src/game/g_res_downloader.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 unit g_res_downloader;
  17
  18 interface
  19
  20 uses sysutils, Classes, md5, g_net, g_netmsg, g_console, g_main, e_log;
  21
  22
  23 // download map wad from server (if necessary)
  24 // download all required map resource wads too
  25 // registers all required replacement wads
  26 // returns name of the map wad (relative to mapdir), or empty string on error
  27 function g_Res_DownloadMapWAD (FileName: AnsiString; const mapHash: TMD5Digest): AnsiString;
  28
  29 // returns original name, or replacement name
  30 function g_Res_FindReplacementWad (oldname: AnsiString): AnsiString;
  31
  32 // call this somewhere in startup sequence
  33 procedure g_Res_CreateDatabases ();
  34
  35
  36 implementation
  37
  38 uses g_language, sfs, utils, wadreader, g_game, hashtable, fhashdb;
  39
  40 var
  41   // cvars
  42   g_res_ignore_names: AnsiString = 'standart;shrshade';
  43   g_res_ignore_enabled: Boolean = true;
  44   g_res_save_databases: Boolean = true;
  45   // other vars
  46   replacements: THashStrStr = nil;
  47   knownMaps: TFileHashDB = nil;
  48   knownRes: TFileHashDB = nil;
  49   saveDBsToDiskEnabled: Boolean = false; // this will be set to `true` if initial database saving succeed
  50
  51
  52 //==========================================================================
  53 //
  54 //  saveDatabases
  55 //
  56 //==========================================================================
  57 procedure saveDatabases (saveMap, saveRes: Boolean);
  58 var
  59   err: Boolean;
  60   st: TStream;
  61 begin
  62   if (not saveDBsToDiskEnabled) or (not g_res_save_databases) then exit;
  63   // rescan dirs
  64   // save map database
  65   if (saveMap) then
  66   begin
  67     err := true;
  68     st := nil;
  69     try
  70       st := createDiskFile(GameDir+'/data/maphash.db');
  71       knownMaps.saveTo(st);
  72       err := false;
  73     except
  74     end;
  75     st.Free;
  76     if (err) then begin saveDBsToDiskEnabled := false; e_LogWriteln('cannot write map database, disk refresh disabled'); exit; end;
  77   end;
  78   // save resource database
  79   if (saveRes) then
  80   begin
  81     err := true;
  82     st := nil;
  83     try
  84       st := createDiskFile(GameDir+'/data/reshash.db');
  85       knownRes.saveTo(st);
  86       err := false;
  87     except
  88     end;
  89     st.Free;
  90     if (err) then begin saveDBsToDiskEnabled := false; e_LogWriteln('cannot write resource database, disk refresh disabled'); exit; end;
  91   end;
  92 end;
  93
  94
  95 //==========================================================================
  96 //
  97 //  g_Res_CreateDatabases
  98 //
  99 //==========================================================================
 100 procedure g_Res_CreateDatabases ();
 101 var
 102   st: TStream;
 103 begin
 104   // create and load a know map database, if necessary
 105   knownMaps.Free;
 106   knownMaps := TFileHashDB.Create(GameDir+'/maps/');
 107   knownRes := TFileHashDB.Create(GameDir+'/wads/');
 108   saveDBsToDiskEnabled := true;
 109   // load map database
 110   st := nil;
 111   try
 112     st := openDiskFileRO(GameDir+'/data/maphash.db');
 113     knownMaps.loadFrom(st);
 114     e_LogWriteln('loaded map database');
 115   except
 116   end;
 117   st.Free;
 118   // load resource database
 119   st := nil;
 120   try
 121     st := openDiskFileRO(GameDir+'/data/reshash.db');
 122     knownRes.loadFrom(st);
 123     e_LogWriteln('loaded resource database');
 124   except
 125   end;
 126   st.Free;
 127   // rescan dirs
 128   e_LogWriteln('refreshing map database');
 129   knownMaps.scanFiles();
 130   e_LogWriteln('refreshing resource database');
 131   knownRes.scanFiles();
 132   // save databases
 133   saveDatabases(true, true);
 134 end;
 135
 136
 137 //==========================================================================
 138 //
 139 //  getWord
 140 //
 141 //  get next word from a string
 142 //  words are delimited with ';'
 143 //  ignores leading and trailing spaces
 144 //  returns empty string if there are no more words
 145 //
 146 //==========================================================================
 147 function getWord (var list: AnsiString): AnsiString;
 148 var
 149   pos: Integer;
 150 begin
 151   result := '';
 152   while (length(list) > 0) do
 153   begin
 154     if (ord(list[1]) <= 32) or (list[1] = ';') or (list[1] = ':') then begin Delete(list, 1, 1); continue; end;
 155     pos := 1;
 156     while (pos <= length(list)) and (list[pos] <> ';') and (list[pos] <> ':') do Inc(pos);
 157     result := Copy(list, 1, pos-1);
 158     Delete(list, 1, pos);
 159     while (length(result) > 0) and (ord(result[length(result)]) <= 32) do Delete(result, length(result), 1);
 160     if (length(result) > 0) then exit;
 161   end;
 162 end;
 163
 164
 165 //==========================================================================
 166 //
 167 //  isIgnoredResWad
 168 //
 169 //  checks if the given resource wad can be ignored
 170 //
 171 //  FIXME: preparse name list?
 172 //
 173 //==========================================================================
 174 function isIgnoredResWad (fname: AnsiString): Boolean;
 175 var
 176   list: AnsiString;
 177   name: AnsiString;
 178 begin
 179   result := false;
 180   if (not g_res_ignore_enabled) then exit;
 181   fname := forceFilenameExt(ExtractFileName(fname), '');
 182   list := g_res_ignore_names;
 183   name := getWord(list);
 184   while (length(name) > 0) do
 185   begin
 186     name := forceFilenameExt(name, '');
 187     //writeln('*** name=[', name, ']; fname=[', fname, ']');
 188     if (StrEquCI1251(name, fname)) then begin result := true; exit; end;
 189     name := getWord(list);
 190   end;
 191 end;
 192
 193
 194 //==========================================================================
 195 //
 196 //  clearReplacementWads
 197 //
 198 //  call this before downloading a new map from a server
 199 //
 200 //==========================================================================
 201 procedure clearReplacementWads ();
 202 begin
 203   if assigned(replacements) then replacements.clear();
 204   e_LogWriteln('cleared replacement wads');
 205 end;
 206
 207
 208 //==========================================================================
 209 //
 210 //  addReplacementWad
 211 //
 212 //  register new replacement wad
 213 //
 214 //==========================================================================
 215 procedure addReplacementWad (oldname: AnsiString; newDiskName: AnsiString);
 216 begin
 217   e_LogWritefln('adding replacement wad: oldname=%s; newname=%s', [oldname, newDiskName]);
 218   if not assigned(replacements) then replacements := THashStrStr.Create();
 219   replacements.put(toLowerCase1251(oldname), newDiskName);
 220 end;
 221
 222
 223 //==========================================================================
 224 //
 225 //  g_Res_FindReplacementWad
 226 //
 227 //  returns original name, or replacement name
 228 //
 229 //==========================================================================
 230 function g_Res_FindReplacementWad (oldname: AnsiString): AnsiString;
 231 var
 232   fn: AnsiString;
 233 begin
 234   //e_LogWritefln('LOOKING for replacement wad for [%s]...', [oldname], TMsgType.Notify);
 235   result := oldname;
 236   if not assigned(replacements) then exit;
 237   if (replacements.get(toLowerCase1251(ExtractFileName(oldname)), fn)) then
 238   begin
 239     //e_LogWritefln('found replacement wad for [%s] -> [%s]', [oldname, fn], TMsgType.Notify);
 240     result := fn;
 241   end;
 242 end;
 243
 244
 245 //==========================================================================
 246 //
 247 //  scanDir
 248 //
 249 //  look for a wad to match the hash
 250 //  scans subdirs, ignores known wad extensions
 251 //
 252 //  returns found wad disk name, or empty string
 253 //
 254 //==========================================================================
 255 (*
 256 function scanDir (dirName: AnsiString; baseName: AnsiString; const resMd5: TMD5Digest): AnsiString;
 257 var
 258   searchResult: TSearchRec;
 259   dfn: AnsiString;
 260   md5: TMD5Digest;
 261   dirs: array of AnsiString;
 262   f: Integer;
 263 begin
 264   result := '';
 265   SetLength(dirs, 0);
 266   if (length(baseName) = 0) then exit;
 267   dirName := IncludeTrailingPathDelimiter(dirName);
 268   e_LogWritefln('scanning dir `%s` for file `%s`...', [dirName, baseName]);
 269
 270   // scan files
 271   if (FindFirst(dirName+'*', faAnyFile, searchResult) <> 0) then exit;
 272   try
 273     repeat
 274       if ((searchResult.Attr and faDirectory) = 0) then
 275       begin
 276         if (isWadNamesEqu(searchResult.Name, baseName)) then
 277         begin
 278           dfn := dirName+searchResult.Name;
 279           if FileExists(dfn) then
 280           begin
 281             e_LogWritefln('  found `%s`...', [dfn]);
 282             md5 := MD5File(dfn);
 283             if MD5Match(md5, resMd5) then
 284             begin
 285               e_LogWritefln('    MATCH `%s`...', [dfn]);
 286               SetLength(dirs, 0);
 287               result := dfn;
 288               exit;
 289             end;
 290           end;
 291         end;
 292       end
 293       else
 294       begin
 295         if (searchResult.Name <> '.') and (searchResult.Name <> '..') then
 296         begin
 297           dfn := dirName+searchResult.Name;
 298           SetLength(dirs, Length(dirs)+1);
 299           dirs[length(dirs)-1] := dfn;
 300         end;
 301       end;
 302     until (FindNext(searchResult) <> 0);
 303   finally
 304     FindClose(searchResult);
 305   end;
 306
 307   // scan subdirs
 308   for f := 0 to High(dirs) do
 309   begin
 310     dfn := dirs[f];
 311     result := scanDir(dfn, baseName, resMd5);
 312     if (length(result) <> 0) then begin SetLength(dirs, 0); exit; end;
 313   end;
 314   SetLength(dirs, 0);
 315 end;
 316 *)
 317
 318
 319 //==========================================================================
 320 //
 321 //  findExistingMapWadWithHash
 322 //
 323 //  find map or resource wad using its base name and hash
 324 //
 325 //  returns found wad disk name, or empty string
 326 //
 327 //==========================================================================
 328 function findExistingMapWadWithHash (fname: AnsiString; const resMd5: TMD5Digest): AnsiString;
 329 begin
 330   //result := scanDir(GameDir+'/maps', ExtractFileName(fname), resMd5);
 331   result := knownMaps.findByHash(resMd5);
 332   if (length(result) > 0) then
 333   begin
 334     result := GameDir+'/maps/'+result;
 335     if not FileExists(result) then
 336     begin
 337       if (knownMaps.scanFiles()) then saveDatabases(true, false);
 338       result := '';
 339     end;
 340   end;
 341 end;
 342
 343
 344 //==========================================================================
 345 //
 346 //  findExistingResWadWithHash
 347 //
 348 //  find map or resource wad using its base name and hash
 349 //
 350 //  returns found wad disk name, or empty string
 351 //
 352 //==========================================================================
 353 function findExistingResWadWithHash (fname: AnsiString; const resMd5: TMD5Digest): AnsiString;
 354 begin
 355   //result := scanDir(GameDir+'/wads', ExtractFileName(fname), resMd5);
 356   result := knownRes.findByHash(resMd5);
 357   if (length(result) > 0) then
 358   begin
 359     result := GameDir+'/wads/'+result;
 360     if not FileExists(result) then
 361     begin
 362       if (knownRes.scanFiles()) then saveDatabases(false, true);
 363       result := '';
 364     end;
 365   end;
 366 end;
 367
 368
 369 //==========================================================================
 370 //
 371 //  generateFileName
 372 //
 373 //  generate new file name based on the given one and the hash
 374 //  you can pass files with pathes here too
 375 //
 376 //==========================================================================
 377 function generateFileName (fname: AnsiString; const hash: TMD5Digest): AnsiString;
 378 var
 379   mds: AnsiString;
 380   path: AnsiString;
 381   base: AnsiString;
 382   ext: AnsiString;
 383 begin
 384   mds := MD5Print(hash);
 385   if (length(mds) > 16) then mds := Copy(mds, 1, 16);
 386   mds := '_'+mds;
 387   if (length(fname) = 0) then begin result := mds; exit; end;
 388   path := ExtractFilePath(fname);
 389   base := ExtractFileName(fname);
 390   ext := getFilenameExt(base);
 391   base := forceFilenameExt(base, '');
 392   if (length(path) > 0) then result := IncludeTrailingPathDelimiter(path) else result := '';
 393   result := result+base+mds+ext;
 394 end;
 395
 396
 397 //==========================================================================
 398 //
 399 //  g_Res_DownloadMapWAD
 400 //
 401 //  download map wad from server (if necessary)
 402 //  download all required map resource wads too
 403 //  registers all required replacement wads
 404 //
 405 //  returns name of the map wad (relative to mapdir), or empty string on error
 406 //
 407 //==========================================================================
 408 function g_Res_DownloadMapWAD (FileName: AnsiString; const mapHash: TMD5Digest): AnsiString;
 409 var
 410   tf: TNetFileTransfer;
 411   resList: TStringList;
 412   f, res: Integer;
 413   strm: TStream;
 414   fname: AnsiString;
 415   wadname: AnsiString;
 416   md5: TMD5Digest;
 417   mapdbUpdated: Boolean = false;
 418   resdbUpdated: Boolean = false;
 419 begin
 420   result := '';
 421   clearReplacementWads();
 422
 423   resList := TStringList.Create();
 424
 425   try
 426     g_Res_received_map_start := 1;
 427     g_Console_Add(Format(_lc[I_NET_MAP_DL], [FileName]));
 428     e_WriteLog('Downloading map `' + FileName + '` from server', TMsgType.Notify);
 429     g_Game_SetLoadingText(FileName + '...', 0, False);
 430     if (not g_Net_SendMapRequest()) then exit;
 431
 432     FileName := ExtractFileName(FileName);
 433     if (length(FileName) = 0) then FileName := 'fucked_map_wad.wad';
 434     res := g_Net_Wait_MapInfo(tf, resList);
 435     if (res <> 0) then exit;
 436
 437     // find or download a map
 438     result := findExistingMapWadWithHash(tf.diskName, mapHash);
 439     if (length(result) = 0) then
 440     begin
 441       // download map
 442       res := g_Net_RequestResFileInfo(-1{map}, tf);
 443       if (res <> 0) then
 444       begin
 445         e_LogWriteln('error requesting map wad');
 446         result := '';
 447         exit;
 448       end;
 449       try
 450         CreateDir(GameDir+'/maps/downloads');
 451       except
 452       end;
 453       fname := GameDir+'/maps/downloads/'+generateFileName(FileName, mapHash);
 454       tf.diskName := fname;
 455       try
 456         strm := openDiskFileRW(fname);
 457       except
 458         e_WriteLog('cannot create map file `'+FileName+'`', TMsgType.Fatal);
 459         result := '';
 460         exit;
 461       end;
 462       try
 463         res := g_Net_ReceiveResourceFile(-1{map}, tf, strm);
 464       except
 465         e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 466         strm.Free;
 467         result := '';
 468         exit;
 469       end;
 470       strm.Free;
 471       if (res <> 0) then
 472       begin
 473         e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 474         result := '';
 475         exit;
 476       end;
 477       // if it was resumed, check md5 and initiate full download if necessary
 478       if tf.resumed then
 479       begin
 480         md5 := MD5File(fname);
 481         // sorry for pasta, i am asshole
 482         if not MD5Match(md5, tf.hash) then
 483         begin
 484           e_LogWritefln('resuming failed; downloading map `%s` from scratch...', [fname]);
 485           try
 486             DeleteFile(fname);
 487             strm := createDiskFile(fname);
 488           except
 489             e_WriteLog('cannot create map file `'+fname+'`', TMsgType.Fatal);
 490             result := '';
 491             exit;
 492           end;
 493           try
 494             res := g_Net_ReceiveResourceFile(-1{map}, tf, strm);
 495           except
 496             e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 497             strm.Free;
 498             result := '';
 499             exit;
 500           end;
 501           strm.Free;
 502           if (res <> 0) then
 503           begin
 504             e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 505             result := '';
 506             exit;
 507           end;
 508         end;
 509       end;
 510       if (knownMaps.addWithHash(fname, mapHash)) then mapdbUpdated := true;
 511       result := fname;
 512     end;
 513
 514     // download resources
 515     for f := 0 to resList.Count-1 do
 516     begin
 517       res := g_Net_RequestResFileInfo(f, tf);
 518       if (res <> 0) then begin result := ''; exit; end;
 519       if (isIgnoredResWad(tf.diskName)) then
 520       begin
 521         // ignored file, abort download
 522         g_Net_AbortResTransfer(tf);
 523         e_LogWritefln('ignoring wad resource `%s` by user request', [tf.diskName]);
 524         continue;
 525       end;
 526       wadname := findExistingResWadWithHash(tf.diskName, tf.hash);
 527       if (length(wadname) <> 0) then
 528       begin
 529         // already here
 530         g_Net_AbortResTransfer(tf);
 531         addReplacementWad(tf.diskName, wadname);
 532       end
 533       else
 534       begin
 535         try
 536           CreateDir(GameDir+'/wads/downloads');
 537         except
 538         end;
 539         fname := GameDir+'/wads/downloads/'+generateFileName(tf.diskName, tf.hash);
 540         e_LogWritefln('downloading resource `%s` to `%s`...', [tf.diskName, fname]);
 541         try
 542           strm := openDiskFileRW(fname);
 543         except
 544           e_WriteLog('cannot create resource file `'+fname+'`', TMsgType.Fatal);
 545           result := '';
 546           exit;
 547         end;
 548         try
 549           res := g_Net_ReceiveResourceFile(f, tf, strm);
 550         except
 551           e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 552           strm.Free;
 553           result := '';
 554           exit;
 555         end;
 556         strm.Free;
 557         if (res <> 0) then
 558         begin
 559           e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 560           result := '';
 561           exit;
 562         end;
 563         // if it was resumed, check md5 and initiate full download if necessary
 564         if tf.resumed then
 565         begin
 566           md5 := MD5File(fname);
 567           // sorry for pasta, i am asshole
 568           if not MD5Match(md5, tf.hash) then
 569           begin
 570             e_LogWritefln('resuming failed; downloading resource `%s` to `%s` from scratch...', [tf.diskName, fname]);
 571             try
 572               DeleteFile(fname);
 573               strm := createDiskFile(fname);
 574             except
 575               e_WriteLog('cannot create resource file `'+fname+'`', TMsgType.Fatal);
 576               result := '';
 577               exit;
 578             end;
 579             try
 580               res := g_Net_ReceiveResourceFile(f, tf, strm);
 581             except
 582               e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 583               strm.Free;
 584               result := '';
 585               exit;
 586             end;
 587             strm.Free;
 588             if (res <> 0) then
 589             begin
 590               e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 591               result := '';
 592               exit;
 593             end;
 594           end;
 595         end;
 596         addReplacementWad(tf.diskName, fname);
 597         if (knownRes.addWithHash(fname, tf.hash)) then resdbUpdated := true;
 598       end;
 599     end;
 600   finally
 601     resList.Free;
 602     g_Res_received_map_start := 0;
 603   end;
 604
 605   if saveDBsToDiskEnabled and (mapdbUpdated or resdbUpdated) then saveDatabases(mapdbUpdated, resdbUpdated);
 606 end;
 607
 608
 609 initialization
 610   conRegVar('rdl_ignore_names', @g_res_ignore_names, 'list of resource wad names (without extensions) to ignore in dl hash checks', 'dl ignore wads');
 611   conRegVar('rdl_ignore_enabled', @g_res_ignore_enabled, 'enable dl hash check ignore list', 'dl hash check ignore list active');
 612   conRegVar('rdl_hashdb_save_enabled', @g_res_save_databases, 'enable saving map/resource hash databases to disk', 'controls storing hash databases to disk');
 613 end.