diff --git a/src/engine/e_res.pas b/src/engine/e_res.pas
index a4f9da50bd829c9fc28605d850bd0b60df8e12f7..81f4638beec76d44a80cb8e85987e6926ffeb9ac 100644 (file)
--- a/src/engine/e_res.pas
+++ b/src/engine/e_res.pas
{--- returns relative wad name; never empty string ---}
function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString;
- {--- append dirs to 'path.wad:\file'. if disk is void, append defWad ---}
+ {--- 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 ---}
{--- 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, hashtable;
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;
var diskName, fileName: AnsiString;
begin
if debug_e_res then
- e_LogWritefln('e_GetResourcePath0 %s (%s)', [path, defWad]);
+ 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;
end;
// k8: sorry. i know that this sux, but checking directory access rights is unreliable (unportable).
- function canCreateFiles (dir: AnsiString): Boolean;
+ function e_CanCreateFilesAt (dir: AnsiString): Boolean;
var
f: Integer;
st: TStream = nil;
result := dirs[f];
if (findFileCI(result, true)) then
begin
- if canCreateFiles(result) then
+ if e_CanCreateFilesAt(result) then
begin
if not assigned(writeableDirs) then writeableDirs := THashStrCIStr.Create();
writeableDirs.put(dirs[f], result);