X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fengine%2Fe_res.pas;h=81f4638beec76d44a80cb8e85987e6926ffeb9ac;hb=9ff94bea3b1895005199baf1c85fde8196bf24c7;hp=e5d47567b3c167cfaf4f792b0b8de647539c3a4e;hpb=4ee9edff7adfcf0f2cbd3cf32b1cb1790061fe14;p=d2df-sdl.git

diff --git a/src/engine/e_res.pas b/src/engine/e_res.pas
index e5d4756..81f4638 100644
--- a/src/engine/e_res.pas
+++ b/src/engine/e_res.pas
@@ -48,67 +48,57 @@ interface
   function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean;
   function e_FindWad (dirs: SSArray; name: AnsiString): AnsiString;
 
-  {--- append dirs to 'path.wad:\file'. if disk is void, append defWad ---}
+  {--- returns relative wad name; never empty string ---}
+  function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString;
+
+  {--- prepend dirs to 'disk.wad:\file'. if empty disk string then prepend defWad  ---}
+  {--- return empty string if error occured or 'path/to/disk.wad:\file' on success ---}
   function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString;
 
   {--- 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;
+
+  function e_CanCreateFilesAt (dir: AnsiString): Boolean;
 
 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
-    i := High(path);
+    i := High(path);  // consider possible cases: '\a\', '\a', '\abc\'
     while (i >= 1) and (path[i] <> '/') and (path[i] <> '\') do Dec(i);
-    result := Copy(path, 1, i)
+    result := Copy(path, 1, i-1)  // exclude the trailing separator
   end;
 
-  function HasRelativeDirs (name: AnsiString): Boolean;
-    var i: Integer; ch: Char;
+  function IsRelativePath (name: AnsiString): Boolean;
   begin
-    i := 1;
-    result := false;
-    while (result = false) and (name[i] <> #0) do
-    begin
-      ch := name[i];
-      if (ch = '/') or (ch = '\') then
-      begin
-        Inc(i);
-        if name[i] = '.' then
-        begin
-          Inc(i);
-          if name[i] = '.' then
-          begin
-            Inc(i);
-            ch := name[i];
-            result := (ch = #0) or (ch = '/') or (ch = '\')
-          end
-        end
-      end
-      else
-      begin
-        Inc(i)
-      end
-    end
+    result := (copy(name, 1, 3) = '../') or (pos('/../', name) <> 0) or (copy(name, Length(name) - 2) = '/..') or
+              (copy(name, 1, 3) = '..\') or (pos('\..\', name) <> 0) or (copy(name, Length(name) - 2) = '\..') or
+              (name = '..');
   end;
 
-  function HasAbsoluteDirs (name: AnsiString): Boolean;
+  function IsAbsolutePath (name: AnsiString): Boolean;
   begin
-    result := (name = '') or (name[1] = '/') or (name[1] = '\')
+    result := ExpandFileName(name) = name;
   end;
 
   function e_IsValidResourceName (name: AnsiString): Boolean;
   begin
-    result := (HasAbsoluteDirs(name) = false) and (HasRelativeDirs(name) = false)
+    result := (IsAbsolutePath(name) = false) and (IsRelativePath(name) = false)
   end;
 
   function SpawnStream (dirs: SSArray; name: AnsiString; p: SpawnProc; createNewDir: Boolean): TStream;
@@ -209,19 +199,44 @@ implementation
     end
   end;
 
+  function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString;
+  var
+    s: AnsiString;
+    maxpfx: AnsiString = '';
+    pfx: AnsiString;
+  begin
+    result := name;
+    if not findFileCI(name) then exit;
+    for s in dirs do
+    begin
+      if (length(s) = 0) then continue;
+      if (length(name) <= length(s)) then continue;
+      if (length(s) < length(maxpfx)) then continue;
+      pfx := s;
+      if not findFileCI(pfx, true) then continue;
+      if (pfx[length(pfx)] <> '/') and (pfx[length(pfx)] <> '\') then pfx := pfx+'/';
+      if (length(pfx)+1 > length(name)) then continue;
+      if (strEquCI1251(copy(name, 1, length(pfx)), pfx)) then maxpfx := pfx;
+    end;
+    if (length(maxpfx) > 0) then
+    begin
+      result := name;
+      Delete(result, 1, length(maxpfx));
+    end;
+  end;
+
   function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString;
     var diskName, fileName: AnsiString;
   begin
     if debug_e_res then
-      e_LogWritefln('e_GetResourcePath0 %s (%s)', [path, defWad]);
-    assert(dirs <> nil);
+      e_LogWritefln('e_GetResourcePath %s (%s)', [path, defWad]);
+    assert(length(dirs) > 0);
     assert(path <> '');
     assert(defWad <> '');
     diskName := g_ExtractWadName(path);
     fileName := g_ExtractFilePathName(path);
     if diskName = '' then diskName := defWad else diskName := e_FindWad(dirs, diskName);
-    assert(diskName <> '', 'oh fuck, wad "' + diskName + '" not founded');
-    result := diskName + ':\' + fileName;
+    if diskName = '' then result := '' else result := diskName + ':\' + fileName;
     if debug_e_res then
       e_LogWritefln('  this>>> %s', [result]);
   end;
@@ -244,16 +259,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 e_CanCreateFilesAt (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 e_CanCreateFilesAt(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.