kam-mobile/code/KM_FileIO_Mobile.pas

unit KM_FileIO_Mobile;
{$I KaM_Remake.inc}

interface

function KMFileIODecodeLegacy(const aBytes: RawByteString; aCodePage: Word): UnicodeString;
procedure KMFileIOCopyFile(const aSource, aDest: UnicodeString);
procedure KMFileIORemoveDirectoryTree(const aPath: UnicodeString);
procedure KMFileIOMoveToTrash(const aSourcePath: UnicodeString; aIsDirectory: Boolean);
procedure KMFileIORenameDirectory(const aSourcePath, aDestPath: UnicodeString);
function KMFileIOApplicationSavePath: string;
function KMFileIOIsDirectoryWriteable(const aDir: string): Boolean;
procedure KMFileIOCheckFolderPermission(const aPath: string; out aRead, aWrite, aExec: Boolean);

implementation

uses
  SysUtils, BaseUnix, SyncObjs, CastleFilesUtils, CastleUriUtils,
  charset, cpall, cp932, cp936, cp949, cp950;

var
  TrashCriticalSection: TCriticalSection;

function FileSystemPathToUtf8(const aPath: UnicodeString): RawByteString;
begin
  Result := RawByteString(UTF8Encode(aPath));
end;

function ResolveApplicationDirectory(const aRelativePath: string): string;
var
  Url, RawPath: string;
begin
  Url := CastleFilesUtils.ApplicationConfig(aRelativePath);
  RawPath := CastleUriUtils.UriToFilenameSafe(Url);
  if RawPath = '' then
    raise Exception.CreateFmt('Unable to resolve application storage location: %s', [Url]);

  Result := IncludeTrailingPathDelimiter(RawPath);
  if not DirectoryExists(Result) and not ForceDirectories(Result) and not DirectoryExists(Result) then
    raise Exception.CreateFmt('Unable to create application storage directory: %s', [Result]);
end;

function KMFileIOApplicationSavePath: string;
begin
  Result := ResolveApplicationDirectory('');
end;

procedure KMFileIOCopyFile(const aSource, aDest: UnicodeString);
begin
  CastleFilesUtils.CheckCopyFile(aSource, aDest);
end;

procedure KMFileIORemoveDirectoryTree(const aPath: UnicodeString);
begin
  CastleFilesUtils.RemoveNonEmptyDir(aPath, False);
end;

procedure KMFileIORenameDirectory(const aSourcePath, aDestPath: UnicodeString);
var
  RawSource, RawDest: RawByteString;
  Err: Integer;
begin
  RawSource := FileSystemPathToUtf8(aSourcePath);
  RawDest := FileSystemPathToUtf8(aDestPath);
  if fpRename(RawSource, RawDest) = 0 then
    Exit;

  Err := fpgeterrno;
  if Err <> ESysEXDEV then
    raise Exception.CreateFmt('KM_FileIO: unable to rename directory from %s to %s (errno %d: %s)',
      [aSourcePath, aDestPath, Err, SysErrorMessage(Err)]);

  try
    CastleFilesUtils.CopyDirectory(aSourcePath, aDestPath);
  except
    if DirectoryExists(aDestPath) then
      try
        CastleFilesUtils.RemoveNonEmptyDir(aDestPath, True);
      except
      end;
    raise;
  end;
  CastleFilesUtils.RemoveNonEmptyDir(aSourcePath, False);
end;

procedure KMFileIOMoveToTrash(const aSourcePath: UnicodeString; aIsDirectory: Boolean);
var
  TrashRoot: string;
  NormalizedSource, BaseName, Extension, Destination: UnicodeString;
  Counter, Err: Integer;
  RawSource, RawDest: RawByteString;
