audit all openFd and dupping for close-on-exec

Made 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

Annex/Link.hs

@@ -448,7 +448,7 @@ isPointerFile f = catchDefaultIO Nothing $
 #if MIN_VERSION_unix(2,8,0)
 	let open = do
 		fd <- openFd (fromOsPath f) ReadOnly 
-			(defaultFileFlags { nofollow = True })
+			(defaultFileFlags { nofollow = True, cloexec = True })
 		fdToHandle fd
 	in bracket open hClose readhandle
 #else

Command/RemoteDaemon.hs

@@ -31,7 +31,9 @@ run o
 #ifndef mingw32_HOST_OS
 		git_annex <- fromOsPath <$> liftIO programPath
 		ps <- gitAnnexDaemonizeParams
-		let logfd = openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing defaultFileFlags
+		let logfd = openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing 
+			defaultFileFlags
+			(CloseOnExecFlag True)
 		liftIO $ daemonize git_annex ps logfd Nothing False runNonInteractive
 #else
 		liftIO $ foreground Nothing runNonInteractive	

Git/LockFile.hs

@@ -53,12 +53,7 @@ openLock' lck = do
 #ifndef mingw32_HOST_OS
 	-- On unix, git simply uses O_EXCL
 	h <- openFdWithMode (fromOsPath lck) ReadWrite (Just 0O666)
