* when creating a file with an exclusive sharing mode on Unix, first check

    whether there isn't already a file and of so whether we can open it using
    this exclusive sharing mode (since the locking is advisory, simply
    overwriting any existing file and then locking it exclusively will
    always work) (mantis #27998)

git-svn-id: trunk@30861 -

.gitattributes

@@ -14483,6 +14483,7 @@ tests/webtbs/tw2788.pp svneol=native#text/plain
 tests/webtbs/tw27880.pp svneol=native#text/plain
 tests/webtbs/tw2789.pp svneol=native#text/plain
 tests/webtbs/tw2794.pp svneol=native#text/plain
+tests/webtbs/tw27998.pp svneol=native#text/plain
 tests/webtbs/tw28007.pp svneol=native#text/pascal
 tests/webtbs/tw2803.pp svneol=native#text/plain
 tests/webtbs/tw2806.pp svneol=native#text/plain

rtl/unix/sysutils.pp

@@ -436,7 +436,7 @@ begin
 end;
 
 
-Function FileOpen (Const FileName : RawbyteString; Mode : Integer) : Longint;
+Function FileOpenNoLocking (Const FileName : RawbyteString; Mode : Integer) : Longint;
 
 Var
   SystemFileName: RawByteString;
@@ -451,9 +451,15 @@ begin
 
   SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
   repeat
-    FileOpen:=fpOpen (pointer(SystemFileName),LinuxFlags);
-  until (FileOpen<>-1) or (fpgeterrno<>ESysEINTR);
+    FileOpenNoLocking:=fpOpen (pointer(SystemFileName),LinuxFlags);
+  until (FileOpenNoLocking<>-1) or (fpgeterrno<>ESysEINTR);
+end;
+
+
+Function FileOpen (Const FileName : RawbyteString; Mode : Integer) : Longint;
 
+begin
+  FileOpen:=FileOpenNoLocking(FileName, Mode);
   FileOpen:=DoFileLocking(FileOpen, Mode);
 end;
 
@@ -483,8 +489,25 @@ end;
 
 Function FileCreate (Const FileName : RawByteString; ShareMode : Longint; Rights:LongInt ) : Longint;
 
+Var
+  fd: Longint;
 begin
-  Result:=FileCreate( FileName, Rights );
+  { if the file already exists and we can't open it using the requested
+    ShareMode (e.g. exclusive sharing), exit immediately so that we don't
+    first empty the file and then check whether we can lock this new file
+    (which we can by definition) }
+  fd:=FileOpenNoLocking(FileName,ShareMode);
+  { the file exists, check whether our locking request is compatible }
+  if fd>=0 then
+    begin
+      Result:=DoFileLocking(fd,ShareMode);
+      FileClose(fd);
+     { Can't lock -> abort }
+      if Result<0 then
+        exit;
+    end;
+  { now create the file }
+  Result:=FileCreate(FileName,Rights);
   Result:=DoFileLocking(Result,ShareMode);
 end;
 

tests/webtbs/tw27998.pp

@@ -0,0 +1,28 @@
+program a;
+{$mode delphi}
+uses
+  SysUtils, Classes;
+const
+  LockFile = 'lock.txt';
+var
+  H : TStream;
+begin
+  try
+    H := TFileStream.Create(lockFile, fmCreate);
+    h.Write(H, 4);
+    { flush }
+    H.free;
+    { reopen in exclusive mode }
+    H := TFileStream.Create(lockfile, fmOpenWrite);
+    { should fail with an exception due to exclusion }
+    H := TFileStream.Create(lockFile, fmCreate);
+    Halt(1);
+  except
+    { check the size of the file, to ensure that the second
+      create didn't overwrite the file }
+    H := TFileStream.create(LockFile, fmOpenRead or fmShareDenyNone);
+    if H.Size<>4 then
+      halt(2);
+  end
+end.
+