DEADSOFTWARE

game: `e_GetDir()` -> `e_GetWriteableDir()`, with slight changes in logic
authorKetmar Dark <ketmar@ketmar.no-ip.org>
Sun, 20 Oct 2019 21:49:53 +0000 (00:49 +0300)
committerKetmar Dark <ketmar@ketmar.no-ip.org>
Sun, 20 Oct 2019 21:50:05 +0000 (00:50 +0300)
src/engine/e_res.pas
src/game/g_console.pas
src/game/g_game.pas
src/game/g_main.pas
src/game/g_menu.pas
src/game/g_net.pas
src/shared/hashtable.pas

index e5d47567b3c167cfaf4f792b0b8de647539c3a4e..e2f888955076063cf022a58d1c3bda40b2be01ce 100644 (file)
@@ -54,16 +54,22 @@ interface
   {--- same as SysUtils.FinFirst ---}
   function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
 
-  {--- try to create directory from list, throws if no one directory created ---}
-  function e_GetDir (dirs: SSArray): AnsiString;
+  {--- try to get a writeable directory from list, throws if no one directory created ---}
+  {--- (unless `required` is `false`: in this case, returns empty string) ---}
+  {--- creates all necessary subdirs, if it can ---}
+  function e_GetWriteableDir (dirs: SSArray; required: Boolean=true): AnsiString;
 
 implementation
 
-  uses WadReader, e_log;
+  uses WadReader, e_log, hashtable;
 
   type
     SpawnProc = function (pathname: AnsiString): Tstream;
 
+  var
+    writeableDirs: THashStrCIStr = nil;
+
+
   function e_UpperDir (path: AnsiString): AnsiString;
     var i: Integer;
   begin
@@ -214,7 +220,7 @@ implementation
   begin
     if debug_e_res then
       e_LogWritefln('e_GetResourcePath0 %s (%s)', [path, defWad]);
-    assert(dirs <> nil);
+    assert(length(dirs) > 0);
     assert(path <> '');
     assert(defWad <> '');
     diskName := g_ExtractWadName(path);
@@ -244,16 +250,78 @@ implementation
     end
   end;
 
-  function e_GetDir (dirs: SSArray): AnsiString;
-    var i: Integer;
+  // k8: sorry. i know that this sux, but checking directory access rights is unreliable (unportable).
+  function canCreateFiles (dir: AnsiString): Boolean;
+  var
+    f: Integer;
+    st: TStream = nil;
+    sr: TSearchRec;
+    fn: AnsiString;
+  begin
+    result := false;
+    for f := 0 to $7fffffff do
+    begin
+      fn := Format('%s/$$$temptest$$$_%d.$$$%d$$$', [dir, f, f]);
+      if (FindFirst(fn, faAnyFile, sr) = 0) then
+      begin
+        FindClose(sr);
+        continue;
+      end;
+      FindClose(sr);
+      try
+        st := TFileStream.Create(fn, fmCreate);
+      except // sorry
+        st := nil; // just in case
+      end;
+      if assigned(st) then
+      begin
+        st.Free();
+        try DeleteFile(fn); except end;
+        result := true;
+      end;
+      exit;
+    end;
+  end;
+
+  function e_GetWriteableDir (dirs: SSArray; required: Boolean=true): AnsiString;
+  var
+    f: Integer;
   begin
+    assert(length(dirs) > 0);
+    result := '';
+    if assigned(writeableDirs) then
+    begin
+      for f := High(dirs) downto Low(dirs) do
+      begin
+        if (writeableDirs.get(dirs[f], result)) then
+        begin
+          //writeln('*** KNOWN WRITEABLE DIR: "', result, '"');
+          exit;
+        end;
+      end;
+    end;
+    for f := High(dirs) downto Low(dirs) do
+    begin
+      try
+        if ForceDirectories(dirs[f]) then
+        begin
+          result := dirs[f];
+          if (findFileCI(result, true)) then
+          begin
+            if canCreateFiles(result) then
+            begin
+              if not assigned(writeableDirs) then writeableDirs := THashStrCIStr.Create();
+              writeableDirs.put(dirs[f], result);
+              //writeln('*** NEW WRITEABLE DIR: "', result, '" ("', dirs[f], '"); rq=', required);
+              exit;
+            end;
+          end;
+        end;
+      except // sorry
+      end;
+    end;
+    if required then raise Exception.Create(Format('unable to create directory "%s"', [dirs[High(dirs)]]));
     result := '';
