packages feed

git-annex 10.20250828 → 10.20250925

raw patch · 153 files changed

+894/−535 lines, 153 filesdep −cryptonitedep ~utf8-string

Dependencies removed: cryptonite

Dependency ranges changed: utf8-string

Files

Annex.hs view
@@ -226,6 +226,7 @@ 	, cachedgitenv :: Maybe (AltIndexFile, OsPath, [(String, String)]) 	, urloptions :: Maybe UrlOptions 	, insmudgecleanfilter :: Bool+	, inreconcilestaged :: Bool 	, getvectorclock :: IO CandidateVectorClock 	, proxyremote :: Maybe (Either ClusterUUID (Types.Remote.RemoteA Annex)) 	, reposizehandle :: Maybe RepoSizeHandle@@ -283,6 +284,7 @@ 		, cachedgitenv = Nothing 		, urloptions = Nothing 		, insmudgecleanfilter = False+		, inreconcilestaged = False 		, getvectorclock = vc 		, proxyremote = Nothing 		, reposizehandle = Nothing
Annex/Balanced.hs view
@@ -12,11 +12,10 @@ import Utility.Hash  import Data.Maybe+import Data.List import Data.Bits (shiftL) import qualified Data.Set as S import qualified Data.ByteArray as BA-import Data.List-import Prelude  -- The Int is how many UUIDs to pick. type BalancedPicker = S.Set UUID -> Key -> Int -> [UUID]
Annex/Content.hs view
@@ -276,8 +276,7 @@ winLocker takelock _ (Just lockfile) =  	let lck = do 		modifyContentDir lockfile $-			void $ liftIO $ tryIO $-				writeFile (fromOsPath lockfile) ""+			void $ liftIO $ tryIO $ writeFileString lockfile "" 		liftIO $ takelock lockfile 	in (lck, Nothing) -- never reached; windows always uses a separate lock file@@ -543,7 +542,7 @@ 			unless (null fs) $ do 				destic <- withTSDelta $ 					liftIO . genInodeCache dest-				ics <- mapM (populatePointerFile (Restage True) key dest) fs+				ics <- mapM (populatePointerFile QueueRestage key dest) fs 				Database.Keys.addInodeCaches key 					(catMaybes (destic:ics)) 		)@@ -785,7 +784,7 @@ 	resetpointer file = unlessM (liftIO $ isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath file)) $ 		ifM (isUnmodified key file) 			( adjustedBranchRefresh $ -				depopulatePointerFile key file+				depopulatePointerFile QueueRestage key file 			-- Modified file, so leave it alone. 			-- If it was a hard link to the annex object, 			-- that object might have been frozen as part of the@@ -991,7 +990,7 @@ 	-- clean up gitAnnexTmpWorkDir for those it finds. 	obj <- prepTmp key 	unlessM (liftIO $ doesFileExist obj) $ do-		liftIO $ writeFile (fromOsPath obj) ""+		liftIO $ writeFileString  obj "" 		setAnnexFilePerm obj 	let tmpdir = gitAnnexTmpWorkDir obj 	createAnnexDirectory tmpdir@@ -1083,7 +1082,7 @@ 		readContentRetentionTimestamp rt >>= \case 			Just ts | ts >= t -> return () 			_ -> replaceFile (const noop) rt $ \tmp ->-				liftIO $ writeFile (fromOsPath tmp) $ show t+				liftIO $ writeFileString tmp $ show t   where 	lock = takeExclusiveLock 	unlock = liftIO . dropLock
Annex/Content/PointerFile.hs view
@@ -52,8 +52,8 @@ {- Removes the content from a pointer file, replacing it with a pointer.  -  - Does not check if the pointer file is modified. -}-depopulatePointerFile :: Key -> OsPath -> Annex ()-depopulatePointerFile key file = do+depopulatePointerFile :: Restage -> Key -> OsPath -> Annex ()+depopulatePointerFile restage key file = do 	st <- liftIO $ catchMaybeIO $ R.getFileStatus (fromOsPath file) 	let mode = fmap fileMode st 	secureErase file@@ -68,4 +68,4 @@ 			(fmap Posix.modificationTimeHiRes st) #endif 		withTSDelta (liftIO . genInodeCache tmp)-	maybe noop (restagePointerFile (Restage True) file) ic+	maybe noop (restagePointerFile restage file) ic
Annex/Fixup.hs view
@@ -1,6 +1,6 @@ {- git-annex repository fixups  -- - Copyright 2013-2020 Joey Hess <id@joeyh.name>+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,29 +9,14 @@  module Annex.Fixup where +import Common import Git.Types import Git.Config import Types.GitConfig-import Utility.Path-import Utility.Path.AbsRel-import Utility.SafeCommand-import Utility.Directory-import Utility.Exception-import Utility.Monad-import Utility.SystemDirectory-import Utility.OsPath import qualified Utility.RawFilePath as R-import Utility.PartialPrelude import qualified Utility.OsString as OS -import System.IO-import Data.List-import Data.Maybe-import Control.Monad-import Control.Monad.IfElse import qualified Data.Map as M-import Control.Applicative-import Prelude  fixupRepo :: Repo -> GitConfig -> IO Repo fixupRepo r c = do@@ -132,11 +117,11 @@ 	-- git-worktree sets up a "commondir" file that contains 	-- the path to the main git directory. 	-- Using --separate-git-dir does not.-	commondirfile = fromOsPath (d </> literalOsPath "commondir")+	commondirfile = d </> literalOsPath "commondir" 	 	readcommondirfile = catchDefaultIO Nothing $ 		fmap toOsPath . headMaybe . lines-			<$> readFile commondirfile+			<$> readFileString commondirfile  	setworktreepath r' = readcommondirfile >>= \case 		Just gd -> return $ r'
Annex/Import.hs view
@@ -21,6 +21,7 @@ 	importKeys, 	makeImportMatcher, 	getImportableContents,+	PostExportLogUpdate, ) where  import Annex.Common@@ -112,8 +113,9 @@ 	-> ImportCommitConfig 	-> AddUnlockedMatcher 	-> Imported+	-> PostExportLogUpdate 	-> Annex (Maybe Ref)-buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported =+buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported postexportlogupdate = 	case importCommitTracking importcommitconfig of 		Nothing -> go Nothing 		Just trackingcommit -> inRepo (Git.Ref.tree trackingcommit) >>= \case@@ -121,12 +123,14 @@ 			Just _ -> go (Just trackingcommit)   where 	go trackingcommit = do-		(importedtree, updatestate) <- recordImportTree remote importtreeconfig (Just addunlockedmatcher) imported+		(importedtree, updatestate) <- recordImportTree remote importtreeconfig (Just addunlockedmatcher) imported postexportlogupdate 		buildImportCommit' remote importcommitconfig trackingcommit importedtree >>= \case 			Just finalcommit -> do 				updatestate 				return (Just finalcommit)-			Nothing -> return Nothing+			Nothing -> do+				postExportLogUpdate postexportlogupdate+				return Nothing  {- Builds a tree for an import from a special remote.  -@@ -138,8 +142,9 @@ 	-> ImportTreeConfig 	-> Maybe AddUnlockedMatcher 	-> Imported+	-> PostExportLogUpdate 	-> Annex (History Sha, Annex ())-recordImportTree remote importtreeconfig addunlockedmatcher imported = do+recordImportTree remote importtreeconfig addunlockedmatcher imported postexportlogupdate = do 	importedtree@(History finaltree _) <- buildImportTrees basetree subdir addunlockedmatcher imported 	return (importedtree, updatestate finaltree)   where@@ -180,6 +185,7 @@ 			{ oldTreeish = exportedTreeishes oldexport 			, newTreeish = importedtree 			}+		postExportLogUpdate postexportlogupdate 		return oldexport  	-- importKeys takes care of updating the location log@@ -498,12 +504,27 @@   where 	ia = Remote.importActions remote --- Result of an import. ImportUnfinished indicates that some file failed to--- be imported. Running again should resume where it left off.+-- Result of an import.  data ImportResult t-	= ImportFinished t+	= ImportFinished PostExportLogUpdate t 	| ImportUnfinished+	-- ^ ImportUnfinished indicates that some file failed to+	-- be imported. Running again should resume where it left off. +-- An action to run after the export log has been updated to reflect an+-- import.+newtype PostExportLogUpdate = PostExportLogUpdate (Annex ())++instance Semigroup PostExportLogUpdate where+	PostExportLogUpdate a <> PostExportLogUpdate b =+		PostExportLogUpdate (a >> b)++noPostExportLogUpdate :: PostExportLogUpdate+noPostExportLogUpdate = PostExportLogUpdate (return ())++postExportLogUpdate :: PostExportLogUpdate -> Annex ()+postExportLogUpdate (PostExportLogUpdate a) = a+ data Diffed t 	= DiffChanged t 	| DiffRemoved@@ -546,7 +567,10 @@ 					Nothing -> fullimport currcidtree 					Just lastimportedtree -> diffimport cidtreemap prevcidtree currcidtree lastimportedtree   where-	remember = recordContentIdentifierTree (Remote.uuid remote)+  	-- Record the content identifier tree after the export log is+	-- updated for the import.+	remember = PostExportLogUpdate .+		recordContentIdentifierTree (Remote.uuid remote)  	-- In order to use a diff, the previous ContentIdentifier tree must 	-- not have been garbage collected. Which can happen since there@@ -567,11 +591,11 @@ 						)  	fullimport currcidtree = -		importKeys remote importtreeconfig importcontent thirdpartypopulated importablecontents >>= \case-			ImportUnfinished -> return ImportUnfinished-			ImportFinished r -> do-				remember currcidtree-	 			return $ ImportFinished $ ImportedFull r+		importKeys remote importtreeconfig importcontent thirdpartypopulated importablecontents >>= return . \case+			ImportUnfinished -> ImportUnfinished+			ImportFinished a r -> +				ImportFinished (a <> remember currcidtree) $+					ImportedFull r 		 	diffimport cidtreemap prevcidtree currcidtree lastimportedtree = do 		(diff, cleanup) <- inRepo $ Git.DiffTree.diffTreeRecursive@@ -589,17 +613,15 @@ 			ImportUnfinished -> do 				void $ liftIO cleanup 				return ImportUnfinished-			ImportFinished (ImportableContentsComplete ic') -> -				liftIO cleanup >>= \case-					False -> return ImportUnfinished-					True -> do-						remember currcidtree-						return $ ImportFinished $ -							ImportedDiff lastimportedtree-								(mkdiff ic' removed)+			ImportFinished a (ImportableContentsComplete ic') -> +				liftIO cleanup >>= return . \case+					False -> ImportUnfinished+					True -> ImportFinished (a <> remember currcidtree) $ +						ImportedDiff lastimportedtree+							(mkdiff ic' removed) 			-- importKeys is not passed ImportableContentsChunked 			-- above, so it cannot return it-			ImportFinished (ImportableContentsChunked {}) -> error "internal"+			ImportFinished _ (ImportableContentsChunked {}) -> error "internal" 		 	isremoval ti = Git.DiffTree.dstsha ti `elem` nullShas 	@@ -685,12 +707,12 @@ 			ImportableContentsComplete ic -> 				go False largematcher cidmap importing db ic >>= return . \case 					Nothing -> ImportUnfinished-					Just v -> ImportFinished $ ImportableContentsComplete v+					Just v -> ImportFinished noPostExportLogUpdate $ ImportableContentsComplete v 			ImportableContentsChunked {} -> do 				c <- gochunked db (importableContentsChunk importablecontents) 				gohistory largematcher cidmap importing db (importableHistoryComplete importablecontents) >>= return . \case 					Nothing -> ImportUnfinished-					Just h -> ImportFinished $ ImportableContentsChunked+					Just h -> ImportFinished noPostExportLogUpdate $ ImportableContentsChunked 						{ importableContentsChunk = c 						, importableHistoryComplete = h 						}
Annex/Ingest.hs view
@@ -172,7 +172,7 @@ {- Ingests a locked down file into the annex. Does not update the working  - tree or the index. -} ingest :: MeterUpdate -> Maybe LockedDown -> Maybe Key -> Annex (Maybe Key, Maybe InodeCache)-ingest meterupdate ld mk = ingest' Nothing meterupdate ld mk (Restage True)+ingest meterupdate ld mk = ingest' Nothing meterupdate ld mk QueueRestage  ingest' :: Maybe Backend -> MeterUpdate -> Maybe LockedDown -> Maybe Key -> Restage -> Annex (Maybe Key, Maybe InodeCache) ingest' _ _ Nothing _ _ = return (Nothing, Nothing)@@ -228,7 +228,7 @@ finishIngestUnlocked :: Key -> KeySource -> Annex () finishIngestUnlocked key source = do 	cleanCruft source-	finishIngestUnlocked' key source (Restage True) Nothing+	finishIngestUnlocked' key source QueueRestage Nothing  finishIngestUnlocked' :: Key -> KeySource -> Restage -> Maybe LinkAnnexResult -> Annex () finishIngestUnlocked' key source restage lar = do
Annex/Link.hs view
@@ -7,7 +7,7 @@  -  - Pointer files are used instead of symlinks for unlocked files.  -- - Copyright 2013-2022 Joey Hess <id@joeyh.name>+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -32,6 +32,7 @@ import Annex.HashObject import Annex.InodeSentinal import Annex.PidLock+import Types.CleanupActions import Utility.FileMode import Utility.InodeCache import Utility.Tmp.Dir@@ -44,8 +45,10 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L+ #ifndef mingw32_HOST_OS #if MIN_VERSION_unix(2,8,0)+import Utility.OpenFd #else import System.PosixCompat.Files (isSymbolicLink) #endif@@ -159,7 +162,10 @@ 	F.writeFile' file (formatPointer k) 	maybe noop (R.setFileMode (fromOsPath file)) mode -newtype Restage = Restage Bool+data Restage+	= NoRestage+	| QueueRestage+	| LaterRestage  {- Restage pointer file. This is used after updating a worktree file  - when content is added/removed, to prevent git status from showing@@ -183,26 +189,27 @@  - and will store it in the restage log. Displays a message to help the  - user understand why the file will appear to be modified.  -- - This uses the git queue, so the update is not performed immediately,- - and this can be run multiple times cheaply. Using the git queue also- - prevents building up too large a number of updates when many files- - are being processed. It's also recorded in the restage log so that,- - if the process is interrupted before the git queue is fulushed, the- - restage will be taken care of later.+ - The update is not performed immediately, so and this can be run multiple+ - times cheaply. It's also recorded in the restage log so that, if the+ - process is interrupted before the git queue is fulushed, the restage+ - will be taken care of later.  -} restagePointerFile :: Restage -> OsPath -> InodeCache -> Annex ()-restagePointerFile (Restage False) f orig = do+restagePointerFile NoRestage f orig = do 	flip writeRestageLog orig =<< inRepo (toTopFilePath f) 	toplevelWarning True $ unableToRestage $ Just f-restagePointerFile (Restage True) f orig = do+{- Using the git queue prevents building up too large a number of updates+ - when many files are being processed.  -}+restagePointerFile QueueRestage f orig = do 	flip writeRestageLog orig =<< inRepo (toTopFilePath f)-	-- Avoid refreshing the index if run by the-	-- smudge clean filter, because git uses that when-	-- it's already refreshing the index, probably because-	-- this very action is running. Running it again would likely-	-- deadlock. 	unlessM (Annex.getState Annex.insmudgecleanfilter) $ 		Annex.Queue.addFlushAction restagePointerFileRunner [f]+{- Defer the restage until the end. -}+restagePointerFile LaterRestage f orig = do+	flip writeRestageLog orig =<< inRepo (toTopFilePath f)+	unlessM (Annex.getState Annex.insmudgecleanfilter) $+		Annex.addCleanupAction RestagePointerFiles $ +			restagePointerFiles =<< Annex.gitRepo  restagePointerFileRunner :: Git.Queue.FlushActionRunner Annex restagePointerFileRunner = @@ -218,7 +225,7 @@ -- to bypass the lock. Then replace the old index file with the new -- updated index file. restagePointerFiles :: Git.Repo -> Annex ()-restagePointerFiles r = unlessM (Annex.getState Annex.insmudgecleanfilter) $ do+restagePointerFiles r = checkcanrun $ do 	-- Flush any queued changes to the keys database, so they 	-- are visible to child processes. 	-- The database is closed because that may improve behavior@@ -329,6 +336,9 @@ 		ck = ConfigKey "filter.annex.process" 		ckd = ConfigKey "filter.annex.process-temp-disabled" +	checkcanrun a = unlessM (Annex.getState Annex.insmudgecleanfilter) $+		unlessM (Annex.getState Annex.inreconcilestaged) $ a+ unableToRestage :: Maybe OsPath -> StringContainingQuotedPath unableToRestage mf = 	"git status will show " <> maybe "some files" QuotedPath mf@@ -447,8 +457,9 @@ #else #if MIN_VERSION_unix(2,8,0) 	let open = do-		fd <- openFd (fromOsPath f) ReadOnly +		fd <- openFdWithMode (fromOsPath f) ReadOnly Nothing 			(defaultFileFlags { nofollow = True })+			(CloseOnExecFlag True) 		fdToHandle fd 	in bracket open hClose readhandle #else
Annex/Locations.hs view
@@ -47,7 +47,6 @@ 	gitAnnexUnusedLog, 	gitAnnexKeysDbDir, 	gitAnnexKeysDbLock,-	gitAnnexKeysDbIndexCache, 	gitAnnexFsckState, 	gitAnnexFsckDbDir, 	gitAnnexFsckDbDirOld,@@ -410,11 +409,6 @@ {- Lock file for the keys database. -} gitAnnexKeysDbLock :: Git.Repo -> GitConfig -> OsPath gitAnnexKeysDbLock  r c = gitAnnexKeysDbDir r c <> literalOsPath ".lck"--{- Contains the stat of the last index file that was- - reconciled with the keys database. -}-gitAnnexKeysDbIndexCache :: Git.Repo -> GitConfig -> OsPath-gitAnnexKeysDbIndexCache r c = gitAnnexKeysDbDir r c <> literalOsPath ".cache"  {- .git/annex/fsck/uuid/ is used to store information about incremental  - fscks. -}
Annex/MetaData/StandardFields.hs view
@@ -22,8 +22,6 @@ import Types.MetaData  import qualified Data.Text as T-import Data.Monoid-import Prelude  tagMetaField :: MetaField tagMetaField = mkMetaFieldUnchecked "tag"
Annex/Multicast.hs view
@@ -1,18 +1,25 @@ {- git-annex multicast receive callback  -- - Copyright 2017 Joey Hess <id@joeyh.name>+ - Copyright 2017-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Annex.Multicast where  import Common import Annex.Path import Utility.Env -import System.Process-import GHC.IO.Handle.FD+#ifndef mingw32_HOST_OS+import System.Posix.IO+#else+import System.Process (createPipeFd)+import GHC.IO.Handle.FD (fdToHandle)+#endif+import GHC.IO.Encoding (getLocaleEncoding)  multicastReceiveEnv :: String multicastReceiveEnv = "GIT_ANNEX_MULTICAST_RECEIVE"@@ -20,9 +27,16 @@ multicastCallbackEnv :: IO (OsPath, [(String, String)], Handle) multicastCallbackEnv = do 	gitannex <- programPath-	-- This will even work on Windows+#ifndef mingw32_HOST_OS+	(rfd, wfd) <- noCreateProcessWhile $ do+		(rfd, wfd) <- createPipe+		setFdOption rfd CloseOnExec True+		return (rfd, wfd)+#else 	(rfd, wfd) <- createPipeFd+#endif 	rh <- fdToHandle rfd+	getLocaleEncoding >>= hSetEncoding rh 	environ <- addEntry multicastReceiveEnv (show wfd) <$> getEnvironment 	return (gitannex, environ, rh) @@ -35,6 +49,7 @@ runMulticastReceive ("-I":_sessionid:fs) hs = case readish hs of 	Just fd -> do 		h <- fdToHandle fd+		getLocaleEncoding >>= hSetEncoding h 		mapM_ (hPutStrLn h) fs 		hClose h 	Nothing -> return ()
Annex/Path.hs view
@@ -65,7 +65,7 @@ readProgramFile :: IO (Maybe OsPath) readProgramFile = catchDefaultIO Nothing $ do 	programfile <- programFile-	fmap toOsPath . headMaybe . lines <$> readFile (fromOsPath programfile)+	fmap toOsPath . headMaybe . lines <$> readFileString programfile  cannotFindProgram :: IO a cannotFindProgram = do
Annex/Sim.hs view
@@ -1356,16 +1356,15 @@ 	let st'' = st' 		{ simRepoState = M.map freeze (simRepoState st') 		}-	let statefile = fromOsPath $ -		toOsPath (simRootDirectory st'') </> literalOsPath "state"-	writeFile statefile (show st'')+	let statefile = toOsPath (simRootDirectory st'') </> literalOsPath "state"+	writeFileString statefile (show st'')   where 	freeze :: SimRepoState SimRepo -> SimRepoState () 	freeze rst = rst { simRepo = Nothing }  restoreSim :: OsPath -> IO (Either String (SimState SimRepo)) restoreSim rootdir = -	tryIO (readFile statefile) >>= \case+	tryIO (readFileString statefile) >>= \case 		Left err -> return (Left (show err)) 		Right c -> case readMaybe c :: Maybe (SimState ()) of 			Nothing -> return (Left "unable to parse sim state file")@@ -1379,7 +1378,7 @@ 					} 				return (Right st'')   where-	statefile = fromOsPath $ rootdir </> literalOsPath "state"+	statefile = rootdir </> literalOsPath "state" 	thaw st (u, rst) = tryNonAsync (thaw' st u) >>= return . \case 		Left _ -> (u, rst { simRepo = Nothing }) 		Right r -> (u, rst { simRepo = Just r })
Annex/SpecialRemote/Config.hs view
@@ -206,13 +206,23 @@ getRemoteConfigValue f (ParsedRemoteConfig m _) = case M.lookup f m of 	Just (RemoteConfigValue v) -> case cast v of 		Just v' -> Just v'-		Nothing -> error $ unwords-			[ "getRemoteConfigValue"-			, fromProposedAccepted f-			, "found value of unexpected type"-			, show (typeOf v) ++ "."-			, "This is a bug in git-annex!"-			]+		Nothing -> case cast v :: Maybe PassedThrough of+			-- Handle the case where an external special remote+			-- tries to SETCONFIG a value belonging to git-annex,+			-- resulting in a PassedThrough type being stored.+			Just _ -> giveup $ unwords+				[ "Special remote config "+				, fromProposedAccepted f+				, "has been overwritten by SETCONFIG."+				, "This is not supported."+				]+			Nothing -> error $ unwords+				[ "getRemoteConfigValue"+				, fromProposedAccepted f+				, "found value of unexpected type"+				, show (typeOf v) ++ "."+				, "This is a bug in git-annex!"+				] 	Nothing -> Nothing  {- Gets all fields that remoteConfigRestPassthrough matched. -}
Annex/Ssh.hs view
@@ -484,4 +484,4 @@ sshAskPassEnv = "GIT_ANNEX_SSHASKPASS"  runSshAskPass :: FilePath -> IO ()-runSshAskPass passfile = putStrLn =<< readFile passfile+runSshAskPass passfile = putStrLn =<< readFileString (toOsPath passfile)
Annex/YoutubeDl.hs view
@@ -94,7 +94,7 @@ 	nofiles = Left $ youtubeDlCommand ++ " did not put any media in its work directory, perhaps it's been configured to store files somewhere else?" 	toomanyfiles fs = Left $ youtubeDlCommand ++ " downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs 	downloadedfiles = liftIO $ -		(nub . lines <$> readFile (fromOsPath filelistfile))+		(nub . lines <$> readFileString filelistfile) 			`catchIO` (pure . const []) 	workdirfiles = liftIO $ filter (/= filelistfile)  		<$> (filterM doesFileExist =<< dirContents workdir)
Assistant.hs view
@@ -56,6 +56,8 @@ #ifdef mingw32_HOST_OS import Utility.Env import System.Environment (getArgs)+#else+import GHC.IO.Encoding (getLocaleEncoding) #endif import qualified Utility.Debug as Debug @@ -82,10 +84,15 @@ 	let logfd = handleToFd =<< openLog (fromOsPath logfile) 	if foreground 		then do-			origout <- liftIO $ catchMaybeIO $ -				fdToHandle =<< dup stdOutput-			origerr <- liftIO $ catchMaybeIO $ -				fdToHandle =<< dup stdError+			enc <- liftIO getLocaleEncoding+			origout <- liftIO $ catchMaybeIO $ do+				h <- fdToHandle =<< dup stdOutput+				hSetEncoding h enc+				return h+			origerr <- liftIO $ catchMaybeIO $ do+				h <- fdToHandle =<< dup stdError+				hSetEncoding h enc+				return h 			let undaemonize = Utility.Daemon.foreground logfd (Just pidfile) 			start undaemonize $  				case startbrowser of
Assistant/DaemonStatus.hs view
@@ -132,7 +132,7 @@ 		]  readDaemonStatusFile :: FilePath -> IO DaemonStatus-readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFile file+readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFileString (toOsPath file)   where 	parse status = foldr parseline status . lines 	parseline line status
Assistant/Gpg.hs view
@@ -16,8 +16,6 @@  import Data.Maybe import qualified Data.Map as M-import Control.Applicative-import Prelude  {- Generates a gpg user id that is not used by any existing secret key -} newUserId :: GpgCmd -> IO UserId
Assistant/Install.hs view
@@ -57,7 +57,7 @@ 		let program = base </> literalOsPath "git-annex" 		programfile <- programFile 		createDirectoryIfMissing True (parentDir programfile)-		writeFile (fromOsPath programfile) (fromOsPath program)+		writeFileString programfile (fromOsPath program)  #ifdef darwin_HOST_OS 		autostartfile <- userAutoStart osxAutoStartLabel@@ -70,7 +70,7 @@ 				let bootfile = toOsPath home </> literalOsPath ".termux" </> literalOsPath "boot" </> literalOsPath "git-annex" 				unlessM (doesFileExist bootfile) $ do 					createDirectoryIfMissing True (takeDirectory bootfile)-					writeFile (fromOsPath bootfile) "git-annex assistant --autostart"+					writeFileString bootfile "git-annex assistant --autostart" 			, do 				menufile <- desktopMenuFilePath "git-annex" <$> userDataDir 				icondir <- iconDir <$> userDataDir@@ -125,7 +125,7 @@ 	userdata <- userDataDir 	let kdeServiceMenusdir = userdata </> literalOsPath "kservices5" </> literalOsPath "ServiceMenus" 	createDirectoryIfMissing True kdeServiceMenusdir-	writeFile (fromOsPath (kdeServiceMenusdir </> literalOsPath "git-annex.desktop"))+	writeFileString (kdeServiceMenusdir </> literalOsPath "git-annex.desktop") 		(kdeDesktopFile actions)   where 	genNautilusScript scriptdir action =@@ -136,7 +136,7 @@ 			] 	scriptname action = "git-annex " ++ action 	installscript f c = whenM (safetoinstallscript f) $ do-		writeFile (fromOsPath f) c+		writeFileString f c 		modifyFileMode f $ addModes [ownerExecuteMode] 	safetoinstallscript f = catchDefaultIO True $ 		elem (encodeBS autoaddedcomment) . fileLines'
Assistant/Install/AutoStart.hs view
@@ -23,7 +23,7 @@ installAutoStart command file = do #ifdef darwin_HOST_OS 	createDirectoryIfMissing True (parentDir file)-	writeFile (fromOsPath file) $ genOSXAutoStartFile osxAutoStartLabel command+	writeFileString file $ genOSXAutoStartFile osxAutoStartLabel command 		["assistant", "--autostart"] #else 	writeDesktopMenuFile (fdoAutostart command) file
Assistant/Install/Menu.hs view
@@ -13,6 +13,7 @@  import Common import Utility.FreeDesktop+import qualified Utility.FileIO as F  installMenu :: String -> OsPath -> OsPath -> OsPath -> IO () #ifdef darwin_HOST_OS@@ -40,8 +41,8 @@ installIcon :: OsPath -> OsPath -> IO () installIcon src dest = do 	createDirectoryIfMissing True (parentDir dest)-	withBinaryFile (fromOsPath src) ReadMode $ \hin ->-		withBinaryFile (fromOsPath dest) WriteMode $ \hout ->+	F.withBinaryFile src ReadMode $ \hin ->+		F.withBinaryFile dest WriteMode $ \hout -> 			hGetContents hin >>= hPutStr hout  iconBaseName :: String
Assistant/Restart.hs view
@@ -79,7 +79,7 @@ 		r <- Git.Config.read =<< Git.Construct.fromPath repo 		waiturl $ gitAnnexUrlFile r 	waiturl urlfile = do-		v <- tryIO $ readFile (fromOsPath urlfile)+		v <- tryIO $ readFileString urlfile 		case v of 			Left _ -> delayed $ waiturl urlfile 			Right url -> ifM (assistantListening url)
Assistant/Ssh.hs view
@@ -224,8 +224,8 @@ 	unless ok $ 		giveup "ssh-keygen failed" 	SshKeyPair-		<$> readFile (fromOsPath (dir </> literalOsPath "key.pub"))-		<*> readFile (fromOsPath (dir </> literalOsPath "key"))+		<$> readFileString (dir </> literalOsPath "key.pub")+		<*> readFileString (dir </> literalOsPath "key")  {- Installs a ssh key pair, and sets up ssh config with a mangled hostname  - that will enable use of the key. This way we avoid changing the user's@@ -255,7 +255,7 @@ 		writeFileProtected (sshdir </> sshPrivKeyFile sshdata) 			(sshPrivKey sshkeypair) 	unlessM (doesFileExist $ sshdir </> sshPubKeyFile sshdata) $-		writeFile (fromOsPath (sshdir </> sshPubKeyFile sshdata))+		writeFileString (sshdir </> sshPubKeyFile sshdata) 			(sshPubKey sshkeypair)  	setSshConfig sshdata@@ -277,8 +277,10 @@ setupSshKeyPair :: SshData -> IO (SshData, SshKeyPair) setupSshKeyPair sshdata = do 	sshdir <- sshDir-	mprivkey <- catchMaybeIO $ readFile (fromOsPath (sshdir </> sshPrivKeyFile sshdata))-	mpubkey <- catchMaybeIO $ readFile (fromOsPath (sshdir </> sshPubKeyFile sshdata))+	mprivkey <- catchMaybeIO $ readFileString+		(sshdir </> sshPrivKeyFile sshdata)+	mpubkey <- catchMaybeIO $ readFileString+		(sshdir </> sshPubKeyFile sshdata) 	keypair <- case (mprivkey, mpubkey) of 		(Just privkey, Just pubkey) -> return $ SshKeyPair 			{ sshPubKey = pubkey@@ -330,15 +332,15 @@ setSshConfig sshdata config = do 	sshdir <- sshDir 	createDirectoryIfMissing True sshdir-	let configfile = fromOsPath (sshdir </> literalOsPath "config")-	unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFile configfile) $ do-		appendFile configfile $ unlines $+	let configfile = sshdir </> literalOsPath "config"+	unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFileString configfile) $ do+		appendFileString configfile $ unlines $ 			[ "" 			, "# Added automatically by git-annex" 			, "Host " ++ mangledhost 			] ++ map (\(k, v) -> "\t" ++ k ++ " " ++ v) 				(settings ++ config)-		setSshConfigMode (toOsPath configfile)+		setSshConfigMode configfile  	return $ sshdata 		{ sshHostName = T.pack mangledhost
Assistant/Threads/Committer.hs view
@@ -62,6 +62,11 @@ 		fmap Seconds . annexDelayAdd <$> Annex.getGitConfig 	largefilematcher <- liftAnnex largeFilesMatcher 	annexdotfiles <- liftAnnex $ getGitConfigVal annexDotFiles+	addunlockedmatcher <- liftAnnex $+		ifM (annexSupportUnlocked <$> Annex.getGitConfig)+			( Just <$> addUnlockedMatcher+			, return Nothing+			) 	msg <- liftAnnex Command.Sync.commitMsg 	lockdowndir <- liftAnnex $ fromRepo gitAnnexTmpWatcherDir 	liftAnnex $ do@@ -70,7 +75,7 @@ 		void $ liftIO $ tryIO $ removeDirectoryRecursive lockdowndir 		void $ createAnnexDirectory lockdowndir 	waitChangeTime $ \(changes, time) -> do-		readychanges <- handleAdds lockdowndir havelsof largefilematcher annexdotfiles delayadd $+		readychanges <- handleAdds lockdowndir havelsof largefilematcher annexdotfiles addunlockedmatcher delayadd $ 			simplifyChanges changes 		if shouldCommit False time (length readychanges) readychanges 			then do@@ -275,8 +280,8 @@  - Any pending adds that are not ready yet are put back into the ChangeChan,  - where they will be retried later.  -}-handleAdds :: OsPath -> Bool -> GetFileMatcher -> Bool -> Maybe Seconds -> [Change] -> Assistant [Change]-handleAdds lockdowndir havelsof largefilematcher annexdotfiles delayadd cs = returnWhen (null incomplete) $ do+handleAdds :: OsPath -> Bool -> GetFileMatcher -> Bool -> Maybe AddUnlockedMatcher -> Maybe Seconds -> [Change] -> Assistant [Change]+handleAdds lockdowndir havelsof largefilematcher annexdotfiles addunlockedmatcher delayadd cs = returnWhen (null incomplete) $ do 	let (pending, inprocess) = partition isPendingAddChange incomplete 	let lockdownconfig = LockDownConfig 		{ lockingFile = False@@ -340,9 +345,9 @@ 			Command.Add.addFile Command.Add.Small f 				=<< liftIO (R.getSymbolicLinkStatus (fromOsPath f)) -	{- Avoid overhead of re-injesting a renamed unlocked file, by-	 - examining the other Changes to see if a removed file has the-	 - same InodeCache as the new file. If so, we can just update+	{- When adding the file unlocked, avoid overhead of re-injesting a renamed+	 - unlocked file, by examining the other Changes to see if a removed+	 - file has the same InodeCache as the new file. If so, we can just update 	 - bookkeeping, and stage the file in git. 	 -} 	addannexed :: [Change] -> Assistant [Maybe Change]@@ -357,18 +362,36 @@ 			, checkWritePerms = True 			} 		if M.null m-			then forM toadd (addannexed' cfg)+			then forM toadd $ \c -> do+				mcache <- liftIO $ genInodeCache (changeFile c) delta+				addunlocked <- checkaddunlocked c+				addannexed' cfg c addunlocked mcache 			else forM toadd $ \c -> do 				mcache <- liftIO $ genInodeCache (changeFile c) delta-				case mcache of-					Nothing -> addannexed' cfg c-					Just cache ->-						case M.lookup (inodeCacheToKey ct cache) m of-							Nothing -> addannexed' cfg c-							Just k -> fastadd c k+				ifM (checkaddunlocked c)+					( case mcache of+						Nothing -> addannexed' cfg c True Nothing+						Just cache ->+							case M.lookup (inodeCacheToKey ct cache) m of+								Nothing -> addannexed' cfg c True Nothing+								Just k -> fastadd c k+					, addannexed' cfg c False mcache+					) -	addannexed' :: LockDownConfig -> Change -> Assistant (Maybe Change)-	addannexed' lockdownconfig change@(InProcessAddChange { lockedDown = ld }) = +	checkaddunlocked (InProcessAddChange { lockedDown = ld }) = +		case addunlockedmatcher of+			Just addunlockedmatcher' -> do+				let mi = MatchingFile $ FileInfo+					{ contentFile = contentLocation (keySource ld)+					, matchFile = keyFilename (keySource ld)+					, matchKey = Nothing+					}+				liftAnnex $ addUnlocked addunlockedmatcher' mi True+			Nothing -> return True+	checkaddunlocked _ = return True++	addannexed' :: LockDownConfig -> Change -> Bool -> Maybe InodeCache -> Assistant (Maybe Change)+	addannexed' lockdownconfig change@(InProcessAddChange { lockedDown = ld }) addunlocked mcache =  		catchDefaultIO Nothing <~> doadd 	  where 	  	ks = keySource ld@@ -376,14 +399,14 @@ 			(mkey, _mcache) <- liftAnnex $ do 				showStartMessage (StartMessage "add" (ActionItemOther (Just (QuotedPath (keyFilename ks)))) (SeekInput [])) 				ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing-			maybe (failedingest change) (done change $ keyFilename ks) mkey-	addannexed' _ _ = return Nothing+			maybe (failedingest change) (done change addunlocked mcache $ keyFilename ks) mkey+	addannexed' _ _ _ _ = return Nothing  	fastadd :: Change -> Key -> Assistant (Maybe Change) 	fastadd change key = do 		let source = keySource $ lockedDown change 		liftAnnex $ finishIngestUnlocked key source-		done change (keyFilename source) key+		done change True Nothing (keyFilename source) key  	removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) 	removedKeysMap ct l = do@@ -399,11 +422,14 @@ 		liftAnnex showEndFail 		return Nothing -	done change file key = liftAnnex $ do+	done change addunlocked mcache file key = liftAnnex $ do 		logStatus NoLiveUpdate key InfoPresent-		mode <- liftIO $ catchMaybeIO $-			fileMode <$> R.getFileStatus (fromOsPath file)-		stagePointerFile file mode =<< hashPointerFile key+		if addunlocked+			then do+				mode <- liftIO $ catchMaybeIO $+					fileMode <$> R.getFileStatus (fromOsPath file)+				stagePointerFile file mode =<< hashPointerFile key+			else addSymlink file key mcache 		showEndOk 		return $ Just $ finishedChange change key
Assistant/Types/BranchChange.hs view
@@ -8,8 +8,6 @@ module Assistant.Types.BranchChange where  import Control.Concurrent.MSampleVar-import Control.Applicative-import Prelude  newtype BranchChangeHandle = BranchChangeHandle (MSampleVar ())
Assistant/Upgrade.hs view
@@ -160,7 +160,7 @@ 		unlessM (boolSystem (fromOsPath program) [Param "version"]) $ 			giveup "New git-annex program failed to run! Not using." 		pf <- programFile-		liftIO $ writeFile (fromOsPath pf) (fromOsPath program)+		liftIO $ writeFileString pf (fromOsPath program) 	 #ifdef darwin_HOST_OS 	{- OS X uses a dmg, so mount it, and copy the contents into place. -}@@ -281,7 +281,7 @@ deleteFromManifest :: OsPath -> IO () deleteFromManifest dir = do 	fs <- map (\f -> dir </> toOsPath f) . lines -		<$> catchDefaultIO "" (readFile (fromOsPath manifest))+		<$> catchDefaultIO "" (readFileString manifest) 	mapM_ (removeWhenExistsWith removeFile) fs 	removeWhenExistsWith removeFile manifest 	removeEmptyRecursive dir
Assistant/WebApp/Configurators/Local.hs view
@@ -185,7 +185,7 @@   where 	addignore = do 		liftIO $ unlessM (doesFileExist $ literalOsPath ".gitignore") $-			writeFile ".gitignore" ".thumbnails"+			writeFileString (literalOsPath ".gitignore") ".thumbnails" 		void $ inRepo $ 			Git.Command.runBool [Param "add", File ".gitignore"]
Assistant/WebApp/Control.hs view
@@ -74,5 +74,5 @@ getLogR = page "Logs" Nothing $ do 	logfile <- liftAnnex $ fromRepo gitAnnexDaemonLogFile 	logs <- liftIO $ listLogs (fromOsPath logfile)-	logcontent <- liftIO $ concat <$> mapM readFile logs+	logcontent <- liftIO $ concat <$> mapM (readFileString . toOsPath) logs 	$(widgetFile "control/log")
Assistant/WebApp/Documentation.hs view
@@ -34,7 +34,7 @@ 		Just f -> customPage (Just About) $ do 			-- no sidebar, just pages of legalese.. 			setTitle "License"-			license <- liftIO $ readFile (fromOsPath f)+			license <- liftIO $ readFileString f 			$(widgetFile "documentation/license")  getRepoGroupR :: Handler Html
Build/Configure.hs view
@@ -12,10 +12,9 @@ import qualified Git.Version import Utility.SystemDirectory import Utility.OsPath+import qualified Utility.FileIO as F  import Control.Monad-import Control.Applicative-import Prelude  tests :: [TestCase] tests =@@ -93,7 +92,7 @@ setup :: IO () setup = do 	createDirectoryIfMissing True (toOsPath tmpDir)-	writeFile testFile "test file contents"+	F.writeFileString (toOsPath testFile) "test file contents"  cleanup :: IO () cleanup = removeDirectoryRecursive (toOsPath tmpDir)
Build/DesktopFile.hs view
@@ -22,7 +22,6 @@ import System.Environment #ifndef mingw32_HOST_OS  import System.Posix.User-import Prelude #endif  systemwideInstall :: IO Bool@@ -74,7 +73,7 @@ 		, do 			programfile <- inDestDir =<< programFile 			createDirectoryIfMissing True (parentDir programfile)-			writeFile (fromOsPath programfile) command+			writeFileString programfile command 		)  installUser :: FilePath -> IO ()
Build/Mans.hs view
@@ -1,6 +1,6 @@ {- Build man pages.  -- - Copyright 2016 Joey Hess <id@joeyh.name>+ - Copyright 2016-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,16 +9,14 @@  module Build.Mans where +import Utility.Process import System.Directory import System.FilePath import Data.List import Control.Monad-import System.Process import System.Exit import Data.Maybe import Utility.Exception-import Control.Applicative-import Prelude  buildMansOrWarn :: IO () buildMansOrWarn = do@@ -37,15 +35,17 @@ 		destm <- catchMaybeIO $ getModificationTime dest 		if (Just srcm > destm) 			then do-				r <- system $ unwords-					-- Run with per because in some+				(Nothing, Nothing, Nothing, pid) <- createProcess $ shell $ unwords $+					-- Run with perl because in some 					-- cases it may not be executable.-					[ "perl", "./Build/mdwn2man"+					[ "perl"+					, "./Build/mdwn2man" 					, progName src 					, "1" 					, src 					, "> " ++ dest 					]+				r <- waitForProcess pid 				if r == ExitSuccess 					then return (Just dest) 					else return Nothing
Build/TestConfig.hs view
@@ -1,6 +1,7 @@ {- Tests the system and generates SysConfig. -}  {-# OPTIONS_GHC -fno-warn-tabs #-}+{-# LANGUAGE OverloadedStrings #-}  module Build.TestConfig where @@ -9,6 +10,7 @@ import Utility.SafeCommand import Utility.SystemDirectory import Utility.OsPath+import qualified Utility.FileIO as F  import System.IO @@ -42,7 +44,7 @@ 		valuetype (MaybeBoolConfig _) = "Maybe Bool"  writeSysConfig :: [Config] -> IO ()-writeSysConfig config = writeFile "Build/SysConfig" body+writeSysConfig config = F.writeFileString (literalOsPath "Build/SysConfig") body   where 	body = unlines $ header ++ map show config ++ footer 	header = [@@ -100,12 +102,16 @@ 	ifM (inSearchPath command) 		( return $ Config k $ MaybeStringConfig $ Just command 		, do-			r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"]+			r <- getM find+				[ literalOsPath "/usr/sbin"+				, literalOsPath "/sbin"+				, literalOsPath "/usr/local/sbin"+				] 			return $ Config k $ MaybeStringConfig r 		)   where 	find d =-		let f = toOsPath d </> toOsPath command+		let f = d </> toOsPath command 		in ifM (doesFileExist f) 			( return (Just (fromOsPath f)) 			, return Nothing
Build/Version.hs view
@@ -8,14 +8,12 @@ import Data.List import System.Environment import Data.Char-import System.Process-import Control.Applicative-import Prelude  import Utility.Monad import Utility.Exception import Utility.OsPath import Utility.FileSystemEncoding+import Utility.Process import qualified Utility.FileIO as F  type Version = String@@ -39,7 +37,7 @@ 			gitversion <- takeWhile (\c -> isAlphaNum c) <$> readProcess "sh" 				[ "-c" 				, "git log -n 1 --format=format:'%H'"-				] ""+				] 			return $ if null gitversion 				then changelogversion 				else concat@@ -51,7 +49,7 @@ 	 getChangelogVersion :: IO Version getChangelogVersion = do-	changelog <- readFile "CHANGELOG"+	changelog <- F.readFileString (literalOsPath "CHANGELOG") 	let verline = takeWhile (/= '\n') changelog 	return $ middle (words verline !! 1)   where
BuildFlags.hs view
@@ -69,6 +69,11 @@ 	, "Testsuite" 	, "S3" 	, "WebDAV"+#ifdef WITH_OSPATH+	, "OsPath"+#else +#warning Building without the OsPath build flag set results in slower filename manipulation and is not recommended.+#endif 	]  -- Not a complete list, let alone a listing transitive deps, but only@@ -80,11 +85,7 @@ 	, ("bloomfilter", VERSION_bloomfilter) 	, ("http-client", VERSION_http_client) 	, ("persistent-sqlite", VERSION_persistent_sqlite)-#ifdef WITH_CRYPTON 	, ("crypton", VERSION_crypton)-#else-	, ("cryptonite", VERSION_cryptonite)-#endif 	, ("aws", VERSION_aws) 	, ("DAV", VERSION_DAV) #ifdef WITH_TORRENTPARSER
CHANGELOG view
@@ -1,3 +1,35 @@+git-annex (10.20250925) upstream; urgency=medium++  * Fix bug that made changes to a special remote sometimes be missed when+    importing a tree from it. After upgrading, any such missed changes+    will be included in the next tree imported from a special remote.+    Fixes reversion introduced in version 10.20230626.+  * Fix crash operating on filenames that are exactly 21 bytes long+    and begin with a utf-8 character.+  * Fix hang that could occur when using git-annex adjust on a branch with+    a number of files greater than annex.queuesize.+  * Fix bug that could cause an invalid utf-8 sequence to be used in a+    temporary filename when the input filename was valid utf-8.+  * Improve performance when used with a local git remote that has a+    large working tree.+  * drop: --fast support when dropping from a remote.+  * Added annex.assistant.allowunlocked config.+  * Add git-remote-p2p-annex and git-remote-tor-annex to standalone builds.+  * enableremote: Disallow using type= to attempt to change the type of an+    existing remote.+  * Add build warnings when git-annex is built without the OsPath+    build flag.+  * version: Report on whether it was built with the OsPath build flag.+  * Avoid leaking file descriptors to child processes started by git-annex+    in some situations. Note that when not built with the OsPath build+    flag, these leaks can still happen.+  * git-annex.cabal: Turn on the OsPath build flag by default.+  * p2phttp: Fix a hang that could occur when used with --directory,+    and a repository in the directory got removed.+  * Removed support for building with unmaintained cryptonite, use crypton.++ -- Joey Hess <id@joeyh.name>  Thu, 25 Sep 2025 13:20:38 -0400+ git-annex (10.20250828) upstream; urgency=medium    * p2p: Added --enable option, which can be used to enable P2P networks
@@ -42,6 +42,11 @@            2007-2015 Bryan O'Sullivan License: BSD-3-clause +Files: Utility/FileIO/CloseOnExec.hs+Copyright: 2025 Joey Hess <id@joeyh.name>+           2024 Julian Ospald+License: BSD-3-clause+ Files: Utility/Matcher.hs Utility/Tor.hs Utility/Yesod.hs Copyright: © 2010-2023 Joey Hess <id@joeyh.name> License: AGPL-3+@@ -144,7 +149,7 @@     notice, this list of conditions and the following disclaimer in the     documentation and/or other materials provided with the distribution.  .- 3. Neither the name of the author nor the names of his contributors+ 3. Neither the name of the author nor the names of other contributors     may be used to endorse or promote products derived from this software     without specific prior written permission.  .
Command/Drop.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -109,8 +109,17 @@ 		performLocal lu pcc key afile numcopies mincopies preverified ud  startRemote :: LiveUpdate -> PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> DroppingUnused -> Remote -> CommandStart-startRemote lu pcc afile ai si numcopies mincopies key ud remote = -	starting "drop" (OnlyActionOn key ai) si $ do+startRemote lu pcc afile ai si numcopies mincopies key ud remote = do+	fast <- Annex.getRead Annex.fast+	if fast+		then do+			remotes <- Remote.keyPossibilities (Remote.IncludeIgnored True) key+			if remote `elem` remotes+				then go+				else stop+		else go+  where+	go = starting "drop" (OnlyActionOn key ai) si $ do 		showAction $ UnquotedString $ "from " ++ Remote.name remote 		performRemote lu pcc key afile numcopies mincopies remote ud
Command/EnableRemote.hs view
@@ -59,8 +59,11 @@ start o (name:rest) = go =<< filter matchingname <$> Annex.getGitRemotes   where 	matchingname r = Git.remoteName r == Just name-	go [] = deadLast name $ -		startSpecialRemote o name (Logs.Remote.keyValToConfig Proposed rest)+	go [] = deadLast name $+		let config = Logs.Remote.keyValToConfig Proposed rest+		in case M.lookup SpecialRemote.typeField config of+			Nothing -> startSpecialRemote o name config+			Just _ -> giveup "Cannot change type= of existing special remote. Instead, use: git-annex initremote --sameas" 	go (r:_) 		| not (null rest) = go [] 		| otherwise = do
Command/FuzzTest.hs view
@@ -178,7 +178,7 @@ runFuzzAction (FuzzAdd (FuzzFile f)) = do 	createWorkTreeDirectory (parentDir (toOsPath f)) 	n <- liftIO (getStdRandom random :: IO Int)-	liftIO $ writeFile f $ show n ++ "\n"+	liftIO $ writeFileString (toOsPath f) $ show n ++ "\n" runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ 	removeWhenExistsWith removeFile (toOsPath f) runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $
Command/Import.hs view
@@ -349,9 +349,9 @@ 				, Remote.name remote 				, ". Re-run command to resume import." 				]-			ImportFinished imported -> void $-				includeCommandAction $ -					commitimport imported+			ImportFinished postexportlogupdate imported ->+				void $ includeCommandAction $ +					commitimport imported postexportlogupdate   where 	importmessages' 		| null importmessages = ["import from " ++ Remote.name remote]@@ -383,10 +383,10 @@ 			, err 			] -commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> AddUnlockedMatcher -> Imported -> CommandStart-commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig addunlockedmatcher imported =+commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> AddUnlockedMatcher -> Imported -> PostExportLogUpdate -> CommandStart+commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig addunlockedmatcher imported postexportlogupdate = 	starting "update" ai si $ do-		importcommit <- buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported+		importcommit <- buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported postexportlogupdate 		next $ updateremotetrackingbranch importcommit   where 	ai = ActionItemOther (Just $ UnquotedString $ fromRef $ fromRemoteTrackingBranch tb)
Command/ImportFeed.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2013-2024 Joey Hess <id@joeyh.name>+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -22,6 +22,7 @@ import Data.Time.Calendar import Data.Time.LocalTime import Control.Concurrent.STM+import Codec.Binary.UTF8.String (decodeString) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.ByteString as B@@ -48,6 +49,7 @@ import Annex.MetaData import Annex.FileMatcher import Annex.UntrustedFilePath+import qualified Utility.FileIO as F import qualified Utility.RawFilePath as R import qualified Database.ImportFeed as Db @@ -158,19 +160,16 @@ 		| otherwise = get  	get = withTmpFile (literalOsPath "feed") $ \tmpf h -> do-		let tmpf' = fromRawFilePath $ fromOsPath tmpf 		liftIO $ hClose h-		ifM (downloadFeed url tmpf')-			( parse tmpf'+		ifM (downloadFeed url tmpf)+			( parse tmpf 			, do 				recordfail 				next $ feedProblem url 					"downloading the feed failed" 			) -	-- Use parseFeedFromFile rather than reading the file-	-- ourselves because it goes out of its way to handle encodings.-	parse tmpf = liftIO (parseFeedFromFile tmpf) >>= \case+	parse tmpf = liftIO (parseFeedFromFile' tmpf) >>= \case 		Nothing -> debugfeedcontent tmpf "parsing the feed failed" 		Just f -> do 			case decodeBS $ fromFeedText $ getFeedTitle f of@@ -183,7 +182,7 @@ 					next $ return True 	 	debugfeedcontent tmpf msg = do-		feedcontent <- liftIO $ readFile tmpf+		feedcontent <- liftIO $ readFileString tmpf 		fastDebug "Command.ImportFeed" $ unlines 			[ "start of feed content" 			, feedcontent@@ -265,11 +264,11 @@ 		}  {- Feeds change, so a feed download cannot be resumed. -}-downloadFeed :: URLString -> FilePath -> Annex Bool+downloadFeed :: URLString -> OsPath -> Annex Bool downloadFeed url f 	| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url" 	| otherwise = Url.withUrlOptions Nothing $-		Url.download nullMeterUpdate Nothing url (toOsPath f)+		Url.download nullMeterUpdate Nothing url f  startDownload :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> CommandStart startDownload addunlockedmatcher opts cache cv todownload = case location todownload of@@ -611,7 +610,7 @@ checkFeedBroken' :: URLString -> OsPath -> Annex Bool checkFeedBroken' url f = do 	prev <- maybe Nothing readish-		<$> liftIO (catchMaybeIO $ readFile (fromOsPath f))+		<$> liftIO (catchMaybeIO $ readFileString f) 	now <- liftIO getCurrentTime 	case prev of 		Nothing -> do@@ -645,3 +644,11 @@  -} fromFeedText :: T.Text -> B.ByteString fromFeedText = TE.encodeUtf8++{- Like Test.Feed.parseFeedFromFile, but ensures the close-on-exec bit is+ - set when opening the file. -}+parseFeedFromFile' :: OsPath -> IO (Maybe Feed)+parseFeedFromFile' fp = parseFeedString <$> utf8readfile fp+  where+  	utf8readfile :: OsPath -> IO String+	utf8readfile f = fmap decodeString (hGetContents =<< F.openBinaryFile f ReadMode)
Command/Info.hs view
@@ -17,8 +17,6 @@ import Data.ByteString.Short (fromShort) import System.PosixCompat.Files (isDirectory) import Data.Ord-import qualified Data.Semigroup as Sem-import Prelude  import Command import qualified Git@@ -68,7 +66,7 @@ 	, backendsKeys :: M.Map KeyVariety Integer 	} 	-instance Sem.Semigroup KeyInfo where+instance Semigroup KeyInfo where 	a <> b = KeyInfo 		{ countKeys = countKeys a + countKeys b 		, sizeKeys = sizeKeys a + sizeKeys b
Command/Map.hs view
@@ -55,7 +55,7 @@ 				<$> fromRepo gitAnnexDir 				<*> pure (literalOsPath "map.dot") -			liftIO $ writeFile (fromOsPath file) (drawMap rs trustmap umap)+			liftIO $ writeFileString file (drawMap rs trustmap umap) 			next $ 				ifM (Annex.getRead Annex.fast) 					( runViewer file []
Command/PreCommit.hs view
@@ -42,7 +42,7 @@ 			=<< isAnnexLink f 	-- after a merge conflict or git cherry-pick or stash, pointer 	-- files in the worktree won't be populated, so populate them here-	Command.Smudge.updateSmudged (Restage False)+	Command.Smudge.updateSmudged NoRestage 	 	runAnnexHook preCommitAnnexHook annexPreCommitCommand
Command/RemoteDaemon.hs view
@@ -31,7 +31,9 @@ #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
Command/Sim.hs view
@@ -70,7 +70,7 @@ 	let st = emptySimState rng (fromOsPath simdir) 	case simfile of 		Nothing -> startup simdir st []-		Just f -> liftIO (readFile f) >>= \c -> +		Just f -> liftIO (readFileString (toOsPath f)) >>= \c ->  			case parseSimFile c of 				Left err -> giveup err 				Right cs -> startup simdir st cs
Command/Smudge.hs view
@@ -173,7 +173,7 @@ 	doingest preferredbackend = do 		-- Can't restage associated files because git add 		-- runs this and has the index locked.-		let norestage = Restage False+		let norestage = NoRestage 		emitpointer 			=<< postingest 			=<< (\ld -> ingest' preferredbackend nullMeterUpdate ld Nothing norestage)@@ -294,7 +294,7 @@ 		obj <- calcRepo (gitAnnexLocation k) 		-- Cannot restage because git add is running and has 		-- the index locked.-		populatePointerFile (Restage False) k obj file >>= \case+		populatePointerFile NoRestage k obj file >>= \case 			Nothing -> return () 			Just ic -> Database.Keys.addInodeCaches k [ic] @@ -305,7 +305,7 @@ 	-- Doing it explicitly here avoids a later pause in the middle of 	-- some other action. 	scanAnnexedFiles-	updateSmudged (Restage True)+	updateSmudged LaterRestage 	stop  updateSmudged :: Restage -> Annex ()
Command/Sync.hs view
@@ -606,8 +606,8 @@ 		Command.Import.listContents' remote ImportTree (CheckGitIgnore False) go   where 	go (Just importable) = importChanges remote ImportTree False True importable >>= \case-		ImportFinished imported -> do-			(_t, updatestate) <- recordImportTree remote ImportTree Nothing imported+		ImportFinished postexportlogupdate imported -> do+			(_t, updatestate) <- recordImportTree remote ImportTree Nothing imported postexportlogupdate 			next $ do 				updatestate 				return True
Command/Unlock.hs view
@@ -67,6 +67,6 @@ cleanup :: OsPath -> Maybe InodeCache -> Key -> Maybe FileMode -> CommandCleanup cleanup dest destic key destmode = do 	stagePointerFile dest destmode =<< hashPointerFile key-	maybe noop (restagePointerFile (Restage True) dest) destic+	maybe noop (restagePointerFile QueueRestage dest) destic 	Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest) 	return True
Command/Vicfg.hs view
@@ -49,7 +49,7 @@ 	createAnnexDirectory $ parentDir f 	cfg <- getCfg 	descs <- uuidDescriptions-	liftIO $ writeFile (fromOsPath f) $ genCfg cfg descs+	liftIO $ writeFileString f $ genCfg cfg descs 	vicfg cfg f 	stop @@ -65,7 +65,7 @@ 	liftIO $ removeWhenExistsWith removeFile f 	case r of 		Left s -> do-			liftIO $ writeFile (fromOsPath f) s+			liftIO $ writeFileString f s 			vicfg curcfg f 		Right newcfg -> setCfg curcfg newcfg   where
Command/WebApp.hs view
@@ -90,7 +90,7 @@ 			( if isJust (listenAddress o) || isJust (listenPort o) 				then giveup "The assistant is already running, so --listen and --port cannot be used." 				else do-					url <- liftIO . readFile . fromOsPath+					url <- liftIO . readFileString 						=<< fromRepo gitAnnexUrlFile 					liftIO $ if isJust listenAddress' 						then putStrLn url
Common.hs view
@@ -33,5 +33,6 @@ import Utility.Split as X import Utility.FileSystemEncoding as X import Utility.OsPath as X+import Utility.FileIO as X (readFileString, writeFileString, appendFileString)  import Utility.PartialPrelude as X
Config/Files.hs view
@@ -32,4 +32,4 @@ noAnnexFileContent :: Maybe OsPath -> IO (Maybe String) noAnnexFileContent repoworktree = case repoworktree of 	Nothing -> return Nothing-	Just wt -> catchMaybeIO (readFile (fromOsPath (wt </> literalOsPath ".noannex")))+	Just wt -> catchMaybeIO (readFileString (wt </> literalOsPath ".noannex"))
Config/Files/AutoStart.hs view
@@ -18,7 +18,7 @@ readAutoStartFile = do 	f <- autoStartFile 	filter valid . nub . map (dropTrailingPathSeparator . toOsPath) . lines-		<$> catchDefaultIO "" (readFile (fromOsPath f))+		<$> catchDefaultIO "" (readFileString f)   where 	-- Ignore any relative paths; some old buggy versions added eg "." 	valid = isAbsolute@@ -30,7 +30,7 @@ 	when (dirs' /= dirs) $ do 		f <- autoStartFile 		createDirectoryIfMissing True (parentDir f)-		viaTmp (writeFile . fromRawFilePath . fromOsPath) f+		viaTmp writeFileString f 			(unlines (map fromOsPath dirs'))  {- Adds a directory to the autostart file. If the directory is already
Config/Smudge.hs view
@@ -70,7 +70,7 @@ 	lf <- Annex.fromRepo Git.attributesLocal 	ls <- liftIO $ catchDefaultIO [] $  		map decodeBS . fileLines' <$> F.readFile' lf-	liftIO $ writeFile (fromOsPath lf) $ unlines $+	liftIO $ writeFileString lf $ unlines $ 		filter (\l -> l `notElem` stdattr && not (null l)) ls 	unsetConfig (ConfigKey "filter.annex.smudge") 	unsetConfig (ConfigKey "filter.annex.clean")
Crypto.hs view
@@ -25,7 +25,6 @@ 	decryptCipher', 	encryptKey, 	isEncKey,-	feedFile, 	feedBytes, 	readBytes, 	readBytesStrictly,@@ -187,9 +186,6 @@  type Feeder = Handle -> IO () type Reader m a = Handle -> m a--feedFile :: FilePath -> Feeder-feedFile f h = L.hPut h =<< L.readFile f  feedBytes :: L.ByteString -> Feeder feedBytes = flip L.hPut
Database/Keys.hs view
@@ -47,7 +47,6 @@ import Git.FilePath import Git.Command import Git.Types-import Git.Index import Git.Sha import Git.CatFile import Git.Branch (writeTreeQuiet, update')@@ -81,8 +80,8 @@ 			else return tableschanged 		v <- a (SQL.ReadHandle qh) 		return (v, DbOpen (qh, tableschanged'))-	go DbClosed = do-		st <- openDb False DbClosed+	go startst@(DbClosed _) = do+		st <- openDb False startst 		v <- case st of 			(DbOpen (qh, _)) -> a (SQL.ReadHandle qh) 			_ -> return mempty@@ -124,7 +123,11 @@ openDb :: Bool -> DbState -> Annex DbState openDb _ st@(DbOpen _) = return st openDb False DbUnavailable = return DbUnavailable-openDb forwrite _ = do+openDb forwrite (DbClosed wasopen) = openDb' forwrite wasopen+openDb forwrite DbUnavailable = openDb' forwrite (DbWasOpen False) ++openDb' :: Bool -> DbWasOpen -> Annex DbState+openDb' forwrite wasopen = do 	lck <- calcRepo' gitAnnexKeysDbLock 	catchPermissionDenied permerr $ withExclusiveLock lck $ do 		dbdir <- calcRepo' gitAnnexKeysDbDir@@ -144,7 +147,7 @@ 	 	open db dbisnew = do 		qh <- liftIO $ H.openDbQueue db SQL.containedTable-		tc <- reconcileStaged dbisnew qh+		tc <- reconcileStaged dbisnew qh wasopen 		return $ DbOpen (qh, tc)  {- Closes the database if it was open. Any writes will be flushed to it.@@ -238,8 +241,8 @@  - This is run with a lock held, so only one process can be running this at  - a time.  -- - To avoid unnecessary work, the index file is statted, and if it's not- - changed since last time this was run, nothing is done.+ - If the database gets closed and then reopened by the same process, this+ - will avoid doing any repeated work.  -  - A tree is generated from the index, and the diff between that tree  - and the last processed tree is examined for changes.@@ -259,30 +262,19 @@  - So when using getAssociatedFiles, have to make sure the file still  - is an associated file.  -}-reconcileStaged :: Bool -> H.DbQueue -> Annex DbTablesChanged-reconcileStaged dbisnew qh = ifM isBareRepo+reconcileStaged :: Bool -> H.DbQueue -> DbWasOpen -> Annex DbTablesChanged+reconcileStaged _ _ (DbWasOpen True) =+	return (DbTablesChanged False False)+reconcileStaged dbisnew qh _ = ifM isBareRepo 	( return mempty-	, do-		gitindex <- inRepo currentIndexFile-		indexcache <- fromOsPath <$> calcRepo' gitAnnexKeysDbIndexCache-		withTSDelta (liftIO . genInodeCache gitindex) >>= \case-			Just cur -> readindexcache indexcache >>= \case-				Nothing -> go cur indexcache =<< getindextree-				Just prev -> ifM (compareInodeCaches prev cur)-					( return mempty-					, go cur indexcache =<< getindextree-					)-			Nothing -> return mempty+	, inReconcileStaged $ go =<< getindextree 	)   where 	lastindexref = Ref "refs/annex/last-index" -	readindexcache indexcache = liftIO $ maybe Nothing readInodeCache-		<$> catchMaybeIO (readFile indexcache)- 	getoldtree = fromMaybe emptyTree <$> inRepo (Git.Ref.sha lastindexref) 	-	go cur indexcache (Just newtree) = do+	go (Just newtree) = do 		oldtree <- getoldtree 		when (oldtree /= newtree) $ do 			fastDebug "Database.Keys" "reconcileStaged start"@@ -292,7 +284,6 @@ 					(Just (fromRef oldtree))  					(fromRef newtree) 					(procdiff mdfeeder)-			liftIO $ writeFile indexcache $ showInodeCache cur 			-- Storing the tree in a ref makes sure it does not 			-- get garbage collected, and is available to diff 			-- against next time.@@ -309,7 +300,7 @@ 	-- When there is a merge conflict, that will not see the new local 	-- version of the files that are conflicted. So a second diff 	-- is done, with --staged but no old tree.-	go _ _ Nothing = do+	go Nothing = do 		fastDebug "Database.Keys" "reconcileStaged start (in conflict)" 		oldtree <- getoldtree 		g <- Annex.gitRepo@@ -442,13 +433,19 @@ 		filepopulated <- sameInodeCache p ics 		case (keypopulated, filepopulated) of 			(True, False) ->-				populatePointerFile (Restage True) key obj p >>= \case+				populatePointerFile restage key obj p >>= \case 					Nothing -> return () 					Just ic -> addinodecaches key 						(catMaybes [Just ic, mobjic])-			(False, True) -> depopulatePointerFile key p+			(False, True) -> depopulatePointerFile restage key p 			_ -> return () 	+	-- Cannot use QueueRestage here, because it could deadlock;+	-- restagePointerFiles tries to close the database handle,+	-- but the database handle is open while reconcileStaged +	-- is running.+	restage = LaterRestage+ 	send :: ((Maybe Key -> Annex a, Ref) -> IO ()) -> Ref -> (Maybe Key -> Annex a) -> IO () 	send feeder r withk = feeder (withk, r) @@ -508,6 +505,15 @@ 	addassociatedfile 		| dbisnew = SQL.newAssociatedFile 		| otherwise = SQL.addAssociatedFile++-- Avoid a potential deadlock.+inReconcileStaged :: Annex a -> Annex a+inReconcileStaged = bracket setup cleanup . const+    where+          setup = Annex.changeState $ \s -> s+                  { Annex.inreconcilestaged = True }+          cleanup () = Annex.changeState $ \s -> s+                  { Annex.inreconcilestaged = False }  {- Normally the keys database is updated incrementally when opened,  - by reconcileStaged. Calling this explicitly allows running the
Database/Keys/Handle.hs view
@@ -9,6 +9,7 @@ 	DbHandle, 	newDbHandle, 	DbState(..),+	DbWasOpen(..), 	withDbState, 	flushDbQueue, 	closeDbHandle,@@ -21,8 +22,6 @@  import Control.Concurrent import Control.Monad.IO.Class (liftIO, MonadIO)-import Control.Applicative-import Prelude  -- The MVar is always left full except when actions are run -- that access the database.@@ -30,10 +29,16 @@  -- The database can be closed or open, but it also may have been -- tried to open (for read) and didn't exist yet or is not readable.-data DbState = DbClosed | DbOpen (H.DbQueue, DbTablesChanged) | DbUnavailable+data DbState +	= DbClosed DbWasOpen+	| DbOpen (H.DbQueue, DbTablesChanged)+	| DbUnavailable +-- Was the database previously opened by this process?+data DbWasOpen = DbWasOpen Bool+ newDbHandle :: IO DbHandle-newDbHandle = DbHandle <$> newMVar DbClosed+newDbHandle = DbHandle <$> newMVar (DbClosed (DbWasOpen False))  -- Runs an action on the state of the handle, which can change its state. -- The MVar is empty while the action runs, which blocks other users@@ -65,5 +70,5 @@   where 	go (DbOpen (qh, _)) = do 		H.closeDbQueue qh-		return ((), DbClosed)+		return ((), DbClosed (DbWasOpen True)) 	go st = return ((), st)
Database/Keys/Tables.hs view
@@ -7,10 +7,6 @@  module Database.Keys.Tables where -import Data.Monoid-import qualified Data.Semigroup as Sem-import Prelude- data DbTable = AssociatedTable | ContentTable 	deriving (Eq, Show) @@ -20,7 +16,7 @@ 	} 	deriving (Show) -instance Sem.Semigroup DbTablesChanged where+instance Semigroup DbTablesChanged where 	a <> b = DbTablesChanged 		{ associatedTable = associatedTable a || associatedTable b 		, contentTable = contentTable a || contentTable b
Database/Queue.hs view
@@ -27,8 +27,6 @@ import Database.Persist.Sqlite import Control.Concurrent import Data.Time.Clock-import Control.Applicative-import Prelude  {- A DbQueue wraps a DbHandle, adding a queue of writes to perform.  -
Git/Construct.hs view
@@ -280,7 +280,7 @@ adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation) adjustGitDirFile' loc@(Local {}) = do 	let gd = gitdir loc-	c <- firstLine <$> catchDefaultIO "" (readFile (fromOsPath gd))+	c <- firstLine <$> catchDefaultIO "" (readFileString gd) 	if gitdirprefix `isPrefixOf` c 		then do 			top <- takeDirectory <$> absPath gd
Git/Fsck.hs view
@@ -26,8 +26,6 @@  import qualified Data.Set as S import Control.Concurrent.Async-import qualified Data.Semigroup as Sem-import Prelude  data FsckResults  	= FsckFoundMissing@@ -56,7 +54,7 @@ appendFsckOutput AllDuplicateEntriesWarning NoFsckOutput = AllDuplicateEntriesWarning appendFsckOutput NoFsckOutput AllDuplicateEntriesWarning = AllDuplicateEntriesWarning -instance Sem.Semigroup FsckOutput where+instance Semigroup FsckOutput where 	(<>) = appendFsckOutput  instance Monoid FsckOutput where
Git/Hook.hs view
@@ -59,7 +59,7 @@ 	f = hookFile h r 	go = do 		-- On Windows, using a ByteString as the file content-		-- avoids the newline translation done by writeFile.+		-- avoids the newline translation done by writeFileString. 		-- Hook scripts on Windows could use CRLF endings, but 		-- they typically use unix newlines, which does work there 		-- and makes the repository more portable.@@ -85,11 +85,11 @@  expectedContent :: Hook -> Repo -> IO ExpectedContent expectedContent h r = do-	-- Note that on windows, this readFile does newline translation,+	-- Note that on windows, this readFileString does newline translation, 	-- and so a hook file that has CRLF will be treated the same as one 	-- that has LF. That is intentional, since users may have a reason 	-- to prefer one or the other.-	content <- readFile $ fromOsPath $ hookFile h r+	content <- readFileString $ hookFile h r 	return $ if content == hookScript h 		then ExpectedContent 		else if any (content ==) (hookOldScripts h)
Git/LockFile.hs view
@@ -53,8 +53,7 @@ #ifndef mingw32_HOST_OS 	-- On unix, git simply uses O_EXCL 	h <- openFdWithMode (fromOsPath lck) ReadWrite (Just 0O666)-		(defaultFileFlags { exclusive = True })-	setFdOption h CloseOnExec True+		(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
Git/Objects.hs view
@@ -50,7 +50,7 @@  listAlternates :: Repo -> IO [FilePath] listAlternates r = catchDefaultIO [] $-	lines <$> readFile (fromOsPath alternatesfile)+	lines <$> readFileString alternatesfile   where 	alternatesfile = objectsDir r </> literalOsPath "info" </> literalOsPath "alternates"
Git/Quote.hs view
@@ -28,8 +28,6 @@ import Data.Word import Data.String import qualified Data.ByteString as S-import qualified Data.Semigroup as Sem-import Prelude  unquote :: S.ByteString -> RawFilePath unquote b = case S.uncons b of@@ -108,7 +106,7 @@ instance IsString StringContainingQuotedPath where 	fromString = UnquotedByteString . encodeBS -instance Sem.Semigroup StringContainingQuotedPath where+instance Semigroup StringContainingQuotedPath where 	UnquotedString a <> UnquotedString b = UnquotedString (a <> b) 	UnquotedByteString a <> UnquotedByteString b = UnquotedByteString (a <> b) 	a <> b = a :+: b
Git/Repair.hs view
@@ -269,7 +269,7 @@ 		let dest = gitd </> toOsPath (fromRef' ref) 		createDirectoryUnder [gitd] (parentDir dest) 		unlessM (doesFileExist dest) $-			writeFile (fromOsPath dest) (fromRef sha)+			writeFileString dest (fromRef sha)  packedRefsFile :: Repo -> OsPath packedRefsFile r = localGitDir r </> literalOsPath "packed-refs"@@ -472,7 +472,7 @@ preRepair g = do 	unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do 		removeWhenExistsWith removeFile headfile-		writeFile (fromOsPath headfile) "ref: refs/heads/master"+		writeFileString headfile "ref: refs/heads/master" 	explodePackedRefsFile g 	unless (repoIsLocalBare g) $ 		void $ tryIO $ allowWrite $ indexFile g
Git/Types.hs view
@@ -21,8 +21,6 @@ import qualified Data.ByteString as S import qualified Data.List.NonEmpty as NE import System.Posix.Types-import qualified Data.Semigroup as Sem-import Prelude  {- Support repositories on local disk, and repositories accessed via an URL.  -@@ -81,7 +79,7 @@ 	-- with an empty value 	deriving (Ord, Eq) -instance Sem.Semigroup ConfigValue where+instance Semigroup ConfigValue where 	ConfigValue a <> ConfigValue b = ConfigValue (a <> b) 	a <> NoConfigValue = a 	NoConfigValue <> b = b
Logs/File.hs view
@@ -38,7 +38,7 @@ writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c   where 	writelog tmp c' = do-		liftIO $ writeFile (fromOsPath tmp) c'+		liftIO $ writeFileString tmp c' 		setAnnexFilePerm tmp  -- | Runs the action with a handle connected to a temp file.
Logs/FsckResults.hs view
@@ -45,7 +45,7 @@ readFsckResults u = do 	logfile <- fromRepo $ gitAnnexFsckResultsLog u 	liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $-		deserializeFsckResults <$> readFile (fromOsPath logfile)+		deserializeFsckResults <$> readFileString logfile  deserializeFsckResults :: String -> FsckResults deserializeFsckResults = deserialize . lines
Logs/Import.hs view
@@ -1,6 +1,6 @@ {- git-annex import logs  -- - Copyright 2023 Joey Hess <id@joeyh.name>+ - Copyright 2023-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -14,24 +14,60 @@ import Git.Types import Git.Sha import Logs.File+import Logs.Export  import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Char8 as S8+import qualified Data.Set as S  {- Records the sha of a tree that contains hashes of ContentIdentifiers- - that were imported from a remote. -}+ - that were imported from a remote.+ -+ - The sha is on the first line of the log file, and following it+ - is a line with the the currently exported treeishs, and then a line with+ - the incomplete exported treeishes.+ -} recordContentIdentifierTree :: UUID -> Sha -> Annex () recordContentIdentifierTree u t = do 	l <- calcRepo' (gitAnnexImportLog u)-	writeLogFile l (fromRef t)+	exported <- getExport u+	writeLogFile l $ unlines+		[ fromRef t+		, unwords $ map fromRef $ exportedTreeishes exported+		, unwords $ map fromRef $ incompleteExportedTreeishes exported+		] -{- Gets the tree last recorded for a remote. -}+{- Gets the ContentIdentifier tree last recorded for a remote.+ -+ - This returns Nothing if no tree was recorded yet. + -+ - It also returns Nothing when there have been changes to what is exported+ - to the remote since the tree was recorded. That avoids a problem where+ - diffing from the current Contentidentifier tree to the previous tree+ - would miss changes that were made to a remote by an export, but were+ - later undone manually. For example, if a file was exported to the remote,+ - and then the file was manually removed from the remote, the current tree+ - would not contain the file, and neither would the previous tree.+ - So diffing between the trees would miss that removal. The removed+ - file would then remain in the imported tree.+ -} getContentIdentifierTree :: UUID -> Annex (Maybe Sha) getContentIdentifierTree u = do 	l <- calcRepo' (gitAnnexImportLog u) 	-- This is safe because the log file is written atomically.-	calcLogFileUnsafe l Nothing update+	ls <- calcLogFileUnsafe l [] (\v ls -> L.toStrict v : ls)+	exported <- getExport u+	return $ case reverse ls of+		-- Subsequent lines are ignored. This leaves room for future+		-- expansion of what is logged.+		(a:b:c:_) -> do+			t <- extractSha a+			exportedtreeishs <- mapM extractSha (S8.words b)+			incompleteexportedtreeishs <- mapM extractSha (S8.words c)+			if same exportedtreeishs (exportedTreeishes exported) && +			   same incompleteexportedtreeishs (incompleteExportedTreeishes exported)+				then Just t+				else Nothing+		_ -> Nothing   where-	update l Nothing = extractSha (L.toStrict l)-	-- Subsequent lines are ignored. This leaves room for future-	-- expansion of what is logged.-	update _l (Just l) = Just l+	same l1 l2 = S.fromList l1 == S.fromList l2
Logs/MapLog.hs view
@@ -28,8 +28,6 @@ import qualified Data.Attoparsec.ByteString.Lazy as AL import qualified Data.Attoparsec.ByteString.Char8 as A8 import Data.ByteString.Builder-import qualified Data.Semigroup as Sem-import Prelude  data LogEntry v = LogEntry 	{ changed :: VectorClock@@ -42,7 +40,7 @@ newtype MapLog f v = MapLog (M.Map f (LogEntry v)) 	deriving (Show, Eq) -instance Ord f => Sem.Semigroup (MapLog f v)+instance Ord f => Semigroup (MapLog f v)   where 	a <> MapLog b = foldl' (\m (f, v) -> addMapLog f v m) a (M.toList b)
Logs/Restage.hs view
@@ -55,7 +55,7 @@ 			ifM (doesPathExist oldf) 				( do 					h <- F.openFile oldf AppendMode-					hPutStr h =<< readFile (fromOsPath logf)+					hPutStr h =<< readFileString logf 					hClose h 					liftIO $ removeWhenExistsWith removeFile logf 				, moveFile logf oldf
Logs/Schedule.hs view
@@ -63,9 +63,9 @@  getLastRunTimes :: Annex (M.Map ScheduledActivity LocalTime) getLastRunTimes = do-	f <- fromOsPath <$> fromRepo gitAnnexScheduleState+	f <- fromRepo gitAnnexScheduleState 	liftIO $ fromMaybe M.empty-		<$> catchDefaultIO Nothing (readish <$> readFile f)+		<$> catchDefaultIO Nothing (readish <$> readFileString f)  setLastRunTime :: ScheduledActivity -> LocalTime -> Annex () setLastRunTime activity lastrun = do
Logs/Transfer.hs view
@@ -263,7 +263,7 @@ -- after it's been created with the right perms by writeTransferInfoFile. updateTransferInfoFile :: TransferInfo -> OsPath -> IO () updateTransferInfoFile info tfile = -	writeFile (fromOsPath tfile) $ writeTransferInfo info+	writeFileString tfile $ writeTransferInfo info  {- File format is a header line containing the startedTime and any  - bytesComplete value. Followed by a newline and the associatedFile.
Logs/View.hs view
@@ -54,8 +54,8 @@  recentViews :: Annex [View] recentViews = do-	f <- fromOsPath <$> fromRepo gitAnnexViewLog-	liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)+	f <- fromRepo gitAnnexViewLog+	liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFileString f)  {- Gets the currently checked out view, if there is one.   -
Messages/JSON.hs view
@@ -31,7 +31,6 @@ 	module Utility.Aeson, ) where -import Control.Applicative import qualified Data.Map as M import qualified Data.Vector as V import qualified Data.ByteString as S@@ -41,8 +40,6 @@ import System.IO.Unsafe (unsafePerformIO) import Control.Concurrent import Data.Maybe-import Data.Monoid-import Prelude  import Types.Command (SeekInput(..)) import Types.ActionItem
P2P/Http/Server.hs view
@@ -477,14 +477,19 @@ 	let lock = do 		lockresv <- newEmptyTMVarIO 		unlockv <- newEmptyTMVarIO+		-- A single worker thread takes the lock, and keeps running+		-- until unlock in order to keep the lock held. 		annexworker <- async $ inAnnexWorker st $ do 			lockres <- runFullProto (clientRunState conn) (clientP2PConnection conn) $ do 				net $ sendMessage (LOCKCONTENT k) 				checkSuccess 			liftIO $ atomically $ putTMVar lockresv lockres-			liftIO $ atomically $ takeTMVar unlockv-			void $ runFullProto (clientRunState conn) (clientP2PConnection conn) $ do-				net $ sendMessage UNLOCKCONTENT+			case lockres of+				Right True -> do+					liftIO $ atomically $ takeTMVar unlockv+					void $ runFullProto (clientRunState conn) (clientP2PConnection conn) $ do+						net $ sendMessage UNLOCKCONTENT+				_ -> return () 		atomically (takeTMVar lockresv) >>= \case 			Right True -> return (Just (annexworker, unlockv)) 			_ -> return Nothing
P2P/Http/State.hs view
@@ -44,8 +44,6 @@ import qualified Data.Set as S import Control.Concurrent.Async import Data.Time.Clock.POSIX-import qualified Data.Semigroup as Sem-import Prelude  data P2PHttpServerState = P2PHttpServerState 	{ servedRepos :: M.Map UUID PerRepoServerState@@ -62,7 +60,7 @@ 		, updateRepos = const mempty 		} -instance Sem.Semigroup P2PHttpServerState where+instance Semigroup P2PHttpServerState where 	a <> b = P2PHttpServerState 		{ servedRepos = servedRepos a <> servedRepos b 		, serverShutdownCleanup = do
P2P/Protocol.hs view
@@ -44,9 +44,7 @@ import Data.Char import Data.Maybe import Data.Time.Clock.POSIX-import Control.Applicative import Control.DeepSeq-import Prelude  newtype Offset = Offset Integer 	deriving (Show, Eq, NFData, Num, Real, Ord, Enum, Integral)
Remote/Directory.hs view
@@ -470,10 +470,12 @@  	docopynoncow iv = do #ifndef mingw32_HOST_OS-		let open = do+		let open = noCreateProcessWhile $ 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
Remote/Directory/LegacyChunked.hs view
@@ -33,7 +33,7 @@ 		let chunkcount = f ++ Legacy.chunkCount 		ifM (check chunkcount) 			( do-				chunks <- Legacy.listChunks f <$> readFile chunkcount+				chunks <- Legacy.listChunks f <$> readFileString (toOsPath chunkcount) 				ifM (allM check chunks) 					( a chunks , return False ) 			, do@@ -52,14 +52,14 @@ storeLegacyChunked meterupdate chunksize alldests@(firstdest:_) b 	| L.null b = do 		-- always write at least one file, even for empty-		L.writeFile firstdest b+		F.writeFile (toOsPath firstdest) b 		return [firstdest] 	| otherwise = storeLegacyChunked' meterupdate chunksize alldests (L.toChunks b) [] storeLegacyChunked' :: MeterUpdate -> ChunkSize -> [FilePath] -> [S.ByteString] -> [FilePath] -> IO [FilePath] storeLegacyChunked' _ _ [] _ _ = error "ran out of dests" storeLegacyChunked' _ _  _ [] c = return $ reverse c storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do-	bs' <- withFile d WriteMode $+	bs' <- F.withFile (toOsPath d) WriteMode $ 		feed zeroBytesProcessed chunksize bs 	storeLegacyChunked' meterupdate chunksize dests bs' (d:c)   where@@ -85,7 +85,7 @@ 	recorder f s = do 		let f' = toOsPath f 		void $ tryIO $ allowWrite f'-		writeFile f s+		writeFileString f' s 		void $ tryIO $ preventWrite f'  store :: FilePath -> ChunkSize -> (OsPath -> OsPath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO ()@@ -103,7 +103,7 @@ 	let go = \k sink -> do 		liftIO $ void $ withStoredFiles (fromOsPath d) (legacyLocations locations) k $ \fs -> do 			forM_ fs $-				F.appendFile' tmp <=< S.readFile+				F.appendFile' tmp <=< F.readFile' . toOsPath 			return True 		b <- liftIO $ F.readFile tmp 		liftIO $ removeWhenExistsWith removeFile tmp
Remote/Helper/Chunked/Legacy.hs view
@@ -10,6 +10,7 @@ import Annex.Common import Remote.Helper.Chunked import Utility.Metered+import qualified Utility.FileIO as F  import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -116,6 +117,6 @@  -} meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO () meteredWriteFileChunks meterupdate dest chunks feeder =-	withBinaryFile dest WriteMode $ \h ->+	F.withBinaryFile (toOsPath dest) WriteMode $ \h -> 		forM_ chunks $ 			meteredWrite meterupdate (S.hPut h) <=< feeder
Remote/Helper/Special.hs view
@@ -96,7 +96,7 @@ fileStorer :: (Key -> OsPath -> MeterUpdate -> Annex ()) -> Storer fileStorer a k (FileContent f) m = a k f m fileStorer a k (ByteContent b) m = withTmp k $ \f -> do-	liftIO $ L.writeFile (fromOsPath f) b+	liftIO $ F.writeFile f b 	a k f m  -- A Storer that expects to be provided with a L.ByteString of
Remote/Tahoe.hs view
@@ -213,7 +213,7 @@  writeSharedConvergenceSecret :: TahoeConfigDir -> SharedConvergenceSecret -> IO () writeSharedConvergenceSecret configdir scs = -	writeFile (fromOsPath (convergenceFile configdir))+	writeFileString (convergenceFile configdir) 		(unlines [scs])  {- The tahoe daemon writes the convergenceFile shortly after it starts@@ -223,11 +223,11 @@ getSharedConvergenceSecret :: TahoeConfigDir -> IO SharedConvergenceSecret getSharedConvergenceSecret configdir = go (60 :: Int)   where-	f = fromOsPath $ convergenceFile configdir+	f = convergenceFile configdir 	go n-		| n == 0 = giveup $ "tahoe did not write " ++ f ++ " after 1 minute. Perhaps the daemon failed to start?"+		| n == 0 = giveup $ "tahoe did not write " ++ fromOsPath f ++ " after 1 minute. Perhaps the daemon failed to start?" 		| otherwise = do-			v <- catchMaybeIO (readFile f)+			v <- catchMaybeIO (readFileString f) 			case v of 				Just s | "\n" `isSuffixOf` s || "\r" `isSuffixOf` s -> 					return $ takeWhile (`notElem` ("\n\r" :: String)) s
Test.hs view
@@ -38,8 +38,8 @@ import qualified Git.Ref import qualified Git.LsTree import qualified Git.FilePath-import qualified Annex.Locations #ifndef mingw32_HOST_OS+import qualified Annex.Locations import qualified Git.Bundle import qualified Types.GitConfig #endif@@ -556,8 +556,8 @@ #ifdef WITH_MAGICMIME 	git "config" ["annex.largefiles", "mimeencoding=binary"] 		"git config annex.largefiles"-	writeFile "binary" "\127"-	writeFile "text" "test\n" +	writeFileString (literalOsPath "binary") "\127"+	writeFileString (literalOsPath "text") "test\n"  	git_annex "add" ["binary", "text"] 		"git-annex add with mimeencoding in largefiles" 	git_annex "sync" ["--no-content"]@@ -879,7 +879,7 @@ 	changecontent annexedfile 	git "add" [annexedfile] "add of modified file" 	runchecks [checkregularfile, checkwritable] annexedfile-	c <- readFile annexedfile+	c <- readFileString (toOsPath annexedfile) 	assertEqual "content of modified file" c (changedcontent annexedfile) 	git_annex_shouldfail "drop" [annexedfile] 		"drop with no known copy of modified file should not be allowed"@@ -896,8 +896,6 @@ 		Just k <- Annex.WorkTree.lookupKey (toOsPath annexedfile) 		Database.Keys.removeInodeCaches k 		Database.Keys.closeDb-		liftIO . removeWhenExistsWith removeFile-			=<< Annex.calcRepo' Annex.Locations.gitAnnexKeysDbIndexCache 	writecontent annexedfile "test_lock_force content" 	git_annex_shouldfail "lock" [annexedfile] "lock of modified file should not be allowed" 	git_annex "lock" ["--force", annexedfile] "lock --force of modified file"@@ -921,7 +919,7 @@ 		then git_annex "pre-commit" [] "pre-commit" 		else git "commit" ["-q", "-m", "contentchanged"] "git commit of edited file" 	runchecks [checkregularfile, checkwritable] annexedfile-	c <- readFile annexedfile+	c <- readFileString (toOsPath annexedfile) 	assertEqual "content of modified file" c (changedcontent annexedfile) 	git_annex_shouldfail "drop" [annexedfile] "drop no known copy of modified file should not be allowed" @@ -947,7 +945,7 @@ 	git "mv" [annexedfile, subdir] "git mv" 	git_annex "fix" [newfile] "fix of moved file" 	runchecks [checklink, checkunwritable] newfile-	c <- readFile newfile+	c <- readFileString (toOsPath newfile) 	assertEqual "content of moved file" c (content annexedfile)   where 	subdir = "s"@@ -1069,7 +1067,8 @@ 	annexed_present sha1annexedfile 	if usegitattributes 		then do-			writeFile ".gitattributes" "* annex.backend=SHA1"+			writeFileString (literalOsPath ".gitattributes")+				"* annex.backend=SHA1" 			git_annex "migrate" [sha1annexedfile] 				"migrate sha1annexedfile" 			git_annex "migrate" [annexedfile]@@ -1085,7 +1084,8 @@ 	checkbackend sha1annexedfile backendSHA1  	-- check that reversing a migration works-	writeFile ".gitattributes" "* annex.backend=SHA256"+	writeFileString (literalOsPath ".gitattributes")+		"* annex.backend=SHA256" 	git_annex "migrate" [sha1annexedfile] "migrate sha1annexedfile" 	git_annex "migrate" [annexedfile] "migrate annexedfile" 	annexed_present annexedfile@@ -1531,7 +1531,7 @@ 		length v == 1 			@? (what ++ " too many variant files in: " ++ show v) 		conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)-		s <- catchMaybeIO $ readFile $ fromOsPath $+		s <- catchMaybeIO $ readFileString $ 			toOsPath d </> toOsPath conflictor 		s == Just nonannexed_content 			@? (what ++ " wrong content for nonannexed file: " ++ show s)@@ -1918,19 +1918,19 @@   where 	testscheme scheme = intmpclonerepo $ test_with_gpg $ \gpgcmd environ -> do 		createDirectory (literalOsPath "dir")-		let initps =+		let ps = 			[ "foo"-			, "type=directory" 			, "encryption=" ++ scheme 			, "directory=dir" 			, "highRandomQuality=false" 			] ++ if scheme `elem` ["hybrid","pubkey"] 				then ["keyid=" ++ Utility.Gpg.testKeyId] 				else []+		let initps = ps ++ [ "type=directory" ] 		git_annex' "initremote" initps (Just environ) "initremote" 		git_annex_shouldfail' "initremote" initps (Just environ) "initremote should not work when run twice in a row"-		git_annex' "enableremote" initps (Just environ) "enableremote"-		git_annex' "enableremote" initps (Just environ) "enableremote when run twice in a row"+		git_annex' "enableremote" ps (Just environ) "enableremote"+		git_annex' "enableremote" ps (Just environ) "enableremote when run twice in a row" 		git_annex' "get" [annexedfile] (Just environ) "get of file" 		annexed_present annexedfile 		git_annex' "copy" [annexedfile, "--to", "foo"] (Just environ) "copy --to encrypted remote"@@ -2074,9 +2074,9 @@ 	dircontains "import" (content "newimport3")   where 	dircontains f v = do-		let df = fromOsPath (literalOsPath "dir" </> stringToOsPath f)-		((v==) <$> readFile df)-			@? ("did not find expected content of " ++ df)+		let df = literalOsPath "dir" </> stringToOsPath f+		((v==) <$> readFileString df)+			@? ("did not find expected content of " ++ fromOsPath df) 	writedir f = writecontent (fromOsPath (literalOsPath "dir" </> stringToOsPath f)) 	-- When on an adjusted branch, this updates the master branch 	-- to match it, which is necessary since the master branch is going@@ -2111,9 +2111,9 @@ 	testexport   where 	dircontains f v = do-		let df = fromOsPath (literalOsPath "dir" </> toOsPath f)-		((v==) <$> readFile df)-			@? ("did not find expected content of " ++ df)+		let df = literalOsPath "dir" </> toOsPath f+		((v==) <$> readFileString df)+			@? ("did not find expected content of " ++ fromOsPath df) 	 	subdir = "subdir" 	subannexedfile = fromOsPath $
Test/Framework.hs view
@@ -391,7 +391,7 @@  checkcontent :: FilePath -> Assertion checkcontent f = do-	c <- Utility.Exception.catchDefaultIO "could not read file" $ readFile f+	c <- Utility.Exception.catchDefaultIO "could not read file" $ readFileString (toOsPath f) 	assertEqual ("checkcontent " ++ f) (content f) c  checkunwritable :: FilePath -> Assertion@@ -415,7 +415,7 @@ checkdangling f = ifM (annexeval Config.crippledFileSystem) 	( return () -- probably no real symlinks to test 	, do-		r <- tryIO $ readFile f+		r <- tryIO $ readFileString (toOsPath f) 		case r of 			Left _ -> return () -- expected; dangling link 			Right _ -> assertFailure $ f ++ " was not a dangling link as expected"@@ -675,9 +675,10 @@ writecontent f c = go (10000000 :: Integer)   where 	go ticsleft = do-		oldmtime <- catchMaybeIO $ getModificationTime (toOsPath f)-		writeFile f c-		newmtime <- getModificationTime (toOsPath f)+		let f' = toOsPath f+		oldmtime <- catchMaybeIO $ getModificationTime f'+		writeFileString f' c+		newmtime <- getModificationTime f' 		if Just newmtime == oldmtime 			then do 				threadDelay 100000
Types/CleanupActions.hs view
@@ -10,7 +10,7 @@ import Types.UUID import Utility.Url -import System.Process (Pid)+import Utility.Process (Pid)  data CleanupAction 	= RemoteCleanup UUID@@ -20,6 +20,7 @@ 	| AdjustedBranchUpdate 	| TorrentCleanup URLString 	| OtherTmpCleanup+	| RestagePointerFiles 	deriving (Eq, Ord)  data SignalAction
Types/DeferredParse.hs view
@@ -12,8 +12,6 @@ import Annex  import Options.Applicative-import qualified Data.Semigroup as Sem-import Prelude  -- Some values cannot be fully parsed without performing an action. -- The action may be expensive, so it's best to call finishParse on such a@@ -47,7 +45,7 @@ 	, annexReadSetter :: AnnexRead -> AnnexRead 	} -instance Sem.Semigroup AnnexSetter where+instance Semigroup AnnexSetter where 	a <> b = AnnexSetter 		{ annexStateSetter = annexStateSetter a >> annexStateSetter b 		, annexReadSetter = annexReadSetter b . annexReadSetter a
Types/DesktopNotify.hs view
@@ -7,17 +7,13 @@  module Types.DesktopNotify where -import Data.Monoid-import qualified Data.Semigroup as Sem-import Prelude- data DesktopNotify = DesktopNotify 	{ notifyStart :: Bool 	, notifyFinish :: Bool 	} 	deriving (Show) -instance Sem.Semigroup DesktopNotify where+instance Semigroup DesktopNotify where 	(DesktopNotify s1 f1) <> (DesktopNotify s2 f2) = 		DesktopNotify (s1 || s2) (f1 || f2)
Types/Difference.hs view
@@ -26,11 +26,8 @@ import Git.Types  import Data.Maybe-import Data.Monoid import qualified Data.ByteString as B import qualified Data.Set as S-import qualified Data.Semigroup as Sem-import Prelude  -- Describes differences from the standard repository format. --@@ -85,7 +82,7 @@ 	} appendDifferences _ _ = UnknownDifferences -instance Sem.Semigroup Differences where+instance Semigroup Differences where 	(<>) = appendDifferences  instance Monoid Differences where
Types/Distribution.hs view
@@ -14,9 +14,6 @@ import Data.Time.Clock import Git.Config (isTrueFalse, boolConfig) -import Control.Applicative-import Prelude- type GitAnnexVersion = String  data GitAnnexDistribution = GitAnnexDistribution
Types/GitConfig.hs view
@@ -157,6 +157,7 @@ 	, annexSkipUnknown :: Bool 	, annexAdjustedBranchRefresh :: Integer 	, annexSupportUnlocked :: Bool+	, annexAssistantAllowUnlocked :: Bool 	, coreSymlinks :: Bool 	, coreSharedRepository :: SharedRepository 	, coreQuotePath :: QuotePath@@ -281,6 +282,7 @@ 		(if getbool "adjustedbranchrefresh" False then 1 else 0) 		(getmayberead (annexConfig "adjustedbranchrefresh")) 	, annexSupportUnlocked = getbool (annexConfig "supportunlocked") True+	, annexAssistantAllowUnlocked = getbool (annexConfig "assistant.allowunlocked") False 	, coreSymlinks = getbool "core.symlinks" True 	, coreSharedRepository = getSharedRepository r 	, coreQuotePath = QuotePath (getbool "core.quotepath" True)
Types/GitRemoteAnnex.hs view
@@ -14,7 +14,6 @@  import Types.Key -import qualified Data.Semigroup as Sem import qualified Data.Set as S  -- The manifest contains an ordered list of git bundle keys.@@ -39,7 +38,7 @@ instance Monoid Manifest where 	mempty = Manifest mempty mempty -instance Sem.Semigroup Manifest where+instance Semigroup Manifest where 	a <> b = mkManifest 		(inManifest a <> inManifest b) 		(S.union (outManifest a) (outManifest b))
Types/Key.hs view
@@ -42,11 +42,9 @@ import Data.Char import System.Posix.Types import Foreign.C.Types-import Data.Monoid import Control.Applicative import GHC.Generics import Control.DeepSeq-import Prelude  {- A Key has a unique name, which is derived from a particular backend,  - and may contain other optional metadata. -}
Types/Transfer.hs view
@@ -23,8 +23,6 @@  import Data.Time.Clock.POSIX import Control.Concurrent-import Control.Applicative-import Prelude  {- Enough information to uniquely identify a transfer. -} data Transfer = Transfer
Types/UUID.hs view
@@ -20,7 +20,6 @@ import Data.String import Data.ByteString.Builder import Control.DeepSeq-import qualified Data.Semigroup as Sem  import Common import Git.Types (ConfigValue(..))@@ -115,7 +114,7 @@  -- A description of a UUID. newtype UUIDDesc = UUIDDesc B.ByteString-	deriving (Eq, Sem.Semigroup, Monoid, IsString)+	deriving (Eq, Semigroup, Monoid, IsString)  fromUUIDDesc :: UUIDDesc -> String fromUUIDDesc (UUIDDesc d) = decodeBS d
Types/VectorClock.hs view
@@ -8,8 +8,6 @@ module Types.VectorClock where  import Data.Time.Clock.POSIX-import Control.Applicative-import Prelude  import Utility.QuickCheck
Upgrade/V2.hs view
@@ -87,7 +87,7 @@ inject :: OsPath -> OsPath -> Annex () inject source dest = do 	old <- fromRepo olddir-	new <- liftIO (readFile $ fromOsPath $ old </> source)+	new <- liftIO $ readFileString (old </> source) 	Annex.Branch.change (Annex.Branch.RegardingUUID []) dest $ \prev ->  		encodeBL $ unlines $ nub $ lines (decodeBL prev) ++ lines new @@ -141,7 +141,7 @@ 	whenM (doesFileExist attributes) $ do 		c <- map decodeBS . fileLines' 			<$> F.readFile' attributes-		liftIO $ viaTmp (writeFile . fromOsPath) attributes +		liftIO $ viaTmp writeFileString attributes  			(unlines $ filter (`notElem` attrLines) c) 		Git.Command.run [Param "add", File (fromOsPath attributes)] repo
Upgrade/V7.hs view
@@ -136,7 +136,7 @@ 		<$> catchDefaultIO "" (F.readFile' lf) 	let ls' = removedotfilter ls 	when (ls /= ls') $-		liftIO $ writeFile (fromOsPath lf) (unlines ls')+		liftIO $ writeFileString lf (unlines ls')   where 	removedotfilter ("* filter=annex":".* !filter":rest) = 		"* filter=annex" : removedotfilter rest
Utility/Aeson.hs view
@@ -30,7 +30,6 @@ import qualified Data.Set import qualified Data.Map import qualified Data.Vector-import Prelude  import Utility.FileSystemEncoding #ifdef WITH_OSPATH
Utility/Daemon.hs view
@@ -52,7 +52,8 @@ 			maybe noop lockPidFile pidfile  			a 		_ -> do-			nullfd <- openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing defaultFileFlags+			nullfd <- openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing defaultFileFlags +				(CloseOnExecFlag True) 			redir nullfd stdInput 			redirLog =<< openlogfd 			environ <- getEnvironment@@ -91,7 +92,8 @@ #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 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@@ -117,9 +121,9 @@ 	unlessM (isNothing <$> checkDaemon pidfile) 		alreadyRunning 	pid <- getPID-	writeFile (fromOsPath pidfile) (show pid)+	writeFileString pidfile (show pid) 	lckfile <- winLockFile pid pidfile-	writeFile (fromOsPath lckfile) ""+	writeFileString lckfile "" 	void $ lockExclusive lckfile #endif @@ -135,12 +139,15 @@ 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 		locked <- getLock fd (ReadLock, AbsoluteSeek, 0, 0)-		p <- readish <$> readFile (fromOsPath pidfile)+		p <- readish <$> readFileString pidfile 		return (check locked p) 	go Nothing = return Nothing @@ -154,7 +161,7 @@ 			"; expected " ++ show pid ++ " )" #else checkDaemon pidfile = maybe (return Nothing) (check . readish)-	=<< catchMaybeIO (readFile (fromOsPath pidfile))+	=<< catchMaybeIO (readFileString pidfile)   where 	check Nothing = return Nothing 	check (Just pid) = do
Utility/Debug.hs view
@@ -23,8 +23,6 @@ import Data.String import Data.Time import System.IO.Unsafe (unsafePerformIO)-import qualified Data.Semigroup as Sem-import Prelude  import Utility.FileSystemEncoding @@ -41,7 +39,7 @@ 	= DebugSelector (DebugSource -> Bool) 	| NoDebugSelector -instance Sem.Semigroup DebugSelector where+instance Semigroup DebugSelector where 	DebugSelector a <> DebugSelector b = DebugSelector (\v -> a v || b v) 	NoDebugSelector <> NoDebugSelector = NoDebugSelector 	NoDebugSelector <> b = b
Utility/DirWatcher/Kqueue.hs view
@@ -111,7 +111,9 @@ 				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/Directory.hs view
@@ -19,10 +19,7 @@ #endif import Control.Monad import System.PosixCompat.Files (isDirectory, isSymbolicLink)-import Control.Applicative import System.IO.Unsafe (unsafeInterleaveIO)-import Data.Maybe-import Prelude  import Utility.OsPath import Utility.Exception
Utility/Directory/Create.hs view
@@ -15,12 +15,9 @@ ) where  import Control.Monad-import Control.Applicative import Control.Monad.IO.Class import Control.Monad.IfElse import System.IO.Error-import Data.Maybe-import Prelude  import Utility.SystemDirectory import Utility.Path.AbsRel
Utility/Directory/Stream.hs view
@@ -21,7 +21,6 @@ import Control.Monad import Control.Concurrent import Data.Maybe-import Prelude  #ifdef mingw32_HOST_OS import qualified System.Win32 as Win32
Utility/Env.hs view
@@ -21,7 +21,6 @@ import Utility.Exception import Control.Applicative import Data.Maybe-import Prelude import qualified System.Environment as E #else import qualified System.Posix.Env as PE
Utility/Env/Basic.hs view
@@ -13,9 +13,7 @@ ) where  import Utility.Exception-import Control.Applicative import Data.Maybe-import Prelude import qualified System.Environment as E  getEnv :: String -> IO (Maybe String)
Utility/FileIO.hs view
@@ -1,5 +1,14 @@-{- File IO on OsPaths.+{- This is a subset of the functions provided by file-io, supplimented with+ - readFileString, writeFileString, and appendFileString.  -+ - When building with file-io, all exported functions set the close-on-exec+ - flag. Also, some other issues are handled that file-io does not handle+ - correctly.+ -+ - When not building with file-io, this provides equvilant+ - RawFilePath versions. Note that those versions do not currently+ - set the close-on-exec flag.+ -  - Since Prelude exports many of these as well, this needs to be imported  - qualified.  -@@ -25,12 +34,17 @@ 	appendFile, 	appendFile', 	openTempFile,++	readFileString,+	writeFileString,+	appendFileString, ) where  #ifdef WITH_OSPATH  #ifndef mingw32_HOST_OS-import System.File.OsPath+import Utility.FileIO.CloseOnExec+import Utility.FileIO.String #else -- On Windows, System.File.OsPath does not handle UNC-style conversion itself, -- so that has to be done when calling it. See @@ -38,8 +52,9 @@ import Utility.Path.Windows import Utility.OsPath import System.IO (IO, Handle, IOMode)-import Prelude (return)-import qualified System.File.OsPath as O+import Prelude (String, return)+import qualified Utility.FileIO.CloseOnExec as O+import qualified Utility.FileIO.String as O import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Control.Applicative@@ -101,15 +116,30 @@ 	-- Avoid returning mangled path from convertToWindowsNativeNamespace 	let t' = p </> takeFileName t 	return (t', h)++readFileString :: OsPath -> IO String+readFileString p = do+	p' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath p)+	O.readFileString p'++writeFileString :: OsPath -> String -> IO ()+writeFileString f txt = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.writeFileString f' txt++appendFileString :: OsPath -> String -> IO ()+appendFileString f txt = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.appendFileString f' txt #endif  #else--- When not building with OsPath, export RawFilePath versions--- instead.+-- RawFilePath versions import Utility.OsPath import Utility.FileSystemEncoding import System.IO (IO, Handle, IOMode)-import Prelude ((.), return)+import Prelude (String, (.), return)+import qualified Prelude as P import qualified System.IO import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L@@ -150,4 +180,13 @@ 		(fromRawFilePath p) 		(fromRawFilePath s) 	return (toRawFilePath t, h)++readFileString :: OsPath -> IO String+readFileString = P.readFile . fromRawFilePath++writeFileString :: OsPath -> String -> IO ()+writeFileString = P.writeFile . fromRawFilePath++appendFileString :: OsPath -> String -> IO ()+appendFileString = P.appendFile . fromRawFilePath #endif
+ Utility/FileIO/CloseOnExec.hs view
@@ -0,0 +1,148 @@+{- This is a subset of the functions provided by file-io.+ -+ - All functions have been modified to set the close-on-exec+ - flag to True.+ -+ - Also, functions that return a Handle have been modified to+ - use the locale encoding, working around this bug:+ - https://github.com/haskell/file-io/issues/45+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ - Copyright 2024 Julian Ospald+ -+ - License: BSD-3-clause+ -}++{-# OPTIONS_GHC -fno-warn-tabs #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Utility.FileIO.CloseOnExec+(+#ifdef WITH_OSPATH+	withFile,+	withFile',+	openFile,+	withBinaryFile,+	openBinaryFile,+	readFile,+	readFile',+	writeFile,+	writeFile',+	appendFile,+	appendFile',+	openTempFile,+#endif+) where++#ifdef WITH_OSPATH++import System.File.OsPath.Internal (withOpenFile', augmentError)+import qualified System.File.OsPath.Internal as I+import System.IO (IO, Handle, IOMode(..), hSetEncoding)+import GHC.IO.Encoding (getLocaleEncoding)+import System.OsPath (OsPath, OsString)+import Prelude (Bool(..), pure, either, (.), (>>=), ($))+import Control.Exception+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+#ifndef mingw32_HOST_OS+import System.Posix.IO+import Utility.Process+#endif++closeOnExec :: Bool+closeOnExec = True++withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r+withFile osfp iomode act = (augmentError "withFile" osfp+    $ withOpenFileEncoding osfp iomode False False closeOnExec (try . act) True)+  >>= either ioError pure++withFile' :: OsPath -> IOMode -> (Handle -> IO r) -> IO r+withFile' osfp iomode act = (augmentError "withFile'" osfp+    $ withOpenFileEncoding osfp iomode False False closeOnExec (try . act) False)+  >>= either ioError pure++openFile :: OsPath -> IOMode -> IO Handle+openFile osfp iomode =  augmentError "openFile" osfp $+	withOpenFileEncoding osfp iomode False False closeOnExec pure False++withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r+withBinaryFile osfp iomode act = (augmentError "withBinaryFile" osfp+    $ withOpenFileEncoding osfp iomode True False closeOnExec (try . act) True)+  >>= either ioError pure++openBinaryFile :: OsPath -> IOMode -> IO Handle+openBinaryFile osfp iomode = augmentError "openBinaryFile" osfp $+	 withOpenFileEncoding osfp iomode True False closeOnExec pure False++readFile :: OsPath -> IO BSL.ByteString+readFile fp = withFileNoEncoding' fp ReadMode BSL.hGetContents++readFile'+  :: OsPath -> IO BS.ByteString+readFile' fp = withFileNoEncoding fp ReadMode BS.hGetContents++writeFile :: OsPath -> BSL.ByteString -> IO ()+writeFile fp contents = withFileNoEncoding fp WriteMode (`BSL.hPut` contents)++writeFile'+  :: OsPath -> BS.ByteString -> IO ()+writeFile' fp contents = withFileNoEncoding fp WriteMode (`BS.hPut` contents)++appendFile :: OsPath -> BSL.ByteString -> IO ()+appendFile fp contents = withFileNoEncoding fp AppendMode (`BSL.hPut` contents)++appendFile'+  :: OsPath -> BS.ByteString -> IO ()+appendFile' fp contents = withFileNoEncoding fp AppendMode (`BS.hPut` contents)++{- Re-implementing openTempFile is difficult due to the current+ - structure of file-io. See this issue for discussion about improving+ - that: https://github.com/haskell/file-io/issues/44+ - So, instead this uses noCreateProcessWhile.+ - -}+openTempFile :: OsPath -> OsString -> IO (OsPath, Handle)+openTempFile tmp_dir template = do+#ifdef mingw32_HOST_OS+	(p, h) <- I.openTempFile tmp_dir template+	getLocaleEncoding >>= hSetEncoding h+	pure (p, h)+#else+	noCreateProcessWhile $ do+		(p, h) <- I.openTempFile tmp_dir template+		fd <- handleToFd h+		setFdOption fd CloseOnExec True+		h' <- fdToHandle fd+		getLocaleEncoding >>= hSetEncoding h'+		pure (p, h')+#endif++{- Wrapper around withOpenFile' that sets the locale encoding on the+ - Handle. -}+withOpenFileEncoding :: OsPath -> IOMode -> Bool -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r+withOpenFileEncoding fp iomode binary existing cloExec action close_finally =+	withOpenFile' fp iomode binary existing cloExec action' close_finally+  where+	action' h = do+		getLocaleEncoding >>= hSetEncoding h+		action h++{- Variant of withFile above that does not have the overhead of setting the+ - locale encoding. Faster to use when the Handle is not used in a way that+ - needs any encoding. -}+withFileNoEncoding :: OsPath -> IOMode -> (Handle -> IO r) -> IO r+withFileNoEncoding osfp iomode act = (augmentError "withFile" osfp+    $ withOpenFile' osfp iomode False False closeOnExec (try . act) True)+  >>= either ioError pure++{- Variant of withFile' above that does not have the overhead of setting the+ - locale encoding. Faster to use when the Handle is not used in a way that+ - needs any encoding. -}+withFileNoEncoding' :: OsPath -> IOMode -> (Handle -> IO r) -> IO r+withFileNoEncoding' osfp iomode act = (augmentError "withFile'" osfp+    $ withOpenFile' osfp iomode False False closeOnExec (try . act) False)+  >>= either ioError pure++#endif
+ Utility/FileIO/String.hs view
@@ -0,0 +1,38 @@+{- Functions that operate on OsPath, but treat the contents of files as+ - Strings.+ -+ - These functions all set the close-on-exec flag to True, unlike+ - the Prelude versions.+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# OPTIONS_GHC -fno-warn-tabs #-}+{-# LANGUAGE CPP #-}++module Utility.FileIO.String+(+#ifdef WITH_OSPATH+	readFileString,+	writeFileString,+	appendFileString,+#endif+) where++#ifdef WITH_OSPATH+import qualified Utility.FileIO.CloseOnExec as I+import Utility.OsPath (OsPath)+import Prelude (String, IO, (>>=))+import System.IO (IOMode(..), hGetContents, hPutStr)++readFileString :: OsPath -> IO String+readFileString f = I.openFile f ReadMode >>= hGetContents++writeFileString :: OsPath -> String -> IO ()+writeFileString f txt = I.withFile f WriteMode (\hdl -> hPutStr hdl txt)++appendFileString :: OsPath -> String -> IO ()+appendFileString f txt = I.withFile f AppendMode (\hdl -> hPutStr hdl txt)+#endif
Utility/FileMode.hs view
@@ -171,7 +171,7 @@  - When possible, this is done using the umask.  -  - On a filesystem that does not support file permissions, this is the same- - as writeFile.+ - as writeFileString.  -} writeFileProtected :: OsPath -> String -> IO () writeFileProtected file content = writeFileProtected' file
Utility/FileSystemEncoding.hs view
@@ -119,11 +119,14 @@ toRawFilePath :: FilePath -> RawFilePath toRawFilePath = encodeBS -{- Truncates a FilePath to the given number of bytes (or less),+{- Truncates a path to the given number of bytes (or less),  - as represented on disk.  -  - Avoids returning an invalid part of a unicode byte sequence, at the  - cost of efficiency when running on a large FilePath.+ -+ - Note that this may return ""! That can happen if it is asked to truncate+ - to eg 1 byte, but the input path starts with a unicode byte sequence.  -} truncateFilePath :: Int -> RawFilePath -> RawFilePath #ifndef mingw32_HOST_OS
Utility/FreeDesktop.hs view
@@ -75,7 +75,7 @@ writeDesktopMenuFile :: DesktopEntry -> OsPath -> IO () writeDesktopMenuFile d file = do 	createDirectoryIfMissing True (takeDirectory file)-	writeFile (fromOsPath file) $ buildDesktopMenuFile d+	writeFileString file $ buildDesktopMenuFile d  {- Path to use for a desktop menu file, in either the systemDataDir or  - the userDataDir -}
Utility/Gpg.hs view
@@ -162,8 +162,10 @@ #ifndef mingw32_HOST_OS 	let setup = liftIO $ do 		-- pipe the passphrase into gpg on a fd-		(frompipe, topipe) <- System.Posix.IO.createPipe-		setFdOption topipe CloseOnExec True+		(frompipe, topipe) <- noCreateProcessWhile $ do+			(frompipe, topipe) <- System.Posix.IO.createPipe+			setFdOption topipe CloseOnExec True+			return (frompipe, topipe) 		toh <- fdToHandle topipe 		t <- async $ do 			B.hPutStr toh (passphrase <> "\n")
Utility/Hash.hs view
@@ -1,4 +1,4 @@-{- Convenience wrapper around cryptonite's hashing.+{- Convenience wrapper around crypton's hashing.  -  - Copyright 2013-2024 Joey Hess <id@joeyh.name>  -@@ -7,7 +7,6 @@  {-# LANGUAGE BangPatterns, PackageImports #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE CPP #-}  module Utility.Hash ( 	sha1,@@ -78,13 +77,8 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.IORef-#ifdef WITH_CRYPTON import "crypton" Crypto.MAC.HMAC hiding (Context) import "crypton" Crypto.Hash-#else-import "cryptonite" Crypto.MAC.HMAC hiding (Context)-import "cryptonite" Crypto.Hash-#endif  sha1 :: L.ByteString -> Digest SHA1 sha1 = hashlazy
Utility/HumanTime.hs view
@@ -23,8 +23,6 @@ import Data.Time.Clock import Data.Time.Clock.POSIX (POSIXTime) import Data.Char-import Control.Applicative-import Prelude  newtype Duration = Duration { durationSeconds :: Integer } 	deriving (Eq, Ord, Read, Show)
Utility/IPAddress.hs view
@@ -23,9 +23,7 @@ import Data.Word import Data.Memory.Endian import Data.List-import Control.Applicative import Text.Printf-import Prelude  extractIPAddress :: SockAddr -> Maybe String extractIPAddress (SockAddrInet _ ipv4) =
Utility/InodeCache.hs view
@@ -234,7 +234,7 @@ writeSentinalFile :: SentinalFile -> IO () writeSentinalFile s = do 	F.writeFile' (sentinalFile s) mempty-	maybe noop (writeFile (fromOsPath (sentinalCacheFile s)) . showInodeCache)+	maybe noop (writeFileString (sentinalCacheFile s) . showInodeCache) 		=<< genInodeCache (sentinalFile s) noTSDelta  data SentinalStatus = SentinalStatus@@ -263,7 +263,7 @@ 				Just new -> return $ calc old new   where 	loadoldcache = catchDefaultIO Nothing $-		readInodeCache <$> readFile (fromOsPath (sentinalCacheFile s))+		readInodeCache <$> readFileString (sentinalCacheFile s) 	gennewcache = genInodeCache (sentinalFile s) noTSDelta 	calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) = 		SentinalStatus (not unchanged) tsdelta
Utility/LinuxMkLibs.hs view
@@ -33,8 +33,6 @@ import System.Posix.Files (isSymbolicLink) import Data.Char import Control.Monad.IfElse-import Control.Applicative-import Prelude  {- Installs a library. If the library is a symlink to another file,  - install the file it links to, and update the symlink to be relative. -}
Utility/LockFile/PidLock.hs view
@@ -41,6 +41,7 @@ import Utility.Tmp import Utility.RawFilePath import Utility.OsPath+import qualified Utility.FileIO as F import qualified Utility.LockFile.Posix as Posix  import System.IO@@ -48,13 +49,12 @@ import System.Posix.IO.ByteString import System.Posix.Files.ByteString import System.Posix.Process+import GHC.IO.Encoding (getLocaleEncoding) import Control.Monad import Control.Monad.IO.Class (liftIO, MonadIO) import Data.Maybe import Data.List import Network.BSD-import Control.Applicative-import Prelude  type PidLockFile = OsPath @@ -77,7 +77,7 @@  readPidLock :: PidLockFile -> IO (Maybe PidLock) readPidLock lockfile = (readish =<<)-	<$> catchMaybeIO (readFile (fromOsPath lockfile))+	<$> catchMaybeIO (F.readFileString lockfile)  -- To avoid races when taking over a stale pid lock, a side lock is used. -- This is a regular posix exclusive lock.@@ -210,10 +210,13 @@ 			let setup = do 				fd <- openFdWithMode dest' WriteOnly 					(Just $ combineModes readModes)-					(defaultFileFlags {exclusive = True})-				fdToHandle fd+					(defaultFileFlags { exclusive = True })+					(CloseOnExecFlag True)+				h <- fdToHandle fd+				getLocaleEncoding >>= hSetEncoding h+				return h 			let cleanup = hClose-			let go h = readFile (fromOsPath src) >>= hPutStr h+			let go h = F.readFileString src >>= hPutStr h 			bracket setup cleanup go 			getFileStatus dest'   where
Utility/LockFile/Posix.hs view
@@ -74,11 +74,10 @@  -- 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' defaultFileFlags-	setFdOption l CloseOnExec True-	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/LockPool/LockHandle.hs view
@@ -25,7 +25,6 @@ import Control.Concurrent.STM import Control.Monad.Catch import Control.Monad.IO.Class (liftIO, MonadIO)-import Prelude  data LockHandle = LockHandle P.LockHandle FileLockOps
Utility/LockPool/PidLock.hs view
@@ -25,15 +25,12 @@ import Utility.LockPool.LockHandle import Utility.ThreadScheduler -import System.IO import System.Posix import Control.Concurrent.STM import Data.Maybe import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class-import Control.Applicative-import Prelude  -- Does locking using a pid lock, blocking until the lock is available -- or the Seconds timeout if the pid lock is held by another process.
Utility/LockPool/Posix.hs view
@@ -26,11 +26,7 @@ import Utility.LockPool.LockHandle import Utility.FileMode -import System.IO import System.Posix-import Data.Maybe-import Control.Applicative-import Prelude  -- Takes a shared lock, blocking until the lock is available. lockShared :: Maybe ModeSetter -> LockFile -> IO LockHandle
Utility/MagicWormhole.hs view
@@ -38,8 +38,6 @@ import Control.Concurrent.Async import Data.Char import Data.List-import Control.Applicative-import Prelude  -- | A Magic Wormhole code. newtype Code = Code String
Utility/Misc.hs view
@@ -34,12 +34,10 @@ import Data.Char import Data.List import System.Exit-import Control.Applicative import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8-import Prelude  {- A version of hgetContents that is not lazy. Ensures file is   - all read before it gets closed. -}@@ -110,7 +108,7 @@ fileLines' = S8.lines #endif --- One windows, writeFile does NewlineMode translation,+-- On windows, writeFile does NewlineMode translation, -- adding CR before LF. When converting to ByteString, use this to emulate that. linesFile :: L.ByteString -> L.ByteString #ifndef mingw32_HOST_OS
Utility/MoveFile.hs view
@@ -15,7 +15,6 @@  import Control.Monad import System.IO.Error-import Prelude  #ifndef mingw32_HOST_OS import System.PosixCompat.Files (isDirectory)
Utility/Network.hs view
@@ -12,9 +12,6 @@ import Utility.Process import Utility.Exception -import Control.Applicative-import Prelude- {- Haskell lacks uname(2) bindings, except in the  - Bindings.Uname addon. Rather than depend on that,  - use uname -n when available. -}
Utility/OpenFd.hs view
@@ -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 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 view
@@ -31,7 +31,7 @@  -} 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
Utility/OptParse.hs view
@@ -11,8 +11,6 @@ ) where  import Options.Applicative-import Data.Monoid-import Prelude  -- | A switch that can be enabled using --foo and disabled using --no-foo. --
Utility/Path.hs view
@@ -31,8 +31,6 @@ import Data.List import Data.Maybe import Control.Monad-import Control.Applicative-import Prelude  import Author import Utility.Monad
Utility/Path/AbsRel.hs view
@@ -18,8 +18,6 @@ ) where  import qualified Data.ByteString as B-import Control.Applicative-import Prelude  import Utility.Path import Utility.UserInfo
Utility/Path/Max.hs view
@@ -13,9 +13,6 @@ #ifndef mingw32_HOST_OS import Utility.Exception import System.Posix.Files-import Data.List-import Control.Applicative-import Prelude #endif  {- Maximum size to use for a file in a specified directory.
Utility/Path/Tests.hs view
@@ -17,11 +17,6 @@ 	prop_dirContains_regressionTest, ) where -import Data.List-import Data.Maybe-import Control.Applicative-import Prelude- import Common import Utility.QuickCheck import qualified Utility.OsString as OS
Utility/Process.hs view
@@ -1,7 +1,8 @@ {- System.Process enhancements, including additional ways of running- - processes, and logging.+ - processes, logging, and amelorations for cases where FDs are not able to+ - be opened with close-on-exec.  -- - Copyright 2012-2020 Joey Hess <id@joeyh.name>+ - Copyright 2012-2025 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -21,6 +22,7 @@ 	forceSuccessProcess', 	checkSuccessProcess, 	withNullHandle,+	noCreateProcessWhile, 	createProcess, 	withCreateProcess, 	waitForProcess,@@ -36,7 +38,7 @@ ) where  import qualified Utility.Process.Shim-import Utility.Process.Shim as X (CreateProcess(..), ProcessHandle, StdStream(..), CmdSpec(..), proc, getPid, getProcessExitCode, shell, terminateProcess, interruptProcessGroupOf)+import Utility.Process.Shim as X (CreateProcess(..), ProcessHandle, StdStream(..), CmdSpec(..), proc, getPid, getProcessExitCode, shell, terminateProcess, interruptProcessGroupOf, Pid) import Utility.Misc import Utility.Exception import Utility.Monad@@ -46,7 +48,9 @@ import System.IO import Control.Monad.IO.Class import Control.Concurrent.Async+import Control.Concurrent import qualified Data.ByteString as S+import System.IO.Unsafe (unsafePerformIO)  data StdHandle = StdinHandle | StdoutHandle | StderrHandle 	deriving (Eq)@@ -173,9 +177,34 @@ 	(Just from, Just to, _, pid) <- createProcess p 	return (pid, to, from) --- | Wrapper around 'System.Process.createProcess' that does debug logging.+-- | Runs an action, preventing any new processes from being started+-- until it is finished.+--+-- Unfortunately, Haskell has a pervasive problem with the close-on-exec+-- flag not being set when opening files. It's also difficult to portably+-- dup or pipe a FD with the close-on-exec flag set. So, this can be used+-- to run an action that opens a FD, and then calls setFdOption to set the+-- close-on-exec flag, without risking a race with a process being forked+-- at the same time.+--+-- Note that only one of these actions can run at a time, and long-duration+-- actions are not advisable.+noCreateProcessWhile :: (MonadIO m, MonadMask m) => (m a) -> m a+noCreateProcessWhile = bracket setup cleanup . const+  where+	setup = liftIO $ takeMVar createProcessSem+	cleanup () = liftIO $ putMVar createProcessSem ()++-- | A shared global MVar. Processes are not created while it is empty.+{-# NOINLINE createProcessSem #-}+createProcessSem :: MVar ()+createProcessSem = unsafePerformIO $ newMVar ()++-- | Wrapper around 'System.Process.createProcess'. +-- This adds debug logging, and avoids starting a process when in a+-- noCreateProcessWhile block. createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)-createProcess p = do+createProcess p = noCreateProcessWhile $ do 	r@(_, _, _, h) <- Utility.Process.Shim.createProcess p 	debugProcess p h 	return r
Utility/Process/Transcript.hs view
@@ -23,11 +23,9 @@ #ifndef mingw32_HOST_OS import Control.Exception import qualified System.Posix.IO-#else-import Control.Applicative+import GHC.IO.Encoding (getLocaleEncoding) #endif import Data.Maybe-import Prelude  -- | Runs a process and returns a transcript combining its stdout and -- stderr, and whether it succeeded or failed.@@ -45,12 +43,15 @@ #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order  - the process writes them. -}- 	let setup = do+ 	let setup = noCreateProcessWhile $ do 		(readf, writef) <- System.Posix.IO.createPipe 		System.Posix.IO.setFdOption readf System.Posix.IO.CloseOnExec True 		System.Posix.IO.setFdOption writef System.Posix.IO.CloseOnExec True 		readh <- System.Posix.IO.fdToHandle readf 		writeh <- System.Posix.IO.fdToHandle writef+		enc <- getLocaleEncoding+		hSetEncoding readh enc+		hSetEncoding writeh enc 		return (readh, writeh) 	let cleanup (readh, writeh) = do 		hClose readh
Utility/QuickCheck.hs view
@@ -24,7 +24,6 @@ import Data.Char import System.Posix.Types import Data.List.NonEmpty (NonEmpty(..))-import Prelude  {- A String, but Arbitrary is limited to ascii.  -
Utility/SafeCommand.hs view
@@ -26,9 +26,6 @@ import System.Exit import System.FilePath import Data.Char-import Data.List-import Control.Applicative-import Prelude  -- | Parameters that can be passed to a shell command. data CommandParam
Utility/Scheduled.hs view
@@ -40,8 +40,6 @@ import Data.Time.Calendar.OrdinalDate import Data.Time.Format () import Data.Char-import Control.Applicative-import Prelude  {- Some sort of scheduled event. -} data Schedule = Schedule Recurrence ScheduledTime
Utility/Scheduled/QuickCheck.hs view
@@ -12,9 +12,6 @@ import Utility.Scheduled import Utility.QuickCheck -import Control.Applicative-import Prelude- instance Arbitrary Schedule where 	arbitrary = Schedule <$> arbitrary <*> arbitrary
Utility/Shell.hs view
@@ -19,6 +19,7 @@ import Utility.Path import Utility.Exception import Utility.PartialPrelude+import Utility.FileIO (readFileString) #endif  shellPath :: FilePath@@ -37,7 +38,7 @@ #ifndef mingw32_HOST_OS 	defcmd #else-	l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFile (fromOsPath f)+	l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFileString f 	case l of 		Just ('#':'!':rest) -> case words rest of 			[] -> defcmd
Utility/ShellEscape.hs view
@@ -18,10 +18,9 @@ import Author import Utility.QuickCheck import Utility.Split-import Data.Function +import Data.Function import Data.List-import Prelude  copyright :: Copyright copyright = author JoeyHess (2000+30-20)
Utility/StatelessOpenPGP.hs view
@@ -141,8 +141,10 @@ #ifndef mingw32_HOST_OS 	let setup = liftIO $ do 		-- pipe the passphrase in on a fd-		(frompipe, topipe) <- System.Posix.IO.createPipe-		setFdOption topipe CloseOnExec True+		(frompipe, topipe) <- noCreateProcessWhile $ do+			(frompipe, topipe) <- System.Posix.IO.createPipe+			setFdOption topipe CloseOnExec True+			return (frompipe, topipe) 		toh <- fdToHandle topipe 		t <- async $ do 			B.hPutStr toh (password <> "\n")
Utility/Tmp.hs view
@@ -49,13 +49,13 @@ 		let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template) 		in annotateIOError e loc Nothing Nothing -{- Runs an action like writeFile, writing to a temp file first and+{- Runs an action like writeFileString, writing to a temp file first and  - then moving it into place. The temp file is stored in the same  - directory as the final file to avoid cross-device renames.  -  - While this uses a temp file, the file will end up with the same- - mode as it would when using writeFile, unless the writer action changes- - it.+ - mode as it would when using writeFileString, unless the writer action+ - changes it.  -} viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m () viaTmp a file content = bracketIO setup cleanup use@@ -116,17 +116,32 @@ #ifndef mingw32_HOST_OS relatedTemplate' f 	| len > templateAddedLength = -		{- Some filesystems like FAT have issues with filenames-		 - ending in ".", and others like VFAT don't allow a-		 - filename to end with trailing whitespace, so avoid-		 - truncating a filename to end that way. -}-		B.dropWhileEnd disallowed $-			truncateFilePath (len - templateAddedLength) f+		let p = fixend $ truncateFilePath (len - templateAddedLength) f+		in if B.null p+			then "t"+			else p 	| otherwise = f   where 	len = B.length f-	disallowed c = c == dot || isSpace (chr (fromIntegral c))+	{- Some filesystems like FAT have issues with filenames+	 - ending in ".", and others like VFAT don't allow a+	 - filename to end with trailing whitespace, so avoid+	 - truncating a filename to end that way.+	 -+	 - Checking with unsnoc for the path to end with a disallowed+	 - character doesn't take wide characters into account,+	 - so will have false positives, but it is fast.+	 -}+	fixend p = case B.unsnoc p of+		Just (_, c) | disallowed c -> +			-- Convert to String to take wide characters into+			-- account.+			toRawFilePath $ reverse $+				dropWhile (disallowed . fromIntegral . ord) $+				reverse $ fromRawFilePath p+		_ -> p 	dot = fromIntegral (ord '.')+	disallowed c = c == dot || isSpace (chr (fromIntegral c)) #else -- Avoids a test suite failure on windows, reason unknown, but -- best to keep paths short on windows anyway.
Utility/Tor.hs view
@@ -71,7 +71,7 @@ addHiddenService :: AppName -> UserID -> UniqueIdent -> IO (OnionAddress, OnionPort) addHiddenService appname uid ident = do 	prepHiddenServiceSocketDir appname uid ident-	ls <- lines <$> (readFile . fromOsPath =<< findTorrc)+	ls <- lines <$> (readFileString =<< findTorrc) 	let portssocks = mapMaybe (parseportsock . separate isSpace) ls 	case filter (\(_, s) -> s == fromOsPath sockfile) portssocks of 		((p, _s):_) -> waithiddenservice 1 p@@ -80,7 +80,7 @@ 			let newport = fromMaybe (error "internal") $ headMaybe $ 				filter (`notElem` map fst portssocks) highports 			torrc <- findTorrc-			writeFile (fromOsPath torrc) $ unlines $+			writeFileString torrc $ unlines $ 				ls ++ 				[ "" 				, "HiddenServiceDir " ++ fromOsPath (hiddenServiceDir appname uid ident)@@ -112,7 +112,7 @@ 	waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort) 	waithiddenservice 0 _ = giveup "tor failed to create hidden service, perhaps the tor service is not running" 	waithiddenservice n p = do-		v <- tryIO $ readFile $ fromOsPath $+		v <- tryIO $ readFileString $ 			hiddenServiceHostnameFile appname uid ident 		case v of 			Right s | ".onion\n" `isSuffixOf` s ->@@ -152,7 +152,7 @@ getHiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> IO (Maybe OsPath) getHiddenServiceSocketFile _appname uid ident =  	parse . map words . lines <$> catchDefaultIO "" -		(readFile . fromOsPath =<< findTorrc)+		(readFileString =<< findTorrc)   where 	parse [] = Nothing 	parse (("HiddenServiceDir":hsdir:[]):("HiddenServicePort":_hsport:hsaddr:[]):rest)
Utility/UserInfo.hs view
@@ -18,14 +18,11 @@ import Utility.Exception #ifndef mingw32_HOST_OS import Utility.Data-import Control.Applicative import System.Posix.User #if MIN_VERSION_unix(2,8,0) import System.Posix.User.ByteString (UserEntry) #endif #endif--import Prelude  {- Current user's home directory.  -
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20250828+Version: 10.20250925 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -169,14 +169,12 @@ Flag MagicMime   Description: Use libmagic to determine file MIME types -Flag Crypton-  Description: Use the crypton library rather than the no longer maintained cryptonite- Flag Servant   Description: Use the servant library, enabling using annex+http urls and git-annex p2phttp  Flag OsPath   Description: Use the os-string library and related libraries, for faster filename manipulation+  Default: True  Flag Benchmark   Description: Enable benchmarking@@ -205,7 +203,7 @@     time (>= 1.9.1),     directory (>= 1.2.7.0),     async,-    utf8-string,+    utf8-string (>= 1.0.0),     Cabal (< 4.0)  Executable git-annex@@ -233,7 +231,7 @@    IfElse,    monad-logger (>= 0.3.10),    free,-   utf8-string,+   utf8-string (>= 1.0.0),    bytestring,    text,    sandi,@@ -283,7 +281,8 @@    network (>= 3.0.0.0),    network-bsd,    git-lfs (>= 1.2.0),-   clock (>= 0.3.0)+   clock (>= 0.3.0),+   crypton   CC-Options: -Wall   GHC-Options: -Wall -fno-warn-tabs  -Wincomplete-uni-patterns   Default-Language: Haskell2010@@ -310,12 +309,6 @@   if os(linux) || os(freebsd)     GHC-Options: -optl-Wl,--as-needed -  if flag(Crypton)-    Build-Depends: crypton-    CPP-Options: -DWITH_CRYPTON-  else-    Build-Depends: cryptonite (>= 0.23)-   if flag(Servant)     Build-Depends:       servant,@@ -1147,6 +1140,8 @@     Utility.Su     Utility.SystemDirectory     Utility.FileIO+    Utility.FileIO.CloseOnExec+    Utility.FileIO.String     Utility.Terminal     Utility.TimeStamp     Utility.TList
stack.yaml view
@@ -9,7 +9,6 @@     dbus: false     debuglocks: false     benchmark: true-    crypton: true     servant: true     ospath: true packages: