git_admin/Virtual-File-System
1
0
Fork 0
mirror of https://github.com/CloudDelphi/Virtual-File-System synced 2025-12-19 09:53:54 +01:00
Code Issues Packages Projects Releases Wiki Activity

Fixed bug: MapDir on non-existent directories reported TRUE. Improved generated mappings report

Browse Source
This commit is contained in:
Berserker 2019-05-26 13:51:04 +03:00
parent 7cb8c94406
commit e9ef40a404
4 changed files with 209 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

141
VfsBase.pas
View File

@ -126,6 +126,10 @@ function MapDir (const VirtPath, RealPath: WideString; OverwriteExisting: boolea
(* Calls specified function with a single argument and returns its result. VFS is disabled for current thread during function exection *)
function CallWithoutVfs (Func: TSingleArgExternalFunc; Arg: pointer = nil): integer; stdcall;
(* Returns text with all applied mappings, separated via #13#10. If ShortenPaths is true, common part
of real and virtual paths is stripped *)
function GetMappingsReport: WideString;
(***) implementation (***)
@ -133,12 +137,13 @@ function CallWithoutVfs (Func: TSingleArgExternalFunc; Arg: pointer = nil): inte
type
(* Applied and remembered mapping. Used to refresh or report VFS *)
TMapping = class
Applied: LONGBOOL;
AbsVirtPath: WideString;
AbsRealPath: WideString;
OverwriteExisting: boolean;
OverwriteExisting: LONGBOOL;
Flags: integer;
class function Make (const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): TMapping;
class function Make (Applied: boolean; const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): TMapping;
end;
var
@ -332,9 +337,10 @@ begin
end;
end; // .procedure BuildVfsItemsTree
class function TMapping.Make (const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): {O} TMapping;
class function TMapping.Make (Applied: boolean; const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): {O} TMapping;
begin
result := TMapping.Create;
result.Applied := Applied;
result.AbsVirtPath := AbsVirtPath;
result.AbsRealPath := AbsRealPath;
result.OverwriteExisting := OverwriteExisting;
@ -468,7 +474,8 @@ begin
Dest.EaSize := Src.EaSize;
end;
(* Redirects single file/directory path (not including directory contents). Target must exist for success *)
(* Redirects single file/directory path (not including directory contents). Returns redirected VFS item
for given real path if VFS item was successfully created/overwritten or it already existed and OverwriteExisting = false. *)
function RedirectFile (const AbsVirtPath, AbsRealPath: WideString; {n} FileInfoPtr: WinNative.PFILE_ID_BOTH_DIR_INFORMATION; OverwriteExisting: boolean; Priority: integer): {Un} TVfsItem;
const
WIDE_NULL_CHAR_LEN = Length(#0);
@ -550,7 +557,7 @@ begin
end;
DirVfsItem := RedirectFile(AbsVirtPath, AbsRealPath, FileInfoPtr, OverwriteExisting, Priority);
Success := DirVfsItem <> nil;
Success := (DirVfsItem <> nil) and ((DirVfsItem.RealPath = AbsRealPath) or VfsUtils.IsDir(AbsRealPath));
if Success then begin
VirtPathPrefix := AddBackslash(AbsVirtPath);
@ -599,8 +606,8 @@ begin
result := (AbsVirtPath <> '') and (AbsRealPath <> '');
if result then begin
Mappings.Add(TMapping.Make(AbsVirtPath, AbsRealPath, OverwriteExisting, Flags));
result := _MapDir(AbsVirtPath, AbsRealPath, nil, OverwriteExisting, Flags, AUTO_PRIORITY) <> nil;
Mappings.Add(TMapping.Make(result, AbsVirtPath, AbsRealPath, OverwriteExisting, Flags));
end;
LeaveVfsConfig;
@ -638,7 +645,7 @@ begin
for i := 0 to Mappings.Count - 1 do begin
with TMapping(Mappings[i]) do begin
MapDir(AbsVirtPath, AbsRealPath, OverwriteExisting, Flags);
TMapping(Mappings[i]).Applied := MapDir(AbsVirtPath, AbsRealPath, OverwriteExisting, Flags);
end;
end;
@ -686,6 +693,126 @@ begin
end; // .with
end; // .function RefreshMappedFile
function GetMappingsReport: WideString;
const
COL_PATHS = 0;
COL_META = 1;
var
{O} Buf: StrLib.TStrBuilder;
{O} Line: StrLib.TStrBuilder;
Cols: array [0..1] of array of WideString;
MaxPathColWidth: integer;
i: integer;
procedure WriteMapping (Mapping: TMapping; LineN: integer);
var
StartPathPos: integer;
MaxCommonPathLen: integer;
ShortestPath: WideString;
LongestPath: WideString;
i: integer;
begin
{!} Assert(Mapping <> nil);
StartPathPos := 1;
if Length(Mapping.AbsRealPath) > Length(Mapping.AbsVirtPath) then begin
LongestPath := Mapping.AbsRealPath;
ShortestPath := Mapping.AbsVirtPath;
end else begin
LongestPath := Mapping.AbsVirtPath;
ShortestPath := Mapping.AbsRealPath;
end;
i := 1;
MaxCommonPathLen := Length(ShortestPath);
while (i <= MaxCommonPathLen) and (ShortestPath[i] = LongestPath[i]) do begin
Inc(i);
end;
// Handle case: [xxx\yyy] zzz and [xxx\yyy]. Common part is [xxx]
if (Length(LongestPath) > MaxCommonPathLen) and (LongestPath[i] <> '\') then begin
while (i >= 2) and (LongestPath[i] <> '\') do begin
Dec(i);
end;
end
// Handle case: D:\App <= D:\Mods. Common part is D:
else if ShortestPath[i] = '\' then begin
Dec(i);
end;
StartPathPos := i;
Line.Clear;
if StartPathPos > 1 then begin
Line.AppendWide('$');
end;
Line.AppendWide(Copy(Mapping.AbsVirtPath, StartPathPos));
Line.AppendWide(' <= ');
if StartPathPos > 1 then begin
Line.AppendWide('$');
end;
Line.AppendWide(Copy(Mapping.AbsRealPath, StartPathPos));
if not Mapping.Applied then begin
Line.AppendWide(' *MISS*');
end;
Cols[COL_PATHS][LineN] := Line.BuildWideStr;
MaxPathColWidth := Max(MaxPathColWidth, Length(Cols[COL_PATHS][LineN]));
Line.Clear;
Line.AppendWide('[Overwrite = ' + IntToStr(ord(Mapping.OverwriteExisting)) + ', Flags = ' + IntToStr(Mapping.Flags));
if StartPathPos > 1 then begin
Line.AppendWide(', $ = "' + Copy(ShortestPath, 1, StartPathPos - 1) + '"]');
end else begin
Line.AppendWide(']');
end;
Cols[COL_META][LineN] := Line.BuildWideStr;
end; // .procedure WriteMapping
function FormatResultTable: WideString;
var
i: integer;
begin
for i := 0 to Mappings.Count - 1 do begin
Buf.AppendWide(Cols[COL_PATHS][i] + StringOfChar(WideChar(' '), MaxPathColWidth - Length(Cols[COL_PATHS][i]) + 1));
Buf.AppendWide(Cols[COL_META][i]);
if i < Mappings.Count - 1 then begin
Buf.AppendWide(#13#10);
end;
end;
result := Buf.BuildWideStr;
end;
begin
Buf := StrLib.TStrBuilder.Create;
Line := StrLib.TStrBuilder.Create;
// * * * * * //
SetLength(Cols[COL_PATHS], Mappings.Count);
SetLength(Cols[COL_META], Mappings.Count);
MaxPathColWidth := 0;
for i := 0 to Mappings.Count - 1 do begin
WriteMapping(TMapping(Mappings[i]), i);
end;
result := FormatResultTable;
// * * * * * //
SysUtils.FreeAndNil(Buf);
SysUtils.FreeAndNil(Line);
end; // .function GetMappingsReport
begin
VfsCritSection.Init;
VfsItems := DataLib.NewDict(Utils.OWNS_ITEMS, DataLib.CASE_SENSITIVE);

34
VfsExport.pas
View File

@ -8,6 +8,7 @@ unit VfsExport;
uses
Windows,
Utils,
VfsDebug, VfsBase, VfsControl, VfsWatching;
exports
@ -48,6 +49,36 @@ begin
result := VfsWatching.RunWatcher(WatchDir, DebounceInterval);
end;
(* Frees buffer, that was transfered to client earlier using other VFS API *)
procedure MemFree ({O} Buf: pointer); stdcall;
begin
FreeMem(Buf);
end;
(* Returns text with all applied mappings, separated via #13#10. If ShortenPaths is true, common part
of real and virtual paths is stripped. Call MemFree to release result buffer *)
function GetMappingsReport: {O} PWideChar; stdcall;
var
Res: WideString;
begin
result := nil;
Res := VfsBase.GetMappingsReport;
GetMem(result, (Length(Res) + 1) * sizeof(WideChar));
Utils.CopyMem((Length(Res) + 1) * sizeof(WideChar), PWideChar(Res), result);
end;
function GetMappingsReportA: {O} pchar; stdcall;
var
Res: string;
begin
result := nil;
Res := VfsBase.GetMappingsReport;
GetMem(result, Length(Res) + 1);
Utils.CopyMem(Length(Res) + 1, pchar(Res), result);
end;
procedure ConsoleLoggingProc (Operation, Message: pchar); stdcall;
begin
WriteLn('>> ', string(Operation), ': ', string(Message), #13#10);
@ -88,6 +119,9 @@ exports
MapModsFromList,
MapModsFromListA,
RunWatcher,
GetMappingsReport,
GetMappingsReportA,
MemFree,
InstallConsoleLogger;
end.

9
VfsImport.pas
View File

@ -33,9 +33,18 @@ function RunVfs (DirListingOrder: TDirListingSortType): LONGBOOL; stdcall; exter
time in msec to wait after last change before running full VFS rescanning routine *)
function RunWatcher (const WatchDir: PWideChar; DebounceInterval: integer): LONGBOOL; stdcall; external 'vfs.dll';
(* Frees buffer, that was transfered to client earlier using other VFS API *)
procedure MemFree ({O} Buf: pointer); stdcall; external 'vfs.dll';
(* Returns text with all applied mappings, separated via #13#10. If ShortenPaths is true, common part
of real and virtual paths is stripped. Call MemFree to release result buffer *)
function GetMappingsReport: {O} PWideChar; stdcall; external 'vfs.dll';
function GetMappingsReportA: {O} pchar; stdcall; external 'vfs.dll';
(* Allocates console and install logger, writing messages to console *)
procedure InstallConsoleLogger; stdcall; external 'vfs.dll';
(***) implementation (***)

33
VfsUtils.pas
View File

@ -140,6 +140,12 @@ function StripNtAbsPathPrefix (const Path: WideString): WideString;
(* Saves API result in external variable and returns result as is *)
function SaveAndRet (Res: integer; out ResCopy): integer;
(* Returns attributes for file at given path *)
function GetFileAttrs (const Path: WideString; {out} var Attrs: integer): boolean;
(* Returns true if directory with given path exists *)
function IsDir (const Path: WideString): boolean;
(* Opens file/directory using absolute NT path and returns success flag *)
function SysOpenFile (const NtAbsPath: WideString; {OUT} var Res: Windows.THandle; const OpenMode: TSysOpenFileMode = OPEN_AS_ANY; const AccessMode: ACCESS_MASK = FILE_GENERIC_READ): boolean;
@ -155,6 +161,7 @@ function SysScanDir (const DirPath, Mask: WideString): ISysDirScanner; overload;
tests were run on network drive *)
procedure GetDirectoryListing (const SearchPath, FileMask: WideString; {Un} Exclude: TDict {OF CaselessKey => not NIL}; DirListing: TDirListing);
(***) implementation (***)
@ -478,6 +485,30 @@ begin
result := StrLib.Join(FileNames, #13#10);
end;
function GetFileAttrs (const Path: WideString; {out} var Attrs: integer): boolean;
const
INVALID_FILE_ATTRIBUTES = -1;
var
Res: integer;
begin
Res := integer(Windows.GetFileAttributesW(PWideChar(Path)));
result := Res <> INVALID_FILE_ATTRIBUTES;
if result then begin
Attrs := Res;
end;
end;
function IsDir (const Path: WideString): boolean;
var
FileAttrs: integer;
begin
result := GetFileAttrs(Path, FileAttrs) and Utils.HasFlag(Windows.FILE_ATTRIBUTE_DIRECTORY, FileAttrs);
end;
function SysOpenFile (const NtAbsPath: WideString; {OUT} var Res: Windows.THandle; const OpenMode: TSysOpenFileMode = OPEN_AS_ANY; const AccessMode: ACCESS_MASK = FILE_GENERIC_READ): boolean;
var
FilePathU: WinNative.UNICODE_STRING;
@ -521,7 +552,7 @@ begin
if IsNtRootDriveAbsPath(NtAbsPath) then begin
// Return fake info for root drive
result := SaveAndRet(Windows.GetFileAttributesW(PWideChar(StripNtAbsPathPrefix(NtAbsPath))), FileAllInfo.BasicInformation.FileAttributes) <> integer(Windows.INVALID_HANDLE_VALUE);
result := GetFileAttrs(StripNtAbsPathPrefix(NtAbsPath), integer(FileAllInfo.BasicInformation.FileAttributes));
if result then begin
FillChar(Res.Base, sizeof(Res.Base), 0);