-    i := High(dirs);
-    while (i >= 0) and (ForceDirectories(dirs[i]) = false) do Dec(i);
-    if i >= 0 then
-      result := dirs[i]
-    else
-      raise Exception.Create('unable to create directory')
   end;
 
 end.
index 6b8ddc82c2538e53156457e687d7e2a0fa1ae1c5..fb76d519dfcef27660f37db6336f21f7fef7029c 100644 (file)
@@ -594,7 +594,7 @@ begin
     // writeconfig <filename>
     if Length(p) = 2 then
     begin
-      s := e_GetDir(ConfigDirs);
+      s := e_GetWriteableDir(ConfigDirs);
       g_Console_WriteConfig(e_CatPath(s, p[1]))
     end
     else
@@ -1965,7 +1965,7 @@ procedure g_Console_WriteGameConfig;
 begin
   if gParsingBinds = false then
   begin
-    s := e_GetDir(ConfigDirs);
+    s := e_GetWriteableDir(ConfigDirs);
     g_Console_WriteConfig(e_CatPath(s, configScript))
   end
 end;
index 4fd60574821c735e0e057cf05dbfe67e00812e9c..80f53ccc05e25ea145ac322c15bdc4898ff3d935 100644 (file)
@@ -4784,7 +4784,7 @@ end;
 procedure g_Game_SaveOptions;
   var s: AnsiString;
 begin
-  s := e_GetDir(ConfigDirs);
+  s := e_GetWriteableDir(ConfigDirs);
   if s <> '' then
     g_Options_Write_Video(s + '/' + CONFIG_FILENAME)
   else
@@ -5473,7 +5473,7 @@ begin
     if (Length(P) > 1) then
       NetInterpLevel := StrToIntDef(P[1], NetInterpLevel);
     g_Console_Add('net_interp = ' + IntToStr(NetInterpLevel));
-    s := e_GetDir(ConfigDirs);
+    s := e_GetWriteableDir(ConfigDirs);
     if s <> '' then
     begin
       config := TConfig.CreateFile(s + '/' + CONFIG_FILENAME);
@@ -5492,7 +5492,7 @@ begin
     else
       g_Console_Add('net_forceplayerupdate = 0');
 
-    s := e_GetDir(ConfigDirs);
+    s := e_GetWriteableDir(ConfigDirs);
     if s <> '' then
     begin
       config := TConfig.CreateFile(s + '/' + CONFIG_FILENAME);
@@ -5512,7 +5512,7 @@ begin
     else
       g_Console_Add('net_predictself = 0');
 
-    s := e_GetDir(ConfigDirs);
+    s := e_GetWriteableDir(ConfigDirs);
     if s <> '' then
     begin
       config := TConfig.CreateFile(s + '/' + CONFIG_FILENAME);
index 24dac52e2e76556c340db9ddd3595c1ec67d1370..b0648049143f24291d0b00ea063294c3b5a4df70 100644 (file)
@@ -29,7 +29,7 @@ procedure CharPress (C: AnsiChar);
 
 var
   {--- TO REMOVE ---}
-  GameDir: string; 
+  GameDir: string;
   {-----------------}
 
   {--- Read-only dirs ---}
@@ -148,14 +148,14 @@ begin
 
   if LogFileName = '' then
   begin
-    rwdir := e_GetDir(LogDirs);
+    rwdir := e_GetWriteableDir(LogDirs, false);
     if rwdir <> '' then
     begin
       {$IFDEF HEADLESS}
         LogFileName := e_CatPath(rwdir, 'Doom2DF_H.log');
       {$ELSE}
         LogFileName := e_Catpath(rwdir, 'Doom2DF.log');
-      {$ENDIF}      
+      {$ENDIF}
     end
   end
 end;
index 53a1cbc6bae3cca965e73a2c6dfdd3ea144ccca3..d808bf3bdc446bef705d698b86ea094b74892a6d 100644 (file)
@@ -375,7 +375,7 @@ begin
 
   if g_Game_IsClient then MC_SEND_PlayerSettings;
 
-  s := e_GetDir(ConfigDirs);
+  s := e_GetWriteableDir(ConfigDirs);
   if s <> '' then
     g_Options_Write(s + '/' + CONFIG_FILENAME);
   g_Console_WriteGameConfig;
@@ -699,7 +699,7 @@ begin
     gcMap := Map;
   end;
 
