1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
16 unit g_res_downloader
;
20 uses sysutils
, Classes
, md5
, g_net
, g_netmsg
, g_console
, g_main
, e_log
;
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
;
29 // returns original name, or replacement name
30 function g_Res_FindReplacementWad (oldname
: AnsiString
): AnsiString
;
32 // call this somewhere in startup sequence
33 procedure g_Res_CreateDatabases (allowRescan
: Boolean=false);
38 uses g_language
, sfs
, utils
, wadreader
, g_game
, hashtable
, fhashdb
, e_res
;
42 g_res_ignore_names
: AnsiString
= 'standart;shrshade';
43 g_res_ignore_enabled
: Boolean = true;
44 g_res_save_databases
: Boolean = true;
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
52 //==========================================================================
56 //==========================================================================
57 procedure saveDatabases (saveMap
, saveRes
: Boolean);
61 ccdir
: AnsiString
= '';
63 if (not saveDBsToDiskEnabled
) or (not g_res_save_databases
) then exit
;
64 ccdir
:= e_GetWriteableDir(CacheDirs
, false);
65 if (length(ccdir
) = 0) then exit
;
73 st
:= createDiskFile(ccdir
+'/maphash.db');
79 if (err
) then begin saveDBsToDiskEnabled
:= false; e_LogWriteln('cannot write map database, disk refresh disabled'); exit
; end;
81 // save resource database
87 st
:= createDiskFile(ccdir
+'/reshash.db');
93 if (err
) then begin saveDBsToDiskEnabled
:= false; e_LogWriteln('cannot write resource database, disk refresh disabled'); exit
; end;
98 //==========================================================================
100 // g_Res_CreateDatabases
102 //==========================================================================
103 procedure g_Res_CreateDatabases (allowRescan
: Boolean=false);
109 ccdir
: AnsiString
= '';
111 if not assigned(knownMaps
) then
113 // create and load a know map database, if necessary
114 knownMaps
:= TFileHashDB
.Create({GameDir}'', MapDirs
);
115 knownMaps
.appendMoreDirs(MapDownloadDirs
);
116 knownRes
:= TFileHashDB
.Create({GameDir}'', WadDirs
);
117 knownRes
.appendMoreDirs(WadDownloadDirs
);
118 saveDBsToDiskEnabled
:= true;
122 ccdir
:= e_GetWriteableDir(CacheDirs
, false);
123 if (length(ccdir
) > 0) then
125 st
:= openDiskFileRO(ccdir
+'/maphash.db');
126 knownMaps
.loadFrom(st
);
127 e_LogWriteln('loaded map database');
132 // load resource database
135 if (length(ccdir
) > 0) then
137 st
:= openDiskFileRO(ccdir
+'/reshash.db');
138 knownRes
.loadFrom(st
);
139 e_LogWriteln('loaded resource database');
148 if (not allowRescan
) then exit
;
152 e_LogWriteln('refreshing map database');
153 upmap
:= knownMaps
.scanFiles();
154 e_LogWriteln('refreshing resource database');
155 upres
:= knownRes
.scanFiles();
157 if (forcesave
) then begin upmap
:= true; upres
:= true; end;
158 if upmap
or upres
then saveDatabases(upmap
, upres
);
162 //==========================================================================
166 // get next word from a string
167 // words are delimited with ';'
168 // ignores leading and trailing spaces
169 // returns empty string if there are no more words
171 //==========================================================================
172 function getWord (var list
: AnsiString
): AnsiString
;
177 while (length(list
) > 0) do
179 if (ord(list
[1]) <= 32) or (list
[1] = ';') or (list
[1] = ':') then begin Delete(list
, 1, 1); continue
; end;
181 while (pos
<= length(list
)) and (list
[pos
] <> ';') and (list
[pos
] <> ':') do Inc(pos
);
182 result
:= Copy(list
, 1, pos
-1);
183 Delete(list
, 1, pos
);
184 while (length(result
) > 0) and (ord(result
[length(result
)]) <= 32) do Delete(result
, length(result
), 1);
185 if (length(result
) > 0) then exit
;
190 //==========================================================================
194 // checks if the given resource wad can be ignored
196 // FIXME: preparse name list?
198 //==========================================================================
199 function isIgnoredResWad (fname
: AnsiString
): Boolean;
205 if (not g_res_ignore_enabled
) then exit
;
206 fname
:= forceFilenameExt(ExtractFileName(fname
), '');
207 list
:= g_res_ignore_names
;
208 name
:= getWord(list
);
209 while (length(name
) > 0) do
211 name
:= forceFilenameExt(name
, '');
212 //writeln('*** name=[', name, ']; fname=[', fname, ']');
213 if (StrEquCI1251(name
, fname
)) then begin result
:= true; exit
; end;
214 name
:= getWord(list
);
219 //==========================================================================
221 // clearReplacementWads
223 // call this before downloading a new map from a server
225 //==========================================================================
226 procedure clearReplacementWads ();
228 if assigned(replacements
) then replacements
.clear();
229 e_LogWriteln('cleared replacement wads');
233 //==========================================================================
237 // register new replacement wad
239 //==========================================================================
240 procedure addReplacementWad (oldname
: AnsiString
; newDiskName
: AnsiString
);
242 e_LogWritefln('adding replacement wad: oldname=%s; newname=%s', [oldname
, newDiskName
]);
243 if not assigned(replacements
) then replacements
:= THashStrStr
.Create();
244 replacements
.put(toLowerCase1251(oldname
), newDiskName
);
248 //==========================================================================
250 // g_Res_FindReplacementWad
252 // returns original name, or replacement name
254 //==========================================================================
255 function g_Res_FindReplacementWad (oldname
: AnsiString
): AnsiString
;
259 //e_LogWritefln('LOOKING for replacement wad for [%s]...', [oldname], TMsgType.Notify);
261 if not assigned(replacements
) then exit
;
262 if (replacements
.get(toLowerCase1251(ExtractFileName(oldname
)), fn
)) then
264 //e_LogWritefln('found replacement wad for [%s] -> [%s]', [oldname, fn], TMsgType.Notify);
270 //==========================================================================
272 // findExistingMapWadWithHash
274 // find map or resource wad using its base name and hash
276 // returns found wad disk name, or empty string
278 //==========================================================================
279 function findExistingMapWadWithHash (fname
: AnsiString
; const resMd5
: TMD5Digest
): AnsiString
;
281 result
:= knownMaps
.findByHash(resMd5
);
282 if (length(result
) > 0) then
284 //result := GameDir+'/maps/'+result;
285 if not FileExists(result
) then
287 if (knownMaps
.scanFiles()) then saveDatabases(true, false);
294 //==========================================================================
296 // findExistingResWadWithHash
298 // find map or resource wad using its base name and hash
300 // returns found wad disk name, or empty string
302 //==========================================================================
303 function findExistingResWadWithHash (fname
: AnsiString
; const resMd5
: TMD5Digest
): AnsiString
;
305 result
:= knownRes
.findByHash(resMd5
);
306 if (length(result
) > 0) then
308 //result := GameDir+'/wads/'+result;
309 if not FileExists(result
) then
311 if (knownRes
.scanFiles()) then saveDatabases(false, true);
318 //==========================================================================
322 // generate new file name based on the given one and the hash
323 // you can pass files with pathes here too
325 //==========================================================================
326 function generateFileName (fname
: AnsiString
; const hash
: TMD5Digest
): AnsiString
;
333 mds
:= MD5Print(hash
);
334 if (length(mds
) > 16) then mds
:= Copy(mds
, 1, 16);
336 if (length(fname
) = 0) then begin result
:= mds
; exit
; end;
337 path
:= ExtractFilePath(fname
);
338 base
:= ExtractFileName(fname
);
339 ext
:= getFilenameExt(base
);
340 base
:= forceFilenameExt(base
, '');
341 if (length(path
) > 0) then result
:= IncludeTrailingPathDelimiter(path
) else result
:= '';
342 result
:= result
+base
+mds
+ext
;
346 //==========================================================================
348 // g_Res_DownloadMapWAD
350 // download map wad from server (if necessary)
351 // download all required map resource wads too
352 // registers all required replacement wads
354 // returns name of the map wad (relative to mapdir), or empty string on error
356 //==========================================================================
357 function g_Res_DownloadMapWAD (FileName
: AnsiString
; const mapHash
: TMD5Digest
): AnsiString
;
359 tf
: TNetFileTransfer
;
360 resList
: array of TNetMapResourceInfo
= nil;
366 mapdbUpdated
: Boolean = false;
367 resdbUpdated
: Boolean = false;
368 transStarted
: Boolean;
369 destMapDir
: AnsiString
= '';
370 destResDir
: AnsiString
= '';
373 clearReplacementWads();
374 sfsGCCollect(); // why not?
375 g_Res_CreateDatabases();
376 FileName
:= ExtractFileName(FileName
);
377 if (length(FileName
) = 0) then FileName
:= '__untitled__.wad';
380 g_Res_received_map_start
:= 1;
381 g_Console_Add(Format(_lc
[I_NET_MAP_DL
], [FileName
]));
382 e_LogWritefln('Downloading map [%s] from server...', [FileName
], TMsgType
.Notify
);
383 g_Game_SetLoadingText(FileName
+ '...', 0, False);
385 // this also sends map request
386 res
:= g_Net_Wait_MapInfo(tf
, resList
);
387 if (res
<> 0) then exit
;
389 // find or download a map
390 result
:= findExistingMapWadWithHash(tf
.diskName
, mapHash
);
391 if (length(result
) = 0) then
394 res
:= g_Net_RequestResFileInfo(-1{map}, tf
);
397 e_LogWriteln('error requesting map wad');
402 destMapDir
:= e_GetWriteableDir(MapDownloadDirs
, false); // not required
405 if (length(destMapDir
) = 0) then
407 e_LogWriteln('cannot create map download directory', TMsgType
.Fatal
);
411 fname
:= destMapDir
+'/'+generateFileName(FileName
, mapHash
);
412 tf
.diskName
:= fname
;
413 e_LogWritefln('map disk file for `%s` is `%s`', [FileName
, fname
], TMsgType
.Fatal
);
415 strm
:= openDiskFileRW(fname
);
417 e_WriteLog('cannot create map file `'+fname
+'`', TMsgType
.Fatal
);
422 res
:= g_Net_ReceiveResourceFile(-1{map}, tf
, strm
);
424 e_WriteLog('error downloading map file (exception) `'+FileName
+'`', TMsgType
.Fatal
);
432 e_LogWritefln('error downloading map `%s` (res=%d)', [FileName
, res
], TMsgType
.Fatal
);
436 // if it was resumed, check md5 and initiate full download if necessary
439 md5
:= MD5File(fname
);
440 // sorry for pasta, i am asshole
441 if not MD5Match(md5
, tf
.hash
) then
443 e_LogWritefln('resuming failed; downloading map `%s` from scratch...', [fname
]);
446 strm
:= createDiskFile(fname
);
448 e_WriteLog('cannot create map file `'+fname
+'` (exception)', TMsgType
.Fatal
);
453 res
:= g_Net_ReceiveResourceFile(-1{map}, tf
, strm
);
455 e_WriteLog('error downloading map file `'+FileName
+'`', TMsgType
.Fatal
);
463 e_LogWritefln('error downloading map `%s` (res=%d)', [FileName
, res
], TMsgType
.Fatal
);
469 if (knownMaps
.addWithHash(fname
, mapHash
)) then mapdbUpdated
:= true;
473 // download resources
474 for f
:= 0 to High(resList
) do
476 // if we got a new-style reslist packet, use received data to check for resource files
477 if (resList
[f
].size
< 0) then
480 transStarted
:= true;
481 res
:= g_Net_RequestResFileInfo(f
, tf
);
482 if (res
<> 0) then begin result
:= ''; exit
; end;
487 transStarted
:= false;
488 tf
.diskName
:= resList
[f
].wadName
;
489 tf
.hash
:= resList
[f
].hash
;
490 tf
.size
:= resList
[f
].size
;
492 if (isIgnoredResWad(tf
.diskName
)) then
494 // ignored file, abort download
495 if (transStarted
) then g_Net_AbortResTransfer(tf
);
496 e_LogWritefln('ignoring wad resource `%s` by user request', [tf
.diskName
]);
499 wadname
:= findExistingResWadWithHash(tf
.diskName
, tf
.hash
);
500 if (length(wadname
) <> 0) then
503 if (transStarted
) then g_Net_AbortResTransfer(tf
);
504 addReplacementWad(tf
.diskName
, wadname
);
508 if (not transStarted
) then
510 res
:= g_Net_RequestResFileInfo(f
, tf
);
511 if (res
<> 0) then begin result
:= ''; exit
; end;
514 destResDir
:= e_GetWriteableDir(WadDownloadDirs
, false); // not required
517 if (length(destResDir
) = 0) then
519 e_LogWriteln('cannot create wad download directory', TMsgType
.Fatal
);
523 fname
:= destResDir
+'/'+generateFileName(tf
.diskName
, tf
.hash
);
524 e_LogWritefln('downloading resource `%s` to `%s`...', [tf
.diskName
, fname
]);
526 strm
:= openDiskFileRW(fname
);
528 e_WriteLog('cannot create resource file `'+fname
+'`', TMsgType
.Fatal
);
533 res
:= g_Net_ReceiveResourceFile(f
, tf
, strm
);
535 e_WriteLog('error downloading map file `'+FileName
+'`', TMsgType
.Fatal
);
543 e_WriteLog('error downloading map file `'+FileName
+'`', TMsgType
.Fatal
);
547 // if it was resumed, check md5 and initiate full download if necessary
550 md5
:= MD5File(fname
);
551 // sorry for pasta, i am asshole
552 if not MD5Match(md5
, tf
.hash
) then
554 e_LogWritefln('resuming failed; downloading resource `%s` to `%s` from scratch...', [tf
.diskName
, fname
]);
557 strm
:= createDiskFile(fname
);
559 e_WriteLog('cannot create resource file `'+fname
+'`', TMsgType
.Fatal
);
564 res
:= g_Net_ReceiveResourceFile(f
, tf
, strm
);
566 e_WriteLog('error downloading map file `'+FileName
+'`', TMsgType
.Fatal
);
574 e_WriteLog('error downloading map file `'+FileName
+'`', TMsgType
.Fatal
);
580 addReplacementWad(tf
.diskName
, fname
);
581 if (knownRes
.addWithHash(fname
, tf
.hash
)) then resdbUpdated
:= true;
585 SetLength(resList
, 0);
586 g_Res_received_map_start
:= 0;
589 if saveDBsToDiskEnabled
and (mapdbUpdated
or resdbUpdated
) then saveDatabases(mapdbUpdated
, resdbUpdated
);
594 conRegVar('rdl_ignore_names', @g_res_ignore_names
, 'list of resource wad names (without extensions) to ignore in dl hash checks', 'dl ignore wads');
595 conRegVar('rdl_ignore_enabled', @g_res_ignore_enabled
, 'enable dl hash check ignore list', 'dl hash check ignore list active');
596 conRegVar('rdl_hashdb_save_enabled', @g_res_save_databases
, 'enable saving map/resource hash databases to disk', 'controls storing hash databases to disk');