DEADSOFTWARE

cleanup: remove g_main.pas
[d2df-sdl.git] / 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;
18 interface
20 uses sysutils, Classes, md5, g_net, g_netmsg, g_console, 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);
36 implementation
38 uses g_language, sfs, utils, wadreader, g_game, hashtable, fhashdb, e_res, g_options;
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
52 //==========================================================================
53 //
54 // saveDatabases
55 //
56 //==========================================================================
57 procedure saveDatabases (saveMap, saveRes: Boolean);
58 var
59 err: Boolean;
60 st: TStream;
61 ccdir: AnsiString = '';
62 begin
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;
66 // rescan dirs
67 // save map database
68 if (saveMap) then
69 begin
70 err := true;
71 st := nil;
72 try
73 st := createDiskFile(ccdir+'/maphash.db');
74 knownMaps.saveTo(st);
75 err := false;
76 except
77 end;
78 st.Free;
79 if (err) then begin saveDBsToDiskEnabled := false; e_LogWriteln('cannot write map database, disk refresh disabled'); exit; end;
80 end;
81 // save resource database
82 if (saveRes) then
83 begin
84 err := true;
85 st := nil;
86 try
87 st := createDiskFile(ccdir+'/reshash.db');
88 knownRes.saveTo(st);
89 err := false;
90 except
91 end;
92 st.Free;
93 if (err) then begin saveDBsToDiskEnabled := false; e_LogWriteln('cannot write resource database, disk refresh disabled'); exit; end;
94 end;
95 end;
98 //==========================================================================
99 //
100 // g_Res_CreateDatabases
101 //
102 //==========================================================================
103 procedure g_Res_CreateDatabases (allowRescan: Boolean=false);
104 var
105 st: TStream;
106 upmap: Boolean;
107 upres: Boolean;
108 forcesave: Boolean;
109 ccdir: AnsiString = '';
110 begin
111 if not assigned(knownMaps) then
112 begin
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;
119 // load map database
120 st := nil;
121 try
122 ccdir := e_GetWriteableDir(CacheDirs, false);
123 if (length(ccdir) > 0) then
124 begin
125 st := openDiskFileRO(ccdir+'/maphash.db');
126 knownMaps.loadFrom(st);
127 e_LogWriteln('loaded map database');
128 end;
129 except
130 end;
131 st.Free;
132 // load resource database
133 st := nil;
134 try
135 if (length(ccdir) > 0) then
136 begin
137 st := openDiskFileRO(ccdir+'/reshash.db');
138 knownRes.loadFrom(st);
139 e_LogWriteln('loaded resource database');
140 end;
141 except
142 end;
143 st.Free;
144 forcesave := true;
145 end
146 else
147 begin
148 if (not allowRescan) then exit;
149 forcesave := false;
150 end;
151 // rescan dirs
152 e_LogWriteln('refreshing map database');
153 upmap := knownMaps.scanFiles();
154 e_LogWriteln('refreshing resource database');
155 upres := knownRes.scanFiles();
156 // save databases
157 if (forcesave) then begin upmap := true; upres := true; end;
158 if upmap or upres then saveDatabases(upmap, upres);
159 end;
162 //==========================================================================
163 //
164 // getWord
165 //
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
170 //
171 //==========================================================================
172 function getWord (var list: AnsiString): AnsiString;
173 var
174 pos: Integer;
175 begin
176 result := '';
177 while (length(list) > 0) do
178 begin
179 if (ord(list[1]) <= 32) or (list[1] = ';') or (list[1] = ':') then begin Delete(list, 1, 1); continue; end;
180 pos := 1;
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;
186 end;
187 end;
190 //==========================================================================
191 //
192 // isIgnoredResWad
193 //
194 // checks if the given resource wad can be ignored
195 //
196 // FIXME: preparse name list?
197 //
198 //==========================================================================
199 function isIgnoredResWad (fname: AnsiString): Boolean;
200 var
201 list: AnsiString;
202 name: AnsiString;
203 begin
204 result := false;
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
210 begin
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);
215 end;
216 end;
219 //==========================================================================
220 //
221 // clearReplacementWads
222 //
223 // call this before downloading a new map from a server
224 //
225 //==========================================================================
226 procedure clearReplacementWads ();
227 begin
228 if assigned(replacements) then replacements.clear();
229 e_LogWriteln('cleared replacement wads');
230 end;
233 //==========================================================================
234 //
235 // addReplacementWad
236 //
237 // register new replacement wad
238 //
239 //==========================================================================
240 procedure addReplacementWad (oldname: AnsiString; newDiskName: AnsiString);
241 begin
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);
245 end;
248 //==========================================================================
249 //
250 // g_Res_FindReplacementWad
251 //
252 // returns original name, or replacement name
253 //
254 //==========================================================================
255 function g_Res_FindReplacementWad (oldname: AnsiString): AnsiString;
256 var
257 fn: AnsiString;
258 begin
259 //e_LogWritefln('LOOKING for replacement wad for [%s]...', [oldname], TMsgType.Notify);
260 result := oldname;
261 if not assigned(replacements) then exit;
262 if (replacements.get(toLowerCase1251(ExtractFileName(oldname)), fn)) then
263 begin
264 //e_LogWritefln('found replacement wad for [%s] -> [%s]', [oldname, fn], TMsgType.Notify);
265 result := fn;
266 end;
267 end;
270 //==========================================================================
271 //
272 // findExistingMapWadWithHash
273 //
274 // find map or resource wad using its base name and hash
275 //
276 // returns found wad disk name, or empty string
277 //
278 //==========================================================================
279 function findExistingMapWadWithHash (fname: AnsiString; const resMd5: TMD5Digest): AnsiString;
280 begin
281 result := knownMaps.findByHash(resMd5);
282 if (length(result) > 0) then
283 begin
284 //result := GameDir+'/maps/'+result;
285 if not FileExists(result) then
286 begin
287 if (knownMaps.scanFiles()) then saveDatabases(true, false);
288 result := '';
289 end;
290 end;
291 end;
294 //==========================================================================
295 //
296 // findExistingResWadWithHash
297 //
298 // find map or resource wad using its base name and hash
299 //
300 // returns found wad disk name, or empty string
301 //
302 //==========================================================================
303 function findExistingResWadWithHash (fname: AnsiString; const resMd5: TMD5Digest): AnsiString;
304 begin
305 result := knownRes.findByHash(resMd5);
306 if (length(result) > 0) then
307 begin
308 //result := GameDir+'/wads/'+result;
309 if not FileExists(result) then
310 begin
311 if (knownRes.scanFiles()) then saveDatabases(false, true);
312 result := '';
313 end;
314 end;
315 end;
318 //==========================================================================
319 //
320 // generateFileName
321 //
322 // generate new file name based on the given one and the hash
323 // you can pass files with pathes here too
324 //
325 //==========================================================================
326 function generateFileName (fname: AnsiString; const hash: TMD5Digest): AnsiString;
327 var
328 mds: AnsiString;
329 path: AnsiString;
330 base: AnsiString;
331 ext: AnsiString;
332 begin
333 mds := MD5Print(hash);
334 if (length(mds) > 16) then mds := Copy(mds, 1, 16);
335 mds := '_'+mds;
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;
343 end;
346 //==========================================================================
347 //
348 // g_Res_DownloadMapWAD
349 //
350 // download map wad from server (if necessary)
351 // download all required map resource wads too
352 // registers all required replacement wads
353 //
354 // returns name of the map wad (relative to mapdir), or empty string on error
355 //
356 //==========================================================================
357 function g_Res_DownloadMapWAD (FileName: AnsiString; const mapHash: TMD5Digest): AnsiString;
358 var
359 tf: TNetFileTransfer;
360 resList: array of TNetMapResourceInfo = nil;
361 f, res: Integer;
362 strm: TStream;
363 fname: AnsiString;
364 wadname: AnsiString;
365 md5: TMD5Digest;
366 mapdbUpdated: Boolean = false;
367 resdbUpdated: Boolean = false;
368 transStarted: Boolean;
369 destMapDir: AnsiString = '';
370 destResDir: AnsiString = '';
371 begin
372 result := '';
373 clearReplacementWads();
374 sfsGCCollect(); // why not?
375 g_Res_CreateDatabases();
376 FileName := ExtractFileName(FileName);
377 if (length(FileName) = 0) then FileName := '__unititled__.wad';
379 try
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
392 begin
393 // download map
394 res := g_Net_RequestResFileInfo(-1{map}, tf);
395 if (res <> 0) then
396 begin
397 e_LogWriteln('error requesting map wad');
398 result := '';
399 exit;
400 end;
401 try
402 destMapDir := e_GetWriteableDir(MapDownloadDirs, false); // not required
403 except
404 end;
405 if (length(destMapDir) = 0) then
406 begin
407 e_LogWriteln('cannot create map download directory', TMsgType.Fatal);
408 result := '';
409 exit;
410 end;
411 fname := destMapDir+'/'+generateFileName(FileName, mapHash);
412 tf.diskName := fname;
413 e_LogWritefln('map disk file for `%s` is `%s`', [FileName, fname], TMsgType.Fatal);
414 try
415 strm := openDiskFileRW(fname);
416 except
417 e_WriteLog('cannot create map file `'+fname+'`', TMsgType.Fatal);
418 result := '';
419 exit;
420 end;
421 try
422 res := g_Net_ReceiveResourceFile(-1{map}, tf, strm);
423 except
424 e_WriteLog('error downloading map file (exception) `'+FileName+'`', TMsgType.Fatal);
425 strm.Free;
426 result := '';
427 exit;
428 end;
429 strm.Free;
430 if (res <> 0) then
431 begin
432 e_LogWritefln('error downloading map `%s` (res=%d)', [FileName, res], TMsgType.Fatal);
433 result := '';
434 exit;
435 end;
436 // if it was resumed, check md5 and initiate full download if necessary
437 if tf.resumed then
438 begin
439 md5 := MD5File(fname);
440 // sorry for pasta, i am asshole
441 if not MD5Match(md5, tf.hash) then
442 begin
443 e_LogWritefln('resuming failed; downloading map `%s` from scratch...', [fname]);
444 try
445 DeleteFile(fname);
446 strm := createDiskFile(fname);
447 except
448 e_WriteLog('cannot create map file `'+fname+'` (exception)', TMsgType.Fatal);
449 result := '';
450 exit;
451 end;
452 try
453 res := g_Net_ReceiveResourceFile(-1{map}, tf, strm);
454 except
455 e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
456 strm.Free;
457 result := '';
458 exit;
459 end;
460 strm.Free;
461 if (res <> 0) then
462 begin
463 e_LogWritefln('error downloading map `%s` (res=%d)', [FileName, res], TMsgType.Fatal);
464 result := '';
465 exit;
466 end;
467 end;
468 end;
469 if (knownMaps.addWithHash(fname, mapHash)) then mapdbUpdated := true;
470 result := fname;
471 end;
473 // download resources
474 for f := 0 to High(resList) do
475 begin
476 // if we got a new-style reslist packet, use received data to check for resource files
477 if (resList[f].size < 0) then
478 begin
479 // old-style packet
480 transStarted := true;
481 res := g_Net_RequestResFileInfo(f, tf);
482 if (res <> 0) then begin result := ''; exit; end;
483 end
484 else
485 begin
486 // new-style packet
487 transStarted := false;
488 tf.diskName := resList[f].wadName;
489 tf.hash := resList[f].hash;
490 tf.size := resList[f].size;
491 end;
492 if (isIgnoredResWad(tf.diskName)) then
493 begin
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]);
497 continue;
498 end;
499 wadname := findExistingResWadWithHash(tf.diskName, tf.hash);
500 if (length(wadname) <> 0) then
501 begin
502 // already here
503 if (transStarted) then g_Net_AbortResTransfer(tf);
504 addReplacementWad(tf.diskName, wadname);
505 end
506 else
507 begin
508 if (not transStarted) then
509 begin
510 res := g_Net_RequestResFileInfo(f, tf);
511 if (res <> 0) then begin result := ''; exit; end;
512 end;
513 try
514 destResDir := e_GetWriteableDir(WadDownloadDirs, false); // not required
515 except
516 end;
517 if (length(destResDir) = 0) then
518 begin
519 e_LogWriteln('cannot create wad download directory', TMsgType.Fatal);
520 result := '';
521 exit;
522 end;
523 fname := destResDir+'/'+generateFileName(tf.diskName, tf.hash);
524 e_LogWritefln('downloading resource `%s` to `%s`...', [tf.diskName, fname]);
525 try
526 strm := openDiskFileRW(fname);
527 except
528 e_WriteLog('cannot create resource file `'+fname+'`', TMsgType.Fatal);
529 result := '';
530 exit;
531 end;
532 try
533 res := g_Net_ReceiveResourceFile(f, tf, strm);
534 except
535 e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
536 strm.Free;
537 result := '';
538 exit;
539 end;
540 strm.Free;
541 if (res <> 0) then
542 begin
543 e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
544 result := '';
545 exit;
546 end;
547 // if it was resumed, check md5 and initiate full download if necessary
548 if tf.resumed then
549 begin
550 md5 := MD5File(fname);
551 // sorry for pasta, i am asshole
552 if not MD5Match(md5, tf.hash) then
553 begin
554 e_LogWritefln('resuming failed; downloading resource `%s` to `%s` from scratch...', [tf.diskName, fname]);
555 try
556 DeleteFile(fname);
557 strm := createDiskFile(fname);
558 except
559 e_WriteLog('cannot create resource file `'+fname+'`', TMsgType.Fatal);
560 result := '';
561 exit;
562 end;
563 try
564 res := g_Net_ReceiveResourceFile(f, tf, strm);
565 except
566 e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
567 strm.Free;
568 result := '';
569 exit;
570 end;
571 strm.Free;
572 if (res <> 0) then
573 begin
574 e_WriteLog('error downloading map file `'+FileName+'`', TMsgType.Fatal);
575 result := '';
576 exit;
577 end;
578 end;
579 end;
580 addReplacementWad(tf.diskName, fname);
581 if (knownRes.addWithHash(fname, tf.hash)) then resdbUpdated := true;
582 end;
583 end;
584 finally
585 SetLength(resList, 0);
586 g_Res_received_map_start := 0;
587 end;
589 if saveDBsToDiskEnabled and (mapdbUpdated or resdbUpdated) then saveDatabases(mapdbUpdated, resdbUpdated);
590 end;
593 initialization
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');
597 end.