-  s := e_GetDir(ConfigDirs);
+  s := e_GetWriteableDir(ConfigDirs);
   if s <> '' then
     g_Options_Write_Gameplay_Custom(s + '/' + CONFIG_FILENAME);
 
@@ -768,7 +768,7 @@ begin
     NetUseMaster := TGUISwitch(GetControl('swUseMaster')).ItemIndex = 0;
   end;
 
-  s := e_GetDir(ConfigDirs);
+  s := e_GetWriteableDir(ConfigDirs);
   if s <> '' then
   begin
     g_Options_Write_Net_Server(s + '/' + CONFIG_FILENAME);
@@ -791,7 +791,7 @@ begin
     PW := TGUIEdit(GetControl('edPW')).Text;
   end;
 
-  s := e_GetDir(ConfigDirs);
+  s := e_GetWriteableDir(ConfigDirs);
   if s <> '' then
     g_Options_Write_Net_Client(s + '/' + CONFIG_FILENAME);
   g_Game_StartClient(NetClientIP, NetClientPort, PW);
@@ -809,7 +809,7 @@ begin
     PW := TGUIEdit(GetControl('edPW')).Text;
   end;
 
-  s := e_GetDir(ConfigDirs);
+  s := e_GetWriteableDir(ConfigDirs);
   if s <> '' then
     g_Options_Write_Net_Client(s + '/' + CONFIG_FILENAME);
   g_Game_StartClient(NetClientIP, NetClientPort, PW);
@@ -1661,7 +1661,7 @@ begin
     gLanguageChange := True;
     gAskLanguage := False;
 
-    s := e_GetDir(ConfigDirs);
+    s := e_GetWriteableDir(ConfigDirs);
     if s <> '' then
       g_Options_Write_Language(s + '/' + CONFIG_FILENAME);
 
@@ -1679,7 +1679,7 @@ begin
     gLanguageChange := True;
     gAskLanguage := False;
 
-    s := e_GetDir(ConfigDirs);
+    s := e_GetWriteableDir(ConfigDirs);
     if s <> '' then
       g_Options_Write_Language(s + '/' + CONFIG_FILENAME);
 
@@ -1925,7 +1925,7 @@ begin
   gLanguageChange := True;
   gAskLanguage := False;
 
-  s := e_GetDir(ConfigDirs);
+  s := e_GetWriteableDir(ConfigDirs);
   if s <> '' then
     g_Options_Write_Language(s + '/' + CONFIG_FILENAME)
 end;
@@ -1937,7 +1937,7 @@ begin
   gLanguageChange := True;
   gAskLanguage := False;
 
-  s := e_GetDir(ConfigDirs);
+  s := e_GetWriteableDir(ConfigDirs);
   if s <> '' then
     g_Options_Write_Language(s + '/' + CONFIG_FILENAME)
 end;
index 6b3c8f7d174a33ce9e5eff10830391917c2a4f0d..099ab76f4f248319c002751bd5d6f864a5c98c8b 100644 (file)
@@ -2189,7 +2189,7 @@ var
   I: Integer;
   path: AnsiString;
 begin
-  path := e_GetDir(DataDirs);
+  path := e_GetWriteableDir(DataDirs);
   if path <> '' then
   begin
     path := e_CatPath(path, BANLIST_FILENAME);
index ec7f54ba85a1b6d86ff9be43b1c63e842fcb7e99..cb6d35c0f8c684b58320c369907b9a3141e1d664 100644 (file)
@@ -204,9 +204,12 @@ type
 type
   THashIntInt = specialize THashBase<Integer, Integer, THashKeyInt>;
   THashStrInt = specialize THashBase<AnsiString, Integer, THashKeyStr>;
+  THashStrCIInt = specialize THashBase<AnsiString, Integer, THashKeyStrAnsiCI>;
   THashIntStr = specialize THashBase<Integer, AnsiString, THashKeyInt>;
   THashStrStr = specialize THashBase<AnsiString, AnsiString, THashKeyStr>;
+  THashStrCIStr = specialize THashBase<AnsiString, AnsiString, THashKeyStrAnsiCI>;
   THashStrVariant = specialize THashBase<AnsiString, Variant, THashKeyStr>;
+  THashStrCIVariant = specialize THashBase<AnsiString, Variant, THashKeyStrAnsiCI>;
 
 
 function u32Hash (a: LongWord): LongWord; inline;