src/shared/fhashdb.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 // database of file hashes (md5)
  17 unit fhashdb;
  18
  19 interface
  20
  21 uses
  22   SysUtils, Classes,
  23   md5, hashtable, utils;
  24
  25
  26 type
  27   THashKeyMD5 = class
  28   public
  29     class function hash (const k: TMD5Digest): LongWord; inline;
  30     class function equ (const a, b: TMD5Digest): Boolean; inline;
  31     class procedure freekey (var k: TMD5Digest); inline;
  32   end;
  33
  34   THashStrCIInt = specialize THashBase<AnsiString, Integer, THashKeyStrAnsiCI>;
  35   THashMD5Int = specialize THashBase<TMD5Digest, Integer, THashKeyMD5>;
  36
  37   TFileHashDB = class
  38   private
  39     type
  40       TFileInfo = record
  41         name: AnsiString; // names are relative to `mBasePath`
  42         hash: TMD5Digest;
  43         size: LongWord;
  44         age: LongInt;
  45         nextFree: Integer;
  46         // used in directory scanner
  47         wasSeen: Boolean;
  48       end;
  49
  50   private
  51     mBasePath: AnsiString; // ends with '/'
  52     mHash2List: THashMD5Int; // hash -> list index
  53     mFile2List: THashStrCIInt; // file name -> list index
  54     mFileList: array of TFileInfo;
  55     mFreeHead: Integer;
  56
  57   private
  58     procedure removeIndex (idx: Integer);
  59     function allocIndex (): Integer;
  60
  61     procedure scanDir (path: AnsiString; var changed: Boolean);
  62
  63   public
  64     constructor Create (aBasePath: AnsiString);
  65     destructor Destroy (); override;
  66
  67     // doesn't clear base path
  68     procedure clear ();
  69
  70     // (re)scans base path and all its subdirs
  71     // returns `true` if db was changed
  72     // you'd better call it after loading a database
  73     function scanFiles (): Boolean;
  74
  75     // those throws
  76     procedure saveTo (st: TStream);
  77     // this clears existing data
  78     procedure loadFrom (st: TStream);
  79
  80     // returns file name relative to base path or empty string
  81     function findByHash (const md5: TMD5Digest): AnsiString;
  82     // returns `true` if something was changed
  83     // name is relative to base
  84     function addWithHash (relname: AnsiString; const md5: TMD5Digest): Boolean;
  85   end;
  86
  87
  88 implementation
  89
  90
  91 class function THashKeyMD5.hash (const k: TMD5Digest): LongWord; inline; begin
  92   //result := joaatHashPtr(@k, sizeof(TMD5Digest));
  93   //k8: use first 4 bytes of k as a hash instead? it should be good enough
  94   Move(k, result, sizeof(result));
  95 end;
  96 class function THashKeyMD5.equ (const a, b: TMD5Digest): Boolean; inline; begin result := MD5Match(a, b); end;
  97 class procedure THashKeyMD5.freekey (var k: TMD5Digest); inline; begin end;
  98
  99
 100 //==========================================================================
 101 //
 102 //  fixSlashes
 103 //
 104 //  fixes all slashes; adds a final one too
 105 //
 106 //==========================================================================
 107 function fixSlashes (const path: AnsiString; addFinal: Boolean): AnsiString;
 108 var
 109   f: Integer;
 110 begin
 111   result := path;
 112   for f := 1 to length(result) do if (result[f] = '\') then result[f] := '/';
 113   if (addFinal) and (length(result) > 0) and (result[length(result)] <> '/') then result := result+'/';
 114 end;
 115
 116
 117 //==========================================================================
 118 //
 119 //  TFileHashDB.Create
 120 //
 121 //==========================================================================
 122 constructor TFileHashDB.Create (aBasePath: AnsiString);
 123 begin
 124   mBasePath := aBasePath;
 125   if (length(aBasePath) <> 0) then
 126   begin
 127     if not findFileCI(mBasePath, true) then mBasePath := aBasePath;
 128   end;
 129   mBasePath := fixSlashes(mBasePath, true);
 130   mHash2List := THashMD5Int.Create();
 131   mFile2List := THashStrCIInt.Create();
 132   SetLength(mFileList, 0);
 133   mFreeHead := -1;
 134 end;
 135
 136
 137 //==========================================================================
 138 //
 139 //  TFileHashDB.Destroy
 140 //
 141 //==========================================================================
 142 destructor TFileHashDB.Destroy ();
 143 begin
 144   mBasePath := '';
 145   mHash2List.Free;
 146   mFile2List.Free;
 147   SetLength(mFileList, 0);
 148   mFreeHead := -1;
 149 end;
 150
 151
 152 //==========================================================================
 153 //
 154 //  TFileHashDB.clear
 155 //
 156 //  doesn't clear base path
 157 //
 158 //==========================================================================
 159 procedure TFileHashDB.clear ();
 160 begin
 161   mHash2List.clear();
 162   mFile2List.clear();
 163   SetLength(mFileList, 0);
 164   mFreeHead := -1;
 165 end;
 166
 167
 168 //==========================================================================
 169 //
 170 //  TFileHashDB.saveTo
 171 //
 172 //==========================================================================
 173 procedure TFileHashDB.saveTo (st: TStream);
 174 var
 175   sign: array[0..3] of AnsiChar;
 176   f: Integer;
 177 begin
 178   sign := 'FHDB';
 179   st.WriteBuffer(sign, 4);
 180   st.WriteWord(0); // version
 181   st.WriteDWord(LongWord(mFile2List.count));
 182   for f := Low(mFileList) to High(mFileList) do
 183   begin
 184     if (length(mFileList[f].name) = 0) then continue;
 185     st.WriteAnsiString(mFileList[f].name);
 186     st.WriteBuffer(mFileList[f].hash, sizeof(TMD5Digest));
 187     st.WriteDWord(mFileList[f].size);
 188     st.WriteDWord(LongWord(mFileList[f].age));
 189   end;
 190 end;
 191
 192
 193 //==========================================================================
 194 //
 195 //  TFileHashDB.loadFrom
 196 //
 197 //==========================================================================
 198 procedure TFileHashDB.loadFrom (st: TStream);
 199 var
 200   sign: array[0..3] of AnsiChar;
 201   count: Integer;
 202   idx: Integer;
 203   fi: ^TFileInfo;
 204 begin
 205   clear();
 206   try
 207     st.ReadBuffer(sign, 4);
 208     if (sign <> 'FHDB') then raise Exception.Create('invalid database signature');
 209     count := st.ReadWord();
 210     if (count <> 0) then raise Exception.Create('invalid database version');
 211     count := Integer(st.ReadDWord());
 212     if (count < 0) or (count > 1024*1024) then raise Exception.Create('invalid database file count');
 213     while (count > 0) do
 214     begin
 215       idx := allocIndex();
 216       fi := @mFileList[idx];
 217       fi.name := st.ReadAnsiString();
 218       st.ReadBuffer(fi.hash, sizeof(TMD5Digest));
 219       fi.size := st.ReadDWord();
 220       fi.age := Integer(st.ReadDWord());
 221       if (length(fi.name) = 0) then raise Exception.Create('invalid database file name');
 222       if (fi.age = -1) then raise Exception.Create('invalid database file age');
 223       mFile2List.put(fi.name, idx);
 224       mHash2List.put(fi.hash, idx);
 225       Dec(count);
 226     end;
 227   except
 228     begin
 229       clear();
 230       raise;
 231      end;
 232   end;
 233 end;
 234
 235
 236 //==========================================================================
 237 //
 238 //  TFileHashDB.removeIndex
 239 //
 240 //==========================================================================
 241 procedure TFileHashDB.removeIndex (idx: Integer);
 242 begin
 243   if (idx < 0) or (idx > High(mFileList)) or (length(mFileList[idx].name) = 0) then exit; // nothing to do
 244   mFile2List.del(mFileList[idx].name);
 245   mHash2List.del(mFileList[idx].hash);
 246   mFileList[idx].name := '';
 247   mFileList[idx].nextFree := mFreeHead;
 248   mFreeHead := idx;
 249 end;
 250
 251
 252 //==========================================================================
 253 //
 254 //  TFileHashDB.allocIndex
 255 //
 256 //==========================================================================
 257 function TFileHashDB.allocIndex (): Integer;
 258 begin
 259   result := mFreeHead;
 260   if (result >= 0) then
 261   begin
 262     mFreeHead := mFileList[result].nextFree;
 263   end
 264   else
 265   begin
 266     result := length(mFileList);
 267     SetLength(mFileList, length(mFileList)+1); // oooh...
 268   end;
 269 end;
 270
 271
 272 //==========================================================================
 273 //
 274 //  TFileHashDB.scanDir
 275 //
 276 //==========================================================================
 277 procedure TFileHashDB.scanDir (path: AnsiString; var changed: Boolean);
 278 var
 279   sr: TSearchRec;
 280   dfn: AnsiString;
 281   hfn: AnsiString;
 282   md5: TMD5Digest;
 283   ok: Boolean;
 284   idx: Integer;
 285   age: LongInt;
 286   needUpdate: Boolean;
 287 begin
 288   if (FindFirst(path+'*', faAnyFile, sr) <> 0) then exit;
 289   try
 290     repeat
 291       if ((sr.Attr and faDirectory) <> 0) then
 292       begin
 293         // directory
 294         if (sr.Name <> '.') and (sr.Name <> '..') then scanDir(path+sr.Name+'/', changed);
 295       end
 296       else if (hasWadExtension(sr.Name)) then
 297       begin
 298         // file
 299         dfn := fixSlashes(path+sr.Name, false);
 300         // build internal file name
 301         hfn := dfn;
 302         Delete(hfn, 1, length(mBasePath)); // remove prefix
 303         // find file in hash
 304         if not mFile2List.get(hfn, idx) then idx := -1;
 305         // check if we already have this file
 306         age := FileAge(dfn);
 307         if (age <> -1) then
 308         begin
 309           // do we need to update this file?
 310           if (idx >= 0) then
 311           begin
 312             needUpdate :=
 313               (age <> mFileList[idx].age) or
 314               (LongWord(sr.size) <> mFileList[idx].size);
 315           end
 316           else
 317           begin
 318             needUpdate := true;
 319           end;
 320           // recalc md5 and update file entry, if necessary
 321           if (needUpdate) then
 322           begin
 323             ok := false;
 324             try
 325               md5 := MD5File(dfn);
 326               ok := true;
 327             except
 328             end;
 329             if (ok) then
 330             begin
 331               changed := true;
 332               // remove old hash -> index mapping
 333               if (idx >= 0) then mHash2List.del(mFileList[idx].hash);
 334               // update
 335               if (idx < 0) then idx := allocIndex();
 336               mFileList[idx].name := hfn;
 337               mFileList[idx].hash := md5;
 338               mFileList[idx].size := LongWord(sr.size);
 339               mFileList[idx].age := age;
 340               mFileList[idx].nextFree := -1;
 341               mFileList[idx].wasSeen := true;
 342               mFile2List.put(hfn, idx);
 343               mHash2List.put(md5, idx);
 344             end
 345             else
 346             begin
 347               // update failed, remove this entry
 348               if (idx >= 0) then changed := true;
 349               removeIndex(idx); // cannot read, remove
 350             end;
 351           end
 352           else
 353           begin
 354             if (idx >= 0) then mFileList[idx].wasSeen := true;
 355           end;
 356         end
 357         else
 358         begin
 359           // remove this file if we don't have it anymore
 360           if (idx >= 0) then changed := true;
 361           removeIndex(idx);
 362         end;
 363       end
 364       else
 365       begin
 366         dfn := fixSlashes(path+sr.Name, false);
 367         // build internal file name
 368         hfn := dfn;
 369         Delete(hfn, 1, length(mBasePath)); // remove prefix
 370         // find file in hash
 371         if mFile2List.get(hfn, idx) then
 372         begin
 373           changed := true;
 374           removeIndex(idx);
 375         end;
 376       end;
 377     until (FindNext(sr) <> 0);
 378   finally
 379     FindClose(sr);
 380   end;
 381 end;
 382
 383
 384 //==========================================================================
 385 //
 386 //  TFileHashDB.scanFiles
 387 //
 388 //  scans base path and all its subdirs
 389 //  returns `true` if db was changed
 390 //
 391 //==========================================================================
 392 function TFileHashDB.scanFiles (): Boolean;
 393 var
 394   f: Integer;
 395 begin
 396   result := false;
 397   for f := Low(mFileList) to High(mFileList) do mFileList[f].wasSeen := false;
 398   scanDir(mBasePath, result);
 399   // remove all unseen files
 400   f := High(mFileList);
 401   while (f >= 0) do
 402   begin
 403     if (length(mFileList[f].name) > 0) and (not mFileList[f].wasSeen) then removeIndex(f);
 404     Dec(f);
 405   end;
 406 end;
 407
 408
 409 //==========================================================================
 410 //
 411 //  TFileHashDB.findByHash
 412 //
 413 //  returns file name relative to base path or empty string
 414 //
 415 //==========================================================================
 416 function TFileHashDB.findByHash (const md5: TMD5Digest): AnsiString;
 417 var
 418   idx: Integer;
 419 begin
 420   if not mHash2List.get(md5, idx) then begin result := ''; exit; end;
 421   result := mFileList[idx].name;
 422 end;
 423
 424
 425 //==========================================================================
 426 //
 427 //  TFileHashDB.addWithHash
 428 //
 429 //  returns `true` if something was changed
 430 //  name is relative to base
 431 //
 432 //==========================================================================
 433 function TFileHashDB.addWithHash (relname: AnsiString; const md5: TMD5Digest): Boolean;
 434 var
 435   age: LongInt;
 436   size: LongInt;
 437   handle: THandle;
 438   fn: AnsiString;
 439   idx: Integer;
 440 begin
 441   result := false;
 442   if (length(relname) > length(mBasePath)) and strEquCI1251(mBasePath, Copy(relname, 1, length(mBasePath))) then Delete(relname, 1, Length(mBasePath));
 443   if (length(relname) = 0) then exit;
 444   fn := mBasePath+relname;
 445   if not findFileCI(fn) then exit;
 446   // get age
 447   age := FileAge(fn);
 448   if (age = -1) then exit;
 449   // get size
 450   handle := FileOpen(fn, fmOpenRead or fmShareDenyNone);
 451   if (handle = THandle(-1)) then exit;
 452   size := FileSeek(handle, 0, fsFromEnd);
 453   FileClose(handle);
 454   if (size = -1) then exit;
 455   // find old file, if any
 456   Delete(fn, 1, length(mBasePath));
 457   if not mFile2List.get(fn, idx) then idx := -1;
 458   // check for changes
 459   if (idx >= 0) then
 460   begin
 461     if (mFileList[idx].size = size) and (mFileList[idx].age = age) and (MD5Match(mFileList[idx].hash, md5)) then exit;
 462     removeIndex(idx);
 463   end;
 464   idx := allocIndex();
 465   mFileList[idx].name := fn;
 466   mFileList[idx].hash := md5;
 467   mFileList[idx].size := size;
 468   mFileList[idx].age := age;
 469   mFileList[idx].nextFree := -1;
 470   mFile2List.put(fn, idx);
 471   mHash2List.put(md5, idx);
 472   result := true;
 473 end;
 474
 475
 476 end.