-#if MIN_VERSION_unix(2,8,0)
-		(defaultFileFlags { exclusive = True, cloexec = True })
-#else
-		(defaultFileFlags { exclusive = True })
-	setFdOption h CloseOnExec True
-#endif
+		(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

Remote/Directory.hs

@@ -471,9 +471,11 @@ retrieveExportWithContentIdentifierM ii dir cow loc cids dest gk p =
 	docopynoncow iv = do
 #ifndef mingw32_HOST_OS
 		let open = do
+			fd <- openFdWithMode f' ReadOnly Nothing
+				defaultFileFlags (CloseOnExecFlag True)
 			-- Need a duplicate fd for the post check.
-			fd <- openFdWithMode f' ReadOnly Nothing defaultFileFlags
 			dupfd <- dup fd
+			setFdOption dupfd CloseOnExec True
 			h <- fdToHandle fd
 			return (h, dupfd)
 		let close (h, dupfd) = do

Utility/Daemon.hs

@@ -53,6 +53,7 @@ daemonize cmd params openlogfd pidfile changedirectory a = do
 			a
 		_ -> do
 			nullfd <- openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing defaultFileFlags 
+				(CloseOnExecFlag True)
 			redir nullfd stdInput
 			redirLog =<< openlogfd
 			environ <- getEnvironment
@@ -91,7 +92,8 @@ foreground pidfile a = do
 #endif
 
 {- Locks the pid file, with an exclusive, non-blocking lock,
- - and leaves it locked on return.
+ - and leaves it locked on return. The lock file is not closed on exec, so
+ - when daemonize runs the process again, it inherits it.
  -
  - Writes the pid to the file, fully atomically.
  - Fails if the pid file is already locked by another process. -}
@@ -99,9 +101,11 @@ lockPidFile :: OsPath -> IO ()
 lockPidFile pidfile = do
 #ifndef mingw32_HOST_OS
 	fd <- openFdWithMode (fromOsPath pidfile) ReadWrite (Just stdFileMode) defaultFileFlags
+		(CloseOnExecFlag False)
 	locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
-	fd' <- openFdWithMode (fromOsPath newfile) ReadWrite (Just stdFileMode) defaultFileFlags
-		{ trunc = True }
+	fd' <- openFdWithMode (fromOsPath newfile) ReadWrite (Just stdFileMode)
+		(defaultFileFlags { trunc = True })
+		(CloseOnExecFlag True)
 	locked' <- catchMaybeIO $ setLock fd' (WriteLock, AbsoluteSeek, 0, 0)
 	case (locked, locked') of
 		(Nothing, _) -> alreadyRunning
@@ -135,7 +139,10 @@ checkDaemon :: OsPath -> IO (Maybe PID)
 checkDaemon pidfile = bracket setup cleanup go
   where
 	setup = catchMaybeIO $
-		openFdWithMode (fromOsPath pidfile) ReadOnly (Just stdFileMode) defaultFileFlags
+		openFdWithMode (fromOsPath pidfile) ReadOnly
+			(Just stdFileMode) 
+			defaultFileFlags
+			(CloseOnExecFlag True)
 	cleanup (Just fd) = closeFd fd
 	cleanup Nothing = return ()
 	go (Just fd) = catchDefaultIO Nothing $ do

Utility/DirWatcher/Kqueue.hs

@@ -111,7 +111,9 @@ scanRecursive topdir prune = M.fromList <$> walk [] [topdir]
 				Nothing -> walk c rest
 				Just info -> do
 					mfd <- catchMaybeIO $
-						openFdWithMode (toRawFilePath dir) Posix.ReadOnly Nothing Posix.defaultFileFlags
+						openFdWithMode (toRawFilePath dir) Posix.ReadOnly Nothing
+							Posix.defaultFileFlags
+							(CloseOnExecFlag True)
 					case mfd of
 						Nothing -> walk c rest
 						Just fd -> do

Utility/LockFile/PidLock.hs

@@ -210,7 +210,8 @@ linkToLock (Just _) src dest = do
 			let setup = do
 				fd <- openFdWithMode dest' WriteOnly
 					(Just $ combineModes readModes)
-					(defaultFileFlags {exclusive = True})
+					(defaultFileFlags { exclusive = True })
+					(CloseOnExecFlag True)
 				fdToHandle fd
 			let cleanup = hClose
 			let go h = readFile (fromOsPath src) >>= hPutStr h

Utility/LockFile/Posix.hs

@@ -5,8 +5,6 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Utility.LockFile.Posix (
 	LockHandle,
 	lockShared,
@@ -76,16 +74,10 @@ tryLock lockreq mode lockfile = uninterruptibleMask_ $ do
 
 -- Close on exec flag is set so child processes do not inherit the lock.
 openLockFile :: LockRequest -> Maybe ModeSetter -> LockFile -> IO Fd
-openLockFile lockreq filemode lockfile = do
-	l <- applyModeSetter filemode lockfile $ \filemode' ->
-		openFdWithMode (fromOsPath lockfile) openfor filemode' $
-#if MIN_VERSION_unix(2,8,0)
-			defaultFileFlags { cloexec = True }
-#else
-			defaultFileFlags
-	setFdOption l CloseOnExec True
-#endif
-	return l
+openLockFile lockreq filemode lockfile =
+	applyModeSetter filemode lockfile $ \filemode' ->
+		openFdWithMode (fromOsPath lockfile) openfor filemode'
+			defaultFileFlags (CloseOnExecFlag True)
   where
 	openfor = case lockreq of
 		ReadLock -> ReadOnly

Utility/OpenFd.hs

@@ -1,6 +1,6 @@
 {- openFd wrapper to support old versions of unix package.
  -
- - Copyright 2023 Joey Hess <id@joeyh.name>
+ - Copyright 2023-2025 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -17,12 +17,17 @@ import System.Posix.Types
 
 import Utility.RawFilePath
 
-openFdWithMode :: RawFilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
+newtype CloseOnExecFlag = CloseOnExecFlag Bool
+
+openFdWithMode :: RawFilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> CloseOnExecFlag -> IO Fd
+openFdWithMode f openmode filemode flags (CloseOnExecFlag closeonexec) = do
 #if MIN_VERSION_unix(2,8,0)
-openFdWithMode f openmode filemode flags = 
-	openFd f openmode (flags { creat = filemode })
+	openFd f openmode (flags { creat = filemode, cloexec = closeonexec })
 #else
-openFdWithMode = openFd
+	fd <- openFd f openmode filemode flags
+	when closeonexec $
+		setFdOption fd CloseOnExec True
+	return fd
 #endif
 
 #endif

Utility/OpenFile.hs

@@ -31,7 +31,7 @@ import Utility.FileSystemEncoding
  -}
 openFileBeingWritten :: RawFilePath -> IO Handle
 openFileBeingWritten f = do
-	fd <- openFdWithMode f ReadOnly Nothing defaultFileFlags
+	fd <- openFdWithMode f ReadOnly Nothing defaultFileFlags (CloseOnExecFlag True)
 	(fd', fdtype) <- mkFD (fromIntegral fd) ReadMode (Just (Stream, 0, 0)) False False
 	mkHandleFromFD fd' fdtype (fromRawFilePath f) ReadMode False Nothing
 

doc/bugs/35_failed_tests_on_beegfs/comment_7_9cfa54f7784de785cf576789ed671975._comment

@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2025-09-04T19:42:44Z"
+ content="""
+I've checked all uses of openFd and made CloseOnExec be used where
+appropriate. Also checked all the fd dupping.
+
+This won't fix the problem, but is necessary goundwork for fixing
+openFile and the rest.
+"""]]