begin
  TrashCriticalSection.Acquire;
  try
    TrashRoot := ResolveApplicationDirectory('Trash/');
    NormalizedSource := ExcludeTrailingPathDelimiter(aSourcePath);
    BaseName := ExtractFileName(NormalizedSource);
    if BaseName = '' then
      raise Exception.CreateFmt('KM_FileIO: invalid trash source path: %s', [aSourcePath]);

    Destination := UnicodeString(TrashRoot) + BaseName;
    if FileExists(Destination) or DirectoryExists(Destination) then
    begin
      Counter := 1;
      if not aIsDirectory then
        Extension := ExtractFileExt(BaseName);
      repeat
        if aIsDirectory then
          Destination := UnicodeString(TrashRoot) + BaseName + '.trash-' + IntToStr(Counter)
        else
          Destination := UnicodeString(TrashRoot) + Copy(BaseName, 1, Length(BaseName) - Length(Extension)) +
            '.trash-' + IntToStr(Counter) + Extension;
        Inc(Counter);
      until not FileExists(Destination) and not DirectoryExists(Destination);
    end;

    RawSource := FileSystemPathToUtf8(aSourcePath);
    RawDest := FileSystemPathToUtf8(Destination);
    if fpRename(RawSource, RawDest) = 0 then
      Exit;

    Err := fpgeterrno;
    if Err <> ESysEXDEV then
      raise Exception.CreateFmt('KM_FileIO: unable to move %s to %s (errno %d: %s)',
        [aSourcePath, Destination, Err, SysErrorMessage(Err)]);

    if aIsDirectory then
    begin
      try
        CastleFilesUtils.CopyDirectory(aSourcePath, Destination);
      except
        if DirectoryExists(Destination) then
          try
            CastleFilesUtils.RemoveNonEmptyDir(Destination, True);
          except
          end;
        raise;
      end;
      CastleFilesUtils.RemoveNonEmptyDir(aSourcePath, False);
    end
    else
    begin
      try
        CastleFilesUtils.CheckCopyFile(aSourcePath, Destination);
      except
        if FileExists(Destination) then
          try
            SysUtils.DeleteFile(Destination);
          except
          end;
        raise;
      end;
      if not SysUtils.DeleteFile(aSourcePath) then
        raise Exception.CreateFmt('KM_FileIO: unable to delete moved source file: %s', [aSourcePath]);
    end;
  finally
    TrashCriticalSection.Release;
  end;
end;

procedure KMFileIOCheckFolderPermission(const aPath: string; out aRead, aWrite, aExec: Boolean);
var
  RawPath: RawByteString;
begin
  RawPath := FileSystemPathToUtf8(UnicodeString(aPath));
  aRead := fpAccess(RawPath, R_OK) = 0;
  aWrite := fpAccess(RawPath, W_OK) = 0;
  aExec := fpAccess(RawPath, X_OK) = 0;
end;

function KMFileIOIsDirectoryWriteable(const aDir: string): Boolean;
var
  BaseToken, Candidate: string;
  RawCandidate: RawByteString;
  Attempt, Handle, Err: Integer;
  Value: Byte;
  Created, IsOpen, WriteOk, CloseOk: Boolean;
begin
  Result := False;
  if (aDir = '') or not DirectoryExists(aDir) then
    Exit;

  Created := False;
  IsOpen := False;
  try
    try
      BaseToken := '.kam-write-check-' + IntToHex(GetTickCount64, 1);
      Attempt := 0;
      repeat
        Candidate := IncludeTrailingPathDelimiter(aDir) + BaseToken + '-' + IntToStr(Attempt);
        RawCandidate := FileSystemPathToUtf8(UnicodeString(Candidate));
        Handle := fpOpen(RawCandidate, O_WRONLY or O_CREAT or O_EXCL, S_IRUSR or S_IWUSR);
        if Handle >= 0 then
          Break;

        Err := fpgeterrno;
        if Err <> ESysEEXIST then
          Exit;
        Inc(Attempt);
      until False;

      Created := True;
      IsOpen := True;
      Value := 0;
      WriteOk := fpWrite(Handle, Value, 1) = 1;
      CloseOk := fpClose(Handle) = 0;
      if CloseOk then
        IsOpen := False;
      Result := WriteOk and CloseOk;
    finally
      try
        if IsOpen then
          fpClose(Handle);
      finally
        if Created and FileExists(Candidate) and not DeleteFile(Candidate) then
          Result := False;
      end;
    end;
  except
    Result := False;
  end;
end;

function KMFileIODecodeLegacy(const aBytes: RawByteString; aCodePage: Word): UnicodeString;
var
  Map: PUnicodeMap;
  Required, Converted: LongInt;
begin
  Map := getmap(aCodePage);
  if Map = nil then
    raise EConvertError.CreateFmt('Unsupported codepage: %d', [aCodePage]);
  if aBytes = '' then
    Exit('');

  Required := getunicode(PAnsiChar(aBytes), Length(aBytes), Map, nil);
  if Required < 0 then
    raise EConvertError.CreateFmt('Conversion failed for codepage: %d', [aCodePage]);
  if Required = 0 then
    Exit('');

  SetLength(Result, Required);
  Converted := getunicode(PAnsiChar(aBytes), Length(aBytes), Map, @Result[1]);
  if Converted < 0 then
    raise EConvertError.CreateFmt('Conversion failed for codepage: %d', [aCodePage]);
  if Converted < Required then
    SetLength(Result, Converted);
end;

initialization
  TrashCriticalSection := TCriticalSection.Create;

finalization
  TrashCriticalSection.Free;

end.