implement openFileBeingWritten

This bypasses the usual haskell file locking used to prevent opening a
file for read that is being written to.

This is unfortunately a bit of a hack. But it seems fairly unlikely to
get broken by changes to ghc. I hope. Using fdToHandle' will also work.

This does not work on windows because it uses openFd from posix. It
would probably be possible to implement it for windows too, just opening
the FD using the Win32 library instead. However, whether windows will
allow reading from a file that is also being written to I don't know,
and since in the git-annex case the writer could be another process (eg
external special remote), that might be doing its own locking in
windows, that seems a can of worms I'd prefer not to open.

diff --git a/Utility/OpenFile.hs b/Utility/OpenFile.hs
new file mode 100644 (file)
index 0000000..99ac696
--- /dev/null
+++ b/Utility/OpenFile.hs
@@ -0,0 +1,32 @@
+{- Opening files
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.OpenFile where
+
+import System.IO
+import System.Posix.IO
+import GHC.IO.FD
+import GHC.IO.Handle.FD
+import GHC.IO.Device
+
+import Utility.OpenFd
+import Utility.RawFilePath
+import Utility.FileSystemEncoding
+
+{- Usually, opening a Handle to a file that another thread also has open
+ - for write is prevented, which avoids a lot of concurrency bugs especially
+ - with lazy IO.
+ - 
+ - However, sometimes one thread is writing and another thread really wants
+ - to read from the same file. This bypasses the usual locking, by claiming
+ - that an opened FD is a Stream.
+ -}
+openFileBeingWritten :: RawFilePath -> IO Handle
+openFileBeingWritten f = do
+       fd <- openFdWithMode f ReadOnly Nothing defaultFileFlags
+       (fd', fdtype) <- mkFD (fromIntegral fd) ReadMode (Just (Stream, 0, 0)) False False
+       mkHandleFromFD fd' fdtype (fromRawFilePath f) ReadMode False Nothing

diff --git a/git-annex.cabal b/git-annex.cabal
index fd3406707add4e0fab5ee4962de8b61809d0fb0d..a771676ff39b4e38aee4c6e98382f0c8a17a62e2 100644 (file)
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1091,6 +1091,7 @@ Executable git-annex
     Utility.Network
     Utility.NotificationBroadcaster
     Utility.OpenFd
+    Utility.OpenFile
     Utility.OptParse
     Utility.OSX
     Utility.PID