(* Tux Commander - UEngines - Basic engines (abstract, local) Copyright (C) 2007 Tomas Bzatek Check for updates on tuxcmd.sourceforge.net This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) unit UEngines; interface uses glib2, gdk2, Classes, Libc, UGlibC_compat; const ERRException = -1; ERRNoAccess = -2; ERRCreateLink = -3; ERRCopyMove = -4; ERRRemove = -5; ERRMkDIr = -6; omRead = 0; omWrite = 1; omAppend = 2; ConfDefaultDirCreationMask = 755; type PDataItem = ^TDataItem; TDataItem = record FName: PChar; // ANSI FDisplayName: PChar; // always-valid UTF-8 LnkPointTo: PChar; // ANSI ColumnData: array[0..9] of PChar; Size: Int64; UpDir: boolean; Mode, UID, GID: Cardinal; IsDir, IsLnk, IsBlk, IsChr, IsFIFO, IsSock, Selected, IsDotFile: boolean; ModifyTime: TTimeT; Icon: Pointer; ItemColor: PGdkColor; end; PDataItemSL = ^TDataItemSL; TDataItemSL = record Stage1: boolean; FName: PChar; // ANSI FDisplayName: PChar; // always-valid UTF-8 LnkPointTo: PChar; // ANSI ADestination: PChar; Size: Int64; Mode, UID, GID: Cardinal; IsDir, IsLnk, ForceMove, IsOnRO, IsExecutable: boolean; ModifyTime: TTimeT; Level: word; atime, mtime: Int64; end; TEngineProgressFunc = function (Sender: Pointer; BytesDone: Int64): boolean; cdecl; // Return False to break the copy process TEngineErrorFunc = function (Sender: Pointer; ErrorType, ErrorNum: integer; FileName: string): boolean; cdecl; // Return TEngineFileDes = pointer; TPanelEngine = class private BreakProcessingType: integer; public ParentEngine: TPanelEngine; LastHighlightItem, SavePath: string; constructor Create; destructor Destroy; override; // function GetListing(var List: PGSList): integer; virtual; abstract; // Returns errorcode function GetListing(var List: TList; const AddDotFiles: boolean): integer; overload; virtual; abstract; // Returns errorcode function GetListing(var List: TList; const AddDotFiles: boolean; APath: string): integer; overload; virtual; abstract; // Returns errorcode function ChangeDir(const NewPath: string; const ShowProgress: boolean = True): integer; virtual; abstract; // Returns errorcode function ExplicitChDir(const NewPath: string): integer; virtual; abstract; // Returns errorcode function GetFileSystemSize: Int64; overload; virtual; abstract; function GetFileSystemSize(const APath: string): Int64; overload; virtual; abstract; function GetFileSystemFree: Int64; overload; virtual; abstract; function GetFileSystemFree(const APath: string): Int64; overload; virtual; abstract; function MakeDir(const NewDir: string): integer; virtual; abstract; // Returns errorcode function GetDirSize(APath: string): Int64; virtual; abstract; // Returns size or 0 if fails function Remove(APath: string): integer; virtual; abstract; // Returns errorcode procedure FillDirFiles(APath: string; List: TList; ALevel: word); virtual; abstract; function GetFileInfoSL(APath: string): PDataItemSL; virtual; abstract; function FileExists(const FileName: string; const Use_lstat: boolean = False): Boolean; virtual; abstract; function DirectoryExists(const FileName: string; const Use_lstat: boolean = False): Boolean; virtual; abstract; function MakeSymLink(const NewFileName, PointTo: string): integer; virtual; abstract; // Returns errorcode function Chmod(const FileName: string; const Mode: integer): integer; virtual; abstract; // Returns errorcode function Chown(const FileName: string; const UID, GID: integer): integer; virtual; abstract; // Returns errorcode procedure BreakProcessing(ProcessingKind: integer); virtual; abstract; // 1 = GetDirSize, 2 = GetListing function RenameFile(SourceFile, DestFile: string): integer; virtual; abstract; // Returns errorcode function ChangeTimes(APath: string; mtime, atime: Int64): integer; virtual; abstract; // Returns errorcode procedure GetFileSystemInfo(const APath: string; var FSSize, FSFree: Int64; var FSName: string); virtual; abstract; function OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; virtual; abstract; // Returns filedescriptor function ReadFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; ABlockSize: integer; var Error: integer): integer; virtual; abstract; // Returns number of bytes read function WriteFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; BytesCount: integer; var Error: integer): integer; virtual; abstract; // Returns number of bytes written function CloseFile(const FileDescriptor: TEngineFileDes): integer; virtual; abstract; // Returns errorcode function FileSeek(const FileDescriptor: TEngineFileDes; const AbsoluteOffset: Int64; var Error: integer): Int64; virtual; abstract; // Returns errorcode function IsOnROMedium(const FileName: string): boolean; virtual; abstract; function FileCanRun(const FileName: string): boolean; virtual; abstract; function GetPath: string; virtual; abstract; procedure SetPath(Value: string); virtual; abstract; function GetPrefix: string; virtual; abstract; function Login(Username, Password: string): integer; virtual; abstract; // Copy-related routines function GetBlockSize: guint32; virtual; abstract; procedure SetBlockSize(Value: guint32); virtual; abstract; function CopyFileIn(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; virtual; abstract; // returns True if file is successfully copied function CopyFileOut(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; virtual; abstract; // returns True if file is successfully copied function IsOnSameFS(const Path1, Path2: string): boolean; virtual; abstract; function TwoSameFiles(const Path1, Path2: string): boolean; virtual; abstract; published property Path: string read GetPath write SetPath; property BlockSize: guint32 read GetBlockSize write SetBlockSize; end; TLocalTreeEngine = class(TPanelEngine) private FPath: string; FBlockSize: guint32; public constructor Create; destructor Destroy; override; // function GetListing(var List: PGSList): integer; override; function GetListing(var List: TList; const AddDotFiles: boolean): integer; override; function GetListing(var List: TList; const AddDotFiles: boolean; APath: string): integer; override; function ChangeDir(const NewPath: string; const ShowProgress: boolean = True): integer; override; function ExplicitChDir(const NewPath: string): integer; override; function GetFileSystemSize: Int64; override; function GetFileSystemSize(const APath: string): Int64; override; function GetFileSystemFree: Int64; override; function GetFileSystemFree(const APath: string): Int64; override; function MakeDir(const NewDir: string): integer; override; function GetDirSize(APath: string): Int64; override; function Remove(APath: string): integer; override; procedure FillDirFiles(APath: string; List: TList; ALevel: word); override; function GetFileInfoSL(APath: string): PDataItemSL; override; function FileExists(const FileName: string; const Use_lstat: boolean = False): Boolean; override; function DirectoryExists(const FileName: string; const Use_lstat: boolean = False): Boolean; override; function MakeSymLink(const NewFileName, PointTo: string): integer; override; function Chmod(const FileName: string; const Mode: integer): integer; override; function Chown(const FileName: string; const UID, GID: integer): integer; override; procedure BreakProcessing(ProcessingKind: integer); override; function RenameFile(SourceFile, DestFile: string): integer; override; function ChangeTimes(APath: string; mtime, atime: Int64): integer; override; procedure GetFileSystemInfo(const APath: string; var FSSize, FSFree: Int64; var FSName: string); override; function OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; override; function ReadFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; ABlockSize: integer; var Error: integer): integer; override; function WriteFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; BytesCount: integer; var Error: integer): integer; override; function CloseFile(const FileDescriptor: TEngineFileDes): integer; override; function FileSeek(const FileDescriptor: TEngineFileDes; const AbsoluteOffset: Int64; var Error: integer): Int64; override; function IsOnROMedium(const FileName: string): boolean; override; function FileCanRun(const FileName: string): boolean; override; function GetPath: string; override; procedure SetPath(Value: string); override; function GetPrefix: string; override; function Login(Username, Password: string): integer; override; function GetBlockSize: guint32; override; procedure SetBlockSize(Value: guint32); override; function CopyFileIn(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; function CopyFileOut(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; function CopyFile(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; function IsOnSameFS(const Path1, Path2: string): boolean; override; function TwoSameFiles(const Path1, Path2: string): boolean; override; published property Path; property BlockSize; end; procedure FreeDataItem(DataItem: PDataItemSL); overload; procedure FreeDataItem(DataItem: PDataItem); overload; implementation uses SysUtils, UCoreUtils, UConfig; (********************************************************************************************************************************) constructor TPanelEngine.Create; begin inherited Create; BreakProcessingType := 0; ParentEngine := nil; // By default it is a top-level engine (local) LastHighlightItem := ''; end; destructor TPanelEngine.Destroy; begin inherited Destroy; end; (********************************************************************************************************************************) constructor TLocalTreeEngine.Create; begin inherited Create; FPath := '/'; FBlockSize := 65536; end; destructor TLocalTreeEngine.Destroy; begin inherited Destroy; end; function TLocalTreeEngine.GetPath: string; begin Result := FPath; end; procedure TLocalTreeEngine.SetPath(Value: string); begin if Value <> FPath then begin FPath := Value; end; end; function TLocalTreeEngine.GetBlockSize: guint32; begin Result := FBlockSize; end; procedure TLocalTreeEngine.SetBlockSize(Value: guint32); begin if Value <> FBlockSize then begin FBlockSize := Value; end; end; function TLocalTreeEngine.GetListing(var List: TList; const AddDotFiles: boolean; APath: string): integer; var Item : PDataItem; Handle : PDirectoryStream; DirEnt : PDirent64; Buf : PChar; // StatBuf : TStatBuf64; StatBuf : PGlibc_stat64; i: integer; LnkBuf : array[0..1000] of char; begin Result := 0; try APath := IncludeTrailingPathDelimiter(APath); if Libc.__chdir(PChar(APath)) <> 0 then begin Result := errno; DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, '): chdir error: ', strerror(Result)]); Exit; end; Handle := Libc.opendir(PChar(APath)); if not Assigned(Handle) then begin DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, '): opendir() handle == NULL: ', strerror(errno)]); Result := ERRNoAccess; Exit; end; repeat // DebugMsg(['x1']); DirEnt := readdir64(Handle); // DebugMsg(['x2']); if Assigned(DirEnt) and Assigned(PChar(@DirEnt^.d_name[0])) then begin // DebugMsg(['x3']); Buf := Pchar(@DirEnt^.d_name[0]); // DebugMsg(['x4']); if (Buf <> '.') and (Buf <> '..') and (DirEnt^.d_name[0] <> #0) and (AddDotFiles or (Length(Buf) = 1) or ((Length(Buf) > 1) and (not ((Buf[0] = '.') and (Buf[1] <> '.'))))) then begin Item := nil; // DebugMsg(['x5']); Item := Libc.malloc(SizeOf(TDataItem)); // DebugMsg(['x6']); Libc.memset(Item, 0, SizeOf(TDataItem)); // DebugMsg(['x7']); with Item^ do begin // DebugMsg(['x8']); FName := nil; FDisplayName := nil; LnkPointTo := nil; for i := 0 to Length(ColumnData) - 1 do ColumnData[i] := nil; FName := strdup(Buf); FDisplayName := StrToUTF8(Buf); // FDisplayName := strdup(Buf); // DebugMsg(['x']); StatBuf := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(StatBuf, 0, sizeof(TGlibc_stat64)); // DebugMsg(['(II) TLocalTreeEngine.GetListing(APath=', APath, '): lstat(Buf = ', Buf, ')']); if glibc_lstat64(Buf, StatBuf) <> 0 then begin DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, '): Error reading file via lstat64: ', strerror(errno)]); Continue; end; Mode := StatBuf^.st_mode; IsDotFile := (Length(Buf) > 1) and (Buf[0] = '.') and (Buf[1] <> '.'); IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); IsLnk := __S_ISTYPE(StatBuf^.st_mode, __S_IFLNK); IsBlk := __S_ISTYPE(StatBuf^.st_mode, __S_IFBLK); IsChr := __S_ISTYPE(StatBuf^.st_mode, __S_IFCHR); IsFIFO := __S_ISTYPE(StatBuf^.st_mode, __S_IFIFO); IsSock := __S_ISTYPE(StatBuf^.st_mode, __S_IFSOCK); {$IFDEF KYLIX} ModifyTime := StatBuf^.st_mtime; {$ELSE} ModifyTime := StatBuf^.st_mtim.tv_sec; {$ENDIF} if StatBuf^.st_uid = 4294967295 then UID := getuid else UID := StatBuf^.st_uid; if StatBuf^.st_gid = 4294967295 then GID := getgid else GID := StatBuf^.st_gid; UpDir := False; Selected := False; // DebugMsg(['(II) TLocalTreeEngine.GetListing(APath=', APath, '): freeing StatBuf...']); Libc.free(StatBuf); // DebugMsg([' done.']); if IsLnk then begin // DebugMsg(['aaaax']); i := readlink(PChar(APath + String(Buf)), LnkBuf, SizeOf(LnkBuf)); if i > 0 then begin LnkBuf[i] := #0; LnkPointTo := Libc.malloc(i + 1); Libc.memset(LnkPointTo, 0, i + 1); LnkPointTo := Libc.strncpy(LnkPointTo, @LnkBuf[0], i); end; StatBuf := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(StatBuf, 0, sizeof(TGlibc_stat64)); if glibc_stat64(Buf, StatBuf) = 0 then begin IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); Mode := StatBuf^.st_mode; end; // DebugMsg(['(II) TLocalTreeEngine.GetListing(APath=', APath, '): freeing StatBuf...']); Libc.free(StatBuf); // DebugMsg([' done.']); end; // DebugMsg(['xdffffffff']); if not IsDir then Size := StatBuf^.st_size else Size := -1; // DebugMsg(['xxsdfsf']); List.Add(Item); // DebugMsg(['x1123']); end; end; end; until DirEnt = nil; closedir(Handle); except on E: Exception do begin Result := ERRException; DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, ') -Exception: ', E.Message]); Exit; end; end; end; function TLocalTreeEngine.GetListing(var List: TList; const AddDotFiles: boolean): integer; begin Result := GetListing(List, AddDotFiles, FPath); end; function TLocalTreeEngine.ChangeDir(const NewPath: string; const ShowProgress: boolean = True): integer; var APath: string; Handle : PDirectoryStream; begin try APath := IncludeTrailingPathDelimiter(NewPath); if __chdir(PChar(APath)) <> 0 then begin Result := errno; Exit; end; Handle := opendir(PChar(APath)); if not Assigned(Handle) then begin Result := ERRNoAccess; Exit; end; { if not Assigned(readdir(Handle)) then begin Result := ERRNoAccess; Exit; end; } if closedir(Handle) <> 0 then begin Result := ERRNoAccess; Exit; end; Result := 0; except on E: Exception do begin Result := ERRException; DebugMsg(['*** TLocalTreeEngine.ChangeDir(APath=', APath, ') -Exception: ', E.Message]); Exit; end; end; end; (********************************************************************************************************************************) function TLocalTreeEngine.ExplicitChDir(const NewPath: string): integer; begin Result := __chdir(PChar(NewPath)); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) function TLocalTreeEngine.GetFileSystemSize(const APath: string): Int64; var Stat: PGlibc_statfs64; begin Result := 0; try Stat := Libc.malloc(sizeof(TGlibc_statfs64)); Libc.memset(Stat, 0, sizeof(TGlibc_statfs64)); if glibc_statfs64(PChar(APath), Stat) <> 0 then Exit; Result := Stat^.f_bsize * Stat^.f_blocks; Libc.free(Stat); except on E: Exception do DebugMsg(['*** TLocalTreeEngine.GetFileSystemSize(APath=', APath, ') -Exception: ', E.Message]); end; end; function TLocalTreeEngine.GetFileSystemSize: Int64; begin Result := GetFileSystemSize(FPath); end; (********************************************************************************************************************************) function TLocalTreeEngine.GetFileSystemFree(const APath: string): Int64; var Stat: PGlibc_statfs64; begin Result := 0; try Stat := Libc.malloc(sizeof(TGlibc_statfs64)); Libc.memset(Stat, 0, sizeof(TGlibc_statfs64)); if glibc_statfs64(PChar(APath), Stat) <> 0 then Exit; Result := Stat^.f_bsize * Stat^.f_bavail; Libc.free(Stat); except on E: Exception do DebugMsg(['*** TLocalTreeEngine.GetFileSystemFree(APath=', APath, ') -Exception: ', E.Message]); end; end; function TLocalTreeEngine.GetFileSystemFree: Int64; begin Result := GetFileSystemFree(FPath); end; (********************************************************************************************************************************) function TLocalTreeEngine.MakeDir(const NewDir: string): integer; begin DebugMsg(['(II) TLocalTreeEngine.MakeDir: begin']); Result := __mkdir(PChar(NewDir), OctalToAttr(ConfDefaultDirCreationMask)); DebugMsg(['(II) TLocalTreeEngine.MakeDir: Result = ', Result]); if Result <> 0 then Result := errno; (* if Result <> 0 then try if Self.DirectoryExists(NewDir) { or (not g_mkdir_with_parents(dd))} {ForceDirectories(NewDir))} then Result := errno; except Result := -1; DebugMsg(['(II) TLocalTreeEngine.MakeDir: Exception']); end; *) DebugMsg(['(II) TLocalTreeEngine.MakeDir: end']); end; (********************************************************************************************************************************) function TLocalTreeEngine.GetDirSize(APath: string): Int64; function InternalGetDirSize(APath: string): Int64; var Handle : PDirectoryStream; DirEnt : PDirent64; StatBuf : PGlibc_stat64; begin Result := 0; try if BreakProcessingType = 1 then Exit; APath := IncludeTrailingPathDelimiter(APath); if __chdir(PChar(APath)) <> 0 then begin Result := 0; Exit; end; Handle := OpenDir(PChar(APath)); if not Assigned(Handle) then begin Result := 0; Exit; end; repeat DirEnt := readdir64(Handle); if Assigned(DirEnt) and Assigned(PChar(@DirEnt^.d_name[0])) and (PChar(@DirEnt^.d_name[0]) <> '.') and (PChar(@DirEnt^.d_name[0]) <> '..') and (DirEnt^.d_name[0] <> #0) then begin StatBuf := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(StatBuf, 0, sizeof(TGlibc_stat64)); if glibc_lstat64(PChar(@DirEnt^.d_name[0]), StatBuf) <> 0 then Continue; if __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR) then begin Inc(Result, InternalGetDirSize(APath + String(PChar(@DirEnt^.d_name[0])))); __chdir(PChar(APath)); end else Inc(Result, StatBuf^.st_size); Libc.free(StatBuf); end; until DirEnt = nil; closedir(Handle); except on E: Exception do begin Result := 0; DebugMsg(['*** TLocalTreeEngine.GetDirSize(APath=', APath, ') -Exception: ', E.Message]); end; end; end; begin try BreakProcessingType := 0; Result := InternalGetDirSize(APath); finally BreakProcessingType := 0; end; end; (********************************************************************************************************************************) function TLocalTreeEngine.Remove(APath: string): integer; begin APath := ExcludeTrailingPathDelimiter(APath); Result := Libc.remove(PChar(APath)); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) procedure TLocalTreeEngine.FillDirFiles(APath: string; List: TList; ALevel: word); var Handle : PDirectoryStream; DirEnt : PDirent64; StatBuf_global : PGlibc_stat64; Item: PDataItemSL; i: integer; LnkBuf : array[0..1000] of char; FilesList: TList; procedure AddEntry(FPath: string; AddCurrDirStage, AStage1: boolean); var StatBuf_local : PGlibc_stat64; begin FPath := ExcludeTrailingPathDelimiter(FPath); StatBuf_local := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(StatBuf_local, 0, sizeof(TGlibc_stat64)); if glibc_lstat64(PChar(FPath), StatBuf_local) <> 0 then begin DebugMsg(['*** Error reading file stat AddEntry(lstat): ', strerror(errno)]); Exit; end; Item := Libc.malloc(SizeOf(TDataItemSL)); Libc.memset(Item, 0, SizeOf(TDataItemSL)); with Item^ do begin FName := nil; FDisplayName := nil; LnkPointTo := nil; ADestination := nil; Stage1 := AStage1; FName := strdup(PChar(FPath)); FDisplayName := StrToUTF8(PChar(FPath)); Size := StatBuf_local^.st_size; Mode := StatBuf_local^.st_mode; IsDir := __S_ISTYPE(StatBuf_local^.st_mode, __S_IFDIR); IsLnk := __S_ISTYPE(StatBuf_local^.st_mode, __S_IFLNK); IsExecutable := AddCurrDirStage or (StatBuf_local^.st_mode and S_IXUSR = S_IXUSR); IsOnRO := IsOnROMedium(FPath); ForceMove := False; if StatBuf_local^.st_uid = 4294967295 then UID := getuid else UID := StatBuf_local^.st_uid; if StatBuf_local^.st_gid = 4294967295 then GID := getgid else GID := StatBuf_local^.st_gid; {$IFDEF KYLIX} atime := StatBuf_local^.st_atime; mtime := StatBuf_local^.st_mtime; {$ELSE} atime := StatBuf_local^.st_atim.tv_sec; mtime := StatBuf_local^.st_mtim.tv_sec; {$ENDIF} if IsLnk and AddCurrDirStage then DebugMsg(['*** Assertion failed AddEntry: Item^.IsLnk = True']); if IsLnk and (not AddCurrDirStage) then begin i := readlink(PChar(APath + String(PChar(@DirEnt^.d_name[0]))), LnkBuf, SizeOf(LnkBuf)); if i > 0 then begin LnkBuf[i] := #0; LnkPointTo := Libc.malloc(i + 1); Libc.memset(LnkPointTo, 0, i + 1); LnkPointTo := Libc.strncpy(LnkPointTo, @LnkBuf[0], i); // StrLCopy(LnkPointTo, @LnkBuf[0], i); end; end; {$IFDEF KYLIX} ModifyTime := StatBuf_local^.st_mtime; {$ELSE} ModifyTime := StatBuf_local^.st_mtim.tv_sec; {$ENDIF} // DebugMsg([FormatDateTime('c', ModifyTime)]); Level := ALevel + Ord(not AddCurrDirStage); Libc.free(StatBuf_local); end; if AddCurrDirStage then List.Add(Item) else FilesList.Add(Item); end; begin if not Assigned(List) then Exit; try AddEntry(APath, True, True); FilesList := TList.Create; APath := IncludeTrailingPathDelimiter(APath); if __chdir(PChar(APath)) <> 0 then Exit; Handle := OpenDir(PChar(APath)); if Assigned(Handle) then repeat DirEnt := readdir64(Handle); if Assigned(DirEnt) and Assigned(PChar(@DirEnt^.d_name[0])) and (PChar(@DirEnt^.d_name[0]) <> '.') and (PChar(@DirEnt^.d_name[0]) <> '..') then begin StatBuf_global := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(StatBuf_global, 0, sizeof(TGlibc_stat64)); if glibc_stat64(PChar(@DirEnt^.d_name[0]), StatBuf_global) <> 0 then Continue; if __S_ISTYPE(StatBuf_global^.st_mode, __S_IFDIR) then begin FillDirFiles(APath + String(PChar(@DirEnt^.d_name[0])), List, ALevel + 1); __chdir(PChar(APath)); end else AddEntry(APath + String(PChar(@DirEnt^.d_name[0])), False, True); Libc.free(StatBuf_global); end; until DirEnt = nil; CloseDir(Handle); if FilesList.Count > 0 then for i := 0 to FilesList.Count - 1 do List.Add(FilesList[i]); FilesList.Free; AddEntry(APath, True, False); except on E: Exception do DebugMsg(['*** TLocalTreeEngine.FillDirFiles(APath=', APath, ', Level=', ALevel, ') -Exception: ', E.Message]); end; end; (********************************************************************************************************************************) function TLocalTreeEngine.GetFileInfoSL(APath: string): PDataItemSL; var StatBuf : PGlibc_stat64; i : integer; LnkBuf : array[0..1000] of char; begin Result := nil; try StatBuf := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(StatBuf, 0, sizeof(TGlibc_stat64)); if glibc_lstat64(PChar(APath), StatBuf) <> 0 then begin DebugMsg(['*** Error reading file stat GetFileInfoSL(lstat): ', strerror(errno)]); Exit; end; // DebugMsg(['x1']); Result := Libc.malloc(SizeOf(TDataItemSL)); Libc.memset(Result, 0, SizeOf(TDataItemSL)); // DebugMsg(['x1']); with Result^ do begin FName := nil; FDisplayName := nil; LnkPointTo := nil; ADestination := nil; Stage1 := True; // DebugMsg(['x1']); FName := strdup(PChar(APath)); FDisplayName := StrToUTF8(PChar(APath)); Size := StatBuf^.st_size; Mode := StatBuf^.st_mode; IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); IsLnk := __S_ISTYPE(StatBuf^.st_mode, __S_IFLNK); // DebugMsg(['x1']); IsExecutable := StatBuf^.st_mode and S_IXUSR = S_IXUSR; // DebugMsg(['x2']); IsOnRO := IsOnROMedium(APath); // DebugMsg(['x2']); ForceMove := False; // DebugMsg(['x2']); {$IFDEF KYLIX} ModifyTime := StatBuf^.st_mtime; {$ELSE} ModifyTime := StatBuf^.st_mtim.tv_sec; {$ENDIF} // DebugMsg(['x2']); if StatBuf^.st_uid = 4294967295 then UID := getuid else UID := StatBuf^.st_uid; if StatBuf^.st_gid = 4294967295 then GID := getgid else GID := StatBuf^.st_gid; {$IFDEF KYLIX} atime := StatBuf^.st_atime; mtime := StatBuf^.st_mtime; {$ELSE} atime := StatBuf^.st_atim.tv_sec; mtime := StatBuf^.st_mtim.tv_sec; {$ENDIF} // DebugMsg(['x1']); Libc.free(StatBuf); // DebugMsg(['x1']); Level := 1; // DebugMsg(['x1']); if IsLnk then begin i := readlink(PChar(APath), LnkBuf, SizeOf(LnkBuf)); if i > 0 then begin LnkBuf[i] := #0; LnkPointTo := Libc.malloc(i + 1); Libc.memset(LnkPointTo, 0, i + 1); // StrLCopy(LnkPointTo, @LnkBuf[0], i); LnkPointTo := Libc.strncpy(LnkPointTo, @LnkBuf[0], i); end; StatBuf := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(StatBuf, 0, sizeof(TGlibc_stat64)); if glibc_stat64(PChar(APath), StatBuf) = 0 then begin IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); Mode := StatBuf^.st_mode; end; Libc.free(StatBuf); end; end; // DebugMsg(['x1']); except on E: Exception do DebugMsg(['*** TLocalTreeEngine.GetFileInfoSL(APath=', APath, ') -Exception: ', E.Message]); end; end; (********************************************************************************************************************************) function TLocalTreeEngine.CopyFileIn(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; begin Result := CopyFile(Sender, SourceFile, DestFile, ProgressFunc, ErrorFunc, Append); end; function TLocalTreeEngine.CopyFileOut(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; begin Result := CopyFile(Sender, SourceFile, DestFile, ProgressFunc, ErrorFunc, Append); end; function TLocalTreeEngine.CopyFile(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; var fsrc, fdest: PIOFile; BytesDone, BytesRead: Int64; offset: off_t; // Used due to sendfile bug while copying from NTFS and some 2.6.x kernels function OldCopyRoutine: boolean; var Buffer: Pointer; BytesWritten: Int64; Res: boolean; begin try Result := False; Res := True; DebugMsg(['*** Using old copy function due to bug in sendfile']); // WriteLn('x1'); Buffer := Libc.malloc(FBlockSize); // WriteLn('x2'); if Buffer = nil then begin ErrorFunc(Sender, 1, errno, SourceFile); // Memory allocation failed // Libc.free(Buffer); Exit; end; Libc.memset(Buffer, 0, FBlockSize); // WriteLn('x3'); while feof(fsrc) = 0 do begin // WriteLn('x4'); BytesRead := fread(Buffer, 1, FBlockSize, fsrc); if (BytesRead < FBlockSize) and (feof(fsrc) = 0) then begin Res := ErrorFunc(Sender, 6, errno, SourceFile); // Cannot read from source file Break; end; // WriteLn('x5'); BytesWritten := fwrite(Buffer, 1, BytesRead, fdest); if BytesWritten < BytesRead then begin Res := ErrorFunc(Sender, 7, ferror(fdest), DestFile); // Cannot write to source file Break; end; Inc(BytesDone, BytesRead); // WriteLn('x6'); try if Assigned(ProgressFunc) and (not ProgressFunc(Sender, BytesDone)) then begin Res := False; Break; end; except on E: Exception do DebugMsg(['*** ProgressFunc ! Exception raised in TLocalTreeEngine.CopyFile.OldCopyRoutine(Sender=', DWord(Sender), ', SourceFile=', SourceFile, ', DestFile=', DestFile, '): (', E.ClassName, '): ', E.Message]); end; // WriteLn('x7'); end; // WriteLn('x8'); Libc.free(Buffer); // WriteLn('x9'); Result := Res; except on E: Exception do DebugMsg(['*** Exception raised in TLocalTreeEngine.CopyFile.OldCopyRoutine(Sender=', DWord(Sender), ', SourceFile=', SourceFile, ', DestFile=', DestFile, '): (', E.ClassName, '): ', E.Message]); end; end; function NewCopyRoutine: boolean; var Res: boolean; StatBuf: PGlibc_stat64; begin try Res := True; repeat DebugMsg(['Copy(sendfile): offset = ', offset, ', BytesDone = ', BytesDone, ', ftell(fsrc) = ', ftell(fsrc)]); BytesRead := Libc.sendfile(glibc_fileno(fdest), glibc_fileno(fsrc), offset, FBlockSize); if BytesRead = -1 then begin if errno = EINVAL then begin Result := OldCopyRoutine; Exit; end else Res := ErrorFunc(Sender, 6, errno, SourceFile); // Cannot read from source file Break; end; Inc(BytesDone, BytesRead); if Assigned(ProgressFunc) and (not ProgressFunc(Sender, BytesDone)) then begin Res := False; Break; end; until BytesRead < FBlockSize; StatBuf := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(StatBuf, 0, sizeof(TGlibc_stat64)); if glibc_lstat64(PChar(SourceFile), StatBuf) <> 0 then begin DebugMsg(['*** TLocalTreeEngine.CopyFile.NewCopyRoutine(Sender=', DWord(Sender), ', SourceFile=', SourceFile, ', DestFile=', DestFile, '): Error reading file via lstat64: ', strerror(errno)]); Res := ErrorFunc(Sender, 6, errno, SourceFile); end else if (BytesDone < StatBuf^.st_size) and Res then Res := ErrorFunc(Sender, 6, errno, SourceFile); Libc.free(StatBuf); Result := Res; except on E: Exception do DebugMsg(['*** Exception raised in TLocalTreeEngine.CopyFile.NewCopyRoutine(Sender=', DWord(Sender), ', SourceFile=', SourceFile, ', DestFile=', DestFile, '): (', E.ClassName, '): ', E.Message]); end; end; begin Result := False; try fsrc := fopen64(PChar(SourceFile), 'r'); if fsrc = nil then begin ErrorFunc(Sender, 2, errno, SourceFile); // Cannot open source file Exit; end; if Append then fdest := fopen64(PChar(DestFile), 'a') else fdest := fopen64(PChar(DestFile), 'w'); if fdest = nil then begin fclose(fsrc); ErrorFunc(Sender, 3, errno, DestFile); // Cannot open target file Exit; end; BytesDone := 0; offset := 0; Result := NewCopyRoutine; if fclose(fdest) <> 0 then begin fclose(fsrc); ErrorFunc(Sender, 4, errno, DestFile); // Cannot close target file Exit; end; if fclose(fsrc) <> 0 then begin ErrorFunc(Sender, 5, errno, SourceFile); // Cannot close source file Exit; end; except on E: Exception do DebugMsg(['*** Exception raised in TLocalTreeEngine.CopyFile(Sender=', DWord(Sender), ', SourceFile=', SourceFile, ', DestFile=', DestFile, '): (', E.ClassName, '): ', E.Message]); end; DebugMsg(['(II) TLocalTreeEngine.CopyFile: finished']); end; (********************************************************************************************************************************) function TLocalTreeEngine.FileExists(const FileName: string; const Use_lstat: boolean = False): Boolean; var st: PGlibc_stat64; begin st := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(st, 0, sizeof(TGlibc_stat64)); if Use_lstat then Result := glibc_lstat64(PChar(FileName), st) = 0 else Result := glibc_stat64(PChar(FileName), st) = 0; Libc.free(st); end; (********************************************************************************************************************************) function TLocalTreeEngine.DirectoryExists(const FileName: string; const Use_lstat: boolean = False): Boolean; var st: PGlibc_stat64; begin st := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(st, 0, sizeof(TGlibc_stat64)); if Use_lstat then Result := glibc_lstat64(PChar(FileName), st) = 0 else if glibc_stat64(PChar(FileName), st) = 0 then Result := S_ISDIR(st^.st_mode) else Result := False; Libc.free(st); end; (********************************************************************************************************************************) function TLocalTreeEngine.MakeSymLink(const NewFileName, PointTo: string): integer; begin Result := Libc.symlink(PChar(PointTo), PChar(NewFileName)); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) function TLocalTreeEngine.Chmod(const FileName: string; const Mode: integer): integer; begin Result := Libc.chmod(PChar(FileName), Mode); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) function TLocalTreeEngine.Chown(const FileName: string; const UID, GID: integer): integer; begin Result := Libc.chown(PChar(FileName), UID, GID); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) procedure TLocalTreeEngine.BreakProcessing(ProcessingKind: integer); begin BreakProcessingType := ProcessingKind; end; (********************************************************************************************************************************) function TLocalTreeEngine.IsOnSameFS(const Path1, Path2: string): boolean; var FStat1, FStat2: PGlibc_stat64; begin // DebugMsg(['** TLocalTreeEngine.IsOnSameFS("', Path1, '", "', Path2, '")']); Result := False; // Default fallback result (forces copy + delete) FStat1 := Libc.malloc(sizeof(TGlibc_stat64)); FStat2 := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(FStat1, 0, sizeof(TGlibc_stat64)); Libc.memset(FStat2, 0, sizeof(TGlibc_stat64)); if glibc_lstat64(PChar(Path1), FStat1) <> 0 then begin DebugMsg(['** TLocalTreeEngine.IsOnSameFS: Libc.stat(', Path1, ') error: ', strerror(errno)]); Exit; end; if glibc_lstat64(PChar(Path2), FStat2) <> 0 then begin DebugMsg(['** TLocalTreeEngine.IsOnSameFS: Libc.stat(', Path2, ') error: ', strerror(errno)]); Exit; end; Result := FStat1^.st_dev = FStat2^.st_dev; Libc.free(FStat1); Libc.free(FStat2); // DebugMsg(['** TLocalTreeEngine.IsOnSameFS("', Path1, '", "', Path2, '") Result = ', Result]); end; (********************************************************************************************************************************) function TLocalTreeEngine.RenameFile(SourceFile, DestFile: string): integer; begin Result := Libc.__rename(PChar(SourceFile), PChar(DestFile)); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) function TLocalTreeEngine.ChangeTimes(APath: string; mtime, atime: Int64): integer; var timebuf: PGlibc_utimbuf; begin Result := errno; try timebuf := Libc.malloc(sizeof(TGlibc_utimbuf)); Libc.memset(timebuf, 0, sizeof(TGlibc_utimbuf)); timebuf^.actime := atime; timebuf^.modtime := mtime; Result := glibc_utime(PChar(APath), timebuf); if Result <> 0 then Result := errno; Libc.free(timebuf); except on E: Exception do DebugMsg(['*** Exception raised in TLocalTreeEngine.ChangeTimes(APath=', APath, '): (', E.ClassName, '): ', E.Message]); end; end; (********************************************************************************************************************************) procedure TLocalTreeEngine.GetFileSystemInfo(const APath: string; var FSSize, FSFree: Int64; var FSName: string); var Stat: PGlibc_statfs64; fd: PIOFile; mntent: PMountEntry; mntdev: PChar; FoundLength: integer; Buffer: array[0..31] of char; begin FSSize := 0; FSFree := 0; FSName := ''; try Stat := Libc.malloc(sizeof(TGlibc_statfs64)); Libc.memset(Stat, 0, sizeof(TGlibc_statfs64)); if glibc_statfs64(PChar(APath), Stat) <> 0 then Exit; FSSize := Stat^.f_bsize * Stat^.f_blocks; FSFree := Stat^.f_bsize * Stat^.f_bavail; fd := setmntent(_PATH_MOUNTED, 'r'); if fd = nil then Exit; // Get mount name FoundLength := 0; mntdev := nil; mntent := getmntent(fd); while mntent <> nil do begin if (Pos(mntent^.mnt_dir, APath) = 1) and (Length(String(mntent^.mnt_dir)) > FoundLength) then begin FoundLength := Length(String(mntent^.mnt_dir)); FSName := String(mntent^.mnt_dir); mntdev := mntent^.mnt_fsname; end; mntent := getmntent(fd); end; endmntent(fd); // if it is CD-ROM, read ISO9660 label if Stat^.f_type = $9660 then begin { ISOFS_SUPER_MAGIC } if Assigned(mntdev) and (mntdev <> '') then begin fd := fopen(mntdev, 'r'); if fd = nil then Exit; if fseek(fd, 32808, SEEK_SET) <> 0 then Exit; if fread(@Buffer[0], 1, 32, fd) <> 0 then FSName := Trim(String(Buffer)); fclose(fd); end; end; Libc.free(Stat); except on E: Exception do DebugMsg(['*** Exception raised in TLocalTreeEngine.GetFileSystemInfo(APath=', APath, '): (', E.ClassName, '): ', E.Message]); end; end; (********************************************************************************************************************************) function TLocalTreeEngine.OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; var m: PChar; begin Error := 0; case Mode of omRead: m := 'r'; omWrite: m := 'w'; omAppend: m := 'a'; else m := 'r'; end; Result := Libc.fopen64(PChar(APath), m); if Result = nil then Error := errno; end; (********************************************************************************************************************************) function TLocalTreeEngine.ReadFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; ABlockSize: integer; var Error: integer): integer; begin Error := 0; Result := Libc.fread(Buffer, 1, ABlockSize, FileDescriptor); if (Result = 0) and (feof(FileDescriptor) = 0) then Error := errno; end; (********************************************************************************************************************************) function TLocalTreeEngine.WriteFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; BytesCount: integer; var Error: integer): integer; begin Error := 0; { Result := Libc.__write(fileno(FileDescriptor), Buffer^, BytesCount); if Result < BytesCount then Error := errno; } Result := Libc.fwrite(Buffer, 1, BytesCount, FileDescriptor); if Result < BytesCount then Error := ferror(FileDescriptor); end; (********************************************************************************************************************************) function TLocalTreeEngine.CloseFile(const FileDescriptor: TEngineFileDes): integer; begin Result := Libc.fclose(FileDescriptor); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) function TLocalTreeEngine.FileSeek(const FileDescriptor: TEngineFileDes; const AbsoluteOffset: Int64; var Error: integer): Int64; begin Error := 0; Result := Libc.fseeko64(FileDescriptor, AbsoluteOffset, SEEK_SET); if Result = -1 then Error := errno; end; (********************************************************************************************************************************) function TLocalTreeEngine.IsOnROMedium(const FileName: string): boolean; var Stat: PGlibc_statfs64; begin Result := False; try Stat := Libc.malloc(sizeof(TGlibc_statfs64)); Libc.memset(Stat, 0, sizeof(TGlibc_statfs64)); if glibc_statfs64(PChar(FileName), Stat) <> 0 then Exit; Result := (Stat^.f_type = $9660); { ISOFS_SUPER_MAGIC } Libc.free(Stat); except on E: Exception do DebugMsg(['*** TLocalTreeEngine.IsOnROMedium(FileName=', FileName, ') -Exception: ', E.Message]); end; end; (********************************************************************************************************************************) function TLocalTreeEngine.FileCanRun(const FileName: string): boolean; begin Result := Libc.access(PChar(FileName), R_OK or X_OK) = 0; end; (********************************************************************************************************************************) function TLocalTreeEngine.GetPrefix: string; begin Result := ''; end; (********************************************************************************************************************************) function TLocalTreeEngine.Login(Username, Password: string): integer; begin Result := 0; end; (********************************************************************************************************************************) function TLocalTreeEngine.TwoSameFiles(const Path1, Path2: string): boolean; var st1, st2: PGlibc_stat64; begin Result := False; st1 := Libc.malloc(sizeof(TGlibc_stat64)); st2 := Libc.malloc(sizeof(TGlibc_stat64)); Libc.memset(st1, 0, sizeof(TGlibc_stat64)); Libc.memset(st2, 0, sizeof(TGlibc_stat64)); if glibc_lstat64(PChar(Path1), st1) <> 0 then Exit; if glibc_lstat64(PChar(Path2), st2) <> 0 then Exit; DebugMsg(['*** TLocalTreeEngine.TwoSameFiles: ', st1^.st_ino, ' ', st2^.st_ino]); Result := st1^.st_ino = st2^.st_ino; Libc.free(st1); Libc.free(st2); end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure FreeDataItem(DataItem: PDataItemSL); begin try if Assigned(DataItem) then begin with DataItem^ do begin if FName <> nil then Libc.free(FName); if FDisplayName <> nil then Libc.free(FDisplayName); // if Assigned(ADestination) then Dispose(ADestination); if LnkPointTo <> nil then Libc.free(LnkPointTo); end; Libc.free(DataItem); end; except end; end; procedure FreeDataItem(DataItem: PDataItem); var i : integer; begin try if Assigned(DataItem) then begin with DataItem^ do begin if FName <> nil then Libc.free(FName); if FDisplayName <> nil then Libc.free(FDisplayName); if LnkPointTo <> nil then Libc.free(LnkPointTo); for i := 0 to Length(ColumnData) - 1 do if ColumnData[i] <> nil then Libc.free(ColumnData[i]); end; Libc.free(DataItem); end; except end; end; end.