From 31037d0664c607fca55ccd09caaea252b265b479 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Fri, 15 May 2015 19:45:12 +0000
Subject: [PATCH]   * 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          |  1 +
 rtl/unix/sysutils.pp    | 31 +++++++++++++++++++++++++++----
 tests/webtbs/tw27998.pp | 28 ++++++++++++++++++++++++++++
 3 files changed, 56 insertions(+), 4 deletions(-)
 create mode 100644 tests/webtbs/tw27998.pp

diff --git a/.gitattributes b/.gitattributes
index e4ffb2c12a..8992a68778 100644
--- a/.gitattributes
+++ b/.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
diff --git a/rtl/unix/sysutils.pp b/rtl/unix/sysutils.pp
index a131c97ede..841fd084ae 100644
--- a/rtl/unix/sysutils.pp
+++ b/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;
 
diff --git a/tests/webtbs/tw27998.pp b/tests/webtbs/tw27998.pp
new file mode 100644
index 0000000000..d54b65c1ec
--- /dev/null
+++ b/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.
+