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 function g_Res_SearchSameWAD(const path, filename: AnsiString; const resMd5: TMD5Digest): AnsiString;
  23
  24 // download map wad from server (if necessary)
  25 // download all required map resource wads too
  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 // call this before downloading a new map from a server
  30 procedure g_Res_ClearReplacementWads ();
  31 // returns original name, or replacement name
  32 function g_Res_FindReplacementWad (oldname: AnsiString): AnsiString;
  33 procedure g_Res_PutReplacementWad (oldname: AnsiString; newDiskName: AnsiString);
  34
  35
  36 implementation
  37
  38 uses g_language, sfs, utils, wadreader, g_game, hashtable;
  39
  40 const DOWNLOAD_DIR = 'downloads';
  41
  42 type
  43   TFileInfo = record
  44     diskName: AnsiString; // lowercased
  45     baseName: AnsiString; // lowercased
  46     md5: TMD5Digest;
  47     md5valid: Boolean;
  48     nextBaseNameIndex: Integer;
  49   end;
  50
  51 var
  52   knownFiles: array of TFileInfo;
  53   knownHash: THashStrInt = nil; // key: base name; value: index
  54   scannedDirs: THashStrInt = nil; // key: lowercased dir name
  55   replacements: THashStrStr = nil;
  56
  57
  58 function findKnownFile (diskName: AnsiString): Integer;
  59 var
  60   idx: Integer;
  61   baseName: AnsiString;
  62 begin
  63   result := -1;
  64   if not assigned(knownHash) then exit;
  65   if (length(diskName) = 0) then exit;
  66   baseName := toLowerCase1251(ExtractFileName(diskName));
  67   if (not knownHash.get(baseName, idx)) then exit;
  68   if (idx < 0) or (idx >= length(knownFiles)) then raise Exception.Create('wutafuck?');
  69   while (idx >= 0) do
  70   begin
  71     if (strEquCI1251(knownFiles[idx].diskName, diskName)) then begin result := idx; exit; end; // i found her!
  72     idx := knownFiles[idx].nextBaseNameIndex;
  73   end;
  74 end;
  75
  76
  77 function addKnownFile (diskName: AnsiString): Integer;
  78 var
  79   idx: Integer;
  80   lastIdx: Integer = -1;
  81   baseName: AnsiString;
  82   fi: ^TFileInfo;
  83 begin
  84   result := -1;
  85   if not assigned(knownHash) then knownHash := THashStrInt.Create();
  86   if (length(diskName) = 0) then exit;
  87   baseName := toLowerCase1251(ExtractFileName(diskName));
  88   if (length(baseName) = 0) then exit;
  89   // check if we already have this file
  90   if (knownHash.get(baseName, idx)) then
  91   begin
  92     if (idx < 0) or (idx >= length(knownFiles)) then raise Exception.Create('wutafuck?');
  93     while (idx >= 0) do
  94     begin
  95       if (strEquCI1251(knownFiles[idx].diskName, diskName)) then
  96       begin
  97         // already here
  98         result := idx;
  99         exit;
 100       end;
 101       lastIdx := idx;
 102       idx := knownFiles[idx].nextBaseNameIndex;
 103     end;
 104   end;
 105   // this file is not there, append it
 106   idx := length(knownFiles);
 107   result := idx;
 108   SetLength(knownFiles, idx+1); // sorry
 109   fi := @knownFiles[idx];
 110   fi.diskName := diskName;
 111   fi.baseName := baseName;
 112   fi.md5valid := false;
 113   fi.nextBaseNameIndex := -1;
 114   if (lastIdx < 0) then
 115   begin
 116     // totally new one
 117     knownHash.put(baseName, idx);
 118   end
 119   else
 120   begin
 121     knownFiles[lastIdx].nextBaseNameIndex := idx;
 122   end;
 123 end;
 124
 125
 126 function getKnownFileWithMD5 (diskDir: AnsiString; baseName: AnsiString; const md5: TMD5Digest): AnsiString;
 127 var
 128   idx: Integer;
 129 begin
 130   result := '';
 131   if not assigned(knownHash) then exit;
 132   if (not knownHash.get(toLowerCase1251(baseName), idx)) then exit;
 133   if (idx < 0) or (idx >= length(knownFiles)) then raise Exception.Create('wutafuck?');
 134   while (idx >= 0) do
 135   begin
 136     if (strEquCI1251(knownFiles[idx].diskName, IncludeTrailingPathDelimiter(diskDir)+baseName)) then
 137     begin
 138       if (not knownFiles[idx].md5valid) then
 139       begin
 140         knownFiles[idx].md5 := MD5File(knownFiles[idx].diskName);
 141         knownFiles[idx].md5valid := true;
 142       end;
 143       if (MD5Match(knownFiles[idx].md5, md5)) then
 144       begin
 145         result := knownFiles[idx].diskName;
 146         exit;
 147       end;
 148     end;
 149     idx := knownFiles[idx].nextBaseNameIndex;
 150   end;
 151 end;
 152
 153
 154 // call this before downloading a new map from a server
 155 procedure g_Res_ClearReplacementWads ();
 156 begin
 157   if assigned(replacements) then replacements.clear();
 158   e_LogWriteln('cleared replacement wads');
 159 end;
 160
 161
 162 // returns original name, or replacement name
 163 function g_Res_FindReplacementWad (oldname: AnsiString): AnsiString;
 164 var
 165   fn: AnsiString;
 166 begin
 167   result := oldname;
 168   if not assigned(replacements) then exit;
 169   if (replacements.get(toLowerCase1251(ExtractFileName(oldname)), fn)) then result := fn;
 170 end;
 171
 172
 173 procedure g_Res_PutReplacementWad (oldname: AnsiString; newDiskName: AnsiString);
 174 begin
 175   e_LogWritefln('adding replacement wad: oldname=%s; newname=%s', [oldname, newDiskName]);
 176   if not assigned(replacements) then replacements := THashStrStr.Create();
 177   replacements.put(toLowerCase1251(oldname), newDiskName);
 178 end;
 179
 180
 181 procedure scanDir (const dirName: AnsiString; calcMD5: Boolean);
 182 var
 183   searchResult: TSearchRec;
 184   dfn: AnsiString;
 185   idx: Integer;
 186 begin
 187   if not assigned(scannedDirs) then scannedDirs := THashStrInt.Create();
 188   dfn := toLowerCase1251(IncludeTrailingPathDelimiter(dirName));
 189   if scannedDirs.has(dfn) then exit;
 190   scannedDirs.put(dfn, 42);
 191
 192   if (FindFirst(dirName+'/*', faAnyFile, searchResult) <> 0) then exit;
 193   try
 194     repeat
 195       if (searchResult.Attr and faDirectory) = 0 then
 196       begin
 197         dfn := dirName+'/'+searchResult.Name;
 198         idx := addKnownFile(dfn);
 199         if (calcMD5) and (idx >= 0) then
 200         begin
 201           if (not knownFiles[idx].md5valid) then
 202           begin
 203             knownFiles[idx].md5 := MD5File(knownFiles[idx].diskName);
 204             knownFiles[idx].md5valid := true;
 205           end;
 206         end;
 207       end
 208       else if (searchResult.Name <> '.') and (searchResult.Name <> '..') then
 209       begin
 210         scanDir(IncludeTrailingPathDelimiter(dirName)+searchResult.Name, calcMD5);
 211       end;
 212     until (FindNext(searchResult) <> 0);
 213   finally
 214     FindClose(searchResult);
 215   end;
 216 end;
 217
 218
 219 function CompareFileHash(const filename: AnsiString; const resMd5: TMD5Digest): Boolean;
 220 var
 221   gResHash: TMD5Digest;
 222   fname: AnsiString;
 223 begin
 224   fname := findDiskWad(filename);
 225   if length(fname) = 0 then begin result := false; exit; end;
 226   gResHash := MD5File(fname);
 227   Result := MD5Match(gResHash, resMd5);
 228 end;
 229
 230 function CheckFileHash(const path, filename: AnsiString; const resMd5: TMD5Digest): Boolean;
 231 var
 232   fname: AnsiString;
 233 begin
 234   fname := findDiskWad(path+filename);
 235   if length(fname) = 0 then begin result := false; exit; end;
 236   Result := FileExists(fname) and CompareFileHash(fname, resMd5);
 237 end;
 238
 239
 240 function g_Res_SearchResWad (asMap: Boolean; fname: AnsiString; const resMd5: TMD5Digest): AnsiString;
 241 var
 242   f: Integer;
 243 begin
 244   result := '';
 245   //if not assigned(scannedDirs) then scannedDirs := THashStrInt.Create();
 246   if (asMap) then
 247   begin
 248     if CheckFileHash(GameDir+'/maps', fname, resMd5) then
 249     begin
 250       result := findDiskWad(GameDir+'/maps/'+fname);
 251       if (length(result) <> 0) then exit;
 252     end;
 253     scanDir(GameDir+'/maps/downloads', true);
 254   end
 255   else
 256   begin
 257     if CheckFileHash(GameDir+'/wads', fname, resMd5) then
 258     begin
 259       result := findDiskWad(GameDir+'/wads/'+fname);
 260       if (length(result) <> 0) then exit;
 261     end;
 262     scanDir(GameDir+'/wads/downloads', true);
 263   end;
 264   for f := Low(knownFiles) to High(knownFiles) do
 265   begin
 266     if (not knownFiles[f].md5valid) then continue;
 267     if (MD5Match(knownFiles[f].md5, resMd5)) then
 268     begin
 269       result := knownFiles[f].diskName;
 270       exit;
 271     end;
 272   end;
 273   //resStream := createDiskFile(GameDir+'/wads/'+mapData.ExternalResources[i].Name);
 274 end;
 275
 276
 277 function g_Res_SearchSameWAD (const path, filename: AnsiString; const resMd5: TMD5Digest): AnsiString;
 278 begin
 279   scanDir(path, false);
 280   result := getKnownFileWithMD5(path, filename, resMd5);
 281 end;
 282
 283
 284 function g_Res_DownloadMapWAD (FileName: AnsiString; const mapHash: TMD5Digest): AnsiString;
 285 var
 286   tf: TNetFileTransfer;
 287   resList: TStringList;
 288   f, res: Integer;
 289   strm: TStream;
 290   mmd5: TMD5Digest;
 291   fname: AnsiString;
 292   idx: Integer;
 293   wadname: AnsiString;
 294 begin
 295   //SetLength(mapData.ExternalResources, 0);
 296   result := '';
 297   g_Res_ClearReplacementWads();
 298   g_Res_received_map_start := false;
 299
 300   try
 301     CreateDir(GameDir+'/maps/downloads');
 302   except
 303   end;
 304
 305   try
 306     CreateDir(GameDir+'/wads/downloads');
 307   except
 308   end;
 309
 310   resList := TStringList.Create();
 311
 312   try
 313     g_Console_Add(Format(_lc[I_NET_MAP_DL], [FileName]));
 314     e_WriteLog('Downloading map `' + FileName + '` from server', TMsgType.Notify);
 315     g_Game_SetLoadingText(FileName + '...', 0, False);
 316     //MC_SEND_MapRequest();
 317     if (not g_Net_SendMapRequest()) then exit;
 318
 319     FileName := ExtractFileName(FileName);
 320     if (length(FileName) = 0) then FileName := 'fucked_map_wad.wad';
 321     res := g_Net_Wait_MapInfo(tf, resList);
 322     if (res <> 0) then exit;
 323
 324     // find or download a map
 325     result := g_Res_SearchResWad(true{asMap}, tf.diskName, mapHash);
 326     if (length(result) = 0) then
 327     begin
 328       // download map
 329       res := g_Net_RequestResFileInfo(-1{map}, tf);
 330       if (res <> 0) then
 331       begin
 332         e_LogWriteln('error requesting map wad');
 333         result := '';
 334         exit;
 335       end;
 336       fname := GameDir+'/maps/downloads/'+FileName;
 337       try
 338         strm := createDiskFile(fname);
 339       except
 340         e_WriteLog('cannot create map file `'+FileName+'`', TMsgType.Fatal);
 341         result := '';
 342         exit;
 343       end;
 344       tf.diskName := fname;
 345       try
 346         res := g_Net_ReceiveResourceFile(-1{map}, tf, strm);
 347       except
 348         e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 349         strm.Free;
 350         result := '';
 351         exit;
 352       end;
 353       strm.Free;
 354       if (res <> 0) then
 355       begin
 356         e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 357         result := '';
 358         exit;
 359       end;
 360       mmd5 := MD5File(fname);
 361       if (not MD5Match(mmd5, mapHash)) then
 362       begin
 363         e_WriteLog('error downloading map file `'+FileName+'` (bad hash)', TMsgType.Fatal);
 364         result := '';
 365         exit;
 366       end;
 367       idx := addKnownFile(fname);
 368       if (idx < 0) then
 369       begin
 370         e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 371         result := '';
 372         exit;
 373       end;
 374       knownFiles[idx].md5 := mmd5;
 375       knownFiles[idx].md5valid := true;
 376       result := fname;
 377     end;
 378
 379     // download resources
 380     for f := 0 to resList.Count-1 do
 381     begin
 382       res := g_Net_RequestResFileInfo(f, tf);
 383       if (res <> 0) then begin result := ''; exit; end;
 384       wadname := g_Res_SearchResWad(false{asMap}, tf.diskName, tf.hash);
 385       if (length(wadname) <> 0) then
 386       begin
 387         // already here
 388         g_Net_AbortResTransfer(tf);
 389         g_Res_PutReplacementWad(tf.diskName, wadname);
 390       end
 391       else
 392       begin
 393         fname := GameDir+'/wads/downloads/'+tf.diskName;
 394         try
 395           strm := createDiskFile(fname);
 396         except
 397           e_WriteLog('cannot create resource file `'+fname+'`', TMsgType.Fatal);
 398           result := '';
 399           exit;
 400         end;
 401         try
 402           res := g_Net_ReceiveResourceFile(f, tf, strm);
 403         except
 404           e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 405           strm.Free;
 406           result := '';
 407           exit;
 408         end;
 409         strm.Free;
 410         if (res <> 0) then
 411         begin
 412           e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 413           result := '';
 414           exit;
 415         end;
 416         idx := addKnownFile(fname);
 417         if (idx < 0) then
 418         begin
 419           e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
 420           result := '';
 421           exit;
 422         end;
 423         knownFiles[idx].md5 := tf.hash;
 424         knownFiles[idx].md5valid := true;
 425         g_Res_PutReplacementWad(tf.diskName, fname);
 426       end;
 427     end;
 428   finally
 429     resList.Free;
 430   end;
 431 end;
 432
 433
 434 end.