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