packages feed

git-annex 5.20140116 → 5.20140127

raw patch · 205 files changed

+4329/−2222 lines, 205 filesdep +optparse-applicativedep ~tastybinary-added

Dependencies added: optparse-applicative

Dependency ranges changed: tasty

Files

.gitignore view
@@ -28,3 +28,4 @@ # OSX related .DS_Store .virthualenv+.tasty-rerun-log
+ .mailmap view
@@ -0,0 +1,6 @@+Joey Hess <joey@kitenet.net> http://joey.kitenet.net/ <joey@web>+Joey Hess <joey@kitenet.net> http://joeyh.name/ <joey@web>+Joey Hess <joey@kitenet.net> http://joeyh.name/ <http://joeyh.name/@web>+Yaroslav Halchenko <debian@onerussian.com>+Yaroslav Halchenko <debian@onerussian.com> http://yarikoptic.myopenid.com/ <site-myopenid@web>+Yaroslav Halchenko <debian@onerussian.com> https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY <Yaroslav@web>
Annex.hs view
@@ -46,6 +46,7 @@ import Git.CheckIgnore import Git.SharedRepository import qualified Git.Queue+import Types.Key import Types.Backend import Types.GitConfig import qualified Types.Remote@@ -56,6 +57,7 @@ import Types.Messages import Types.UUID import Types.FileMatcher+import Types.NumCopies import qualified Utility.Matcher import qualified Data.Map as M import qualified Data.Set as S@@ -75,7 +77,7 @@ 	)  type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a)-type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> FileInfo -> Annex Bool))+type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> MatchInfo -> Annex Bool))  -- internal state storage data AnnexState = AnnexState@@ -94,8 +96,9 @@ 	, checkattrhandle :: Maybe CheckAttrHandle 	, checkignorehandle :: Maybe (Maybe CheckIgnoreHandle) 	, forcebackend :: Maybe String-	, forcenumcopies :: Maybe Int-	, limit :: Matcher (FileInfo -> Annex Bool)+	, globalnumcopies :: Maybe NumCopies+	, forcenumcopies :: Maybe NumCopies+	, limit :: Matcher (MatchInfo -> Annex Bool) 	, uuidmap :: Maybe UUIDMap 	, preferredcontentmap :: Maybe PreferredContentMap 	, shared :: Maybe SharedRepository@@ -109,6 +112,8 @@ 	, cleanup :: M.Map String (Annex ()) 	, inodeschanged :: Maybe Bool 	, useragent :: Maybe String+	, errcounter :: Integer+	, unusedkeys :: Maybe (S.Set Key) 	}  newState :: GitConfig -> Git.Repo -> AnnexState@@ -128,6 +133,7 @@ 	, checkattrhandle = Nothing 	, checkignorehandle = Nothing 	, forcebackend = Nothing+	, globalnumcopies = Nothing 	, forcenumcopies = Nothing 	, limit = Left [] 	, uuidmap = Nothing@@ -143,6 +149,8 @@ 	, cleanup = M.empty 	, inodeschanged = Nothing 	, useragent = Nothing+	, errcounter = 0+	, unusedkeys = Nothing 	}  {- Makes an Annex state object for the specified git repo.
Annex/Branch.hs view
@@ -252,8 +252,7 @@ 	committedref <- inRepo $ Git.Branch.commitAlways message fullname parents 	setIndexSha committedref 	parentrefs <- commitparents <$> catObject committedref-	when (racedetected branchref parentrefs) $ do-		liftIO $ print ("race detected", branchref, parentrefs, "committing", (branchref, parents))+	when (racedetected branchref parentrefs) $ 		fixrace committedref parentrefs   where 	-- look for "parent ref" lines and return the refs
Annex/Branch/Transitions.hs view
@@ -41,6 +41,7 @@ 		in if null newlog 			then RemoveFile 			else ChangeFile $ Presence.showLog newlog+	Just SingleValueLog -> PreserveFile 	Nothing -> PreserveFile  dropDeadFromUUIDBasedLog :: TrustMap -> UUIDBased.Log String -> UUIDBased.Log String
Annex/Content.hs view
@@ -377,6 +377,7 @@ removeAnnex key = withObjectLoc key remove removedirect   where 	remove file = cleanObjectLoc key $ do+		secureErase file 		liftIO $ nukeFile file 		removeInodeCache key 	removedirect fs = do@@ -389,7 +390,18 @@ 		cwd <- liftIO getCurrentDirectory 		let top' = fromMaybe top $ absNormPath cwd top 		let l' = relPathDirToFile top' (fromMaybe l $ absNormPath top' l)+		secureErase f 		replaceFile f $ makeAnnexLink l'++{- Runs the secure erase command if set, otherwise does nothing.+ - File may or may not be deleted at the end; caller is responsible for+ - making sure it's deleted. -}+secureErase :: FilePath -> Annex ()+secureErase file = maybe noop go =<< annexSecureEraseCommand <$> Annex.getGitConfig+  where+  	go basecmd = void $ liftIO $+		boolSystem "sh" [Param "-c", Param $ gencmd basecmd]+	gencmd = massReplace [ ("%file", shellEscape file) ]  {- Moves a key's file out of .git/annex/objects/ -} fromAnnex :: Key -> FilePath -> Annex ()
+ Annex/Drop.hs view
@@ -0,0 +1,124 @@+{- dropping of unwanted content+ -+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.Drop where++import Common.Annex+import Logs.Trust+import Config.NumCopies+import Types.Remote (uuid)+import Types.Key (key2file)+import qualified Remote+import qualified Command.Drop+import Command+import Annex.Wanted+import Annex.Exception+import Config+import Annex.Content.Direct++import qualified Data.Set as S+import System.Log.Logger (debugM)++type Reason = String++{- Drop a key from local and/or remote when allowed by the preferred content+ - and numcopies settings.+ -+ - The UUIDs are ones where the content is believed to be present.+ - The Remote list can include other remotes that do not have the content;+ - only ones that match the UUIDs will be dropped from.+ - If allowed to drop fromhere, that drop will be tried first.+ -+ - A remote can be specified that is known to have the key. This can be+ - used an an optimisation when eg, a key has just been uploaded to a+ - remote.+ -+ - In direct mode, all associated files are checked, and only if all+ - of them are unwanted are they dropped.+ -+ - The runner is used to run commands, and so can be either callCommand+ - or commandAction.+ -}+handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> CommandActionRunner -> Annex ()+handleDropsFrom locs rs reason fromhere key afile knownpresentremote runner = do+	fs <- ifM isDirect+		( do+			l <- associatedFilesRelative key+			if null l+				then return $ maybe [] (:[]) afile+				else return l+		, return $ maybe [] (:[]) afile+		)+	n <- getcopies fs+	if fromhere && checkcopies n Nothing+		then go fs rs =<< dropl fs n+		else go fs rs n+  where+	getcopies fs = do+		(untrusted, have) <- trustPartition UnTrusted locs+		numcopies <- if null fs+			then getNumCopies+			else maximum <$> mapM getFileNumCopies fs+		return (NumCopies (length have), numcopies, S.fromList untrusted)++	{- Check that we have enough copies still to drop the content.+	 - When the remote being dropped from is untrusted, it was not+	 - counted as a copy, so having only numcopies suffices. Otherwise,+	 - we need more than numcopies to safely drop. -}+	checkcopies (have, numcopies, _untrusted) Nothing = have > numcopies+	checkcopies (have, numcopies, untrusted) (Just u)+		| S.member u untrusted = have >= numcopies+		| otherwise = have > numcopies+	+	decrcopies (have, numcopies, untrusted) Nothing =+		(NumCopies (fromNumCopies have - 1), numcopies, untrusted)+	decrcopies v@(_have, _numcopies, untrusted) (Just u)+		| S.member u untrusted = v+		| otherwise = decrcopies v Nothing++	go _ [] _ = noop+	go fs (r:rest) n+		| uuid r `S.notMember` slocs = go fs rest n+		| checkcopies n (Just $ Remote.uuid r) =+			dropr fs r n >>= go fs rest+		| otherwise = noop++	checkdrop fs n u a+		| null fs = check $ -- no associated files; unused content+			wantDrop True u (Just key) Nothing+		| otherwise = check $+			allM (wantDrop True u (Just key) . Just) fs+		where+			check c = ifM c+				( dodrop n u a+				, return n+				)++	dodrop n@(have, numcopies, _untrusted) u a = +		ifM (safely $ runner $ a numcopies)+			( do+				liftIO $ debugM "drop" $ unwords+					[ "dropped"+					, fromMaybe (key2file key) afile+					, "(from " ++ maybe "here" show u ++ ")"+					, "(copies now " ++ show (fromNumCopies have - 1) ++ ")"+					, ": " ++ reason+					]+				return $ decrcopies n u+			, return n+			)++	dropl fs n = checkdrop fs n Nothing $ \numcopies ->+		Command.Drop.startLocal afile numcopies key knownpresentremote++	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->+		Command.Drop.startRemote afile numcopies key r++	slocs = S.fromList locs+	+	safely a = either (const False) id <$> tryAnnex a+
Annex/FileMatcher.hs view
@@ -1,6 +1,6 @@ {- git-annex file matching  -- - 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.  -}@@ -28,19 +28,26 @@ type FileMatcher = Matcher MatchFiles  checkFileMatcher :: FileMatcher -> FilePath -> Annex Bool-checkFileMatcher matcher file = checkFileMatcher' matcher file S.empty True+checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True -checkFileMatcher' :: FileMatcher -> FilePath -> AssumeNotPresent -> Bool -> Annex Bool-checkFileMatcher' matcher file notpresent def+checkMatcher :: FileMatcher -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool+checkMatcher matcher mkey afile notpresent def 	| isEmpty matcher = return def-	| otherwise = do-		matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)-		let fi = FileInfo-			{ matchFile = matchfile-			, relFile = file-			}-		matchMrun matcher $ \a -> a notpresent fi+	| otherwise = case (mkey, afile) of+		(_, Just file) -> go =<< fileMatchInfo file+		(Just key, _) -> go (MatchingKey key)+		_ -> return def+  where+	go mi = matchMrun matcher $ \a -> a notpresent mi +fileMatchInfo :: FilePath -> Annex MatchInfo+fileMatchInfo file = do+	matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)+	return $ MatchingFile $ FileInfo+		{ matchFile = matchfile+		, relFile = file+		}+ matchAll :: FileMatcher matchAll = generate [] @@ -65,11 +72,14 @@ 	| t `elem` tokens = Right $ token t 	| t == "present" = use checkpresent 	| t == "inpreferreddir" = use checkpreferreddir+	| t == "unused" = Right (Operation limitUnused) 	| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k $ 		M.fromList 			[ ("include", limitInclude) 			, ("exclude", limitExclude) 			, ("copies", limitCopies)+			, ("lackingcopies", limitLackingCopies False)+			, ("approxlackingcopies", limitLackingCopies True) 			, ("inbackend", limitInBackend) 			, ("largerthan", limitSize (>)) 			, ("smallerthan", limitSize (<))
+ Annex/Init.hs view
@@ -0,0 +1,240 @@+{- git-annex repository initialization+ -+ - Copyright 2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Annex.Init (+	ensureInitialized,+	isInitialized,+	initialize,+	uninitialize,+	probeCrippledFileSystem,+) where++import Common.Annex+import Utility.Network+import qualified Annex+import qualified Git+import qualified Git.LsFiles+import qualified Git.Config+import qualified Git.Construct+import qualified Git.Types as Git+import qualified Annex.Branch+import Logs.UUID+import Annex.Version+import Annex.UUID+import Config+import Annex.Direct+import Annex.Content.Direct+import Annex.Environment+import Annex.Perms+import Backend+#ifndef mingw32_HOST_OS+import Utility.UserInfo+import Utility.FileMode+#endif+import Annex.Hook+import Git.Hook (hookFile)+import Upgrade+import Annex.Content+import Logs.Location++import System.Log.Logger++genDescription :: Maybe String -> Annex String+genDescription (Just d) = return d+genDescription Nothing = do+	reldir <- liftIO . relHome =<< fromRepo Git.repoPath+	hostname <- fromMaybe "" <$> liftIO getHostname+#ifndef mingw32_HOST_OS+	let at = if null hostname then "" else "@"+	username <- liftIO myUserName+	return $ concat [username, at, hostname, ":", reldir]+#else+	return $ concat [hostname, ":", reldir]+#endif++initialize :: Maybe String -> Annex ()+initialize mdescription = do+	prepUUID+	checkFifoSupport+	checkCrippledFileSystem+	unlessM isBare $+		hookWrite preCommitHook+	setVersion supportedVersion+	ifM (crippledFileSystem <&&> not <$> isBare)+		( do+			enableDirectMode+			setDirect True+		, do+			-- Handle case where this repo was cloned from a+			-- direct mode repo.+			unlessM isBare+				switchHEADBack+		)+	createInodeSentinalFile+	u <- getUUID+	{- This will make the first commit to git, so ensure git is set up+	 - properly to allow commits when running it. -}+	ensureCommit $ do+		Annex.Branch.create+		describeUUID u =<< genDescription mdescription++uninitialize :: Annex ()+uninitialize = do+	hookUnWrite preCommitHook+	removeRepoUUID+	removeVersion++{- Will automatically initialize if there is already a git-annex+ - branch from somewhere. Otherwise, require a manual init+ - to avoid git-annex accidentially being run in git+ - repos that did not intend to use it.+ -+ - Checks repository version and handles upgrades too.+ -}+ensureInitialized :: Annex ()+ensureInitialized = do+	getVersion >>= maybe needsinit checkUpgrade+	fixBadBare+  where+	needsinit = ifM Annex.Branch.hasSibling+			( initialize Nothing+			, error "First run: git-annex init"+			)++{- Checks if a repository is initialized. Does not check version for ugrade. -}+isInitialized :: Annex Bool+isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion++isBare :: Annex Bool+isBare = fromRepo Git.repoIsLocalBare++{- A crippled filesystem is one that does not allow making symlinks,+ - or removing write access from files. -}+probeCrippledFileSystem :: Annex Bool+probeCrippledFileSystem = do+#ifdef mingw32_HOST_OS+	return True+#else+	tmp <- fromRepo gitAnnexTmpDir+	let f = tmp </> "gaprobe"+	createAnnexDirectory tmp+	liftIO $ writeFile f ""+	uncrippled <- liftIO $ probe f+	liftIO $ removeFile f+	return $ not uncrippled+  where+	probe f = catchBoolIO $ do+		let f2 = f ++ "2"+		nukeFile f2+		createSymbolicLink f f2+		nukeFile f2+		preventWrite f+		allowWrite f+		return True+#endif++checkCrippledFileSystem :: Annex ()+checkCrippledFileSystem = whenM probeCrippledFileSystem $ do+	warning "Detected a crippled filesystem."+	setCrippledFileSystem True++	{- Normally git disables core.symlinks itself when the+	 - filesystem does not support them, but in Cygwin, git+	 - does support symlinks, while git-annex, not linking+	 - with Cygwin, does not. -}+	whenM (coreSymlinks <$> Annex.getGitConfig) $ do+		warning "Disabling core.symlinks."+		setConfig (ConfigKey "core.symlinks")+			(Git.Config.boolConfig False)++probeFifoSupport :: Annex Bool+probeFifoSupport = do+#ifdef mingw32_HOST_OS+	return False+#else+	tmp <- fromRepo gitAnnexTmpDir+	let f = tmp </> "gaprobe"+	createAnnexDirectory tmp+	liftIO $ do+		nukeFile f+		ms <- tryIO $ do+			createNamedPipe f ownerReadMode+			getFileStatus f+		nukeFile f+		return $ either (const False) isNamedPipe ms+#endif++checkFifoSupport :: Annex ()+checkFifoSupport = unlessM probeFifoSupport $ do+	warning "Detected a filesystem without fifo support."+	warning "Disabling ssh connection caching."+	setConfig (annexConfig "sshcaching") (Git.Config.boolConfig False)++enableDirectMode :: Annex ()+enableDirectMode = unlessM isDirect $ do+	warning "Enabling direct mode."+	top <- fromRepo Git.repoPath+	(l, clean) <- inRepo $ Git.LsFiles.inRepo [top]+	forM_ l $ \f ->+		maybe noop (`toDirect` f) =<< isAnnexLink f+	void $ liftIO clean++{- Work around for git-annex version 5.20131118 - 5.20131127, which+ - had a bug that unset core.bare when initializing a bare repository.+ - + - This resulted in objects sent to the repository being stored in + - repo/.git/annex/objects, so move them to repo/annex/objects.+ -+ - This check slows down every git-annex run somewhat (by one file stat),+ - so should be removed after a suitable period of time has passed.+ - Since the bare repository may be on an offline USB drive, best to+ - keep it for a while. However, git-annex was only buggy for a few+ - weeks, so not too long.+ -}+fixBadBare :: Annex ()+fixBadBare = whenM checkBadBare $ do+	ks <- getKeysPresent+	liftIO $ debugM "Init" $ unwords+		[ "Detected bad bare repository with"+		, show (length ks)+		, "objects; fixing"+		]+	g <- Annex.gitRepo+	gc <- Annex.getGitConfig+	d <- Git.repoPath <$> Annex.gitRepo+	void $ liftIO $ boolSystem "git"+		[ Param $ "--git-dir=" ++ d+		, Param "config"+		, Param Git.Config.coreBare+		, Param $ Git.Config.boolConfig True+		]+	g' <- liftIO $ Git.Construct.fromPath d+	s' <- liftIO $ Annex.new $ g' { Git.location = Git.Local { Git.gitdir = d, Git.worktree = Nothing } }+	Annex.changeState $ \s -> s+		{ Annex.repo = Annex.repo s'+		, Annex.gitconfig = Annex.gitconfig s'+		}+	forM_ ks $ \k -> do+		oldloc <- liftIO $ gitAnnexLocation k g gc+		thawContentDir oldloc+		moveAnnex k oldloc+		logStatus k InfoPresent+	let dotgit = d </> ".git"+	liftIO $ removeDirectoryRecursive dotgit+		`catchIO` (const $ renameDirectory dotgit (d </> "removeme"))++{- A repostory with the problem won't know it's a bare repository, but will+ - have no pre-commit hook (which is not set up in a bare repository),+ - and will not have a HEAD file in its .git directory. -}+checkBadBare :: Annex Bool+checkBadBare = allM (not <$>)+	[isBare, hasPreCommitHook, hasDotGitHEAD]+  where+	hasPreCommitHook = inRepo $ doesFileExist . hookFile preCommitHook+	hasDotGitHEAD = inRepo $ \r -> doesFileExist $ Git.localGitDir r </> "HEAD"
Annex/Wanted.hs view
@@ -14,19 +14,16 @@ import qualified Data.Set as S  {- Check if a file is preferred content for the local repository. -}-wantGet :: Bool -> AssociatedFile -> Annex Bool-wantGet def Nothing = return def-wantGet def (Just file) = isPreferredContent Nothing S.empty file def+wantGet :: Bool -> Maybe Key -> AssociatedFile -> Annex Bool+wantGet def key file = isPreferredContent Nothing S.empty key file def  {- Check if a file is preferred content for a remote. -}-wantSend :: Bool -> AssociatedFile -> UUID -> Annex Bool-wantSend def Nothing _ = return def-wantSend def (Just file) to = isPreferredContent (Just to) S.empty file def+wantSend :: Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool+wantSend def key file to = isPreferredContent (Just to) S.empty key file def  {- Check if a file can be dropped, maybe from a remote.  - Don't drop files that are preferred content. -}-wantDrop :: Bool -> Maybe UUID -> AssociatedFile -> Annex Bool-wantDrop def _ Nothing = return $ not def-wantDrop def from (Just file) = do+wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> Annex Bool+wantDrop def from key file = do 	u <- maybe getUUID (return . id) from-	not <$> isPreferredContent (Just u) (S.singleton u) file def+	not <$> isPreferredContent (Just u) (S.singleton u) key file def
Assistant.hs view
@@ -145,7 +145,7 @@ 				, assist $ transferPollerThread 				, assist $ transfererThread 				, assist $ daemonStatusThread-				, assist $ sanityCheckerDailyThread+				, assist $ sanityCheckerDailyThread urlrenderer 				, assist $ sanityCheckerHourlyThread 				, assist $ problemFixerThread urlrenderer #ifdef WITH_CLIBS
Assistant/Alert.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant alerts  -- - 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.  -}@@ -259,6 +259,25 @@ upgradeFailedAlert :: String -> Alert upgradeFailedAlert msg = (errorAlert msg []) 	{ alertHeader = Just $ fromString "Upgrade failed." }++unusedFilesAlert :: [AlertButton] -> String -> Alert+unusedFilesAlert buttons message = Alert+	{ alertHeader = Just $ fromString $ unwords+		[ "Old and deleted files are piling up --"+		, message+		]+	, alertIcon = Just InfoIcon+	, alertPriority = High+	, alertButtons = buttons+	, alertClosable = True+	, alertClass = Message+	, alertMessageRender = renderData+	, alertCounter = 0+	, alertBlockDisplay = True+	, alertName = Just UnusedFilesAlert+	, alertCombiner = Just $ fullCombiner $ \new _old -> new+	, alertData = []+	}  brokenRepositoryAlert :: [AlertButton] -> Alert brokenRepositoryAlert = errorAlert "Serious problems have been detected with your repository. This needs your immediate attention!"
Assistant/DaemonStatus.hs view
@@ -59,7 +59,7 @@  	return $ \dstatus -> dstatus 		{ syncRemotes = syncable-		, syncGitRemotes = filter Remote.syncableRemote syncable+		, syncGitRemotes = filter Remote.gitSyncableRemote syncable 		, syncDataRemotes = syncdata 		, syncingToCloudRemote = any iscloud syncdata 		}
Assistant/Drop.hs view
@@ -5,108 +5,21 @@  - Licensed under the GNU GPL version 3 or higher.  -} -module Assistant.Drop where+module Assistant.Drop (+	handleDrops,+	handleDropsFrom,+) where  import Assistant.Common import Assistant.DaemonStatus+import Annex.Drop (handleDropsFrom, Reason) import Logs.Location-import Logs.Trust-import Types.Remote (uuid)-import qualified Remote-import qualified Command.Drop-import Command-import Annex.Wanted-import Annex.Exception-import Config-import Annex.Content.Direct--import qualified Data.Set as S--type Reason = String+import RunCommand  {- Drop from local and/or remote when allowed by the preferred content and  - numcopies settings. -} handleDrops :: Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant ()-handleDrops _ _ _ Nothing _ = noop handleDrops reason fromhere key f knownpresentremote = do 	syncrs <- syncDataRemotes <$> getDaemonStatus 	locs <- liftAnnex $ loggedLocations key-	handleDropsFrom locs syncrs reason fromhere key f knownpresentremote--{- The UUIDs are ones where the content is believed to be present.- - The Remote list can include other remotes that do not have the content;- - only ones that match the UUIDs will be dropped from.- - If allowed to drop fromhere, that drop will be tried first.- -- - In direct mode, all associated files are checked, and only if all- - of them are unwanted are they dropped.- -}-handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant ()-handleDropsFrom _ _ _ _ _ Nothing _ = noop-handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do-	fs <- liftAnnex $ ifM isDirect-		( do-			l <- associatedFilesRelative key-			if null l-				then return [afile]-				else return l-		, return [afile]-		)-	n <- getcopies fs-	if fromhere && checkcopies n Nothing-		then go fs rs =<< dropl fs n-		else go fs rs n-  where-	getcopies fs = liftAnnex $ do-		(untrusted, have) <- trustPartition UnTrusted locs-		numcopies <- maximum <$> mapM (getNumCopies <=< numCopies) fs-		return (length have, numcopies, S.fromList untrusted)--	{- Check that we have enough copies still to drop the content.-	 - When the remote being dropped from is untrusted, it was not-	 - counted as a copy, so having only numcopies suffices. Otherwise,-	 - we need more than numcopies to safely drop. -}-	checkcopies (have, numcopies, _untrusted) Nothing = have > numcopies-	checkcopies (have, numcopies, untrusted) (Just u)-		| S.member u untrusted = have >= numcopies-		| otherwise = have > numcopies-	-	decrcopies (have, numcopies, untrusted) Nothing =-		(have - 1, numcopies, untrusted)-	decrcopies v@(_have, _numcopies, untrusted) (Just u)-		| S.member u untrusted = v-		| otherwise = decrcopies v Nothing--	go _ [] _ = noop-	go fs (r:rest) n-		| uuid r `S.notMember` slocs = go fs rest n-		| checkcopies n (Just $ Remote.uuid r) =-			dropr fs r n >>= go fs rest-		| otherwise = noop--	checkdrop fs n@(have, numcopies, _untrusted) u a =-		ifM (liftAnnex $ allM (wantDrop True u . Just) fs)-			( ifM (liftAnnex $ safely $ doCommand $ a (Just numcopies))-				( do-					debug-						[ "dropped"-						, afile-						, "(from " ++ maybe "here" show u ++ ")"-						, "(copies now " ++ show (have - 1) ++ ")"-						, ": " ++ reason-						]-					return $ decrcopies n u-				, return n-				)-			, return n-			)--	dropl fs n = checkdrop fs n Nothing $ \numcopies ->-		Command.Drop.startLocal (Just afile) numcopies key knownpresentremote--	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->-		Command.Drop.startRemote (Just afile) numcopies key r--	safely a = either (const False) id <$> tryAnnex a--	slocs = S.fromList locs+	liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f knownpresentremote callCommand
Assistant/Threads/Committer.hs view
@@ -464,7 +464,7 @@ 		Nothing -> noop 		Just k -> whenM (scanComplete <$> getDaemonStatus) $ do 			present <- liftAnnex $ inAnnex k-			if present+			void $ if present 				then queueTransfers "new file created" Next k (Just f) Upload 				else queueTransfers "new or renamed file wanted" Next k (Just f) Download 			handleDrops "file renamed" present k (Just f) Nothing
Assistant/Threads/ConfigMonitor.hs view
@@ -17,6 +17,7 @@ import Logs.Trust import Logs.PreferredContent import Logs.Group+import Logs.NumCopies import Remote.List (remoteListRefresh) import qualified Git.LsTree as LsTree import Git.FilePath@@ -59,6 +60,7 @@ 	, (remoteLog, void $ liftAnnex remoteListRefresh) 	, (trustLog, void $ liftAnnex trustMapLoad) 	, (groupLog, void $ liftAnnex groupMapLoad)+	, (numcopiesLog, void $ liftAnnex globalNumCopiesLoad) 	, (scheduleLog, void updateScheduleLog) 	-- Preferred content settings depend on most of the other configs, 	-- so will be reloaded whenever any configs change.
Assistant/Threads/SanityChecker.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Assistant.Threads.SanityChecker ( 	sanityCheckerStartupThread, 	sanityCheckerDailyThread,@@ -15,7 +17,10 @@ import Assistant.DaemonStatus import Assistant.Alert import Assistant.Repair+import Assistant.Drop import Assistant.Ssh+import Assistant.TransferQueue+import Assistant.Types.UrlRenderer import qualified Annex.Branch import qualified Git.LsFiles import qualified Git.Command@@ -27,10 +32,20 @@ import Utility.NotificationBroadcaster import Config import Utility.HumanTime+import Utility.Tense import Git.Repair import Git.Index+import Assistant.Unused+import Logs.Unused+import Logs.Transfer+import Config.Files+import qualified Annex+#ifdef WITH_WEBAPP+import Assistant.WebApp.Types+#endif  import Data.Time.Clock.POSIX+import qualified Data.Text as T  {- This thread runs once at startup, and most other threads wait for it  - to finish. (However, the webapp thread does not, to prevent the UI@@ -78,8 +93,8 @@ 	hourlyCheck  {- This thread wakes up daily to make sure the tree is in good shape. -}-sanityCheckerDailyThread :: NamedThread-sanityCheckerDailyThread = namedThread "SanityCheckerDaily" $ forever $ do+sanityCheckerDailyThread :: UrlRenderer -> NamedThread+sanityCheckerDailyThread urlrenderer = namedThread "SanityCheckerDaily" $ forever $ do 	waitForNextCheck  	debug ["starting sanity check"]@@ -90,7 +105,8 @@ 		modifyDaemonStatus_ $ \s -> s { sanityCheckRunning = True }  		now <- liftIO getPOSIXTime -- before check started-		r <- either showerr return =<< (tryIO . batch) <~> dailyCheck+		r <- either showerr return +			=<< (tryIO . batch) <~> dailyCheck urlrenderer  		modifyDaemonStatus_ $ \s -> s 			{ sanityCheckRunning = False@@ -119,9 +135,10 @@ {- It's important to stay out of the Annex monad as much as possible while  - running potentially expensive parts of this check, since remaining in it  - will block the watcher. -}-dailyCheck :: Assistant Bool-dailyCheck = do+dailyCheck :: UrlRenderer -> Assistant Bool+dailyCheck urlrenderer = do 	g <- liftAnnex gitRepo+	batchmaker <- liftIO getBatchCommandMaker  	-- Find old unstaged symlinks, and add them to git. 	(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g@@ -140,12 +157,29 @@ 	 - to have a lot of small objects and they should not be a 	 - significant size. -} 	when (Git.Config.getMaybe "gc.auto" g == Just "0") $-		liftIO $ void $ Git.Command.runBool+		liftIO $ void $ Git.Command.runBatch batchmaker 			[ Param "-c", Param "gc.auto=670000" 			, Param "gc" 			, Param "--auto" 			] g +	{- Check if the unused files found last time have been dealt with. -}+	checkOldUnused urlrenderer++	{- Run git-annex unused once per day. This is run as a separate+	 - process to stay out of the annex monad and so it can run as a+	 - batch job. -}+	program <- liftIO readProgramFile+	let (program', params') = batchmaker (program, [Param "unused"])+	void $ liftIO $ boolSystem program' params'+	{- Invalidate unused keys cache, and queue transfers of all unused+	 - keys, or if no transfers are called for, drop them. -}+	unused <- liftAnnex unusedKeys'+	void $ liftAnnex $ setUnusedKeys unused+	forM_ unused $ \k -> do+		unlessM (queueTransfers "unused" Later k Nothing Upload) $+			handleDrops "unused" True k Nothing Nothing+ 	return True   where 	toonew timestamp now = now < (realToFrac (timestamp + slop) :: POSIXTime)@@ -159,7 +193,8 @@ 		insanity $ "found unstaged symlink: " ++ file  hourlyCheck :: Assistant ()-hourlyCheck = checkLogSize 0+hourlyCheck = do+	checkLogSize 0  {- Rotate logs until log file size is < 1 mb. -} checkLogSize :: Int -> Assistant ()@@ -184,3 +219,23 @@ oneDay :: Int oneDay = 24 * oneHour +{- If annex.expireunused is set, find any keys that have lingered unused+ - for the specified duration, and remove them.+ -+ - Otherwise, check to see if unused keys are piling up, and let the user+ - know. -}+checkOldUnused :: UrlRenderer -> Assistant ()+checkOldUnused urlrenderer = go =<< annexExpireUnused <$> liftAnnex Annex.getGitConfig+  where+	go (Just Nothing) = noop+  	go (Just (Just expireunused)) = expireUnused (Just expireunused)+	go Nothing = maybe noop prompt =<< describeUnusedWhenBig++	prompt msg = +#ifdef WITH_WEBAPP+		do+			button <- mkAlertButton True (T.pack "Configure") urlrenderer ConfigUnusedR+			void $ addAlert $ unusedFilesAlert [button] $ T.unpack $ renderTense Present msg+#else+		debug [msg]+#endif
Assistant/Threads/TransferScanner.hs view
@@ -29,6 +29,7 @@ import qualified Backend import Annex.Content import Annex.Wanted+import RunCommand  import qualified Data.Set as S @@ -156,16 +157,16 @@ 		syncrs <- syncDataRemotes <$> getDaemonStatus 		locs <- liftAnnex $ loggedLocations key 		present <- liftAnnex $ inAnnex key-		handleDropsFrom locs syncrs+		liftAnnex $ handleDropsFrom locs syncrs 			"expensive scan found too many copies of object"-			present key (Just f) Nothing+			present key (Just f) Nothing callCommand 		liftAnnex $ do 			let slocs = S.fromList locs 			let use a = return $ mapMaybe (a key slocs) syncrs 			ts <- if present-				then filterM (wantSend True (Just f) . Remote.uuid . fst)+				then filterM (wantSend True (Just key) (Just f) . Remote.uuid . fst) 					=<< use (genTransfer Upload False)-				else ifM (wantGet True $ Just f)+				else ifM (wantGet True (Just key) (Just f)) 					( use (genTransfer Download True) , return [] ) 			let unwanted' = S.difference unwanted slocs 			return (unwanted', ts)
Assistant/Threads/WebApp.hs view
@@ -27,6 +27,7 @@ import Assistant.WebApp.Configurators.WebDAV import Assistant.WebApp.Configurators.XMPP import Assistant.WebApp.Configurators.Preferences+import Assistant.WebApp.Configurators.Unused import Assistant.WebApp.Configurators.Edit import Assistant.WebApp.Configurators.Delete import Assistant.WebApp.Configurators.Fsck
Assistant/TransferQueue.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant pending transfer queue  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -51,14 +51,17 @@  {- Adds transfers to queue for some of the known remotes.  - Honors preferred content settings, only transferring wanted files. -}-queueTransfers :: Reason -> Schedule -> Key -> AssociatedFile -> Direction -> Assistant ()+queueTransfers :: Reason -> Schedule -> Key -> AssociatedFile -> Direction -> Assistant Bool queueTransfers = queueTransfersMatching (const True)  {- Adds transfers to queue for some of the known remotes, that match a  - condition. Honors preferred content settings. -}-queueTransfersMatching :: (UUID -> Bool) -> Reason -> Schedule -> Key -> AssociatedFile -> Direction -> Assistant ()+queueTransfersMatching :: (UUID -> Bool) -> Reason -> Schedule -> Key -> AssociatedFile -> Direction -> Assistant Bool queueTransfersMatching matching reason schedule k f direction-	| direction == Download = whenM (liftAnnex $ wantGet True f) go+	| direction == Download = ifM (liftAnnex $ wantGet True (Just k) f)+		( go+		, return False+		) 	| otherwise = go   where 	go = do@@ -67,9 +70,13 @@ 			=<< syncDataRemotes <$> getDaemonStatus 		let matchingrs = filter (matching . Remote.uuid) rs 		if null matchingrs-			then defer-			else forM_ matchingrs $ \r ->-				enqueue reason schedule (gentransfer r) (stubInfo f r)+			then do+				defer+				return False+			else do+				forM_ matchingrs $ \r ->+					enqueue reason schedule (gentransfer r) (stubInfo f r)+				return True 	selectremotes rs 		{- Queue downloads from all remotes that 		 - have the key. The list of remotes is ordered with@@ -82,7 +89,7 @@ 		 - already have it. -} 		| otherwise = do 			s <- locs-			filterM (wantSend True f . Remote.uuid) $+			filterM (wantSend True (Just k) f . Remote.uuid) $ 				filter (\r -> not (inset s r || Remote.readonly r)) rs 	  where 	  	locs = S.fromList <$> Remote.keyLocations k
Assistant/TransferSlots.hs view
@@ -103,8 +103,8 @@ {- By the time this is called, the daemonstatus's currentTransfers map should  - already have been updated to include the transfer. -} genTransfer :: Transfer -> TransferInfo -> TransferGenerator-genTransfer t info = case (transferRemote info, associatedFile info) of-	(Just remote, Just file) +genTransfer t info = case transferRemote info of+	Just remote  		| Git.repoIsLocalUnknown (Remote.repo remote) -> do 			-- optimisation for removable drives not plugged in 			liftAnnex $ recordFailedTransfer t info@@ -114,7 +114,7 @@ 			( do 				debug [ "Transferring:" , describeTransfer t info ] 				notifyTransfer-				return $ Just (t, info, go remote file)+				return $ Just (t, info, go remote) 			, do 				debug [ "Skipping unnecessary transfer:", 					describeTransfer t info ]@@ -149,10 +149,12 @@ 	 - usual cleanup. However, first check if something else is 	 - running the transfer, to avoid removing active transfers. 	 -}-	go remote file transferrer = ifM (liftIO $ performTransfer transferrer t $ associatedFile info)+	go remote transferrer = ifM (liftIO $ performTransfer transferrer t $ associatedFile info) 		( do-			void $ addAlert $ makeAlertFiller True $-				transferFileAlert direction True file+			maybe noop+				(void . addAlert . makeAlertFiller True +					. transferFileAlert direction True)+				(associatedFile info) 			unless isdownload $ 				handleDrops 					("object uploaded to " ++ show remote)@@ -188,11 +190,11 @@ shouldTransfer :: Transfer -> TransferInfo -> Annex Bool shouldTransfer t info 	| transferDirection t == Download =-		(not <$> inAnnex key) <&&> wantGet True file+		(not <$> inAnnex key) <&&> wantGet True (Just key) file 	| transferDirection t == Upload = case transferRemote info of 		Nothing -> return False 		Just r -> notinremote r-			<&&> wantSend True file (Remote.uuid r)+			<&&> wantSend True (Just key) file (Remote.uuid r) 	| otherwise = return False   where 	key = transferKey t@@ -216,7 +218,7 @@ 	| transferDirection t == Download = 		whenM (liftAnnex $ inAnnex $ transferKey t) $ do 			dodrops False-			queueTransfersMatching (/= transferUUID t)+			void $ queueTransfersMatching (/= transferUUID t) 				"newly received object" 				Later (transferKey t) (associatedFile info) Upload 	| otherwise = dodrops True
Assistant/Types/Alert.hs view
@@ -32,6 +32,7 @@ 	| SyncAlert 	| NotFsckedAlert 	| UpgradeAlert+	| UnusedFilesAlert 	deriving (Eq)  {- The first alert is the new alert, the second is an old alert.
+ Assistant/Unused.hs view
@@ -0,0 +1,86 @@+{- git-annex assistant unused files+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Assistant.Unused where++import qualified Data.Map as M++import Assistant.Common+import qualified Git+import Types.Key+import Logs.Unused+import Logs.Location+import Annex.Content+import Utility.DataUnits+import Utility.DiskFree+import Utility.HumanTime+import Utility.Tense++import Data.Time.Clock.POSIX+import qualified Data.Text as T++describeUnused :: Assistant (Maybe TenseText)+describeUnused = describeUnused' False++describeUnusedWhenBig :: Assistant (Maybe TenseText)+describeUnusedWhenBig = describeUnused' True++{- This uses heuristics: 1000 unused keys, or more unused keys + - than the remaining free disk space, or more than 1/10th the total+ - disk space being unused keys all suggest a problem. -}+describeUnused' :: Bool -> Assistant (Maybe TenseText)+describeUnused' whenbig = liftAnnex $ go =<< readUnusedLog ""+  where+	go m = do+		let num = M.size m+		let diskused = foldl' sumkeysize 0 (M.keys m)+		df <- forpath getDiskFree+		disksize <- forpath getDiskSize+		return $ if num == 0+			then Nothing+			else if not whenbig || moreused df diskused || tenthused disksize diskused+				then Just $ tenseWords+					[ UnTensed $ T.pack $ roughSize storageUnits False diskused+					, Tensed "are" "were"+					, "taken up by unused files"+					]+				else if num > 1000+					then Just $ tenseWords+						[ UnTensed $ T.pack $ show num ++ " unused files"+						, Tensed "exist" "existed"+						]+					else Nothing++	moreused Nothing _ = False+	moreused (Just df) used = df <= used++	tenthused Nothing _ = False+	tenthused (Just disksize) used = used >= disksize `div` 10++	sumkeysize s k = s + fromMaybe 0 (keySize k)++	forpath a = inRepo $ liftIO . a . Git.repoPath++{- With a duration, expires all unused files that are older.+ - With Nothing, expires *all* unused files. -}+expireUnused :: Maybe Duration -> Assistant ()+expireUnused duration = do+	m <- liftAnnex $ readUnusedLog ""+	now <- liftIO getPOSIXTime+	let oldkeys = M.keys $ M.filter (tooold now) m+	forM_ oldkeys $ \k -> do+		debug ["removing old unused key", key2file k]+		liftAnnex $ do+			removeAnnex k+			logStatus k InfoMissing+  where+	boundry = durationToPOSIXTime <$> duration+	tooold now (_, mt) = case boundry of+		Nothing -> True+		Just b -> maybe False (\t -> now - t >= b) mt
Assistant/Upgrade.hs view
@@ -276,7 +276,6 @@  removeEmptyRecursive :: FilePath -> IO () removeEmptyRecursive dir = do-	print ("remove", dir) 	mapM_ removeEmptyRecursive =<< dirContents dir 	void $ tryIO $ removeDirectory dir
Assistant/WebApp/Configurators/Edit.hs view
@@ -264,6 +264,7 @@ 		liftAnnex $ setConfig  			(remoteConfig (Remote.repo rmt) "ignore") 			(Git.Config.boolConfig False)-		liftAssistant $ syncRemote rmt 		liftAnnex $ void Remote.remoteListRefresh+		liftAssistant updateSyncRemotes+		liftAssistant $ syncRemote rmt 		redirect DashboardR
Assistant/WebApp/Configurators/Local.hs view
@@ -14,7 +14,7 @@ import Assistant.WebApp.MakeRemote import Assistant.Sync import Assistant.Restart-import Init+import Annex.Init import qualified Git import qualified Git.Construct import qualified Git.Config
Assistant/WebApp/Configurators/Preferences.hs view
@@ -17,6 +17,7 @@ import qualified Git import Config import Config.Files+import Config.NumCopies import Utility.DataUnits import Git.Config import Types.Distribution@@ -81,7 +82,7 @@ getPrefs :: Annex PrefsForm getPrefs = PrefsForm 	<$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig)-	<*> (annexNumCopies <$> Annex.getGitConfig)+	<*> (fromNumCopies <$> getNumCopies) 	<*> inAutoStartFile 	<*> (annexAutoUpgrade <$> Annex.getGitConfig) 	<*> (annexDebug <$> Annex.getGitConfig)@@ -89,7 +90,8 @@ storePrefs :: PrefsForm -> Annex () storePrefs p = do 	setConfig (annexConfig "diskreserve") (T.unpack $ diskReserve p)-	setConfig (annexConfig "numcopies") (show $ numCopies p)+	setGlobalNumCopies (NumCopies $ numCopies p)+	unsetConfig (annexConfig "numcopies") -- deprecated 	setConfig (annexConfig "autoupgrade") (fromAutoUpgrade $ autoUpgrade p) 	unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do 		here <- fromRepo Git.repoPath
+ Assistant/WebApp/Configurators/Unused.hs view
@@ -0,0 +1,80 @@+{- git-annex assistant unused file preferences+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}++module Assistant.WebApp.Configurators.Unused where++import Assistant.WebApp.Common+import qualified Annex+import Utility.HumanTime+import Assistant.Unused+import Config+import Git.Config+import Logs.Unused+import Utility.Tense++import qualified Text.Hamlet as Hamlet++data UnusedForm = UnusedForm+	{ enableExpire :: Bool+	, expireWhen :: Integer+	}++unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm+unusedForm def msg = do+	(enableRes, enableView) <- mreq (selectFieldList enabledisable) ""+		(Just $ enableExpire def)+	(whenRes, whenView) <- mreq intField ""+		(Just $ expireWhen def)+	let form = do+		webAppFormAuthToken+		$(widgetFile "configurators/unused/form")+	return (UnusedForm <$> enableRes <*> whenRes, form)+  where+	enabledisable :: [(Text, Bool)]+	enabledisable = [("Disable expiry", False), ("Enable expiry", True)]++getConfigUnusedR :: Handler Html+getConfigUnusedR = postConfigUnusedR+postConfigUnusedR :: Handler Html+postConfigUnusedR = page "Unused files" (Just Configuration) $ do+	current <- liftAnnex getUnused+	((res, form), enctype) <- liftH $ runFormPostNoToken $ unusedForm current+	case res of+		FormSuccess new -> liftH $ do+			liftAnnex $ storeUnused new+			redirect ConfigurationR+		_ -> do+			munuseddesc <- liftAssistant describeUnused+			ts <- liftAnnex $ dateUnusedLog ""+			mlastchecked <- case ts of+				Nothing -> pure Nothing+				Just t -> Just <$> liftIO (durationSince t)+			$(widgetFile "configurators/unused")++getUnused :: Annex UnusedForm+getUnused = convert . annexExpireUnused <$> Annex.getGitConfig+  where+	convert Nothing = noexpire+	convert (Just Nothing) = noexpire+	convert (Just (Just n)) = UnusedForm True $ durationToDays n++	-- The 7 is so that, if they enable expiry, they have to change+	-- it to get faster than  a week.+	noexpire = UnusedForm False 7++storeUnused :: UnusedForm -> Annex ()+storeUnused f = setConfig (annexConfig "expireunused") $+	if not (enableExpire f) || expireWhen f < 0+		then boolConfig False+		else fromDuration $ daysToDuration $ expireWhen f++getCleanupUnusedR :: Handler Html+getCleanupUnusedR = do+	liftAssistant $ expireUnused Nothing+	redirect ConfigUnusedR
Assistant/WebApp/routes view
@@ -25,6 +25,7 @@ /config/upgrade/start/#GitAnnexDistribution ConfigStartUpgradeR GET /config/upgrade/finish ConfigFinishUpgradeR GET /config/upgrade/automatically ConfigEnableAutomaticUpgradeR GET+/config/unused ConfigUnusedR GET POST  /config/addrepository AddRepositoryR GET /config/repository/new NewRepositoryR GET POST@@ -117,5 +118,7 @@  /repair/#UUID RepairRepositoryR GET POST /repair/run/#UUID RepairRepositoryRunR GET POST++/unused/cleanup CleanupUnusedR GET  /static StaticR Static getStatic
CHANGELOG view
@@ -1,3 +1,54 @@+git-annex (5.20140127) unstable; urgency=medium++  * sync --content: New option that makes the content of annexed files be+    transferred. Similar to the assistant, this honors any configured+    preferred content expressions.+  * Remove --json option from commands not supporting it.+  * status: Support --json.+  * list: Fix specifying of files to list.+  * Allow --all to be mixed with matching options like --copies and --in+    (but not --include and --exclude).+  * numcopies: New command, sets global numcopies value that is seen by all+    clones of a repository.+  * The annex.numcopies git config setting is deprecated. Once the numcopies+    command is used to set the global number of copies, any annex.numcopies+    git configs will be ignored.+  * assistant: Make the prefs page set the global numcopies.+  * Add lackingcopies, approxlackingcopies, and unused to+    preferred content expressions.+  * Client, transfer, incremental backup, and archive repositories+    now want to get content that does not yet have enough copies.+  * Client, transfer, and source repositories now do not want to retain+    unused file contents.+  * assistant: Checks daily for unused file contents, and when possible+    moves them to a repository (such as a backup repository) that+    wants to retain them.+  * assistant: annex.expireunused can be configured to cause unused+    file contents to be deleted after some period of time.+  * webapp: Nudge user to see if they want to expire old unused file+    contents when a lot of them seem to be piling up in the repository.+  * repair: Check git version at run time.+  * assistant: Run the periodic git gc in batch mode.+  * added annex.secure-erase-command config option.+  * Optimise non-bare http remotes; no longer does a 404 to the wrong+    url every time before trying the right url. Needs annex-bare to be+    set to false, which is done when initially probing the uuid of a+    http remote.+  * webapp: After upgrading a git repository to git-annex, fix+    bug that made it temporarily not be synced with.+  * whereis: Support --all.+  * All commands that support --all also support a --key option,+    which limits them to acting on a single key.++ -- Joey Hess <joeyh@debian.org>  Mon, 27 Jan 2014 13:43:28 -0400++git-annex (5.20140117) unstable; urgency=medium++  * Really fix FTBFS on mipsel and sparc due to test suite not being available+    on those architectures.++ -- Joey Hess <joeyh@debian.org>  Fri, 17 Jan 2014 14:46:27 -0400+ git-annex (5.20140116) unstable; urgency=medium    * Added tahoe special remote.
Checks.hs view
@@ -12,7 +12,7 @@  import Common.Annex import Types.Command-import Init+import Annex.Init import Config import Utility.Daemon import qualified Git
CmdLine.hs view
@@ -23,7 +23,6 @@  import Common.Annex import qualified Annex-import qualified Annex.Queue import qualified Git import qualified Git.AutoCorrect import Annex.Content@@ -41,7 +40,7 @@ 		Left e -> maybe (throw e) (\a -> a params) (cmdnorepo cmd) 		Right g -> do 			state <- Annex.new g-			(actions, state') <- Annex.run state $ do+			Annex.eval state $ do 				checkEnvironment 				checkfuzzy 				forM_ fields $ uncurry Annex.setField@@ -50,8 +49,9 @@ 				sequence_ flags 				whenM (annexDebug <$> Annex.getGitConfig) $ 					liftIO enableDebugOutput-				prepCommand cmd params-		 	tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdnocommit cmd]+				startup+				performCommand cmd params+				shutdown $ cmdnocommit cmd   where 	err msg = msg ++ "\n\n" ++ usage header allcmds 	cmd = Prelude.head cmds@@ -92,44 +92,19 @@ 		, commandUsage cmd 		] -{- Runs a list of Annex actions. Catches IO errors and continues- - (but explicitly thrown errors terminate the whole command).- -}-tryRun :: Annex.AnnexState -> Command -> [CommandCleanup] -> IO ()-tryRun = tryRun' 0-tryRun' :: Integer -> Annex.AnnexState -> Command -> [CommandCleanup] -> IO ()-tryRun' errnum _ cmd []-	| errnum > 0 = error $ cmdname cmd ++ ": " ++ show errnum ++ " failed"-	| otherwise = noop-tryRun' errnum state cmd (a:as) = do-	r <- run-	handle $! r-  where-	run = tryIO $ Annex.run state $ do-		Annex.Queue.flushWhenFull-		a-	handle (Left err) = showerr err >> cont False state-	handle (Right (success, state')) = cont success state'-	cont success s = do-		let errnum' = if success then errnum else errnum + 1-		(tryRun' $! errnum') s cmd as-	showerr err = Annex.eval state $ do-		showErr err-		showEndFail- {- Actions to perform each time ran. -}-startup :: Annex Bool-startup = liftIO $ do+startup :: Annex ()+startup = #ifndef mingw32_HOST_OS-	void $ installHandler sigINT Default Nothing+	liftIO $ void $ installHandler sigINT Default Nothing+#else+	return () #endif-	return True  {- Cleanup actions. -}-shutdown :: Bool -> Annex Bool+shutdown :: Bool -> Annex () shutdown nocommit = do 	saveState nocommit 	sequence_ =<< M.elems <$> Annex.getState Annex.cleanup 	liftIO reapZombies -- zombies from long-running git processes 	sshCleanup -- ssh connection caching-	return True
+ CmdLine/GitAnnex.hs view
@@ -0,0 +1,182 @@+{- git-annex main program+ -+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP, OverloadedStrings #-}++module CmdLine.GitAnnex where++import qualified Git.CurrentRepo+import CmdLine+import Command++import qualified Command.Add+import qualified Command.Unannex+import qualified Command.Drop+import qualified Command.Move+import qualified Command.Copy+import qualified Command.Get+import qualified Command.LookupKey+import qualified Command.ExamineKey+import qualified Command.FromKey+import qualified Command.DropKey+import qualified Command.TransferKey+import qualified Command.TransferKeys+import qualified Command.ReKey+import qualified Command.Reinject+import qualified Command.Fix+import qualified Command.Init+import qualified Command.Describe+import qualified Command.InitRemote+import qualified Command.EnableRemote+import qualified Command.Fsck+import qualified Command.Repair+import qualified Command.Unused+import qualified Command.DropUnused+import qualified Command.AddUnused+import qualified Command.Unlock+import qualified Command.Lock+import qualified Command.PreCommit+import qualified Command.Find+import qualified Command.Whereis+import qualified Command.List+import qualified Command.Log+import qualified Command.Merge+import qualified Command.Info+import qualified Command.Status+import qualified Command.Migrate+import qualified Command.Uninit+import qualified Command.NumCopies+import qualified Command.Trust+import qualified Command.Untrust+import qualified Command.Semitrust+import qualified Command.Dead+import qualified Command.Group+import qualified Command.Wanted+import qualified Command.Schedule+import qualified Command.Ungroup+import qualified Command.Vicfg+import qualified Command.Sync+import qualified Command.Mirror+import qualified Command.AddUrl+#ifdef WITH_FEED+import qualified Command.ImportFeed+#endif+import qualified Command.RmUrl+import qualified Command.Import+import qualified Command.Map+import qualified Command.Direct+import qualified Command.Indirect+import qualified Command.Upgrade+import qualified Command.Forget+import qualified Command.Version+import qualified Command.Help+#ifdef WITH_ASSISTANT+import qualified Command.Watch+import qualified Command.Assistant+#ifdef WITH_WEBAPP+import qualified Command.WebApp+#endif+#ifdef WITH_XMPP+import qualified Command.XMPPGit+#endif+#endif+import qualified Command.Test+#ifdef WITH_TESTSUITE+import qualified Command.FuzzTest+#endif+#ifdef WITH_EKG+import System.Remote.Monitoring+#endif++cmds :: [Command]+cmds = concat+	[ Command.Add.def+	, Command.Get.def+	, Command.Drop.def+	, Command.Move.def+	, Command.Copy.def+	, Command.Unlock.def+	, Command.Lock.def+	, Command.Sync.def+	, Command.Mirror.def+	, Command.AddUrl.def+#ifdef WITH_FEED+	, Command.ImportFeed.def+#endif+	, Command.RmUrl.def+	, Command.Import.def+	, Command.Init.def+	, Command.Describe.def+	, Command.InitRemote.def+	, Command.EnableRemote.def+	, Command.Reinject.def+	, Command.Unannex.def+	, Command.Uninit.def+	, Command.PreCommit.def+	, Command.NumCopies.def+	, Command.Trust.def+	, Command.Untrust.def+	, Command.Semitrust.def+	, Command.Dead.def+	, Command.Group.def+	, Command.Wanted.def+	, Command.Schedule.def+	, Command.Ungroup.def+	, Command.Vicfg.def+	, Command.LookupKey.def+	, Command.ExamineKey.def+	, Command.FromKey.def+	, Command.DropKey.def+	, Command.TransferKey.def+	, Command.TransferKeys.def+	, Command.ReKey.def+	, Command.Fix.def+	, Command.Fsck.def+	, Command.Repair.def+	, Command.Unused.def+	, Command.DropUnused.def+	, Command.AddUnused.def+	, Command.Find.def+	, Command.Whereis.def+	, Command.List.def+	, Command.Log.def+	, Command.Merge.def+	, Command.Info.def+	, Command.Status.def+	, Command.Migrate.def+	, Command.Map.def+	, Command.Direct.def+	, Command.Indirect.def+	, Command.Upgrade.def+	, Command.Forget.def+	, Command.Version.def+	, Command.Help.def+#ifdef WITH_ASSISTANT+	, Command.Watch.def+	, Command.Assistant.def+#ifdef WITH_WEBAPP+	, Command.WebApp.def+#endif+#ifdef WITH_XMPP+	, Command.XMPPGit.def+#endif+#endif+	, Command.Test.def+#ifdef WITH_TESTSUITE+	, Command.FuzzTest.def+#endif+	]++header :: String+header = "git-annex command [option ...]"++run :: [String] -> IO ()+run args = do+#ifdef WITH_EKG+	_ <- forkServer "localhost" 4242+#endif+	dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get
+ CmdLine/GitAnnex/Options.hs view
@@ -0,0 +1,99 @@+{- git-annex options+ -+ - Copyright 2010, 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module CmdLine.GitAnnex.Options where++import System.Console.GetOpt++import Common.Annex+import qualified Git.Config+import Git.Types+import Types.TrustLevel+import Types.NumCopies+import Types.Messages+import qualified Annex+import qualified Remote+import qualified Limit+import qualified Limit.Wanted+import CmdLine.Option+import CmdLine.Usage++gitAnnexOptions :: [Option]+gitAnnexOptions = commonOptions +++	[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)+		"override default number of copies"+	, Option [] ["trust"] (trustArg Trusted)+		"override trust setting"+	, Option [] ["semitrust"] (trustArg SemiTrusted)+		"override trust setting back to default"+	, Option [] ["untrust"] (trustArg UnTrusted)+		"override trust setting to untrusted"+	, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")+		"override git configuration setting"+	, Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)+		"skip files matching the glob pattern"+	, Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob)+		"limit to files matching the glob pattern"+	, Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote)+		"match files present in a remote"+	, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)+		"skip files with fewer copies"+	, Option [] ["lackingcopies"] (ReqArg (Limit.addLackingCopies False) paramNumber)+		"match files that need more copies"+	, Option [] ["approxlackingcopies"] (ReqArg (Limit.addLackingCopies True) paramNumber)+		"match files that need more copies (faster)"+	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)+		"match files using a key-value backend"+	, Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup)+		"match files present in all remotes in a group"+	, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize)+		"match files larger than a size"+	, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize)+		"match files smaller than a size"+	, Option [] ["want-get"] (NoArg Limit.Wanted.addWantGet)+		"match files the repository wants to get"+	, Option [] ["want-drop"] (NoArg Limit.Wanted.addWantDrop)+		"match files the repository wants to drop"+	, Option ['T'] ["time-limit"] (ReqArg Limit.addTimeLimit paramTime)+		"stop after the specified amount of time"+	, Option [] ["user-agent"] (ReqArg setuseragent paramName)+		"override default User-Agent"+	, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier"))+		"Trust Amazon Glacier inventory"+	] ++ matcherOptions+  where+	trustArg t = ReqArg (Remote.forceTrust t) paramRemote+	setnumcopies v = maybe noop+		(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n })+		(readish v)+	setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }+	setgitconfig v = inRepo (Git.Config.store v)+		>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })+		>>= Annex.changeGitRepo++keyOptions :: [Option]+keyOptions = +	[ Option ['A'] ["all"] (NoArg (Annex.setFlag "all"))+		"operate on all versions of all files"+	, Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused"))+		"operate on files found by last run of git-annex unused"+	, Option [] ["key"] (ReqArg (Annex.setField "key") paramKey)+		"operate on specified key"+	]++fromOption :: Option+fromOption = fieldOption ['f'] "from" paramRemote "source remote"++toOption :: Option+toOption = fieldOption ['t'] "to" paramRemote "destination remote"++fromToOptions :: [Option]+fromToOptions = [fromOption, toOption]++jsonOption :: Option+jsonOption = Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput))+	"enable JSON output"
+ CmdLine/GitAnnexShell.hs view
@@ -0,0 +1,199 @@+{- git-annex-shell main program+ -+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module CmdLine.GitAnnexShell where++import System.Environment+import System.Console.GetOpt++import Common.Annex+import qualified Git.Construct+import CmdLine+import Command+import Annex.UUID+import Annex (setField)+import CmdLine.GitAnnexShell.Fields+import Utility.UserInfo+import Remote.GCrypt (getGCryptUUID)+import qualified Annex+import Annex.Init++import qualified Command.ConfigList+import qualified Command.InAnnex+import qualified Command.DropKey+import qualified Command.RecvKey+import qualified Command.SendKey+import qualified Command.TransferInfo+import qualified Command.Commit+import qualified Command.GCryptSetup++cmds_readonly :: [Command]+cmds_readonly = concat+	[ gitAnnexShellCheck Command.ConfigList.def+	, gitAnnexShellCheck Command.InAnnex.def+	, gitAnnexShellCheck Command.SendKey.def+	, gitAnnexShellCheck Command.TransferInfo.def+	]++cmds_notreadonly :: [Command]+cmds_notreadonly = concat+	[ gitAnnexShellCheck Command.RecvKey.def+	, gitAnnexShellCheck Command.DropKey.def+	, gitAnnexShellCheck Command.Commit.def+	, Command.GCryptSetup.def+	]++cmds :: [Command]+cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly+  where+	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }++options :: [OptDescr (Annex ())]+options = commonOptions +++	[ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid"+	]+  where+	checkUUID expected = getUUID >>= check+	  where+		check u | u == toUUID expected = noop+		check NoUUID = checkGCryptUUID expected+		check u = unexpectedUUID expected u+	checkGCryptUUID expected = check =<< getGCryptUUID True =<< gitRepo+	  where+	  	check (Just u) | u == toUUID expected = noop+		check Nothing = unexpected expected "uninitialized repository"+		check (Just u) = unexpectedUUID expected u+	unexpectedUUID expected u = unexpected expected $ "UUID " ++ fromUUID u+	unexpected expected s = error $+		"expected repository UUID " ++ expected ++ " but found " ++ s++header :: String+header = "git-annex-shell [-c] command [parameters ...] [option ...]"++run :: [String] -> IO ()+run [] = failure+-- skip leading -c options, passed by eg, ssh+run ("-c":p) = run p+-- a command can be either a builtin or something to pass to git-shell+run c@(cmd:dir:params)+	| cmd `elem` builtins = builtin cmd dir params+	| otherwise = external c+run c@(cmd:_)+	-- Handle the case of being the user's login shell. It will be passed+	-- a single string containing all the real parameters.+	| "git-annex-shell " `isPrefixOf` cmd = run $ drop 1 $ shellUnEscape cmd+	| cmd `elem` builtins = failure+	| otherwise = external c++builtins :: [String]+builtins = map cmdname cmds++builtin :: String -> String -> [String] -> IO ()+builtin cmd dir params = do+	checkNotReadOnly cmd+	checkDirectory $ Just dir+	let (params', fieldparams, opts) = partitionParams params+	    fields = filter checkField $ parseFields fieldparams+	    cmds' = map (newcmd $ unwords opts) cmds+	dispatch False (cmd : params') cmds' options fields header $+		Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath+  where+	addrsyncopts opts seek k = setField "RsyncOptions" opts >> seek k+	newcmd opts c = c { cmdseek = addrsyncopts opts (cmdseek c) }++external :: [String] -> IO ()+external params = do+	{- Normal git-shell commands all have the directory as their last+	 - parameter. -}+	let lastparam = lastMaybe =<< shellUnEscape <$> lastMaybe params+	    (params', _, _) = partitionParams params+	checkDirectory lastparam+	checkNotLimited+	unlessM (boolSystem "git-shell" $ map Param $ "-c":params') $+		error "git-shell failed"++{- Split the input list into 3 groups separated with a double dash --.+ - Parameters between two -- markers are field settings, in the form:+ - field=value field=value+ -+ - Parameters after the last -- are the command itself and its arguments e.g.,+ - rsync --bandwidth=100.+ -}+partitionParams :: [String] -> ([String], [String], [String])+partitionParams ps = case segment (== "--") ps of+	params:fieldparams:rest -> ( params, fieldparams, intercalate ["--"] rest )+	[params] -> (params, [], [])+	_ -> ([], [], [])++parseFields :: [String] -> [(String, String)]+parseFields = map (separate (== '='))++{- Only allow known fields to be set, ignore others.+ - Make sure that field values make sense. -}+checkField :: (String, String) -> Bool+checkField (field, value)+	| field == fieldName remoteUUID = fieldCheck remoteUUID value+	| field == fieldName associatedFile = fieldCheck associatedFile value+	| field == fieldName direct = fieldCheck direct value+	| otherwise = False++failure :: IO ()+failure = error $ "bad parameters\n\n" ++ usage header cmds++checkNotLimited :: IO ()+checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"++checkNotReadOnly :: String -> IO ()+checkNotReadOnly cmd+	| cmd `elem` map cmdname cmds_readonly = noop+	| otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"++checkDirectory :: Maybe FilePath -> IO ()+checkDirectory mdir = do+	v <- catchMaybeIO $ getEnv "GIT_ANNEX_SHELL_DIRECTORY"+	case (v, mdir) of+		(Nothing, _) -> noop+		(Just d, Nothing) -> req d Nothing+		(Just d, Just dir)+			|  d `equalFilePath` dir -> noop+			| otherwise -> do+				home <- myHomeDir+				d' <- canondir home d+				dir' <- canondir home dir+				if d' `equalFilePath` dir'+					then noop+					else req d' (Just dir')+  where+	req d mdir' = error $ unwords +		[ "Only allowed to access"+		, d+		, maybe "and could not determine directory from command line" ("not " ++) mdir'+		]++	{- A directory may start with ~/ or in some cases, even /~/,+	 - or could just be relative to home, or of course could+	 - be absolute. -}+	canondir home d+		| "~/" `isPrefixOf` d = return d+		| "/~/" `isPrefixOf` d = return $ drop 1 d+		| otherwise = relHome $ absPathFrom home d++checkEnv :: String -> IO ()+checkEnv var = do+	v <- catchMaybeIO $ getEnv var+	case v of+		Nothing -> noop+		Just "" -> noop+		Just _ -> error $ "Action blocked by " ++ var++{- Modifies a Command to check that it is run in either a git-annex+ - repository, or a repository with a gcrypt-id set. -}+gitAnnexShellCheck :: [Command] -> [Command]+gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists+  where+	okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $+		error "Not a git-annex or gcrypt repository."
+ CmdLine/GitAnnexShell/Fields.hs view
@@ -0,0 +1,35 @@+{- git-annex-shell fields+ -+ - Copyright 2012 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module CmdLine.GitAnnexShell.Fields where++import Common.Annex+import qualified Annex++import Data.Char++{- A field, stored in Annex state, with a value sanity checker. -}+data Field = Field+	{ fieldName :: String+	, fieldCheck :: String -> Bool+	}++getField :: Field -> Annex (Maybe String)+getField = Annex.getField . fieldName++remoteUUID :: Field+remoteUUID = Field "remoteuuid" $+	-- does it look like a UUID?+	all (\c -> isAlphaNum c || c == '-')++associatedFile :: Field+associatedFile = Field "associatedfile" $ \f ->+	-- is the file a safe relative filename?+	not (isAbsolute f) && not ("../" `isPrefixOf` f)++direct :: Field+direct = Field "direct" $ \f -> f == "1"
+ CmdLine/Option.hs view
@@ -0,0 +1,77 @@+{- common command-line options+ -+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module CmdLine.Option (+	commonOptions,+	matcherOptions,+	flagOption,+	fieldOption,+	optionName,+	ArgDescr(..),+	OptDescr(..),+) where++import System.Console.GetOpt++import Common.Annex+import qualified Annex+import Types.Messages+import Limit+import CmdLine.Usage++commonOptions :: [Option]+commonOptions =+	[ Option [] ["force"] (NoArg (setforce True))+		"allow actions that may lose annexed data"+	, Option ['F'] ["fast"] (NoArg (setfast True))+		"avoid slow operations"+	, Option ['a'] ["auto"] (NoArg (setauto True))+		"automatic mode"+	, Option ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))+		"avoid verbose output"+	, Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))+		"allow verbose output (default)"+	, Option ['d'] ["debug"] (NoArg setdebug)+		"show debug messages"+	, Option [] ["no-debug"] (NoArg unsetdebug)+		"don't show debug messages"+	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)+		"specify key-value backend to use"+	]+  where+	setforce v = Annex.changeState $ \s -> s { Annex.force = v }+	setfast v = Annex.changeState $ \s -> s { Annex.fast = v }+	setauto v = Annex.changeState $ \s -> s { Annex.auto = v }+	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }+	setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }+	unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }++matcherOptions :: [Option]+matcherOptions =+	[ longopt "not" "negate next option"+	, longopt "and" "both previous and next option must match"+	, longopt "or" "either previous or next option must match"+	, shortopt "(" "open group of options"+	, shortopt ")" "close group of options"+	]+  where+	longopt o = Option [] [o] $ NoArg $ addToken o+	shortopt o = Option o [] $ NoArg $ addToken o++{- An option that sets a flag. -}+flagOption :: String -> String -> String -> Option+flagOption short opt description = +	Option short [opt] (NoArg (Annex.setFlag opt)) description++{- An option that sets a field. -}+fieldOption :: String -> String -> String -> String -> Option+fieldOption short opt paramdesc description = +	Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description++{- The flag or field name used for an option. -}+optionName :: Option -> String+optionName (Option _ o _ _) = Prelude.head o
+ CmdLine/Seek.hs view
@@ -0,0 +1,182 @@+{- git-annex command seeking+ - + - These functions find appropriate files or other things based on+ - the values a user passes to a command, and prepare actions operating+ - on them.+ -+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module CmdLine.Seek where++import System.PosixCompat.Files++import Common.Annex+import Types.Command+import Types.Key+import Types.FileMatcher+import qualified Annex+import qualified Git+import qualified Git.Command+import qualified Git.LsFiles as LsFiles+import qualified Limit+import CmdLine.Option+import Logs.Location+import Logs.Unused+import Annex.CatFile+import RunCommand++withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek+withFilesInGit a params = seekActions $ prepFiltered a $+	seekHelper LsFiles.inRepo params++withFilesNotInGit :: (FilePath -> CommandStart) -> CommandSeek+withFilesNotInGit a params = do+	{- dotfiles are not acted on unless explicitly listed -}+	files <- filter (not . dotfile) <$>+		seekunless (null ps && not (null params)) ps+	dotfiles <- seekunless (null dotps) dotps+	seekActions $ prepFiltered a $+		return $ concat $ segmentPaths params (files++dotfiles)+  where+	(dotps, ps) = partition dotfile params+	seekunless True _ = return []+	seekunless _ l = do+		force <- Annex.getState Annex.force+		g <- gitRepo+		liftIO $ Git.Command.leaveZombie <$> LsFiles.notInRepo force l g++withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek+withPathContents a params = seekActions $ +	map a . concat <$> liftIO (mapM get params)+  where+	get p = ifM (isDirectory <$> getFileStatus p)+		( map (\f -> (f, makeRelative (parentDir p) f))+			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p+		, return [(p, takeFileName p)]+		)++withWords :: ([String] -> CommandStart) -> CommandSeek+withWords a params = seekActions $ return [a params]++withStrings :: (String -> CommandStart) -> CommandSeek+withStrings a params = seekActions $ return $ map a params++withPairs :: ((String, String) -> CommandStart) -> CommandSeek+withPairs a params = seekActions $ return $ map a $ pairs [] params+  where+	pairs c [] = reverse c+	pairs c (x:y:xs) = pairs ((x,y):c) xs+	pairs _ _ = error "expected pairs"++withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek+withFilesToBeCommitted a params = seekActions $ prepFiltered a $+	seekHelper LsFiles.stagedNotDeleted params++withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek+withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged++withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek+withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged++{- Unlocked files have changed type from a symlink to a regular file.+ -+ - Furthermore, unlocked files used to be a git-annex symlink,+ - not some other sort of symlink.+ -}+withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek+withFilesUnlocked' typechanged a params = seekActions $+	prepFiltered a unlockedfiles+  where+  	check f = liftIO (notSymlink f) <&&> +		(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)+	unlockedfiles = filterM check =<< seekHelper typechanged params++{- Finds files that may be modified. -}+withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek+withFilesMaybeModified a params = seekActions $+	prepFiltered a $ seekHelper LsFiles.modified params++withKeys :: (Key -> CommandStart) -> CommandSeek+withKeys a params = seekActions $ return $ map (a . parse) params+  where+	parse p = fromMaybe (error "bad key") $ file2key p++{- Gets the value of a field options, which is fed into+ - a conversion function.+ -}+getOptionField :: Option -> (Maybe String -> Annex a) -> Annex a+getOptionField option converter = converter <=< Annex.getField $ optionName option++getOptionFlag :: Option -> Annex Bool+getOptionFlag option = Annex.getFlag (optionName option)++withNothing :: CommandStart -> CommandSeek+withNothing a [] = seekActions $ return [a]+withNothing _ _ = error "This command takes no parameters."++{- If --all is specified, or in a bare repo, runs an action on all+ - known keys.+ -+ - If --unused is specified, runs an action on all keys found by+ - the last git annex unused scan.+ -+ - If --key is specified, operates only on that key.+ -+ - Otherwise, fall back to a regular CommandSeek action on+ - whatever params were passed. -}+withKeyOptions :: (Key -> CommandStart) -> CommandSeek -> CommandSeek+withKeyOptions keyop fallbackop params = do+	bare <- fromRepo Git.repoIsLocalBare+	allkeys <- Annex.getFlag "all"+	unused <- Annex.getFlag "unused"+	specifickey <- Annex.getField "key"+	auto <- Annex.getState Annex.auto+	when (auto && bare) $+		error "Cannot use --auto in a bare repository"+	case	(allkeys, unused, null params, specifickey) of+		(False  , False , True       , Nothing)+			| bare -> go auto loggedKeys+			| otherwise -> fallbackop params+		(False  , False , _          , Nothing) -> fallbackop params+		(True   , False , True       , Nothing) -> go auto loggedKeys+		(False  , True  , True       , Nothing) -> go auto unusedKeys'+		(False  , False , True       , Just ks) -> case file2key ks of+			Nothing -> error "Invalid key"+			Just k -> go auto $ return [k]+		_ -> error "Can only specify one of file names, --all, --unused, or --key"+  where+  	go True _ = error "Cannot use --auto with --all or --unused or --key"+	go False a = do+		matcher <- Limit.getMatcher+		seekActions $ map (process matcher) <$> a+	process matcher k = ifM (matcher $ MatchingKey k)+		( keyop k , return Nothing)++prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]+prepFiltered a fs = do+	matcher <- Limit.getMatcher+	map (process matcher) <$> fs+  where+	process matcher f = ifM (matcher $ MatchingFile $ FileInfo f f)+		( a f , return Nothing )++seekActions :: Annex [CommandStart] -> Annex ()+seekActions gen = do+	as <- gen+	mapM_ commandAction as++seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath]+seekHelper a params = do+	ll <- inRepo $ \g ->+		runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) params+	{- Show warnings only for files/directories that do not exist. -}+	forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p ->+		unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $+			fileNotFound p+	return $ concat ll++notSymlink :: FilePath -> IO Bool+notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
+ CmdLine/Usage.hs view
@@ -0,0 +1,111 @@+{- git-annex usage messages+ -+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module CmdLine.Usage where++import Common.Annex++import Types.Command++import System.Console.GetOpt++usageMessage :: String -> String+usageMessage s = "Usage: " ++ s++{- Usage message with lists of commands by section. -}+usage :: String -> [Command] -> String+usage header cmds = unlines $ usageMessage header : concatMap go [minBound..]+  where+	go section+		| null cs = []+		| otherwise =+			[ ""+			, descSection section ++ ":"+			, ""+			] ++ map cmdline cs+	  where+		cs = filter (\c -> cmdsection c == section) scmds+	cmdline c = concat+		[ cmdname c+		, namepad (cmdname c)+		, cmdparamdesc c+		, descpad (cmdparamdesc c)+		, cmddesc c+		]+	pad n s = replicate (n - length s) ' '+	namepad = pad $ longest cmdname + 1+	descpad = pad $ longest cmdparamdesc + 2+	longest f = foldl max 0 $ map (length . f) cmds+	scmds = sort cmds++{- Usage message for a single command. -}+commandUsage :: Command -> String+commandUsage cmd = unlines+	[ usageInfo header (cmdoptions cmd)+	, "To see additional options common to all commands, run: git annex help options"+	]+  where+	header = usageMessage $ unwords+		[ "git-annex"+		, cmdname cmd+		, cmdparamdesc cmd+		, "[option ...]"+		]++{- Descriptions of params used in usage messages. -}+paramPaths :: String+paramPaths = paramOptional $ paramRepeating paramPath -- most often used+paramPath :: String+paramPath = "PATH"+paramKey :: String+paramKey = "KEY"+paramDesc :: String+paramDesc = "DESC"+paramUrl :: String+paramUrl = "URL"+paramNumber :: String+paramNumber = "NUMBER"+paramNumRange :: String+paramNumRange = "NUM|RANGE"+paramRemote :: String+paramRemote = "REMOTE"+paramGlob :: String+paramGlob = "GLOB"+paramName :: String+paramName = "NAME"+paramValue :: String+paramValue = "VALUE"+paramUUID :: String+paramUUID = "UUID"+paramType :: String+paramType = "TYPE"+paramDate :: String+paramDate = "DATE"+paramTime :: String+paramTime = "TIME"+paramFormat :: String+paramFormat = "FORMAT"+paramFile :: String+paramFile = "FILE"+paramGroup :: String+paramGroup = "GROUP"+paramExpression :: String+paramExpression = "EXPR"+paramSize :: String+paramSize = "SIZE"+paramAddress :: String+paramAddress = "ADDRESS"+paramKeyValue :: String+paramKeyValue = "K=V"+paramNothing :: String+paramNothing = ""+paramRepeating :: String -> String+paramRepeating s = s ++ " ..."+paramOptional :: String -> String+paramOptional s = "[" ++ s ++ "]"+paramPair :: String -> String -> String+paramPair a b = a ++ " " ++ b
Command.hs view
@@ -1,10 +1,12 @@ {- git-annex command infrastructure  -- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE BangPatterns #-}+ module Command ( 	command, 	noRepo,@@ -14,13 +16,9 @@ 	next, 	stop, 	stopUnless,-	prepCommand,-	doCommand, 	whenAnnexed, 	ifAnnexed, 	isBareRepo,-	numCopies,-	numCopiesCheck, 	checkAuto, 	module ReExported ) where@@ -29,18 +27,17 @@ import qualified Backend import qualified Annex import qualified Git-import qualified Remote import Types.Command as ReExported import Types.Option as ReExported-import Seek as ReExported+import CmdLine.Seek as ReExported import Checks as ReExported-import Usage as ReExported-import Logs.Trust-import Config-import Annex.CheckAttr+import CmdLine.Usage as ReExported+import RunCommand as ReExported+import CmdLine.Option as ReExported+import CmdLine.GitAnnex.Options as ReExported  {- Generates a normal command -}-command :: String -> String -> [CommandSeek] -> CommandSection -> String -> Command+command :: String -> String -> CommandSeek -> CommandSection -> String -> Command command = Command [] Nothing commonChecks False False  {- Indicates that a command doesn't need to commit any changes to@@ -74,25 +71,6 @@ stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a) stopUnless c a = ifM c ( a , stop ) -{- Prepares to run a command via the check and seek stages, returning a- - list of actions to perform to run the command. -}-prepCommand :: Command -> [String] -> Annex [CommandCleanup]-prepCommand Command { cmdseek = seek, cmdcheck = c } params = do-	mapM_ runCheck c-	map doCommand . concat <$> mapM (\s -> s params) seek--{- Runs a command through the start, perform and cleanup stages -}-doCommand :: CommandStart -> CommandCleanup-doCommand = start-  where-	start   = stage $ maybe skip perform-	perform = stage $ maybe failure cleanup-	cleanup = stage $ status-	stage = (=<<)-	skip = return True-	failure = showEndFail >> return False-	status r = showEndResult r >> return r- {- Modifies an action to only act on files that are already annexed,  - and passes the key and backend on to it. -} whenAnnexed :: (FilePath -> (Key, Backend) -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)@@ -103,20 +81,6 @@  isBareRepo :: Annex Bool isBareRepo = fromRepo Git.repoIsLocalBare--numCopies :: FilePath  -> Annex (Maybe Int)-numCopies file = do-	forced <- Annex.getState Annex.forcenumcopies-	case forced of-		Just n -> return $ Just n-		Nothing -> readish <$> checkAttr "annex.numcopies" file--numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v-numCopiesCheck file key vs = do-	numcopiesattr <- numCopies file-	needed <- getNumCopies numcopiesattr-	have <- trustExclude UnTrusted =<< Remote.keyLocations key-	return $ length have `vs` needed  checkAuto :: Annex Bool -> Annex Bool checkAuto checker = ifM (Annex.getState Annex.auto)
Command/Add.hs view
@@ -41,18 +41,18 @@ {- Add acts on both files not checked into git yet, and unlocked files.  -  - In direct mode, it acts on any files that have changed. -}-seek :: [CommandSeek]-seek =-	[ go withFilesNotInGit-	, whenNotDirect $ go withFilesUnlocked-	, whenDirect $ go withFilesMaybeModified-	]-  where-  	go a = withValue largeFilesMatcher $ \matcher ->-		a $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)-			( start file-			, stop-			)+seek :: CommandSeek+seek ps = do+	matcher <- largeFilesMatcher+	let go a = flip a ps $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)+		( start file+		, stop+		)+	go withFilesNotInGit+	ifM isDirect+		( go withFilesMaybeModified+		, go withFilesUnlocked+		)  {- The add subcommand annexes a file, generating a key for it using a  - backend, and then moving it into the annex directory and setting up
Command/AddUnused.hs view
@@ -18,8 +18,8 @@ def = [notDirect $ command "addunused" (paramRepeating paramNumRange) 	seek SectionMaintenance "add back unused files"] -seek :: [CommandSeek]-seek = [withUnusedMaps start]+seek :: CommandSeek+seek = withUnusedMaps start  start :: UnusedMaps -> Int -> CommandStart start = startUnused "addunused" perform
Command/AddUrl.hs view
@@ -21,7 +21,6 @@ import qualified Backend.URL import Annex.Content import Logs.Web-import qualified Option import Types.Key import Types.KeySource import Config@@ -39,19 +38,20 @@ 		SectionCommon "add urls to annex"]  fileOption :: Option-fileOption = Option.field [] "file" paramFile "specify what file the url is added to"+fileOption = fieldOption [] "file" paramFile "specify what file the url is added to"  pathdepthOption :: Option-pathdepthOption = Option.field [] "pathdepth" paramNumber "path components to use in filename"+pathdepthOption = fieldOption [] "pathdepth" paramNumber "path components to use in filename"  relaxedOption :: Option-relaxedOption = Option.flag [] "relaxed" "skip size check"+relaxedOption = flagOption [] "relaxed" "skip size check" -seek :: [CommandSeek]-seek = [withField fileOption return $ \f ->-	withFlag relaxedOption $ \relaxed ->-	withField pathdepthOption (return . maybe Nothing readish) $ \d ->-	withStrings $ start relaxed f d]+seek :: CommandSeek+seek ps = do+	f <- getOptionField fileOption return+	relaxed <- getOptionFlag relaxedOption+	d <- getOptionField pathdepthOption (return . maybe Nothing readish)+	withStrings (start relaxed f d) ps  start :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s
Command/Assistant.hs view
@@ -9,9 +9,8 @@  import Common.Annex import Command-import qualified Option import qualified Command.Watch-import Init+import Annex.Init import Config.Files import qualified Build.SysConfig import Utility.HumanTime@@ -32,17 +31,18 @@ 	]  autoStartOption :: Option-autoStartOption = Option.flag [] "autostart" "start in known repositories"+autoStartOption = flagOption [] "autostart" "start in known repositories"  startDelayOption :: Option-startDelayOption = Option.field [] "startdelay" paramNumber "delay before running startup scan"+startDelayOption = fieldOption [] "startdelay" paramNumber "delay before running startup scan" -seek :: [CommandSeek]-seek = [withFlag Command.Watch.stopOption $ \stopdaemon ->-	withFlag Command.Watch.foregroundOption $ \foreground ->-	withFlag autoStartOption $ \autostart ->-	withField startDelayOption (pure . maybe Nothing parseDuration) $ \startdelay -> -	withNothing $ start foreground stopdaemon autostart startdelay]+seek :: CommandSeek+seek ps = do+	stopdaemon <- getOptionFlag Command.Watch.stopOption+	foreground <- getOptionFlag Command.Watch.foregroundOption+	autostart <- getOptionFlag autoStartOption+	startdelay <- getOptionField startDelayOption (pure . maybe Nothing parseDuration)+	withNothing (start foreground stopdaemon autostart startdelay) ps  start :: Bool -> Bool -> Bool -> Maybe Duration -> CommandStart start foreground stopdaemon autostart startdelay
Command/Commit.hs view
@@ -16,8 +16,8 @@ def = [command "commit" paramNothing seek 	SectionPlumbing "commits any staged changes to the git-annex branch"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = next $ next $ do
Command/ConfigList.hs view
@@ -17,8 +17,8 @@ def = [noCommit $ command "configlist" paramNothing seek 	SectionPlumbing "outputs relevant git configuration"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = do
Command/Copy.hs view
@@ -9,22 +9,23 @@  import Common.Annex import Command-import GitAnnex.Options import qualified Command.Move import qualified Remote import Annex.Wanted+import Config.NumCopies  def :: [Command] def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek 	SectionCommon "copy content of files to/from another repository"] -seek :: [CommandSeek]-seek =-	[ withField toOption Remote.byNameWithUUID $ \to ->-	  withField fromOption Remote.byNameWithUUID $ \from ->-	  withKeyOptions (Command.Move.startKey to from False) $-	  withFilesInGit $ whenAnnexed $ start to from-	]+seek :: CommandSeek+seek ps = do+	to <- getOptionField toOption Remote.byNameWithUUID+	from <- getOptionField fromOption Remote.byNameWithUUID+	withKeyOptions+	 	(Command.Move.startKey to from False)+		(withFilesInGit $ whenAnnexed $ start to from)+		ps  {- A copy is just a move that does not delete the source file.  - However, --auto mode avoids unnecessary copies, and avoids getting or@@ -35,5 +36,5 @@   where 	shouldCopy = checkAuto (check <||> numCopiesCheck file key (<)) 	check = case to of-		Nothing -> wantGet False (Just file)-		Just r -> wantSend False (Just file) (Remote.uuid r)+		Nothing -> wantGet False (Just key) (Just file)+		Just r -> wantSend False (Just key) (Just file) (Remote.uuid r)
Command/Dead.hs view
@@ -19,8 +19,8 @@ def = [command "dead" (paramRepeating paramRemote) seek 	SectionSetup "hide a lost repository"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start ws = do
Command/Describe.hs view
@@ -16,8 +16,8 @@ def = [command "describe" (paramPair paramRemote paramDesc) seek 	SectionSetup "change description of a repository"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start (name:description) = do
Command/Direct.hs view
@@ -23,8 +23,8 @@ 	command "direct" paramNothing seek 		SectionSetup "switch repository to direct mode"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = ifM isDirect ( stop , next perform )
Command/Drop.hs view
@@ -14,26 +14,25 @@ import Annex.UUID import Logs.Location import Logs.Trust+import Config.NumCopies import Annex.Content-import Config-import qualified Option import Annex.Wanted-import Types.Key  def :: [Command]-def = [withOptions [fromOption] $ command "drop" paramPaths seek+def = [withOptions [dropFromOption] $ command "drop" paramPaths seek 	SectionCommon "indicate content of files not currently wanted"] -fromOption :: Option-fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote"+dropFromOption :: Option+dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote" -seek :: [CommandSeek]-seek = [withField fromOption Remote.byNameWithUUID $ \from ->-	withFilesInGit $ whenAnnexed $ start from]+seek :: CommandSeek+seek ps = do+	from <- getOptionField dropFromOption Remote.byNameWithUUID+	withFilesInGit (whenAnnexed $ start from) ps  start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart start from file (key, _) = checkDropAuto from file key $ \numcopies ->-	stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just file)) $+	stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just key) (Just file)) $ 		case from of 			Nothing -> startLocal (Just file) numcopies key Nothing 			Just remote -> do@@ -42,17 +41,17 @@ 					then startLocal (Just file) numcopies key Nothing 					else startRemote (Just file) numcopies key remote -startLocal :: AssociatedFile -> Maybe Int -> Key -> Maybe Remote -> CommandStart+startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do-	showStart "drop" (fromMaybe (key2file key) afile)+	showStart' "drop" key afile 	next $ performLocal key numcopies knownpresentremote -startRemote :: AssociatedFile -> Maybe Int -> Key -> Remote -> CommandStart+startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart startRemote afile numcopies key remote = do-	showStart ("drop " ++ Remote.name remote) (fromMaybe (key2file key) afile)+	showStart' ("drop " ++ Remote.name remote) key afile 	next $ performRemote key numcopies remote -performLocal :: Key -> Maybe Int -> Maybe Remote -> CommandPerform+performLocal :: Key -> NumCopies -> Maybe Remote -> CommandPerform performLocal key numcopies knownpresentremote = lockContent key $ do 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key 	let trusteduuids' = case knownpresentremote of@@ -64,7 +63,7 @@ 		removeAnnex key 		next $ cleanupLocal key -performRemote :: Key -> Maybe Int -> Remote -> CommandPerform+performRemote :: Key -> NumCopies -> Remote -> CommandPerform performRemote key numcopies remote = lockContent key $ do 	-- Filter the remote it's being dropped from out of the lists of 	-- places assumed to have the key, and places to check.@@ -97,23 +96,21 @@ {- Checks specified remotes to verify that enough copies of a key exist to  - allow it to be safely removed (with no data loss). Can be provided with  - some locations where the key is known/assumed to be present. -}-canDropKey :: Key -> Maybe Int -> [UUID] -> [Remote] -> [UUID] -> Annex Bool-canDropKey key numcopiesM have check skip = do+canDropKey :: Key -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool+canDropKey key numcopies have check skip = do 	force <- Annex.getState Annex.force-	if force || numcopiesM == Just 0+	if force || numcopies == NumCopies 0 		then return True-		else do-			need <- getNumCopies numcopiesM-			findCopies key need skip have check+		else findCopies key numcopies skip have check -findCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool+findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool findCopies key need skip = helper [] []   where 	helper bad missing have []-		| length have >= need = return True+		| NumCopies (length have) >= need = return True 		| otherwise = notEnoughCopies key need have (skip++missing) bad 	helper bad missing have (r:rs)-		| length have >= need = return True+		| NumCopies (length have) >= need = return True 		| otherwise = do 			let u = Remote.uuid r 			let duplicate = u `elem` have@@ -124,12 +121,12 @@ 				(False, Right False) -> helper bad (u:missing) have rs 				_                    -> helper bad missing have rs -notEnoughCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool+notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool notEnoughCopies key need have skip bad = do 	unsafe 	showLongNote $ 		"Could only verify the existence of " ++-		show (length have) ++ " out of " ++ show need ++ +		show (length have) ++ " out of " ++ show (fromNumCopies need) ++  		" necessary copies" 	Remote.showTriedRemotes bad 	Remote.showLocations key (have++skip)@@ -138,25 +135,21 @@ 	return False   where 	unsafe = showNote "unsafe"-	hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)"+	hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"  {- In auto mode, only runs the action if there are enough- - copies on other semitrusted repositories.- -- - Passes any numcopies attribute of the file on to the action as an- - optimisation. -}-checkDropAuto :: Maybe Remote -> FilePath -> Key -> (Maybe Int -> CommandStart) -> CommandStart+ - copies on other semitrusted repositories. -}+checkDropAuto :: Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart checkDropAuto mremote file key a = do-	numcopiesattr <- numCopies file-	Annex.getState Annex.auto >>= auto numcopiesattr+	numcopies <- getFileNumCopies file+	Annex.getState Annex.auto >>= auto numcopies   where-	auto numcopiesattr False = a numcopiesattr-	auto numcopiesattr True = do-		needed <- getNumCopies numcopiesattr+	auto numcopies False = a numcopies+	auto numcopies True = do 		locs <- Remote.keyLocations key 		uuid <- getUUID 		let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote 		locs' <- trustExclude UnTrusted $ filter (/= remoteuuid) locs-		if length locs' >= needed-			then a numcopiesattr+		if NumCopies (length locs') >= numcopies+			then a numcopies 			else stop
Command/DropKey.hs view
@@ -12,20 +12,19 @@ import qualified Annex import Logs.Location import Annex.Content-import Types.Key  def :: [Command] def = [noCommit $ command "dropkey" (paramRepeating paramKey) seek 	SectionPlumbing "drops annexed content for specified keys"]  -seek :: [CommandSeek]-seek = [withKeys start]+seek :: CommandSeek+seek = withKeys start  start :: Key -> CommandStart start key = stopUnless (inAnnex key) $ do 	unlessM (Annex.getState Annex.force) $ 		error "dropkey can cause data loss; use --force if you're sure you want to do this"-	showStart "dropkey" (key2file key)+	showStart' "dropkey" key Nothing 	next $ perform key  perform :: Key -> CommandPerform
Command/DropUnused.hs view
@@ -13,28 +13,30 @@ import qualified Command.Drop import qualified Remote import qualified Git-import qualified Option import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)+import Config.NumCopies  def :: [Command]-def = [withOptions [Command.Drop.fromOption] $+def = [withOptions [Command.Drop.dropFromOption] $ 	command "dropunused" (paramRepeating paramNumRange) 		seek SectionMaintenance "drop unused file content"] -seek :: [CommandSeek]-seek = [withUnusedMaps start]+seek :: CommandSeek+seek ps = do+	numcopies <- getNumCopies+	withUnusedMaps (start numcopies) ps -start :: UnusedMaps -> Int -> CommandStart-start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation)+start :: NumCopies -> UnusedMaps -> Int -> CommandStart+start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation) -perform :: Key -> CommandPerform-perform key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from+perform :: NumCopies -> Key -> CommandPerform+perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from   where 	dropremote r = do 		showAction $ "from " ++ Remote.name r-		Command.Drop.performRemote key Nothing r-	droplocal = Command.Drop.performLocal key Nothing Nothing-	from = Annex.getField $ Option.name Command.Drop.fromOption+		Command.Drop.performRemote key numcopies r+	droplocal = Command.Drop.performLocal key numcopies Nothing+	from = Annex.getField $ optionName Command.Drop.dropFromOption  performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform performOther filespec key = do
Command/EnableRemote.hs view
@@ -20,8 +20,8 @@ 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) 	seek SectionSetup "enables use of an existing special remote"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start [] = unknownNameError "Specify the name of the special remote to enable."@@ -40,10 +40,10 @@ unknownNameError :: String -> Annex a unknownNameError prefix = do 	names <- InitRemote.remoteNames-	error $ prefix +++	error $ prefix ++ "\n" ++ 		if null names-			then ""-			else " Known special remotes: " ++ unwords names+			then "(No special remotes are currently known; perhaps use initremote instead?)"+			else "Known special remotes: " ++ unwords names  perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform perform t u c = do
Command/ExamineKey.hs view
@@ -10,16 +10,18 @@ import Common.Annex import Command import qualified Utility.Format-import Command.Find (formatOption, withFormat, showFormatted, keyVars)+import Command.Find (formatOption, getFormat, showFormatted, keyVars) import Types.Key  def :: [Command]-def = [noCommit $ noMessages $ withOptions [formatOption] $+def = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $ 	command "examinekey" (paramRepeating paramKey) seek 	SectionPlumbing "prints information from a key"] -seek :: [CommandSeek]-seek = [withFormat $ \f -> withKeys $ start f]+seek :: CommandSeek+seek ps = do+	format <- getFormat+	withKeys (start format) ps  start :: Maybe Utility.Format.Format -> Key -> CommandStart start format key = do
Command/Find.hs view
@@ -17,26 +17,27 @@ import qualified Utility.Format import Utility.DataUnits import Types.Key-import qualified Option  def :: [Command]-def = [noCommit $ noMessages $ withOptions [formatOption, print0Option] $+def = [noCommit $ noMessages $ withOptions [formatOption, print0Option, jsonOption] $ 	command "find" paramPaths seek SectionQuery "lists available files"]  formatOption :: Option-formatOption = Option.field [] "format" paramFormat "control format of output"+formatOption = fieldOption [] "format" paramFormat "control format of output" -withFormat :: (Maybe Utility.Format.Format -> CommandSeek) -> CommandSeek-withFormat = withField formatOption $ return . fmap Utility.Format.gen+getFormat :: Annex (Maybe Utility.Format.Format)+getFormat = getOptionField formatOption $ return . fmap Utility.Format.gen  print0Option :: Option-print0Option = Option.Option [] ["print0"] (Option.NoArg set)+print0Option = Option [] ["print0"] (NoArg set) 	"terminate output with null"   where-	set = Annex.setField (Option.name formatOption) "${file}\0"+	set = Annex.setField (optionName formatOption) "${file}\0" -seek :: [CommandSeek]-seek = [withFormat $ \f -> withFilesInGit $ whenAnnexed $ start f]+seek :: CommandSeek+seek ps = do+	format <- getFormat+	withFilesInGit (whenAnnexed $ start format) ps  start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart start format file (key, _) = do
Command/Fix.hs view
@@ -24,8 +24,8 @@ def = [notDirect $ noCommit $ command "fix" paramPaths seek 	SectionMaintenance "fix up symlinks to point to annexed content"] -seek :: [CommandSeek]-seek = [withFilesInGit $ whenAnnexed start]+seek :: CommandSeek+seek = withFilesInGit $ whenAnnexed start  {- Fixes the symlink to an annexed file. -} start :: FilePath -> (Key, Backend) -> CommandStart
Command/Forget.hs view
@@ -12,7 +12,6 @@ import qualified Annex.Branch as Branch import Logs.Transitions import qualified Annex-import qualified Option  import Data.Time.Clock.POSIX @@ -24,11 +23,12 @@ forgetOptions = [dropDeadOption]  dropDeadOption :: Option-dropDeadOption = Option.flag [] "drop-dead" "drop references to dead repositories"+dropDeadOption = flagOption [] "drop-dead" "drop references to dead repositories" -seek :: [CommandSeek]-seek = [withFlag dropDeadOption $ \dropdead ->-	withNothing $ start dropdead]+seek :: CommandSeek+seek ps = do+	dropdead <- getOptionFlag dropDeadOption+	withNothing (start dropdead) ps  start :: Bool -> CommandStart start dropdead = do
Command/FromKey.hs view
@@ -20,8 +20,8 @@ 	command "fromkey" (paramPair paramKey paramPath) seek 		SectionPlumbing "adds a file using a specific key"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start (keyname:file:[]) = do
Command/Fsck.hs view
@@ -25,15 +25,14 @@ import Annex.Link import Logs.Location import Logs.Trust+import Config.NumCopies import Annex.UUID import Utility.DataUnits import Utility.FileMode import Config-import qualified Option import Types.Key import Utility.HumanTime import Git.FilePath-import GitAnnex.Options hiding (fromOption)  #ifndef mingw32_HOST_OS import System.Posix.Process (getProcessID)@@ -49,41 +48,42 @@ def = [withOptions fsckOptions $ command "fsck" paramPaths seek 	SectionMaintenance "check for problems"] -fromOption :: Option-fromOption = Option.field ['f'] "from" paramRemote "check remote"+fsckFromOption :: Option+fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote"  startIncrementalOption :: Option-startIncrementalOption = Option.flag ['S'] "incremental" "start an incremental fsck"+startIncrementalOption = flagOption ['S'] "incremental" "start an incremental fsck"  moreIncrementalOption :: Option-moreIncrementalOption = Option.flag ['m'] "more" "continue an incremental fsck"+moreIncrementalOption = flagOption ['m'] "more" "continue an incremental fsck"  incrementalScheduleOption :: Option-incrementalScheduleOption = Option.field [] "incremental-schedule" paramTime+incrementalScheduleOption = fieldOption [] "incremental-schedule" paramTime 	"schedule incremental fscking"  fsckOptions :: [Option] fsckOptions = -	[ fromOption+	[ fsckFromOption 	, startIncrementalOption 	, moreIncrementalOption 	, incrementalScheduleOption 	] ++ keyOptions -seek :: [CommandSeek]-seek =-	[ withField fromOption Remote.byNameWithUUID $ \from ->-	  withIncremental $ \i ->-	  withKeyOptions (startKey i) $-	  withFilesInGit $ whenAnnexed $ start from i-	]+seek :: CommandSeek+seek ps = do+	from <- getOptionField fsckFromOption Remote.byNameWithUUID+	i <- getIncremental+	withKeyOptions+		(startKey i)+		(withFilesInGit $ whenAnnexed $ start from i)+		ps -withIncremental :: (Incremental -> CommandSeek) -> CommandSeek-withIncremental = withValue $ do+getIncremental :: Annex Incremental+getIncremental = do 	i <- maybe (return False) (checkschedule . parseDuration)-		=<< Annex.getField (Option.name incrementalScheduleOption)-	starti <- Annex.getFlag (Option.name startIncrementalOption)-	morei <- Annex.getFlag (Option.name moreIncrementalOption)+		=<< Annex.getField (optionName incrementalScheduleOption)+	starti <- Annex.getFlag (optionName startIncrementalOption)+	morei <- Annex.getFlag (optionName moreIncrementalOption) 	case (i, starti, morei) of 		(False, False, False) -> return NonIncremental 		(False, True, _) -> startIncremental@@ -110,14 +110,14 @@  start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart start from inc file (key, backend) = do-	numcopies <- numCopies file+	numcopies <- getFileNumCopies file 	case from of 		Nothing -> go $ perform key file backend numcopies 		Just r -> go $ performRemote key file backend numcopies r   where 	go = runFsck inc file key -perform :: Key -> FilePath -> Backend -> Maybe Int -> Annex Bool+perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool perform key file backend numcopies = check 	-- order matters 	[ fixLink key file@@ -131,7 +131,7 @@  {- To fsck a remote, the content is retrieved to a tmp file,  - and checked locally. -}-performRemote :: Key -> FilePath -> Backend -> Maybe Int -> Remote -> Annex Bool+performRemote :: Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool performRemote key file backend numcopies remote = 	dispatch =<< Remote.hasKey remote key   where@@ -367,27 +367,26 @@ 				, return True 				) -checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool+checkKeyNumCopies :: Key -> FilePath -> NumCopies -> Annex Bool checkKeyNumCopies key file numcopies = do-	needed <- getNumCopies numcopies 	(untrustedlocations, safelocations) <- trustPartition UnTrusted =<< Remote.keyLocations key-	let present = length safelocations-	if present < needed+	let present = NumCopies (length safelocations)+	if present < numcopies 		then do 			ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations-			warning $ missingNote file present needed ppuuids+			warning $ missingNote file present numcopies ppuuids 			return False 		else return True -missingNote :: String -> Int -> Int -> String -> String-missingNote file 0 _ [] = +missingNote :: String -> NumCopies -> NumCopies -> String -> String+missingNote file (NumCopies 0) _ [] =  		"** No known copies exist of " ++ file-missingNote file 0 _ untrusted =+missingNote file (NumCopies 0) _ untrusted = 		"Only these untrusted locations may have copies of " ++ file ++ 		"\n" ++ untrusted ++ 		"Back it up to trusted locations with git-annex copy." missingNote file present needed [] =-		"Only " ++ show present ++ " of " ++ show needed ++ +		"Only " ++ show (fromNumCopies present) ++ " of " ++ show (fromNumCopies needed) ++  		" trustworthy copies exist of " ++ file ++ 		"\nBack it up with git-annex copy." missingNote file present needed untrusted =
Command/FuzzTest.hs view
@@ -25,8 +25,8 @@ def = [ notBareRepo $ command "fuzztest" paramNothing seek SectionPlumbing 	"generates fuzz test files"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = do
Command/GCryptSetup.hs view
@@ -18,8 +18,8 @@ 	command "gcryptsetup" paramValue seek 		SectionPlumbing "sets up gcrypt repository"] -seek :: [CommandSeek]-seek = [withStrings start]+seek :: CommandSeek+seek = withStrings start  start :: String -> CommandStart start gcryptid = next $ next $ do
Command/Get.hs view
@@ -12,10 +12,9 @@ import qualified Remote import Annex.Content import Logs.Transfer+import Config.NumCopies import Annex.Wanted-import GitAnnex.Options import qualified Command.Move-import Types.Key  def :: [Command] def = [withOptions getOptions $ command "get" paramPaths seek@@ -24,17 +23,18 @@ getOptions :: [Option] getOptions = fromOption : keyOptions -seek :: [CommandSeek]-seek = -	[ withField fromOption Remote.byNameWithUUID $ \from ->-	  withKeyOptions (startKeys from) $-	  withFilesInGit $ whenAnnexed $ start from-	]+seek :: CommandSeek+seek ps = do+	from <- getOptionField fromOption Remote.byNameWithUUID+	withKeyOptions+		(startKeys from)+		(withFilesInGit $ whenAnnexed $ start from)+		ps  start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart start from file (key, _) = start' expensivecheck from key (Just file)   where-	expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file))+	expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file))  startKeys :: Maybe Remote -> Key -> CommandStart startKeys from key = start' (return True) from key Nothing@@ -49,7 +49,7 @@ 					go $ Command.Move.fromPerform src False key afile   where   	go a = do-		showStart "get" (fromMaybe (key2file key) afile)+		showStart' "get" key afile 		next a  perform :: Key -> AssociatedFile -> CommandPerform@@ -59,7 +59,11 @@ {- Try to find a copy of the file in one of the remotes,  - and copy it to here. -} getKeyFile :: Key -> AssociatedFile -> FilePath -> Annex Bool-getKeyFile key afile dest = dispatch =<< Remote.keyPossibilities key+getKeyFile key afile dest = getKeyFile' key afile dest+	=<< Remote.keyPossibilities key++getKeyFile' :: Key -> AssociatedFile -> FilePath -> [Remote] -> Annex Bool+getKeyFile' key afile dest = dispatch   where 	dispatch [] = do 		showNote "not available"
Command/Group.hs view
@@ -19,8 +19,8 @@ def = [command "group" (paramPair paramRemote paramDesc) seek 	SectionSetup "add a repository to a group"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start (name:g:[]) = do
Command/Help.hs view
@@ -18,7 +18,6 @@ import qualified Command.Sync import qualified Command.Whereis import qualified Command.Fsck-import GitAnnex.Options  import System.Console.GetOpt @@ -26,8 +25,8 @@ def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ 	command "help" paramNothing seek SectionQuery "display help"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start params = do@@ -42,7 +41,7 @@ start' _ = showGeneralHelp  showCommonOptions :: IO ()-showCommonOptions = putStrLn $ usageInfo "Common options:" options+showCommonOptions = putStrLn $ usageInfo "Common options:" gitAnnexOptions  showGeneralHelp :: IO () showGeneralHelp = putStrLn $ unlines
Command/Import.hs view
@@ -13,7 +13,6 @@ import Command import qualified Annex import qualified Command.Add-import qualified Option import Utility.CopyFile import Backend import Remote@@ -32,16 +31,16 @@ 	]  duplicateOption :: Option-duplicateOption = Option.flag [] "duplicate" "do not delete source files"+duplicateOption = flagOption [] "duplicate" "do not delete source files"  deduplicateOption :: Option-deduplicateOption = Option.flag [] "deduplicate" "delete source files whose content was imported before"+deduplicateOption = flagOption [] "deduplicate" "delete source files whose content was imported before"  cleanDuplicatesOption :: Option-cleanDuplicatesOption = Option.flag [] "clean-duplicates" "delete duplicate source files (import nothing)"+cleanDuplicatesOption = flagOption [] "clean-duplicates" "delete duplicate source files (import nothing)"  skipDuplicatesOption :: Option-skipDuplicatesOption = Option.flag [] "skip-duplicates" "import only new files"+skipDuplicatesOption = flagOption [] "skip-duplicates" "import only new files"  data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates 	deriving (Eq)@@ -53,7 +52,7 @@ 	<*> getflag cleanDuplicatesOption 	<*> getflag skipDuplicatesOption   where-  	getflag = Annex.getFlag . Option.name+  	getflag = Annex.getFlag . optionName   	gen False False False False = Default 	gen True False False False = Duplicate 	gen False True False False = DeDuplicate@@ -61,8 +60,10 @@ 	gen False False False True = SkipDuplicates 	gen _ _ _ _ = error "bad combination of --duplicate, --deduplicate, --clean-duplicates, --skip-duplicates" -seek :: [CommandSeek]-seek = [withValue getDuplicateMode $ \mode -> withPathContents $ start mode]+seek :: CommandSeek+seek ps = do+	mode <- getDuplicateMode+	withPathContents (start mode) ps  start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart start mode (srcfile, destfile) =
Command/ImportFeed.hs view
@@ -21,7 +21,6 @@ import Command import qualified Annex.Url as Url import Logs.Web-import qualified Option import qualified Utility.Format import Utility.Tmp import Command.AddUrl (addUrlFile, relaxedOption)@@ -39,13 +38,14 @@ 		SectionCommon "import files from podcast feeds"]  templateOption :: Option-templateOption = Option.field [] "template" paramFormat "template for filenames"+templateOption = fieldOption [] "template" paramFormat "template for filenames" -seek :: [CommandSeek]-seek = [withField templateOption return $ \tmpl ->-	withFlag relaxedOption $ \relaxed ->-	withValue (getCache tmpl) $ \cache ->-	withStrings $ start relaxed cache]+seek :: CommandSeek+seek ps = do+	tmpl <- getOptionField templateOption return+	relaxed <- getOptionFlag relaxedOption+	cache <- getCache tmpl+	withStrings (start relaxed cache) ps  start :: Bool -> Cache -> URLString -> CommandStart start relaxed cache url = do
Command/InAnnex.hs view
@@ -15,8 +15,8 @@ def = [noCommit $ command "inannex" (paramRepeating paramKey) seek 	SectionPlumbing "checks if keys are present in the annex"] -seek :: [CommandSeek]-seek = [withKeys start]+seek :: CommandSeek+seek = withKeys start  start :: Key -> CommandStart start key = inAnnexSafe key >>= dispatch
Command/Indirect.hs view
@@ -23,7 +23,7 @@ import Annex.Content.Direct import Annex.CatFile import Annex.Exception-import Init+import Annex.Init import qualified Command.Add  def :: [Command]@@ -31,8 +31,8 @@ 	command "indirect" paramNothing seek 		SectionSetup "switch repository to indirect mode"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = ifM isDirect
Command/Info.hs view
@@ -28,6 +28,7 @@ import Types.Key import Logs.UUID import Logs.Trust+import Config.NumCopies import Remote import Config import Utility.Percentage@@ -70,11 +71,12 @@ type StatState = StateT StatInfo Annex  def :: [Command]-def = [noCommit $ command "info" paramPaths seek-	SectionQuery "shows general information about the annex"]+def = [noCommit $ withOptions [jsonOption] $+	command "info" paramPaths seek SectionQuery+	"shows general information about the annex"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [FilePath] -> CommandStart start [] = do@@ -310,7 +312,7 @@   where 	initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) 	update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) =-		ifM (matcher $ FileInfo file file)+		ifM (matcher $ MatchingFile $ FileInfo file file) 			( do 				!presentdata' <- ifM (inAnnex key) 					( return $ addKey key presentdata
Command/Init.hs view
@@ -9,14 +9,14 @@  import Common.Annex import Command-import Init+import Annex.Init 	 def :: [Command] def = [dontCheck repoExists $ 	command "init" paramDesc seek SectionSetup "initialize git-annex"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start ws = do
Command/InitRemote.hs view
@@ -24,8 +24,8 @@ 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) 	seek SectionSetup "creates a special (non-git) remote"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start [] = error "Specify a name for the remote."
Command/List.hs view
@@ -20,7 +20,6 @@ import Logs.Trust import Logs.UUID import Annex.UUID-import qualified Option import qualified Annex import Git.Types (RemoteName) @@ -29,16 +28,16 @@ 	SectionQuery "show which remotes contain files"]  allrepos :: Option-allrepos = Option.flag [] "allrepos" "show all repositories, not only remotes"+allrepos = flagOption [] "allrepos" "show all repositories, not only remotes" -seek :: [CommandSeek]-seek = -	[ withValue getList $ withNothing . startHeader-	, withValue getList $ withFilesInGit . whenAnnexed . start-	]+seek :: CommandSeek+seek ps = do+	list <- getList+	printHeader list+	withFilesInGit (whenAnnexed $ start list) ps  getList :: Annex [(UUID, RemoteName, TrustLevel)]-getList = ifM (Annex.getFlag $ Option.name allrepos)+getList = ifM (Annex.getFlag $ optionName allrepos) 	( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAll) 	, getRemotes 	)@@ -58,10 +57,8 @@ 		return $ sortBy (comparing snd3) $ 			filter (\t -> thd3 t /= DeadTrusted) rs3 -startHeader :: [(UUID, RemoteName, TrustLevel)] -> CommandStart-startHeader l = do-	liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l-	stop+printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()+printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l  start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> (Key, Backend) -> CommandStart start l file (key, _) = do
Command/Lock.hs view
@@ -16,8 +16,10 @@ def = [notDirect $ command "lock" paramPaths seek SectionCommon 	"undo unlock command"] -seek :: [CommandSeek]-seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start]+seek :: CommandSeek+seek ps = do+	withFilesUnlocked start ps+	withFilesUnlockedToBeCommitted start ps  start :: FilePath -> CommandStart start file = do
Command/Log.hs view
@@ -24,7 +24,6 @@ import qualified Git import Git.Command import qualified Remote-import qualified Option import qualified Annex  data RefChange = RefChange @@ -44,25 +43,26 @@  passthruOptions :: [Option] passthruOptions = map odate ["since", "after", "until", "before"] ++-	[ Option.field ['n'] "max-count" paramNumber+	[ fieldOption ['n'] "max-count" paramNumber 		"limit number of logs displayed" 	]   where-	odate n = Option.field [] n paramDate $ "show log " ++ n ++ " date"+	odate n = fieldOption [] n paramDate $ "show log " ++ n ++ " date"  gourceOption :: Option-gourceOption = Option.flag [] "gource" "format output for gource"+gourceOption = flagOption [] "gource" "format output for gource" -seek :: [CommandSeek]-seek = [withValue Remote.uuidDescriptions $ \m ->-	withValue (liftIO getCurrentTimeZone) $ \zone ->-	withValue (concat <$> mapM getoption passthruOptions) $ \os ->-	withFlag gourceOption $ \gource ->-	withFilesInGit $ whenAnnexed $ start m zone os gource]+seek :: CommandSeek+seek ps = do+	m <- Remote.uuidDescriptions+	zone <- liftIO getCurrentTimeZone+	os <- concat <$> mapM getoption passthruOptions+	gource <- getOptionFlag gourceOption+	withFilesInGit (whenAnnexed $ start m zone os gource) ps   where 	getoption o = maybe [] (use o) <$>-		Annex.getField (Option.name o)-	use o v = [Param ("--" ++ Option.name o), Param v]+		Annex.getField (optionName o)+	use o v = [Param ("--" ++ optionName o), Param v]  start :: M.Map UUID String -> TimeZone -> [CommandParam] -> Bool -> 	FilePath -> (Key, Backend) -> CommandStart
Command/LookupKey.hs view
@@ -17,8 +17,8 @@ 	command "lookupkey" (paramRepeating paramFile) seek 		SectionPlumbing "looks up key used for file"] -seek :: [CommandSeek]-seek = [withStrings start]+seek :: CommandSeek+seek = withStrings start  start :: String -> CommandStart start file = do
Command/Map.hs view
@@ -31,8 +31,8 @@ 	command "map" paramNothing seek SectionQuery 		"generate map of repositories"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = do
Command/Merge.hs view
@@ -17,11 +17,10 @@ def = [command "merge" paramNothing seek SectionMaintenance 	"automatically merge changes from remotes"] -seek :: [CommandSeek]-seek =-	[ withNothing mergeBranch-	, withNothing mergeSynced-	]+seek :: CommandSeek+seek ps = do+	withNothing mergeBranch ps+	withNothing mergeSynced ps  mergeBranch :: CommandStart mergeBranch = do
Command/Migrate.hs view
@@ -22,8 +22,8 @@ 	command "migrate" paramPaths seek 		SectionUtility "switch data to different backend"] -seek :: [CommandSeek]-seek = [withFilesInGit $ whenAnnexed start]+seek :: CommandSeek+seek = withFilesInGit $ whenAnnexed start  start :: FilePath -> (Key, Backend) -> CommandStart start file (key, oldbackend) = do
Command/Mirror.hs view
@@ -9,34 +9,33 @@  import Common.Annex import Command-import GitAnnex.Options import qualified Command.Move import qualified Command.Drop import qualified Command.Get import qualified Remote import Annex.Content import qualified Annex+import Config.NumCopies  def :: [Command] def = [withOptions (fromToOptions ++ keyOptions) $ 	command "mirror" paramPaths seek 		SectionCommon "mirror content of files to/from another repository"] -seek :: [CommandSeek]-seek =-	[ withField toOption Remote.byNameWithUUID $ \to ->-	  withField fromOption Remote.byNameWithUUID $ \from ->-	  withKeyOptions (startKey Nothing to from Nothing) $-	  withFilesInGit $ whenAnnexed $ start to from-	]+seek :: CommandSeek+seek ps = do+	to <- getOptionField toOption Remote.byNameWithUUID+	from <- getOptionField fromOption Remote.byNameWithUUID+	withKeyOptions+		(startKey to from Nothing)+		(withFilesInGit $ whenAnnexed $ start to from)+		ps  start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart-start to from file (key, _backend) = do-	numcopies <- numCopies file-	startKey numcopies to from (Just file) key+start to from file (key, _backend) = startKey to from (Just file) key -startKey :: Maybe Int -> Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart-startKey numcopies to from afile key = do+startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart+startKey to from afile key = do 	noAuto 	case (from, to) of 		(Nothing, Nothing) -> error "specify either --from or --to"@@ -48,7 +47,9 @@ 		error "--auto is not supported for mirror" 	mirrorto r = ifM (inAnnex key) 		( Command.Move.toStart r False afile key-		, Command.Drop.startRemote afile numcopies key r+		, do+			numcopies <- getnumcopies+			Command.Drop.startRemote afile numcopies key r 		) 	mirrorfrom r = do 		haskey <- Remote.hasKey r key@@ -56,6 +57,9 @@ 			Left _ -> stop 			Right True -> Command.Get.start' (return True) Nothing key afile 			Right False -> ifM (inAnnex key)-				( Command.Drop.startLocal afile numcopies key Nothing+				( do+					numcopies <- getnumcopies+					Command.Drop.startLocal afile numcopies key Nothing 				, stop 				)+	getnumcopies = maybe getNumCopies getFileNumCopies afile
Command/Move.hs view
@@ -16,8 +16,6 @@ import Annex.UUID import Logs.Presence import Logs.Transfer-import GitAnnex.Options-import Types.Key  def :: [Command] def = [withOptions moveOptions $ command "move" paramPaths seek@@ -26,13 +24,14 @@ moveOptions :: [Option] moveOptions = fromToOptions ++ keyOptions -seek :: [CommandSeek]-seek = -	[ withField toOption Remote.byNameWithUUID $ \to ->-	  withField fromOption Remote.byNameWithUUID $ \from ->-	  withKeyOptions (startKey to from True) $-	  withFilesInGit $ whenAnnexed $ start to from True-	]+seek :: CommandSeek+seek ps = do+	to <- getOptionField toOption Remote.byNameWithUUID+	from <- getOptionField fromOption Remote.byNameWithUUID+	withKeyOptions+		(startKey to from True)+		(withFilesInGit $ whenAnnexed $ start to from True)+		ps  start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart start to from move file (key, _) = start' to from move (Just file) key@@ -53,17 +52,14 @@ 		"--auto is not supported for move"  showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()-showMoveAction True _ (Just file) = showStart "move" file-showMoveAction False _ (Just file) = showStart "copy" file-showMoveAction True key Nothing = showStart "move" (key2file key)-showMoveAction False key Nothing = showStart "copy" (key2file key)+showMoveAction move = showStart' (if move then "move" else "copy")  {- Moves (or copies) the content of an annexed file to a remote.  -  - If the remote already has the content, it is still removed from  - the current repository.  -- - Note that unlike drop, this does not honor annex.numcopies.+ - Note that unlike drop, this does not honor numcopies.  - A file's content can be moved even if there are insufficient copies to  - allow it to be dropped.  -}
+ Command/NumCopies.hs view
@@ -0,0 +1,56 @@+{- git-annex command+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.NumCopies where++import Common.Annex+import qualified Annex+import Command+import Config.NumCopies+import Types.Messages++def :: [Command]+def = [command "numcopies" paramNumber seek+	SectionSetup "configure desired number of copies"]++seek :: CommandSeek+seek = withWords start++start :: [String] -> CommandStart+start [] = startGet+start [s] = do+	case readish s of+		Nothing -> error $ "Bad number: " ++ s+		Just n+			| n > 0 -> startSet n+			| n == 0 -> ifM (Annex.getState Annex.force)+				( startSet n+				, error "Setting numcopies to 0 is very unsafe. You will lose data! If you really want to do that, specify --force."+				)+			| otherwise -> error "Number cannot be negative!"+start _ = error "Specify a single number."++startGet :: CommandStart+startGet = next $ next $ do+	Annex.setOutput QuietOutput+	v <- getGlobalNumCopies+	case v of+		Just n -> liftIO $ putStrLn $ show $ fromNumCopies n+		Nothing -> do+			liftIO $ putStrLn $ "global numcopies is not set"+			old <- deprecatedNumCopies+			case old of+				Nothing -> liftIO $ putStrLn "(default is 1)"+				Just n -> liftIO $ putStrLn $ "(deprecated git config annex.numcopies is set to " ++ show (fromNumCopies n) ++ " locally)"+	return True++startSet :: Int -> CommandStart+startSet n = do+	showStart "numcopies" (show n)+	next $ next $ do+		setGlobalNumCopies $ NumCopies n+		return True
Command/PreCommit.hs view
@@ -9,6 +9,7 @@  import Common.Annex import Command+import Config import qualified Command.Add import qualified Command.Fix import Annex.Direct@@ -17,19 +18,20 @@ def = [command "pre-commit" paramPaths seek SectionPlumbing 	"run by git pre-commit hook"] -seek :: [CommandSeek]-seek =-	-- fix symlinks to files being committed-	[ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed Command.Fix.start-	-- inject unlocked files into the annex-	, whenNotDirect $ withFilesUnlockedToBeCommitted startIndirect+seek :: CommandSeek+seek ps = ifM isDirect 	-- update direct mode mappings for committed files-	, whenDirect $ withWords startDirect-	]+	( withWords startDirect ps+	, do+		-- fix symlinks to files being committed+		withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps+		-- inject unlocked files into the annex+		withFilesUnlockedToBeCommitted startIndirect ps+	)  startIndirect :: FilePath -> CommandStart startIndirect file = next $ do-	unlessM (doCommand $ Command.Add.start file) $+	unlessM (callCommand $ Command.Add.start file) $ 		error $ "failed to add " ++ file ++ "; canceling commit" 	next $ return True
Command/ReKey.hs view
@@ -22,8 +22,8 @@ 	(paramOptional $ paramRepeating $ paramPair paramPath paramKey) 	seek SectionPlumbing "change keys used for files"] -seek :: [CommandSeek]-seek = [withPairs start]+seek :: CommandSeek+seek = withPairs start  start :: (FilePath, String) -> CommandStart start (file, keyname) = ifAnnexed file go stop
Command/RecvKey.hs view
@@ -17,7 +17,7 @@ import Utility.Rsync import Logs.Transfer import Command.SendKey (fieldTransfer)-import qualified Fields+import qualified CmdLine.GitAnnexShell.Fields as Fields import qualified Types.Key import qualified Types.Backend import qualified Backend@@ -26,8 +26,8 @@ def = [noCommit $ command "recvkey" paramKey seek 	SectionPlumbing "runs rsync in server mode to receive content"] -seek :: [CommandSeek]-seek = [withKeys start]+seek :: CommandSeek+seek = withKeys start  start :: Key -> CommandStart start key = ifM (inAnnex key)
Command/Reinject.hs view
@@ -17,8 +17,8 @@ def = [command "reinject" (paramPair "SRC" "DEST") seek 	SectionUtility "sets content of annexed file"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [FilePath] -> CommandStart start (src:dest:[])
Command/Repair.hs view
@@ -20,8 +20,8 @@ def = [noCommit $ dontCheck repoExists $ 	command "repair" paramNothing seek SectionMaintenance "recover broken git repository"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = next $ next $ runRepair =<< Annex.getState Annex.force
Command/RmUrl.hs view
@@ -16,8 +16,8 @@ 	command "rmurl" (paramPair paramFile paramUrl) seek 		SectionCommon "record file is not available at url"] -seek :: [CommandSeek]-seek = [withPairs start]+seek :: CommandSeek+seek = withPairs start  start :: (FilePath, String) -> CommandStart start (file, url) = flip whenAnnexed file $ \_ (key, _) -> do
Command/Schedule.hs view
@@ -21,8 +21,8 @@ def = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek 	SectionSetup "get or set scheduled jobs"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start = parse
Command/Semitrust.hs view
@@ -16,8 +16,8 @@ def = [command "semitrust" (paramRepeating paramRemote) seek 	SectionSetup "return repository to default trust level"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start ws = do
Command/SendKey.hs view
@@ -13,15 +13,15 @@ import Annex import Utility.Rsync import Logs.Transfer-import qualified Fields+import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered  def :: [Command] def = [noCommit $ command "sendkey" paramKey seek 	SectionPlumbing "runs rsync in server mode to send content"] -seek :: [CommandSeek]-seek = [withKeys start]+seek :: CommandSeek+seek = withKeys start  start :: Key -> CommandStart start key = do
Command/Status.hs view
@@ -17,14 +17,12 @@ import qualified Git  def :: [Command]-def = [notBareRepo $ noCommit $ noMessages $+def = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $ 	command "status" paramPaths seek SectionCommon 		"show the working tree status"] -seek :: [CommandSeek]-seek = -	[ withWords start-	]+seek :: CommandSeek+seek = withWords start  start :: [FilePath] -> CommandStart start [] = do@@ -32,11 +30,11 @@ 	-- given the path to the top of the repository. 	cwd <- liftIO getCurrentDirectory 	top <- fromRepo Git.repoPath-	next $ perform [relPathDirToFile cwd top]-start locs = next $ perform locs+	start' [relPathDirToFile cwd top]+start locs = start' locs 	-perform :: [FilePath] -> CommandPerform-perform locs = do+start' :: [FilePath] -> CommandStart+start' locs = do 	(l, cleanup) <- inRepo $ LsFiles.modifiedOthers locs 	getstatus <- ifM isDirect 		( return statusDirect@@ -44,7 +42,7 @@ 		) 	forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f 	void $ liftIO cleanup-	next $ return True+	stop  data Status  	= NewFile@@ -57,7 +55,10 @@ showStatus ModifiedFile = "M"  showFileStatus :: FilePath -> Status -> Annex ()-showFileStatus f s  = liftIO $ putStrLn $ showStatus s ++ " " ++ f+showFileStatus f s  = unlessM (showFullJSON [("status", ss), ("file", f)]) $+	liftIO $ putStrLn $ ss ++ " " ++ f+  where+	ss = showStatus s  statusDirect :: FilePath -> Annex (Maybe Status) statusDirect f = checkstatus =<< liftIO (catchMaybeIO $ getFileStatus f)
Command/Sync.hs view
@@ -1,7 +1,7 @@ {- git-annex command  -  - Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>- - Copyright 2011,2012 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -10,10 +10,11 @@  import Common.Annex import Command-import qualified Remote import qualified Annex import qualified Annex.Branch import qualified Annex.Queue+import qualified Remote+import qualified Types.Remote as Remote import Annex.Direct import Annex.CatFile import Annex.Link@@ -30,16 +31,29 @@ import Config import Annex.ReplaceFile import Git.FileMode+import Annex.Wanted+import Annex.Content+import Command.Get (getKeyFile')+import Logs.Transfer+import Logs.Presence+import Logs.Location+import Annex.Drop  import qualified Data.Set as S import Data.Hash.MD5 import Control.Concurrent.MVar  def :: [Command]-def = [command "sync" (paramOptional (paramRepeating paramRemote))-	[seek] SectionCommon "synchronize local repository with remotes"]+def = [withOptions syncOptions $+	command "sync" (paramOptional (paramRepeating paramRemote))+	seek SectionCommon "synchronize local repository with remotes"] --- syncing involves several operations, any of which can independently fail+syncOptions :: [Option]+syncOptions = [ contentOption ]++contentOption :: Option+contentOption = flagOption [] "content" "also transfer file contents"+ seek :: CommandSeek seek rs = do 	prepMerge@@ -60,17 +74,26 @@ 	let withbranch a = a =<< getbranch  	remotes <- syncRemotes rs-	return $ concat+	let gitremotes = filter Remote.gitSyncableRemote remotes++	-- Syncing involves many actions, any of which can independently+	-- fail, without preventing the others from running.+	seekActions $ return $ concat 		[ [ commit ] 		, [ withbranch mergeLocal ]-		, [ withbranch (pullRemote remote) | remote <- remotes ]-		, [ mergeAnnex ]-		, [ withbranch pushLocal ]-		, [ withbranch (pushRemote remote) | remote <- remotes ]+		, map (withbranch . pullRemote) gitremotes+		,  [ mergeAnnex ] 		]+	whenM (Annex.getFlag $ optionName contentOption) $+		seekSyncContent remotes+	seekActions $ return $ concat+		[ [ withbranch pushLocal ]+		, map (withbranch . pushRemote) gitremotes+		]  {- Merging may delete the current directory, so go to the top- - of the repo. -}+ - of the repo. This also means that sync always acts on all files in the+ - repository, not just on a subdirectory. -} prepMerge :: Annex () prepMerge = liftIO . setCurrentDirectory =<< fromRepo Git.repoPath @@ -83,21 +106,16 @@ syncRemotes :: [String] -> Annex [Remote] syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )   where-	pickfast = (++) <$> listed <*> (good =<< fastest <$> available)+	pickfast = (++) <$> listed <*> (filterM good =<< fastest <$> available) 	wanted-		| null rs = good =<< concat . Remote.byCost <$> available+		| null rs = filterM good =<< concat . Remote.byCost <$> available 		| otherwise = listed-	listed = do-		l <- catMaybes <$> mapM (Remote.byName . Just) rs-		let s = filter (not . Remote.syncableRemote) l-		unless (null s) $-			error $ "cannot sync special remotes: " ++-				unwords (map Types.Remote.name s)-		return l-	available = filter Remote.syncableRemote-		. filter (remoteAnnexSync . Types.Remote.gitconfig)+	listed = catMaybes <$> mapM (Remote.byName . Just) rs+	available = filter (remoteAnnexSync . Types.Remote.gitconfig) 		<$> Remote.remoteList-	good = filterM $ Remote.Git.repoAvail . Types.Remote.repo+	good r+		| Remote.gitSyncableRemote r = Remote.Git.repoAvail $ Types.Remote.repo r+		| otherwise = return True 	fastest = fromMaybe [] . headMaybe . Remote.byCost  commit :: CommandStart@@ -152,6 +170,9 @@ pushLocal :: Maybe Git.Ref -> CommandStart pushLocal Nothing = stop pushLocal (Just branch) = do+	-- In case syncing content made changes to the git-annex branch,+	-- commit it.+	Annex.Branch.commit "update" 	-- Update the sync branch to match the new state of the branch 	inRepo $ updateBranch $ syncBranch branch 	-- In direct mode, we're operating on some special direct mode@@ -464,3 +485,64 @@ 		( inRepo $ Git.Branch.changed r b 		, return True 		)++{- If it's preferred content, and we don't have it, get it from one of the+ - listed remotes (preferring the cheaper earlier ones).+ -+ - Send it to each remote that doesn't have it, and for which it's+ - preferred content.+ -+ - Drop it locally if it's not preferred content (honoring numcopies).+ - + - Drop it from each remote that has it, where it's not preferred content+ - (honoring numcopies).+ -}+seekSyncContent :: [Remote] -> Annex ()+seekSyncContent rs = mapM_ go =<< seekHelper LsFiles.inRepo []+  where+	go f = ifAnnexed f (syncFile rs f) noop++syncFile :: [Remote] -> FilePath -> (Key, Backend) -> Annex ()+syncFile rs f (k, _) = do+	locs <- loggedLocations k+	let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs++	sequence_ =<< handleget have+	putrs <- catMaybes . snd . unzip <$> (sequence =<< handleput lack)++	-- Using callCommand rather than commandAction for drops,+	-- because a failure to drop does not mean the sync failed.+	handleDropsFrom (putrs ++ locs) rs "unwanted" True k (Just f)+		Nothing callCommand+  where+  	wantget have = allM id +		[ pure (not $ null have)+		, not <$> inAnnex k+		, wantGet True (Just k) (Just f)+		]+	handleget have = ifM (wantget have)+		( return [ get have ]+		, return []+		)+	get have = commandAction $ do+		showStart "get" f+		next $ next $ getViaTmp k $ \dest -> getKeyFile' k (Just f) dest have++	wantput r+		| Remote.readonly r || remoteAnnexReadOnly (Types.Remote.gitconfig r) = return False+		| otherwise = wantSend True (Just k) (Just f) (Remote.uuid r)+	handleput lack = ifM (inAnnex k)+		( map put <$> (filterM wantput lack)+		, return []+		)+	put dest = do+		ok <- commandAction $ do+			showStart "copy" f+			showAction $ "to " ++ Remote.name dest+			next $ next $ do+				ok <- upload (Remote.uuid dest) k (Just f) noRetry $+					Remote.storeKey dest k (Just f)+				when ok $+					Remote.logStatus dest k InfoPresent+				return ok+		return (ok, if ok then Just (Remote.uuid dest) else Nothing)
Command/Test.hs view
@@ -7,16 +7,17 @@  module Command.Test where +import Common import Command import Messages  def :: [Command]-def = [ dontCheck repoExists $+def = [ noRepo startIO $ dontCheck repoExists $ 	command "test" paramNothing seek SectionPlumbing 		"run built-in test suite"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  {- We don't actually run the test suite here because of a dependency loop.  - The main program notices when the command is test and runs it; this@@ -28,7 +29,9 @@  - test suite.  -} start :: [String] -> CommandStart-start [] = do-	warning "git-annex was built without its test suite; not testing"+start ps = do+	liftIO $ startIO ps 	stop-start _ = error "Cannot specify any additional parameters when running test"++startIO :: CmdParams -> IO ()+startIO _ = warningIO "git-annex was built without its test suite; not testing"
Command/TransferInfo.hs view
@@ -12,15 +12,15 @@ import Annex.Content import Logs.Transfer import Types.Key-import qualified Fields+import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered  def :: [Command] def = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing 	"updates sender on number of bytes of content received"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  {- Security:  -
Command/TransferKey.hs view
@@ -14,8 +14,6 @@ import Logs.Transfer import qualified Remote import Types.Remote-import GitAnnex.Options-import qualified Option  def :: [Command] def = [withOptions transferKeyOptions $@@ -26,13 +24,14 @@ transferKeyOptions = fileOption : fromToOptions  fileOption :: Option-fileOption = Option.field [] "file" paramFile "the associated file"+fileOption = fieldOption [] "file" paramFile "the associated file" -seek :: [CommandSeek]-seek = [withField toOption Remote.byNameWithUUID $ \to ->-	withField fromOption Remote.byNameWithUUID $ \from ->-	withField fileOption return $ \file ->-		withKeys $ start to from file]+seek :: CommandSeek+seek ps = do+	to <- getOptionField toOption Remote.byNameWithUUID+	from <- getOptionField fromOption Remote.byNameWithUUID+	file <- getOptionField fileOption return+	withKeys (start to from file) ps  start :: Maybe Remote -> Maybe Remote -> AssociatedFile -> Key -> CommandStart start to from file key =
Command/TransferKeys.hs view
@@ -25,8 +25,8 @@ def = [command "transferkeys" paramNothing seek 	SectionPlumbing "transfers keys"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = withHandles $ \(readh, writeh) -> do@@ -106,34 +106,34 @@ fieldSep :: String fieldSep = "\0" -class Serialized a where+class TCSerialized a where 	serialize :: a -> String 	deserialize :: String -> Maybe a -instance Serialized Bool where+instance TCSerialized Bool where 	serialize True = "1" 	serialize False = "0" 	deserialize "1" = Just True 	deserialize "0" = Just False 	deserialize _ = Nothing -instance Serialized Direction where+instance TCSerialized Direction where 	serialize Upload = "u" 	serialize Download = "d" 	deserialize "u" = Just Upload 	deserialize "d" = Just Download 	deserialize _ = Nothing -instance Serialized AssociatedFile where+instance TCSerialized AssociatedFile where 	serialize (Just f) = f 	serialize Nothing = "" 	deserialize "" = Just Nothing 	deserialize f = Just $ Just f -instance Serialized UUID where+instance TCSerialized UUID where 	serialize = fromUUID 	deserialize = Just . toUUID -instance Serialized Key where+instance TCSerialized Key where 	serialize = key2file 	deserialize = file2key
Command/Trust.hs view
@@ -16,8 +16,8 @@ def = [command "trust" (paramRepeating paramRemote) seek 	SectionSetup "trust a repository"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start ws = do
Command/Unannex.hs view
@@ -23,8 +23,8 @@ def = [command "unannex" paramPaths seek SectionUtility 		"undo accidential add command"] -seek :: [CommandSeek]-seek = [withFilesInGit $ whenAnnexed start]+seek :: CommandSeek+seek = withFilesInGit $ whenAnnexed start  start :: FilePath -> (Key, Backend) -> CommandStart start file (key, _) = stopUnless (inAnnex key) $ do
Command/Ungroup.hs view
@@ -19,8 +19,8 @@ def = [command "ungroup" (paramPair paramRemote paramDesc) seek 	SectionSetup "remove a repository from a group"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start (name:g:[]) = do
Command/Uninit.hs view
@@ -12,9 +12,9 @@ import qualified Git import qualified Git.Command import qualified Command.Unannex-import Init import qualified Annex.Branch import Annex.Content+import Annex.Init  def :: [Command] def = [addCheck check $ command "uninit" paramPaths seek @@ -34,12 +34,11 @@ 	revhead = inRepo $ Git.Command.pipeReadStrict 		[Params "rev-parse --abbrev-ref HEAD"] -seek :: [CommandSeek]-seek = -	[ withFilesNotInGit $ whenAnnexed startCheckIncomplete-	, withFilesInGit $ whenAnnexed Command.Unannex.start-	, withNothing start-	]+seek :: CommandSeek+seek ps = do+	withFilesNotInGit (whenAnnexed startCheckIncomplete) ps+	withFilesInGit (whenAnnexed Command.Unannex.start) ps+	finish  {- git annex symlinks that are not checked into git could be left by an  - interrupted add. -}@@ -50,8 +49,8 @@ 	, "Not continuing with uninit; either delete or git annex add the file and retry." 	] -start :: CommandStart-start = next $ next $ do+finish :: Annex ()+finish = do 	annexdir <- fromRepo gitAnnexDir 	annexobjectdir <- fromRepo gitAnnexObjectDir 	leftovers <- removeUnannexed =<< getKeysPresent
Command/Unlock.hs view
@@ -20,8 +20,8 @@   where 	c n = notDirect . command n paramPaths seek SectionCommon -seek :: [CommandSeek]-seek = [withFilesInGit $ whenAnnexed start]+seek :: CommandSeek+seek = withFilesInGit $ whenAnnexed start  {- The unlock subcommand replaces the symlink with a copy of the file's  - content. -}
Command/Untrust.hs view
@@ -16,8 +16,8 @@ def = [command "untrust" (paramRepeating paramRemote) seek 	SectionSetup "do not trust a repository"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start ws = do
Command/Unused.hs view
@@ -33,25 +33,24 @@ import qualified Backend import qualified Remote import qualified Annex.Branch-import qualified Option import Annex.CatFile import Types.Key import Git.FilePath  def :: [Command]-def = [withOptions [fromOption] $ command "unused" paramNothing seek+def = [withOptions [unusedFromOption] $ command "unused" paramNothing seek 	SectionMaintenance "look for unused file content"] -fromOption :: Option-fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content"+unusedFromOption :: Option+unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content" -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  {- Finds unused content in the annex. -}  start :: CommandStart start = do-	from <- Annex.getField $ Option.name fromOption+	from <- Annex.getField $ optionName unusedFromOption 	let (name, action) = case from of 		Nothing -> (".", checkUnused) 		Just "." -> (".", checkUnused)@@ -92,7 +91,7 @@ 	l <- a 	let unusedlist = number c l 	unless (null l) $ showLongNote $ msg unusedlist-	writeUnusedLog file unusedlist+	updateUnusedLog file $ M.fromList unusedlist 	return $ c + length l  number :: Int -> [a] -> [(Int, a)]@@ -326,19 +325,21 @@ 	, unusedTmpMap :: UnusedMap 	} -{- Read unused logs once, and pass the maps to each start action. -} withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CommandSeek withUnusedMaps a params = do-	unused <- readUnusedLog ""-	unusedbad <- readUnusedLog "bad"-	unusedtmp <- readUnusedLog "tmp"+	unused <- readUnusedMap ""+	unusedbad <- readUnusedMap "bad"+	unusedtmp <- readUnusedMap "tmp" 	let m = unused `M.union` unusedbad `M.union` unusedtmp-	return $ map (a $ UnusedMaps unused unusedbad unusedtmp) $+	let unusedmaps = UnusedMaps unused unusedbad unusedtmp+	seekActions $ return $ map (a unusedmaps) $ 		concatMap (unusedSpec m) params  unusedSpec :: UnusedMap -> String -> [Int] unusedSpec m spec-	| spec == "all" = [fst (M.findMin m)..fst (M.findMax m)]+	| spec == "all" = if M.null m+		then []+		else [fst (M.findMin m)..fst (M.findMax m)] 	| "-" `isInfixOf` spec = range $ separate (== '-') spec 	| otherwise = maybe badspec (: []) (readish spec)   where@@ -347,8 +348,8 @@ 		_ -> badspec 	badspec = error $ "Expected number or range, not \"" ++ spec ++ "\"" -{- Start action for unused content. Finds the number in the maps, and- - calls either of 3 actions, depending on the type of unused file. -}+{- Seek action for unused content. Finds the number in the maps, and+ - calls one of 3 actions, depending on the type of unused file. -} startUnused :: String 	-> (Key -> CommandPerform) 	-> (Key -> CommandPerform)
Command/Upgrade.hs view
@@ -16,8 +16,8 @@ 	command "upgrade" paramNothing seek 		SectionMaintenance "upgrade repository layout"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = do
Command/Version.hs view
@@ -21,8 +21,8 @@ def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ 	command "version" paramNothing seek SectionQuery "show version info"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = do
Command/Vicfg.hs view
@@ -30,8 +30,8 @@ def = [command "vicfg" paramNothing seek 	SectionSetup "edit git-annex's configuration"] -seek :: [CommandSeek]-seek = [withNothing start]+seek :: CommandSeek+seek = withNothing start  start :: CommandStart start = do
Command/Wanted.hs view
@@ -20,8 +20,8 @@ def = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek 	SectionSetup "get or set preferred content expression"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start = parse
Command/Watch.hs view
@@ -10,23 +10,23 @@ import Common.Annex import Assistant import Command-import Option import Utility.HumanTime  def :: [Command] def = [notBareRepo $ withOptions [foregroundOption, stopOption] $  	command "watch" paramNothing seek SectionCommon "watch for changes"] -seek :: [CommandSeek]-seek = [withFlag stopOption $ \stopdaemon -> -	withFlag foregroundOption $ \foreground ->-	withNothing $ start False foreground stopdaemon Nothing]+seek :: CommandSeek+seek ps = do+	stopdaemon <- getOptionFlag stopOption+	foreground <- getOptionFlag foregroundOption+	withNothing (start False foreground stopdaemon Nothing) ps  foregroundOption :: Option-foregroundOption = Option.flag [] "foreground" "do not daemonize"+foregroundOption = flagOption [] "foreground" "do not daemonize"  stopOption :: Option-stopOption = Option.flag [] "stop" "stop daemon"+stopOption = flagOption [] "stop" "stop daemon"  start :: Bool -> Bool -> Bool -> Maybe Duration -> CommandStart start assistant foreground stopdaemon startdelay = do
Command/WebApp.hs view
@@ -23,13 +23,12 @@ #ifdef __ANDROID__ import Utility.Env #endif-import Init+import Annex.Init import qualified Git import qualified Git.Config import qualified Git.CurrentRepo import qualified Annex import Config.Files-import qualified Option import Upgrade import Annex.Version @@ -45,12 +44,13 @@ 	command "webapp" paramNothing seek SectionCommon "launch webapp"]  listenOption :: Option-listenOption = Option.field [] "listen" paramAddress+listenOption = fieldOption [] "listen" paramAddress 	"accept connections to this address" -seek :: [CommandSeek]-seek = [withField listenOption return $ \listenhost ->-	withNothing $ start listenhost]+seek :: CommandSeek+seek ps = do+	listenhost <- getOptionField listenOption return+	withNothing (start listenhost) ps  start :: Maybe HostName -> CommandStart start = start' True@@ -107,7 +107,7 @@ 		(d:_) -> do 			setCurrentDirectory d 			state <- Annex.new =<< Git.CurrentRepo.get-			void $ Annex.eval state $ doCommand $+			void $ Annex.eval state $ callCommand $ 				start' False listenhost  {- Run the webapp without a repository, which prompts the user, makes one,
Command/Whereis.hs view
@@ -15,16 +15,27 @@ import Logs.Trust  def :: [Command]-def = [noCommit $ command "whereis" paramPaths seek-	SectionQuery "lists repositories that have file content"]+def = [noCommit $ withOptions (jsonOption : keyOptions) $+	command "whereis" paramPaths seek SectionQuery+		"lists repositories that have file content"] -seek :: [CommandSeek]-seek = [withValue (remoteMap id) $ \m ->-	withFilesInGit $ whenAnnexed $ start m]+seek :: CommandSeek+seek ps = do+	m <- remoteMap id+	withKeyOptions+		(startKeys m)+		(withFilesInGit $ whenAnnexed $ start m)+		ps  start :: M.Map UUID Remote -> FilePath -> (Key, Backend) -> CommandStart-start remotemap file (key, _) = do-	showStart "whereis" file+start remotemap file (key, _) = start' remotemap key (Just file)++startKeys :: M.Map UUID Remote -> Key -> CommandStart+startKeys remotemap key = start' remotemap key Nothing++start' :: M.Map UUID Remote -> Key -> AssociatedFile -> CommandStart+start' remotemap key afile = do+	showStart' "whereis" key afile 	next $ perform remotemap key  perform :: M.Map UUID Remote -> Key -> CommandPerform
Command/XMPPGit.hs view
@@ -16,8 +16,8 @@ 	command "xmppgit" paramNothing seek 		SectionPlumbing "git to XMPP relay"] -seek :: [CommandSeek]-seek = [withWords start]+seek :: CommandSeek+seek = withWords start  start :: [String] -> CommandStart start _ = do
Config.hs view
@@ -69,10 +69,6 @@ setRemoteAvailability :: Git.Repo -> Availability -> Annex () setRemoteAvailability r c = setConfig (remoteConfig r "availability") (show c) -getNumCopies :: Maybe Int -> Annex Int-getNumCopies (Just v) = return v-getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig- isDirect :: Annex Bool isDirect = annexDirect <$> Annex.getGitConfig
+ Config/NumCopies.hs view
@@ -0,0 +1,80 @@+{- git-annex numcopies configuration+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Config.NumCopies (+	module Types.NumCopies,+	module Logs.NumCopies,+	getFileNumCopies,+	getGlobalFileNumCopies,+	getNumCopies,+	numCopiesCheck,+	deprecatedNumCopies,+	defaultNumCopies+) where++import Common.Annex+import qualified Annex+import Types.NumCopies+import Logs.NumCopies+import Logs.Trust+import Annex.CheckAttr+import qualified Remote++defaultNumCopies :: NumCopies+defaultNumCopies = NumCopies 1++fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies+fromSources = fromMaybe defaultNumCopies <$$> getM id++{- The git config annex.numcopies is deprecated. -}+deprecatedNumCopies :: Annex (Maybe NumCopies)+deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig++{- Value forced on the command line by --numcopies. -}+getForcedNumCopies :: Annex (Maybe NumCopies)+getForcedNumCopies = Annex.getState Annex.forcenumcopies++{- Numcopies value from any of the non-.gitattributes configuration+ - sources. -}+getNumCopies :: Annex NumCopies+getNumCopies = fromSources+	[ getForcedNumCopies+	, getGlobalNumCopies+	, deprecatedNumCopies+	]++{- Numcopies value for a file, from any configuration source, including the+ - deprecated git config. -}+getFileNumCopies :: FilePath -> Annex NumCopies+getFileNumCopies f = fromSources+	[ getForcedNumCopies+	, getFileNumCopies' f+	, deprecatedNumCopies+	]++{- This is the globally visible numcopies value for a file. So it does+ - not include local configuration in the git config or command line+ - options. -}+getGlobalFileNumCopies :: FilePath  -> Annex NumCopies+getGlobalFileNumCopies f = fromSources+	[ getFileNumCopies' f+	]++getFileNumCopies' :: FilePath  -> Annex (Maybe NumCopies)+getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr+  where+	getattr = (NumCopies <$$> readish)+		<$> checkAttr "annex.numcopies" file++{- Checks if numcopies are satisfied for a file by running a comparison+ - between the number of (not untrusted) copies that are+ - belived to exist, and the configured value. -}+numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v+numCopiesCheck file key vs = do+	NumCopies needed <- getFileNumCopies file+	have <- trustExclude UnTrusted =<< Remote.keyLocations key+	return $ length have `vs` needed
− Fields.hs 
@@ -1,35 +0,0 @@-{- git-annex fields- -- - Copyright 2012 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module Fields where--import Common.Annex-import qualified Annex--import Data.Char--{- A field, stored in Annex state, with a value sanity checker. -}-data Field = Field-	{ fieldName :: String-	, fieldCheck :: String -> Bool-	}--getField :: Field -> Annex (Maybe String)-getField = Annex.getField . fieldName--remoteUUID :: Field-remoteUUID = Field "remoteuuid" $-	-- does it look like a UUID?-	all (\c -> isAlphaNum c || c == '-')--associatedFile :: Field-associatedFile = Field "associatedfile" $ \f ->-	-- is the file a safe relative filename?-	not (isAbsolute f) && not ("../" `isPrefixOf` f)--direct :: Field-direct = Field "direct" $ \f -> f == "1"
Git/Command.hs view
@@ -18,6 +18,7 @@ #ifdef mingw32_HOST_OS import Git.FilePath #endif+import Utility.Batch  {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]@@ -41,9 +42,13 @@ {- Runs git in the specified repo. -} runBool :: [CommandParam] -> Repo -> IO Bool runBool params repo = assertLocal repo $-	boolSystemEnv "git"-		(gitCommandLine params repo)-		(gitEnv repo)+	boolSystemEnv "git" (gitCommandLine params repo) (gitEnv repo)++{- Runs git in batch mode. -}+runBatch :: BatchCommandMaker -> [CommandParam] -> Repo -> IO Bool+runBatch batchmaker params repo = assertLocal repo $ do+	let (cmd, params') = batchmaker ("git", gitCommandLine params repo)+	boolSystemEnv cmd params' (gitEnv repo)  {- Runs git in the specified repo, throwing an error if it fails. -} run :: [CommandParam] -> Repo -> IO ()
Git/Fsck.hs view
@@ -20,7 +20,7 @@ import Git.Command import Git.Sha import Utility.Batch-import qualified Git.BuildVersion+import qualified Git.Version  import qualified Data.Set as S @@ -40,12 +40,14 @@  -} findBroken :: Bool -> Repo -> IO FsckResults findBroken batchmode r = do-	let (command, params) = ("git", fsckParams r)+	supportsNoDangling <- (>= Git.Version.normalize "1.7.10")+		<$> Git.Version.installed+	let (command, params) = ("git", fsckParams supportsNoDangling r) 	(command', params') <- if batchmode 		then toBatchCommand (command, params) 		else return (command, params) 	(output, fsckok) <- processTranscript command' (toCommand params') Nothing-	let objs = findShas output+	let objs = findShas supportsNoDangling output 	badobjs <- findMissing objs r 	if S.null badobjs && not fsckok 		then return FsckFailed@@ -75,21 +77,18 @@ 		, Param (show s) 		] r -findShas :: String -> [Sha]-findShas = catMaybes . map extractSha . concat . map words . filter wanted . lines+findShas :: Bool -> String -> [Sha]+findShas supportsNoDangling = catMaybes . map extractSha . concat . map words . filter wanted . lines   where 	wanted l 		| supportsNoDangling = True 		| otherwise = not ("dangling " `isPrefixOf` l) -fsckParams :: Repo -> [CommandParam]-fsckParams = gitCommandLine $ map Param $ catMaybes+fsckParams :: Bool -> Repo -> [CommandParam]+fsckParams supportsNoDangling = gitCommandLine $ map Param $ catMaybes 	[ Just "fsck" 	, if supportsNoDangling 		then Just "--no-dangling" 		else Nothing 	, Just "--no-reflogs" 	]--supportsNoDangling :: Bool-supportsNoDangling = not $ Git.BuildVersion.older "1.7.10"
− GitAnnex.hs 
@@ -1,181 +0,0 @@-{- git-annex main program- -- - Copyright 2010-2013 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--{-# LANGUAGE CPP, OverloadedStrings #-}--module GitAnnex where--import qualified Git.CurrentRepo-import CmdLine-import Command-import GitAnnex.Options--import qualified Command.Add-import qualified Command.Unannex-import qualified Command.Drop-import qualified Command.Move-import qualified Command.Copy-import qualified Command.Get-import qualified Command.LookupKey-import qualified Command.ExamineKey-import qualified Command.FromKey-import qualified Command.DropKey-import qualified Command.TransferKey-import qualified Command.TransferKeys-import qualified Command.ReKey-import qualified Command.Reinject-import qualified Command.Fix-import qualified Command.Init-import qualified Command.Describe-import qualified Command.InitRemote-import qualified Command.EnableRemote-import qualified Command.Fsck-import qualified Command.Repair-import qualified Command.Unused-import qualified Command.DropUnused-import qualified Command.AddUnused-import qualified Command.Unlock-import qualified Command.Lock-import qualified Command.PreCommit-import qualified Command.Find-import qualified Command.Whereis-import qualified Command.List-import qualified Command.Log-import qualified Command.Merge-import qualified Command.Info-import qualified Command.Status-import qualified Command.Migrate-import qualified Command.Uninit-import qualified Command.Trust-import qualified Command.Untrust-import qualified Command.Semitrust-import qualified Command.Dead-import qualified Command.Group-import qualified Command.Wanted-import qualified Command.Schedule-import qualified Command.Ungroup-import qualified Command.Vicfg-import qualified Command.Sync-import qualified Command.Mirror-import qualified Command.AddUrl-#ifdef WITH_FEED-import qualified Command.ImportFeed-#endif-import qualified Command.RmUrl-import qualified Command.Import-import qualified Command.Map-import qualified Command.Direct-import qualified Command.Indirect-import qualified Command.Upgrade-import qualified Command.Forget-import qualified Command.Version-import qualified Command.Help-#ifdef WITH_ASSISTANT-import qualified Command.Watch-import qualified Command.Assistant-#ifdef WITH_WEBAPP-import qualified Command.WebApp-#endif-#ifdef WITH_XMPP-import qualified Command.XMPPGit-#endif-#endif-import qualified Command.Test-#ifdef WITH_TESTSUITE-import qualified Command.FuzzTest-#endif-#ifdef WITH_EKG-import System.Remote.Monitoring-#endif--cmds :: [Command]-cmds = concat-	[ Command.Add.def-	, Command.Get.def-	, Command.Drop.def-	, Command.Move.def-	, Command.Copy.def-	, Command.Unlock.def-	, Command.Lock.def-	, Command.Sync.def-	, Command.Mirror.def-	, Command.AddUrl.def-#ifdef WITH_FEED-	, Command.ImportFeed.def-#endif-	, Command.RmUrl.def-	, Command.Import.def-	, Command.Init.def-	, Command.Describe.def-	, Command.InitRemote.def-	, Command.EnableRemote.def-	, Command.Reinject.def-	, Command.Unannex.def-	, Command.Uninit.def-	, Command.PreCommit.def-	, Command.Trust.def-	, Command.Untrust.def-	, Command.Semitrust.def-	, Command.Dead.def-	, Command.Group.def-	, Command.Wanted.def-	, Command.Schedule.def-	, Command.Ungroup.def-	, Command.Vicfg.def-	, Command.LookupKey.def-	, Command.ExamineKey.def-	, Command.FromKey.def-	, Command.DropKey.def-	, Command.TransferKey.def-	, Command.TransferKeys.def-	, Command.ReKey.def-	, Command.Fix.def-	, Command.Fsck.def-	, Command.Repair.def-	, Command.Unused.def-	, Command.DropUnused.def-	, Command.AddUnused.def-	, Command.Find.def-	, Command.Whereis.def-	, Command.List.def-	, Command.Log.def-	, Command.Merge.def-	, Command.Info.def-	, Command.Status.def-	, Command.Migrate.def-	, Command.Map.def-	, Command.Direct.def-	, Command.Indirect.def-	, Command.Upgrade.def-	, Command.Forget.def-	, Command.Version.def-	, Command.Help.def-#ifdef WITH_ASSISTANT-	, Command.Watch.def-	, Command.Assistant.def-#ifdef WITH_WEBAPP-	, Command.WebApp.def-#endif-#ifdef WITH_XMPP-	, Command.XMPPGit.def-#endif-#endif-#ifdef WITH_TESTSUITE-	, Command.Test.def-	, Command.FuzzTest.def-#endif-	]--header :: String-header = "git-annex command [option ...]"--run :: [String] -> IO ()-run args = do-#ifdef WITH_EKG-	_ <- forkServer "localhost" 4242-#endif-	dispatch True args cmds options [] header Git.CurrentRepo.get
− GitAnnex/Options.hs 
@@ -1,87 +0,0 @@-{- git-annex options- -- - Copyright 2010, 2013 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module GitAnnex.Options where--import System.Console.GetOpt--import Common.Annex-import qualified Git.Config-import Git.Types-import Command-import Types.TrustLevel-import qualified Annex-import qualified Remote-import qualified Limit-import qualified Limit.Wanted-import qualified Option--options :: [Option]-options = Option.common ++-	[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)-		"override default number of copies"-	, Option [] ["trust"] (trustArg Trusted)-		"override trust setting"-	, Option [] ["semitrust"] (trustArg SemiTrusted)-		"override trust setting back to default"-	, Option [] ["untrust"] (trustArg UnTrusted)-		"override trust setting to untrusted"-	, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")-		"override git configuration setting"-	, Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)-		"skip files matching the glob pattern"-	, Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob)-		"limit to files matching the glob pattern"-	, Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote)-		"match files present in a remote"-	, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)-		"skip files with fewer copies"-	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)-		"match files using a key-value backend"-	, Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup)-		"match files present in all remotes in a group"-	, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize)-		"match files larger than a size"-	, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize)-		"match files smaller than a size"-	, Option [] ["want-get"] (NoArg Limit.Wanted.addWantGet)-		"match files the repository wants to get"-	, Option [] ["want-drop"] (NoArg Limit.Wanted.addWantDrop)-		"match files the repository wants to drop"-	, Option ['T'] ["time-limit"] (ReqArg Limit.addTimeLimit paramTime)-		"stop after the specified amount of time"-	, Option [] ["user-agent"] (ReqArg setuseragent paramName)-		"override default User-Agent"-	, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier"))-		"Trust Amazon Glacier inventory"-	] ++ Option.matcher-  where-	trustArg t = ReqArg (Remote.forceTrust t) paramRemote-	setnumcopies v = maybe noop-		(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just n })-		(readish v)-	setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }-	setgitconfig v = inRepo (Git.Config.store v)-		>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })-		>>= Annex.changeGitRepo--keyOptions :: [Option]-keyOptions = -	[ Option ['A'] ["all"] (NoArg (Annex.setFlag "all"))-		"operate on all versions of all files"-	, Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused"))-		"operate on files found by last run of git-annex unused"-	]--fromOption :: Option-fromOption = Option.field ['f'] "from" paramRemote "source remote"--toOption :: Option-toOption = Option.field ['t'] "to" paramRemote "destination remote"--fromToOptions :: [Option]-fromToOptions = [fromOption, toOption]
− GitAnnexShell.hs 
@@ -1,200 +0,0 @@-{- git-annex-shell main program- -- - Copyright 2010-2012 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module GitAnnexShell where--import System.Environment-import System.Console.GetOpt--import Common.Annex-import qualified Git.Construct-import CmdLine-import Command-import Annex.UUID-import Annex (setField)-import qualified Option-import Fields-import Utility.UserInfo-import Remote.GCrypt (getGCryptUUID)-import qualified Annex-import Init--import qualified Command.ConfigList-import qualified Command.InAnnex-import qualified Command.DropKey-import qualified Command.RecvKey-import qualified Command.SendKey-import qualified Command.TransferInfo-import qualified Command.Commit-import qualified Command.GCryptSetup--cmds_readonly :: [Command]-cmds_readonly = concat-	[ gitAnnexShellCheck Command.ConfigList.def-	, gitAnnexShellCheck Command.InAnnex.def-	, gitAnnexShellCheck Command.SendKey.def-	, gitAnnexShellCheck Command.TransferInfo.def-	]--cmds_notreadonly :: [Command]-cmds_notreadonly = concat-	[ gitAnnexShellCheck Command.RecvKey.def-	, gitAnnexShellCheck Command.DropKey.def-	, gitAnnexShellCheck Command.Commit.def-	, Command.GCryptSetup.def-	]--cmds :: [Command]-cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly-  where-	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }--options :: [OptDescr (Annex ())]-options = Option.common ++-	[ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid"-	]-  where-	checkUUID expected = getUUID >>= check-	  where-		check u | u == toUUID expected = noop-		check NoUUID = checkGCryptUUID expected-		check u = unexpectedUUID expected u-	checkGCryptUUID expected = check =<< getGCryptUUID True =<< gitRepo-	  where-	  	check (Just u) | u == toUUID expected = noop-		check Nothing = unexpected expected "uninitialized repository"-		check (Just u) = unexpectedUUID expected u-	unexpectedUUID expected u = unexpected expected $ "UUID " ++ fromUUID u-	unexpected expected s = error $-		"expected repository UUID " ++ expected ++ " but found " ++ s--header :: String-header = "git-annex-shell [-c] command [parameters ...] [option ...]"--run :: [String] -> IO ()-run [] = failure--- skip leading -c options, passed by eg, ssh-run ("-c":p) = run p--- a command can be either a builtin or something to pass to git-shell-run c@(cmd:dir:params)-	| cmd `elem` builtins = builtin cmd dir params-	| otherwise = external c-run c@(cmd:_)-	-- Handle the case of being the user's login shell. It will be passed-	-- a single string containing all the real parameters.-	| "git-annex-shell " `isPrefixOf` cmd = run $ drop 1 $ shellUnEscape cmd-	| cmd `elem` builtins = failure-	| otherwise = external c--builtins :: [String]-builtins = map cmdname cmds--builtin :: String -> String -> [String] -> IO ()-builtin cmd dir params = do-	checkNotReadOnly cmd-	checkDirectory $ Just dir-	let (params', fieldparams, opts) = partitionParams params-	    fields = filter checkField $ parseFields fieldparams-	    cmds' = map (newcmd $ unwords opts) cmds-	dispatch False (cmd : params') cmds' options fields header $-		Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath-  where-	addrsyncopts opts seek k = setField "RsyncOptions" opts >> seek k-	newcmd opts c = c { cmdseek = map (addrsyncopts opts) (cmdseek c) }--external :: [String] -> IO ()-external params = do-	{- Normal git-shell commands all have the directory as their last-	 - parameter. -}-	let lastparam = lastMaybe =<< shellUnEscape <$> lastMaybe params-	    (params', _, _) = partitionParams params-	checkDirectory lastparam-	checkNotLimited-	unlessM (boolSystem "git-shell" $ map Param $ "-c":params') $-		error "git-shell failed"--{- Split the input list into 3 groups separated with a double dash --.- - Parameters between two -- markers are field settings, in the form:- - field=value field=value- -- - Parameters after the last -- are the command itself and its arguments e.g.,- - rsync --bandwidth=100.- -}-partitionParams :: [String] -> ([String], [String], [String])-partitionParams ps = case segment (== "--") ps of-	params:fieldparams:rest -> ( params, fieldparams, intercalate ["--"] rest )-	[params] -> (params, [], [])-	_ -> ([], [], [])--parseFields :: [String] -> [(String, String)]-parseFields = map (separate (== '='))--{- Only allow known fields to be set, ignore others.- - Make sure that field values make sense. -}-checkField :: (String, String) -> Bool-checkField (field, value)-	| field == fieldName remoteUUID = fieldCheck remoteUUID value-	| field == fieldName associatedFile = fieldCheck associatedFile value-	| field == fieldName direct = fieldCheck direct value-	| otherwise = False--failure :: IO ()-failure = error $ "bad parameters\n\n" ++ usage header cmds--checkNotLimited :: IO ()-checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"--checkNotReadOnly :: String -> IO ()-checkNotReadOnly cmd-	| cmd `elem` map cmdname cmds_readonly = noop-	| otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"--checkDirectory :: Maybe FilePath -> IO ()-checkDirectory mdir = do-	v <- catchMaybeIO $ getEnv "GIT_ANNEX_SHELL_DIRECTORY"-	case (v, mdir) of-		(Nothing, _) -> noop-		(Just d, Nothing) -> req d Nothing-		(Just d, Just dir)-			|  d `equalFilePath` dir -> noop-			| otherwise -> do-				home <- myHomeDir-				d' <- canondir home d-				dir' <- canondir home dir-				if d' `equalFilePath` dir'-					then noop-					else req d' (Just dir')-  where-	req d mdir' = error $ unwords -		[ "Only allowed to access"-		, d-		, maybe "and could not determine directory from command line" ("not " ++) mdir'-		]--	{- A directory may start with ~/ or in some cases, even /~/,-	 - or could just be relative to home, or of course could-	 - be absolute. -}-	canondir home d-		| "~/" `isPrefixOf` d = return d-		| "/~/" `isPrefixOf` d = return $ drop 1 d-		| otherwise = relHome $ absPathFrom home d--checkEnv :: String -> IO ()-checkEnv var = do-	v <- catchMaybeIO $ getEnv var-	case v of-		Nothing -> noop-		Just "" -> noop-		Just _ -> error $ "Action blocked by " ++ var--{- Modifies a Command to check that it is run in either a git-annex- - repository, or a repository with a gcrypt-id set. -}-gitAnnexShellCheck :: [Command] -> [Command]-gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists-  where-	okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $-		error "Not a git-annex or gcrypt repository."
− Init.hs 
@@ -1,240 +0,0 @@-{- git-annex repository initialization- -- - Copyright 2011 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--{-# LANGUAGE CPP #-}--module Init (-	ensureInitialized,-	isInitialized,-	initialize,-	uninitialize,-	probeCrippledFileSystem,-) where--import Common.Annex-import Utility.Network-import qualified Annex-import qualified Git-import qualified Git.LsFiles-import qualified Git.Config-import qualified Git.Construct-import qualified Git.Types as Git-import qualified Annex.Branch-import Logs.UUID-import Annex.Version-import Annex.UUID-import Config-import Annex.Direct-import Annex.Content.Direct-import Annex.Environment-import Annex.Perms-import Backend-#ifndef mingw32_HOST_OS-import Utility.UserInfo-import Utility.FileMode-#endif-import Annex.Hook-import Git.Hook (hookFile)-import Upgrade-import Annex.Content-import Logs.Location--import System.Log.Logger--genDescription :: Maybe String -> Annex String-genDescription (Just d) = return d-genDescription Nothing = do-	reldir <- liftIO . relHome =<< fromRepo Git.repoPath-	hostname <- fromMaybe "" <$> liftIO getHostname-#ifndef mingw32_HOST_OS-	let at = if null hostname then "" else "@"-	username <- liftIO myUserName-	return $ concat [username, at, hostname, ":", reldir]-#else-	return $ concat [hostname, ":", reldir]-#endif--initialize :: Maybe String -> Annex ()-initialize mdescription = do-	prepUUID-	checkFifoSupport-	checkCrippledFileSystem-	unlessM isBare $-		hookWrite preCommitHook-	setVersion supportedVersion-	ifM (crippledFileSystem <&&> not <$> isBare)-		( do-			enableDirectMode-			setDirect True-		, do-			-- Handle case where this repo was cloned from a-			-- direct mode repo.-			unlessM isBare-				switchHEADBack-		)-	createInodeSentinalFile-	u <- getUUID-	{- This will make the first commit to git, so ensure git is set up-	 - properly to allow commits when running it. -}-	ensureCommit $ do-		Annex.Branch.create-		describeUUID u =<< genDescription mdescription--uninitialize :: Annex ()-uninitialize = do-	hookUnWrite preCommitHook-	removeRepoUUID-	removeVersion--{- Will automatically initialize if there is already a git-annex- - branch from somewhere. Otherwise, require a manual init- - to avoid git-annex accidentially being run in git- - repos that did not intend to use it.- -- - Checks repository version and handles upgrades too.- -}-ensureInitialized :: Annex ()-ensureInitialized = do-	getVersion >>= maybe needsinit checkUpgrade-	fixBadBare-  where-	needsinit = ifM Annex.Branch.hasSibling-			( initialize Nothing-			, error "First run: git-annex init"-			)--{- Checks if a repository is initialized. Does not check version for ugrade. -}-isInitialized :: Annex Bool-isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion--isBare :: Annex Bool-isBare = fromRepo Git.repoIsLocalBare--{- A crippled filesystem is one that does not allow making symlinks,- - or removing write access from files. -}-probeCrippledFileSystem :: Annex Bool-probeCrippledFileSystem = do-#ifdef mingw32_HOST_OS-	return True-#else-	tmp <- fromRepo gitAnnexTmpDir-	let f = tmp </> "gaprobe"-	createAnnexDirectory tmp-	liftIO $ writeFile f ""-	uncrippled <- liftIO $ probe f-	liftIO $ removeFile f-	return $ not uncrippled-  where-	probe f = catchBoolIO $ do-		let f2 = f ++ "2"-		nukeFile f2-		createSymbolicLink f f2-		nukeFile f2-		preventWrite f-		allowWrite f-		return True-#endif--checkCrippledFileSystem :: Annex ()-checkCrippledFileSystem = whenM probeCrippledFileSystem $ do-	warning "Detected a crippled filesystem."-	setCrippledFileSystem True--	{- Normally git disables core.symlinks itself when the-	 - filesystem does not support them, but in Cygwin, git-	 - does support symlinks, while git-annex, not linking-	 - with Cygwin, does not. -}-	whenM (coreSymlinks <$> Annex.getGitConfig) $ do-		warning "Disabling core.symlinks."-		setConfig (ConfigKey "core.symlinks")-			(Git.Config.boolConfig False)--probeFifoSupport :: Annex Bool-probeFifoSupport = do-#ifdef mingw32_HOST_OS-	return False-#else-	tmp <- fromRepo gitAnnexTmpDir-	let f = tmp </> "gaprobe"-	createAnnexDirectory tmp-	liftIO $ do-		nukeFile f-		ms <- tryIO $ do-			createNamedPipe f ownerReadMode-			getFileStatus f-		nukeFile f-		return $ either (const False) isNamedPipe ms-#endif--checkFifoSupport :: Annex ()-checkFifoSupport = unlessM probeFifoSupport $ do-	warning "Detected a filesystem without fifo support."-	warning "Disabling ssh connection caching."-	setConfig (annexConfig "sshcaching") (Git.Config.boolConfig False)--enableDirectMode :: Annex ()-enableDirectMode = unlessM isDirect $ do-	warning "Enabling direct mode."-	top <- fromRepo Git.repoPath-	(l, clean) <- inRepo $ Git.LsFiles.inRepo [top]-	forM_ l $ \f ->-		maybe noop (`toDirect` f) =<< isAnnexLink f-	void $ liftIO clean--{- Work around for git-annex version 5.20131118 - 5.20131127, which- - had a bug that unset core.bare when initializing a bare repository.- - - - This resulted in objects sent to the repository being stored in - - repo/.git/annex/objects, so move them to repo/annex/objects.- -- - This check slows down every git-annex run somewhat (by one file stat),- - so should be removed after a suitable period of time has passed.- - Since the bare repository may be on an offline USB drive, best to- - keep it for a while. However, git-annex was only buggy for a few- - weeks, so not too long.- -}-fixBadBare :: Annex ()-fixBadBare = whenM checkBadBare $ do-	ks <- getKeysPresent-	liftIO $ debugM "Init" $ unwords-		[ "Detected bad bare repository with"-		, show (length ks)-		, "objects; fixing"-		]-	g <- Annex.gitRepo-	gc <- Annex.getGitConfig-	d <- Git.repoPath <$> Annex.gitRepo-	void $ liftIO $ boolSystem "git"-		[ Param $ "--git-dir=" ++ d-		, Param "config"-		, Param Git.Config.coreBare-		, Param $ Git.Config.boolConfig True-		]-	g' <- liftIO $ Git.Construct.fromPath d-	s' <- liftIO $ Annex.new $ g' { Git.location = Git.Local { Git.gitdir = d, Git.worktree = Nothing } }-	Annex.changeState $ \s -> s-		{ Annex.repo = Annex.repo s'-		, Annex.gitconfig = Annex.gitconfig s'-		}-	forM_ ks $ \k -> do-		oldloc <- liftIO $ gitAnnexLocation k g gc-		thawContentDir oldloc-		moveAnnex k oldloc-		logStatus k InfoPresent-	let dotgit = d </> ".git"-	liftIO $ removeDirectoryRecursive dotgit-		`catchIO` (const $ renameDirectory dotgit (d </> "removeme"))--{- A repostory with the problem won't know it's a bare repository, but will- - have no pre-commit hook (which is not set up in a bare repository),- - and will not have a HEAD file in its .git directory. -}-checkBadBare :: Annex Bool-checkBadBare = allM (not <$>)-	[isBare, hasPreCommitHook, hasDotGitHEAD]-  where-	hasPreCommitHook = inRepo $ doesFileExist . hookFile preCommitHook-	hasDotGitHEAD = inRepo $ \r -> doesFileExist $ Git.localGitDir r </> "HEAD"
Limit.hs view
@@ -1,6 +1,6 @@ {- user-specified limits on files to act on  -- - Copyright 2011-2013 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -23,12 +23,14 @@ import Annex.Content import Annex.UUID import Logs.Trust+import Config.NumCopies import Types.TrustLevel import Types.Key import Types.Group import Types.FileMatcher import Types.Limit import Logs.Group+import Logs.Unused import Utility.HumanTime import Utility.DataUnits @@ -48,10 +50,10 @@  {- Gets a matcher for the user-specified limits. The matcher is cached for  - speed; once it's obtained the user-specified limits can't change. -}-getMatcher :: Annex (FileInfo -> Annex Bool)+getMatcher :: Annex (MatchInfo -> Annex Bool) getMatcher = Utility.Matcher.matchM <$> getMatcher' -getMatcher' :: Annex (Utility.Matcher.Matcher (FileInfo -> Annex Bool))+getMatcher' :: Annex (Utility.Matcher.Matcher (MatchInfo -> Annex Bool)) getMatcher' = do 	m <- Annex.getState Annex.limit 	case m of@@ -63,7 +65,7 @@ 			return matcher  {- Adds something to the limit list, which is built up reversed. -}-add :: Utility.Matcher.Token (FileInfo -> Annex Bool) -> Annex ()+add :: Utility.Matcher.Token (MatchInfo -> Annex Bool) -> Annex () add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }   where 	prepend (Left ls) = Left $ l:ls@@ -94,8 +96,8 @@ {- Could just use wildCheckCase, but this way the regex is only compiled  - once. Also, we use regex-TDFA when available, because it's less buggy  - in its support of non-unicode characters. -}-matchglob :: String -> FileInfo -> Bool-matchglob glob fi =+matchglob :: String -> MatchInfo -> Bool+matchglob glob (MatchingFile fi) = #ifdef WITH_TDFA 	case cregex of 		Right r -> case execute r (matchFile fi) of@@ -108,6 +110,7 @@ #else 	wildCheckCase glob (matchFile fi) #endif+matchglob _ (MatchingKey _) = False  {- Adds a limit to skip files not believed to be present  - in a specfied repository. -}@@ -115,14 +118,11 @@ addIn = addLimit . limitIn  limitIn :: MkLimit-limitIn name = Right $ \notpresent -> check $+limitIn name = Right $ \notpresent -> checkKey $ 	if name == "." 		then inhere notpresent 		else inremote notpresent   where-	check a = lookupFile >=> handle a-	handle _ Nothing = return False-	handle a (Just (key, _)) = a key 	inremote notpresent key = do 		u <- Remote.nameToUUID name 		us <- Remote.keyLocations key@@ -137,22 +137,20 @@  {- Limit to content that is currently present on a uuid. -} limitPresent :: Maybe UUID -> MkLimit-limitPresent u _ = Right $ const $ check $ \key -> do+limitPresent u _ = Right $ const $ checkKey $ \key -> do 	hereu <- getUUID 	if u == Just hereu || isNothing u 		then inAnnex key 		else do 			us <- Remote.keyLocations key 			return $ maybe False (`elem` us) u-  where-	check a = lookupFile >=> handle a-	handle _ Nothing = return False-	handle a (Just (key, _)) = a key  {- Limit to content that is in a directory, anywhere in the repository tree -} limitInDir :: FilePath -> MkLimit-limitInDir dir = const $ Right $ const $ \fi -> return $-	any (== dir) $ splitPath $ takeDirectory $ matchFile fi+limitInDir dir = const $ Right $ const go+  where+	go (MatchingFile fi) = return $ any (== dir) $ splitPath $ takeDirectory $ matchFile fi+	go (MatchingKey _) = return False  {- Adds a limit to skip files not believed to have the specified number  - of copies. -}@@ -169,10 +167,9 @@   where 	go num good = case readish num of 		Nothing -> Left "bad number for copies"-		Just n -> Right $ \notpresent f ->-			lookupFile f >>= handle n good notpresent-	handle _ _ _ Nothing = return False-	handle n good notpresent (Just (key, _)) = do+		Just n -> Right $ \notpresent -> checkKey $+			handle n good notpresent+	handle n good notpresent key = do 		us <- filter (`S.notMember` notpresent) 			<$> (filterM good =<< Remote.keyLocations key) 		return $ length us >= n@@ -182,6 +179,36 @@ 		| "+" `isSuffixOf` s = (>=) <$> readTrustLevel (beginning s) 		| otherwise = (==) <$> readTrustLevel s +{- Adds a limit to match files that need more copies made. -}+addLackingCopies :: Bool -> String -> Annex ()+addLackingCopies approx = addLimit . limitLackingCopies approx++limitLackingCopies :: Bool -> MkLimit+limitLackingCopies approx want = case readish want of+	Just needed -> Right $ \notpresent mi -> flip checkKey mi $+		handle mi needed notpresent+	Nothing -> Left "bad value for number of lacking copies"+  where+	handle mi needed notpresent key = do+		NumCopies numcopies <- if approx+			then approxNumCopies+			else case mi of+				MatchingKey _ -> approxNumCopies+				MatchingFile fi -> getGlobalFileNumCopies $ matchFile fi+		us <- filter (`S.notMember` notpresent)+			<$> (trustExclude UnTrusted =<< Remote.keyLocations key)+		return $ numcopies - length us >= needed+	approxNumCopies = fromMaybe defaultNumCopies <$> getGlobalNumCopies++{- Match keys that are unused.+ - + - This has a nice optimisation: When a file exists,+ - its key is obviously not unused.+ -}+limitUnused :: MatchFiles+limitUnused _ (MatchingFile _) = return False+limitUnused _ (MatchingKey k) = S.member k <$> unusedKeys+ {- Adds a limit to skip files not believed to be present in all  - repositories in the specified group. -} addInAllGroup :: String -> Annex ()@@ -192,11 +219,10 @@ limitInAllGroup :: GroupMap -> MkLimit limitInAllGroup m groupname 	| S.null want = Right $ const $ const $ return True-	| otherwise = Right $ \notpresent -> lookupFile >=> check notpresent+	| otherwise = Right $ \notpresent -> checkKey $ check notpresent   where 	want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m-	check _ Nothing = return False-	check notpresent (Just (key, _))+	check notpresent key 		-- optimisation: Check if a wanted uuid is notpresent. 		| not (S.null (S.intersection want notpresent))	= return False 		| otherwise = do@@ -208,10 +234,9 @@ addInBackend = addLimit . limitInBackend  limitInBackend :: MkLimit-limitInBackend name = Right $ const $ lookupFile >=> check+limitInBackend name = Right $ const $ checkKey check   where-	wanted = Backend.lookupBackendName name-	check = return . maybe False ((==) wanted . snd)+	check key = pure $ keyBackendName key == name  {- Adds a limit to skip files that are too large or too small -} addLargerThan :: String -> Annex ()@@ -225,8 +250,10 @@ 	Nothing -> Left "bad size" 	Just sz -> Right $ go sz   where-  	go sz _ fi = lookupFile fi >>= check fi sz-	check _ sz (Just (key, _)) = return $ keySize key `vs` Just sz+  	go sz _ (MatchingFile fi) = lookupFile fi >>= check fi sz+	go sz _ (MatchingKey key) = checkkey sz key+	checkkey sz key = return $ keySize key `vs` Just sz+	check _ sz (Just (key, _)) = checkkey sz key 	check fi sz Nothing = do 		filesize <- liftIO $ catchMaybeIO $ 			fromIntegral . fileSize@@ -249,3 +276,10 @@  lookupFile :: FileInfo -> Annex (Maybe (Key, Backend)) lookupFile = Backend.lookupFile . relFile++lookupFileKey :: FileInfo -> Annex (Maybe Key)+lookupFileKey = (fst <$>) <$$> Backend.lookupFile . relFile++checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool+checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a+checkKey a (MatchingKey k) = a k
Limit/Wanted.hs view
@@ -13,9 +13,11 @@ import Types.FileMatcher  addWantGet :: Annex ()-addWantGet = addLimit $ Right $ const $-	\fileinfo -> wantGet False (Just $ matchFile fileinfo)+addWantGet = addLimit $ Right $ const $ checkWant $ wantGet False Nothing  addWantDrop :: Annex ()-addWantDrop = addLimit $ Right $ const $-	\fileinfo -> wantDrop False Nothing (Just $ matchFile fileinfo)+addWantDrop = addLimit $ Right $ const $ checkWant $ wantDrop False Nothing Nothing++checkWant :: (Maybe FilePath -> Annex Bool) -> MatchInfo -> Annex Bool+checkWant a (MatchingFile fi) = a (Just $ matchFile fi)+checkWant _ (MatchingKey _) = return False
Logs.hs view
@@ -11,7 +11,11 @@ import Types.Key  {- There are several varieties of log file formats. -}-data LogVariety = UUIDBasedLog | NewUUIDBasedLog | PresenceLog Key+data LogVariety+	= UUIDBasedLog+	| NewUUIDBasedLog+	| PresenceLog Key+	| SingleValueLog 	deriving (Show)  {- Converts a path from the git-annex branch into one of the varieties@@ -20,6 +24,7 @@ getLogVariety f 	| f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog 	| isRemoteStateLog f = Just NewUUIDBasedLog+	| f == numcopiesLog = Just SingleValueLog 	| otherwise = PresenceLog <$> firstJust (presenceLogs f)  {- All the uuid-based logs stored in the top of the git-annex branch. -}@@ -43,6 +48,9 @@ uuidLog :: FilePath uuidLog = "uuid.log" +numcopiesLog :: FilePath+numcopiesLog = "numcopies.log"+ remoteLog :: FilePath remoteLog = "remote.log" @@ -118,6 +126,7 @@ 	, expect isPresenceLog (getLogVariety $ locationLogFile dummykey) 	, expect isPresenceLog (getLogVariety $ urlLogFile dummykey) 	, expect isNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)+	, expect isSingleValueLog (getLogVariety $ numcopiesLog) 	]   where   	expect = maybe False@@ -127,3 +136,5 @@ 	isNewUUIDBasedLog _ = False 	isPresenceLog (PresenceLog k) = k == dummykey 	isPresenceLog _ = False+	isSingleValueLog SingleValueLog = True+	isSingleValueLog _ = False
+ Logs/NumCopies.hs view
@@ -0,0 +1,38 @@+{- git-annex numcopies log+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Logs.NumCopies (+	setGlobalNumCopies,+	getGlobalNumCopies,+	globalNumCopiesLoad,+) where++import Common.Annex+import qualified Annex+import Types.NumCopies+import Logs+import Logs.SingleValue++instance SingleValueSerializable NumCopies where+	serialize (NumCopies n) = show n+	deserialize = NumCopies <$$> readish++setGlobalNumCopies :: NumCopies -> Annex ()+setGlobalNumCopies = setLog numcopiesLog++{- Value configured in the numcopies log. Cached for speed. -}+getGlobalNumCopies :: Annex (Maybe NumCopies)+getGlobalNumCopies = maybe globalNumCopiesLoad (return . Just)+	=<< Annex.getState Annex.globalnumcopies++globalNumCopiesLoad :: Annex (Maybe NumCopies)+globalNumCopiesLoad = do+	v <- getLog numcopiesLog+	Annex.changeState $ \s -> s { Annex.globalnumcopies = v }+	return v
Logs/PreferredContent.hs view
@@ -38,13 +38,13 @@  {- Checks if a file is preferred content for the specified repository  - (or the current repository if none is specified). -}-isPreferredContent :: Maybe UUID -> AssumeNotPresent -> FilePath -> Bool -> Annex Bool-isPreferredContent mu notpresent file def = do+isPreferredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool+isPreferredContent mu notpresent mkey afile def = do 	u <- maybe getUUID return mu 	m <- preferredContentMap 	case M.lookup u m of 		Nothing -> return def-		Just matcher -> checkFileMatcher' matcher file notpresent def+		Just matcher -> checkMatcher matcher mkey afile notpresent def  {- The map is cached for speed. -} preferredContentMap :: Annex Annex.PreferredContentMap
+ Logs/SingleValue.hs view
@@ -0,0 +1,65 @@+{- git-annex single-value log+ -+ - This is used to store a value in a way that can be union merged.+ -+ - A line of the log will look like: "timestamp value"+ -+ - The line with the newest timestamp wins.+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Logs.SingleValue where++import Common.Annex+import qualified Annex.Branch++import qualified Data.Set as S+import Data.Time.Clock.POSIX+import Data.Time+import System.Locale++class SingleValueSerializable v where+	serialize :: v -> String+	deserialize :: String -> Maybe v++data LogEntry v = LogEntry+	{ changed :: POSIXTime+	, value :: v+	} deriving (Eq, Show, Ord)++type Log v = S.Set (LogEntry v)++showLog :: (SingleValueSerializable v) => Log v -> String+showLog = unlines . map showline . S.toList+  where+	showline (LogEntry t v) = unwords [show t, serialize v]++parseLog :: (Ord v, SingleValueSerializable v) => String -> Log v+parseLog = S.fromList . mapMaybe parse . lines+  where+	parse line = do+		let (ts, s) = splitword line+		date <- utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts+		v <- deserialize s+		Just (LogEntry date v)+	splitword = separate (== ' ')++newestValue :: Log v -> Maybe v+newestValue s+	| S.null s = Nothing+	| otherwise = Just (value $ S.findMax s)++readLog :: (Ord v, SingleValueSerializable v) => FilePath -> Annex (Log v)+readLog = parseLog <$$> Annex.Branch.get++getLog :: (Ord v, SingleValueSerializable v) => FilePath -> Annex (Maybe v)+getLog = newestValue <$$> readLog++setLog :: (SingleValueSerializable v) => FilePath -> v -> Annex ()+setLog f v = do+        now <- liftIO getPOSIXTime+        let ent = LogEntry now v+	Annex.Branch.change f $ \_old -> showLog (S.singleton ent)
Logs/Unused.hs view
@@ -1,32 +1,76 @@ {- git-annex unused log file  -- - Copyright 2010,2012 Joey Hess <joey@kitenet.net>+ - This file is stored locally in .git/annex/, not in the git-annex branch.  -+ - The format: "int key timestamp"+ -+ - The int is a short, stable identifier that the user can use to+ - refer to this key. (Equivilant to a filename.)+ -+ - The timestamp indicates when the key was first determined to be unused.+ - Older versions of the log omit the timestamp.+ -+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>+ -  - Licensed under the GNU GPL version 3 or higher.  -}  module Logs.Unused ( 	UnusedMap,-	writeUnusedLog,+	updateUnusedLog, 	readUnusedLog,+	readUnusedMap,+	dateUnusedLog, 	unusedKeys,+	unusedKeys',+	setUnusedKeys, ) where  import qualified Data.Map as M+import qualified Data.Set as S+import Data.Time.Clock.POSIX+import Data.Time+import System.Locale  import Common.Annex+import qualified Annex import Types.Key import Utility.Tmp +-- everything that is stored in the unused log+type UnusedLog = M.Map Key (Int, Maybe POSIXTime)++-- used to look up unused keys specified by the user type UnusedMap = M.Map Int Key -writeUnusedLog :: FilePath -> [(Int, Key)] -> Annex ()+log2map :: UnusedLog -> UnusedMap+log2map = M.fromList . map (\(k, (i, _t)) -> (i, k)) . M.toList++map2log :: POSIXTime -> UnusedMap -> UnusedLog+map2log t = M.fromList . map (\(i, k) -> (k, (i, Just t))) . M.toList++{- Only keeps keys that are in the new log, but uses any timestamps+ - those keys had in the old log. -}+preserveTimestamps :: UnusedLog -> UnusedLog -> UnusedLog+preserveTimestamps oldl newl = M.intersection (M.unionWith oldts oldl newl) newl+  where+	oldts _old@(_, ts) _new@(int, _) = (int, ts)++updateUnusedLog :: FilePath -> UnusedMap -> Annex ()+updateUnusedLog prefix m = do+	oldl <- readUnusedLog prefix+	newl <- preserveTimestamps oldl . flip map2log m <$> liftIO getPOSIXTime+	writeUnusedLog prefix newl++writeUnusedLog :: FilePath -> UnusedLog -> Annex () writeUnusedLog prefix l = do 	logfile <- fromRepo $ gitAnnexUnusedLog prefix-	liftIO $ viaTmp writeFile logfile $-		unlines $ map (\(n, k) -> show n ++ " " ++ key2file k) l+	liftIO $ viaTmp writeFile logfile $ unlines $ map format $ M.toList l+  where+	format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t+	format (k, (i, Nothing)) = show i ++ " " ++ key2file k -readUnusedLog :: FilePath -> Annex UnusedMap+readUnusedLog :: FilePath -> Annex UnusedLog readUnusedLog prefix = do 	f <- fromRepo $ gitAnnexUnusedLog prefix 	ifM (liftIO $ doesFileExist f)@@ -35,11 +79,31 @@ 		, return M.empty 		)   where-	parse line = case (readish tag, file2key rest) of-		(Just num, Just key) -> Just (num, key)+	parse line = case (readish sint, file2key skey, utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts) of+		(Just int, Just key, mtimestamp) -> Just (key, (int, mtimestamp)) 		_ -> Nothing 	  where-		(tag, rest) = separate (== ' ') line+		(sint, rest) = separate (== ' ') line+		(skey, ts) = separate (== ' ') rest -unusedKeys :: Annex [Key]-unusedKeys = M.elems <$> readUnusedLog ""+readUnusedMap :: FilePath -> Annex UnusedMap+readUnusedMap = log2map <$$> readUnusedLog++dateUnusedLog :: FilePath -> Annex (Maybe UTCTime)+dateUnusedLog prefix = do+	f <- fromRepo $ gitAnnexUnusedLog prefix+	liftIO $ catchMaybeIO $ getModificationTime f++{- Set of unused keys. This is cached for speed. -}+unusedKeys :: Annex (S.Set Key)+unusedKeys = maybe (setUnusedKeys =<< unusedKeys') return+	=<< Annex.getState Annex.unusedkeys++unusedKeys' :: Annex [Key]+unusedKeys' = M.keys <$> readUnusedLog ""++setUnusedKeys :: [Key] -> Annex (S.Set Key)+setUnusedKeys ks = do+	let v = S.fromList ks+	Annex.changeState $ \s -> s { Annex.unusedkeys = Just v }+	return v
Messages.hs view
@@ -1,12 +1,13 @@ {- git-annex output messages  -- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}  module Messages ( 	showStart,+	showStart', 	showNote, 	showAction, 	showProgress,@@ -54,9 +55,13 @@ import qualified Annex import Utility.Metered -showStart :: String -> String -> Annex ()+showStart :: String -> FilePath -> Annex () showStart command file = handle (JSON.start command $ Just file) $ 	flushed $ putStr $ command ++ " " ++ file ++ " "++showStart' :: String -> Key -> Maybe FilePath -> Annex ()+showStart' command key afile = showStart command $+	fromMaybe (key2file key) afile  showNote :: String -> Annex () showNote s = handle (JSON.note s) $
− Option.hs 
@@ -1,79 +0,0 @@-{- common command-line options- -- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module Option (-	common,-	matcher,-	flag,-	field,-	name,-	ArgDescr(..),-	OptDescr(..),-) where--import System.Console.GetOpt--import Common.Annex-import qualified Annex-import Types.Messages-import Limit-import Usage--common :: [Option]-common =-	[ Option [] ["force"] (NoArg (setforce True))-		"allow actions that may lose annexed data"-	, Option ['F'] ["fast"] (NoArg (setfast True))-		"avoid slow operations"-	, Option ['a'] ["auto"] (NoArg (setauto True))-		"automatic mode"-	, Option ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))-		"avoid verbose output"-	, Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))-		"allow verbose output (default)"-	, Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput))-		"enable JSON output"-	, Option ['d'] ["debug"] (NoArg setdebug)-		"show debug messages"-	, Option [] ["no-debug"] (NoArg unsetdebug)-		"don't show debug messages"-	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)-		"specify key-value backend to use"-	]-  where-	setforce v = Annex.changeState $ \s -> s { Annex.force = v }-	setfast v = Annex.changeState $ \s -> s { Annex.fast = v }-	setauto v = Annex.changeState $ \s -> s { Annex.auto = v }-	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }-	setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }-	unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }--matcher :: [Option]-matcher =-	[ longopt "not" "negate next option"-	, longopt "and" "both previous and next option must match"-	, longopt "or" "either previous or next option must match"-	, shortopt "(" "open group of options"-	, shortopt ")" "close group of options"-	]-  where-	longopt o = Option [] [o] $ NoArg $ addToken o-	shortopt o = Option o [] $ NoArg $ addToken o--{- An option that sets a flag. -}-flag :: String -> String -> String -> Option-flag short opt description = -	Option short [opt] (NoArg (Annex.setFlag opt)) description--{- An option that sets a field. -}-field :: String -> String -> String -> String -> Option-field short opt paramdesc description = -	Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description--{- The flag or field name used for an option. -}-name :: Option -> String-name (Option _ o _ _) = Prelude.head o
Remote.hs view
@@ -20,7 +20,7 @@  	remoteTypes, 	remoteList,-	syncableRemote,+	gitSyncableRemote, 	remoteMap, 	uuidDescriptions, 	byName,
Remote/External/Types.hs view
@@ -229,11 +229,11 @@ supportedProtocolVersions :: [ProtocolVersion] supportedProtocolVersions = [1] -class Serializable a where+class ExternalSerializable a where 	serialize :: a -> String 	deserialize :: String -> Maybe a -instance Serializable Direction where+instance ExternalSerializable Direction where 	serialize Upload = "STORE" 	serialize Download = "RETRIEVE" @@ -241,23 +241,23 @@ 	deserialize "RETRIEVE" = Just Download 	deserialize _ = Nothing -instance Serializable Key where+instance ExternalSerializable Key where 	serialize = key2file 	deserialize = file2key -instance Serializable [Char] where+instance ExternalSerializable [Char] where 	serialize = id 	deserialize = Just -instance Serializable ProtocolVersion where+instance ExternalSerializable ProtocolVersion where 	serialize = show 	deserialize = readish -instance Serializable Cost where+instance ExternalSerializable Cost where 	serialize = show 	deserialize = readish -instance Serializable Availability where+instance ExternalSerializable Availability where 	serialize GloballyAvailable = "GLOBAL" 	serialize LocallyAvailable = "LOCAL" @@ -265,7 +265,7 @@ 	deserialize "LOCAL" = Just LocallyAvailable 	deserialize _ = Nothing -instance Serializable BytesProcessed where+instance ExternalSerializable BytesProcessed where 	serialize (BytesProcessed n) = show n 	deserialize = BytesProcessed <$$> readish @@ -283,15 +283,15 @@ parse0 mk "" = Just mk parse0 _ _ = Nothing -parse1 :: Serializable p1 => (p1 -> a) -> Parser a+parse1 :: ExternalSerializable p1 => (p1 -> a) -> Parser a parse1 mk p1 = mk <$> deserialize p1 -parse2 :: (Serializable p1, Serializable p2) => (p1 -> p2 -> a) -> Parser a+parse2 :: (ExternalSerializable p1, ExternalSerializable p2) => (p1 -> p2 -> a) -> Parser a parse2 mk s = mk <$> deserialize p1 <*> deserialize p2   where 	(p1, p2) = splitWord s -parse3 :: (Serializable p1, Serializable p2, Serializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a+parse3 :: (ExternalSerializable p1, ExternalSerializable p2, ExternalSerializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3   where 	(p1, rest) = splitWord s
Remote/Git.hs view
@@ -34,9 +34,9 @@ import Utility.Tmp import Config import Config.Cost-import Init+import Annex.Init import Types.Key-import qualified Fields+import qualified CmdLine.GitAnnexShell.Fields as Fields import Logs.Location import Utility.Metered #ifndef mingw32_HOST_OS@@ -111,7 +111,7 @@ 			, retrieveKeyFile = copyFromRemote new 			, retrieveKeyFileCheap = copyFromRemoteCheap new 			, removeKey = dropKey new-			, hasKey = inAnnex r+			, hasKey = inAnnex new 			, hasKeyCheap = repoCheap r 			, whereisKey = Nothing 			, remoteFsck = if Git.repoIsUrl r@@ -197,7 +197,12 @@ 			Left _ -> do 				set_ignore "not usable by git-annex" 				return r-			Right r' -> return r'+			Right r' -> do+				-- Cache when http remote is not bare for+				-- optimisation.+				unless (Git.Config.isBare r') $+					setremote "annex-bare" (Git.Config.boolConfig False)+				return r'  	store = observe $ \r' -> do 		g <- gitRepo@@ -222,12 +227,18 @@ 				set_ignore "does not have git-annex installed" 			return r 	-	set_ignore msg = case Git.remoteName r of+	set_ignore msg = do+		let k = "annex-ignore"+		case Git.remoteName r of+			Nothing -> noop+			Just n -> warning $ "Remote " ++ n ++ " " ++ msg ++ "; setting " ++ k+		setremote k (Git.Config.boolConfig True)+	+	setremote k v = case Git.remoteName r of 		Nothing -> noop 		Just n -> do-			let k = "remote." ++ n ++ ".annex-ignore"-			warning $ "Remote " ++ n ++ " " ++ msg ++ "; setting " ++ k-			inRepo $ Git.Command.run [Param "config", Param k, Param "true"]+			let k' = "remote." ++ n ++ "." ++ k+			inRepo $ Git.Command.run [Param "config", Param k', Param v] 		 	handlegcrypt Nothing = return r 	handlegcrypt (Just _cacheduuid) = do@@ -242,15 +253,16 @@  - If the remote cannot be accessed, or if it cannot determine  - whether it has the content, returns a Left error message.  -}-inAnnex :: Git.Repo -> Key -> Annex (Either String Bool)-inAnnex r key+inAnnex :: Remote -> Key -> Annex (Either String Bool)+inAnnex rmt key 	| Git.repoIsHttp r = checkhttp =<< getHttpHeaders 	| Git.repoIsUrl r = checkremote 	| otherwise = checklocal   where+  	r = repo rmt 	checkhttp headers = do 		showChecking r-		ifM (anyM (\u -> Url.withUserAgent $ Url.checkBoth u headers (keySize key)) (keyUrls r key))+		ifM (anyM (\u -> Url.withUserAgent $ Url.checkBoth u headers (keySize key)) (keyUrls rmt key)) 			( return $ Right True 			, return $ Left "not found" 			)@@ -263,14 +275,19 @@ 		dispatch (Right (Just b)) = Right b 		dispatch (Right Nothing) = cantCheck r -keyUrls :: Git.Repo -> Key -> [String]-keyUrls r key = map tourl locs+keyUrls :: Remote -> Key -> [String]+keyUrls r key = map tourl locs'   where-	tourl l = Git.repoLocation r ++ "/" ++ l+	tourl l = Git.repoLocation (repo r) ++ "/" ++ l+	-- If the remote is known to not be bare, try the hash locations+	-- used for non-bare repos first, as an optimisation.+	locs+		| remoteAnnexBare (gitconfig r) == Just False = reverse (annexLocations key)+		| otherwise = annexLocations key #ifndef mingw32_HOST_OS-	locs = annexLocations key+	locs' = locs #else-	locs = map (replace "\\" "/") (annexLocations key)+	locs' = map (replace "\\" "/") (annexLocations key) #endif  dropKey :: Remote -> Key -> Annex Bool@@ -309,7 +326,7 @@ 		direct <- isDirect 		Ssh.rsyncHelper (Just feeder)  			=<< Ssh.rsyncParamsRemote direct r Download key dest file-	| Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls (repo r) key) dest+	| Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls r key) dest 	| otherwise = error "copying from non-ssh, non-http remote not supported"   where 	{- Feed local rsync's progress info back to the remote,
Remote/Helper/Ssh.hs view
@@ -12,8 +12,8 @@ import qualified Git.Url import Annex.UUID import Annex.Ssh-import Fields (Field, fieldName)-import qualified Fields+import CmdLine.GitAnnexShell.Fields (Field, fieldName)+import qualified CmdLine.GitAnnexShell.Fields as Fields import Types.GitConfig import Types.Key import Remote.Helper.Messages
Remote/List.hs view
@@ -111,6 +111,6 @@ 		| otherwise = return r  {- Checks if a remote is syncable using git. -}-syncableRemote :: Remote -> Bool-syncableRemote r = remotetype r `elem`+gitSyncableRemote :: Remote -> Bool+gitSyncableRemote r = remotetype r `elem` 	[ Remote.Git.remote, Remote.GCrypt.remote ]
Remote/Web.hs view
@@ -118,7 +118,8 @@ #endif 		DefaultDownloader -> do 			headers <- getHttpHeaders-			Right <$> Url.withUserAgent (Url.checkBoth u' headers $ keySize key)+			Url.withUserAgent $ catchMsgIO .+				Url.checkBoth u' headers (keySize key)   where   	firsthit [] miss _ = return miss 	firsthit (u:rest) _ a = do
+ RunCommand.hs view
@@ -0,0 +1,70 @@+{- git-annex running commands+ -+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE BangPatterns #-}++module RunCommand where++import Common.Annex+import qualified Annex+import Types.Command+import qualified Annex.Queue+import Annex.Exception++type CommandActionRunner = CommandStart -> CommandCleanup++{- Runs a command, starting with the check stage, and then+ - the seek stage. Finishes by printing the number of commandActions that+ - failed. -}+performCommand :: Command -> CmdParams -> Annex ()+performCommand Command { cmdseek = seek, cmdcheck = c, cmdname = name } params = do+	mapM_ runCheck c+	Annex.changeState $ \s -> s { Annex.errcounter = 0 }+	seek params+	showerrcount =<< Annex.getState Annex.errcounter+  where+	showerrcount 0 = noop+	showerrcount cnt = error $ name ++ ": " ++ show cnt ++ " failed"++{- Runs one of the actions needed to perform a command.+ - Individual actions can fail without stopping the whole command,+ - including by throwing IO errors (but other errors terminate the whole+ - command).+ - + - This should only be run in the seek stage. -}+commandAction :: CommandActionRunner+commandAction a = handle =<< tryAnnexIO go+  where+	go = do+		Annex.Queue.flushWhenFull+		callCommand a+	handle (Right True) = return True+	handle (Right False) = incerr+	handle (Left err) = do+		showErr err+		showEndFail+		incerr+	incerr = do+		Annex.changeState $ \s -> +			let ! c = Annex.errcounter s + 1 +			    ! s' = s { Annex.errcounter = c }+			in s'+		return False++{- Runs a single command action through the start, perform and cleanup+ - stages, without catching errors. Useful if one command wants to run+ - part of another command. -}+callCommand :: CommandActionRunner+callCommand = start+  where+	start   = stage $ maybe skip perform+	perform = stage $ maybe failure cleanup+	cleanup = stage $ status+	stage = (=<<)+	skip = return True+	failure = showEndFail >> return False+	status r = showEndResult r >> return r
− Seek.hs 
@@ -1,178 +0,0 @@-{- git-annex command seeking- - - - These functions find appropriate files or other things based on- - the values a user passes to a command, and prepare actions operating- - on them.- -- - Copyright 2010-2013 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module Seek where--import System.PosixCompat.Files--import Common.Annex-import Types.Command-import Types.Key-import Types.FileMatcher-import qualified Annex-import qualified Git-import qualified Git.Command-import qualified Git.LsFiles as LsFiles-import qualified Limit-import qualified Option-import Config-import Logs.Location-import Logs.Unused-import Annex.CatFile--seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath]-seekHelper a params = do-	ll <- inRepo $ \g ->-		runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) params-	{- Show warnings only for files/directories that do not exist. -}-	forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p ->-		unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $-			fileNotFound p-	return $ concat ll--withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek-withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params--withFilesNotInGit :: (FilePath -> CommandStart) -> CommandSeek-withFilesNotInGit a params = do-	{- dotfiles are not acted on unless explicitly listed -}-	files <- filter (not . dotfile) <$>-		seekunless (null ps && not (null params)) ps-	dotfiles <- seekunless (null dotps) dotps-	prepFiltered a $ return $ concat $ segmentPaths params (files++dotfiles)-  where-	(dotps, ps) = partition dotfile params-	seekunless True _ = return []-	seekunless _ l = do-		force <- Annex.getState Annex.force-		g <- gitRepo-		liftIO $ Git.Command.leaveZombie <$> LsFiles.notInRepo force l g--withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek-withPathContents a params = map a . concat <$> liftIO (mapM get params)-  where-	get p = ifM (isDirectory <$> getFileStatus p)-		( map (\f -> (f, makeRelative (parentDir p) f))-			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p-		, return [(p, takeFileName p)]-		)--withWords :: ([String] -> CommandStart) -> CommandSeek-withWords a params = return [a params]--withStrings :: (String -> CommandStart) -> CommandSeek-withStrings a params = return $ map a params--withPairs :: ((String, String) -> CommandStart) -> CommandSeek-withPairs a params = return $ map a $ pairs [] params-  where-	pairs c [] = reverse c-	pairs c (x:y:xs) = pairs ((x,y):c) xs-	pairs _ _ = error "expected pairs"--withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek-withFilesToBeCommitted a params = prepFiltered a $-	seekHelper LsFiles.stagedNotDeleted params--withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek-withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged--withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek-withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged--{- Unlocked files have changed type from a symlink to a regular file.- -- - Furthermore, unlocked files used to be a git-annex symlink,- - not some other sort of symlink.- -}-withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek-withFilesUnlocked' typechanged a params = prepFiltered a unlockedfiles-  where-  	check f = liftIO (notSymlink f) <&&> -		(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)-	unlockedfiles = filterM check =<< seekHelper typechanged params--{- Finds files that may be modified. -}-withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek-withFilesMaybeModified a params =-	prepFiltered a $ seekHelper LsFiles.modified params--withKeys :: (Key -> CommandStart) -> CommandSeek-withKeys a params = return $ map (a . parse) params-  where-	parse p = fromMaybe (error "bad key") $ file2key p--withValue :: Annex v -> (v -> CommandSeek) -> CommandSeek-withValue v a params = do-	r <- v-	a r params--{- Modifies a seek action using the value of a field option, which is fed into- - a conversion function, and then is passed into the seek action.- - This ensures that the conversion function only runs once.- -}-withField :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek-withField option converter = withValue $-	converter <=< Annex.getField $ Option.name option--withFlag :: Option -> (Bool -> CommandSeek) -> CommandSeek-withFlag option = withValue $ Annex.getFlag (Option.name option)--withNothing :: CommandStart -> CommandSeek-withNothing a [] = return [a]-withNothing _ _ = error "This command takes no parameters."--{- If --all is specified, or in a bare repo, runs an action on all- - known keys.- -- - If --unused is specified, runs an action on all keys found by- - the last git annex unused scan.- -- - Otherwise, fall back to a regular CommandSeek action on- - whatever params were passed. -}-withKeyOptions :: (Key -> CommandStart) -> CommandSeek -> CommandSeek-withKeyOptions keyop fallbackop params = do-	bare <- fromRepo Git.repoIsLocalBare-	allkeys <- Annex.getFlag "all"-	unused <- Annex.getFlag "unused"-	auto <- Annex.getState Annex.auto-	case    (allkeys || bare , unused, auto ) of-		(True    , False , False) -> go loggedKeys-		(False   , True  , False) -> go unusedKeys-		(True    , True  , _    )-			| bare && not allkeys -> go unusedKeys-			| otherwise -> error "Cannot use --all with --unused."-		(False   , False , _    ) -> fallbackop params-		(_       , _     , True )-			| bare -> error "Cannot use --auto in a bare repository."-			| otherwise -> error "Cannot use --auto with --all or --unused."-  where-  	go a = do-		unless (null params) $-			error "Cannot mix --all or --unused with file names."-		map keyop <$> a--prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]-prepFiltered a fs = do-	matcher <- Limit.getMatcher-	map (process matcher) <$> fs-  where-	process matcher f = ifM (matcher $ FileInfo f f)-		( a f , return Nothing )--notSymlink :: FilePath -> IO Bool-notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f--whenNotDirect :: CommandSeek -> CommandSeek-whenNotDirect a params = ifM isDirect ( return [] , a params )--whenDirect :: CommandSeek -> CommandSeek-whenDirect a params = ifM isDirect ( a params, return [] )
Test.hs view
@@ -13,10 +13,11 @@ import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck+import Data.Monoid +import Options.Applicative hiding (command) import System.PosixCompat.Files import Control.Exception.Extensible-import Data.Monoid import qualified Data.Map as M import System.IO.HVFS (SystemFS(..)) import qualified Text.JSON@@ -48,7 +49,7 @@ import qualified Config import qualified Config.Cost import qualified Crypto-import qualified Init+import qualified Annex.Init import qualified Utility.Path import qualified Utility.FileMode import qualified Build.SysConfig@@ -64,7 +65,7 @@ import qualified Utility.Scheduled import qualified Utility.HumanTime #ifndef mingw32_HOST_OS-import qualified GitAnnex+import qualified CmdLine.GitAnnex as GitAnnex import qualified Remote.Helper.Encryptable import qualified Types.Crypto import qualified Utility.Gpg@@ -72,33 +73,45 @@  type TestEnv = M.Map String String -main :: IO ()-main = do-#ifndef mingw32_HOST_OS-	indirectenv <- prepare False-	directenv <- prepare True+main :: [String] -> IO ()+main ps = do 	let tests = testGroup "Tests"-		[ localOption (QuickCheckTests 1000) properties-		, unitTests directenv "(direct)"-		, unitTests indirectenv "(indirect)"-		]+		-- Test both direct and indirect mode.+		-- Windows is only going to use direct mode,+		-- so don't test twice.+		[ properties+#ifndef mingw32_HOST_OS+		, withTestEnv True $ unitTests "(direct)"+		, withTestEnv False $ unitTests "(indirect)" #else-	-- Windows is only going to use direct mode, so don't test twice.-	env <- prepare False-	let tests = testGroup "Tests"-		[properties, unitTests env ""]+		, withTestEnv False $ unitTests "" #endif-	let runner = tryIngredients [consoleTestReporter] mempty tests-	ifM (maybe (error "tasty failed to return a runner!") id runner)-		( exitSuccess-		, do-			putStrLn "  (This could be due to a bug in git-annex, or an incompatability"-			putStrLn "   with utilities, such as git, installed on this system.)"-			exitFailure-		)+		] +	-- Can't use tasty's defaultMain because one of the command line+	-- parameters is "test".+	let pinfo = info (helper <*> suiteOptionParser ingredients tests)+		( fullDesc <> header "Builtin test suite" )+	opts <- either (\f -> error =<< errMessage f "git-annex test") return $+		execParserPure (prefs idm) pinfo ps+	case tryIngredients ingredients opts tests of+		Nothing -> error "No tests found!?"+		Just act -> ifM act+			( exitSuccess+			, do+				putStrLn "  (This could be due to a bug in git-annex, or an incompatability"+				putStrLn "   with utilities, such as git, installed on this system.)"+				exitFailure+			)++ingredients :: [Ingredient]+ingredients =+	[ consoleTestReporter+	, listingTests+	]+ properties :: TestTree-properties = testGroup "QuickCheck"+properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" 	[ testProperty "prop_idempotent_deencode_git" Git.Filename.prop_idempotent_deencode 	, testProperty "prop_idempotent_deencode" Utility.Format.prop_idempotent_deencode 	, testProperty "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey@@ -129,12 +142,20 @@ 	, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips 	] -unitTests :: TestEnv -> String -> TestTree-unitTests env note = testGroup ("Unit Tests " ++ note)-	-- test order matters, later tests may rely on state from earlier+{- 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") 	[ check "init" test_init 	, check "add" test_add-	, check "add sha1dup" test_add_sha1dup+	]+  where+	check desc t = testCase desc (t env)++unitTests :: String -> IO TestEnv -> TestTree+unitTests note getenv = testGroup ("Unit Tests " ++ note)+	[ check "add sha1dup" test_add_sha1dup+	, check "add extras" test_add_extras 	, check "add subdirs" test_add_subdirs 	, check "reinject" test_reinject 	, check "unannex (no copy)" test_unannex_nocopy@@ -177,14 +198,11 @@ 	, check "bup remote" test_bup_remote 	, check "crypto" test_crypto 	, check "preferred content" test_preferred_content-	, check "global cleanup" test_global_cleanup 	]   where-	check desc t = testCase desc (t env)--test_global_cleanup :: TestEnv -> Assertion-test_global_cleanup _env = cleanup tmpdir+	check desc t = testCase desc (getenv >>= 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"@@ -203,19 +221,13 @@ 	git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" 	annexed_present sha1annexedfile 	checkbackend sha1annexedfile backendSHA1-	writeFile wormannexedfile $ content wormannexedfile-	git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"-	annexed_present wormannexedfile-	checkbackend wormannexedfile backendWORM 	ifM (annexeval Config.isDirect) 		( do-			boolSystem "rm" [Params "-f", File wormannexedfile] @? "rm failed" 			writeFile ingitfile $ content ingitfile 			not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode" 			boolSystem "rm" [Params "-f", File ingitfile] @? "rm failed" 			git_annex env "sync" [] @? "sync failed" 		, do-			boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed" 			writeFile ingitfile $ content ingitfile 			boolSystem "git" [Param "add", File ingitfile] @? "git add failed" 			boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed"@@ -230,6 +242,13 @@ 	annexed_present sha1annexedfiledup 	annexed_present sha1annexedfile +test_add_extras :: TestEnv -> Assertion+test_add_extras env = intmpclonerepo env $ do+	writeFile wormannexedfile $ content wormannexedfile+	git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"+	annexed_present wormannexedfile+	checkbackend wormannexedfile backendWORM+ test_add_subdirs :: TestEnv -> Assertion test_add_subdirs env = intmpclonerepo env $ do 	createDirectory "dir"@@ -292,6 +311,9 @@ test_drop_withremote env = intmpclonerepo env $ do 	git_annex env "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" 	annexed_notpresent annexedfile 	inmainrepo env $ annexed_present annexedfile@@ -511,9 +533,9 @@ test_fsck_basic :: TestEnv -> Assertion test_fsck_basic env = intmpclonerepo env $ do 	git_annex env "fsck" [] @? "fsck failed"-	boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"+	git_annex env "numcopies" ["2"] @? "numcopies config failed" 	fsck_should_fail env "numcopies unsatisfied"-	boolSystem "git" [Params "config annex.numcopies 1"] @? "git config failed"+	git_annex env "numcopies" ["1"] @? "numcopies config failed" 	corrupt annexedfile 	corrupt sha1annexedfile   where@@ -542,7 +564,7 @@  test_fsck_remoteuntrusted :: TestEnv -> Assertion test_fsck_remoteuntrusted env = intmpclonerepo env $ do-	boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"+	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"@@ -661,7 +683,7 @@   where 	checkunused expectedkeys desc = do 		git_annex env "unused" [] @? "unused failed"-		unusedmap <- annexeval $ Logs.Unused.readUnusedLog ""+		unusedmap <- annexeval $ Logs.Unused.readUnusedMap "" 		let unusedkeys = M.elems unusedmap 		assertEqual ("unused keys differ " ++ desc) 			(sort expectedkeys) (sort unusedkeys)@@ -1083,7 +1105,7 @@ 		)   where   	isdirect = annexeval $ do-		Init.initialize Nothing+		Annex.Init.initialize Nothing 		Config.isDirect  intmpbareclonerepo :: TestEnv -> Assertion -> Assertion@@ -1242,8 +1264,24 @@ unannexed :: FilePath -> Assertion unannexed = runchecks [checkregularfile, checkcontent, checkwritable] -prepare :: Bool -> IO TestEnv-prepare forcedirect = do+withTestEnv :: Bool -> (IO TestEnv -> TestTree) -> TestTree+withTestEnv forcedirect = withResource prepare release+  where+	prepare = do+		env <- prepareTestEnv forcedirect+		case tryIngredients ingredients mempty (initTests env) of+			Nothing -> error "No tests found!?"+			Just act -> unlessM act $+				error "init tests failed! cannot continue"+		return env+	release = releaseTestEnv++releaseTestEnv :: TestEnv -> IO ()+releaseTestEnv _env = do+	cleanup tmpdir++prepareTestEnv :: Bool -> IO TestEnv+prepareTestEnv forcedirect = do 	whenM (doesDirectoryExist tmpdir) $ 		error $ "The temporary directory " ++ tmpdir ++ " already exists; cannot run test suite."
Types/Command.hs view
@@ -18,9 +18,9 @@ data CommandCheck = CommandCheck { idCheck :: Int, runCheck :: Annex () } {- b. The seek stage takes the parameters passed to the command,  -    looks through the repo to find the ones that are relevant- -    to that command (ie, new files to add), and generates- -    a list of start stage actions. -}-type CommandSeek = [String] -> Annex [CommandStart]+ -    to that command (ie, new files to add), and runs commandAction+ -    to handle all necessary actions. -}+type CommandSeek = [String] -> Annex () {- c. The start stage is run before anything is printed about the  -    command, is passed some input, and can early abort it  -    if the input does not make sense. It should run quickly and@@ -42,7 +42,7 @@ 	, cmdnomessages :: Bool      -- don't output normal messages 	, cmdname :: String 	, cmdparamdesc :: String     -- description of params for usage-	, cmdseek :: [CommandSeek]   -- seek stage+	, cmdseek :: CommandSeek 	, cmdsection :: CommandSection 	, cmddesc :: String          -- description of command for usage 	}
Types/FileMatcher.hs view
@@ -7,6 +7,12 @@  module Types.FileMatcher where +import Types.Key (Key)++data MatchInfo+	= MatchingFile FileInfo+	| MatchingKey Key+ data FileInfo = FileInfo 	{ relFile :: FilePath -- may be relative to cwd 	, matchFile :: FilePath -- filepath to match on; may be relative to top
Types/GitConfig.hs view
@@ -1,6 +1,6 @@ {- git-annex configuration  -- - 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,12 +19,14 @@ import Config.Cost import Types.Distribution import Types.Availability+import Types.NumCopies+import Utility.HumanTime  {- Main git-annex settings. Each setting corresponds to a git-config key  - such as annex.foo -} data GitConfig = GitConfig 	{ annexVersion :: Maybe String-	, annexNumCopies :: Int+	, annexNumCopies :: Maybe NumCopies 	, annexDiskReserve :: Integer 	, annexDirect :: Bool 	, annexBackends :: [String]@@ -45,6 +47,8 @@ 	, annexLargeFiles :: Maybe String 	, annexFsckNudge :: Bool 	, annexAutoUpgrade :: AutoUpgrade+	, annexExpireUnused :: Maybe (Maybe Duration)+	, annexSecureEraseCommand :: Maybe String 	, coreSymlinks :: Bool 	, gcryptId :: Maybe String 	}@@ -52,7 +56,7 @@ extractGitConfig :: Git.Repo -> GitConfig extractGitConfig r = GitConfig 	{ annexVersion = notempty $ getmaybe (annex "version")-	, annexNumCopies = get (annex "numcopies") 1+	, annexNumCopies = NumCopies <$> getmayberead (annex "numcopies") 	, annexDiskReserve = fromMaybe onemegabyte $ 		readSize dataUnits =<< getmaybe (annex "diskreserve") 	, annexDirect = getbool (annex "direct") False@@ -74,11 +78,13 @@ 	, annexLargeFiles = getmaybe (annex "largefiles") 	, annexFsckNudge = getbool (annex "fscknudge") True 	, annexAutoUpgrade = toAutoUpgrade $ getmaybe (annex "autoupgrade")+	, annexExpireUnused = maybe Nothing Just . parseDuration+		<$> getmaybe (annex "expireunused")+	, annexSecureEraseCommand = getmaybe (annex "secure-erase-command") 	, coreSymlinks = getbool "core.symlinks" True 	, gcryptId = getmaybe "core.gcrypt-id" 	}   where-	get k def = fromMaybe def $ getmayberead k 	getbool k def = fromMaybe def $ getmaybebool k 	getmaybebool k = Git.Config.isTrue =<< getmaybe k 	getmayberead k = readish =<< getmaybe k@@ -103,6 +109,7 @@ 	, remoteAnnexStartCommand :: Maybe String 	, remoteAnnexStopCommand :: Maybe String 	, remoteAnnexAvailability :: Maybe Availability+	, remoteAnnexBare :: Maybe Bool  	{- These settings are specific to particular types of remotes 	 - including special remotes. -}@@ -133,6 +140,7 @@ 	, remoteAnnexStartCommand = notempty $ getmaybe "start-command" 	, remoteAnnexStopCommand = notempty $ getmaybe "stop-command" 	, remoteAnnexAvailability = getmayberead "availability"+	, remoteAnnexBare = getmaybebool "bare"  	, remoteAnnexSshOptions = getoptions "ssh-options" 	, remoteAnnexRsyncOptions = getoptions "rsync-options"
Types/Limit.hs view
@@ -17,4 +17,4 @@ type MkLimit = String -> Either String MatchFiles  type AssumeNotPresent = S.Set UUID-type MatchFiles = AssumeNotPresent -> FileInfo -> Annex Bool+type MatchFiles = AssumeNotPresent -> MatchInfo -> Annex Bool
+ Types/NumCopies.hs view
@@ -0,0 +1,14 @@+{- git-annex numcopies type+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Types.NumCopies where++newtype NumCopies = NumCopies Int+	deriving (Ord, Eq)++fromNumCopies :: NumCopies -> Int+fromNumCopies (NumCopies n) = n
Types/StandardGroups.hs view
@@ -75,12 +75,12 @@ {- See doc/preferred_content.mdwn for explanations of these expressions. -} preferredContent :: StandardGroup -> PreferredContentExpression preferredContent ClientGroup = lastResort $-	"(exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")"+	"((exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")) and not unused" preferredContent TransferGroup = lastResort $ 	"not (inallgroup=client and copies=client:2) and (" ++ preferredContent ClientGroup ++ ")"-preferredContent BackupGroup = "include=*"+preferredContent BackupGroup = "include=* or unused" preferredContent IncrementalBackupGroup = lastResort-	"include=* and (not copies=incrementalbackup:1)"+	"(include=* or unused) and (not copies=incrementalbackup:1)" preferredContent SmallArchiveGroup = lastResort $ 	"(include=*/archive/* or include=archive/*) and (" ++ preferredContent FullArchiveGroup ++ ")" preferredContent FullArchiveGroup = lastResort notArchived@@ -93,6 +93,8 @@ notArchived = "not (copies=archive:1 or copies=smallarchive:1)"   	 {- Most repositories want any content that is only on untrusted- - or dead repositories. -}+ - or dead repositories, or that otherwise does not have enough copies.+ - Does not look at .gitattributes since that is quite a lot slower.+ -} lastResort :: String -> PreferredContentExpression-lastResort s = "(" ++ s ++ ") or (not copies=semitrusted+:1)"+lastResort s = "(" ++ s ++ ") or approxlackingcopies=1"
− Usage.hs 
@@ -1,111 +0,0 @@-{- git-annex usage messages- -- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module Usage where--import Common.Annex--import Types.Command--import System.Console.GetOpt--usageMessage :: String -> String-usageMessage s = "Usage: " ++ s--{- Usage message with lists of commands by section. -}-usage :: String -> [Command] -> String-usage header cmds = unlines $ usageMessage header : concatMap go [minBound..]-  where-	go section-		| null cs = []-		| otherwise =-			[ ""-			, descSection section ++ ":"-			, ""-			] ++ map cmdline cs-	  where-		cs = filter (\c -> cmdsection c == section) scmds-	cmdline c = concat-		[ cmdname c-		, namepad (cmdname c)-		, cmdparamdesc c-		, descpad (cmdparamdesc c)-		, cmddesc c-		]-	pad n s = replicate (n - length s) ' '-	namepad = pad $ longest cmdname + 1-	descpad = pad $ longest cmdparamdesc + 2-	longest f = foldl max 0 $ map (length . f) cmds-	scmds = sort cmds--{- Usage message for a single command. -}-commandUsage :: Command -> String-commandUsage cmd = unlines-	[ usageInfo header (cmdoptions cmd)-	, "To see additional options common to all commands, run: git annex help options"-	]-  where-	header = usageMessage $ unwords-		[ "git-annex"-		, cmdname cmd-		, cmdparamdesc cmd-		, "[option ...]"-		]--{- Descriptions of params used in usage messages. -}-paramPaths :: String-paramPaths = paramOptional $ paramRepeating paramPath -- most often used-paramPath :: String-paramPath = "PATH"-paramKey :: String-paramKey = "KEY"-paramDesc :: String-paramDesc = "DESC"-paramUrl :: String-paramUrl = "URL"-paramNumber :: String-paramNumber = "NUMBER"-paramNumRange :: String-paramNumRange = "NUM|RANGE"-paramRemote :: String-paramRemote = "REMOTE"-paramGlob :: String-paramGlob = "GLOB"-paramName :: String-paramName = "NAME"-paramValue :: String-paramValue = "VALUE"-paramUUID :: String-paramUUID = "UUID"-paramType :: String-paramType = "TYPE"-paramDate :: String-paramDate = "DATE"-paramTime :: String-paramTime = "TIME"-paramFormat :: String-paramFormat = "FORMAT"-paramFile :: String-paramFile = "FILE"-paramGroup :: String-paramGroup = "GROUP"-paramExpression :: String-paramExpression = "EXPR"-paramSize :: String-paramSize = "SIZE"-paramAddress :: String-paramAddress = "ADDRESS"-paramKeyValue :: String-paramKeyValue = "K=V"-paramNothing :: String-paramNothing = ""-paramRepeating :: String -> String-paramRepeating s = s ++ " ..."-paramOptional :: String -> String-paramOptional s = "[" ++ s ++ "]"-paramPair :: String -> String -> String-paramPair a b = a ++ " " ++ b
Utility/DiskFree.hs view
@@ -1,13 +1,16 @@ {- disk free space checking   -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012, 2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}  {-# LANGUAGE ForeignFunctionInterface, CPP #-} -module Utility.DiskFree ( getDiskFree ) where+module Utility.DiskFree (+	getDiskFree,+	getDiskSize+) where  #ifdef WITH_CLIBS @@ -20,9 +23,12 @@ foreign import ccall safe "libdiskfree.h diskfree" c_diskfree 	:: CString -> IO CULLong -getDiskFree :: FilePath -> IO (Maybe Integer)-getDiskFree path = withFilePath path $ \c_path -> do-	free <- c_diskfree c_path+foreign import ccall safe "libdiskfree.h disksize" c_disksize+	:: CString -> IO CULLong++getVal :: (CString -> IO CULLong) -> FilePath -> IO (Maybe Integer)+getVal getter path = withFilePath path $ \c_path -> do+	free <- getter c_path 	ifM (safeErrno <$> getErrno) 		( return $ Just $ toInteger free 		, return Nothing@@ -30,6 +36,12 @@   where 	safeErrno (Errno v) = v == 0 +getDiskFree :: FilePath -> IO (Maybe Integer)+getDiskFree = getVal c_diskfree++getDiskSize :: FilePath -> IO (Maybe Integer)+getDiskSize = getVal c_disksize+ #else #ifdef mingw32_HOST_OS @@ -41,12 +53,18 @@ getDiskFree path = catchMaybeIO $ do 	(sectors, bytes, nfree, _ntotal) <- getDiskFreeSpace (Just path) 	return $ toInteger sectors * toInteger bytes * toInteger nfree++getDiskSize :: FilePath -> IO (Maybe Integer)+getDiskSize _ = return Nothing #else  #warning Building without disk free space checking support  getDiskFree :: FilePath -> IO (Maybe Integer) getDiskFree _ = return Nothing++getDiskSize :: FilePath -> IO (Maybe Integer)+getDiskSize _ = return Nothing  #endif #endif
Utility/HumanTime.hs view
@@ -7,7 +7,10 @@  module Utility.HumanTime ( 	Duration(..),+	durationSince, 	durationToPOSIXTime,+	durationToDays,+	daysToDuration, 	parseDuration, 	fromDuration, 	prop_duration_roundtrips@@ -17,6 +20,7 @@ import Utility.Applicative import Utility.QuickCheck +import Data.Time.Clock import Data.Time.Clock.POSIX (POSIXTime) import Data.Char import Control.Applicative@@ -25,8 +29,19 @@ newtype Duration = Duration { durationSeconds :: Integer }   deriving (Eq, Ord, Read, Show) +durationSince :: UTCTime -> IO Duration+durationSince pasttime = do+	now <- getCurrentTime+	return $ Duration $ round $ diffUTCTime now pasttime+ durationToPOSIXTime :: Duration -> POSIXTime durationToPOSIXTime = fromIntegral . durationSeconds++durationToDays :: Duration -> Integer+durationToDays d = durationSeconds d `div` dsecs++daysToDuration :: Integer -> Duration+daysToDuration i = Duration $ i * dsecs  {- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -} parseDuration :: String -> Maybe Duration
Utility/libdiskfree.c view
@@ -1,6 +1,6 @@ /* disk free space checking, C mini-library  *- * Copyright 2012 Joey Hess <joey@kitenet.net>+ * Copyright 2012, 2014 Joey Hess <joey@kitenet.net>  *  * Licensed under the GNU GPL version 3 or higher.  */@@ -43,16 +43,12 @@ #include <errno.h> #include <stdio.h> -/* Checks the amount of disk that is available to regular (non-root) users.- * (If there's an error, or this is not supported,- * returns 0 and sets errno to nonzero.)- */-unsigned long long int diskfree(const char *path) {+unsigned long long int get(const char *path, int req) { #ifdef UNKNOWN 	errno = 1; 	return 0; #else-	unsigned long long int available, blocksize;+	unsigned long long int v, blocksize; 	struct STATSTRUCT buf;  	if (STATCALL(path, &buf) != 0)@@ -60,10 +56,33 @@ 	else 		errno = 0; -	available = buf.f_bavail;+	switch (req) {+		case 0:+			v = buf.f_blocks;+			break;+		case 1:+			v = buf.f_bavail;+			break;+		default:+			v = 0;+	}+ 	blocksize = buf.f_bsize;-	return available * blocksize;+	return v * blocksize; #endif+}++/* Checks the amount of disk that is available to regular (non-root) users.+ * (If there's an error, or this is not supported,+ * returns 0 and sets errno to nonzero.)+ */+unsigned long long int diskfree(const char *path) {+	return get(path, 1);+}++/* Gets the total size of the disk. */+unsigned long long int disksize(const char *path) {+	return get(path, 0); }  /*
debian/changelog view
@@ -1,3 +1,54 @@+git-annex (5.20140127) unstable; urgency=medium++  * sync --content: New option that makes the content of annexed files be+    transferred. Similar to the assistant, this honors any configured+    preferred content expressions.+  * Remove --json option from commands not supporting it.+  * status: Support --json.+  * list: Fix specifying of files to list.+  * Allow --all to be mixed with matching options like --copies and --in+    (but not --include and --exclude).+  * numcopies: New command, sets global numcopies value that is seen by all+    clones of a repository.+  * The annex.numcopies git config setting is deprecated. Once the numcopies+    command is used to set the global number of copies, any annex.numcopies+    git configs will be ignored.+  * assistant: Make the prefs page set the global numcopies.+  * Add lackingcopies, approxlackingcopies, and unused to+    preferred content expressions.+  * Client, transfer, incremental backup, and archive repositories+    now want to get content that does not yet have enough copies.+  * Client, transfer, and source repositories now do not want to retain+    unused file contents.+  * assistant: Checks daily for unused file contents, and when possible+    moves them to a repository (such as a backup repository) that+    wants to retain them.+  * assistant: annex.expireunused can be configured to cause unused+    file contents to be deleted after some period of time.+  * webapp: Nudge user to see if they want to expire old unused file+    contents when a lot of them seem to be piling up in the repository.+  * repair: Check git version at run time.+  * assistant: Run the periodic git gc in batch mode.+  * added annex.secure-erase-command config option.+  * Optimise non-bare http remotes; no longer does a 404 to the wrong+    url every time before trying the right url. Needs annex-bare to be+    set to false, which is done when initially probing the uuid of a+    http remote.+  * webapp: After upgrading a git repository to git-annex, fix+    bug that made it temporarily not be synced with.+  * whereis: Support --all.+  * All commands that support --all also support a --key option,+    which limits them to acting on a single key.++ -- Joey Hess <joeyh@debian.org>  Mon, 27 Jan 2014 13:43:28 -0400++git-annex (5.20140117) unstable; urgency=medium++  * Really fix FTBFS on mipsel and sparc due to test suite not being available+    on those architectures.++ -- Joey Hess <joeyh@debian.org>  Fri, 17 Jan 2014 14:46:27 -0400+ git-annex (5.20140116) unstable; urgency=medium    * Added tahoe special remote.
debian/control view
@@ -51,9 +51,10 @@ 	libghc-http-dev, 	libghc-feed-dev, 	libghc-regex-tdfa-dev [!mipsel !s390],-	libghc-tasty-dev [!mipsel !sparc],+	libghc-tasty-dev (>= 0.7) [!mipsel !sparc], 	libghc-tasty-hunit-dev [!mipsel !sparc], 	libghc-tasty-quickcheck-dev [!mipsel !sparc],+	libghc-optparse-applicative-dev, 	lsof [!kfreebsd-i386 !kfreebsd-amd64], 	ikiwiki, 	perlmagick,
+ doc/assistant/unused.png view

binary file changed (absent → 49957 bytes)

+ doc/bugs/--json_is_broken_for_status.mdwn view
@@ -0,0 +1,34 @@+### Please describe the problem.++bad json produced++### What steps will reproduce the problem?+++[[!format sh """+$> git annex status --json+,"success":true}++in another one++$> git annex status --json+D hardware/g-box/builds/mine/.#yoh-debug-lastdidnotconnect.txt+,"success":true}+"""]]++### What version of git-annex are you using? On what operating system?++Debian sid 5.20140116++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+++# End of transcript or log.+"""]]++> Not all commands support json. Made this explict by making --json not be+> a global option. Added --json support to status. [[done]]. --[[Joey]]
+ doc/bugs/Android_:_handling_DCIM__47__Camera_not_being_configurable.mdwn view
@@ -0,0 +1,13 @@+### Please describe the problem.++In order to handle the fact that the directory where pictures are saved is not configurable on my phone, I set up a second git annex repository with the Repository group "file source".++### What version of git-annex are you using? On what operating system?++5.20140108-gce9652++### Please provide any additional information below.++In the log, there are many "too many open files" errors like these :++git:createProcess: runInteractiveProcess: pipe: resource exhausted (Too many open files)
+ doc/bugs/Auto_update_not_updating_to_newest_version.mdwn view
@@ -0,0 +1,70 @@+### Please describe the problem.++I assume this is an assistant problem.++My git-annex version on Mac OS seems to lag significantly behind current releases. I was today informed that it was updated to 5.20131221-g00d1673. Given that there are at least two newer versions I expected it to be updated to the newest one.++There also seems no way to trigger a check for a new version.++### What steps will reproduce the problem?++Install on Mac. Observe over some days and see it not update.+++### What version of git-annex are you using? On what operating system?++5.20131221-g00d1673,+Mac OS++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+[2014-01-10 14:46:44 CET] main: starting assistant version 5.20131221-g00d1673+[2014-01-10 14:46:44 CET] UpgradeWatcher: Finished upgrading git-annex to version 5.20131221-g00d1673 +(scanning...) [2014-01-10 14:46:44 CET] Watcher: Performing startup scan+(started...) [2014-01-10 14:47:02 CET] main: starting assistant version 5.20131221-g00d1673+(scanning...) [2014-01-10 14:47:02 CET] Watcher: Performing startup scan+(started...) +[2014-01-10 14:48:44 CET] main: starting assistant version 5.20131221-g00d1673+(scanning...) [2014-01-10 14:48:44 CET] Watcher: Performing startup scan+(started...) +[2014-01-10 14:49:35 CET] main: starting assistant version 5.20131221-g00d1673+(scanning...) [2014-01-10 14:49:35 CET] Watcher: Performing startup scan+(started...) [2014-01-10 14:52:44 CET] UpgradeWatcher: Upgrading git-annex++[2014-01-10 14:52:44 CET] main: starting assistant version 5.20131221-g00d1673+[2014-01-10 14:52:44 CET] UpgradeWatcher: Finished upgrading git-annex to version 5.20131221-g00d1673 +(scanning...) [2014-01-10 14:52:45 CET] Watcher: Performing startup scan+(started...) [2014-01-10 14:53:13 CET] main: starting assistant version 5.20131221-g00d1673+(scanning...) [2014-01-10 14:53:13 CET] Watcher: Performing startup scan+(started...) +[2014-01-15 15:22:29 CET] main: starting assistant version 5.20131221-g00d1673+[2014-01-15 15:22:30 CET] Cronner: Consistency check in progress+(scanning...) [2014-01-15 15:22:30 CET] Watcher: Performing startup scan+(started...) +(scanning...) [2014-01-15 15:23:05 CET] Watcher: Performing startup scan+[2014-01-15 15:23:05 CET] Committer: Committing changes to git+(Recording state in git...)+(started...) [2014-01-15 15:23:06 CET] main: Syncing with box.com ++[2014-01-15 15:23:28 CET] main: starting assistant version 5.20131221-g00d1673+(scanning...) [2014-01-15 15:23:28 CET] Watcher: Performing startup scan+(started...) [2014-01-15 16:23:30 CET] NetWatcherFallback: Syncing with box.com +[2014-01-15 17:23:31 CET] NetWatcherFallback: Syncing with box.com +[2014-01-15 18:23:32 CET] NetWatcherFallback: Syncing with box.com +[2014-01-16 16:42:15 CET] NetWatcherFallback: Syncing with box.com +[2014-01-16 16:56:33 CET] UpgradeWatcher: Upgrading git-annex++[2014-01-16 16:56:33 CET] main: starting assistant version 5.20131221-g00d1673+[2014-01-16 16:56:33 CET] Cronner: Consistency check in progress+[2014-01-16 16:56:33 CET] UpgradeWatcher: Finished upgrading git-annex to version 5.20131221-g00d1673 +(scanning...) [2014-01-16 16:56:33 CET] Watcher: Performing startup scan+(started...) fsck dvi2bitmap ok+[2014-01-16 16:58:14 CET] main: starting assistant version 5.20131221-g00d1673+(scanning...) [2014-01-16 16:58:14 CET] Watcher: Performing startup scan+(started...) ++# End of transcript or log.+"""]]
+ doc/bugs/Can__39__t_start_it_on_Debian_Wheezy.mdwn view
@@ -0,0 +1,26 @@+### Please describe the problem.+After install I dont get any link to start the program even though can start it from terminal.++### What steps will reproduce the problem?+$ sudo apt-get install git-annex+--->After install...+$ git annex assistant+$ git annex webapp+--->Seems like syntax of the command is not correct, I get the help to write the command correctly.++### What version of git-annex are you using? On what operating system?+git-annex version: 3.20120629+Debian Wheezy 64bits XFCE++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+I don't know where is that log++# End of transcript or log.+"""]]++> Wheezy was released before git-annex had the webapp. If you want it,+> install the backport. [[done]] --[[Joey]]
+ doc/bugs/Cannot_delete_remote_when_ssh_sync_fails.mdwn view
@@ -0,0 +1,8 @@+### Please describe the problem.+The webapp does not offer me the option to delete a remote repository that it did not succeed to synchronize with. Status of the repository is sync enabled (metadata only) but in settings I may only edit the repo, but cannot delete it.++### What steps will reproduce the problem?+Set up git-annex on a new computer. Forget to enable ssh on the machine. Perform a local pairing (success). The sync fails for obvious reasons.++### What version of git-annex are you using? On what operating system?+System is ubuntu but I assume this is a general issue. Version of git-annex is 5.20140117
+ doc/bugs/Creating_a_box.com_repository_fails.mdwn view
@@ -0,0 +1,33 @@+### Please describe the problem.++Adding a repository on box.com, using the assistant, fails with an error message (as seen in the log below).++### What steps will reproduce the problem?++Start up the assistant. Create a new empty repository. Enable consistency checking as suggested. Click add another repository, select box.com, fill in your credentials, keep shared ticked and encrypt all selected, click add repository. Error message appears.+++### What version of git-annex are you using? On what operating system?++5.20140117.1 from ppa of François Marier++ubuntu 13.10 (saucy), i686++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log++[2014-01-26 20:40:10 CET] main: starting assistant version 5.20140117.1+[2014-01-26 20:40:10 CET] Cronner: You should enable consistency checking to protect your data. +(Recording state in git...)+(scanning...) [2014-01-26 20:40:10 CET] Watcher: Performing startup scan+(started...) [2014-01-26 20:41:10 CET] Cronner: Consistency check in progress++(Recording state in git...)+(encryption setup) (shared cipher) (testing WebDAV server...)+26/Jan/2014:20:41:24 +0100 [Error#yesod-core] InternalIOException <socket: 32>: hPutBuf: illegal operation (handle is closed) @(yesod-core-1.2.3:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:471:5)++# End of transcript or log.+"""]]
+ doc/bugs/Resolve_.local_adresses_using_avahi_or_bonjour.mdwn view
@@ -0,0 +1,16 @@+### Please describe the problem.++trying to add a remote host using its avahi local name : nas.local (for example). ++### What steps will reproduce the problem?++add remote server, use nas.local > cannot resolve nas.local++### What version of git-annex are you using? On what operating system?++Version: 5.20140116-g2d9ec29+Ubuntu++### Please provide any additional information below.++
+ doc/bugs/__96__minimal_build__39____fails_due_to_missing_stm_dependency.mdwn view
@@ -0,0 +1,95 @@+### Please describe the problem.++Building a recent git-annex with cabal with the `minimal build'+options given in the installation instructions fails. It is probably+just a matter of fixing the dependencies in the cabal file.++### What steps will reproduce the problem?+Compile with:++cabal install git-annex-5.20140108 --bindir=$HOME/bin -f"-assistant -webapp -webdav -pairing -xmpp -dns"++### What version of git-annex are you using? On what operating system?+Linux 2.6.32-5-686 i686 GNU/Linux+++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+Resolving dependencies...+[ 1 of 27] Compiling Utility.PartialPrelude ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/PartialPrelude.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/PartialPrelude.o )+[ 2 of 27] Compiling Utility.FileSystemEncoding ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/FileSystemEncoding.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/FileSystemEncoding.o )+[ 3 of 27] Compiling Utility.Applicative ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Applicative.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Applicative.o )+[ 4 of 27] Compiling Utility.Data     ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Data.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Data.o )+[ 5 of 27] Compiling Utility.Exception ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Exception.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Exception.o )+[ 6 of 27] Compiling Utility.Tmp      ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Tmp.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Tmp.o )+[ 7 of 27] Compiling Utility.Env      ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Env.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Env.o )+[ 8 of 27] Compiling Utility.UserInfo ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/UserInfo.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/UserInfo.o )+[ 9 of 27] Compiling Utility.OSX      ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/OSX.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/OSX.o )+[10 of 27] Compiling Utility.Monad    ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Monad.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Monad.o )+[11 of 27] Compiling Utility.Misc     ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Misc.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Misc.o )+[12 of 27] Compiling Utility.Process  ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Process.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Process.o )+[13 of 27] Compiling Utility.Path     ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Path.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Path.o )+[14 of 27] Compiling Utility.FreeDesktop ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/FreeDesktop.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/FreeDesktop.o )+[15 of 27] Compiling Assistant.Install.AutoStart ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Assistant/Install/AutoStart.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Assistant/Install/AutoStart.o )+[16 of 27] Compiling Utility.SafeCommand ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/SafeCommand.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/SafeCommand.o )+[17 of 27] Compiling Utility.ExternalSHA ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/ExternalSHA.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/ExternalSHA.o )+[18 of 27] Compiling Utility.Directory ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Utility/Directory.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Utility/Directory.o )+[19 of 27] Compiling Common           ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Common.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Common.o )+[20 of 27] Compiling Git.Version      ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Git/Version.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Git/Version.o )+[21 of 27] Compiling Config.Files     ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Config/Files.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Config/Files.o )+[22 of 27] Compiling Assistant.Install.Menu ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Assistant/Install/Menu.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Assistant/Install/Menu.o )+[23 of 27] Compiling Build.TestConfig ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Build/TestConfig.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Build/TestConfig.o )+[24 of 27] Compiling Build.Version    ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Build/Version.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Build/Version.o )+[25 of 27] Compiling Build.Configure  ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Build/Configure.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Build/Configure.o )+[26 of 27] Compiling Build.DesktopFile ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Build/DesktopFile.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Build/DesktopFile.o )+[27 of 27] Compiling Main             ( /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/Setup.hs, /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/Main.o )+Linking /tmp/git-annex-5.20140108-30015/git-annex-5.20140108/dist/setup/setup ...+  checking version...fatal: Not a git repository (or any of the parent directories): .git+ 5.20140107+  checking UPGRADE_LOCATION... not available+  checking git... yes+  checking git version... 1.7.2.5+  checking cp -a... yes+  checking cp -p... yes+  checking cp --reflink=auto... yes+  checking xargs -0... yes+  checking rsync... yes+  checking curl... no+  checking wget... yes+  checking bup... no+  checking quvi... no+  checking newquvi... no+  checking nice... yes+  checking ionice... yes+  checking nocache... no+  checking gpg... gpg+  checking lsof... lsof+  checking git-remote-gcrypt... not available+  checking ssh connection caching... no+  checking sha1... sha1sum+  checking sha256... sha256sum+  checking sha512... sha512sum+  checking sha224... sha224sum+  checking sha384... sha384sum+Configuring git-annex-5.20140108...+Building git-annex-5.20140108...+Preprocessing executable 'git-annex' for git-annex-5.20140108...++Remote/External.hs:29:8:+    Could not find module `Control.Concurrent.STM'+    It is a member of the hidden package `stm-2.4.2'.+    Perhaps you need to add `stm' to the build-depends in your .cabal file.+    Use -v to see a list of the files searched for.+Failed to install git-annex-5.20140108+cabal: Error: some packages failed to install:+git-annex-5.20140108 failed during the building phase. The exception was:+ExitFailure 1+++# End of transcript or log.+"""]]++> [[fixed|done]] --[[Joey]]
+ doc/bugs/can__39__t_get.mdwn view
@@ -0,0 +1,75 @@+### Please describe the problem.+++### What steps will reproduce the problem?++[[!format sh """+$> git annex get 2read/ISNN2010__Tang.pdf+git-annex: Cannot mix --all or --unused with file names.+"""]]++### What version of git-annex are you using? On what operating system?+++[[!format sh """+$> apt-cache policy git-annex+git-annex:+  Installed: 5.20140116+  Candidate: 5.20140116+  Version table:+ *** 5.20140116 0+        600 http://debian.lcs.mit.edu/debian/ sid/main amd64 Packages+        100 /var/lib/dpkg/status+"""]]++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log++$> git annex get 2read/ISNN2010__Tang.pdf+git-annex: Cannot mix --all or --unused with file names.++but seems to start fetching some load if I do not specify any path and just run 'git annex get'.++There seems to be some screw up:++I have plenty of objects under .git/annex/objects/ (seems largely from+the directory above), nothing is now reported by unused (with obscure+msg):++$> du -scmL * 2>/dev/null | tail -1+1	total                      ++$> du -scm .git/annex/objects +334	.git/annex/objects+334	total++$> git annex dropunused all+git-annex: Map.findMin: empty map has no minimal element++Here is some portion of the history which lead to such a state (there+was git annex unused somewhere before)++25954  git annex move --unused --to onerussian.com_annex+25955  git annex dropunused+25956  git annex dropunused all+25962  git annex unused+25963  git log --stat -SSHA256E-s5639442--67691e57cb4d6c51afe838590ad265ba4bea9c291cf52d58ed24f05b70bf33bf.mp3+25965  git log --stat -SSHA256E-s143042--b4012bf03ed0a387a9e714390efa75f1dd769162cca4c9b77e516732342be3f9.html+25968  git annex move --unused --to onerussian.com_annex+25969  git annex dropunused all+25976  git annex unused+25978  git br+25980  git log --stat -Ss741707--7c215090893f1f0c994e2a9ad3088016676464bbad26768841dd08c07295a2fe.pdf.map+25981  git annex unused+25982  git annex fsck+25983  git annex unused+25984  git annex dropkey+25985  git log --stat -SSHA256E-s14534131--20de680eedb3e1fb687c9b00c154d978333b61f4ea122c632bdb5bcdbb1553ff.pdf+25986  git show de3ccae8304efbae4a7a8add49de638f64b821fc+25991  git annex fsck++# End of transcript or log.+"""]]
+ doc/bugs/can__39__t_get/comment_1_ef32287828481c161bd913c9db9052a5._comment view
@@ -0,0 +1,27 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY"+ nickname="Yaroslav"+ subject="git annex fix starts fixing but then spits bulk of errors"+ date="2014-01-18T05:42:15Z"+ content="""+probably related:++```+fix books/Мои первые книжки/PDF/Благинина Е.А. - Лодочки (Мои первые книжки) - 1962.pdf ok+fix books/Мои первые книжки/PDF/Благинина Е.А. - Не мешайте мне трудиться (Мои первые книжки) - 1975.pdf fatal: This operation must be run in a work tree+ok+(Recording state in git...)++git-annex: user error (xargs [\"-0\",\"git\",\"--git-dir=/home/yoh/annex/.git\",\"add\",\"--force\",\"--\"] exited 123)+fatal: This operation must be run in a work tree+failed+(Recording state in git...)++git-annex: user error (xargs [\"-0\",\"git\",\"--git-dir=/home/yoh/annex/.git\",\"add\",\"--force\",\"--\"] exited 123)+fatal: This operation must be run in a work tree+failed+(Recording state in git...)++....+```+"""]]
+ doc/bugs/can__39__t_get/comment_2_31fe400f4bac516a5c1101612cb06a54._comment view
@@ -0,0 +1,32 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY"+ nickname="Yaroslav"+ subject="repair seems to be also confused"+ date="2014-01-18T05:47:02Z"+ content="""+[[[+$> git annex repair                               +Running git fsck ...+No problems found.+fatal: '/home/yoh/annex/.git' is outside repository+Had to delete the .git/annex/index file as it was corrupt.+No data was lost.+ok++$> ls+2enjoy/   2read/    2watch/  books/  hardware/  videos/+2listen/  2review/  abooks/  docs/   pics/++$> git annex repair+Running git fsck ...+No problems found.+fatal: '/home/yoh/annex/.git' is outside repository+Had to delete the .git/annex/index file as it was corrupt.+No data was lost.+ok++$> git annex get 2read/ISNN2010__Tang.pdf+git-annex: Cannot mix --all or --unused with file names.++]]]+"""]]
+ doc/bugs/can__39__t_get/comment_3_87d123c04815d38abb92f967829c3a23._comment view
@@ -0,0 +1,16 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY"+ nickname="Yaroslav"+ subject="could it be part/reason of the problem"+ date="2014-01-18T06:05:50Z"+ content="""+not sure how that happened... definitely not me consciously! ;-)  some commands are complaining that \"You cannot run this command in a bare repository\" which I thought is BS since it is not BARE! but then looked into .git/config and it does have core.bare = True ... yikes!.. ++This repository is also under assistant \"control\".++changing to bare=False seems to start 'get'ing things, git annex repair doesn't produce obscure errors.++git annex fix though now doesn't report any problems -- only 'ok', but none of those files mentioned 'ok' has a working symlink,,,  but I guess that is a fluke after many upgrades -- just dropping everything locally and getting needed context after purging .git/annex/objects .++So I guess issue is resolved by discovering that repository was set to 'bare' mode somehow although it was not and seemed like working but not quite+"""]]
+ doc/bugs/can__39__t_get/comment_4_b99cff87dbe38f08f888200dfe7e2436._comment view
@@ -0,0 +1,14 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.43"+ subject="comment 4"+ date="2014-01-18T15:42:59Z"+ content="""+git-annex sets core.bare=true for direct mode, but it also then sets annex.direct=true and so does not treat it as a bare mode repository. If you had eg, manually tried to change annex.direct to false, and left it in bare mode, that would explain everything.++> git annex fix though now doesn't report any problems -- only 'ok', but none of those files mentioned 'ok' has a working symlink++That is completely normal behavior; git annex fix does not care if the content is locally present or not; it just checks that the symlinks would point to it if it were present.++(Fixed the partial function in dropunused.)+"""]]
doc/copies.mdwn view
@@ -6,8 +6,8 @@ to keep N copies of a file's content available across all repositories.  (Although [[untrusted_repositories|trust]] don't count toward this total.) -By default, N is 1; it is configured by annex.numcopies. This default-can be overridden on a per-file-type basis by the annex.numcopies+By default, N is 1; it is configured by running `git annex numcopies N`.+This default can be overridden on a per-file-type basis by the annex.numcopies setting in `.gitattributes` files. The --numcopies switch allows temporarily using a different value. @@ -30,9 +30,3 @@  With N=2, in order to drop the file content from Laptop, it would need access to both USB and Server.--Note that different repositories can be configured with different values of-N. So just because Laptop has N=2, this does not prevent the number of-copies falling to 1, when USB and Server have N=1. To avoid this,-configure it in `.gitattributes`, which is shared between repositories-using git.
doc/design/assistant/telehash.mdwn view
@@ -33,7 +33,7 @@ * XMPP pairing can also be used for telehash address discovery. (Note that   MITM attacks are possible.) Is it worth keeping XMPP in git-annex just   for this?-* Telehash addresses of repoitories can be communicated out of band (eg,+* Telehash addresses of repositories can be communicated out of band (eg,   via an OTR session or gpg signed mail), and pasted into the webapp to   initiate a repository pairing that then proceeds entirely over telehash.   Once both sides do this, the pairing can proceed automatically.@@ -58,3 +58,33 @@ and `git push` can be used at the command line to access telehash remotes. Allows using general git entirely decentralized and with end-to-end encryption.++## separate daemon?++A `gathd` could contain all the telehash specific code, and git-annex+communicate with it via a local socket.++Advantages:++* `git annex sync` could also use the running daemon+* `git-remote-telehash` could use the running daemon+* c-telehash might end up linked to openssl, which has licence combination+  problems with git-annex. A separate process not using git-annex's code+  would avoid this.+* Allows the daemon to be written in some other language if necessary+  (for example, if c-telehash development stalls and the nodejs version is+  already usable)+* Potentially could be generalized to handle other similar protocols.+  Or even the xmpp code moved into it. There could even be git-annex native+  exchange protocols implemented in such a daemon to allow SSH-less+  transfers.+* Security holes in telehash would not need to compromise the entire+  git-annex. gathd could be sandboxed in one way or another.++Disadvantages:++* Adds a memcopy when large files are being transferred through telehash.+  Unlikely to be a bottleneck.+* Adds some complexity.+* What IPC to use on Windows? Might have to make git-annex communicate+  with it over its stdin/stdout there.
+ doc/design/preferred_content.mdwn view
@@ -0,0 +1,21 @@+The [[preferred_content]] expressions didn't have a design document, but+it's a small non-turing complete DSL for expressing which objects a+repository prefers to contain.++One thing that needs to be written down though is the stability analysis+that must be done of preferred content expressions. ++It's important that when a set of repositories all look at one-another's+preferred content expressions, and copy/move/drop objects to satisfy them,+they end up at a steady state. So, a given preferred content expression+should ideally evaluate to the same answer for each key, from the+perspective of each repository.++The best way to ensure that is the case is to only use terms in preferred+content expressions that rely on state that is shared between all+repositories. So, state in the git-annex branch, or the master branch+(assuming all repositories have master checked out).++Since git is eventually consistent, there might be disagreements about+which object belongs where, but once consistency is reached, things will+settle down.
+ doc/devblog/day_100__git-annex_sync_--content.mdwn view
@@ -0,0 +1,4 @@+Spent the day building this new feature, which makes `git annex sync --content`+do the same synchronization of file contents (to satisfy preferred content+settings) that the assistant does. The result has not been tested a lot+yet, but seems to work well.
+ doc/devblog/day_101__old_mistakes.mdwn view
@@ -0,0 +1,23 @@+In order to remove some hackishness in `git annex sync --content`, I+finally fixed a bad design decision I made back at the very beginning+(before I really knew haskell) when I built the command seek code, which+had led to a kind of inversion of control. This took most of a night, but+it made a lot of code in git-annex clearer, and it makes the command+seeking code much more flexible in what it can do. Some of the oldest, and+worst code in git-annex was removed in the process.++Also, I've been reworking the numcopies configuration, to allow for a +[[todo/preferred_content_numcopies_check]]. That will let the assistant,+as well as `git annex sync --content` proactively make copies when+needed in order to satisfy numcopies. ++As part of this, `git config annex.numcopies` is deprecated, and there's a+new `git annex numcopies N` command that sets the numcopies value that will+be used by any clone of a repository.++I got the preferred content checking of numcopies working too. However,+I am unsure if checking for per-file .gitattributes annex.numcopies+settings will make preferred content expressions be, so I have left+that out for now.++Today's work was sponsored by Josh Taylor.
+ doc/devblog/day_102__cleanups.mdwn view
@@ -0,0 +1,10 @@+Worked on cleaning up and reorganizing all the code that handles numcopies+settings. Much nicer now. Fixed some bugs.++As expected, making the preferred content numcopies check look at+.gitattributes slows it down significantly. So, exposed both the slow and+accurate check and a faster version that ignores .gitattributes.++Also worked on the test suite, removing dependencies between tests.+This will let tasty-rerun be used later to run only previously failing+tests.
+ doc/devblog/day_103__unused.mdwn view
@@ -0,0 +1,34 @@+A big missing peice of the assistant is doing something about the content+of old versions of files, and deleted files. In direct mode, editing or+deleting a file necessarily loses its content from the local repository,+but the content can still hang around in other repositories. So, the+assistant needs to do something about that to avoid eating up disk space+unnecessarily.++I built on recent work, that lets preferred content expressions be matched+against keys with no associated file. This means that I can run unused keys+through all the machinery in the assistant that handles file transfers, and+they'll end being moved to whatever repository wants them. To control which+repositories do want to retain unused files, and which not, I added a+`unused` keyword to preferred content expressions. Client repositories and+transfer repositories do not want to retain unused files, but backup etc+repos do.++One nice thing about this `unused` preferred content implementation is that+it doesn't slow down normal matching of preferred content expressions at+all. Can you guess why not? See [[!commit 4b55afe9e92c045d72b78747021e15e8dfc16416]]++So, the assistant will run `git annex unused` on a daily basis, and+cause unused files to flow to repositories that want them. But what if no+repositories do? To guard against filling up the local disk, there's+a `annex.expireunused` configuration setting, that can cause old unused+files to be deleted by the assistant after a number of days.++I made the assistant check if there seem to be a lot of unused files piling+up. (1000+, or 10% of disk used by them, or more space taken by unused files+than is free.) If so, it'll pop up an alert to nudge the user to configure+annex.expireunused.++Still need to build the UI to configure that, and test all of this.++Today's work was sponsored by Samuel Tardieu.
+ doc/devblog/day_104__unused_II.mdwn view
@@ -0,0 +1,7 @@+Built the UI to manage unused files.++[[!img assistant/unused.png]]++Testing yesterday's work, I found several problems that prevented the+assistant from moving unused files around, and fixed them. It seems to be+working pretty well now.
doc/devblog/day_94__leaks.mdwn view
@@ -7,6 +7,6 @@ Before: [[bugs/import_memleak_from_the_assistant/leakbefore.png]] After: [[bugs/import_memleak_from_the_assistant/leakafter.png]] -Also fixed a bug in `git annex add` when the disk was completely full. It-could sometimes in that situation move the file from the work tree to+Also fixed a bug in `git annex add` when the disk was completely full.+In that situation, it could sometimes move the file from the work tree to .git/annex/objects and fail to put the symlink in place.
+ doc/devblog/day_99__catching_up_again.mdwn view
@@ -0,0 +1,19 @@+Activity has been a bit low again this week. It seems to make sense to do+weekly releases currently (rather than bi-monthly), and Thursday's+release had only one new feature (Tahoe LAFS) and a bunch of bug fixes.++Looks like git-annex will get back into Debian testing soon, after various+fixes to make it build on all architectures again, and then the+backport can be updated again too.++I have been struggling with a problem with the OSX builds, which fail with+a SIGKILL on some machines. It seems that homebrew likes to agressively+optimise things it builds, and while I have had some success with its+`--build-bottle` option, something in the gnutls stack used for XMPP is+still over-optimised. Waiting to hear back from Kevin on cleaning up some+optimised system libraries on the OSX host I use. (Is there some way to make+a clean chrooot on OSX that can be accessed by a non-root user?)++Today I did some minor work involving the --json switch, and also +a small change (well, under 300 line diff) allowing+--all to be mixed with options like --copies and --in.
+ doc/forum/Can_not_drop_unused_file.mdwn view
@@ -0,0 +1,14 @@+I have encrypted directory remote on a usb drive over time it accumulated some unused files. I would like to drop them running,++    git annex --unused --from external++returns a list of unused files when I try to drop them with,+++    git annex dropunused --force --from external 1-XX++I get,++    dropunused XX (from external...) failed++I can not seem to get rid of these files.
− doc/forum/Limit_file_revision_history.mdwn 
@@ -1,22 +0,0 @@-Hi, I am assuming to use git-annex-assistant for two usecases, but I would like to ask about the options or planed roadmap for dropped/removed files from the repository.--Usecases:--1. sync working directory between laptop, home computer, work komputer-2. archive functionality for my photograps--Both usecases have one common factor. Some files might become obsolate and in long time frame nobody is interested to keep their revisions. Let's assume photographs. Usuall workflow I take is to import all photograps to filesystem, then assess (select) the good ones I want to keep and then process them what ever way.--Problem with git-annex(-assistant) I have is that it start to revision all of the files at the time they are added to directory. This is welcome at first but might be an issue if you are used to put 80% of the size of your imported files to trash.--I am aware of what git-annex is not. I have been reading documentation for "git-annex drop" and "unused" options including forums. I do understand that I am actually able to delete all revisions of the file if I will drop it, remove it and if I will run git annex unused 1..###. (on all synced repositories).--I actually miss the option to have above process automated/replicated to the other synced repositories.--I would formulate the 'use case' requirements for git-annex as:--* command to drop an file including revisions from all annex repositories? (for example like moving a file to /trash folder) that will schedulle it's deletition)-* option to keep like max. 10 last revisions of the file?-* option to keep only previous revisions if younger than 6 months from now?--Finally, how to specify a feature request for git-annex?
doc/git-annex.mdwn view
@@ -23,7 +23,7 @@  When a file is annexed, its content is moved into a key-value store, and a symlink is made that points to the content. These symlinks are checked into-git and versioned like regular files. You can move them around, delete +git and versioned like regular files. You can move them around, delete them, and so on. Pushing to another git repository will make git-annex there aware of the annexed file, and it can be used to retrieve its content from the key-value store.@@ -54,7 +54,7 @@  # COMMONLY USED COMMANDS -Like many git commands, git-annex can be passed a path that +Like many git commands, git-annex can be passed a path that is either a file or a directory. In the latter case it acts on all relevant files in the directory. When no path is specified, most git-annex commands default to acting on all relevant files in the current directory (and@@ -78,7 +78,7 @@  * `drop [path ...]` -  Drops the content of annexed files from this repository. +  Drops the content of annexed files from this repository.    git-annex will refuse to drop content if it cannot verify it is   safe to do so. This can be overridden with the `--force` switch.@@ -86,7 +86,7 @@   To drop content from a remote, specify `--from`.  * `move [path ...]`-  +   When used with the `--from` option, moves the content of annexed files   from the specified repository to the current one. @@ -111,13 +111,13 @@    Similar to `git status --short`, displays the status of the files in the   working tree. Shows files that are not checked into git, files that-  have been deleted, and files that have been modified. -  Particulary useful in direct mode.+  have been deleted, and files that have been modified.+  Particularly useful in direct mode.  * `unlock [path ...]`    Normally, the content of annexed files is protected from being changed.-  Unlocking a annexed file allows it to be modified. This replaces the+  Unlocking an annexed file allows it to be modified. This replaces the   symlink for each specified file with a copy of the file's content.   You can then modify it and `git annex add` (or `git commit`) to inject   it back into the annex.@@ -139,25 +139,29 @@   the default is to sync with all remotes. Or specify `--fast` to sync with   the remotes with the lowest annex-cost value. -  The sync process involves first committing all local changes+  The sync process involves first committing all local changes,   then fetching and merging the `synced/master` and the `git-annex` branch-  from the remote repositories and finally pushing the changes back to+  from the remote repositories, and finally pushing the changes back to   those branches on the remote repositories. You can use standard git   commands to do each of those steps by hand, or if you don't want to   worry about the details, you can use sync. -  Merge conflicts are automatically resolved by sync. When two conflicting+  Merge conflicts are automatically handled by sync. When two conflicting   versions of a file have been committed, both will be added to the tree,   under different filenames. For example, file "foo" would be replaced   with "foo.somekey" and "foo.otherkey".    Note that syncing with a remote will not update the remote's working   tree with changes made to the local repository. However, those changes-  are pushed to the remote, so can be merged into its working tree+  are pushed to the remote, so they can be merged into its working tree   by running "git annex sync" on the remote. -  Note that sync does not transfer any file contents from or to the remote-  repositories.+  With the `--content` option, the contents of annexed files in the work+  tree will also be uploaded and downloaded from remotes. By default,+  this tries to get each annexed file that the local repository does not+  yet have, and then copies each file to every remote that it is syncing with.+  This behavior can be overridden by configuring the preferred content of+  a repository. See see PREFERRED CONTENT below.  * `merge` @@ -212,7 +216,7 @@   addurl can be used both to add new files, or to add urls to existing files.    When quvi is installed, urls are automatically tested to see if they-  are on a video hosting site, and the video is downloaded instead.+  point to a video hosting site, and the video is downloaded instead.  * `rmurl file url` @@ -221,7 +225,7 @@ * `import [path ...]`    Moves files from somewhere outside the git working copy, and adds them to-  the annex. Individual files to import can be specified. +  the annex. Individual files to import can be specified.   If a directory is specified, the entire directory is imported.          	git annex import /media/camera/DCIM/*@@ -285,7 +289,7 @@   files that it does not match will instead be added with `git add`.    To not daemonize, run with `--foreground` ; to stop a running daemon,-  run with `--stop`+  run with `--stop`.  * `assistant` @@ -293,7 +297,7 @@   Typically started at boot, or when you log in.    With the `--autostart` option, the assistant is started in any repositories-  it has created. These are listed in `~/.config/git-annex/autostart`+  it has created. These are listed in `~/.config/git-annex/autostart`.  * `webapp` @@ -319,7 +323,7 @@    It's useful, but not mandatory, to initialize each new clone   of a repository with its own description. If you don't provide one,-  one will be generated.+  one will be generated using the username, hostname and the path.  * `describe repository description` @@ -331,7 +335,7 @@  * `initremote name [param=value ...]` -  Creates a new special remote, and adds it to `.git/config`. +  Creates a new special remote, and adds it to `.git/config`.    The remote's configuration is specified by the parameters. Different   types of special remotes need different configuration values. The@@ -340,7 +344,7 @@   All special remotes support encryption. You can either specify   `encryption=none` to disable encryption, or specify   `encryption=hybrid keyid=$keyid ...` to specify a GPG key id (or an email-  address associated with a key.)+  address associated with a key).    There are actually three schemes that can be used for management of the   encryption keys. When using the encryption=hybrid scheme, additional@@ -368,7 +372,7 @@   which may be a different repository than the one in which it was   originally created with the initremote command. -  The name of the remote is the same name used when originally +  The name of the remote is the same name used when originally   creating that remote with "initremote". Run "git annex enableremote"   with no parameters to get a list of special remote names. @@ -381,7 +385,7 @@   the as the encryption scheme cannot be changed once a special remote   has been created.) -  The GPG keys that an encrypted special remote is encrypted to can be+  The GPG keys that an encrypted special remote is encrypted with can be   changed using the keyid+= and keyid-= parameters. These respectively   add and remove keys from the list. However, note that removing a key   does NOT necessarily prevent the key's owner from accessing data@@ -399,6 +403,20 @@   keyid+= and keyid-= with such remotes should be used with care, and   make little sense except in cases like the revoked key example above. +* `numcopies [N]`++  Tells git-annex how many copies it should preserve of files, over all+  repositories. The default is 1.++  Run without a number to get the current value.++  When git-annex is asked to drop a file, it first verifies that the+  required number of copies can be satisfied amoung all the other+  repositories that have a copy of the file.++  This can be overridden on a per-file basis by the annex.numcopies setting+  in .gitattributes files.+ * `trust [repository ...]`    Records that a repository is trusted to not unexpectedly lose@@ -417,7 +435,7 @@  * `dead [repository ...]` -  Indicates that the repository has been irretrevably lost.+  Indicates that the repository has been irretrievably lost.   (To undo, use semitrust.)  * `group repository groupname`@@ -601,7 +619,7 @@   finds files in the current directory and its subdirectories.    By default, only lists annexed files whose content is currently present.-  This can be changed by specifying file matching options. To list all+  This can be changed by specifying matching options. To list all   annexed files, present or not, specify `--include "*"`. To list all   annexed files whose content is not present, specify `--not --in=here` @@ -632,7 +650,7 @@   `--since`, `--after`, `--until`, `--before`, and `--max-count` can be specified.   They are passed through to git log. For example, `--since "1 month ago"` -  To generate output suitable for the gource visualisation program,+  To generate output suitable for the gource visualization program,   specify `--gource`.  * `info [directory ...]`@@ -643,7 +661,7 @@   To only show the data that can be gathered quickly, use `--fast`.    When a directory is specified, shows a differently formatted info-  display for that directory. In this mode, all of the file matching+  display for that directory. In this mode, all of the matching   options can be used to filter the files that will be included in   the information. @@ -652,6 +670,7 @@   Then run:          	git annex info --fast . --not --in here+ * `version`    Shows the version of git-annex, as well as repository version information.@@ -757,7 +776,7 @@    For example, the location a key's value is stored (in indirect mode)   can be looked up by running:-  +         	git annex examinekey --format='.git/annex/objects/${hashdirmixed}${key}/${key}'  * `fromkey key file`@@ -803,6 +822,8 @@    This runs git-annex's built-in test suite. +  There are several parameters, provided by Haskell's tasty test framework.+ * `xmppgit`    This command is used internally to perform git pulls over XMPP.@@ -817,13 +838,13 @@  * `--fast` -  Enables less expensive, but also less thorough versions of some commands.+  Enable less expensive, but also less thorough versions of some commands.   What is avoided depends on the command.  * `--auto` -  Enables automatic mode. Commands that get, drop, or move file contents-  will only do so when needed to help satisfy the setting of annex.numcopies,+  Enable automatic mode. Commands that get, drop, or move file contents+  will only do so when needed to help satisfy the setting of numcopies,   and preferred content configuration.  * `--all`@@ -839,6 +860,10 @@   Operate on all data that has been determined to be unused by   a previous run of `git-annex unused`. +* `--key=key`++  Operate on only the specified key.+ * `--quiet`    Avoid the default verbose display of what is done; only show errors@@ -852,8 +877,8 @@    Rather than the normal output, generate JSON. This is intended to be   parsed by programs that use git-annex. Each line of output is a JSON-  object. Note that json output is only usable with some git-annex commands,-  like info and find.+  object. Note that JSON output is only usable with some git-annex commands,+  like info, find, and whereis.  * `--debug` @@ -878,8 +903,8 @@  * `--numcopies=n` -  Overrides the `annex.numcopies` setting, forcing git-annex to ensure the-  specified number of copies exist. +  Overrides the numcopies setting, forcing git-annex to ensure the+  specified number of copies exist.    Note that setting numcopies to 0 is very unsafe. @@ -891,7 +916,7 @@   Note that git-annex may continue running a little past the specified   time limit, in order to finish processing a file. -  Also, note that if the time limit prevents git-annex from doing all it +  Also, note that if the time limit prevents git-annex from doing all it   was asked to, it will exit with a special code, 101.  * `--trust=repository`@@ -912,7 +937,7 @@    Be careful using this, especially if you or someone else might have recently   removed a file from Glacier. If you try to drop the only other copy of the-  file, and this switch is enabled, you could lose data!  +  file, and this switch is enabled, you could lose data!  * `--backend=name` @@ -937,9 +962,9 @@  * `-c name=value` -  Used to override git configuration settings. May be specified multiple times.+  Overrides git configuration settings. May be specified multiple times. -# FILE MATCHING OPTIONS+# MATCHING OPTIONS  These options can all be specified multiple times, and can be combined to limit which files git-annex acts on.@@ -959,6 +984,8 @@          	--exclude='*.mp3' --exclude='subdir/*' +  Note that this will not match anything when using --all or --unused.+ * `--include=glob`    Skips files not matching the glob pattern.  (Same as `--not --exclude`.)@@ -966,6 +993,8 @@          	--include='*.mp3' --or --include='*.ogg' +  Note that this will not skip anything when using --all or --unused.+ * `--in=repository`    Matches only files that git-annex believes have their contents present@@ -997,6 +1026,17 @@   copies, on remotes in the specified group. For example,   `--copies=archive:2` +* `--lackingcopies=number`++  Matches only files that git-annex believes need the specified number or +  more additional copies to be made in order to satisfy their numcopies+  settings.++* `--approxlackingcopies=number`++  Like lackingcopies, but does not look at .gitattributes annex.numcopies+  settings. This makes it significantly faster.+ * `--inbackend=name`    Matches only files whose content is stored using the specified key-value@@ -1020,35 +1060,39 @@    Matches files that the preferred content settings for the repository   make it want to get. Note that this will match even files that are-  already present, unless limited with eg, `--not --in .`+  already present, unless limited with e.g., `--not --in .`+  +  Note that this will not match anything when using --all or --unused.  * `--want-drop`    Matches files that the preferred content settings for the repository   make it want to drop. Note that this will match even files that have-  already been dropped, unless limited with eg, `--in .`+  already been dropped, unless limited with e.g., `--in .`+  +  Note that this will not match anything when using --all or --unused.  * `--not` -  Inverts the next file matching option. For example, to only act on+  Inverts the next matching option. For example, to only act on   files with less than 3 copies, use `--not --copies=3`  * `--and` -  Requires that both the previous and the next file matching option matches.+  Requires that both the previous and the next matching option matches.   The default.  * `--or` -  Requires that either the previous, or the next file matching option matches.+  Requires that either the previous, or the next matching option matches.  * `-(` -  Opens a group of file matching options.+  Opens a group of matching options.  * `-)` -  Closes a group of file matching options.+  Closes a group of matching options.  # PREFERRED CONTENT @@ -1058,7 +1102,7 @@ They are used by the `--auto` option, and by the git-annex assistant.  The preferred content settings are similar, but not identical to-the file matching options specified above, just without the dashes.+the matching options specified above, just without the dashes. For example:  	exclude=archive/* and (include=*.mp3 or smallerthan=1mb)@@ -1076,7 +1120,7 @@ The git-annex assistant daemon can be configured to run scheduled jobs. This is similar to cron and anacron (and you can use them if you prefer), but has the advantage of being integrated into git-annex, and so being able-to eg, fsck a repository on a removable drive when the drive gets+to e.g., fsck a repository on a removable drive when the drive gets connected.  The scheduled jobs can be configured using `git annex vicfg` or@@ -1104,12 +1148,6 @@    A unique UUID for this repository (automatically set). -* `annex.numcopies`--  Number of copies of files to keep across all repositories. (default: 1)--  Note that setting numcopies to 0 is very unsafe.- * `annex.backends`    Space-separated list of names of the key-value backends to use.@@ -1138,6 +1176,17 @@          	annex.largefiles = largerthan=100kb and not (include=*.c or include=*.h) +* `annex.numcopies`++  This is a deprecated setting. You should instead use the+  `git annex numcopies` command to configure how many copies of files+  are kept acros all repositories.++  This config setting is only looked at when `git annex numcopies` has+  never been configured.++  Note that setting numcopies to 0 is very unsafe.+ * `annex.queuesize`    git-annex builds a queue of git commands, in order to combine similar@@ -1158,7 +1207,7 @@ * `annex.bloomaccuracy`    Adjusts the accuracy of the bloom filter used by-  `git annex unused`. The default accuracy is 1000 -- +  `git annex unused`. The default accuracy is 1000 --   1 unused file out of 1000 will be missed by `git annex unused`. Increasing   the accuracy will make `git annex unused` consume more memory;   run `git annex info` for memory usage numbers.@@ -1183,6 +1232,19 @@   to close it. On Mac OSX, when not using direct mode this defaults to   1 second, to work around a bad interaction with software there. +* `annex.expireunused`++  Controls what the assistant does about unused file contents+  that are stored in the repository.+  +  The default is `false`, which causes+  all old and unused file contents to be retained, unless the assistant+  is able to move them to some other repository (such as a backup repository).++  Can be set to a time specification, like "7d" or "1m", and then+  file contents that have been known to be unused for a week or a+  month will be deleted.+ * `annex.fscknudge`    When set to false, prevents the webapp from reminding you when using@@ -1238,7 +1300,7 @@ * `remote.<name>.annex-cost-command`    If set, the command is run, and the number it outputs is used as the cost.-  This allows varying the cost based on eg, the current network. The+  This allows varying the cost based on e.g., the current network. The   cost-command can be any shell command line.  * `remote.<name>.annex-start-command`@@ -1297,11 +1359,16 @@   configured by the trust and untrust commands. The value can be any of   "trusted", "semitrusted" or "untrusted". -* `remote.<name>.availability`+* `remote.<name>.annex-availability`    Can be used to tell git-annex whether a remote is LocallyAvailable   or GloballyAvailable. Normally, git-annex determines this automatically. +* `remote.<name>.annex-bare`++  Can be used to tell git-annex if a remote is a bare repository+  or not. Normally, git-annex determines this automatically.+ * `remote.<name>.annex-ssh-options`    Options to use when using ssh to talk to this remote.@@ -1369,9 +1436,17 @@    In the command line, %url is replaced with the url to download,   and %file is replaced with the file that it should be saved to.-  Note that both these values will automatically be quoted, since-  the command is run in a shell. +* `annex.secure-erase-command`++  This can be set to a command that should be run whenever git-annex+  removes the content of a file from the repository.++  In the command line, %file is replaced with the file that should be+  erased.++  For example, to use the wipe command, set it to `wipe -f %file`+ * `remote.<name>.rsyncurl`    Used by rsync special remotes, this configures@@ -1423,7 +1498,7 @@    It is set to "true" if this is a gcrypt remote.   If the gcrypt remote is accessible over ssh and has git-annex-shell-  available to manage it, it's set to "shell"+  available to manage it, it's set to "shell".  * `remote.<name>.hooktype`, `remote.<name>.externaltype` @@ -1443,10 +1518,12 @@  The numcopies setting can also be configured on a per-file-type basis via the `annex.numcopies` attribute in `.gitattributes` files. This overrides-any value set using `annex.numcopies` in `.git/config`.-For example, this makes two copies be needed for wav files:+other numcopies settings.+For example, this makes two copies be needed for wav files and 3 copies+for flac files:  	*.wav annex.numcopies=2+	*.flac annex.numcopies=3  Note that setting numcopies to 0 is very unsafe. @@ -1466,11 +1543,11 @@  # SEE ALSO -Most of git-annex's documentation is available on its web site, +Most of git-annex's documentation is available on its web site, <http://git-annex.branchable.com/>  If git-annex is installed from a package, a copy of its documentation-should be included, in, for example, `/usr/share/doc/git-annex/`+should be included, in, for example, `/usr/share/doc/git-annex/`.  # AUTHOR @@ -1478,4 +1555,4 @@  <http://git-annex.branchable.com/> -Warning: Automatically converted into a man page by mdwn2man. Edit with care+Warning: Automatically converted into a man page by mdwn2man. Edit with care.
doc/install/fromscratch.mdwn view
@@ -25,9 +25,9 @@   * [extensible-exceptions](http://hackage.haskell.org/package/extensible-exceptions)   * [feed](http://hackage.haskell.org/package/feed)   * [async](http://hackage.haskell.org/package/async)-* Optional haskell stuff, used by the [[assistant]] and its webapp   * [stm](http://hackage.haskell.org/package/stm)     (version 2.3 or newer)+* Optional haskell stuff, used by the [[assistant]] and its webapp   * [hinotify](http://hackage.haskell.org/package/hinotify)     (Linux only)   * [dbus](http://hackage.haskell.org/package/dbus)
doc/internals.mdwn view
@@ -56,8 +56,11 @@ 	e605dca6-446a-11e0-8b2a-002170d25c55 laptop timestamp=1317929189.157237s 	26339d22-446b-11e0-9101-002170d25c55 usb disk timestamp=1317929330.769997s -If there are multiple lines for the same uuid, the one with the most recent-timestamp wins. git-annex union merges this and other files.+## `numcopies.log`++Records the global numcopies setting.++The file format is simply a timestamp followed by a number.  ## `remote.log`
− doc/news/version_5.20131130.mdwn 
@@ -1,4 +0,0 @@-git-annex 5.20131130 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * init: Fix a bug that caused git annex init, when run in a bare-     repository, to set core.bare=false."""]]
− doc/news/version_5.20131213.mdwn 
@@ -1,32 +0,0 @@-git-annex 5.20131213 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * Avoid using git commit in direct mode, since in some situations-     it will read the full contents of files in the tree.-   * assistant: Batch jobs are now run with ionice and nocache, when-     those commands are available.-   * assistant: Run transferkeys as batch jobs.-   * Automatically fix up bad bare repositories created by-     versions 5.20131118 through 5.20131127.-   * rsync special remote: Fix fallback mode for rsync remotes that-     use hashDirMixed. Closes: #[731142](http://bugs.debian.org/731142)-   * copy --from, get --from: When --force is used, ignore the-     location log and always try to get the file from the remote.-   * Deal with box.com changing the url of their webdav endpoint.-   * Android: Fix SRV record lookups for XMPP to use android getprop-     command to find DNS server, since there is no resolv.conf.-   * import: Add --skip-duplicates option.-   * lock: Require --force. Closes: #[731606](http://bugs.debian.org/731606)-   * import: better handling of overwriting an existing file/directory/broken-     link when importing-   * Windows: assistant and webapp work! (very experimental)-   * Windows: Support annex.diskreserve.-   * Fix bad behavior in Firefox, which was caused by an earlier fix to-     bad behavior in Chromium.-   * repair: Improve repair of git-annex index file.-   * repair: Remove damaged git-annex sync branches.-   * status: Ignore new files that are gitignored.-   * Fix direct mode's handling when modifications to non-annexed files-     are pulled from a remote. A bug prevented the files from being updated-     in the work tree, and this caused the modification to be reverted.-   * OSX: Remove ssh and ssh-keygen from dmg as they're included in OSX by-     default."""]]
− doc/news/version_5.20131221.mdwn 
@@ -1,21 +0,0 @@-git-annex 5.20131221 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * assistant: Fix OSX-specific bug that caused the startup scan to try to-     follow symlinks to other directories, and add their contents to the annex.-   * assistant: Set StrictHostKeyChecking yes when creating ssh remotes,-     and add it to the configuration for any ssh remotes previously created-     by the assistant. This avoids repeated prompts by ssh if the host key-     changes, instead syncing with such a remote will fail. Closes: #[732602](http://bugs.debian.org/732602)-   * Fix test suite to cover lock --force change.-   * Add plumbing-level lookupkey and examinekey commands.-   * find --format: Added hashdirlower, hashdirmixed, keyname, and mtime-     format variables.-   * assistant: Always batch changes found in startup scan.-   * An armel Linux standalone build is now available, which includes the-     webapp.-   * Programs from Linux and OSX standalone builds can now be symlinked-     into a directory in PATH as an alternative installation method, and will-     use readlink to find where the build was unpacked.-   * Include man pages in Linux and OSX standalone builds.-   * Linux standalone build now includes its own glibc and forces the linker to-     use it, to remove dependence on the host glibc."""]]
+ doc/news/version_5.20140116.mdwn view
@@ -0,0 +1,21 @@+git-annex 5.20140116 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * Added tahoe special remote.+   * external special remote protocol: Added GETGITDIR, and GETAVAILABILITY.+   * Refuse to build with git older than 1.7.1.1, which is needed for+     git checkout -B+   * map: Fix display of v5 direct mode repos.+   * repair: Support old git versions from before git fsck --no-dangling was+     implemented.+   * Fix a long-standing bug that could cause the wrong index file to be used+     when committing to the git-annex branch, if GIT\_INDEX\_FILE is set in the+     environment. This typically resulted in git-annex branch log files being+     committed to the master branch and later showing up in the work tree.+     (These log files can be safely removed.)+   * assistant: Detect if .git/annex/index is corrupt at startup, and+     recover.+   * repair: Fix bug in packed refs file exploding code that caused a .gitrefs+     directory to be created instead of .git/refs+   * Fix FTBFS on mipsel and sparc due to test suite not being available+     on those architectures.+   * Android: Avoid passing --clobber to busybox wget."""]]
+ doc/news/version_5.20140127.mdwn view
@@ -0,0 +1,41 @@+git-annex 5.20140127 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * sync --content: New option that makes the content of annexed files be+     transferred. Similar to the assistant, this honors any configured+     preferred content expressions.+   * Remove --json option from commands not supporting it.+   * status: Support --json.+   * list: Fix specifying of files to list.+   * Allow --all to be mixed with matching options like --copies and --in+     (but not --include and --exclude).+   * numcopies: New command, sets global numcopies value that is seen by all+     clones of a repository.+   * The annex.numcopies git config setting is deprecated. Once the numcopies+     command is used to set the global number of copies, any annex.numcopies+     git configs will be ignored.+   * assistant: Make the prefs page set the global numcopies.+   * Add lackingcopies, approxlackingcopies, and unused to+     preferred content expressions.+   * Client, transfer, incremental backup, and archive repositories+     now want to get content that does not yet have enough copies.+   * Client, transfer, and source repositories now do not want to retain+     unused file contents.+   * assistant: Checks daily for unused file contents, and when possible+     moves them to a repository (such as a backup repository) that+     wants to retain them.+   * assistant: annex.expireunused can be configured to cause unused+     file contents to be deleted after some period of time.+   * webapp: Nudge user to see if they want to expire old unused file+     contents when a lot of them seem to be piling up in the repository.+   * repair: Check git version at run time.+   * assistant: Run the periodic git gc in batch mode.+   * added annex.secure-erase-command config option.+   * Optimise non-bare http remotes; no longer does a 404 to the wrong+     url every time before trying the right url. Needs annex-bare to be+     set to false, which is done when initially probing the uuid of a+     http remote.+   * webapp: After upgrading a git repository to git-annex, fix+     bug that made it temporarily not be synced with.+   * whereis: Support --all.+   * All commands that support --all also support a --key option,+     which limits them to acting on a single key."""]]
doc/preferred_content.mdwn view
@@ -3,20 +3,22 @@ get` and `git annex drop` to move the content to the repositories you want to contain it. But sometimes, it can be good to have more fine-grained control over which repositories prefer to have which content. Configuring-this allows `git annex get --auto`, `git annex drop --auto`, etc to do-smarter things.+this allows the git-annex assistant as well as +`git annex get --auto`, `git annex drop --auto`, `git annex sync --content`,+etc to do smarter things.  Preferred content settings can be edited using `git annex vicfg`, or viewed and set at the command line with `git annex wanted`.-Each repository can have its own settings, and other repositories may also-try to honor those settings. So there's no local `.git/config` setting it.+Each repository can have its own settings, and other repositories will+try to honor those settings when interacting with it.+So there's no local `.git/config` for preferred content settings.  The idea is that you write an expression that files are matched against. If a file matches, it's preferred to have its content stored in the repository. If it doesn't, it's preferred to drop its content from the repository (if there are enough copies elsewhere). -The expressions are very similar to the file matching options documented+The expressions are very similar to the matching options documented on the [[git-annex]] man page. At the command line, you can use those options in commands like this: @@ -109,9 +111,9 @@ ### client  All content is preferred, unless it's for a file in a "archive" directory,-which has reached an archive repository.+which has reached an archive repository, or is unused. -`((exclude=*/archive/* and exclude=archive/*) or (not (copies=archive:1 or copies=smallarchive:1))) or (not copies=semitrusted+:1)`+`(((exclude=*/archive/* and exclude=archive/*) or (not (copies=archive:1 or copies=smallarchive:1))) and not unused) or roughlylackingcopies=1`  ### transfer @@ -138,27 +140,27 @@  All content is preferred. -`include=*`+`include=* or unused`  ### incremental backup  Only prefers content that's not already backed up to another backup or incremental backup repository. -`(include=* and (not copies=backup:1) and (not copies=incrementalbackup:1)) or (not copies=semitrusted+:1)`+`((include=* or unused) and (not copies=backup:1) and (not copies=incrementalbackup:1)) or approxlackingcopies=1`  ### small archive  Only prefers content that's located in an "archive" directory, and only if it's not already been archived somewhere else. -`((include=*/archive/* or include=archive/*) and not (copies=archive:1 or copies=smallarchive:1)) or (not copies=semitrusted+:1)`+`((include=*/archive/* or include=archive/*) and not (copies=archive:1 or copies=smallarchive:1)) or approxlackingcopies=1`  ### full archive  All content is preferred, unless it's already been archived somewhere else. -`(not (copies=archive:1 or copies=smallarchive:1)) or (not copies=semitrusted+:1)`+`(not (copies=archive:1 or copies=smallarchive:1)) or approxlackingcopies=1`  Note that if you want to archive multiple copies (not a bad idea!), you should instead configure all your archive repositories with a
+ doc/sync/comment_10_2cd8ab86f498d6f676f859b552f831eb._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawkI9AR8BqG4RPw_Ov2lnDCJWMuM6WMRobQ"+ nickname="Dav"+ subject="Sorry to just be getting back..."+ date="2014-01-26T22:51:28Z"+ content="""+The URLs in question in this case were read-only github https URLs. In any case, my problems are solved by what you've already suggested. I think a less error-sounding response to read-only https repos sounds nice!+"""]]
+ doc/tips/Shamir_secret_sharing_and_git-annex.mdwn view
@@ -0,0 +1,21 @@+Combining git-annex with [Shamir secret sharing](http://en.wikipedia.org/wiki/Shamir%27s_Secret_Sharing)+is an useful way to securely back up highly sensitive files,+such as a gpg key or bitcoin wallet.++Shamir secret sharing creates N shares of a file, of which any M can be+used to reconstitute the original file. Anyone who has less than M shares+cannot tell anything about the original file, other than its size.++Where git-annex comes in is as a way to manage these shares. They can be+added to the annex, and then git-annex used to move one share to each clone+of the repository. Since git-annex keeps track of where each file is+stored, this can aid later finding the shares again when they're needed, as+well as making ongoing management of the shares easier.++Note that this conveniece comes at a price: Any attacker who gets a copy+of the git repository can use it to figure out where the shares are+located. While this is not a crippling flaw, and can be worked around, it+needs to be considered when implementing this technique.++Here is an example of this method being used for a ~/.gnupg directory:+<http://git.kitenet.net/?p=gpg.git;a=blob;f=README.sss>
doc/tips/using_the_web_as_a_special_remote.mdwn view
@@ -34,7 +34,7 @@ 	  Could only verify the existence of 0 out of 1 necessary copies 	  Also these untrusted repositories may contain the file: 	  	00000000-0000-0000-0000-000000000001  -- web-	  (Use --force to override this check, or adjust annex.numcopies.)+	  (Use --force to override this check, or adjust numcopies.) 	failed  ## attaching urls to existing files
doc/todo/A_really_simple_way_to_pair_devices_like_bittorent_sync.mdwn view
@@ -5,3 +5,5 @@ It would be just great to have some means to sync files without cloud just the two device. Without the ssh / rsync jut share some secret and the devices do the rest. :-o  Anyway thanks for hearing. I'm looking forward to know more about git-annex. Thank you for that sw. =-<>-=++> [[design/assistant/telehash]] --[[Joey]]
+ doc/todo/Enhancement:_git_annex_whereis_KEY.mdwn view
@@ -0,0 +1,19 @@+### Please describe the problem.++Great work on git annex! One possible enhancement occured to me: It would be very useful though if the "whereis" command would support looking up the location of files by arbitrary keys. This way one could inspect the location of old content which is not currently checked-out in the tree.++In a related vein, the "unused" command could report old filenames or describe the associated commits. Tracking old versions is a great feature of your git-based approach, but currently, tasks such as pruning selected content seem unwiedly. Though I might be missing existing solutions. You can easily "cut-off" the history by forcing a drop of all unused content. It would be cool if one could somehow "address" old versions by filename and commit/date and selectively drop just these. The same could go for the "whereis" command, where one could e.g. query which remote holds content which was stored under some filename at some specific date.++Thanks Cheers!++> I agree that it's useful to run whereis on a specific key. This can+> now be done using `git annex whereis --key KEY`+> [[done]] --[[Joey]]+> +> To report old filenames, unused would have to search back through the+> contents of symlinks in old versions of the repo, to find symlinks that+> referred to a key. The best way I know how to do that is `git log -S$KEY`,+> which is what unused suggests you use. But this is slow --+> searching for a single key in one of my repos takes 25 seconds.+> That's why it doesn't do it for you.+>
+ doc/todo/Limit_file_revision_history.mdwn view
@@ -0,0 +1,117 @@+Hi, I am assuming to use git-annex-assistant for two usecases, but I would like to ask about the options or planed roadmap for dropped/removed files from the repository.++Usecases:++1. sync working directory between laptop, home computer, work komputer+2. archive functionality for my photograps++Both usecases have one common factor. Some files might become obsolate and+in long time frame nobody is interested to keep their revisions. Let's+assume photographs. Usuall workflow I take is to import all photograps to+filesystem, then assess (select) the good ones I want to keep and then+process them what ever way.++Problem with git-annex(-assistant) I have is that it start to revision all+of the files at the time they are added to directory. This is welcome at+first but might be an issue if you are used to put 80% of the size of your+imported files to trash.++I am aware of what git-annex is not. I have been reading documentation for+"git-annex drop" and "unused" options including forums. I do understand+that I am actually able to delete all revisions of the file if I will drop+it, remove it and if I will run git annex unused 1..###. (on all synced+repositories).++I actually miss the option to have above process automated/replicated to the other synced repositories.++I would formulate the 'use case' requirements for git-annex as:++* command to drop an file including revisions from all annex repositories?+  (for example like moving a file to /trash folder) that will schedulle+  it's deletition)+* option to keep like max. 10 last revisions of the file?+* option to keep only previous revisions if younger than 6 months from now?++Finally, how to specify a feature request for git-annex?++> By moving it here ;-) --[[Joey]] ++> So, let's spec out a design.+> +> * Add preferred content terminal to configure whether a repository wants+>   to hang on to unused content. Simply `unused`.+>   (It cannot include a timestamp, because there's+>   no way repos can agree on about when a key became unused.) **done**+> * In order to quickly match that terminal, the Annex monad will need+>   to keep a Set of unused Keys. This should only be loaded on demand.+>   **done**  +>   NB: There is some potential for a great many unused Keys to cause+>   memory usage to balloon.+> * Client repositories will end their preferred content with+>   `and (not unused)`. Transfer repositories too, because typically+>   only client repos connect to them, and so otherwise unused files+>   would build up there. Backup repos would want unused files. I+>   think that archive repos would too. **done**+> * Make the assistant check for unused files periodically. Exactly+>   how often may need to be tuned, but once per day seems reasonable+>   for most repos. Note that the assistant could also notice on the+>   fly when files are removed and mark their keys as unused if that was+>   the last associated file. (Only currently possible in direct mode.)+>   **done**+> * After scanning for unused files, it makes sense for the+>   assistant to queue transfers of unused files to any remotes that+>   do want them (eg, backup remotes). If the files can successfully be+>   sent to a remote, that will lead to them being dropped locally as+>   they're not wanted.+> * Add a git config setting like annex.expireunused=7d. This causes+>   *deletion* of unused files after the specified time period if they are+>   not able to be moved to a repo that wants them.+>   (The default should be annex.expireunused=false.)+> * How to detect how long a file has been unused? We can't look at the+>   time stamp of the object; we could use the mtime of the .map file,+>   that that's direct mode only and may be replaced with a database+>   later. Seems best to just keep a unused log file with timestamps.+>   **done**+> * After the assistant scans for unused files, if annex.expireunused+>   is not set, and there is some significant quantity of unused files+>   (eg, more than 1000, or more than 1 gb, or more than the amount of+>   remaining free disk space),+>   it can pop up a webapp alert asking to configure it. **done**+> * Webapp interface to configure annex.expireunused. Reasonable values+>   are no expiring, or any number of days. **done**+> +> [[done]] This does not cover every use case that was requested.+> But I don't see a cheap way to ensure it keeps eg the past 10 versions of+> a file. I guess that if you care about that, you leave+> annex.expireunused=false, and set up a backup repository where the unused+> files will be moved to.+> +> Note that since the assistant uses direct mode by default, old versions+> of modififed files are not guaranteed to be retained. But they very well+> might be. For example, if a file is replicated to 2 clients, and one+> client directly edits it, or deletes it, it loses the old version,+> but the other client will still be storing that old version.+> +> ## Stability analysis for unused in preferred content expressions+> +> This is tricky, because two repos that are otherwise entirely+> in sync may have differing opinons about whether a key is unused,+> depending on when each last scanned for unused keys.+> +> So, this preferred content terminal is *not stable*.+> It may be possible to write preferred content expressions +> that constantly moved such keys around without reaching a steady state.+> +> Example:+> +> A and B are clients directly connected, and both also connected+> to BACKUP.+> +> A deletes F. B syncs with A, and runs unused check; decides F+> is unused. B sends F to BACKUP. B will then think A doesn't want F,+> and will drop F from A. Next time A runs a full transfer scan, it will+> *not* find F (because the file was deleted!). So it won't get F back from+> BACKUP.+> +> So, it looks like the fact that unused files are not going to be+> looked for on the full transfer scan seems to make this work out ok.
doc/todo/git_annex_get___60__file__62___should_verify_file_hash.mdwn view
@@ -30,3 +30,5 @@  # End of transcript or log. """]]++> [[duplicate|done]] of [[checksum_verification_on_transfer]] --[[Joey]]
doc/todo/http_git_annex_404_retry.mdwn view
@@ -14,3 +14,5 @@ directory hashing, but that's been discussed elsewhere.)  --[[Joey]]++[[done]]
+ doc/todo/preferred_content_numcopies_check.mdwn view
@@ -0,0 +1,86 @@+The assistant and git annex sync --content do not try to proactively+download content that is not otherwise wanted in order to get numcopies+satisfied. (Unlike get --auto, which does take numcopies into account.)++Should these automated systems try to proactively satisfy numcopies? I+don't feel they should. It could result in surprising results. For example,+a transfer repository, which is of limited size, could start being filled+up with lots of content that all clients have, just because numcopies was+set to a larger number than the total number of clients. Another example,+a source repository on eg an Android phone, should never have content in it+that was not created on that device.++However, it would make sense for some specific +types of repositories to proactively get content to satisfy numcopies. +Currently some types of repositories use "or (not copies=semitrusted+:1)",+to ensure that if the only copy of a file is on a dead repository, they+will try to get that file before the repo goes away. This is done+by client repositories, and backup, and archive. Probably the same set+would make sense to proactively satisfy numcopies.++So, a new type of preferred content expression is called for. Such as, for+example, "numcopiesneeded=1". Which indicates that at least 1 more copy +is needed to satifsy numcopies. ++(Note that it should only count semittrusted and higher trust+level repos as satisfying numcopies.)++But, preferred content expressions can only operate on info stored in the+git repo, or they will fail to be stable. Ie, repo A needs to be able to+calculate whether a file is preferred content by repo B and get the same+result as when repo B calculates that.++numcopies is currently configured in 3 places:++* .git/config `annex.numcopies` (global, stored only locally)+* .gitattributes `annex.numcopies` (per file, stored in git repo)+* --numcopies (not relevant)++So, need to add a global numcopies setting that is stored in the git repo.+That could either be a file in the git-annex branch, or just+`* annex.numcopies=2` in the toplevel .gitattributes. Note that the+assistant needs to be able to query and set it, which I think argues+against using .gitattributes for it. Also arguing against that is that the+.git/config numcopies valie applies even to objects with no file in the+work tree, which gitattributes settings do not.++Conclusion:++* Add to the git-annex branch a numcopies file that holds the global+  numcopies default if present. **done**+* Modify the assistant to use it when configuring numcopies. **done**+* To deprecate .git/config's annex.numcopies, only make it take effect+  when there is no numcopies file in the git-annex branch. **done**+* Add "numcopiesneeded=N" preferred content expression using the git-annex+  branch numcopies setting, overridden by any .gitattributes numcopies setting+  for a particular file. It should ignore the other ways to specify+  numcopies, particularly git config annex.numcopies. **done**+* Make the repo groups that currently end with "or (not copies=semitrusted+:1)"+  to instead end with "or numcopiesneeded=1" **done**+* See if "numcopiesneeded=N" can check .gitattributes without getting+  a lot slower. If now, perhaps add a "numcopiesneededaccurate=N" that+  checks it. **done**++[[done]] ++## Stability analysis++If a remote prefers eg, "blah or numcopiesneeded=1", and+file $foo does not match blah, but needs more copies, then then the+expression will match.++So, git-annex will get $foo, adding a copy. Which means that the +numcopiesneeded=1 will no longer match, so the file is no longer wanted+now that it has been downloaded.++Now there are two cases for what can happen:++* git-annex tries to drop $foo, but fails because it cannot find enough+  other copies+* git-annex copies $foo to some other remote that wants it, and then+  manages to drop $foo from the local remote.++This seems ok. Files flow through repos and they act like transfer+repos when there are not enough copies.++--[[Joey]]
+ doc/todo/separate_rsync_bwlimit_options_for_upload_and_download.mdwn view
@@ -0,0 +1,2 @@+The bandwidth for upload and download are often different.  It would be useful to have different settings for upload and download limits.+As it is, I have to keep changing annex-rsync-options options between uploads and downloads.
doc/todo/wishlist:_git_annex_put_--_same_as_get__44___but_for_defaults.mdwn view
@@ -15,3 +15,6 @@     mr push  to do the right thing all by itself.++> I feel that the new `git annex sync --content` is pretty close to what's+> requested here. [[done]] --[[Joey]]
doc/walkthrough/fsck:_verifying_your_data.mdwn view
@@ -2,7 +2,7 @@ can be checked depends on the key-value [[backend|backends]] you've used for the data. For example, when you use the SHA1 backend, fsck will verify that the checksums of your files are good. Fsck also checks that the-annex.numcopies setting is satisfied for all files.+[[numcopies|copies]] setting is satisfied for all files.  	# git annex fsck 	fsck some_file (checksum...) ok
doc/walkthrough/removing_files:_When_things_go_wrong.mdwn view
@@ -10,12 +10,12 @@ 	  Try making some of these repositories available: 	   	58d84e8a-d9ae-11df-a1aa-ab9aa8c00826  -- portable USB drive 	   	ca20064c-dbb5-11df-b2fe-002170d25c55  -- backup SATA drive-	  (Use --force to override this check, or adjust annex.numcopies.)+	  (Use --force to override this check, or adjust numcopies.) 	failed 	drop other.iso (unsafe) 	  Could only verify the existence of 0 out of 1 necessary copies           No other repository is known to contain the file.-	  (Use --force to override this check, or adjust annex.numcopies.)+	  (Use --force to override this check, or adjust numcopies.) 	failed  Here you might --force it to drop `important_file` if you [[trust]] your backup.
git-annex.1 view
@@ -21,7 +21,7 @@ .PP When a file is annexed, its content is moved into a key\-value store, and a symlink is made that points to the content. These symlinks are checked into-git and versioned like regular files. You can move them around, delete +git and versioned like regular files. You can move them around, delete them, and so on. Pushing to another git repository will make git\-annex there aware of the annexed file, and it can be used to retrieve its content from the key\-value store.@@ -50,7 +50,7 @@  move iso/Debian_5.0.iso (moving to usbdrive...) ok .PP .SH COMMONLY USED COMMANDS-Like many git commands, git\-annex can be passed a path that +Like many git commands, git\-annex can be passed a path that is either a file or a directory. In the latter case it acts on all relevant files in the directory. When no path is specified, most git\-annex commands default to acting on all relevant files in the current directory (and@@ -71,7 +71,7 @@ but you can override this using the \fB\-\-from\fP option. .IP .IP "\fBdrop [path ...]\fP"-Drops the content of annexed files from this repository. +Drops the content of annexed files from this repository. .IP git\-annex will refuse to drop content if it cannot verify it is safe to do so. This can be overridden with the \fB\-\-force\fP switch.@@ -101,12 +101,12 @@ .IP "\fBstatus [path ...]\fP" Similar to \fBgit status \-\-short\fP, displays the status of the files in the working tree. Shows files that are not checked into git, files that-have been deleted, and files that have been modified. -Particulary useful in direct mode.+have been deleted, and files that have been modified.+Particularly useful in direct mode. .IP .IP "\fBunlock [path ...]\fP" Normally, the content of annexed files is protected from being changed.-Unlocking a annexed file allows it to be modified. This replaces the+Unlocking an annexed file allows it to be modified. This replaces the symlink for each specified file with a copy of the file's content. You can then modify it and \fBgit annex add\fP (or \fBgit commit\fP) to inject it back into the annex.@@ -125,25 +125,29 @@ the default is to sync with all remotes. Or specify \fB\-\-fast\fP to sync with the remotes with the lowest annex\-cost value. .IP-The sync process involves first committing all local changes+The sync process involves first committing all local changes, then fetching and merging the \fBsynced/master\fP and the \fBgit\-annex\fP branch-from the remote repositories and finally pushing the changes back to+from the remote repositories, and finally pushing the changes back to those branches on the remote repositories. You can use standard git commands to do each of those steps by hand, or if you don't want to worry about the details, you can use sync. .IP-Merge conflicts are automatically resolved by sync. When two conflicting+Merge conflicts are automatically handled by sync. When two conflicting versions of a file have been committed, both will be added to the tree, under different filenames. For example, file "foo" would be replaced with "foo.somekey" and "foo.otherkey". .IP Note that syncing with a remote will not update the remote's working tree with changes made to the local repository. However, those changes-are pushed to the remote, so can be merged into its working tree+are pushed to the remote, so they can be merged into its working tree by running "git annex sync" on the remote. .IP-Note that sync does not transfer any file contents from or to the remote-repositories.+With the \fB\-\-content\fP option, the contents of annexed files in the work+tree will also be uploaded and downloaded from remotes. By default,+this tries to get each annexed file that the local repository does not+yet have, and then copies each file to every remote that it is syncing with.+This behavior can be overridden by configuring the preferred content of+a repository. See see PREFERRED CONTENT below. .IP .IP "\fBmerge\fP" This performs the same merging that is done by the sync command, but@@ -195,14 +199,14 @@ addurl can be used both to add new files, or to add urls to existing files. .IP When quvi is installed, urls are automatically tested to see if they-are on a video hosting site, and the video is downloaded instead.+point to a video hosting site, and the video is downloaded instead. .IP .IP "\fBrmurl file url\fP" Record that the file is no longer available at the url. .IP .IP "\fBimport [path ...]\fP" Moves files from somewhere outside the git working copy, and adds them to-the annex. Individual files to import can be specified. +the annex. Individual files to import can be specified. If a directory is specified, the entire directory is imported. .IP  git annex import /media/camera/DCIM/*@@ -264,14 +268,14 @@ files that it does not match will instead be added with \fBgit add\fP. .IP To not daemonize, run with \fB\-\-foreground\fP ; to stop a running daemon,-run with \fB\-\-stop\fP+run with \fB\-\-stop\fP. .IP .IP "\fBassistant\fP" Like watch, but also automatically syncs changes to other remotes. Typically started at boot, or when you log in. .IP With the \fB\-\-autostart\fP option, the assistant is started in any repositories-it has created. These are listed in \fB~/.config/git\-annex/autostart\fP+it has created. These are listed in \fB~/.config/git\-annex/autostart\fP. .IP .IP "\fBwebapp\fP" Opens a web app, that allows easy setup of a git\-annex repository,@@ -295,7 +299,7 @@ .IP It's useful, but not mandatory, to initialize each new clone of a repository with its own description. If you don't provide one,-one will be generated.+one will be generated using the username, hostname and the path. .IP .IP "\fBdescribe repository description\fP" Changes the description of a repository.@@ -305,7 +309,7 @@ "here". .IP .IP "\fBinitremote name [param=value ...]\fP"-Creates a new special remote, and adds it to \fB.git/config\fP. +Creates a new special remote, and adds it to \fB.git/config\fP. .IP The remote's configuration is specified by the parameters. Different types of special remotes need different configuration values. The@@ -314,7 +318,7 @@ All special remotes support encryption. You can either specify \fBencryption=none\fP to disable encryption, or specify \fBencryption=hybrid keyid=$keyid ...\fP to specify a GPG key id (or an email-address associated with a key.)+address associated with a key). .IP There are actually three schemes that can be used for management of the encryption keys. When using the encryption=hybrid scheme, additional@@ -341,7 +345,7 @@ which may be a different repository than the one in which it was originally created with the initremote command. .IP-The name of the remote is the same name used when originally +The name of the remote is the same name used when originally creating that remote with "initremote". Run "git annex enableremote" with no parameters to get a list of special remote names. .IP@@ -354,7 +358,7 @@ the as the encryption scheme cannot be changed once a special remote has been created.) .IP-The GPG keys that an encrypted special remote is encrypted to can be+The GPG keys that an encrypted special remote is encrypted with can be changed using the keyid+= and keyid\-= parameters. These respectively add and remove keys from the list. However, note that removing a key does NOT necessarily prevent the key's owner from accessing data@@ -372,6 +376,19 @@ keyid+= and keyid\-= with such remotes should be used with care, and make little sense except in cases like the revoked key example above. .IP+.IP "\fBnumcopies [N]\fP"+Tells git\-annex how many copies it should preserve of files, over all+repositories. The default is 1.+.IP+Run without a number to get the current value.+.IP+When git\-annex is asked to drop a file, it first verifies that the+required number of copies can be satisfied amoung all the other+repositories that have a copy of the file.+.IP+This can be overridden on a per\-file basis by the annex.numcopies setting+in .gitattributes files.+.IP .IP "\fBtrust [repository ...]\fP" Records that a repository is trusted to not unexpectedly lose content. Use with care.@@ -386,7 +403,7 @@ Returns a repository to the default semi trusted state. .IP .IP "\fBdead [repository ...]\fP"-Indicates that the repository has been irretrevably lost.+Indicates that the repository has been irretrievably lost. (To undo, use semitrust.) .IP .IP "\fBgroup repository groupname\fP"@@ -554,7 +571,7 @@ finds files in the current directory and its subdirectories. .IP By default, only lists annexed files whose content is currently present.-This can be changed by specifying file matching options. To list all+This can be changed by specifying matching options. To list all annexed files, present or not, specify \fB\-\-include "*"\fP. To list all annexed files whose content is not present, specify \fB\-\-not \-\-in=here\fP .IP@@ -582,7 +599,7 @@ \fB\-\-since\fP, \fB\-\-after\fP, \fB\-\-until\fP, \fB\-\-before\fP, and \fB\-\-max\-count\fP can be specified. They are passed through to git log. For example, \fB\-\-since "1 month ago"\fP .IP-To generate output suitable for the gource visualisation program,+To generate output suitable for the gource visualization program, specify \fB\-\-gource\fP. .IP .IP "\fBinfo [directory ...]\fP"@@ -592,7 +609,7 @@ To only show the data that can be gathered quickly, use \fB\-\-fast\fP. .IP When a directory is specified, shows a differently formatted info-display for that directory. In this mode, all of the file matching+display for that directory. In this mode, all of the matching options can be used to filter the files that will be included in the information. .IP@@ -601,8 +618,8 @@ Then run: .IP  git annex info \-\-fast . \-\-not \-\-in here-.IP "\fBversion\fP" .IP+.IP "\fBversion\fP" Shows the version of git\-annex, as well as repository version information. .IP .IP "\fBmap\fP"@@ -738,6 +755,8 @@ .IP "\fBtest\fP" This runs git\-annex's built\-in test suite. .IP+There are several parameters, provided by Haskell's tasty test framework.+.IP .IP "\fBxmppgit\fP" This command is used internally to perform git pulls over XMPP. .IP@@ -749,12 +768,12 @@ Use with care. .IP .IP "\fB\-\-fast\fP"-Enables less expensive, but also less thorough versions of some commands.+Enable less expensive, but also less thorough versions of some commands. What is avoided depends on the command. .IP .IP "\fB\-\-auto\fP"-Enables automatic mode. Commands that get, drop, or move file contents-will only do so when needed to help satisfy the setting of annex.numcopies,+Enable automatic mode. Commands that get, drop, or move file contents+will only do so when needed to help satisfy the setting of numcopies, and preferred content configuration. .IP .IP "\fB\-\-all\fP"@@ -768,6 +787,9 @@ Operate on all data that has been determined to be unused by a previous run of \fBgit\-annex unused\fP. .IP+.IP "\fB\-\-key=key\fP"+Operate on only the specified key.+.IP .IP "\fB\-\-quiet\fP" Avoid the default verbose display of what is done; only show errors and progress displays.@@ -778,8 +800,8 @@ .IP "\fB\-\-json\fP" Rather than the normal output, generate JSON. This is intended to be parsed by programs that use git\-annex. Each line of output is a JSON-object. Note that json output is only usable with some git\-annex commands,-like info and find.+object. Note that JSON output is only usable with some git\-annex commands,+like info, find, and whereis. .IP .IP "\fB\-\-debug\fP" Show debug messages.@@ -799,8 +821,8 @@ It should be specified using the name of a configured remote. .IP .IP "\fB\-\-numcopies=n\fP"-Overrides the \fBannex.numcopies\fP setting, forcing git\-annex to ensure the-specified number of copies exist. +Overrides the numcopies setting, forcing git\-annex to ensure the+specified number of copies exist. .IP Note that setting numcopies to 0 is very unsafe. .IP@@ -811,7 +833,7 @@ Note that git\-annex may continue running a little past the specified time limit, in order to finish processing a file. .IP-Also, note that if the time limit prevents git\-annex from doing all it +Also, note that if the time limit prevents git\-annex from doing all it was asked to, it will exit with a special code, 101. .IP .IP "\fB\-\-trust=repository\fP"@@ -830,7 +852,7 @@ .IP Be careful using this, especially if you or someone else might have recently removed a file from Glacier. If you try to drop the only other copy of the-file, and this switch is enabled, you could lose data!  +file, and this switch is enabled, you could lose data! .IP .IP "\fB\-\-backend=name\fP" Specifies which key\-value backend to use. This can be used when@@ -851,9 +873,9 @@ Overrides the User\-Agent to use when downloading files from the web. .IP .IP "\fB\-c name=value\fP"-Used to override git configuration settings. May be specified multiple times.+Overrides git configuration settings. May be specified multiple times. .IP-.SH FILE MATCHING OPTIONS+.SH MATCHING OPTIONS These options can all be specified multiple times, and can be combined to limit which files git\-annex acts on. .PP@@ -871,12 +893,16 @@ .IP  \-\-exclude='*.mp3' \-\-exclude='subdir/*' .IP+Note that this will not match anything when using \-\-all or \-\-unused.+.IP .IP "\fB\-\-include=glob\fP" Skips files not matching the glob pattern.  (Same as \fB\-\-not \-\-exclude\fP.) For example, to include only mp3 and ogg files: .IP  \-\-include='*.mp3' \-\-or \-\-include='*.ogg' .IP+Note that this will not skip anything when using \-\-all or \-\-unused.+.IP .IP "\fB\-\-in=repository\fP" Matches only files that git\-annex believes have their contents present in a repository. Note that it does not check the repository to verify@@ -904,6 +930,15 @@ copies, on remotes in the specified group. For example, \fB\-\-copies=archive:2\fP .IP+.IP "\fB\-\-lackingcopies=number\fP"+Matches only files that git\-annex believes need the specified number or +more additional copies to be made in order to satisfy their numcopies+settings.+.IP+.IP "\fB\-\-approxlackingcopies=number\fP"+Like lackingcopies, but does not look at .gitattributes annex.numcopies+settings. This makes it significantly faster.+.IP .IP "\fB\-\-inbackend=name\fP" Matches only files whose content is stored using the specified key\-value backend.@@ -923,29 +958,33 @@ .IP "\fB\-\-want\-get\fP" Matches files that the preferred content settings for the repository make it want to get. Note that this will match even files that are-already present, unless limited with eg, \fB\-\-not \-\-in .\fP+already present, unless limited with e.g., \fB\-\-not \-\-in .\fP .IP+Note that this will not match anything when using \-\-all or \-\-unused.+.IP .IP "\fB\-\-want\-drop\fP" Matches files that the preferred content settings for the repository make it want to drop. Note that this will match even files that have-already been dropped, unless limited with eg, \fB\-\-in .\fP+already been dropped, unless limited with e.g., \fB\-\-in .\fP .IP+Note that this will not match anything when using \-\-all or \-\-unused.+.IP .IP "\fB\-\-not\fP"-Inverts the next file matching option. For example, to only act on+Inverts the next matching option. For example, to only act on files with less than 3 copies, use \fB\-\-not \-\-copies=3\fP .IP .IP "\fB\-\-and\fP"-Requires that both the previous and the next file matching option matches.+Requires that both the previous and the next matching option matches. The default. .IP .IP "\fB\-\-or\fP"-Requires that either the previous, or the next file matching option matches.+Requires that either the previous, or the next matching option matches. .IP .IP "\fB\-(\fP"-Opens a group of file matching options.+Opens a group of matching options. .IP .IP "\fB\-)\fP"-Closes a group of file matching options.+Closes a group of matching options. .IP .SH PREFERRED CONTENT Each repository has a preferred content setting, which specifies content@@ -954,7 +993,7 @@ They are used by the \fB\-\-auto\fP option, and by the git\-annex assistant. .PP The preferred content settings are similar, but not identical to-the file matching options specified above, just without the dashes.+the matching options specified above, just without the dashes. For example: .PP  exclude=archive/* and (include=*.mp3 or smallerthan=1mb)@@ -971,7 +1010,7 @@ The git\-annex assistant daemon can be configured to run scheduled jobs. This is similar to cron and anacron (and you can use them if you prefer), but has the advantage of being integrated into git\-annex, and so being able-to eg, fsck a repository on a removable drive when the drive gets+to e.g., fsck a repository on a removable drive when the drive gets connected. .PP The scheduled jobs can be configured using \fBgit annex vicfg\fP or@@ -997,11 +1036,6 @@ .IP "\fBannex.uuid\fP" A unique UUID for this repository (automatically set). .IP-.IP "\fBannex.numcopies\fP"-Number of copies of files to keep across all repositories. (default: 1)-.IP-Note that setting numcopies to 0 is very unsafe.-.IP .IP "\fBannex.backends\fP" Space\-separated list of names of the key\-value backends to use. The first listed is used to store new files by default.@@ -1027,6 +1061,16 @@ .IP  annex.largefiles = largerthan=100kb and not (include=*.c or include=*.h) .IP+.IP "\fBannex.numcopies\fP"+This is a deprecated setting. You should instead use the+\fBgit annex numcopies\fP command to configure how many copies of files+are kept acros all repositories.+.IP+This config setting is only looked at when \fBgit annex numcopies\fP has+never been configured.+.IP+Note that setting numcopies to 0 is very unsafe.+.IP .IP "\fBannex.queuesize\fP" git\-annex builds a queue of git commands, in order to combine similar commands for speed. By default the size of the queue is limited to@@ -1044,7 +1088,7 @@ .IP .IP "\fBannex.bloomaccuracy\fP" Adjusts the accuracy of the bloom filter used by-\fBgit annex unused\fP. The default accuracy is 1000 \-\- +\fBgit annex unused\fP. The default accuracy is 1000 \-\- 1 unused file out of 1000 will be missed by \fBgit annex unused\fP. Increasing the accuracy will make \fBgit annex unused\fP consume more memory; run \fBgit annex info\fP for memory usage numbers.@@ -1066,6 +1110,18 @@ to close it. On Mac OSX, when not using direct mode this defaults to 1 second, to work around a bad interaction with software there. .IP+.IP "\fBannex.expireunused\fP"+Controls what the assistant does about unused file contents+that are stored in the repository.+.IP+The default is \fBfalse\fP, which causes+all old and unused file contents to be retained, unless the assistant+is able to move them to some other repository (such as a backup repository).+.IP+Can be set to a time specification, like "7d" or "1m", and then+file contents that have been known to be unused for a week or a+month will be deleted.+.IP .IP "\fBannex.fscknudge\fP" When set to false, prevents the webapp from reminding you when using repositories that lack consistency checks.@@ -1112,7 +1168,7 @@ .IP .IP "\fBremote.<name>.annex\-cost\-command\fP" If set, the command is run, and the number it outputs is used as the cost.-This allows varying the cost based on eg, the current network. The+This allows varying the cost based on e.g., the current network. The cost\-command can be any shell command line. .IP .IP "\fBremote.<name>.annex\-start\-command\fP"@@ -1163,10 +1219,14 @@ configured by the trust and untrust commands. The value can be any of "trusted", "semitrusted" or "untrusted". .IP-.IP "\fBremote.<name>.availability\fP"+.IP "\fBremote.<name>.annex\-availability\fP" Can be used to tell git\-annex whether a remote is LocallyAvailable or GloballyAvailable. Normally, git\-annex determines this automatically. .IP+.IP "\fBremote.<name>.annex\-bare\fP"+Can be used to tell git\-annex if a remote is a bare repository+or not. Normally, git\-annex determines this automatically.+.IP .IP "\fBremote.<name>.annex\-ssh\-options\fP" Options to use when using ssh to talk to this remote. .IP@@ -1224,9 +1284,16 @@ .IP In the command line, %url is replaced with the url to download, and %file is replaced with the file that it should be saved to.-Note that both these values will automatically be quoted, since-the command is run in a shell. .IP+.IP "\fBannex.secure\-erase\-command\fP"+This can be set to a command that should be run whenever git\-annex+removes the content of a file from the repository.+.IP+In the command line, %file is replaced with the file that should be+erased.+.IP+For example, to use the wipe command, set it to \fBwipe \-f %file\fP+.IP .IP "\fBremote.<name>.rsyncurl\fP" Used by rsync special remotes, this configures the location of the rsync repository to use. Normally this is automatically@@ -1269,7 +1336,7 @@ .IP It is set to "true" if this is a gcrypt remote. If the gcrypt remote is accessible over ssh and has git\-annex\-shell-available to manage it, it's set to "shell"+available to manage it, it's set to "shell". .IP .IP "\fBremote.<name>.hooktype\fP, \fBremote.<name>.externaltype\fP" Used by hook special remotes and external special remotes to record@@ -1287,10 +1354,12 @@ .PP The numcopies setting can also be configured on a per\-file\-type basis via the \fBannex.numcopies\fP attribute in \fB.gitattributes\fP files. This overrides-any value set using \fBannex.numcopies\fP in \fB.git/config\fP.-For example, this makes two copies be needed for wav files:+other numcopies settings.+For example, this makes two copies be needed for wav files and 3 copies+for flac files: .PP  *.wav annex.numcopies=2+ *.flac annex.numcopies=3 .PP Note that setting numcopies to 0 is very unsafe. .PP@@ -1308,11 +1377,11 @@ to start the git\-annex assistant in. .PP .SH SEE ALSO-Most of git\-annex's documentation is available on its web site, +Most of git\-annex's documentation is available on its web site, <http://git\-annex.branchable.com/> .PP If git\-annex is installed from a package, a copy of its documentation-should be included, in, for example, \fB/usr/share/doc/git\-annex/\fP+should be included, in, for example, \fB/usr/share/doc/git\-annex/\fP. .PP .SH AUTHOR Joey Hess <joey@kitenet.net>
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20140116+Version: 5.20140127 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -93,7 +93,7 @@    extensible-exceptions, dataenc, SHA, process, json,    base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers,    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,-   SafeSemaphore, uuid, random, dlist, unix-compat, async+   SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3)   CC-Options: -Wall   GHC-Options: -Wall   Extensions: PackageImports@@ -114,7 +114,8 @@     CPP-Options: -DWITH_CLIBS    if flag(TestSuite)-    Build-Depends: tasty, tasty-hunit, tasty-quickcheck+    Build-Depends: tasty (>= 0.7), tasty-hunit, tasty-quickcheck,+     optparse-applicative     CPP-Options: -DWITH_TESTSUITE    if flag(TDFA)@@ -134,7 +135,6 @@     CPP-Options: -DWITH_WEBDAV    if flag(Assistant) && ! os(solaris)-    Build-Depends: stm (>= 2.3)     CPP-Options: -DWITH_ASSISTANT    if flag(Assistant)
git-annex.hs view
@@ -10,8 +10,8 @@ import System.Environment import System.FilePath -import qualified GitAnnex-import qualified GitAnnexShell+import qualified CmdLine.GitAnnex+import qualified CmdLine.GitAnnexShell #ifdef WITH_TESTSUITE import qualified Test #endif@@ -20,15 +20,15 @@ main = run =<< getProgName   where 	run n-		| isshell n = go GitAnnexShell.run-		| otherwise = go GitAnnex.run+		| isshell n = go CmdLine.GitAnnexShell.run+		| otherwise = go CmdLine.GitAnnex.run 	isshell n = takeFileName n == "git-annex-shell" 	go a = do 		ps <- getArgs #ifdef WITH_TESTSUITE-		if ps == ["test"]-			then Test.main-			else a ps+		case ps of+			("test":ps') -> Test.main ps'+			_ -> a ps #else 		a ps #endif
templates/configurators/main.hamlet view
@@ -15,24 +15,28 @@         to retain of each file, and how much disk space it can use.   <div .row-fluid>     <div .span4>-      $if xmppconfigured-        <h3>-          <a href="@{XMPPConfigR}">-            Re-configure jabber account-        <p>-         Your jabber account is set up, and will be used to keep #-         in touch with remote devices, and with your friends.-      $else-        <h3>-          <a href="@{XMPPConfigR}">-            Configure jabber account-       <p>-         Keep in touch with remote devices, and with your friends, #-         by configuring a jabber account.-    <div .span4>       <h3>         <a href="@{ConfigFsckR}">-          Configure consistency checks+          Consistency checks       <p>         Set up periodic checks of your data to detect and recover from #         disk problems.+    <div .span4>+      <h3>+        <a href="@{ConfigUnusedR}">+          Unused files+      <p>+        Configure what to do with old and deleted files.+  <div .row-fluid>+    <div .span4>+      <h3>+        <a href="@{XMPPConfigR}">+          Jabber account+      $if xmppconfigured+        <p>+          Your jabber account is set up, and will be used to keep #+          in touch with remote devices, and with your friends.+      $else+        <p>+          Keep in touch with remote devices, and with your friends, #+          by configuring a jabber account.
+ templates/configurators/unused.hamlet view
@@ -0,0 +1,38 @@+<div .span9 .hero-unit>+  <h2>+    Managing unused files+  <p>+    $maybe desc <- munuseddesc+      Some old versions of files and deleted files have been preserved #+      inside this repository.+      <div .alert .alert-info>+        <i .icon-info-sign></i> #{renderTense Past desc} #+        $maybe lastchecked <- mlastchecked+          (last checked #{fromDuration lastchecked} ago)+    $nothing+      Old versions of files and deleted files can be preserved inside #+      this repository.+  <p>+    This might be useful, if you ever need to access those old or deleted #+    files. But they'll also use up disk space. There are three ways to deal #+    with this.+  <ol>+    <li>+      <p>+        Set up a backup or archive repository, on a removable drive #+        or in the cloud, and the unused files will be moved to it, freeing #+        up space.+        <br>+        <a .btn href="@{AddRepositoryR}">+          <i .icon-plus></i> Add a new repository+    <li>+      <p>+        Or, you can let unused files expire after a period of time.+        <form method="post" .form-inline enctype=#{enctype}>+          ^{form}+    <li>+      <p>+        Finally, you can clean up all unused files manually at any time.+        <br>+        <a .btn href="@{CleanupUnusedR}">+          <i .icon-trash></i> Clean up unused files now
+ templates/configurators/unused/form.hamlet view
@@ -0,0 +1,6 @@+#{msg}+<p>+  <div .input-prepend .input-append>+    ^{fvInput enableView} after ^{fvInput whenView} days.&nbsp;+    <button type=submit .btn>+      Save Changes