unit datomicfilewriter;

{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

function WriteFileContentAtomic(const FileName: AnsiString;
                                Content: Pointer;
                                ContentSize: SizeUInt): Boolean;
//
//  Returns
//
//      Result=True:  success, content has been written to the file
//
//      Result=False: failed, the file FileName left unchanged
//


implementation

{$IF Defined(WINDOWS)}
uses
  windows;
{$ENDIF}

{$IF Defined(UNIX)}
uses
  BaseUnix, Unix;
{$ENDIF}

{$IF Defined(UNIX)}
function WriteFileContent(const FileName: AnsiString;
                          Content: Pointer;
                          ContentSize: SizeUInt): Boolean;
const
  DEFAULT_MODE = BaseUnix.S_IWUSR or BaseUnix.S_IRUSR or
                 BaseUnix.S_IWGRP or BaseUnix.S_IRGRP or
                 BaseUnix.S_IWOTH or BaseUnix.S_IROTH;
var
  H: BaseUnix.cint;
begin
  repeat
    H := BaseUnix.fpOpen(@FileName[1], O_CREAT or O_WRONLY, DEFAULT_MODE);
    if H = -1 then begin
      if BaseUnix.fpGetErrno = BaseUnix.ESysEINTR then
        continue;
    end;
  until True;

  while BaseUnix.fpWrite(H, Content^, ContentSize) = -1 do begin
    if BaseUnix.fpGetErrno <> BaseUnix.ESysEINTR then begin
      BaseUnix.fpClose(H);
      Exit(False);
    end;
  end;

  while Unix.fpFSync(H) = -1 do begin
    if BaseUnix.fpGetErrno <> BaseUnix.ESysEINTR then begin
      BaseUnix.fpClose(H);
      Exit(False);
    end;
  end;

  BaseUnix.fpClose(H);
  Exit(True);
end;

{$ELSE} // Cross-platform implementation of the WriteFileContent
function WriteFileContent(const FileName: AnsiString;
                          Content: Pointer;
                          ContentSize: SizeUInt): Boolean;
var
  F: File of Byte;
  Written: SizeUInt;
begin
  Assign(F, FileName);

{$I-}
  ReWrite(F);
{$I+}
  if IOResult <> 0 then
    Exit(False);

{$I-}
  BlockWrite(F, Content^, ContentSize, Written);
  if (IOResult <> 0) or (Written < ContentSize) then
    Exit(False);
{$I+}

  // Seems that untyped files do not have their own buffer and do not require
  // flush. Still wonder how to properly flush OS buffers...
  // Flush(F);
{$I-}
  Close(F);
{$I+}
  Exit(IOResult = 0);
end;
{$ENDIF}

{$IF Defined(WINDOWS)}
function GenerateTempFileName(TempPath: PAnsiChar): AnsiString;
var
  Ret: windows.UINT;
begin
  SetLength(Result, MAX_PATH + 1);
  Ret := GetTempFileNameA(TempPath, '.', 0, @Result[1]);
  if Ret = 0 then begin
    // Writeln('Failed GetTempFileNameA, ', GetLastError);
    Exit('');
  end;
  SetLength(Result, StrLen(@Result[1]));
end;

function FileExists(FileName: PAnsiChar): Boolean;
var
  Attrib: windows.DWORD;
begin
  Attrib := GetFileAttributes(FileName);
  // Writeln(BinStr(Attrib, SizeOf(DWORD) * 8));
  Exit((Attrib <> INVALID_FILE_ATTRIBUTES) and
       ((Attrib and FILE_ATTRIBUTE_DIRECTORY) = 0));
end;

{$IF not Declared(ReplaceFileA)}
function ReplaceFileA(lpReplacedFileName:    windows.LPCSTR;
                      lpReplacementFileName: windows.LPCSTR;
                      lpBackupFileName:      windows.LPCSTR;
                      dwReplaceFlags:        windows.DWORD;
                      lpExclude:             windows.LPVOID;
                      lpReserved:            windows.LPVOID
      ): windows.BOOL; stdcall; external 'Kernel32.dll';
{$ENDIF}

function WriteFileContentAtomic(const FileName: AnsiString;
                                Content: Pointer;
                                ContentSize: SizeUInt): Boolean;
var
  TempPath: AnsiString;
  TempFileName, BackupFileName: AnsiString;
begin
  if not FileExists(@FileName[1]) then begin
    Exit(WriteFileContent(FileName, Content, ContentSize));
  end;

  //
  //  Get path to temporary directory
  //

  //
  //  We could not use GetTempPath here because
  //
  //    1. It does not garantee access rights to the directory for the current
  //       user, and
  //    2. it does not garantee that returned directory is on the same drive as
  //       the FileName
  //
  //    TempPathLen := GetTempPathA(MAX_PATH, @TempPath[0]);
  //    if (TempPathLen = 0) or (TempPathLen > MAX_PATH) then
  //      Exit(False);
  //
  //  So we just use directory of the FileName
  //

  TempPath := FileName;
  while (Length(TempPath) > 0) and not (TempPath[Length(TempPath)] in ['/', '\']) do
    SetLength(TempPath, Length(TempPath) - 1);
  if TempPath = '' then
    TempPath := '.';

  //
  //  Generate names of temporary files
  //

  TempFileName := GenerateTempFileName(@TempPath[1]);
  BackupFileName := GenerateTempFileName(@TempPath[1]);
  //Writeln('Got temp file name: ', TempFileName, ', backup: ', BackupFileName);
  if (TempFileName = '') or (BackupFileName = '') then
    Exit(False);

  //
  //  Save content to the temporary file
  //
  if not WriteFileContent(TempFileName, Content, ContentSize) then begin
    // Writeln('Could not write file content');
    Exit(False);
  end;

  //
  //  Now try to atomicaly move the temp file onto the target file. It seems
  //  that ReplaceFileA is our best bet, though documentation does not garantee
  //  atomicity...
  //
  if not ReplaceFileA(@FileName[1],       // the name of file to be replaced
                      @TempFileName[1],   // the name of file that will replace
                      @BackupFileName[1], // the name of backup file
                      0,                  // replacement options
                      nil,                // lpExlude, reserved for future use
                      nil) then begin     // lpReserved
    // Writeln(stderr, 'Failed ReplaceFileA ', GetLastError);
    Exit(False);
  end;

  //
  //  Now we can remove the temporary files.
  //  Ignore errors if any.
  //
  DeleteFileA(@TempFileName[1]);
  DeleteFileA(@BackupFileName[1]);

  Exit(True);
end;
{$ENDIF}

{$IF Defined(UNIX)}
function WriteFileContentAtomic(const FileName: AnsiString;
                                Content: Pointer;
                                ContentSize: SizeUInt): Boolean;
var
  TempFileName: AnsiString;
begin
  TempFileName := FileName + '~';

  if not WriteFileContent(TempFileName, Content, ContentSize) then
    Exit(False);

  Exit(FpRename(PAnsiChar(TempFileName), PAnsiChar(FileName)) = 0);
end;
{$ENDIF}

end.
