packages feed

git-annex 5.20140606 → 5.20140613

raw patch · 94 files changed

+1444/−819 lines, 94 filesdep +wai-extradep −wai-logger

Dependencies added: wai-extra

Dependencies removed: wai-logger

Files

Annex.hs view
@@ -32,10 +32,6 @@ 	withCurrentState, ) where -import "mtl" Control.Monad.Reader-import Control.Monad.Catch-import Control.Concurrent- import Common import qualified Git import qualified Git.Config@@ -62,12 +58,17 @@ import Types.MetaData import Types.DesktopNotify import Types.CleanupActions-import qualified Data.Map as M-import qualified Data.Set as S #ifdef WITH_QUVI import Utility.Quvi (QuviVersion) #endif+import Utility.InodeCache +import "mtl" Control.Monad.Reader+import Control.Monad.Catch+import Control.Concurrent+import qualified Data.Map as M+import qualified Data.Set as S+ {- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.  - This allows modifying the state in an exception-safe fashion.  - The MVar is not exposed outside this module.@@ -120,7 +121,7 @@ 	, fields :: M.Map String String 	, modmeta :: [ModMeta] 	, cleanup :: M.Map CleanupAction (Annex ())-	, inodeschanged :: Maybe Bool+	, sentinalstatus :: Maybe SentinalStatus 	, useragent :: Maybe String 	, errcounter :: Integer 	, unusedkeys :: Maybe (S.Set Key)@@ -165,7 +166,7 @@ 	, fields = M.empty 	, modmeta = [] 	, cleanup = M.empty-	, inodeschanged = Nothing+	, sentinalstatus = Nothing 	, useragent = Nothing 	, errcounter = 0 	, unusedkeys = Nothing
Annex/AutoMerge.hs view
@@ -17,7 +17,6 @@ import qualified Git.UpdateIndex as UpdateIndex import qualified Git.Merge import qualified Git.Ref-import qualified Git.Sha import qualified Git import Git.Types (BlobType(..)) import Config@@ -38,14 +37,9 @@ 		Just b -> go =<< inRepo (Git.Ref.sha b)   where 	go old = ifM isDirect-		( do-			d <- fromRepo gitAnnexMergeDir-			r <- inRepo (mergeDirect d branch)-				<||> resolveMerge old branch-			mergeDirectCleanup d (fromMaybe Git.Sha.emptyTree old) Git.Ref.headRef-			return r+		( mergeDirect currbranch old branch (resolveMerge old branch) 		, inRepo (Git.Merge.mergeNonInteractive branch)-			<||> resolveMerge old branch+			<||> (resolveMerge old branch <&&> commitResolvedMerge) 		)  {- Resolves a conflicted merge. It's important that any conflicts be@@ -70,9 +64,11 @@  -  - In indirect mode, the merge is resolved in the work tree and files  - staged, to clean up from a conflicted merge that was run in the work- - tree. In direct mode, the work tree is not touched here; files are - - staged to the index, and written to the gitAnnexMergeDir, and later- - mergeDirectCleanup handles updating the work tree.+ - tree.+ -+ - In direct mode, the work tree is not touched here; files are staged to+ - the index, and written to the gitAnnexMergeDir, for later handling by+ - the direct mode merge code.  -} resolveMerge :: Maybe Git.Ref -> Git.Ref -> Annex Bool resolveMerge us them = do@@ -92,14 +88,6 @@ 		unlessM isDirect $ 			cleanConflictCruft mergedfs top 		Annex.Queue.flush-		whenM isDirect $-			void preCommitDirect-		void $ inRepo $ Git.Command.runBool-			[ Param "commit"-			, Param "--no-verify"-			, Param "-m"-			, Param "git-annex automatic merge conflict fix"-			] 		showLongNote "Merge conflict was automatically resolved; you may want to examine the result." 	return merged @@ -177,3 +165,11 @@ 	s = S.fromList resolvedfs 	matchesresolved f = S.member (base f) s 	base f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f+	+commitResolvedMerge :: Annex Bool+commitResolvedMerge = inRepo $ Git.Command.runBool+	[ Param "commit"+	, Param "--no-verify"+	, Param "-m"+	, Param "git-annex automatic merge conflict fix"+	]
Annex/Content/Direct.hs view
@@ -1,10 +1,12 @@ {- git-annex file content managing for direct mode  -- - Copyright 2012-2013 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Annex.Content.Direct ( 	associatedFiles, 	associatedFilesRelative,@@ -27,6 +29,8 @@ 	inodesChanged, 	createInodeSentinalFile, 	addContentWhenNotPresent,+	withTSDelta,+	getTSDelta, ) where  import Common.Annex@@ -136,7 +140,7 @@  -} updateInodeCache :: Key -> FilePath -> Annex () updateInodeCache key file = maybe noop (addInodeCache key)-	=<< liftIO (genInodeCache file)+	=<< withTSDelta (liftIO . genInodeCache file)  {- Adds another inode to the cache for a key. -} addInodeCache :: Key -> InodeCache -> Annex ()@@ -164,7 +168,7 @@ {- Checks if a InodeCache matches the current version of a file. -} sameInodeCache :: FilePath -> [InodeCache] -> Annex Bool sameInodeCache _ [] = return False-sameInodeCache file old = go =<< liftIO (genInodeCache file)+sameInodeCache file old = go =<< withTSDelta (liftIO . genInodeCache file)   where 	go Nothing = return False 	go (Just curr) = elemInodeCaches curr old@@ -173,7 +177,7 @@ sameFileStatus :: Key -> FileStatus -> Annex Bool sameFileStatus key status = do 	old <- recordedInodeCache key-	let curr = toInodeCache status+	curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta status 	case (old, curr) of 		(_, Just c) -> elemInodeCaches c old 		([], Nothing) -> return True@@ -217,40 +221,43 @@  - inodes have changed.  -} inodesChanged :: Annex Bool-inodesChanged = maybe calc return =<< Annex.getState Annex.inodeschanged-  where-	calc = do-		scache <- liftIO . genInodeCache-			=<< fromRepo gitAnnexInodeSentinal-		scached <- readInodeSentinalFile-		let changed = case (scache, scached) of-			(Just c1, Just c2) -> not $ compareStrong c1 c2-			_ -> True-		Annex.changeState $ \s -> s { Annex.inodeschanged = Just changed }-		return changed+inodesChanged = sentinalInodesChanged <$> sentinalStatus -readInodeSentinalFile :: Annex (Maybe InodeCache)-readInodeSentinalFile = do-	sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache-	liftIO $ catchDefaultIO Nothing $-		readInodeCache <$> readFile sentinalcachefile+withTSDelta :: (TSDelta -> Annex a) -> Annex a+withTSDelta a = a =<< getTSDelta -writeInodeSentinalFile :: Annex ()-writeInodeSentinalFile = do-	sentinalfile <- fromRepo gitAnnexInodeSentinal-	createAnnexDirectory (parentDir sentinalfile)-	sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache-	liftIO $ writeFile sentinalfile ""-	liftIO $ maybe noop (writeFile sentinalcachefile . showInodeCache)-		=<< genInodeCache sentinalfile+getTSDelta :: Annex TSDelta+#ifdef mingw32_HOST_OS+getTSDelta = sentinalTSDelta <$> sentinalStatus+#else+getTSDelta = pure noTSDelta -- optimisation+#endif +sentinalStatus :: Annex SentinalStatus+sentinalStatus = maybe check return =<< Annex.getState Annex.sentinalstatus+  where+	check = do+		sc <- liftIO . checkSentinalFile =<< annexSentinalFile+		Annex.changeState $ \s -> s { Annex.sentinalstatus = Just sc }+		return sc+ {- The sentinal file is only created when first initializing a repository.  - If there are any annexed objects in the repository already, creating  - the file would invalidate their inode caches. -} createInodeSentinalFile :: Annex ()-createInodeSentinalFile =-	unlessM (alreadyexists <||> hasobjects)-		writeInodeSentinalFile+createInodeSentinalFile = unlessM (alreadyexists <||> hasobjects) $ do+	s <- annexSentinalFile+	createAnnexDirectory (parentDir (sentinalFile s))+	liftIO $ writeSentinalFile s   where-	alreadyexists = isJust <$> readInodeSentinalFile+	alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile 	hasobjects = liftIO . doesDirectoryExist =<< fromRepo gitAnnexObjectDir++annexSentinalFile :: Annex SentinalFile+annexSentinalFile = do+	sentinalfile <- fromRepo gitAnnexInodeSentinal+	sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache+	return $ SentinalFile+		{ sentinalFile = sentinalfile+		, sentinalCacheFile = sentinalcachefile+		}
Annex/Direct.hs view
@@ -1,6 +1,6 @@ {- git-annex direct mode  -- - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -34,6 +34,8 @@ import Annex.ReplaceFile import Annex.Exception import Annex.VariantFile+import Git.Index+import Annex.Index  {- Uses git ls-files to find files that need to be committed, and stages  - them into the index. Returns True if some changes were staged. -}@@ -51,11 +53,12 @@ 	{- Determine what kind of modified or deleted file this is, as 	 - efficiently as we can, by getting any key that's associated 	 - with it in git, as well as its stat info. -}-	go (file, Just sha, Just mode) = do+	go (file, Just sha, Just mode) = withTSDelta $ \delta -> do 		shakey <- catKey sha mode 		mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file+		mcache <- liftIO $ maybe (pure Nothing) (toInodeCache delta) mstat 		filekey <- isAnnexLink file-		case (shakey, filekey, mstat, toInodeCache =<< mstat) of+		case (shakey, filekey, mstat, mcache) of 			(_, Just key, _, _) 				| shakey == filekey -> noop 				{- A changed symlink. -}@@ -141,21 +144,83 @@ 		)  {- In direct mode, git merge would usually refuse to do anything, since it- - sees present direct mode files as type changed files. To avoid this,- - merge is run with the work tree set to a temp directory.+ - sees present direct mode files as type changed files.+ -+ - So, to handle a merge, it's run with the work tree set to a temp+ - directory, and the merge is staged into a copy of the index.+ - Then the work tree is updated to reflect the merge, and+ - finally, the merge is committed and the real index updated.  -}-mergeDirect :: FilePath -> Git.Ref -> Git.Repo -> IO Bool-mergeDirect d branch g = do-	whenM (doesDirectoryExist d) $-		removeDirectoryRecursive d-	createDirectoryIfMissing True d-	let g' = g { location = Local { gitdir = Git.localGitDir g, worktree = Just d } }-	Git.Merge.mergeNonInteractive branch g'+mergeDirect :: Maybe Git.Ref -> Maybe Git.Ref -> Git.Branch -> Annex Bool -> Annex Bool+mergeDirect startbranch oldref branch resolvemerge = do+	-- Use the index lock file as the temp index file.+	-- This is actually what git does when updating the index,+	-- and so it will prevent other git processes from making+	-- any changes to the index while our merge is in progress.+	reali <- fromRepo indexFile+	tmpi <- fromRepo indexFileLock+	liftIO $ copyFile reali tmpi -{- Cleans up after a direct mode merge. The merge must have been committed,- - and the commit sha passed in, along with the old sha of the tree- - before the merge. Uses git diff-tree to find files that changed between- - the two shas, and applies those changes to the work tree.+	d <- fromRepo gitAnnexMergeDir+	liftIO $ do+		whenM (doesDirectoryExist d) $+			removeDirectoryRecursive d+		createDirectoryIfMissing True d++	withIndexFile tmpi $ do+		merged <- stageMerge d branch+		r <- if merged+			then return True+			else resolvemerge+		mergeDirectCleanup d (fromMaybe Git.Sha.emptyTree oldref)+		mergeDirectCommit merged startbranch branch+		liftIO $ rename tmpi reali+		return r++{- Stage a merge into the index, avoiding changing HEAD or the current+ - branch. -}+stageMerge :: FilePath -> Git.Branch -> Annex Bool+stageMerge d branch = do+	-- XXX A bug in git makes stageMerge unsafe to use if the git repo+	-- is configured with core.symlinks=false+	-- Using mergeNonInteractive is not ideal though, since it will+	-- update the current branch immediately, before the work tree+	-- has been updated, which would leave things in an inconsistent+	-- state if mergeDirectCleanup is interrupted.+	-- <http://marc.info/?l=git&m=140262402204212&w=2>+	merger <- ifM (coreSymlinks <$> Annex.getGitConfig)+		( return Git.Merge.stageMerge+		, return Git.Merge.mergeNonInteractive+		) +	inRepo $ \g -> merger branch $ +		g { location = Local { gitdir = Git.localGitDir g, worktree = Just d } }++{- Commits after a direct mode merge is complete, and after the work+ - tree has been updated by mergeDirectCleanup.+ -}+mergeDirectCommit :: Bool -> Maybe Git.Ref -> Git.Branch -> Annex ()+mergeDirectCommit allowff old branch = do+	void preCommitDirect+	d <- fromRepo Git.localGitDir+	let merge_head = d </> "MERGE_HEAD"+	let merge_msg = d </> "MERGE_MSG"+	let merge_mode = d </> "MERGE_MODE"+	ifM (pure allowff <&&> canff)+		( inRepo $ Git.Branch.update Git.Ref.headRef branch -- fast forward+		, do+			msg <- liftIO $+				catchDefaultIO ("merge " ++ fromRef branch) $+					readFile merge_msg+			void $ inRepo $ Git.Branch.commit False msg+				Git.Ref.headRef [Git.Ref.headRef, branch]+		)+	liftIO $ mapM_ nukeFile [merge_head, merge_msg, merge_mode]+  where+	canff = maybe (return False) (\o -> inRepo $ Git.Branch.fastForwardable o branch) old++{- Cleans up after a direct mode merge. The merge must have been staged+ - in the index. Uses diff-index to compare the staged changes with+ - the tree before the merge, and applies those changes to the work tree.  -  - There are really only two types of changes: An old item can be deleted,  - or a new item added. Two passes are made, first deleting and then@@ -164,9 +229,9 @@  - order, but we cannot add the directory until the file with the  - same name is removed.)  -}-mergeDirectCleanup :: FilePath -> Git.Ref -> Git.Ref -> Annex ()-mergeDirectCleanup d oldsha newsha = do-	(items, cleanup) <- inRepo $ DiffTree.diffTreeRecursive oldsha newsha+mergeDirectCleanup :: FilePath -> Git.Ref -> Annex ()+mergeDirectCleanup d oldref = do+	(items, cleanup) <- inRepo $ DiffTree.diffIndex oldref 	makeabs <- flip fromTopFilePath <$> gitRepo 	let fsitems = zip (map (makeabs . DiffTree.file) items) items 	forM_ fsitems $@@ -194,12 +259,12 @@ 	 - key, it's left alone.  	 - 	 - If the file is already present, and does not exist in the-	 - oldsha branch, preserve this local file.+	 - oldref, preserve this local file. 	 - 	 - Otherwise, create the symlink and then if possible, replace it 	 - with the content. -} 	movein item makeabs k f = unlessM (goodContent k f) $ do-		preserveUnannexed item makeabs f oldsha+		preserveUnannexed item makeabs f oldref 		l <- inRepo $ gitAnnexLink f k 		replaceFile f $ makeAnnexLink l 		toDirect k f@@ -207,13 +272,13 @@ 	{- Any new, modified, or renamed files were written to the temp 	 - directory by the merge, and are moved to the real work tree. -} 	movein_raw item makeabs f = do-		preserveUnannexed item makeabs f oldsha+		preserveUnannexed item makeabs f oldref 		liftIO $ do 			createDirectoryIfMissing True $ parentDir f 			void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f  {- If the file that's being moved in is already present in the work- - tree, but did not exist in the oldsha branch, preserve this+ - tree, but did not exist in the oldref, preserve this  - local, unannexed file (or directory), as "variant-local".  -  - It's also possible that the file that's being moved in@@ -221,7 +286,7 @@  - file (not a directory), which should be preserved.  -} preserveUnannexed :: DiffTree.DiffTreeItem -> (TopFilePath -> FilePath) -> FilePath -> Ref -> Annex ()-preserveUnannexed item makeabs absf oldsha = do+preserveUnannexed item makeabs absf oldref = do 	whenM (liftIO (collidingitem absf) <&&> unannexed absf) $ 		liftIO $ findnewname absf 0 	checkdirs (DiffTree.file item)@@ -241,7 +306,7 @@ 		<$> catchMaybeIO (getSymbolicLinkStatus f)  	unannexed f = (isNothing <$> isAnnexLink f)-		<&&> (isNothing <$> catFileDetails oldsha f)+		<&&> (isNothing <$> catFileDetails oldref f)  	findnewname :: FilePath -> Int -> IO () 	findnewname f n = do
Annex/Ssh.hs view
@@ -22,7 +22,6 @@  import qualified Data.Map as M import Data.Hash.MD5-import System.Process (cwd) import System.Exit  import Common.Annex
Assistant/Install.hs view
@@ -122,15 +122,15 @@ cleanEnvironment :: IO (Maybe [(String, String)]) cleanEnvironment = clean <$> getEnvironment   where-	clean env+	clean environ 		| null vars = Nothing-		| otherwise = Just $ catMaybes $ map (restoreorig env) env+		| otherwise = Just $ catMaybes $ map (restoreorig environ) environ 		| otherwise = Nothing 	  where 		vars = words $ fromMaybe "" $-			lookup "GIT_ANNEX_STANDLONE_ENV" env-		restoreorig oldenv p@(k, _v)-			| k `elem` vars = case lookup ("ORIG_" ++ k) oldenv of+			lookup "GIT_ANNEX_STANDLONE_ENV" environ+		restoreorig oldenviron p@(k, _v)+			| k `elem` vars = case lookup ("ORIG_" ++ k) oldenviron of 				(Just v') 					| not (null v') -> Just (k, v') 				_ -> Nothing
Assistant/Restart.hs view
@@ -24,7 +24,6 @@ import qualified Git  import Control.Concurrent-import System.Process (cwd) #ifndef mingw32_HOST_OS import System.Posix (signalProcess, sigTERM) #else
Assistant/Threads/Committer.hs view
@@ -313,10 +313,11 @@ 	adddirect toadd = do 		ct <- liftAnnex compareInodeCachesWith 		m <- liftAnnex $ removedKeysMap ct cs+		delta <- liftAnnex getTSDelta 		if M.null m 			then forM toadd add 			else forM toadd $ \c -> do-				mcache <- liftIO $ genInodeCache $ changeFile c+				mcache <- liftIO $ genInodeCache (changeFile c) delta 				case mcache of 					Nothing -> add c 					Just cache ->
Assistant/Threads/RemoteControl.hs view
@@ -22,7 +22,6 @@  import Control.Concurrent import Control.Concurrent.Async-import System.Process (std_in, std_out) import Network.URI import qualified Data.Map as M import qualified Data.Set as S
Assistant/Threads/WebApp.hs view
@@ -47,6 +47,8 @@ import Network.Socket (SockAddr, HostName) import Data.Text (pack, unpack) import qualified Network.Wai.Handler.WarpTLS as TLS+import Network.Wai.Middleware.RequestLogger+import System.Log.Logger  mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes") @@ -83,7 +85,7 @@ 	setUrlRenderer urlrenderer $ yesodRender webapp (pack "") 	app <- toWaiAppPlain webapp 	app' <- ifM debugEnabled-		( return $ httpDebugLogger app+		( return $ logStdout app 		, return app 		) 	runWebApp tlssettings listenhost' app' $ \addr -> if noannex@@ -135,3 +137,9 @@ #else 	return Nothing #endif++{- Checks if debugging is actually enabled. -}+debugEnabled :: IO Bool+debugEnabled = do+	l <- getRootLogger+	return $ getLevel l <= Just DEBUG
Assistant/TransferrerPool.hs view
@@ -15,7 +15,6 @@ import qualified Command.TransferKeys as T  import Control.Concurrent.STM hiding (check)-import System.Process (create_group, std_in, std_out) import Control.Exception (throw) import Control.Concurrent
Assistant/WebApp/Configurators/Local.hs view
@@ -116,11 +116,11 @@ defaultRepositoryPath firstrun = do #ifndef mingw32_HOST_OS 	home <- myHomeDir-	cwd <- liftIO getCurrentDirectory-	if home == cwd && firstrun+	currdir <- liftIO getCurrentDirectory+	if home == currdir && firstrun 		then inhome-		else ifM (legit cwd <&&> canWrite cwd)-			( return cwd+		else ifM (legit currdir <&&> canWrite currdir)+			( return currdir 			, inhome 			) #else
Assistant/WebApp/Configurators/Ssh.hs view
@@ -381,7 +381,7 @@ 	login = getLogin sshinput 	geti f = maybe "" T.unpack (f sshinput) -	go extraopts env = processTranscript' "ssh" (extraopts ++ opts) env $+	go extraopts environ = processTranscript' "ssh" (extraopts ++ opts) environ $ 		Just (fromMaybe "" input)  	setupAskPass = do@@ -392,8 +392,8 @@ 			Just pass -> withTmpFile "ssh" $ \passfile h -> do 				hClose h 				writeFileProtected passfile pass-				env <- getEnvironment-				let env' = addEntries+				environ <- getEnvironment+				let environ' = addEntries 					[ ("SSH_ASKPASS", program) 					, (sshAskPassEnv, passfile) 					-- ssh does not use SSH_ASKPASS@@ -401,8 +401,8 @@ 					-- there is no controlling 					-- terminal. 					, ("DISPLAY", ":0")-					] env-				go [passwordprompts 1] (Just env')+					] environ+				go [passwordprompts 1] (Just environ') 	 	passwordprompts :: Int -> String 	passwordprompts = sshOpt "NumberOfPasswordPrompts" . show
Assistant/XMPP/Git.hs view
@@ -38,7 +38,6 @@ import Network.Protocol.XMPP import qualified Data.Text as T import System.Posix.Types-import System.Process (std_in, std_out, std_err) import Control.Concurrent import System.Timeout import qualified Data.ByteString as B@@ -112,15 +111,15 @@ 	tmpdir <- gettmpdir 	installwrapper tmpdir -	env <- liftIO getEnvironment+	environ <- liftIO getEnvironment 	path <- liftIO getSearchPath-	let myenv = addEntries+	let myenviron = addEntries 		[ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path) 		, (relayIn, show inf) 		, (relayOut, show outf) 		, (relayControl, show controlf) 		]-		env+		environ  	inh <- liftIO $ fdToHandle readpush 	outh <- liftIO $ fdToHandle writepush@@ -132,7 +131,7 @@ 	{- This can take a long time to run, so avoid running it in the 	 - Annex monad. Also, override environment. -} 	g <- liftAnnex gitRepo-	r <- liftIO $ gitpush $ g { gitEnv = Just myenv }+	r <- liftIO $ gitpush $ g { gitEnv = Just myenviron }  	liftIO $ do 		mapM_ killThread [t1, t2]
Build/EvilSplicer.hs view
@@ -310,6 +310,7 @@ 	. yesod_url_render_hack 	. text_builder_hack 	. nested_instances +	. boxed_fileembed 	. collapse_multiline_strings 	. remove_package_version 	. emptylambda@@ -552,6 +553,42 @@ 	 - that above, so have to fix up after it here.  	 - The ; is added by case_layout. -} 	flip_colon = replace "; : _ " "; _ : "++{- Embedded files use unsafe packing, which is problimatic+ - for several reasons, including that GHC sometimes omits trailing+ - newlines in the file content, which leads to the wrong byte+ - count. Also, GHC sometimes outputs unicode characters, which + - are not legal in unboxed strings. + -+ - Avoid problems by converting:+ - GHC.IO.unsafePerformIO+ -   (Data.ByteString.Unsafe.unsafePackAddressLen+ -      lllll+ -      "blabblah"#)),+ - to:+ - Data.ByteString.Char8.pack "blabblah"),+ -+ - Note that the string is often multiline. This only works if+ - collapse_multiline_strings has run first.+ -}+boxed_fileembed :: String -> String+boxed_fileembed = parsecAndReplace $ do+	i <- indent+	void $ string "GHC.IO.unsafePerformIO"+	void newline+	void indent+	void $ string "(Data.ByteString.Unsafe.unsafePackAddressLen"+	void newline+	void indent+	void number+	void newline+	void indent+	void $ char '"'+	s <- restOfLine+	let s' = take (length s - 5) s+	if "\"#))," `isSuffixOf` s+		then return (i ++ "Data.ByteString.Char8.pack \"" ++ s' ++ "\"),\n")+		else fail "not an unboxed string"  {- This works around a problem in the expanded template haskell for Yesod  - type-safe url rendering.
CHANGELOG view
@@ -1,3 +1,22 @@+git-annex (5.20140613) unstable; urgency=medium++  * Ignore setsid failures.+  * Avoid leaving behind .tmp files when failing in some cases, including+    importing files to a disk that is full.+  * Avoid bad commits after interrupted direct mode sync (or merge).+  * Fix build with wai 0.3.0.+  * Deal with FAT's low resolution timestamps, which in combination with+    Linux's caching of higher res timestamps while a FAT is mounted, caused+    direct mode repositories on FAT to seem to have modified files after+    they were unmounted and remounted.+  * Windows: Fix opening webapp when repository is in a directory with+    spaces in the path.+  * Detect when Windows has lost its mind in a timezone change, and+    automatically apply a delta to the timestamps it returns, to get back to+    sane values.++ -- Joey Hess <joeyh@debian.org>  Fri, 13 Jun 2014 09:58:07 -0400+ git-annex (5.20140606) unstable; urgency=medium    * webapp: When adding a new local repository, fix bug that caused its
Command/Add.hs view
@@ -102,7 +102,7 @@  lockDown' :: FilePath -> Annex (Either IOException KeySource) lockDown' file = ifM crippledFileSystem-	( liftIO $ tryIO nohardlink+	( withTSDelta $ liftIO . tryIO . nohardlink 	, tryAnnexIO $ do 		tmp <- fromRepo gitAnnexTmpMiscDir 		createAnnexDirectory tmp@@ -122,22 +122,22 @@   	go tmp = do 		unlessM isDirect $ 			freezeContent file-		liftIO $ do+		withTSDelta $ \delta -> liftIO $ do 			(tmpfile, h) <- openTempFile tmp $ 				relatedTemplate $ takeFileName file 			hClose h 			nukeFile tmpfile-			withhardlink tmpfile `catchIO` const nohardlink-  	nohardlink = do-		cache <- genInodeCache file+			withhardlink delta tmpfile `catchIO` const (nohardlink delta)+  	nohardlink delta = do+		cache <- genInodeCache file delta 		return KeySource 			{ keyFilename = file 			, contentLocation = file 			, inodeCache = cache 			}-	withhardlink tmpfile = do+	withhardlink delta tmpfile = do 		createLink file tmpfile-		cache <- genInodeCache tmpfile+		cache <- genInodeCache tmpfile delta 		return KeySource 			{ keyFilename = file 			, contentLocation = tmpfile@@ -151,11 +151,11 @@  -} ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache) ingest Nothing = return (Nothing, Nothing)-ingest (Just source) = do+ingest (Just source) = withTSDelta $ \delta -> do 	backend <- chooseBackend $ keyFilename source 	k <- genKey source backend 	ms <- liftIO $ catchMaybeIO $ getFileStatus $ contentLocation source-	let mcache = toInodeCache =<< ms+	mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta) ms 	case (mcache, inodeCache source) of 		(_, Nothing) -> go k mcache ms 		(Just newc, Just c) | compareStrong c newc -> go k mcache ms
Command/Status.hs view
@@ -28,9 +28,9 @@ start [] = do 	-- Like git status, when run without a directory, behave as if 	-- given the path to the top of the repository.-	cwd <- liftIO getCurrentDirectory+	currdir <- liftIO getCurrentDirectory 	top <- fromRepo Git.repoPath-	start' [relPathDirToFile cwd top]+	start' [relPathDirToFile currdir top] start locs = start' locs 	 start' :: [FilePath] -> CommandStart
Command/Uninit.hs view
@@ -27,8 +27,8 @@ 	when (b == Annex.Branch.name) $ error $ 		"cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out" 	top <- fromRepo Git.repoPath-	cwd <- liftIO getCurrentDirectory-	whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $+	currdir <- liftIO getCurrentDirectory+	whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ 		error "can only run uninit from the top of the git repository"   where 	current_branch = Git.Ref . Prelude.head . lines <$> revhead
Command/WebApp.hs view
@@ -34,7 +34,6 @@  import Control.Concurrent import Control.Concurrent.STM-import System.Process (env, std_out, std_err) import Network.Socket (HostName) import System.Environment (getArgs) @@ -215,7 +214,16 @@   where 	p = case mcmd of 		Just cmd -> proc cmd [htmlshim]-		Nothing -> browserProc url+		Nothing -> +#ifndef mingw32_HOST_OS+			browserProc url+#else+			{- Windows hack to avoid using the full path,+			 - which might contain spaces that cause problems+			 - for browserProc. -}+			(browserProc (takeFileName htmlshim))+				{ cwd = Just (takeDirectory htmlshim) } +#endif #ifdef __ANDROID__ 	{- Android does not support file:// urls, but neither is 	 - the security of the url in the process table important
Git/Branch.hs view
@@ -52,9 +52,24 @@ 	diffs = pipeReadStrict 		[ Param "log" 		, Param (fromRef origbranch ++ ".." ++ fromRef newbranch)-		, Params "--oneline -n1"+		, Param "-n1"+		, Param "--pretty=%H" 		] repo +{- Check if it's possible to fast-forward from the old+ - ref to the new ref.+ -+ - This requires there to be a path from the old to the new. -}+fastForwardable :: Ref -> Ref -> Repo -> IO Bool+fastForwardable old new repo = not . null <$>+	pipeReadStrict+		[ Param "log"+		, Param $ fromRef old ++ ".." ++ fromRef new+		, Param "-n1"+		, Param "--pretty=%H"+		, Param "--ancestry-path"+		] repo+ {- Given a set of refs that are all known to have commits not  - on the branch, tries to update the branch by a fast-forward.  -@@ -74,7 +89,7 @@   where 	no_ff = return False 	do_ff to = do-		run [Param "update-ref", Param $ fromRef branch, Param $ fromRef to] repo+		update branch to repo 		return True 	findbest c [] = return $ Just c 	findbest c (r:rs)
Git/CheckAttr.hs view
@@ -23,9 +23,9 @@  - values and returns a handle.  -} checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle checkAttrStart attrs repo = do-	cwd <- getCurrentDirectory+	currdir <- getCurrentDirectory 	h <- CoProcess.rawMode =<< gitCoProcessStart True params repo-	return (h, attrs, cwd)+	return (h, attrs, currdir)   where 	params = 		[ Param "check-attr" @@ -38,7 +38,7 @@  {- Gets an attribute of a file. -} checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String-checkAttr (h, attrs, cwd) want file = do+checkAttr (h, attrs, currdir) want file = do 	pairs <- CoProcess.query h send (receive "") 	let vals = map snd $ filter (\(attr, _) -> attr == want) pairs 	case vals of@@ -83,8 +83,8 @@ 	 - so use relative filenames. -} 	oldgit = Git.BuildVersion.older "1.7.7" 	file'-		| oldgit = absPathFrom cwd file-		| otherwise = relPathDirToFile cwd $ absPathFrom cwd file+		| oldgit = absPathFrom currdir file+		| otherwise = relPathDirToFile currdir $ absPathFrom currdir file 	oldattrvalue attr l = end bits !! 0 	  where 		bits = split sep l
Git/Command.hs view
@@ -9,8 +9,6 @@  module Git.Command where -import System.Process (std_out, env)- import Common import Git import Git.Types
Git/Config.hs view
@@ -9,7 +9,6 @@  import qualified Data.Map as M import Data.Char-import System.Process (cwd, env) import Control.Exception.Extensible  import Common
Git/CurrentRepo.hs view
@@ -37,8 +37,8 @@ 	case wt of 		Nothing -> return r 		Just d -> do-			cwd <- getCurrentDirectory-			unless (d `dirContains` cwd) $+			curr <- getCurrentDirectory+			unless (d `dirContains` curr) $ 				setCurrentDirectory d 			return $ addworktree wt r   where@@ -57,8 +57,8 @@ 	configure Nothing (Just r) = Git.Config.read r 	configure (Just d) _ = do 		absd <- absPath d-		cwd <- getCurrentDirectory-		r <- newFrom $ Local { gitdir = absd, worktree = Just cwd }+		curr <- getCurrentDirectory+		r <- newFrom $ Local { gitdir = absd, worktree = Just curr } 		Git.Config.read r 	configure Nothing Nothing = error "Not in a git repository."
Git/DiffTree.hs view
@@ -49,7 +49,7 @@ diffIndex ref = diffIndex' ref [Param "--cached"]  {- Diffs between a tree and the working tree. Does nothing if there is not- - yet a commit in the repository, of if the repository is bare. -}+ - yet a commit in the repository, or if the repository is bare. -} diffWorkTree :: Ref -> Repo -> IO ([DiffTreeItem], IO Bool) diffWorkTree ref repo = 	ifM (Git.Ref.headExists repo)
Git/Fsck.hs view
@@ -23,7 +23,6 @@ import qualified Git.Version  import qualified Data.Set as S-import System.Process (std_out, std_err) import Control.Concurrent.Async  type MissingObjects = S.Set Sha
Git/Index.hs view
@@ -30,3 +30,7 @@  indexFile :: Repo -> FilePath indexFile r = localGitDir r </> "index"++{- Git locks the index by creating this file. -}+indexFileLock :: Repo -> FilePath+indexFileLock r = indexFile r ++ ".lock"
Git/LsFiles.hs view
@@ -132,8 +132,8 @@ 	-- git diff returns filenames relative to the top of the git repo; 	-- convert to filenames relative to the cwd, like git ls-files. 	let top = repoPath repo-	cwd <- getCurrentDirectory-	return (map (\f -> relPathDirToFile cwd $ top </> f) fs, cleanup)+	currdir <- getCurrentDirectory+	return (map (\f -> relPathDirToFile currdir $ top </> f) fs, cleanup)   where 	prefix = [Params "diff --name-only --diff-filter=T -z"] 	suffix = Param "--" : (if null l then [File "."] else map File l)
Git/Merge.hs view
@@ -1,6 +1,6 @@ {- git merging  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012, 2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -19,3 +19,15 @@ 	| otherwise = merge [Param "--no-edit", Param $ fromRef branch]   where 	merge ps = runBool $ Param "merge" : ps++{- Stage the merge into the index, but do not commit it.-}+stageMerge :: Ref -> Repo -> IO Bool+stageMerge branch = runBool+	[ Param "merge"+	, Param "--quiet"+	, Param "--no-commit"+	-- Without this, a fast-forward merge is done, since it involves no+	-- commit.+	, Param "--no-ff"+	, Param $ fromRef branch+	]
Git/Queue.hs view
@@ -24,9 +24,6 @@ import qualified Git.UpdateIndex  import qualified Data.Map as M-#ifndef mingw32_HOST_OS-import System.Process-#endif  {- Queable actions that can be performed in a git repository.  -}@@ -159,9 +156,9 @@ 	-- Using xargs on Windows is problimatic, so just run the command 	-- once per file (not as efficient.) 	if null (getFiles action)-		then void $ boolSystem "git" gitparams+		then void $ boolSystemEnv "git" gitparams (gitEnv repo) 		else forM_ (getFiles action) $ \f ->-			void $ boolSystem "git" (gitparams ++ [f])+			void $ boolSystemEnv "git" (gitparams ++ [f]) (gitEnv repo) #endif   where 	gitparams = gitCommandLine
Git/UpdateIndex.hs view
@@ -30,7 +30,6 @@ import Git.Sha  import Control.Exception (bracket)-import System.Process (std_in)  {- Streamers are passed a callback and should feed it lines in the form  - read by update-index, and generated by ls-tree. -}
Locations.hs view
@@ -142,8 +142,8 @@ {- Calculates a symlink to link a file to an annexed object. -} gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath gitAnnexLink file key r = do-	cwd <- getCurrentDirectory-	let absfile = fromMaybe whoops $ absNormPathUnix cwd file+	currdir <- getCurrentDirectory+	let absfile = fromMaybe whoops $ absNormPathUnix currdir file 	loc <- gitAnnexLocation' key r False 	return $ relPathDirToFile (parentDir absfile) loc   where
Remote/External.hs view
@@ -28,7 +28,6 @@ import Creds  import Control.Concurrent.STM-import System.Process (std_in, std_out, std_err) import System.Log.Logger (debugM) import qualified Data.Map as M import qualified Data.ByteString.Lazy as L
Remote/Git.hs view
@@ -55,7 +55,6 @@  import Control.Concurrent import Control.Concurrent.MSampleVar-import System.Process (std_in, std_err) import qualified Data.Map as M import Control.Exception.Extensible @@ -467,12 +466,12 @@ 	| otherwise = return $ do 		program <- readProgramFile 		r' <- Git.Config.read r-		env <- getEnvironment-		let env' = addEntries +		environ <- getEnvironment+		let environ' = addEntries  			[ ("GIT_WORK_TREE", Git.repoPath r') 			, ("GIT_DIR", Git.localGitDir r')-			] env-		batchCommandEnv program (Param "fsck" : params) $ Just env'+			] environ+		batchCommandEnv program (Param "fsck" : params) $ Just environ'  {- The passed repair action is run in the Annex monad of the remote. -} repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool)
Remote/Glacier.hs view
@@ -27,8 +27,6 @@ import Annex.UUID import Utility.Env -import System.Process- type Vault = String type Archive = FilePath
Remote/Hook.hs view
@@ -79,15 +79,15 @@ hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)   where 	mergeenv l = addEntries l <$> getEnvironment-	env s v = ("ANNEX_" ++ s, v)+	envvar s v = ("ANNEX_" ++ s, v) 	keyenv = catMaybes-		[ Just $ env "KEY" (key2file k)-		, Just $ env "ACTION" action-		, env "HASH_1" <$> headMaybe hashbits-		, env "HASH_2" <$> headMaybe (drop 1 hashbits)+		[ Just $ envvar "KEY" (key2file k)+		, Just $ envvar "ACTION" action+		, envvar "HASH_1" <$> headMaybe hashbits+		, envvar "HASH_2" <$> headMaybe (drop 1 hashbits) 		] 	fileenv Nothing = []-	fileenv (Just file) =  [env "FILE" file]+	fileenv (Just file) =  [envvar "FILE" file] 	hashbits = map takeDirectory $ splitPath $ hashDirMixed k  lookupHook :: HookName -> Action -> Annex (Maybe String)@@ -155,5 +155,5 @@ 	findkey s = key2file k `elem` lines s 	check Nothing = error $ action ++ " hook misconfigured" 	check (Just hook) = do-		env <- hookEnv action k Nothing-		findkey <$> readProcessEnv "sh" ["-c", hook] env+		environ <- hookEnv action k Nothing+		findkey <$> readProcessEnv "sh" ["-c", hook] environ
Remote/S3.hs view
@@ -293,7 +293,7 @@ 		either s3Error return =<< liftIO (sendObject conn object)  	file = filePrefix c ++ "annex-uuid"-	uuidb = L.fromStrict $ T.encodeUtf8 $ T.pack $ fromUUID u+	uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u] 	bucket = fromJust $ getBucket c  	mkobject = S3Object bucket file "" (getXheaders c)
RemoteDaemon/Transport/Ssh.hs view
@@ -20,7 +20,6 @@  import Control.Concurrent.Chan import Control.Concurrent.Async-import System.Process (std_in, std_out, std_err)  transport :: Transport transport r url h@(TransportHandle g s) ichan ochan = do
Test.hs view
@@ -176,15 +176,15 @@ {- These tests set up the test environment, but also test some basic parts  - of git-annex. They are always run before the unitTests. -} initTests :: TestEnv -> TestTree-initTests env = testGroup "Init Tests"+initTests testenv = testGroup "Init Tests" 	[ check "init" test_init 	, check "add" test_add 	]   where-	check desc t = testCase desc (t env)+	check desc t = testCase desc (t testenv)  unitTests :: String -> IO TestEnv -> TestTree-unitTests note getenv = testGroup ("Unit Tests " ++ note)+unitTests note gettestenv = testGroup ("Unit Tests " ++ note) 	[ check "add sha1dup" test_add_sha1dup 	, check "add extras" test_add_extras 	, check "reinject" test_reinject@@ -236,25 +236,25 @@ 	, check "add subdirs" test_add_subdirs 	]   where-	check desc t = testCase desc (getenv >>= t)+	check desc t = testCase desc (gettestenv >>= t)  -- this test case create the main repo test_init :: TestEnv -> Assertion-test_init env = innewrepo env $ do-	git_annex env "init" [reponame] @? "init failed"-	handleforcedirect env+test_init testenv = innewrepo testenv $ do+	git_annex testenv "init" [reponame] @? "init failed"+	handleforcedirect testenv   where 	reponame = "test repo"  -- this test case runs in the main repo, to set up a basic -- annexed file that later tests will use test_add :: TestEnv -> Assertion-test_add env = inmainrepo env $ do+test_add testenv = inmainrepo testenv $ do 	writeFile annexedfile $ content annexedfile-	git_annex env "add" [annexedfile] @? "add failed"+	git_annex testenv "add" [annexedfile] @? "add failed" 	annexed_present annexedfile 	writeFile sha1annexedfile $ content sha1annexedfile-	git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed"+	git_annex testenv "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" 	annexed_present sha1annexedfile 	checkbackend sha1annexedfile backendSHA1 	ifM (annexeval Config.isDirect)@@ -262,223 +262,223 @@ 			writeFile ingitfile $ content ingitfile 			not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode" 			nukeFile ingitfile-			git_annex env "sync" [] @? "sync failed"+			git_annex testenv "sync" [] @? "sync failed" 		, do 			writeFile ingitfile $ content ingitfile 			boolSystem "git" [Param "add", File ingitfile] @? "git add failed" 			boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed"-			git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"+			git_annex testenv "add" [ingitfile] @? "add ingitfile should be no-op" 			unannexed ingitfile 		)  test_add_sha1dup :: TestEnv -> Assertion-test_add_sha1dup env = intmpclonerepo env $ do+test_add_sha1dup testenv = intmpclonerepo testenv $ do 	writeFile sha1annexedfiledup $ content sha1annexedfiledup-	git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed"+	git_annex testenv "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" 	annexed_present sha1annexedfiledup 	annexed_present sha1annexedfile  test_add_extras :: TestEnv -> Assertion-test_add_extras env = intmpclonerepo env $ do+test_add_extras testenv = intmpclonerepo testenv $ do 	writeFile wormannexedfile $ content wormannexedfile-	git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"+	git_annex testenv "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" 	annexed_present wormannexedfile 	checkbackend wormannexedfile backendWORM  test_reinject :: TestEnv -> Assertion-test_reinject env = intmpclonerepoInDirect env $ do-	git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed"+test_reinject testenv = intmpclonerepoInDirect testenv $ do+	git_annex testenv "drop" ["--force", sha1annexedfile] @? "drop failed" 	writeFile tmp $ content sha1annexedfile 	r <- annexeval $ Types.Backend.getKey backendSHA1 		Types.KeySource.KeySource { Types.KeySource.keyFilename = tmp, Types.KeySource.contentLocation = tmp, Types.KeySource.inodeCache = Nothing } 	let key = Types.Key.key2file $ fromJust r-	git_annex env "reinject" [tmp, sha1annexedfile] @? "reinject failed"-	git_annex env "fromkey" [key, sha1annexedfiledup] @? "fromkey failed for dup"+	git_annex testenv "reinject" [tmp, sha1annexedfile] @? "reinject failed"+	git_annex testenv "fromkey" [key, sha1annexedfiledup] @? "fromkey failed for dup" 	annexed_present sha1annexedfiledup   where 	tmp = "tmpfile"  test_unannex_nocopy :: TestEnv -> Assertion-test_unannex_nocopy env = intmpclonerepo env $ do+test_unannex_nocopy testenv = intmpclonerepo testenv $ do 	annexed_notpresent annexedfile-	git_annex env "unannex" [annexedfile] @? "unannex failed with no copy"+	git_annex testenv "unannex" [annexedfile] @? "unannex failed with no copy" 	annexed_notpresent annexedfile  test_unannex_withcopy :: TestEnv -> Assertion-test_unannex_withcopy env = intmpclonerepo env $ do-	git_annex env "get" [annexedfile] @? "get failed"+test_unannex_withcopy testenv = intmpclonerepo testenv $ do+	git_annex testenv "get" [annexedfile] @? "get failed" 	annexed_present annexedfile-	git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"+	git_annex testenv "unannex" [annexedfile, sha1annexedfile] @? "unannex failed" 	unannexed annexedfile-	git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file"+	git_annex testenv "unannex" [annexedfile] @? "unannex failed on non-annexed file" 	unannexed annexedfile 	unlessM (annexeval Config.isDirect) $ do-		git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op"+		git_annex testenv "unannex" [ingitfile] @? "unannex ingitfile should be no-op" 		unannexed ingitfile  test_drop_noremote :: TestEnv -> Assertion-test_drop_noremote env = intmpclonerepo env $ do-	git_annex env "get" [annexedfile] @? "get failed"+test_drop_noremote testenv = intmpclonerepo testenv $ do+	git_annex testenv "get" [annexedfile] @? "get failed" 	boolSystem "git" [Params "remote rm origin"] 		@? "git remote rm origin failed"-	not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"+	not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file" 	annexed_present annexedfile-	git_annex env "drop" ["--force", annexedfile] @? "drop --force failed"+	git_annex testenv "drop" ["--force", annexedfile] @? "drop --force failed" 	annexed_notpresent annexedfile-	git_annex env "drop" [annexedfile] @? "drop of dropped file failed"+	git_annex testenv "drop" [annexedfile] @? "drop of dropped file failed" 	unlessM (annexeval Config.isDirect) $ do-		git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op"+		git_annex testenv "drop" [ingitfile] @? "drop ingitfile should be no-op" 		unannexed ingitfile  test_drop_withremote :: TestEnv -> Assertion-test_drop_withremote env = intmpclonerepo env $ do-	git_annex env "get" [annexedfile] @? "get failed"+test_drop_withremote testenv = intmpclonerepo testenv $ do+	git_annex testenv "get" [annexedfile] @? "get failed" 	annexed_present annexedfile-	git_annex env "numcopies" ["2"] @? "numcopies config failed"-	not <$> git_annex env "drop" [annexedfile] @? "drop succeeded although numcopies is not satisfied"-	git_annex env "numcopies" ["1"] @? "numcopies config failed"-	git_annex env "drop" [annexedfile] @? "drop failed though origin has copy"+	git_annex testenv "numcopies" ["2"] @? "numcopies config failed"+	not <$> git_annex testenv "drop" [annexedfile] @? "drop succeeded although numcopies is not satisfied"+	git_annex testenv "numcopies" ["1"] @? "numcopies config failed"+	git_annex testenv "drop" [annexedfile] @? "drop failed though origin has copy" 	annexed_notpresent annexedfile-	inmainrepo env $ annexed_present annexedfile+	inmainrepo testenv $ annexed_present annexedfile  test_drop_untrustedremote :: TestEnv -> Assertion-test_drop_untrustedremote env = intmpclonerepo env $ do-	git_annex env "untrust" ["origin"] @? "untrust of origin failed"-	git_annex env "get" [annexedfile] @? "get failed"+test_drop_untrustedremote testenv = intmpclonerepo testenv $ do+	git_annex testenv "untrust" ["origin"] @? "untrust of origin failed"+	git_annex testenv "get" [annexedfile] @? "get failed" 	annexed_present annexedfile-	not <$> git_annex env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file"+	not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file" 	annexed_present annexedfile-	inmainrepo env $ annexed_present annexedfile+	inmainrepo testenv $ annexed_present annexedfile  test_get :: TestEnv -> Assertion-test_get env = intmpclonerepo env $ do-	inmainrepo env $ annexed_present annexedfile+test_get testenv = intmpclonerepo testenv $ do+	inmainrepo testenv $ annexed_present annexedfile 	annexed_notpresent annexedfile-	git_annex env "get" [annexedfile] @? "get of file failed"-	inmainrepo env $ annexed_present annexedfile+	git_annex testenv "get" [annexedfile] @? "get of file failed"+	inmainrepo testenv $ annexed_present annexedfile 	annexed_present annexedfile-	git_annex env "get" [annexedfile] @? "get of file already here failed"-	inmainrepo env $ annexed_present annexedfile+	git_annex testenv "get" [annexedfile] @? "get of file already here failed"+	inmainrepo testenv $ annexed_present annexedfile 	annexed_present annexedfile 	unlessM (annexeval Config.isDirect) $ do-		inmainrepo env $ unannexed ingitfile+		inmainrepo testenv $ unannexed ingitfile 		unannexed ingitfile-		git_annex env "get" [ingitfile] @? "get ingitfile should be no-op"-		inmainrepo env $ unannexed ingitfile+		git_annex testenv "get" [ingitfile] @? "get ingitfile should be no-op"+		inmainrepo testenv $ unannexed ingitfile 		unannexed ingitfile  test_move :: TestEnv -> Assertion-test_move env = intmpclonerepo env $ do+test_move testenv = intmpclonerepo testenv $ do 	annexed_notpresent annexedfile-	inmainrepo env $ annexed_present annexedfile-	git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file failed"+	inmainrepo testenv $ annexed_present annexedfile+	git_annex testenv "move" ["--from", "origin", annexedfile] @? "move --from of file failed" 	annexed_present annexedfile-	inmainrepo env $ annexed_notpresent annexedfile-	git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed"+	inmainrepo testenv $ annexed_notpresent annexedfile+	git_annex testenv "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed" 	annexed_present annexedfile-	inmainrepo env $ annexed_notpresent annexedfile-	git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file failed"-	inmainrepo env $ annexed_present annexedfile+	inmainrepo testenv $ annexed_notpresent annexedfile+	git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file failed"+	inmainrepo testenv $ annexed_present annexedfile 	annexed_notpresent annexedfile-	git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"-	inmainrepo env $ annexed_present annexedfile+	git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"+	inmainrepo testenv $ annexed_present annexedfile 	annexed_notpresent annexedfile 	unlessM (annexeval Config.isDirect) $ do 		unannexed ingitfile-		inmainrepo env $ unannexed ingitfile-		git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"+		inmainrepo testenv $ unannexed ingitfile+		git_annex testenv "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" 		unannexed ingitfile-		inmainrepo env $ unannexed ingitfile-		git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"+		inmainrepo testenv $ unannexed ingitfile+		git_annex testenv "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" 		unannexed ingitfile-		inmainrepo env $ unannexed ingitfile+		inmainrepo testenv $ unannexed ingitfile  test_copy :: TestEnv -> Assertion-test_copy env = intmpclonerepo env $ do+test_copy testenv = intmpclonerepo testenv $ do 	annexed_notpresent annexedfile-	inmainrepo env $ annexed_present annexedfile-	git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed"+	inmainrepo testenv $ annexed_present annexedfile+	git_annex testenv "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed" 	annexed_present annexedfile-	inmainrepo env $ annexed_present annexedfile-	git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed"+	inmainrepo testenv $ annexed_present annexedfile+	git_annex testenv "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed" 	annexed_present annexedfile-	inmainrepo env $ annexed_present annexedfile-	git_annex env "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed"+	inmainrepo testenv $ annexed_present annexedfile+	git_annex testenv "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed" 	annexed_present annexedfile-	inmainrepo env $ annexed_present annexedfile-	git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"+	inmainrepo testenv $ annexed_present annexedfile+	git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" 	annexed_notpresent annexedfile-	inmainrepo env $ annexed_present annexedfile+	inmainrepo testenv $ annexed_present annexedfile 	unlessM (annexeval Config.isDirect) $ do 		unannexed ingitfile-		inmainrepo env $ unannexed ingitfile-		git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"+		inmainrepo testenv $ unannexed ingitfile+		git_annex testenv "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" 		unannexed ingitfile-		inmainrepo env $ unannexed ingitfile-		git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"+		inmainrepo testenv $ unannexed ingitfile+		git_annex testenv "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" 		checkregularfile ingitfile 		checkcontent ingitfile  test_preferred_content :: TestEnv -> Assertion-test_preferred_content env = intmpclonerepo env $ do+test_preferred_content testenv = intmpclonerepo testenv $ do 	annexed_notpresent annexedfile 	-- get --auto only looks at numcopies when preferred content is not 	-- set, and with 1 copy existing, does not get the file.-	git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content"+	git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content" 	annexed_notpresent annexedfile -	git_annex env "wanted" [".", "standard"] @? "set expression to standard failed"-	git_annex env "group" [".", "client"] @? "set group to standard failed"-	git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed for client"+	git_annex testenv "wanted" [".", "standard"] @? "set expression to standard failed"+	git_annex testenv "group" [".", "client"] @? "set group to standard failed"+	git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed for client" 	annexed_present annexedfile-	git_annex env "ungroup" [".", "client"] @? "ungroup failed"+	git_annex testenv "ungroup" [".", "client"] @? "ungroup failed" -	git_annex env "wanted" [".", "standard"] @? "set expression to standard failed"-	git_annex env "group" [".", "manual"] @? "set group to manual failed"+	git_annex testenv "wanted" [".", "standard"] @? "set expression to standard failed"+	git_annex testenv "group" [".", "manual"] @? "set group to manual failed" 	-- drop --auto with manual leaves the file where it is-	git_annex env "drop" ["--auto", annexedfile] @? "drop --auto of file failed with manual preferred content"+	git_annex testenv "drop" ["--auto", annexedfile] @? "drop --auto of file failed with manual preferred content" 	annexed_present annexedfile-	git_annex env "drop" [annexedfile] @? "drop of file failed"+	git_annex testenv "drop" [annexedfile] @? "drop of file failed" 	annexed_notpresent annexedfile 	-- get --auto with manual does not get the file-	git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with manual preferred content"+	git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with manual preferred content" 	annexed_notpresent annexedfile-	git_annex env "ungroup" [".", "client"] @? "ungroup failed"+	git_annex testenv "ungroup" [".", "client"] @? "ungroup failed" 	-	git_annex env "wanted" [".", "exclude=*"] @? "set expression to exclude=* failed"-	git_annex env "get" [annexedfile] @? "get of file failed"+	git_annex testenv "wanted" [".", "exclude=*"] @? "set expression to exclude=* failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex env "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*"+	git_annex testenv "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*" 	annexed_notpresent annexedfile-	git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*"+	git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*" 	annexed_notpresent annexedfile  test_lock :: TestEnv -> Assertion-test_lock env = intmpclonerepoInDirect env $ do+test_lock testenv = intmpclonerepoInDirect testenv $ do 	-- regression test: unlock of not present file should skip it 	annexed_notpresent annexedfile-	not <$> git_annex env "unlock" [annexedfile] @? "unlock failed to fail with not present file"+	not <$> git_annex testenv "unlock" [annexedfile] @? "unlock failed to fail with not present file" 	annexed_notpresent annexedfile -	git_annex env "get" [annexedfile] @? "get of file failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex env "unlock" [annexedfile] @? "unlock failed"		+	git_annex testenv "unlock" [annexedfile] @? "unlock failed"		 	unannexed annexedfile 	-- write different content, to verify that lock 	-- throws it away 	changecontent annexedfile 	writeFile annexedfile $ content annexedfile ++ "foo"-	not <$> git_annex env "lock" [annexedfile] @? "lock failed to fail without --force"-	git_annex env "lock" ["--force", annexedfile] @? "lock --force failed"+	not <$> git_annex testenv "lock" [annexedfile] @? "lock failed to fail without --force"+	git_annex testenv "lock" ["--force", annexedfile] @? "lock --force failed" 	annexed_present annexedfile-	git_annex env "unlock" [annexedfile] @? "unlock failed"		+	git_annex testenv "unlock" [annexedfile] @? "unlock failed"		 	unannexed annexedfile 	changecontent annexedfile-	git_annex env "add" [annexedfile] @? "add of modified file failed"+	git_annex testenv "add" [annexedfile] @? "add of modified file failed" 	runchecks [checklink, checkunwritable] annexedfile 	c <- readFile annexedfile 	assertEqual "content of modified file" c (changedcontent annexedfile)-	r' <- git_annex env "drop" [annexedfile]+	r' <- git_annex testenv "drop" [annexedfile] 	not r' @? "drop wrongly succeeded with no known copy of modified file"  test_edit :: TestEnv -> Assertion@@ -488,37 +488,37 @@ test_edit_precommit = test_edit' True  test_edit' :: Bool -> TestEnv -> Assertion-test_edit' precommit env = intmpclonerepoInDirect env $ do-	git_annex env "get" [annexedfile] @? "get of file failed"+test_edit' precommit testenv = intmpclonerepoInDirect testenv $ do+	git_annex testenv "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex env "edit" [annexedfile] @? "edit failed"+	git_annex testenv "edit" [annexedfile] @? "edit failed" 	unannexed annexedfile 	changecontent annexedfile 	boolSystem "git" [Param "add", File annexedfile] 		@? "git add of edited file failed" 	if precommit-		then git_annex env "pre-commit" []+		then git_annex testenv "pre-commit" [] 			@? "pre-commit failed" 		else boolSystem "git" [Params "commit -q -m contentchanged"] 			@? "git commit of edited file failed" 	runchecks [checklink, checkunwritable] annexedfile 	c <- readFile annexedfile 	assertEqual "content of modified file" c (changedcontent annexedfile)-	not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file"+	not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file"  test_fix :: TestEnv -> Assertion-test_fix env = intmpclonerepoInDirect env $ do+test_fix testenv = intmpclonerepoInDirect testenv $ do 	annexed_notpresent annexedfile-	git_annex env "fix" [annexedfile] @? "fix of not present failed"+	git_annex testenv "fix" [annexedfile] @? "fix of not present failed" 	annexed_notpresent annexedfile-	git_annex env "get" [annexedfile] @? "get of file failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex env "fix" [annexedfile] @? "fix of present file failed"+	git_annex testenv "fix" [annexedfile] @? "fix of present file failed" 	annexed_present annexedfile 	createDirectory subdir 	boolSystem "git" [Param "mv", File annexedfile, File subdir] 		@? "git mv failed"-	git_annex env "fix" [newfile] @? "fix of moved file failed"+	git_annex testenv "fix" [newfile] @? "fix of moved file failed" 	runchecks [checklink, checkunwritable] newfile 	c <- readFile newfile 	assertEqual "content of moved file" c (content annexedfile)@@ -527,22 +527,22 @@ 	newfile = subdir ++ "/" ++ annexedfile  test_trust :: TestEnv -> Assertion-test_trust env = intmpclonerepo env $ do-	git_annex env "trust" [repo] @? "trust failed"+test_trust testenv = intmpclonerepo testenv $ do+	git_annex testenv "trust" [repo] @? "trust failed" 	trustcheck Logs.Trust.Trusted "trusted 1"-	git_annex env "trust" [repo] @? "trust of trusted failed"+	git_annex testenv "trust" [repo] @? "trust of trusted failed" 	trustcheck Logs.Trust.Trusted "trusted 2"-	git_annex env "untrust" [repo] @? "untrust failed"+	git_annex testenv "untrust" [repo] @? "untrust failed" 	trustcheck Logs.Trust.UnTrusted "untrusted 1"-	git_annex env "untrust" [repo] @? "untrust of untrusted failed"+	git_annex testenv "untrust" [repo] @? "untrust of untrusted failed" 	trustcheck Logs.Trust.UnTrusted "untrusted 2"-	git_annex env "dead" [repo] @? "dead failed"+	git_annex testenv "dead" [repo] @? "dead failed" 	trustcheck Logs.Trust.DeadTrusted "deadtrusted 1"-	git_annex env "dead" [repo] @? "dead of dead failed"+	git_annex testenv "dead" [repo] @? "dead of dead failed" 	trustcheck Logs.Trust.DeadTrusted "deadtrusted 2"-	git_annex env "semitrust" [repo] @? "semitrust failed"+	git_annex testenv "semitrust" [repo] @? "semitrust failed" 	trustcheck Logs.Trust.SemiTrusted "semitrusted 1"-	git_annex env "semitrust" [repo] @? "semitrust of semitrusted failed"+	git_annex testenv "semitrust" [repo] @? "semitrust of semitrusted failed" 	trustcheck Logs.Trust.SemiTrusted "semitrusted 2"   where 	repo = "origin"@@ -554,48 +554,48 @@ 		assertBool msg present  test_fsck_basic :: TestEnv -> Assertion-test_fsck_basic env = intmpclonerepo env $ do-	git_annex env "fsck" [] @? "fsck failed"-	git_annex env "numcopies" ["2"] @? "numcopies config failed"-	fsck_should_fail env "numcopies unsatisfied"-	git_annex env "numcopies" ["1"] @? "numcopies config failed"+test_fsck_basic testenv = intmpclonerepo testenv $ do+	git_annex testenv "fsck" [] @? "fsck failed"+	git_annex testenv "numcopies" ["2"] @? "numcopies config failed"+	fsck_should_fail testenv "numcopies unsatisfied"+	git_annex testenv "numcopies" ["1"] @? "numcopies config failed" 	corrupt annexedfile 	corrupt sha1annexedfile   where 	corrupt f = do-		git_annex env "get" [f] @? "get of file failed"+		git_annex testenv "get" [f] @? "get of file failed" 		Utility.FileMode.allowWrite f 		writeFile f (changedcontent f) 		ifM (annexeval Config.isDirect)-			( git_annex env "fsck" [] @? "fsck failed in direct mode with changed file content"-			, not <$> git_annex env "fsck" [] @? "fsck failed to fail with corrupted file content"+			( git_annex testenv "fsck" [] @? "fsck failed in direct mode with changed file content"+			, not <$> git_annex testenv "fsck" [] @? "fsck failed to fail with corrupted file content" 			)-		git_annex env "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f+		git_annex testenv "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f  test_fsck_bare :: TestEnv -> Assertion-test_fsck_bare env = intmpbareclonerepo env $-	git_annex env "fsck" [] @? "fsck failed"+test_fsck_bare testenv = intmpbareclonerepo testenv $+	git_annex testenv "fsck" [] @? "fsck failed"  test_fsck_localuntrusted :: TestEnv -> Assertion-test_fsck_localuntrusted env = intmpclonerepo env $ do-	git_annex env "get" [annexedfile] @? "get failed"-	git_annex env "untrust" ["origin"] @? "untrust of origin repo failed"-	git_annex env "untrust" ["."] @? "untrust of current repo failed"-	fsck_should_fail env "content only available in untrusted (current) repository"-	git_annex env "trust" ["."] @? "trust of current repo failed"-	git_annex env "fsck" [annexedfile] @? "fsck failed on file present in trusted repo"+test_fsck_localuntrusted testenv = intmpclonerepo testenv $ do+	git_annex testenv "get" [annexedfile] @? "get failed"+	git_annex testenv "untrust" ["origin"] @? "untrust of origin repo failed"+	git_annex testenv "untrust" ["."] @? "untrust of current repo failed"+	fsck_should_fail testenv "content only available in untrusted (current) repository"+	git_annex testenv "trust" ["."] @? "trust of current repo failed"+	git_annex testenv "fsck" [annexedfile] @? "fsck failed on file present in trusted repo"  test_fsck_remoteuntrusted :: TestEnv -> Assertion-test_fsck_remoteuntrusted env = intmpclonerepo env $ do-	git_annex env "numcopies" ["2"] @? "numcopies config failed"-	git_annex env "get" [annexedfile] @? "get failed"-	git_annex env "get" [sha1annexedfile] @? "get failed"-	git_annex env "fsck" [] @? "fsck failed with numcopies=2 and 2 copies"-	git_annex env "untrust" ["origin"] @? "untrust of origin failed"-	fsck_should_fail env "content not replicated to enough non-untrusted repositories"+test_fsck_remoteuntrusted testenv = intmpclonerepo testenv $ do+	git_annex testenv "numcopies" ["2"] @? "numcopies config failed"+	git_annex testenv "get" [annexedfile] @? "get failed"+	git_annex testenv "get" [sha1annexedfile] @? "get failed"+	git_annex testenv "fsck" [] @? "fsck failed with numcopies=2 and 2 copies"+	git_annex testenv "untrust" ["origin"] @? "untrust of origin failed"+	fsck_should_fail testenv "content not replicated to enough non-untrusted repositories"  fsck_should_fail :: TestEnv -> String -> Assertion-fsck_should_fail env m = not <$> git_annex env "fsck" []+fsck_should_fail testenv m = not <$> git_annex testenv "fsck" [] 	@? "fsck failed to fail with " ++ m  test_migrate :: TestEnv -> Assertion@@ -605,26 +605,26 @@ test_migrate_via_gitattributes = test_migrate' True  test_migrate' :: Bool -> TestEnv -> Assertion-test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do+test_migrate' usegitattributes testenv = intmpclonerepoInDirect testenv $ do 	annexed_notpresent annexedfile 	annexed_notpresent sha1annexedfile-	git_annex env "migrate" [annexedfile] @? "migrate of not present failed"-	git_annex env "migrate" [sha1annexedfile] @? "migrate of not present failed"-	git_annex env "get" [annexedfile] @? "get of file failed"-	git_annex env "get" [sha1annexedfile] @? "get of file failed"+	git_annex testenv "migrate" [annexedfile] @? "migrate of not present failed"+	git_annex testenv "migrate" [sha1annexedfile] @? "migrate of not present failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed"+	git_annex testenv "get" [sha1annexedfile] @? "get of file failed" 	annexed_present annexedfile 	annexed_present sha1annexedfile 	if usegitattributes 		then do 			writeFile ".gitattributes" "* annex.backend=SHA1"-			git_annex env "migrate" [sha1annexedfile]+			git_annex testenv "migrate" [sha1annexedfile] 				@? "migrate sha1annexedfile failed"-			git_annex env "migrate" [annexedfile]+			git_annex testenv "migrate" [annexedfile] 				@? "migrate annexedfile failed" 		else do-			git_annex env "migrate" [sha1annexedfile, "--backend", "SHA1"]+			git_annex testenv "migrate" [sha1annexedfile, "--backend", "SHA1"] 				@? "migrate sha1annexedfile failed"-			git_annex env "migrate" [annexedfile, "--backend", "SHA1"]+			git_annex testenv "migrate" [annexedfile, "--backend", "SHA1"] 				@? "migrate annexedfile failed" 	annexed_present annexedfile 	annexed_present sha1annexedfile@@ -633,9 +633,9 @@  	-- check that reversing a migration works 	writeFile ".gitattributes" "* annex.backend=SHA256"-	git_annex env "migrate" [sha1annexedfile]+	git_annex testenv "migrate" [sha1annexedfile] 		@? "migrate sha1annexedfile failed"-	git_annex env "migrate" [annexedfile]+	git_annex testenv "migrate" [annexedfile] 		@? "migrate annexedfile failed" 	annexed_present annexedfile 	annexed_present sha1annexedfile@@ -644,12 +644,12 @@  test_unused :: TestEnv -> Assertion -- This test is broken in direct mode-test_unused env = intmpclonerepoInDirect env $ do+test_unused testenv = intmpclonerepoInDirect testenv $ do 	-- keys have to be looked up before files are removed 	annexedfilekey <- annexeval $ findkey annexedfile 	sha1annexedfilekey <- annexeval $ findkey sha1annexedfile-	git_annex env "get" [annexedfile] @? "get of file failed"-	git_annex env "get" [sha1annexedfile] @? "get of file failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed"+	git_annex testenv "get" [sha1annexedfile] @? "get of file failed" 	checkunused [] "after get" 	boolSystem "git" [Params "rm -fq", File annexedfile] @? "git rm failed" 	checkunused [] "after rm"@@ -663,19 +663,19 @@ 	checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile"  	-- good opportunity to test dropkey also-	git_annex env "dropkey" ["--force", Types.Key.key2file annexedfilekey]+	git_annex testenv "dropkey" ["--force", Types.Key.key2file annexedfilekey] 		@? "dropkey failed" 	checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Types.Key.key2file annexedfilekey) -	not <$> git_annex env "dropunused" ["1"] @? "dropunused failed to fail without --force"-	git_annex env "dropunused" ["--force", "1"] @? "dropunused failed"+	not <$> git_annex testenv "dropunused" ["1"] @? "dropunused failed to fail without --force"+	git_annex testenv "dropunused" ["--force", "1"] @? "dropunused failed" 	checkunused [] "after dropunused"-	not <$> git_annex env "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers"+	not <$> git_annex testenv "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers"  	-- unused used to miss symlinks that were not staged and pointed  	-- at annexed content, and think that content was unused 	writeFile "unusedfile" "unusedcontent"-	git_annex env "add" ["unusedfile"] @? "add of unusedfile failed"+	git_annex testenv "add" ["unusedfile"] @? "add of unusedfile failed" 	unusedfilekey <- annexeval $ findkey "unusedfile" 	renameFile "unusedfile" "unusedunstagedfile" 	boolSystem "git" [Params "rm -qf", File "unusedfile"] @? "git rm failed"@@ -686,7 +686,7 @@ 	-- unused used to miss symlinks that were deleted or modified 	-- manually, but commited as such. 	writeFile "unusedfile" "unusedcontent"-	git_annex env "add" ["unusedfile"] @? "add of unusedfile failed"+	git_annex testenv "add" ["unusedfile"] @? "add of unusedfile failed" 	boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed" 	unusedfilekey' <- annexeval $ findkey "unusedfile" 	checkunused [] "with staged deleted link"@@ -696,7 +696,7 @@ 	-- unused used to miss symlinks that were deleted or modified 	-- manually, but not staged as such. 	writeFile "unusedfile" "unusedcontent"-	git_annex env "add" ["unusedfile"] @? "add of unusedfile failed"+	git_annex testenv "add" ["unusedfile"] @? "add of unusedfile failed" 	boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed" 	unusedfilekey'' <- annexeval $ findkey "unusedfile" 	checkunused [] "with unstaged deleted link"@@ -705,7 +705,7 @@    where 	checkunused expectedkeys desc = do-		git_annex env "unused" [] @? "unused failed"+		git_annex testenv "unused" [] @? "unused failed" 		unusedmap <- annexeval $ Logs.Unused.readUnusedMap "" 		let unusedkeys = M.elems unusedmap 		assertEqual ("unused keys differ " ++ desc)@@ -715,109 +715,109 @@ 		return $ fromJust r  test_describe :: TestEnv -> Assertion-test_describe env = intmpclonerepo env $ do-	git_annex env "describe" [".", "this repo"] @? "describe 1 failed"-	git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"+test_describe testenv = intmpclonerepo testenv $ do+	git_annex testenv "describe" [".", "this repo"] @? "describe 1 failed"+	git_annex testenv "describe" ["origin", "origin repo"] @? "describe 2 failed"  test_find :: TestEnv -> Assertion-test_find env = intmpclonerepo env $ do+test_find testenv = intmpclonerepo testenv $ do 	annexed_notpresent annexedfile-	git_annex_expectoutput env "find" [] []-	git_annex env "get" [annexedfile] @? "get failed"+	git_annex_expectoutput testenv "find" [] []+	git_annex testenv "get" [annexedfile] @? "get failed" 	annexed_present annexedfile 	annexed_notpresent sha1annexedfile-	git_annex_expectoutput env "find" [] [annexedfile]-	git_annex_expectoutput env "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] []-	git_annex_expectoutput env "find" ["--include", annexedfile] [annexedfile]-	git_annex_expectoutput env "find" ["--not", "--in", "origin"] []-	git_annex_expectoutput env "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile]-	git_annex_expectoutput env "find" ["--inbackend", "SHA1"] [sha1annexedfile]-	git_annex_expectoutput env "find" ["--inbackend", "WORM"] []+	git_annex_expectoutput testenv "find" [] [annexedfile]+	git_annex_expectoutput testenv "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] []+	git_annex_expectoutput testenv "find" ["--include", annexedfile] [annexedfile]+	git_annex_expectoutput testenv "find" ["--not", "--in", "origin"] []+	git_annex_expectoutput testenv "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile]+	git_annex_expectoutput testenv "find" ["--inbackend", "SHA1"] [sha1annexedfile]+	git_annex_expectoutput testenv "find" ["--inbackend", "WORM"] []  	{- --include=* should match files in subdirectories too, 	 - and --exclude=* should exclude them. -} 	createDirectory "dir" 	writeFile "dir/subfile" "subfile"-	git_annex env "add" ["dir"] @? "add of subdir failed"-	git_annex_expectoutput env "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"]-	git_annex_expectoutput env "find" ["--exclude", "*"] []+	git_annex testenv "add" ["dir"] @? "add of subdir failed"+	git_annex_expectoutput testenv "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"]+	git_annex_expectoutput testenv "find" ["--exclude", "*"] []  test_merge :: TestEnv -> Assertion-test_merge env = intmpclonerepo env $-	git_annex env "merge" [] @? "merge failed"+test_merge testenv = intmpclonerepo testenv $+	git_annex testenv "merge" [] @? "merge failed"  test_info :: TestEnv -> Assertion-test_info env = intmpclonerepo env $ do-	json <- git_annex_output env "info" ["--json"]+test_info testenv = intmpclonerepo testenv $ do+	json <- git_annex_output testenv "info" ["--json"] 	case Text.JSON.decodeStrict json :: Text.JSON.Result (Text.JSON.JSObject Text.JSON.JSValue) of 		Text.JSON.Ok _ -> return () 		Text.JSON.Error e -> assertFailure e  test_version :: TestEnv -> Assertion-test_version env = intmpclonerepo env $-	git_annex env "version" [] @? "version failed"+test_version testenv = intmpclonerepo testenv $+	git_annex testenv "version" [] @? "version failed"  test_sync :: TestEnv -> Assertion-test_sync env = intmpclonerepo env $ do-	git_annex env "sync" [] @? "sync failed"+test_sync testenv = intmpclonerepo testenv $ do+	git_annex testenv "sync" [] @? "sync failed" 	{- Regression test for bug fixed in  	 - 7b0970b340d7faeb745c666146c7f701ec71808f, where in direct mode 	 - sync committed the symlink standin file to the annex. -}-	git_annex_expectoutput env "find" ["--in", "."] []+	git_annex_expectoutput testenv "find" ["--in", "."] []  {- Regression test for union merge bug fixed in  - 0214e0fb175a608a49b812d81b4632c081f63027 -} test_union_merge_regression :: TestEnv -> Assertion-test_union_merge_regression env =+test_union_merge_regression testenv = 	{- We need 3 repos to see this bug. -}-	withtmpclonerepo env False $ \r1 ->-		withtmpclonerepo env False $ \r2 ->-			withtmpclonerepo env False $ \r3 -> do-				forM_ [r1, r2, r3] $ \r -> indir env r $ do+	withtmpclonerepo testenv False $ \r1 ->+		withtmpclonerepo testenv False $ \r2 ->+			withtmpclonerepo testenv False $ \r3 -> do+				forM_ [r1, r2, r3] $ \r -> indir testenv r $ do 					when (r /= r1) $ 						boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" 					when (r /= r2) $ 						boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add" 					when (r /= r3) $ 						boolSystem "git" [Params "remote add r3", File ("../../" ++ r3)] @? "remote add"-					git_annex env "get" [annexedfile] @? "get failed"+					git_annex testenv "get" [annexedfile] @? "get failed" 					boolSystem "git" [Params "remote rm origin"] @? "remote rm"-				forM_ [r3, r2, r1] $ \r -> indir env r $-					git_annex env "sync" [] @? "sync failed"-				forM_ [r3, r2] $ \r -> indir env r $-					git_annex env "drop" ["--force", annexedfile] @? "drop failed"-				indir env r1 $ do-					git_annex env "sync" [] @? "sync failed in r1"-					git_annex_expectoutput env "find" ["--in", "r3"] []+				forM_ [r3, r2, r1] $ \r -> indir testenv r $+					git_annex testenv "sync" [] @? "sync failed"+				forM_ [r3, r2] $ \r -> indir testenv r $+					git_annex testenv "drop" ["--force", annexedfile] @? "drop failed"+				indir testenv r1 $ do+					git_annex testenv "sync" [] @? "sync failed in r1"+					git_annex_expectoutput testenv "find" ["--in", "r3"] [] 					{- This was the bug. The sync 					 - mangled location log data and it 					 - thought the file was still in r2 -}-					git_annex_expectoutput env "find" ["--in", "r2"] []+					git_annex_expectoutput testenv "find" ["--in", "r2"] []  {- Regression test for the automatic conflict resolution bug fixed  - in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -} test_conflict_resolution_movein_regression :: TestEnv -> Assertion-test_conflict_resolution_movein_regression env = withtmpclonerepo env False $ \r1 -> -	withtmpclonerepo env False $ \r2 -> do+test_conflict_resolution_movein_regression testenv = withtmpclonerepo testenv False $ \r1 -> +	withtmpclonerepo testenv False $ \r2 -> do 		let rname r = if r == r1 then "r1" else "r2"-		forM_ [r1, r2] $ \r -> indir env r $ do+		forM_ [r1, r2] $ \r -> indir testenv r $ do 			{- Get all files, see check below. -}-			git_annex env "get" [] @? "get failed"+			git_annex testenv "get" [] @? "get failed" 			disconnectOrigin-		pair env r1 r2-		forM_ [r1, r2] $ \r -> indir env r $ do+		pair testenv r1 r2+		forM_ [r1, r2] $ \r -> indir testenv r $ do 			{- Set up a conflict. -} 			let newcontent = content annexedfile ++ rname r 			ifM (annexeval Config.isDirect) 				( writeFile annexedfile newcontent 				, do-					git_annex env "unlock" [annexedfile] @? "unlock failed"		+					git_annex testenv "unlock" [annexedfile] @? "unlock failed"		 					writeFile annexedfile newcontent 				) 		{- Sync twice in r1 so it gets the conflict resolution 		 - update from r2 -}-		forM_ [r1, r2, r1] $ \r -> indir env r $-			git_annex env "sync" ["--force"] @? "sync failed in " ++ rname r+		forM_ [r1, r2, r1] $ \r -> indir testenv r $+			git_annex testenv "sync" ["--force"] @? "sync failed in " ++ rname r 		{- After the sync, it should be possible to get all 		 - files. This includes both sides of the conflict, 		 - although the filenames are not easily predictable.@@ -825,28 +825,28 @@ 		 - The bug caused, in direct mode, one repo to 		 - be missing the content of the file that had 		 - been put in it. -}-		forM_ [r1, r2] $ \r -> indir env r $ do-		 	git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r+		forM_ [r1, r2] $ \r -> indir testenv r $ do+		 	git_annex testenv "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r  {- Simple case of conflict resolution; 2 different versions of annexed  - file. -} test_conflict_resolution :: TestEnv -> Assertion-test_conflict_resolution env = -	withtmpclonerepo env False $ \r1 ->-		withtmpclonerepo env False $ \r2 -> do-			indir env r1 $ do+test_conflict_resolution testenv = +	withtmpclonerepo testenv False $ \r1 ->+		withtmpclonerepo testenv False $ \r2 -> do+			indir testenv r1 $ do 				disconnectOrigin 				writeFile conflictor "conflictor1"-				git_annex env "add" [conflictor] @? "add conflicter failed"-				git_annex env "sync" [] @? "sync failed in r1"-			indir env r2 $ do+				git_annex testenv "add" [conflictor] @? "add conflicter failed"+				git_annex testenv "sync" [] @? "sync failed in r1"+			indir testenv r2 $ do 				disconnectOrigin 				writeFile conflictor "conflictor2"-				git_annex env "add" [conflictor] @? "add conflicter failed"-				git_annex env "sync" [] @? "sync failed in r2"-			pair env r1 r2-			forM_ [r1,r2,r1] $ \r -> indir env r $-				git_annex env "sync" [] @? "sync failed"+				git_annex testenv "add" [conflictor] @? "add conflicter failed"+				git_annex testenv "sync" [] @? "sync failed in r2"+			pair testenv r1 r2+			forM_ [r1,r2,r1] $ \r -> indir testenv r $+				git_annex testenv "sync" [] @? "sync failed" 			checkmerge "r1" r1 			checkmerge "r2" r2   where@@ -857,35 +857,35 @@ 		let v = filter (variantprefix `isPrefixOf`) l 		length v == 2 			@? (what ++ " not exactly 2 variant files in: " ++ show l)-		indir env d $ do-			git_annex env "get" v @? "get failed"-			git_annex_expectoutput env "find" v v+		indir testenv d $ do+			git_annex testenv "get" v @? "get failed"+			git_annex_expectoutput testenv "find" v v   {- Check merge conflict resolution when one side is an annexed  - file, and the other is a directory. -} test_mixed_conflict_resolution :: TestEnv -> Assertion-test_mixed_conflict_resolution env = do+test_mixed_conflict_resolution testenv = do 	check True 	check False   where-	check inr1 = withtmpclonerepo env False $ \r1 ->-		withtmpclonerepo env False $ \r2 -> do-			indir env r1 $ do+	check inr1 = withtmpclonerepo testenv False $ \r1 ->+		withtmpclonerepo testenv False $ \r2 -> do+			indir testenv r1 $ do 				disconnectOrigin 				writeFile conflictor "conflictor"-				git_annex env "add" [conflictor] @? "add conflicter failed"-				git_annex env "sync" [] @? "sync failed in r1"-			indir env r2 $ do+				git_annex testenv "add" [conflictor] @? "add conflicter failed"+				git_annex testenv "sync" [] @? "sync failed in r1"+			indir testenv r2 $ do 				disconnectOrigin 				createDirectory conflictor 				writeFile subfile "subfile"-				git_annex env "add" [conflictor] @? "add conflicter failed"-				git_annex env "sync" [] @? "sync failed in r2"-			pair env r1 r2+				git_annex testenv "add" [conflictor] @? "add conflicter failed"+				git_annex testenv "sync" [] @? "sync failed in r2"+			pair testenv r1 r2 			let l = if inr1 then [r1, r2] else [r2, r1]-			forM_ l $ \r -> indir env r $-				git_annex env "sync" [] @? "sync failed in mixed conflict"+			forM_ l $ \r -> indir testenv r $+				git_annex testenv "sync" [] @? "sync failed in mixed conflict" 			checkmerge "r1" r1 			checkmerge "r2" r2 	conflictor = "conflictor"@@ -899,41 +899,41 @@ 			@? (what ++ " conflictor variant file missing in: " ++ show l ) 		length v == 1 			@? (what ++ " too many variant files in: " ++ show v)-		indir env d $ do-			git_annex env "get" (conflictor:v) @? ("get failed in " ++ what)-			git_annex_expectoutput env "find" [conflictor] [Git.FilePath.toInternalGitPath subfile]-			git_annex_expectoutput env "find" v v+		indir testenv d $ do+			git_annex testenv "get" (conflictor:v) @? ("get failed in " ++ what)+			git_annex_expectoutput testenv "find" [conflictor] [Git.FilePath.toInternalGitPath subfile]+			git_annex_expectoutput testenv "find" v v  {- Check merge conflict resolution when both repos start with an annexed  - file; one modifies it, and the other deletes it. -} test_remove_conflict_resolution :: TestEnv -> Assertion-test_remove_conflict_resolution env = do+test_remove_conflict_resolution testenv = do 	check True 	check False   where-	check inr1 = withtmpclonerepo env False $ \r1 ->-		withtmpclonerepo env False $ \r2 -> do-			indir env r1 $ do+	check inr1 = withtmpclonerepo testenv False $ \r1 ->+		withtmpclonerepo testenv False $ \r2 -> do+			indir testenv r1 $ do 				disconnectOrigin 				writeFile conflictor "conflictor"-				git_annex env "add" [conflictor] @? "add conflicter failed"-				git_annex env "sync" [] @? "sync failed in r1"-			indir env r2 $+				git_annex testenv "add" [conflictor] @? "add conflicter failed"+				git_annex testenv "sync" [] @? "sync failed in r1"+			indir testenv r2 $ 				disconnectOrigin-			pair env r1 r2-			indir env r2 $ do-				git_annex env "sync" [] @? "sync failed in r2"-				git_annex env "get" [conflictor]+			pair testenv r1 r2+			indir testenv r2 $ do+				git_annex testenv "sync" [] @? "sync failed in r2"+				git_annex testenv "get" [conflictor] 					@? "get conflictor failed" 				unlessM (annexeval Config.isDirect) $ do-					git_annex env "unlock" [conflictor]+					git_annex testenv "unlock" [conflictor] 						@? "unlock conflictor failed" 				writeFile conflictor "newconflictor"-			indir env r1 $+			indir testenv r1 $ 				nukeFile conflictor 			let l = if inr1 then [r1, r2, r1] else [r2, r1, r2]-			forM_ l $ \r -> indir env r $-				git_annex env "sync" [] @? "sync failed"+			forM_ l $ \r -> indir testenv r $+				git_annex testenv "sync" [] @? "sync failed" 			checkmerge "r1" r1 			checkmerge "r2" r2 	conflictor = "conflictor"@@ -953,31 +953,31 @@  - indirect mode.  -} test_nonannexed_conflict_resolution :: TestEnv -> Assertion-test_nonannexed_conflict_resolution env = do+test_nonannexed_conflict_resolution testenv = do 	check True False 	check False False 	check True True 	check False True   where-	check inr1 switchdirect = withtmpclonerepo env False $ \r1 ->-		withtmpclonerepo env False $ \r2 -> do+	check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 ->+		withtmpclonerepo testenv False $ \r2 -> do 			whenM (isInDirect r1 <&&> isInDirect r2) $ do-				indir env r1 $ do+				indir testenv r1 $ do 					disconnectOrigin 					writeFile conflictor "conflictor"-					git_annex env "add" [conflictor] @? "add conflicter failed"-					git_annex env "sync" [] @? "sync failed in r1"-				indir env r2 $ do+					git_annex testenv "add" [conflictor] @? "add conflicter failed"+					git_annex testenv "sync" [] @? "sync failed in r1"+				indir testenv r2 $ do 					disconnectOrigin 					writeFile conflictor nonannexed_content 					boolSystem "git" [Params "add", File conflictor] @? "git add conflictor failed"-					git_annex env "sync" [] @? "sync failed in r2"-				pair env r1 r2+					git_annex testenv "sync" [] @? "sync failed in r2"+				pair testenv r1 r2 				let l = if inr1 then [r1, r2] else [r2, r1]-				forM_ l $ \r -> indir env r $ do+				forM_ l $ \r -> indir testenv r $ do 					when switchdirect $-						git_annex env "direct" [] @? "failed switching to direct mode"-					git_annex env "sync" [] @? "sync failed"+						git_annex testenv "direct" [] @? "failed switching to direct mode"+					git_annex testenv "sync" [] @? "sync failed" 				checkmerge ("r1" ++ show switchdirect) r1 				checkmerge ("r2" ++ show switchdirect) r2 	conflictor = "conflictor"@@ -1005,37 +1005,37 @@  - Case 2: Remote adds conflictor/file; local has a file named conflictor.  -} test_uncommitted_conflict_resolution :: TestEnv -> Assertion-test_uncommitted_conflict_resolution env = do+test_uncommitted_conflict_resolution testenv = do 	check conflictor 	check (conflictor </> "file")   where-	check remoteconflictor = withtmpclonerepo env False $ \r1 ->-		withtmpclonerepo env False $ \r2 -> do-			indir env r1 $ do+	check remoteconflictor = withtmpclonerepo testenv False $ \r1 ->+		withtmpclonerepo testenv False $ \r2 -> do+			indir testenv r1 $ do 				disconnectOrigin 				createDirectoryIfMissing True (parentDir remoteconflictor) 				writeFile remoteconflictor annexedcontent-				git_annex env "add" [conflictor] @? "add remoteconflicter failed"-				git_annex env "sync" [] @? "sync failed in r1"-			indir env r2 $ do+				git_annex testenv "add" [conflictor] @? "add remoteconflicter failed"+				git_annex testenv "sync" [] @? "sync failed in r1"+			indir testenv r2 $ do 				disconnectOrigin 				writeFile conflictor localcontent-			pair env r1 r2-			indir env r2 $ ifM (annexeval Config.isDirect)+			pair testenv r1 r2+			indir testenv r2 $ ifM (annexeval Config.isDirect) 				( do-					git_annex env "sync" [] @? "sync failed"+					git_annex testenv "sync" [] @? "sync failed" 					let local = conflictor ++ localprefix 					doesFileExist local @? (local ++ " missing after merge") 					s <- readFile local 					s == localcontent @? (local ++ " has wrong content: " ++ s)-					git_annex env "get" [conflictor] @? "get failed"+					git_annex testenv "get" [conflictor] @? "get failed" 					doesFileExist remoteconflictor @? (remoteconflictor ++ " missing after merge") 					s' <- readFile remoteconflictor 					s' == annexedcontent @? (remoteconflictor ++ " has wrong content: " ++ s) 				-- this case is intentionally not handled 				-- in indirect mode, since the user 				-- can recover on their own easily-				, not <$> git_annex env "sync" [] @? "sync failed to fail"+				, not <$> git_annex testenv "sync" [] @? "sync failed to fail" 				) 	conflictor = "conflictor" 	localprefix = ".variant-local"@@ -1046,81 +1046,81 @@  - lost track of whether a file was a symlink.   -} test_conflict_resolution_symlinks :: TestEnv -> Assertion-test_conflict_resolution_symlinks env = do-	withtmpclonerepo env False $ \r1 ->-		withtmpclonerepo env False $ \r2 -> do-			withtmpclonerepo env False $ \r3 -> do-				indir env r1 $ do+test_conflict_resolution_symlinks testenv = do+	withtmpclonerepo testenv False $ \r1 ->+		withtmpclonerepo testenv False $ \r2 -> do+			withtmpclonerepo testenv False $ \r3 -> do+				indir testenv r1 $ do 					writeFile conflictor "conflictor"-					git_annex env "add" [conflictor] @? "add conflicter failed"-					git_annex env "sync" [] @? "sync failed in r1"+					git_annex testenv "add" [conflictor] @? "add conflicter failed"+					git_annex testenv "sync" [] @? "sync failed in r1" 					check_is_link conflictor "r1"-				indir env r2 $ do+				indir testenv r2 $ do 					createDirectory conflictor 					writeFile (conflictor </> "subfile") "subfile"-					git_annex env "add" [conflictor] @? "add conflicter failed"-					git_annex env "sync" [] @? "sync failed in r2"+					git_annex testenv "add" [conflictor] @? "add conflicter failed"+					git_annex testenv "sync" [] @? "sync failed in r2" 					check_is_link (conflictor </> "subfile") "r2"-				indir env r3 $ do+				indir testenv r3 $ do 					writeFile conflictor "conflictor"-					git_annex env "add" [conflictor] @? "add conflicter failed"-					git_annex env "sync" [] @? "sync failed in r1"+					git_annex testenv "add" [conflictor] @? "add conflicter failed"+					git_annex testenv "sync" [] @? "sync failed in r1" 					check_is_link (conflictor </> "subfile") "r3"   where 	conflictor = "conflictor" 	check_is_link f what = do-		git_annex_expectoutput env "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f]+		git_annex_expectoutput testenv "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f] 		l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f] 		all (\i -> Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.SymlinkBlob) l 			@? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l)  {- Set up repos as remotes of each other. -} pair :: TestEnv -> FilePath -> FilePath -> Assertion-pair env r1 r2 = forM_ [r1, r2] $ \r -> indir env r $ do+pair testenv r1 r2 = forM_ [r1, r2] $ \r -> indir testenv r $ do 	when (r /= r1) $ 		boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" 	when (r /= r2) $ 		boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add"  test_map :: TestEnv -> Assertion-test_map env = intmpclonerepo env $ do+test_map testenv = intmpclonerepo testenv $ do 	-- set descriptions, that will be looked for in the map-	git_annex env "describe" [".", "this repo"] @? "describe 1 failed"-	git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"+	git_annex testenv "describe" [".", "this repo"] @? "describe 1 failed"+	git_annex testenv "describe" ["origin", "origin repo"] @? "describe 2 failed" 	-- --fast avoids it running graphviz, not a build dependency-	git_annex env "map" ["--fast"] @? "map failed"+	git_annex testenv "map" ["--fast"] @? "map failed"  test_uninit :: TestEnv -> Assertion-test_uninit env = intmpclonerepo env $ do-	git_annex env "get" [] @? "get failed"+test_uninit testenv = intmpclonerepo testenv $ do+	git_annex testenv "get" [] @? "get failed" 	annexed_present annexedfile-	_ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit+	_ <- git_annex testenv "uninit" [] -- exit status not checked; does abnormal exit 	checkregularfile annexedfile 	doesDirectoryExist ".git" @? ".git vanished in uninit"  test_uninit_inbranch :: TestEnv -> Assertion-test_uninit_inbranch env = intmpclonerepoInDirect env $ do+test_uninit_inbranch testenv = intmpclonerepoInDirect testenv $ do 	boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex"-	not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"+	not <$> git_annex testenv "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"  test_upgrade :: TestEnv -> Assertion-test_upgrade env = intmpclonerepo env $ do-	git_annex env "upgrade" [] @? "upgrade from same version failed"+test_upgrade testenv = intmpclonerepo testenv $ do+	git_annex testenv "upgrade" [] @? "upgrade from same version failed"  test_whereis :: TestEnv -> Assertion-test_whereis env = intmpclonerepo env $ do+test_whereis testenv = intmpclonerepo testenv $ do 	annexed_notpresent annexedfile-	git_annex env "whereis" [annexedfile] @? "whereis on non-present file failed"-	git_annex env "untrust" ["origin"] @? "untrust failed"-	not <$> git_annex env "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail"-	git_annex env "get" [annexedfile] @? "get failed"+	git_annex testenv "whereis" [annexedfile] @? "whereis on non-present file failed"+	git_annex testenv "untrust" ["origin"] @? "untrust failed"+	not <$> git_annex testenv "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail"+	git_annex testenv "get" [annexedfile] @? "get failed" 	annexed_present annexedfile-	git_annex env "whereis" [annexedfile] @? "whereis on present file failed"+	git_annex testenv "whereis" [annexedfile] @? "whereis on present file failed"  test_hook_remote :: TestEnv -> Assertion-test_hook_remote env = intmpclonerepo env $ do+test_hook_remote testenv = intmpclonerepo testenv $ do #ifndef mingw32_HOST_OS-	git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed"+	git_annex testenv "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed" 	createDirectory dir 	git_config "annex.foo-store-hook" $ 		"cp $ANNEX_FILE " ++ loc@@ -1130,15 +1130,15 @@ 		"rm -f " ++ loc 	git_config "annex.foo-checkpresent-hook" $ 		"if [ -e " ++ loc ++ " ]; then echo $ANNEX_KEY; fi"-	git_annex env "get" [annexedfile] @? "get of file failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed"+	git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed" 	annexed_present annexedfile-	git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+	git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" 	annexed_notpresent annexedfile-	git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed"+	git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed" 	annexed_present annexedfile-	not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+	not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" 	annexed_present annexedfile   where 	dir = "dir"@@ -1151,34 +1151,34 @@ #endif  test_directory_remote :: TestEnv -> Assertion-test_directory_remote env = intmpclonerepo env $ do+test_directory_remote testenv = intmpclonerepo testenv $ do 	createDirectory "dir"-	git_annex env "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed"-	git_annex env "get" [annexedfile] @? "get of file failed"+	git_annex testenv "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed"+	git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed" 	annexed_present annexedfile-	git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+	git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" 	annexed_notpresent annexedfile-	git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed"+	git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed" 	annexed_present annexedfile-	not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+	not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" 	annexed_present annexedfile  test_rsync_remote :: TestEnv -> Assertion-test_rsync_remote env = intmpclonerepo env $ do+test_rsync_remote testenv = intmpclonerepo testenv $ do #ifndef mingw32_HOST_OS 	createDirectory "dir"-	git_annex env "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"-	git_annex env "get" [annexedfile] @? "get of file failed"+	git_annex testenv "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed"+	git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed" 	annexed_present annexedfile-	git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+	git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" 	annexed_notpresent annexedfile-	git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed"+	git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed" 	annexed_present annexedfile-	not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+	not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" 	annexed_present annexedfile #else 	-- Rsync remotes with a rsyncurl of a directory do not currently@@ -1187,34 +1187,34 @@ #endif  test_bup_remote :: TestEnv -> Assertion-test_bup_remote env = intmpclonerepo env $ when Build.SysConfig.bup $ do+test_bup_remote testenv = intmpclonerepo testenv $ when Build.SysConfig.bup $ do 	dir <- absPath "dir" -- bup special remote needs an absolute path 	createDirectory dir-	git_annex env "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"-	git_annex env "get" [annexedfile] @? "get of file failed"+	git_annex testenv "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"+	git_annex testenv "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed"+	git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed" 	annexed_present annexedfile-	git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+	git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" 	annexed_notpresent annexedfile-	git_annex env "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed"+	git_annex testenv "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed" 	annexed_present annexedfile-	not <$> git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed to fail"+	not <$> git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed to fail" 	annexed_present annexedfile  -- gpg is not a build dependency, so only test when it's available test_crypto :: TestEnv -> Assertion #ifndef mingw32_HOST_OS-test_crypto env = do+test_crypto testenv = do 	testscheme "shared" 	testscheme "hybrid" 	testscheme "pubkey"   where-	testscheme scheme = intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do+	testscheme scheme = intmpclonerepo testenv $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do 		Utility.Gpg.testTestHarness @? "test harness self-test failed" 		Utility.Gpg.testHarness $ do 			createDirectory "dir"-			let a cmd = git_annex env cmd $+			let a cmd = git_annex testenv cmd $ 				[ "foo" 				, "type=directory" 				, "encryption=" ++ scheme@@ -1227,9 +1227,9 @@ 			not <$> a "initremote" @? "initremote failed to fail when run twice in a row" 			a "enableremote" @? "enableremote failed" 			a "enableremote" @? "enableremote failed when run twice in a row"-			git_annex env "get" [annexedfile] @? "get of file failed"+			git_annex testenv "get" [annexedfile] @? "get of file failed" 			annexed_present annexedfile-			git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"+			git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed" 			(c,k) <- annexeval $ do 				uuid <- Remote.nameToUUID "foo" 				rs <- Logs.Remote.readRemoteLog@@ -1241,11 +1241,11 @@ 			testEncryptedRemote scheme key c [k] @? "invalid crypto setup" 	 			annexed_present annexedfile-			git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+			git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" 			annexed_notpresent annexedfile-			git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"+			git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed" 			annexed_present annexedfile-			not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+			not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" 			annexed_present annexedfile 	{- Ensure the configuration complies with the encryption scheme, and 	 - that all keys are encrypted properly for the given directory remote. -}@@ -1278,28 +1278,28 @@ #endif  test_add_subdirs :: TestEnv -> Assertion-test_add_subdirs env = intmpclonerepo env $ do+test_add_subdirs testenv = intmpclonerepo testenv $ do 	createDirectory "dir" 	writeFile ("dir" </> "foo") $ "dir/" ++ content annexedfile-	git_annex env "add" ["dir"] @? "add of subdir failed"+	git_annex testenv "add" ["dir"] @? "add of subdir failed"  	{- Regression test for Windows bug where symlinks were not 	 - calculated correctly for files in subdirs. -}-	git_annex env "sync" [] @? "sync failed"+	git_annex testenv "sync" [] @? "sync failed" 	l <- annexeval $ decodeBS <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo") 	"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l)  	createDirectory "dir2" 	writeFile ("dir2" </> "foo") $ content annexedfile 	setCurrentDirectory "dir"-	git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed"+	git_annex testenv "add" [".." </> "dir2"] @? "add of ../subdir failed"  -- This is equivilant to running git-annex, but it's all run in-process -- (when the OS allows) so test coverage collection works. git_annex :: TestEnv -> String -> [String] -> IO Bool-git_annex env command params = do+git_annex testenv command params = do #ifndef mingw32_HOST_OS-	forM_ (M.toList env) $ \(var, val) ->+	forM_ (M.toList testenv) $ \(var, val) -> 		Utility.Env.setEnv var val True  	-- catch all errors, including normally fatal errors@@ -1312,23 +1312,23 @@ #else 	Utility.SafeCommand.boolSystemEnv "git-annex" 		(map Param $ command : params)-		(Just $ M.toList env)+		(Just $ M.toList testenv) #endif  {- Runs git-annex and returns its output. -} git_annex_output :: TestEnv -> String -> [String] -> IO String-git_annex_output env command params = do+git_annex_output testenv command params = do 	got <- Utility.Process.readProcessEnv "git-annex" (command:params)-		(Just $ M.toList env)+		(Just $ M.toList testenv) 	-- XXX since the above is a separate process, code coverage stats are 	-- not gathered for things run in it. 	-- Run same command again, to get code coverage.-	_ <- git_annex env command params+	_ <- git_annex testenv command params 	return got  git_annex_expectoutput :: TestEnv -> String -> [String] -> [String] -> IO ()-git_annex_expectoutput env command params expected = do-	got <- lines <$> git_annex_output env command params+git_annex_expectoutput testenv command params expected = do+	got <- lines <$> git_annex_output testenv command params 	got == expected @? ("unexpected value running " ++ command ++ " " ++ show params ++ " -- got: " ++ show got ++ " expected: " ++ show expected)  -- Runs an action in the current annex. Note that shutdown actions@@ -1341,16 +1341,16 @@ 		a  innewrepo :: TestEnv -> Assertion -> Assertion-innewrepo env a = withgitrepo env $ \r -> indir env r a+innewrepo testenv a = withgitrepo testenv $ \r -> indir testenv r a  inmainrepo :: TestEnv -> Assertion -> Assertion-inmainrepo env = indir env mainrepodir+inmainrepo testenv = indir testenv mainrepodir  intmpclonerepo :: TestEnv -> Assertion -> Assertion-intmpclonerepo env a = withtmpclonerepo env False $ \r -> indir env r a+intmpclonerepo testenv a = withtmpclonerepo testenv False $ \r -> indir testenv r a  intmpclonerepoInDirect :: TestEnv -> Assertion -> Assertion-intmpclonerepoInDirect env a = intmpclonerepo env $+intmpclonerepoInDirect testenv a = intmpclonerepo testenv $ 	ifM isdirect 		( putStrLn "not supported in direct mode; skipping" 		, a@@ -1366,62 +1366,62 @@ 	not <$> Annex.eval s Config.isDirect  intmpbareclonerepo :: TestEnv -> Assertion -> Assertion-intmpbareclonerepo env a = withtmpclonerepo env True $ \r -> indir env r a+intmpbareclonerepo testenv a = withtmpclonerepo testenv True $ \r -> indir testenv r a  withtmpclonerepo :: TestEnv -> Bool -> (FilePath -> Assertion) -> Assertion-withtmpclonerepo env bare a = do+withtmpclonerepo testenv bare a = do 	dir <- tmprepodir-	bracket (clonerepo env mainrepodir dir bare) cleanup a+	bracket (clonerepo testenv mainrepodir dir bare) cleanup a  disconnectOrigin :: Assertion disconnectOrigin = boolSystem "git" [Params "remote rm origin"] @? "remote rm"  withgitrepo :: TestEnv -> (FilePath -> Assertion) -> Assertion-withgitrepo env = bracket (setuprepo env mainrepodir) return+withgitrepo testenv = bracket (setuprepo testenv mainrepodir) return  indir :: TestEnv -> FilePath -> Assertion -> Assertion-indir env dir a = do-	cwd <- getCurrentDirectory+indir testenv dir a = do+	currdir <- getCurrentDirectory 	-- Assertion failures throw non-IO errors; catch-	-- any type of error and change back to cwd before+	-- any type of error and change back to currdir before 	-- rethrowing.-	r <- bracket_ (changeToTmpDir env dir) (setCurrentDirectory cwd)+	r <- bracket_ (changeToTmpDir testenv dir) (setCurrentDirectory currdir) 		(try a::IO (Either SomeException ())) 	case r of 		Right () -> return () 		Left e -> throw e  setuprepo :: TestEnv -> FilePath -> IO FilePath-setuprepo env dir = do+setuprepo testenv dir = do 	cleanup dir 	ensuretmpdir 	boolSystem "git" [Params "init -q", File dir] @? "git init failed"-	configrepo env dir+	configrepo testenv dir 	return dir  -- clones are always done as local clones; we cannot test ssh clones clonerepo :: TestEnv -> FilePath -> FilePath -> Bool -> IO FilePath-clonerepo env old new bare = do+clonerepo testenv old new bare = do 	cleanup new 	ensuretmpdir 	let b = if bare then " --bare" else "" 	boolSystem "git" [Params ("clone -q" ++ b), File old, File new] @? "git clone failed"-	indir env new $-		git_annex env "init" ["-q", new] @? "git annex init failed"-	configrepo env new+	indir testenv new $+		git_annex testenv "init" ["-q", new] @? "git annex init failed"+	configrepo testenv new 	unless bare $-		indir env new $-			handleforcedirect env+		indir testenv new $+			handleforcedirect testenv 	return new  configrepo :: TestEnv -> FilePath -> IO ()-configrepo env dir = indir env dir $ do+configrepo testenv dir = indir testenv dir $ do 	boolSystem "git" [Params "config user.name", Param "Test User"] @? "git config failed" 	boolSystem "git" [Params "config user.email test@example.com"] @? "git config failed"  handleforcedirect :: TestEnv -> IO ()-handleforcedirect env = when (M.lookup "FORCEDIRECT" env == Just "1") $-	git_annex env "direct" ["-q"] @? "git annex direct failed"+handleforcedirect testenv = when (M.lookup "FORCEDIRECT" testenv == Just "1") $+	git_annex testenv "direct" ["-q"] @? "git annex direct failed" 	 ensuretmpdir :: IO () ensuretmpdir = do@@ -1539,12 +1539,12 @@ withTestEnv forcedirect = withResource prepare release   where 	prepare = do-		env <- prepareTestEnv forcedirect-		case tryIngredients [consoleTestReporter] mempty (initTests env) of+		testenv <- prepareTestEnv forcedirect+		case tryIngredients [consoleTestReporter] mempty (initTests testenv) of 			Nothing -> error "No tests found!?" 			Just act -> unlessM act $ 				error "init tests failed! cannot continue"-		return env+		return testenv 	release = releaseTestEnv  releaseTestEnv :: TestEnv -> IO ()@@ -1555,14 +1555,14 @@ 	whenM (doesDirectoryExist tmpdir) $ 		error $ "The temporary directory " ++ tmpdir ++ " already exists; cannot run test suite." -	cwd <- getCurrentDirectory+	currdir <- getCurrentDirectory 	p <- Utility.Env.getEnvDefault "PATH" "" -	env <- Utility.Env.getEnvironment+	environ <- Utility.Env.getEnvironment 	let newenv = 		-- Ensure that the just-built git annex is used.-		[ ("PATH", cwd ++ [searchPathSeparator] ++ p)-		, ("TOPDIR", cwd)+		[ ("PATH", currdir ++ [searchPathSeparator] ++ p)+		, ("TOPDIR", currdir) 		-- Avoid git complaining if it cannot determine the user's 		-- email address, or exploding if it doesn't know the user's 		-- name.@@ -1575,11 +1575,11 @@ 		, ("FORCEDIRECT", if forcedirect then "1" else "") 		] -	return $ M.fromList newenv `M.union` M.fromList env+	return $ M.fromList newenv `M.union` M.fromList environ  changeToTmpDir :: TestEnv -> FilePath -> IO ()-changeToTmpDir env t = do-	let topdir = fromMaybe "" $ M.lookup "TOPDIR" env+changeToTmpDir testenv t = do+	let topdir = fromMaybe "" $ M.lookup "TOPDIR" testenv 	setCurrentDirectory $ topdir ++ "/" ++ t  tmpdir :: String
Utility/Batch.hs view
@@ -16,7 +16,6 @@ import System.Posix.Process #endif import qualified Control.Exception as E-import System.Process (env)  {- Runs an operation, at batch priority.  -
Utility/CoProcess.hs view
@@ -37,8 +37,8 @@ 	}  start :: Int -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle-start numrestarts cmd params env = do-	s <- start' $ CoProcessSpec numrestarts cmd params env+start numrestarts cmd params environ = do+	s <- start' $ CoProcessSpec numrestarts cmd params environ 	newMVar s  start' :: CoProcessSpec -> IO CoProcessState
Utility/Daemon.hs view
@@ -39,7 +39,7 @@ 	checkalreadyrunning f = maybe noop (const alreadyRunning)  		=<< checkDaemon f 	child1 = do-		_ <- createSession+		_ <- tryIO createSession 		_ <- forkProcess child2 		out 	child2 = do@@ -49,8 +49,8 @@ 		nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags 		redir nullfd stdInput 		redirLog logfd-		{- forkProcess masks async exceptions; unmask them inside-		 - the action. -}+		{- In old versions of ghc, forkProcess masks async exceptions;+		 - unmask them inside the action. -} 		wait =<< asyncWithUnmask (\unmask -> unmask a) 		out 	out = exitImmediately ExitSuccess@@ -59,7 +59,7 @@ foreground :: Fd -> Maybe FilePath -> IO () -> IO () foreground logfd pidfile a = do 	maybe noop lockPidFile pidfile-	_ <- createSession+	_ <- tryIO createSession 	redirLog logfd 	a 	exitImmediately ExitSuccess
Utility/ExternalSHA.hs view
@@ -15,7 +15,6 @@ import Utility.FileSystemEncoding import Utility.Misc -import System.Process import Data.List import Data.Char import Control.Applicative
Utility/InodeCache.hs view
@@ -1,12 +1,41 @@-{- Caching a file's inode, size, and modification time to see when it's changed.+{- Caching a file's inode, size, and modification time+ - to see when it's changed.  -- - Copyright 2013 Joey Hess <joey@kitenet.net>+ - Copyright 2013, 2014 Joey Hess <joey@kitenet.net>  -  - License: BSD-2-clause  -} -module Utility.InodeCache where+{-# LANGUAGE CPP #-} +module Utility.InodeCache (+	InodeCache,+	InodeComparisonType(..),++	compareStrong,+	compareWeak,+	compareBy,++	readInodeCache,+	showInodeCache,+	genInodeCache,+	toInodeCache,++	InodeCacheKey,+	inodeCacheToKey,+	inodeCacheToMtime,++	SentinalFile(..),+	SentinalStatus(..),+	TSDelta,+	noTSDelta,+	writeSentinalFile,+	checkSentinalFile,+	sentinalFileExists,++	prop_read_show_inodecache+) where+ import Common import System.PosixCompat.Types import Utility.QuickCheck@@ -28,10 +57,17 @@  {- Weak comparison of the inode caches, comparing the size and mtime,  - but not the actual inode.  Useful when inodes have changed, perhaps- - due to some filesystems being remounted. -}+ - due to some filesystems being remounted.+ -+ - The weak mtime comparison treats any mtimes that are within 2 seconds+ - of one-anther as the same. This is because FAT has only a 2 second+ - resolution. When a FAT filesystem is used on Linux, higher resolution+ - timestamps are cached and used by Linux, but this is lost on unmount,+ - so after a remount, the timestamp can appear to have changed.+ -} compareWeak :: InodeCache -> InodeCache -> Bool compareWeak (InodeCache (InodeCachePrim _ size1 mtime1)) (InodeCache (InodeCachePrim _ size2 mtime2)) =-	size1 == size2 && mtime1 == mtime2+	size1 == size2 && (abs (mtime1 - mtime2) < 2)  compareBy :: InodeComparisonType -> InodeCache -> InodeCache -> Bool compareBy Strongly = compareStrong@@ -69,16 +105,96 @@ 		in InodeCache <$> prim 	_ -> Nothing -genInodeCache :: FilePath -> IO (Maybe InodeCache)-genInodeCache f = catchDefaultIO Nothing $ toInodeCache <$> getFileStatus f+genInodeCache :: FilePath -> TSDelta -> IO (Maybe InodeCache)+genInodeCache f delta = catchDefaultIO Nothing $+	toInodeCache delta =<< getFileStatus f -toInodeCache :: FileStatus -> Maybe InodeCache-toInodeCache s-	| isRegularFile s = Just $ InodeCache $ InodeCachePrim-		(fileID s)-		(fileSize s)-		(modificationTime s)-	| otherwise = Nothing+toInodeCache :: TSDelta -> FileStatus -> IO (Maybe InodeCache)+toInodeCache (TSDelta getdelta) s+	| isRegularFile s = do+		delta <- getdelta+		return $ Just $ InodeCache $ InodeCachePrim+			(fileID s)+			(fileSize s)+			(modificationTime s + delta)+	| otherwise = pure Nothing++{- Some filesystem get new random inodes each time they are mounted.+ - To detect this and other problems, a sentinal file can be created.+ - Its InodeCache at the time of its creation is written to the cache file,+ - so changes can later be detected. -}+data SentinalFile = SentinalFile+	{ sentinalFile :: FilePath+	, sentinalCacheFile :: FilePath+	}+	deriving (Show)++{- On Windows, the mtime of a file appears to change when the time zone is+ - changed. To deal with this, a TSDelta can be used; the delta is added to+ - the mtime when generating an InodeCache. The current delta can be found+ - by looking at the SentinalFile. Effectively, this makes all InodeCaches+ - use the same time zone that was in use when the sential file was+ - originally written. -}+newtype TSDelta = TSDelta (IO EpochTime)++noTSDelta :: TSDelta+noTSDelta = TSDelta (pure 0)++writeSentinalFile :: SentinalFile -> IO ()+writeSentinalFile s = do+	writeFile (sentinalFile s) ""+	maybe noop (writeFile (sentinalCacheFile s) . showInodeCache)+		=<< genInodeCache (sentinalFile s) noTSDelta++data SentinalStatus = SentinalStatus+	{ sentinalInodesChanged :: Bool+	, sentinalTSDelta :: TSDelta+	} ++{- Checks if the InodeCache of the sentinal file is the same+ - as it was when it was originally created.+ -+ - On Windows, time stamp differences are ignored, since they change+ - with the timezone.+ -+ - When the sential file does not exist, InodeCaches canot reliably be+ - compared, so the assumption is that there is has been a change.+ -}+checkSentinalFile :: SentinalFile -> IO SentinalStatus+checkSentinalFile s = do+	mold <- loadoldcache+	case mold of+		Nothing -> return dummy+		(Just old) -> do+			mnew <- gennewcache+			case mnew of+				Nothing -> return dummy+				Just new -> return $ calc old new+  where+	loadoldcache = catchDefaultIO Nothing $+		readInodeCache <$> readFile (sentinalCacheFile s)+	gennewcache = genInodeCache (sentinalFile s) noTSDelta+	calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) =+		SentinalStatus (not unchanged) tsdelta+	  where+#ifdef mingw32_HOST_OS+	  	unchanged = oldinode == newinode && oldsize == newsize+		tsdelta = TSDelta $ do+			-- Run when generating an InodeCache, +			-- to get the current delta.+			mnew <- gennewcache+			return $ case mnew of+				Just (InodeCache (InodeCachePrim _ _ currmtime)) ->+					oldmtime - currmtime+				Nothing -> 0+#else+		unchanged = oldinode == newinode && oldsize == newsize && oldmtime == newmtime+		tsdelta = noTSDelta+#endif+	dummy = SentinalStatus True noTSDelta++sentinalFileExists :: SentinalFile -> IO Bool+sentinalFileExists s = allM doesFileExist [sentinalCacheFile s, sentinalFile s]  instance Arbitrary InodeCache where 	arbitrary =
Utility/Process.hs view
@@ -10,7 +10,7 @@  module Utility.Process ( 	module X,-	CreateProcess,+	CreateProcess(..), 	StdHandle(..), 	readProcess, 	readProcessEnv,
Utility/SafeCommand.hs view
@@ -9,7 +9,6 @@  import System.Exit import Utility.Process-import System.Process (env) import Data.String.Utils import Control.Applicative import System.FilePath
Utility/Tmp.hs view
@@ -25,13 +25,20 @@  - then moving it into place. The temp file is stored in the same  - directory as the final file to avoid cross-device renames. -} viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()-viaTmp a file content = do-	let (dir, base) = splitFileName file-	createDirectoryIfMissing True dir-	(tmpfile, handle) <- openTempFile dir (base ++ ".tmp")-	hClose handle-	a tmpfile content-	rename tmpfile file+viaTmp a file content = bracket setup cleanup use+  where+	(dir, base) = splitFileName file+	template = base ++ ".tmp"+	setup = do+		createDirectoryIfMissing True dir+		openTempFile dir template+	cleanup (tmpfile, handle) = do+		_ <- tryIO $ hClose handle+		tryIO $ removeFile tmpfile+	use (tmpfile, handle) = do+		hClose handle+		a tmpfile content+		rename tmpfile file  {- Runs an action with a tmp file located in the system's tmp directory  - (or in "." if there is none) then removes the file. -}
Utility/WebApp.hs view
@@ -18,16 +18,12 @@ import qualified Network.Wai as Wai import Network.Wai.Handler.Warp import Network.Wai.Handler.WarpTLS-import Network.Wai.Logger-import Control.Monad.IO.Class import Network.HTTP.Types-import System.Log.Logger import qualified Data.CaseInsensitive as CI import Network.Socket import "crypto-api" Crypto.Random import qualified Web.ClientSession as CS import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.UTF8 as L8 import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Text.Encoding as TE@@ -61,6 +57,10 @@ 	["start", "-a", "android.intent.action.VIEW", "-d", url] #else #ifdef mingw32_HOST_OS+-- Warning: On Windows, no quoting or escaping of the url seems possible,+-- so spaces in it will cause problems. One approach is to make the url+-- be a relative filename, and adjust the returned CreateProcess to change+-- to the directory it's in. browserProc url = proc "cmd" ["/c start " ++ url] #else browserProc url = proc "xdg-open" [url]@@ -153,35 +153,6 @@ 	use sock = do 		listen sock maxListenQueue 		return sock--{- Checks if debugging is actually enabled. -}-debugEnabled :: IO Bool-debugEnabled = do-	l <- getRootLogger-	return $ getLevel l <= Just DEBUG--{- WAI middleware that logs using System.Log.Logger at debug level.- -- - Recommend only inserting this middleware when debugging is actually- - enabled, as it's not optimised at all.- -}-httpDebugLogger :: Wai.Middleware-httpDebugLogger waiApp req = do-	logRequest req-	waiApp req--logRequest :: MonadIO m => Wai.Request -> m ()-logRequest req = do-	liftIO $ debugM "WebApp" $ unwords-		[ showSockAddr $ Wai.remoteHost req-		, frombs $ Wai.requestMethod req-		, frombs $ Wai.rawPathInfo req-		--, show $ Wai.httpVersion req-		--, frombs $ lookupRequestField "referer" req-		, frombs $ lookupRequestField "user-agent" req-		]-  where-	frombs v = L8.toString $ L.fromChunks [v]  lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
debian/changelog view
@@ -1,3 +1,22 @@+git-annex (5.20140613) unstable; urgency=medium++  * Ignore setsid failures.+  * Avoid leaving behind .tmp files when failing in some cases, including+    importing files to a disk that is full.+  * Avoid bad commits after interrupted direct mode sync (or merge).+  * Fix build with wai 0.3.0.+  * Deal with FAT's low resolution timestamps, which in combination with+    Linux's caching of higher res timestamps while a FAT is mounted, caused+    direct mode repositories on FAT to seem to have modified files after+    they were unmounted and remounted.+  * Windows: Fix opening webapp when repository is in a directory with+    spaces in the path.+  * Detect when Windows has lost its mind in a timezone change, and+    automatically apply a delta to the timestamps it returns, to get back to+    sane values.++ -- Joey Hess <joeyh@debian.org>  Fri, 13 Jun 2014 09:58:07 -0400+ git-annex (5.20140606) unstable; urgency=medium    * webapp: When adding a new local repository, fix bug that caused its
debian/control view
@@ -40,7 +40,7 @@ 	libghc-warp-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], 	libghc-warp-tls-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], 	libghc-wai-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],-	libghc-wai-logger-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],+	libghc-wai-extra-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], 	libghc-securemem-dev, 	libghc-byteable-dev, 	libghc-dns-dev,
+ doc/bugs/On_Ubuntu_14.04_assistant_fails_to_create_new_setup.mdwn view
@@ -0,0 +1,91 @@+### Please describe the problem.++Following steps from http://git-annex.branchable.com/assistant/quickstart/ does not get past the first screen.++### What steps will reproduce the problem?++* On a nearly fresh Lubuntu system, nearly fresh account, Lubuntu session, run `git-annex` from the start menu.+* Opens firefox, in `Create a git-annex repository` select my `~/Documents` folder, press `Make Repository`.++* Expected: a new, different page opens.+* Observed: the same page opens, only difference the path displayed is `/home/mylogin/Documents`. Pressing `Make Repository` again shows the same page again.++I couldn't find any logs at the time. Now I see that they are in .git/annex/daemon.log but content from that time is already gone.++### What version of git-annex are you using? On what operating system?++A fresh Ubuntu 14.04 (actually Lubuntu but this shouldn't change anything, right ?), create a user, login.+++    LC_ALL=C apt-cache policy git-annex+    git-annex:+      Installed: 5.20140412ubuntu1+      Candidate: 5.20140412ubuntu1+      Version table:+     *** 5.20140412ubuntu1 0+            500 http://fr.archive.ubuntu.com/ubuntu/ trusty/universe i386 Packages+            100 /var/lib/dpkg/status+++### Please provide any additional information below.++[[!format sh """+# No command line in bug occurrence.  This is the transcript of the workaround I found.+# Actually, the PC was rebooted then I went command line.+cd ~/Documents+git status+fatal: This operation must be run in a work tree+# oh I see it's a bare repo+git annex add .+add (my file names... one line for each) ok+(Recording state in git...)++Now the webapp seems to run okay, I can see many pages, schedule checks, etc.++# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+-> Ok but log shows only events after I manually dit git annex add.++[2014-06-08 14:28:46 CEST] main: starting assistant version 5.20140412ubuntu1+[2014-06-08 14:28:46 CEST] Cronner: You should enable consistency checking to protect your data.++  dbus failed; falling back to mtab polling (ClientError {clientErrorMessage = "runClient: unable to determine DBUS address", clientErrorFatal = True})+(scanning...) [2014-06-08 14:28:46 CEST] Watcher: Performing startup scan+(started...) [2014-06-08 14:28:47 CEST] Committer: Adding (myfiles)++add (my files...) ok+[2014-06-08 14:32:51 CEST] Committer: Committing changes to git+[2014-06-08 14:34:12 CEST] Committer: Committing changes to git+[2014-06-08 14:34:13 CEST] Committer: Adding (myfiles)+ok+(Recording state in git...)+(Recording state in git...)+(Recording state in git...)+(Recording state in git...)+(Recording state in git...)+add (myfile) ok+add (myfile) [2014-06-08 14:34:13 CEST] Committer: Committing changes to git+[2014-06-08 14:42:48 CEST] Cronner: Consistency check in progress+fsck (myfile) (checksum...)+ok++# End of transcript or log.+"""]]++++# Question:++cat /etc/xdg/autostart/git-annex.desktop+[Desktop Entry]+Type=Application+Version=1.0+Name=Git Annex Assistant+Comment=Autostart+Terminal=false+Exec=/usr/bin/git-annex assistant --autostart+Categories=++Should there be a git-annex process whenever I log in even if I don't launch the webapp ?+I can check that on next login.++At the moment there is "git-annex webapp" and several child processes.
+ doc/bugs/Windows_file_timestamp_timezone_madness.mdwn view
@@ -0,0 +1,31 @@+Windows has an unfortunate handling of time zones, which means that when+the time zone is changed (or DST changes), the timestamps of files also+appear to change.++This means that after such a change, git-annex will see new mtimes, and+want to re-checksum every file in the repo.++[[!tag confirmed]]++> Update: Actually, I seem to have been getting confused by behavior of+> cygwin terminal setting TZ. That indeed led to timestamp changes when the+> time zone changed. I have made git-annex unset TZ to avoid this.+> +> Without TZ set, time stamps are actually stable across time zone changes.+> Ie, a simple program to read the time stamp of a file and print it+> always shows the same thing, before and after a timezone change.+> +> However, and here's where it gets truely ghastly: A program that stats a+> file in a loop will see its timestamp change when the timezone changes.+> I suspect this might be a bug in the Haskell RTS caching something it+> should not. Stopping and re-running the program gets back to the+> original timestamp.+>+> I have not tested DST changes, but it's hard to imagine it being any+> worse than the above behavior.+> +> So, that's insane then. We can't trust timestamps to be stable on windows +> when git-annex is running for a long period of time. --[[Joey]]+> +> > [[fixed|done]], using the inode sentinal file to detect when windows+> > has lost its mind, and calculating its delta from insanity. --[[Joey]]
doc/bugs/android_4.3_install_failed_.mdwn view
@@ -16,4 +16,5 @@     lib/lib.runshell.so: line 133: can't create /sdcard/git-annex.home/git-annex-install.log: Permission denied      Installation failed ! Please report a but and attach /sdcard/git-annex.home/git-annex-install.log -+[[!meta title="android 4.3 install failed on android device without sdcard"]]+[[!tag moreinfo]]
+ doc/bugs/assistant_expensive_scan_unnecessarily_queues_files.mdwn view
@@ -0,0 +1,65 @@+### Please describe the problem.+Summary: The assistant pulls files from remote repos although they are stored on trusted repos (remote machine may be up or down).++After starting the assistant via "git annex webapp --listen #ip# --verbose --debug" it starts to check for pending tasks and starts to queue lots of files (could be all of them). I checked the daemon.log and found the following line:++[[!format sh """+[2014-06-03 21:39:04 CEST] TransferScanner: queued Download UUID "541d2f88-16c3-11e2-aa7e-8f1a2c8e14c5" apps/Apache_OpenOffice_4.0.0_MacOS_x86_install_en-US.dmg Nothing : expensive scan found missing object+"""]]++The file is available in a remote repo:++[[!format sh """+$ git annex whereis apps/Apache_OpenOffice_4.0.0_MacOS_x86_install_en-US.dmg+whereis apps/Apache_OpenOffice_4.0.0_MacOS_x86_install_en-US.dmg (1 copy) +  	541d2f88-16c3-11e2-aa7e-8f1a2c8e14c5 -- dump+ok+"""]]++The remote "dump" is trusted and is configured as "backup" repo. The repo running the assistant is configured as "manual". The configuration settings for wanted, required and scheduled remained untouched.++Num copies is unset and defaults to 1:++[[!format sh """+$ git annex numcopies+global numcopies is not set+(default is 1)+"""]]++When calling "git annex find --want-get" no files are listed as in my case, all are stored in the "dump" repo which is trusted.++[[!format sh """+$ git annex find --want-get+$ +"""]]++### What steps will reproduce the problem?+Start the assistant and wait for it to finish startup checking. The assistant adds lots (all?) of the files due to “expensive scan found missing object”.++### What version of git-annex are you using? On what operating system?+Snapshot build from the annex branchable webpage running on an OSX 10.9.3 machine:+[[!format sh """+$ git annex version+git-annex version: 5.20140411-g2503f43+build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash+key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL+remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external+local repository version: 5+supported repository version: 5+upgrade supported from repository versions: 0 1 2 4+"""]]++Note: Updated to 5.20140529-g68a56a6 but same behavior is observed.++### Please provide any additional information below.++The backup node was down while the assistant starts up. However also files from another trusted node that is online 24/7 is pulled. Repo was upgraded from version 4 to 5. Is there a way to further check why a file was added e.g. to dump all variables of the evaluated term (approxlackingcopies, copies, etc)?++[[!format sh """+[2014-06-03 21:39:04 CEST] TransferScanner: starting scan of [Remote { name ="origin" },Remote { name ="dump" }]+[2014-06-03 21:39:04 CEST] read: git ["--git-dir=/Volumes/DATA/annex/images/.git","--work-tree=/Volumes/DATA/annex/images","ls-files","--cached","-z","--"]+[2014-06-03 21:39:04 CEST] chat: git ["--git-dir=/Volumes/DATA/annex/images/.git","--work-tree=/Volumes/DATA/annex/images","check-attr","-z","--stdin","annex.backend","annex.numcopies","--"]+[2014-06-03 21:39:04 CEST] TransferScanner: queued Download UUID "541d2f88-16c3-11e2-aa7e-8f1a2c8e14c5" apps/Apache_OpenOffice_4.0.0_MacOS_x86_install_en-US.dmg Nothing : expensive scan found missing object+[2014-06-03 21:39:04 CEST] Transferrer: Transferring: Download UUID "541d2f88-16c3-11e2-aa7e-8f1a2c8e14c5" apps/Apache_OpenOffice_4.0.0_MacOS_x86_install_en-US.dmg Nothing+[2014-06-03 21:39:04 CEST] TransferScanner: queued Download UUID "541d2f88-16c3-11e2-aa7e-8f1a2c8e14c5" apps/Apache_OpenOffice_4.0.1_MacOS_x86_install_en-US.dmg Nothing : expensive scan found missing object+"""]]
+ doc/bugs/direct_mode_merge_interrupt.mdwn view
@@ -0,0 +1,54 @@+Seems to me there is a bug in how merges are done in direct mode. This is+done in two steps:++1. Merge the remote branch into the local branch, with work tree directed+   to a temp dir.+2. Use the temp dir and the newly merged branch to update the work tree.++If this is interrupted between 1 and 2, by eg the user ctrl-Cing or power+being lost, the result is a repository that thinks the current branch has+been merged, but does not have an updated work tree. The next sync in that+repository will see the files as deleted (or as being an old version), and+commit the current work tree state to the branch. ++Result is files appear to be lost, although `git revert` in an indirect+mode repo can get them back.++To fix this, direct mode merge would need to avoid updating the current+branch when merging the remote branch into it (how?). It should first+update the whole work tree, and only after it's updated should it update+the index and the current branch to reflect the merge.  ++This way, if the merge is interrupted, the work tree may have uncommitted+changed -- but it's fine if they get accidentially committed, since when+the merge is re-done, those changes will by the same ones made by the+merge. (I assume this is how `git merge` normally works.) --[[Joey]]++> Implemented that. And then realized that even updating the index+> as part of a merge results in the work tree being out of sync with the+> index. Which will cause the next sync to again delete any files that+> are in the index but not the work tree. Urgh. +> +> Seems that a direct mode+> merge also needs to use a different index file to stage its changes?+> (Ugh)+> > done --[[Joey]]++> > > I had to revert the fix on FAT/Windows due to +> > > a git bug: <http://marc.info/?l=git&m=140262402204212&w=2>+> > > Once that bug's fixed, I can revisit this. --[[Joey]]++[[!meta title="direct mode merge interrupt (fixed for all except FAT, Windows)"]]++## other options++> Or could perhaps use `git-merge-tree`+> and avoid staging the merge in the index until the work-tree is updated.+> +> Alternatively, could use another strategy.. Add a lock file which is held while +> the merge is in progress and contains the pre-merge sha.+> If the lock file is present but not held, state is inconsistent.+> `git-annex sync` and the SanityChecker should+> then run mergeDirectCleanup to recover, before any commits can be made+> from the inconsistent state. This approach seems to get complicated+> quickly.. --[[Joey]]
doc/bugs/error_compiling_network-info_when_compiling_git-annex.mdwn view
@@ -8,3 +8,5 @@ Is there some other dependency that needs network-info? Is there a way to find out?  Thanks++> fowarded 2 ways; [[done]] --[[Joey]]
doc/bugs/import_leaves_stray___96__.tmp__96___files_if_interrupted.mdwn view
@@ -7,3 +7,6 @@ ### What version of git-annex are you using? On what operating system?  git-annex 5.20140517.4 in Ubuntu 12.04.++> The ".tmp" means this dropping is left by viaTmp, and I see why.+> [[fixed|done]] --[[Joey]]
doc/bugs/ssh_portnum_bugs.mdwn view
@@ -12,3 +12,4 @@  When I was experiencing this issue, I was running the default on Jessie/Wheezy. Now I'm running the latest (via auto-update and distributed binary) but don't know if this is still an issue with latest versions (I switched to 22 as a workaround). +[[!tag moreinfo]]
doc/design/roadmap.mdwn view
@@ -13,6 +13,6 @@ * Month 7 user-driven features and polishing * Month 8 [[!traillink git-remote-daemon]] * Month 9 Brazil!, [[!traillink assistant/sshpassword]]-* **Month 10 get [[assistant/Android]] out of beta**+* **Month 10 polish [[assistant/Windows]] port** * Month 11 [[!traillink assistant/chunks]], [[!traillink assistant/deltas]], [[!traillink assistant/gpgkeys]] (pick 2?) * Month 12 [[!traillink assistant/telehash]]
doc/devblog/day_180__porting.mdwn view
@@ -9,5 +9,5 @@ and does not use openssl itself, but a few programs bundled with it, like curl, do use openssl.) -A nice peice of news: OSX Homebrew now contains git-annex, so it can be+A nice piece of news: OSX Homebrew now contains git-annex, so it can be easily installed with `brew install git-annex`
+ doc/devblog/day_181__tricky_merge.mdwn view
@@ -0,0 +1,8 @@+Spent most of today improving behavior when a sync or merge is+interrupted in direct mode. It was possible for an interrupt at the wrong+time to leave the merge committed, but the work tree not yet updated. And+then the next sync would make a commit that reverted the merged changes!++To fix this I had to avoid making any merge commit or indeed updating the+index until after the work tree is updated. It looked intractable for a+while; I'm still surprised I eventually succeeded.
+ doc/devblog/day_182__service.mdwn view
@@ -0,0 +1,6 @@+Have for the first time gotten git-annex to run as a proper Windows+service, using nssm.+([details](http://git-annex.branchable.com/todo/windows_support/#comment-a61be55862ea32e3dc30972f905bb987))+Not quite ready yet though; doesn't run as the right user.++And a few other windows porting bits.
+ doc/devblog/day_183__rubbing_sticks_together.mdwn view
@@ -0,0 +1,23 @@+Spent all day on some horrible timestamp issues on legacy systems. ++On FAT, timestamps have a 2s granularity, which is ok, but then Linux adds+a temporary higher resolution cache, which is lost on unmount. This+confused git-annex since the mtimes seemed to change and it had to+re-checksum half the files to get unconfused, which was not good.+I found a way to use the inode sentinal file to detect when on FAT+and put in a workaround, without degrading git-annex everywhere else.++On Windows, time zones are a utter disaster; it changes the mtime it reports+for files after the time zone has changed. Also there's a bug in the+haskell time library which makes it return old time zone data after a time+zone change. (I just finished developing a fix for that bug..)++Left with nothing but a few sticks, I rubbed them together, and+actually found a way to deal with this problem too. Scary details in+[[bugs/Windows_file_timestamp_timezone_madness]]. While I've implemented+it, it's stuck on a branch until I find a way to make git-annex notice when+the timezone changes while it's running.++----++Today's work was sponsored by Svenne Krap.
+ doc/devblog/day_184__windows_month.mdwn view
@@ -0,0 +1,22 @@+It's officially a Windows porting month. Now that I'm half way through it+and with the last week of the month going to be a vacation, this makes+sense.++Today, finished up dealing with the timezone/timestamp issues on Windows.+This got stranger and stranger the closer I looked at it. After a timestamp+change, a program that was already running will see one timestamp, while a+program that is started after the change will see another one! My approach+works pretty much no matter how Windows goes insane though, and always+recovers a true timestamp. Yay.++Also fixed a regression test failure on Windows, which turned out to be+rooted in a bug in the command queue runner, which neglected to pass+along environment overrides on Windows.++Then I spent 5 hours tracking down a tricky +test suite failure on Windows, which turned out to also+affect FAT and be a recent reversion that has as it's+root cause a [fun bug in git itself](http://marc.info/?l=git&m=140262402204212&w=2).+Put in a not very good workaround. Thank goodness for test suites!++Also got the arm autobuilder unstuck. Release tomorrow.
+ doc/install/NixOS/comment_1_4e487ddd2654a8a992c1538b9c3bf003._comment view
@@ -0,0 +1,21 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawn3p4i4lk_zMilvjnJ9sS6g2nerpgz0Fjc"+ nickname="Matthias"+ subject="build failure"+ date="2014-06-09T15:13:18Z"+ content="""+Building git-annex with Nix 1.7 fails for me. Error:++    trying https://git.samba.org/?p=rsync.git;a=commitdiff_plain;h=0dedfbce2c1b851684ba658861fe9d620636c56a+      % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current+                                     Dload  Upload   Total   Spent    Left  Speed+    100  2277    0  2277    0     0   2805      0 --:--:-- --:--:-- --:--:--  5735+    output path `/nix/store/w6l1c3cdr52arymv3zgwly7razwnsdll-CVE-2014-2855.patch' should have sha256 hash `1jpwwdf07naqxc8fv1lspc95jgk50j5j3wvf037bjay2qzpwjmvf', instead has `0j1pqmwsqc5mh815x28izi4baki2y2r5q8k7ma1sgs4xsgjc4rk8'+    building path(s) `/nix/store/85v7c8b3ygpfj8m8bk98kcygf29qcbq7-cacert-20131205.pem.bz2'+    cannot build derivation `/nix/store/im9p1y2xbh08yrwp5yggj1ii884wv3ql-rsync-3.1.0.drv': 1 dependencies couldn't be built+    killing process 2599+    cannot build derivation `/nix/store/sl48cnm06m7mcqxjfj2b0yv8am3blqr3-git-annex-5.20140517.drv': 1 dependencies couldn't be built+    error: build of `/nix/store/sl48cnm06m7mcqxjfj2b0yv8am3blqr3-git-annex-5.20140517.drv' failed++Someone has an idea what Nix expects me to do in this situation?+"""]]
− doc/news/version_5.20140412.mdwn 
@@ -1,3 +0,0 @@-git-annex 5.20140412 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * Last release didn't quite fix the high cpu issue in all cases, this should."""]]
+ doc/news/version_5.20140613.mdwn view
@@ -0,0 +1,16 @@+git-annex 5.20140613 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * Ignore setsid failures.+   * Avoid leaving behind .tmp files when failing in some cases, including+     importing files to a disk that is full.+   * Avoid bad commits after interrupted direct mode sync (or merge).+   * Fix build with wai 0.3.0.+   * Deal with FAT's low resolution timestamps, which in combination with+     Linux's caching of higher res timestamps while a FAT is mounted, caused+     direct mode repositories on FAT to seem to have modified files after+     they were unmounted and remounted.+   * Windows: Fix opening webapp when repository is in a directory with+     spaces in the path.+   * Detect when Windows has lost its mind in a timezone change, and+     automatically apply a delta to the timestamps it returns, to get back to+     sane values."""]]
doc/thanks.mdwn view
@@ -124,7 +124,8 @@ Mica Semrick, Paul Staab, Rémi Vanicat, Martin Holtschneider, Jan Ivar Beddari, Peter Simons, Thomas Koch, Justin Geibel, Guillaume DELVIT, Shanti Bouchez, Oliver Brandt, François Deppierraz, Chad Walstrom, Tim Mattison,-Jakub Antoni Tyszko, Casa do Boneco, and 30 anonymous bitcoin users+Jakub Antoni Tyszko, Casa do Boneco, Florian Tham, +and 30 anonymous bitcoin users  With an especial thanks to the WikiMedia foundation, and Rede Mocambos.
doc/users/anarcat.mdwn view
@@ -46,3 +46,10 @@ Forums where I posted.  [[!inline pages="forum/* and link(users/anarcat)" sort=mtime feeds=no actions=yes archive=yes show=0]]++Git annex dev news+==================++I find the recent changes a little too noisy, but i want more than just the [[news]], so i made up this little hybrid feed:++[[!inline pages="(news/* and !news/*/* and !*/Discussion) or (devblog/* and !devblog/*/*)" feedonly="yes"]]
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20140606+Version: 5.20140613 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -189,7 +189,7 @@   if flag(Webapp)     Build-Depends:      yesod, yesod-default, yesod-static, yesod-form, yesod-core,-     http-types, transformers, wai, wai-logger, warp, warp-tls,+     http-types, transformers, wai, wai-extra, warp, warp-tls,      blaze-builder, crypto-api, hamlet, clientsession,      template-haskell, data-default, aeson, network-conduit,      shakespeare
git-annex.hs view
@@ -48,29 +48,38 @@ 	isshell n = takeFileName n == "git-annex-shell"  #ifdef mingw32_HOST_OS-{- On Windows, if HOME is not set, probe it and set it, re-execing- - git-annex with the new environment.- - +{- On Windows, if HOME is not set, probe it and set it.  - This is a workaround for some Cygwin commands needing HOME to be set,  - and for there being no known way to set environment variables on  - Windows, except by passing an environment in each call to a program.  - While ugly, this workaround is easier than trying to ensure HOME is set  - in all calls to the affected programs.+ -+ - If TZ is set, unset it.+ - TZ being set can interfere with workarounds for Windows timezone+ - horribleness, and prevents getCurrentTimeZone from seeing the system+ - time zone.+ -+ - Due to Windows limitations, have to re-exec git-annex with the new+ - environment.  -} winEnv :: ([String] -> IO ()) -> [String] -> IO ()-winEnv a ps = go =<< getEnv "HOME"+winEnv a ps = do+	e <- getEnvironment+	home <- myHomeDir+	let e' = wantedenv e home+	if (e' /= e)+		then do+			cmd <- readProgramFile+			(_, _, _, pid) <- createProcess (proc cmd ps)+				{ env = Just e' }+			exitWith =<< waitForProcess pid		+		else a ps   where-	go (Just _) = a ps-	go Nothing = do-		home <- myHomeDir-		putStrLn $ "** Windows hack; overrideing HOME to " ++ home-		e <- getEnvironment-		let eoverride =+	wantedenv e home = delEntry "TZ" $ case lookup "HOME" e of+		Nothing -> e +		Just _ -> addEntries 			[ ("HOME", home) 			, ("CYGWIN", "nodosfilewarning")-			]-		cmd <- readProgramFile-		(_, _, _, pid) <- createProcess (proc cmd ps)-			{ env = Just $ e ++ eoverride }-		exitWith =<< waitForProcess pid+			] e #endif
− standalone/android/haskell-patches/skein_hardcode_little-endian.patch 
@@ -1,24 +0,0 @@-From 3a04b41ffce4e4e87b0fedd3a1e3434a3f06cc76 Mon Sep 17 00:00:00 2001-From: foo <foo@bar>-Date: Sun, 22 Sep 2013 00:18:12 +0000-Subject: [PATCH] hardcode little endian------ c_impl/optimized/skein_port.h |    1 +- 1 file changed, 1 insertion(+)--diff --git a/c_impl/optimized/skein_port.h b/c_impl/optimized/skein_port.h-index a2d0fc2..6929bb0 100644---- a/c_impl/optimized/skein_port.h-+++ b/c_impl/optimized/skein_port.h-@@ -45,6 +45,7 @@ typedef uint64_t        u64b_t;             /* 64-bit unsigned integer */-  * platform-specific code instead (e.g., for big-endian CPUs).
-  *
-  */
-+#define SKEIN_NEED_SWAP  (0)
- #ifndef SKEIN_NEED_SWAP /* compile-time "override" for endianness? */
- 
- #include "brg_endian.h"                     /* get endianness selection */
--- -1.7.10.4-
− standalone/android/haskell-patches/vector_hack-to-build-with-new-ghc.patch 
@@ -1,24 +0,0 @@-From b0a79f4f98188ba5d43b7e3912b36d34d099ab65 Mon Sep 17 00:00:00 2001-From: dummy <dummy@example.com>-Date: Fri, 18 Oct 2013 23:20:35 +0000-Subject: [PATCH] cross build------ Data/Vector/Fusion/Stream/Monadic.hs |    1 -- 1 file changed, 1 deletion(-)--diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs-index 51fec75..b089b3d 100644---- a/Data/Vector/Fusion/Stream/Monadic.hs-+++ b/Data/Vector/Fusion/Stream/Monadic.hs-@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) )- - data SPEC = SPEC | SPEC2- #if __GLASGOW_HASKELL__ >= 700--{-# ANN type SPEC ForceSpecConstr #-}- #endif- - emptyStream :: String--- -1.7.10.4-
standalone/linux/install-haskell-packages view
@@ -65,10 +65,12 @@  	patched network 	patched wai-app-static+	patched vector 	patched aeson 	patched shakespeare 	patched yesod-routes 	patched monad-logger+	patched skein 	patched yesod-core 	patched persistent 	patched persistent-template
standalone/no-th/evilsplicer-headers.hs view
@@ -32,6 +32,7 @@ import qualified Yesod.Core.Types import qualified GHC.IO import qualified Data.ByteString.Unsafe+import qualified Data.ByteString.Char8 {- End EvilSplicer headers. -}
standalone/no-th/haskell-patches/file-embed_remove-TH.patch view
@@ -1,17 +1,17 @@-From cd49a96991dc3dd8867038fa9d426a8ccdb25f8d Mon Sep 17 00:00:00 2001-From: Joey Hess <joey@kitenet.net>-Date: Tue, 17 Dec 2013 18:40:48 +0000+From 2b41af230ea5675592e87a2362d9c17bcd8df1db Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Tue, 10 Jun 2014 19:00:44 +0000 Subject: [PATCH] remove TH  ---- Data/FileEmbed.hs | 87 ++++---------------------------------------------------- 1 file changed, 5 insertions(+), 82 deletions(-)+ Data/FileEmbed.hs | 100 +++---------------------------------------------------+ 1 file changed, 5 insertions(+), 95 deletions(-)  diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs-index 5617493..ad92cdc 100644+index aae9d5a..efdbb7b 100644 --- a/Data/FileEmbed.hs +++ b/Data/FileEmbed.hs-@@ -17,13 +17,13 @@+@@ -17,19 +17,18 @@  -- > {-# LANGUAGE TemplateHaskell #-}  module Data.FileEmbed      ( -- * Embed at compile time@@ -30,7 +30,13 @@  #endif      , inject      , injectFile-@@ -56,72 +56,11 @@ import Data.ByteString.Unsafe (unsafePackAddressLen)+       -- * Internal+     , stringToBs+-    , bsToExp+     ) where+ + import Language.Haskell.TH.Syntax+@@ -57,85 +56,12 @@ import Data.ByteString.Unsafe (unsafePackAddressLen)  import System.IO.Unsafe (unsafePerformIO)  import System.FilePath ((</>))  @@ -81,7 +87,7 @@ -    e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp)) -    return $ SigE e typ ----- | Get a directory tree in the IO monad.+ -- | Get a directory tree in the IO monad.  --  -- This is the workhorse of 'embedDir'  getDir :: FilePath -> IO [(FilePath, B.ByteString)]@@ -96,14 +102,27 @@ -    return $! TupE [LitE $ StringL path, exp'] - -bsToExp :: B.ByteString -> Q Exp+-#if MIN_VERSION_template_haskell(2, 5, 0)+-bsToExp bs =+-    return $ VarE 'unsafePerformIO+-      `AppE` (VarE 'unsafePackAddressLen+-      `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)+-#if MIN_VERSION_template_haskell(2, 8, 0)+-      `AppE` LitE (StringPrimL $ B.unpack bs))+-#else+-      `AppE` LitE (StringPrimL $ B8.unpack bs))+-#endif+-#else -bsToExp bs = do -    helper <- [| stringToBs |] -    let chars = B8.unpack bs -    return $! AppE helper $! LitE $! StringL chars- +-#endif+-  stringToBs :: String -> B.ByteString  stringToBs = B8.pack-@@ -164,22 +103,6 @@ padSize i =+ +@@ -177,22 +103,6 @@ padSize i =      let s = show i       in replicate (sizeLen - length s) '0' ++ s  @@ -127,5 +146,5 @@  inject :: B.ByteString -- ^ bs to inject         -> B.ByteString -- ^ original BS containing dummy -- -1.8.5.1+2.0.0
standalone/no-th/haskell-patches/lens_no-TH.patch view
@@ -1,21 +1,20 @@-From 2109923a879a02c8a79e8e08573bf9e500d8afc8 Mon Sep 17 00:00:00 2001+From bc312c7431877b3b788de5e7ce5ee743be73c0ba Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Wed, 21 May 2014 16:25:06 +0000-Subject: [PATCH] remove  TH+Date: Tue, 10 Jun 2014 22:13:58 +0000+Subject: [PATCH] remove TH  ---- lens.cabal                              | 20 +-------------------- src/Control/Lens.hs                     |  8 ++------- src/Control/Lens/Cons.hs                |  2 --- src/Control/Lens/Internal/Fold.hs       |  2 --- src/Control/Lens/Internal/Reflection.hs |  2 --- src/Control/Lens/Operators.hs           |  2 +-- src/Control/Lens/Prism.hs               |  2 --- src/Control/Monad/Primitive/Lens.hs     |  1 -- 8 files changed, 4 insertions(+), 35 deletions(-)+ lens.cabal                          | 19 +------------------+ src/Control/Lens.hs                 |  8 ++------+ src/Control/Lens/Cons.hs            |  2 --+ src/Control/Lens/Internal/Fold.hs   |  2 --+ src/Control/Lens/Operators.hs       |  2 +-+ src/Control/Lens/Prism.hs           |  2 --+ src/Control/Monad/Primitive/Lens.hs |  1 -+ 7 files changed, 4 insertions(+), 32 deletions(-)  diff --git a/lens.cabal b/lens.cabal-index 03f64f5..3f6f6d2 100644+index d70c2f4..28af768 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability:     provisional@@ -25,17 +24,9 @@ -build-type:    Custom +build-type:    Simple  -- build-tools:   cpphs- tested-with:   GHC == 7.6.3+ tested-with:   GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1, GHC == 7.8.2  synopsis:      Lenses, Folds and Traversals-@@ -182,7 +182,6 @@ flag j- - library-   build-depends:--    aeson                     >= 0.7      && < 0.8,-     array                     >= 0.3.0.2  && < 0.6,-     base                      >= 4.3      && < 5,-     bifunctors                >= 4        && < 5,-@@ -221,7 +220,6 @@ library+@@ -220,7 +220,6 @@ library      Control.Exception.Lens      Control.Lens      Control.Lens.Action@@ -43,7 +34,7 @@      Control.Lens.Combinators      Control.Lens.Cons      Control.Lens.Each-@@ -249,29 +247,24 @@ library+@@ -248,29 +247,24 @@ library      Control.Lens.Internal.Reflection      Control.Lens.Internal.Review      Control.Lens.Internal.Setter@@ -73,7 +64,7 @@      Data.Array.Lens      Data.Bits.Lens      Data.ByteString.Lens-@@ -294,17 +287,10 @@ library+@@ -293,17 +287,10 @@ library      Data.Typeable.Lens      Data.Vector.Lens      Data.Vector.Generic.Lens@@ -91,7 +82,7 @@    cpp-options: -traditional      if flag(safe)-@@ -406,7 +392,6 @@ test-suite doctests+@@ -405,7 +392,6 @@ test-suite doctests        deepseq,        doctest        >= 0.9.1,        filepath,@@ -99,7 +90,7 @@        mtl,        nats,        parallel,-@@ -444,7 +429,6 @@ benchmark plated+@@ -443,7 +429,6 @@ benchmark plated      comonad,      criterion,      deepseq,@@ -107,7 +98,7 @@      lens,      transformers  -@@ -479,7 +463,6 @@ benchmark unsafe+@@ -478,7 +463,6 @@ benchmark unsafe      comonads-fd,      criterion,      deepseq,@@ -115,7 +106,7 @@      lens,      transformers  -@@ -496,6 +479,5 @@ benchmark zipper+@@ -495,6 +479,5 @@ benchmark zipper      comonads-fd,      criterion,      deepseq,@@ -196,19 +187,6 @@  ------------------------------------------------------------------------------  -- Folding  -------------------------------------------------------------------------------diff --git a/src/Control/Lens/Internal/Reflection.hs b/src/Control/Lens/Internal/Reflection.hs-index bf09f2c..c9e112f 100644---- a/src/Control/Lens/Internal/Reflection.hs-+++ b/src/Control/Lens/Internal/Reflection.hs-@@ -64,8 +64,6 @@ import Data.Word- import Data.Typeable- import Data.Reflection- --{-# ANN module "HLint: ignore Avoid lambda" #-}--- class Typeable s => B s where-   reflectByte :: proxy s -> IntPtr-  diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs index 9992e63..631e8e6 100644 --- a/src/Control/Lens/Operators.hs@@ -248,5 +226,5 @@  prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))  prim = iso internal primitive -- -2.0.0.rc2+2.0.0
+ standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch view
@@ -0,0 +1,26 @@+From 3a04b41ffce4e4e87b0fedd3a1e3434a3f06cc76 Mon Sep 17 00:00:00 2001+From: foo <foo@bar>+Date: Sun, 22 Sep 2013 00:18:12 +0000+Subject: [PATCH] hardcode little endian++This is the same as building with a cabal flag.++---+ c_impl/optimized/skein_port.h |    1 ++ 1 file changed, 1 insertion(+)++diff --git a/c_impl/optimized/skein_port.h b/c_impl/optimized/skein_port.h+index a2d0fc2..6929bb0 100644+--- a/c_impl/optimized/skein_port.h++++ b/c_impl/optimized/skein_port.h+@@ -45,6 +45,7 @@ typedef uint64_t        u64b_t;             /* 64-bit unsigned integer */+  * platform-specific code instead (e.g., for big-endian CPUs).
+  *
+  */
++#define SKEIN_NEED_SWAP  (0)
+ #ifndef SKEIN_NEED_SWAP /* compile-time "override" for endianness? */
+ 
+ #include "brg_endian.h"                     /* get endianness selection */
+-- +1.7.10.4+
+ standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch view
@@ -0,0 +1,24 @@+From b0a79f4f98188ba5d43b7e3912b36d34d099ab65 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Fri, 18 Oct 2013 23:20:35 +0000+Subject: [PATCH] cross build++---+ Data/Vector/Fusion/Stream/Monadic.hs |    1 -+ 1 file changed, 1 deletion(-)++diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs+index 51fec75..b089b3d 100644+--- a/Data/Vector/Fusion/Stream/Monadic.hs++++ b/Data/Vector/Fusion/Stream/Monadic.hs+@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) )+ + data SPEC = SPEC | SPEC2+ #if __GLASGOW_HASKELL__ >= 700+-{-# ANN type SPEC ForceSpecConstr #-}+ #endif+ + emptyStream :: String+-- +1.7.10.4+
standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch view
@@ -1,6 +1,6 @@-From 685d4d9fbb929ed1356f8346f573e187746aee4b Mon Sep 17 00:00:00 2001-From: Joey Hess <joey@kitenet.net>-Date: Thu, 22 May 2014 16:29:20 -0400+From 3aef808eee43c973ae1fbf6e8769d89b7f0d355b Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Tue, 10 Jun 2014 14:47:42 +0000 Subject: [PATCH] deal with TH  Export modules referenced by it.@@ -14,7 +14,7 @@  3 files changed, 5 insertions(+), 11 deletions(-)  diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs-index f2fa743..1a82b30 100644+index db2b835..b2c1aec 100644 --- a/Network/Wai/Application/Static.hs +++ b/Network/Wai/Application/Static.hs @@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)@@ -26,13 +26,13 @@  import Data.Text (Text)  import qualified Data.Text as T  -@@ -198,8 +196,6 @@ staticAppPieces _ _ req+@@ -198,8 +196,6 @@ staticAppPieces _ _ req sendResponse          H.status405          [("Content-Type", "text/plain")]          "Only GET is supported"--staticAppPieces _ [".hidden", "folder.png"] _  = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]--staticAppPieces _ [".hidden", "haskell.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]- staticAppPieces ss rawPieces req = liftIO $ do+-staticAppPieces _ [".hidden", "folder.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]+-staticAppPieces _ [".hidden", "haskell.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]+ staticAppPieces ss rawPieces req sendResponse = liftIO $ do      case toPieces rawPieces of          Just pieces -> checkPieces ss pieces req >>= response diff --git a/WaiAppStatic/Storage/Embedded.hs b/WaiAppStatic/Storage/Embedded.hs@@ -55,7 +55,7 @@ -import WaiAppStatic.Storage.Embedded.TH +--import WaiAppStatic.Storage.Embedded.TH diff --git a/wai-app-static.cabal b/wai-app-static.cabal-index 925d350..e5d11a6 100644+index ef6f898..9a59d71 100644 --- a/wai-app-static.cabal +++ b/wai-app-static.cabal @@ -33,7 +33,6 @@ library@@ -66,7 +66,7 @@                     , text                      >= 0.7                     , blaze-builder             >= 0.2.1.4                     , base64-bytestring         >= 0.1-@@ -60,9 +59,8 @@ library+@@ -61,9 +60,8 @@ library                       WaiAppStatic.Listing                       WaiAppStatic.Types                       WaiAppStatic.CmdLine@@ -78,5 +78,5 @@      extensions:     CPP   -- -2.0.0.rc2+2.0.0
standalone/no-th/haskell-patches/yesod-auth_don-t-really-build.patch view
@@ -1,19 +1,19 @@-From 9a8637661270d3c6a15e6aeca5e8983fe126bd27 Mon Sep 17 00:00:00 2001+From 583575461dc58b76c6c7e14d429f73182d49ef81 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Wed, 21 May 2014 05:27:36 +0000+Date: Tue, 10 Jun 2014 20:29:51 +0000 Subject: [PATCH] don't really build  ---- yesod-auth.cabal | 10 ----------- 1 file changed, 10 deletions(-)+ yesod-auth.cabal | 11 -----------+ 1 file changed, 11 deletions(-)  diff --git a/yesod-auth.cabal b/yesod-auth.cabal-index 0872581..723cde0 100644+index 906c08b..b4bc841 100644 --- a/yesod-auth.cabal +++ b/yesod-auth.cabal-@@ -60,16 +60,6 @@ library-                    , byteable-                    , binary+@@ -65,17 +65,6 @@ library+                    , conduit-extra+                    , attoparsec-conduit   -    exposed-modules: Yesod.Auth -                     Yesod.Auth.BrowserId@@ -23,11 +23,12 @@ -                     Yesod.Auth.Rpxnow -                     Yesod.Auth.Message -                     Yesod.Auth.GoogleEmail+-                     Yesod.Auth.GoogleEmail2 -    other-modules:   Yesod.Auth.Routes -                     Yesod.PasswordStore      ghc-options:     -Wall    source-repository head -- -2.0.0.rc2+2.0.0
standalone/no-th/haskell-patches/yesod-core_expand_TH.patch view
@@ -1,6 +1,6 @@-From ccea70b3cb02c3a9e7fa43ebfbfcfdda76f9307f Mon Sep 17 00:00:00 2001+From 9feb37d13dc8449dc4445db83485780caee4b7ff Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Wed, 21 May 2014 03:51:16 +0000+Date: Tue, 10 Jun 2014 17:44:52 +0000 Subject: [PATCH] expand and remove TH  ---@@ -408,7 +408,7 @@ -    char = show . snd . loc_start +fileLocationToString loc = "unknown" diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs-index 59663a8..9408a95 100644+index e0d1f0e..cc23fdd 100644 --- a/Yesod/Core/Dispatch.hs +++ b/Yesod/Core/Dispatch.hs @@ -1,4 +1,3 @@@@ -445,7 +445,7 @@      , PathMultiPiece (..)      , Texts        -- * Convert to WAI-@@ -130,13 +129,6 @@ toWaiAppLogger logger site = do+@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do                  , yreSite = site                  , yreSessionBackend = sb                  }@@ -459,7 +459,7 @@      middleware <- mkDefaultMiddlewares logger      return $ middleware $ toWaiAppYre yre  -@@ -165,14 +157,7 @@ warp port site = do+@@ -170,14 +162,7 @@ warp port site = do                  ]              -}              , Network.Wai.Handler.Warp.settingsOnException = const $ \e ->@@ -475,7 +475,7 @@              }    where      shouldLog' =-@@ -206,7 +191,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr+@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr  -- | Deprecated synonym for 'warp'.  warpDebug :: YesodDispatch site => Int -> site -> IO ()  warpDebug = warp@@ -484,10 +484,10 @@  -- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It  -- reads port information from the PORT environment variable, as used by tools diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs-index e5cbc44..db7c097 100644+index 2e5d7cb..83f93bf 100644 --- a/Yesod/Core/Handler.hs +++ b/Yesod/Core/Handler.hs-@@ -169,7 +169,7 @@ import           Data.Text.Encoding            (decodeUtf8With, encodeUtf8)+@@ -172,7 +172,7 @@ import           Data.Text.Encoding            (decodeUtf8With, encodeUtf8)  import           Data.Text.Encoding.Error      (lenientDecode)  import qualified Data.Text.Lazy                as TL  import qualified Text.Blaze.Html.Renderer.Text as RenderText@@ -496,15 +496,15 @@    import qualified Data.ByteString               as S  import qualified Data.ByteString.Lazy          as L-@@ -198,6 +198,7 @@ import Control.Exception (throwIO)+@@ -201,6 +201,7 @@ import Control.Exception (throwIO)  import Blaze.ByteString.Builder (Builder)  import Safe (headMay)  import Data.CaseInsensitive (CI) +import qualified Text.Blaze.Internal+ import qualified Data.Conduit.List as CL+ import Control.Monad (unless)  import           Control.Monad.Trans.Resource  (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO- #if MIN_VERSION_wai(2, 0, 0)- #else-@@ -806,19 +807,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)+@@ -847,19 +848,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)                 -> m a  redirectToPost url = do      urlText <- toTextUrl url@@ -534,7 +534,7 @@  -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.  hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs-index 3e2e4e0..b92eadb 100644+index 09b4609..e1ef568 100644 --- a/Yesod/Core/Internal/Run.hs +++ b/Yesod/Core/Internal/Run.hs @@ -16,8 +16,8 @@ import           Control.Exception.Lifted     (catch)@@ -767,5 +767,5 @@  ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)                   => HtmlUrlI18n message (Route (HandlerSite m)) -- -2.0.0.rc2+2.0.0
standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch view
@@ -1,6 +1,6 @@-From b232effd092b03c6ad4235e5aa0c5750461af02d Mon Sep 17 00:00:00 2001+From 92a34bc2b09572a58a4e696e0d8a0a61475535f7 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Wed, 21 May 2014 04:47:44 +0000+Date: Tue, 10 Jun 2014 19:09:56 +0000 Subject: [PATCH] do not really build  ---@@ -8,7 +8,7 @@  1 file changed, 10 deletions(-)  diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal-index 3560dd9..d01be4a 100644+index b44499b..ef33863 100644 --- a/yesod-persistent.cabal +++ b/yesod-persistent.cabal @@ -14,16 +14,6 @@ description:     Some helpers for using Persistent from Yesod.@@ -18,7 +18,7 @@ -                   , yesod-core                >= 1.2.2    && < 1.3 -                   , persistent                >= 1.2      && < 1.4 -                   , persistent-template       >= 1.2      && < 1.4--                   , transformers              >= 0.2.2    && < 0.4+-                   , transformers              >= 0.2.2 -                   , blaze-builder -                   , conduit -                   , resourcet                 >= 0.4.5@@ -29,5 +29,5 @@    test-suite test -- -2.0.0.rc2+2.0.0
standalone/no-th/haskell-patches/yesod_hack-TH.patch view
@@ -1,13 +1,13 @@-From 86264ab2a76568585cacca9145e440d6c06edbe3 Mon Sep 17 00:00:00 2001+From da032b804c0a35c2831664e28c9211f4fe712593 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Wed, 21 May 2014 06:30:03 +0000+Date: Tue, 10 Jun 2014 20:39:42 +0000 Subject: [PATCH] avoid TH  ---  Yesod.hs              | 19 ++++++++++++--- Yesod/Default/Main.hs | 31 +----------------------+ Yesod/Default/Main.hs | 32 +-----------------------  Yesod/Default/Util.hs | 69 ++-------------------------------------------------- 3 files changed, 20 insertions(+), 99 deletions(-)+ 3 files changed, 20 insertions(+), 100 deletions(-)  diff --git a/Yesod.hs b/Yesod.hs index b367144..fbe309c 100644@@ -41,7 +41,7 @@ +insert = undefined + diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs-index e273de2..bf46642 100644+index 565ed35..41c2df0 100644 --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -1,10 +1,8 @@@@ -64,7 +64,7 @@  import System.Log.FastLogger (LogStr, toLogStr)  import Language.Haskell.TH.Syntax (qLocation)  -@@ -55,33 +53,6 @@ defaultMain load getApp = do+@@ -55,34 +53,6 @@ defaultMain load getApp = do    type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()  @@ -90,14 +90,15 @@ -        } app -  where -    shouldLog' =--#if MIN_VERSION_wai(2,1,3)+-#if MIN_VERSION_warp(2,1,3) -        Warp.defaultShouldDisplayException -#else -        const True -#endif- +-  -- | Run your application continously, listening for SIGINT and exiting  --   when received+ -- diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs index a10358e..0547424 100644 --- a/Yesod/Default/Util.hs@@ -195,5 +196,5 @@ -                else return $ Just ex -        else return Nothing -- -2.0.0.rc2+2.0.0
static/css/bootstrap-theme.css view
static/css/bootstrap.css view
static/js/bootstrap.js view
static/js/jquery.full.js view
static/js/jquery.ui.core.js view
static/js/jquery.ui.mouse.js view
static/js/jquery.ui.sortable.js view
static/js/jquery.ui.widget.js view
static/js/longpolling.js view
@@ -44,5 +44,3 @@ 		} 	}); }--//EOF