033e4b086fMade all uses of openFd and dup set the close-on-exec flag, with a few exceptions when starting a git-annex daemon. Made openFdWithMode be used everywhere, rather than openFd. Adding a new parameter to it ensures I checked everything. And will help to make sure this gets considered in the future when opening fds. In lockPidFile, the only thing that keeps the pid file locked, once daemonize re-runs the command in a new session, is that the fd is inherited. In Utility.LogFile.redir, the new fd it dups to does not have the close-on-exec flag set, because this is used to set up the stdout and stderr fds, which need to be inherited by child processes. Same in Assistant.startDaemon where the browser gets started with the original stdout and stderr. This does nothing about uses of openFile and similar! Sponsored-By: mycroft
79 lines
2.2 KiB
Haskell
79 lines
2.2 KiB
Haskell
{- git lock files
|
|
-
|
|
- Copyright 2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Git.LockFile where
|
|
|
|
import Common
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
import Utility.OpenFd
|
|
import System.Posix.Types
|
|
import System.Posix.IO
|
|
#else
|
|
import System.Win32.Types
|
|
import System.Win32.File
|
|
#endif
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
data LockHandle = LockHandle OsPath Fd
|
|
#else
|
|
data LockHandle = LockHandle OsPath HANDLE
|
|
#endif
|
|
|
|
{- Uses the same exclusive locking that git does.
|
|
- Throws an IO exception if the file is already locked.
|
|
-
|
|
- Note that git's locking method suffers from the problem that
|
|
- a dangling lock can be left if a process is terminated at the wrong
|
|
- time.
|
|
-}
|
|
openLock :: OsPath -> IO LockHandle
|
|
openLock lck = openLock' lck `catchNonAsync` lckerr
|
|
where
|
|
lckerr e = do
|
|
-- Same error message displayed by git.
|
|
whenM (doesFileExist lck) $
|
|
hPutStrLn stderr $ unlines
|
|
[ "fatal: Unable to create '" ++ fromOsPath lck ++ "': " ++ show e
|
|
, ""
|
|
, "If no other git process is currently running, this probably means a"
|
|
, "git process crashed in this repository earlier. Make sure no other git"
|
|
, "process is running and remove the file manually to continue."
|
|
]
|
|
throwM e
|
|
|
|
openLock' :: OsPath -> IO LockHandle
|
|
openLock' lck = do
|
|
#ifndef mingw32_HOST_OS
|
|
-- On unix, git simply uses O_EXCL
|
|
h <- openFdWithMode (fromOsPath lck) ReadWrite (Just 0O666)
|
|
(defaultFileFlags { exclusive = True }) (CloseOnExecFlag True)
|
|
#else
|
|
-- It's not entirely clear how git manages locking on Windows,
|
|
-- since it's buried in the portability layer, and different
|
|
-- versions of git for windows use different portability layers.
|
|
-- But, we can be fairly sure that holding the lock file open on
|
|
-- windows is enough to prevent another process from opening it.
|
|
--
|
|
-- So, all that's needed is a way to open the file, that fails
|
|
-- if the file already exists. Using CreateFile with CREATE_NEW
|
|
-- accomplishes that.
|
|
h <- createFile (fromOsPath lck) gENERIC_WRITE fILE_SHARE_NONE Nothing
|
|
cREATE_NEW fILE_ATTRIBUTE_NORMAL Nothing
|
|
#endif
|
|
return (LockHandle lck h)
|
|
|
|
closeLock :: LockHandle -> IO ()
|
|
closeLock (LockHandle lck h) = do
|
|
#ifndef mingw32_HOST_OS
|
|
closeFd h
|
|
#else
|
|
closeHandle h
|
|
#endif
|
|
removeFile lck
|