Merge branch 'master' of git://git-annex.branchable.com

Annex.hs

@@ -94,7 +94,7 @@ data AnnexState = AnnexState
 	, checkattrhandle :: Maybe CheckAttrHandle
 	, checkignorehandle :: Maybe (Maybe CheckIgnoreHandle)
 	, forcebackend :: Maybe String
-	, forcenumcopies :: Maybe Int
+	, globalnumcopies :: Maybe Int
 	, limit :: Matcher (MatchInfo -> Annex Bool)
 	, uuidmap :: Maybe UUIDMap
 	, preferredcontentmap :: Maybe PreferredContentMap
@@ -109,6 +109,7 @@ data AnnexState = AnnexState
 	, cleanup :: M.Map String (Annex ())
 	, inodeschanged :: Maybe Bool
 	, useragent :: Maybe String
+	, errcounter :: Integer
 	}
 
 newState :: GitConfig -> Git.Repo -> AnnexState
@@ -128,7 +129,7 @@ newState c r = AnnexState
 	, checkattrhandle = Nothing
 	, checkignorehandle = Nothing
 	, forcebackend = Nothing
-	, forcenumcopies = Nothing
+	, globalnumcopies = Nothing
 	, limit = Left []
 	, uuidmap = Nothing
 	, preferredcontentmap = Nothing
@@ -143,6 +144,7 @@ newState c r = AnnexState
 	, cleanup = M.empty
 	, inodeschanged = Nothing
 	, useragent = Nothing
+	, errcounter = 0
 	}
 
 {- Makes an Annex state object for the specified git repo.

Annex/Branch/Transitions.hs

@@ -41,6 +41,7 @@ dropDead f content trustmap = case getLogVariety f of
 		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/Drop.hs

@@ -8,7 +8,6 @@
 module Annex.Drop where
 
 import Common.Annex
-import Logs.Location
 import Logs.Trust
 import Types.Remote (uuid)
 import qualified Remote
@@ -27,29 +26,24 @@ type Reason = String
 {- Drop a key from local and/or remote when allowed by the preferred content
  - and numcopies settings.
  -
- - The Remote list can include other remotes that do not have the content.
+ - The UUIDs are ones where the content is believed to be present.
- -
- - 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.
- -}
-handleDrops :: Reason -> [Remote] -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
-handleDrops _ _ _ _ Nothing _ = noop
-handleDrops reason rs fromhere key f knownpresentremote = do
-	locs <- loggedLocations key
-	handleDropsFrom locs rs 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.
  -
+ - 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 -> Annex ()
+handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> CommandActionRunner -> Annex ()
-handleDropsFrom _ _ _ _ _ Nothing _ = noop
+handleDropsFrom _ _ _ _ _ Nothing _ _ = noop
-handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
+handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runner = do
 	fs <- ifM isDirect
 		( do
 			l <- associatedFilesRelative key
@@ -92,7 +86,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
 
 	checkdrop fs n@(have, numcopies, _untrusted) u a =
 		ifM (allM (wantDrop True u . Just) fs)
-			( ifM (safely $ doCommand $ a (Just numcopies))
+			( ifM (safely $ runner $ a (Just numcopies))
 				( do
 					liftIO $ debugM "drop" $ unwords
 						[ "dropped"
@@ -113,6 +107,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
 	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
 		Command.Drop.startRemote (Just afile) numcopies key r
 
+	slocs = S.fromList locs
+	
 	safely a = either (const False) id <$> tryAnnex a
 
-	slocs = S.fromList locs

Annex/FileMatcher.hs

@@ -70,6 +70,7 @@ parseToken checkpresent checkpreferreddir groupmap t
 			[ ("include", limitInclude)
 			, ("exclude", limitExclude)
 			, ("copies", limitCopies)
+			, ("numcopiesneeded", limitNumCopiesNeeded)
 			, ("inbackend", limitInBackend)
 			, ("largerthan", limitSize (>))
 			, ("smallerthan", limitSize (<))

Assistant/Drop.hs

@@ -14,6 +14,7 @@ import Assistant.Common
 import Assistant.DaemonStatus
 import Annex.Drop (handleDropsFrom, Reason)
 import Logs.Location
+import RunCommand
 
 {- Drop from local and/or remote when allowed by the preferred content and
  - numcopies settings. -}
@@ -22,4 +23,4 @@ handleDrops _ _ _ Nothing _ = noop
 handleDrops reason fromhere key f knownpresentremote = do
 	syncrs <- syncDataRemotes <$> getDaemonStatus
 	locs <- liftAnnex $ loggedLocations key
-	liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f knownpresentremote
+	liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f knownpresentremote callCommand

Assistant/Threads/ConfigMonitor.hs

@@ -17,6 +17,7 @@ import Logs.UUID
 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 @@ configFilesActions =
 	, (remoteLog, void $ liftAnnex remoteListRefresh)
 	, (trustLog, void $ liftAnnex trustMapLoad)
 	, (groupLog, void $ liftAnnex groupMapLoad)
+	, (numcopiesLog, void $ liftAnnex numCopiesLoad)
 	, (scheduleLog, void updateScheduleLog)
 	-- Preferred content settings depend on most of the other configs,
 	-- so will be reloaded whenever any configs change.

Assistant/Threads/TransferScanner.hs

@@ -29,6 +29,7 @@ import qualified Git.LsFiles as LsFiles
 import qualified Backend
 import Annex.Content
 import Annex.Wanted
+import RunCommand
 
 import qualified Data.Set as S
 
@@ -158,7 +159,7 @@ expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do
 		present <- liftAnnex $ inAnnex key
 		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

Assistant/WebApp/Configurators/Preferences.hs

@@ -21,6 +21,7 @@ import Utility.DataUnits
 import Git.Config
 import Types.Distribution
 import qualified Build.SysConfig
+import Logs.NumCopies
 
 import qualified Data.Text as T
 
@@ -81,7 +82,7 @@ prefsAForm def = PrefsForm
 getPrefs :: Annex PrefsForm
 getPrefs = PrefsForm
 	<$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig)
-	<*> (annexNumCopies <$> Annex.getGitConfig)
+	<*> (maybe deprecatedNumCopies return =<< getGlobalNumCopies)
 	<*> inAutoStartFile
 	<*> (annexAutoUpgrade <$> Annex.getGitConfig)
 	<*> (annexDebug <$> Annex.getGitConfig)
@@ -89,7 +90,8 @@ getPrefs = PrefsForm
 storePrefs :: PrefsForm -> Annex ()
 storePrefs p = do
 	setConfig (annexConfig "diskreserve") (T.unpack $ diskReserve p)
-	setConfig (annexConfig "numcopies") (show $ numCopies p)
+	setGlobalNumCopies (numCopies p)
+	unsetConfig (annexConfig "numcopies") -- deprecated
 	setConfig (annexConfig "autoupgrade") (fromAutoUpgrade $ autoUpgrade p)
 	unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do
 		here <- fromRepo Git.repoPath

CmdLine.hs

@@ -23,7 +23,6 @@ import System.Posix.Signals
 
 import Common.Annex
 import qualified Annex
-import qualified Annex.Queue
 import qualified Git
 import qualified Git.AutoCorrect
 import Annex.Content
@@ -41,7 +40,7 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
 		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 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
 				sequence_ flags
 				whenM (annexDebug <$> Annex.getGitConfig) $
 					liftIO enableDebugOutput
-				prepCommand cmd params
+				startup
-		 	tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdnocommit cmd]
+				performCommand cmd params
+				shutdown $ cmdnocommit cmd
   where
 	err msg = msg ++ "\n\n" ++ usage header allcmds
 	cmd = Prelude.head cmds
@@ -92,44 +92,19 @@ getOptCmd argv cmd commonoptions = check $
 		, 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 :: Annex ()
-startup = liftIO $ do
+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

Command.hs

@@ -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,8 +16,6 @@ module Command (
 	next,
 	stop,
 	stopUnless,
-	prepCommand,
-	doCommand,
 	whenAnnexed,
 	ifAnnexed,
 	isBareRepo,
@@ -35,12 +35,14 @@ import Types.Option as ReExported
 import Seek as ReExported
 import Checks as ReExported
 import Usage as ReExported
+import RunCommand as ReExported
 import Logs.Trust
+import Logs.NumCopies
 import Config
 import Annex.CheckAttr
 
 {- 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 +76,6 @@ stop = return Nothing
 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)
@@ -106,8 +89,8 @@ isBareRepo = fromRepo Git.repoIsLocalBare
 
 numCopies :: FilePath  -> Annex (Maybe Int)
 numCopies file = do
-	forced <- Annex.getState Annex.forcenumcopies
+	global <- getGlobalNumCopies
-	case forced of
+	case global of
 		Just n -> return $ Just n
 		Nothing -> readish <$> checkAttr "annex.numcopies" file
 

Command/Add.hs

@@ -41,18 +41,18 @@ def = [notBareRepo $ command "add" paramPaths seek SectionCommon
 {- 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 :: CommandSeek
-seek =
+seek ps = do
-	[ go withFilesNotInGit
+	matcher <- largeFilesMatcher
-	, whenNotDirect $ go withFilesUnlocked
+	let go a = flip a ps $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)
-	, whenDirect $ go withFilesMaybeModified
+		( start file
-	]
+		, stop
-  where
+		)
-  	go a = withValue largeFilesMatcher $ \matcher ->
+	go withFilesNotInGit
-		a $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)
+	ifM isDirect
-			( start file
+		( go withFilesMaybeModified
-			, stop
+		, 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

@@ -18,8 +18,8 @@ def :: [Command]
 def = [notDirect $ command "addunused" (paramRepeating paramNumRange)
 	seek SectionMaintenance "add back unused files"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withUnusedMaps start]
+seek = withUnusedMaps start
 
 start :: UnusedMaps -> Int -> CommandStart
 start = startUnused "addunused" perform

Command/AddUrl.hs

@@ -47,11 +47,12 @@ pathdepthOption = Option.field [] "pathdepth" paramNumber "path components to us
 relaxedOption :: Option
 relaxedOption = Option.flag [] "relaxed" "skip size check"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withField fileOption return $ \f ->
+seek ps = do
-	withFlag relaxedOption $ \relaxed ->
+	f <- getOptionField fileOption return
-	withField pathdepthOption (return . maybe Nothing readish) $ \d ->
+	relaxed <- getOptionFlag relaxedOption
-	withStrings $ start relaxed f d]
+	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

@@ -37,12 +37,13 @@ autoStartOption = Option.flag [] "autostart" "start in known repositories"
 startDelayOption :: Option
 startDelayOption = Option.field [] "startdelay" paramNumber "delay before running startup scan"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFlag Command.Watch.stopOption $ \stopdaemon ->
+seek ps = do
-	withFlag Command.Watch.foregroundOption $ \foreground ->
+	stopdaemon <- getOptionFlag Command.Watch.stopOption
-	withFlag autoStartOption $ \autostart ->
+	foreground <- getOptionFlag Command.Watch.foregroundOption
-	withField startDelayOption (pure . maybe Nothing parseDuration) $ \startdelay -> 
+	autostart <- getOptionFlag autoStartOption
-	withNothing $ start foreground stopdaemon autostart startdelay]
+	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

@@ -16,8 +16,8 @@ def :: [Command]
 def = [command "commit" paramNothing seek
 	SectionPlumbing "commits any staged changes to the git-annex branch"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = next $ next $ do

Command/ConfigList.hs

@@ -17,8 +17,8 @@ def :: [Command]
 def = [noCommit $ command "configlist" paramNothing seek
 	SectionPlumbing "outputs relevant git configuration"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = do

Command/Copy.hs

@@ -18,13 +18,14 @@ def :: [Command]
 def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek
 	SectionCommon "copy content of files to/from another repository"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek =
+seek ps = do
-	[ withField toOption Remote.byNameWithUUID $ \to ->
+	to <- getOptionField toOption Remote.byNameWithUUID
-	  withField fromOption Remote.byNameWithUUID $ \from ->
+	from <- getOptionField fromOption Remote.byNameWithUUID
-	  withKeyOptions (Command.Move.startKey to from False) $
+	withKeyOptions
-	  withFilesInGit $ whenAnnexed $ start to from
+	 	(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

Command/Dead.hs

@@ -19,8 +19,8 @@ def :: [Command]
 def = [command "dead" (paramRepeating paramRemote) seek
 	SectionSetup "hide a lost repository"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start ws = do

Command/Describe.hs

@@ -16,8 +16,8 @@ def :: [Command]
 def = [command "describe" (paramPair paramRemote paramDesc) seek
 	SectionSetup "change description of a repository"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start (name:description) = do

Command/Direct.hs

@@ -23,8 +23,8 @@ def = [notBareRepo $ noDaemonRunning $
 	command "direct" paramNothing seek
 		SectionSetup "switch repository to direct mode"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = ifM isDirect ( stop , next perform )

Command/Drop.hs

@@ -27,9 +27,10 @@ def = [withOptions [fromOption] $ command "drop" paramPaths seek
 fromOption :: Option
 fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withField fromOption Remote.byNameWithUUID $ \from ->
+seek ps = do
-	withFilesInGit $ whenAnnexed $ start from]
+	from <- getOptionField fromOption Remote.byNameWithUUID
+	withFilesInGit (whenAnnexed $ start from) ps
 
 start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
 start from file (key, _) = checkDropAuto from file key $ \numcopies ->
@@ -138,7 +139,7 @@ notEnoughCopies key need have skip bad = do
 	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.

Command/DropKey.hs

@@ -18,8 +18,8 @@ def :: [Command]
 def = [noCommit $ command "dropkey" (paramRepeating paramKey) seek
 	SectionPlumbing "drops annexed content for specified keys"] 
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withKeys start]
+seek = withKeys start
 
 start :: Key -> CommandStart
 start key = stopUnless (inAnnex key) $ do

Command/DropUnused.hs

@@ -21,8 +21,8 @@ def = [withOptions [Command.Drop.fromOption] $
 	command "dropunused" (paramRepeating paramNumRange)
 		seek SectionMaintenance "drop unused file content"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withUnusedMaps start]
+seek = withUnusedMaps start
 
 start :: UnusedMaps -> Int -> CommandStart
 start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation)

Command/EnableRemote.hs

@@ -20,8 +20,8 @@ def = [command "enableremote"
 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
 	seek SectionSetup "enables use of an existing special remote"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start [] = unknownNameError "Specify the name of the special remote to enable."

Command/ExamineKey.hs

@@ -10,7 +10,7 @@ module Command.ExamineKey where
 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
 import GitAnnex.Options
 
@@ -19,8 +19,10 @@ def = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $
 	command "examinekey" (paramRepeating paramKey) seek
 	SectionPlumbing "prints information from a key"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFormat $ \f -> withKeys $ start f]
+seek ps = do
+	format <- getFormat
+	withKeys (start format) ps
 
 start :: Maybe Utility.Format.Format -> Key -> CommandStart
 start format key = do

Command/Find.hs

@@ -27,8 +27,8 @@ def = [noCommit $ noMessages $ withOptions [formatOption, print0Option, jsonOpti
 formatOption :: Option
 formatOption = Option.field [] "format" paramFormat "control format of output"
 
-withFormat :: (Maybe Utility.Format.Format -> CommandSeek) -> CommandSeek
+getFormat :: Annex (Maybe Utility.Format.Format)
-withFormat = withField formatOption $ return . fmap Utility.Format.gen
+getFormat = getOptionField formatOption $ return . fmap Utility.Format.gen
 
 print0Option :: Option
 print0Option = Option.Option [] ["print0"] (Option.NoArg set)
@@ -36,8 +36,10 @@ print0Option = Option.Option [] ["print0"] (Option.NoArg set)
   where
 	set = Annex.setField (Option.name formatOption) "${file}\0"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFormat $ \f -> withFilesInGit $ whenAnnexed $ start f]
+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

@@ -24,8 +24,8 @@ def :: [Command]
 def = [notDirect $ noCommit $ command "fix" paramPaths seek
 	SectionMaintenance "fix up symlinks to point to annexed content"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFilesInGit $ whenAnnexed start]
+seek = withFilesInGit $ whenAnnexed start
 
 {- Fixes the symlink to an annexed file. -}
 start :: FilePath -> (Key, Backend) -> CommandStart

Command/Forget.hs

@@ -26,9 +26,10 @@ forgetOptions = [dropDeadOption]
 dropDeadOption :: Option
 dropDeadOption = Option.flag [] "drop-dead" "drop references to dead repositories"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFlag dropDeadOption $ \dropdead ->
+seek ps = do
-	withNothing $ start dropdead]
+	dropdead <- getOptionFlag dropDeadOption
+	withNothing (start dropdead) ps
 
 start :: Bool -> CommandStart
 start dropdead = do

Command/FromKey.hs

@@ -20,8 +20,8 @@ def = [notDirect $ notBareRepo $
 	command "fromkey" (paramPair paramKey paramPath) seek
 		SectionPlumbing "adds a file using a specific key"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start (keyname:file:[]) = do

Command/Fsck.hs

@@ -70,16 +70,17 @@ fsckOptions =
 	, incrementalScheduleOption
 	] ++ keyOptions
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek =
+seek ps = do
-	[ withField fromOption Remote.byNameWithUUID $ \from ->
+	from <- getOptionField fromOption Remote.byNameWithUUID
-	  withIncremental $ \i ->
+	i <- getIncremental
-	  withKeyOptions (startKey i) $
+	withKeyOptions
-	  withFilesInGit $ whenAnnexed $ start from i
+		(startKey i)
-	]
+		(withFilesInGit $ whenAnnexed $ start from i)
+		ps
 
-withIncremental :: (Incremental -> CommandSeek) -> CommandSeek
+getIncremental :: Annex Incremental
-withIncremental = withValue $ do
+getIncremental = do
 	i <- maybe (return False) (checkschedule . parseDuration)
 		=<< Annex.getField (Option.name incrementalScheduleOption)
 	starti <- Annex.getFlag (Option.name startIncrementalOption)

Command/FuzzTest.hs

@@ -25,8 +25,8 @@ def :: [Command]
 def = [ notBareRepo $ command "fuzztest" paramNothing seek SectionPlumbing
 	"generates fuzz test files"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = do

Command/GCryptSetup.hs

@@ -18,8 +18,8 @@ def = [dontCheck repoExists $ noCommit $
 	command "gcryptsetup" paramValue seek
 		SectionPlumbing "sets up gcrypt repository"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withStrings start]
+seek = withStrings start
 
 start :: String -> CommandStart
 start gcryptid = next $ next $ do

Command/Get.hs

@@ -24,12 +24,13 @@ def = [withOptions getOptions $ command "get" paramPaths seek
 getOptions :: [Option]
 getOptions = fromOption : keyOptions
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = 
+seek ps = do
-	[ withField fromOption Remote.byNameWithUUID $ \from ->
+	from <- getOptionField fromOption Remote.byNameWithUUID
-	  withKeyOptions (startKeys from) $
+	withKeyOptions
-	  withFilesInGit $ whenAnnexed $ start from
+		(startKeys from)
-	]
+		(withFilesInGit $ whenAnnexed $ start from)
+		ps
 
 start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
 start from file (key, _) = start' expensivecheck from key (Just file)

Command/Group.hs

@@ -19,8 +19,8 @@ def :: [Command]
 def = [command "group" (paramPair paramRemote paramDesc) seek
 	SectionSetup "add a repository to a group"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start (name:g:[]) = do

Command/Help.hs

@@ -26,8 +26,8 @@ def :: [Command]
 def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
 	command "help" paramNothing seek SectionQuery "display help"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start params = do

Command/Import.hs

@@ -61,8 +61,10 @@ getDuplicateMode = gen
 	gen False False False True = SkipDuplicates
 	gen _ _ _ _ = error "bad combination of --duplicate, --deduplicate, --clean-duplicates, --skip-duplicates"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withValue getDuplicateMode $ \mode -> withPathContents $ start mode]
+seek ps = do
+	mode <- getDuplicateMode
+	withPathContents (start mode) ps
 
 start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart
 start mode (srcfile, destfile) =

Command/ImportFeed.hs

@@ -41,11 +41,12 @@ def = [notBareRepo $ withOptions [templateOption, relaxedOption] $
 templateOption :: Option
 templateOption = Option.field [] "template" paramFormat "template for filenames"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withField templateOption return $ \tmpl ->
+seek ps = do
-	withFlag relaxedOption $ \relaxed ->
+	tmpl <- getOptionField templateOption return
-	withValue (getCache tmpl) $ \cache ->
+	relaxed <- getOptionFlag relaxedOption
-	withStrings $ start relaxed cache]
+	cache <- getCache tmpl
+	withStrings (start relaxed cache) ps
 
 start :: Bool -> Cache -> URLString -> CommandStart
 start relaxed cache url = do

Command/InAnnex.hs

@@ -15,8 +15,8 @@ def :: [Command]
 def = [noCommit $ command "inannex" (paramRepeating paramKey) seek
 	SectionPlumbing "checks if keys are present in the annex"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withKeys start]
+seek = withKeys start
 
 start :: Key -> CommandStart
 start key = inAnnexSafe key >>= dispatch

Command/Indirect.hs

@@ -31,8 +31,8 @@ def = [notBareRepo $ noDaemonRunning $
 	command "indirect" paramNothing seek
 		SectionSetup "switch repository to indirect mode"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = ifM isDirect

Command/Info.hs

@@ -75,8 +75,8 @@ def = [noCommit $ withOptions [jsonOption] $
 	command "info" paramPaths seek SectionQuery
 	"shows general information about the annex"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [FilePath] -> CommandStart
 start [] = do

Command/Init.hs

@@ -15,8 +15,8 @@ def :: [Command]
 def = [dontCheck repoExists $
 	command "init" paramDesc seek SectionSetup "initialize git-annex"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start ws = do

Command/InitRemote.hs

@@ -24,8 +24,8 @@ def = [command "initremote"
 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
 	seek SectionSetup "creates a special (non-git) remote"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start [] = error "Specify a name for the remote."

Command/List.hs

@@ -31,11 +31,11 @@ def = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek
 allrepos :: Option
 allrepos = Option.flag [] "allrepos" "show all repositories, not only remotes"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = 
+seek ps = do
-	[ withValue getList $ withWords . startHeader
+	list <- getList
-	, withValue getList $ withFilesInGit . whenAnnexed . start
+	printHeader list
-	]
+	withFilesInGit (whenAnnexed $ start list) ps
 
 getList :: Annex [(UUID, RemoteName, TrustLevel)]
 getList = ifM (Annex.getFlag $ Option.name allrepos)
@@ -58,10 +58,8 @@ getList = ifM (Annex.getFlag $ Option.name allrepos)
 		return $ sortBy (comparing snd3) $
 			filter (\t -> thd3 t /= DeadTrusted) rs3
 
-startHeader :: [(UUID, RemoteName, TrustLevel)] -> [String] -> CommandStart
+printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
-startHeader l _ = do
+printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l
-	liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l
-	stop
 
 start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> (Key, Backend) -> CommandStart
 start l file (key, _) = do

Command/Lock.hs

@@ -16,8 +16,10 @@ def :: [Command]
 def = [notDirect $ command "lock" paramPaths seek SectionCommon
 	"undo unlock command"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start]
+seek ps = do
+	withFilesUnlocked start ps
+	withFilesUnlockedToBeCommitted start ps
 
 start :: FilePath -> CommandStart
 start file = do

Command/Log.hs

@@ -53,12 +53,13 @@ passthruOptions = map odate ["since", "after", "until", "before"] ++
 gourceOption :: Option
 gourceOption = Option.flag [] "gource" "format output for gource"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withValue Remote.uuidDescriptions $ \m ->
+seek ps = do
-	withValue (liftIO getCurrentTimeZone) $ \zone ->
+	m <- Remote.uuidDescriptions
-	withValue (concat <$> mapM getoption passthruOptions) $ \os ->
+	zone <- liftIO getCurrentTimeZone
-	withFlag gourceOption $ \gource ->
+	os <- concat <$> mapM getoption passthruOptions
-	withFilesInGit $ whenAnnexed $ start m zone os gource]
+	gource <- getOptionFlag gourceOption
+	withFilesInGit (whenAnnexed $ start m zone os gource) ps
   where
 	getoption o = maybe [] (use o) <$>
 		Annex.getField (Option.name o)

Command/LookupKey.hs

@@ -17,8 +17,8 @@ def = [notBareRepo $ noCommit $ noMessages $
 	command "lookupkey" (paramRepeating paramFile) seek
 		SectionPlumbing "looks up key used for file"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withStrings start]
+seek = withStrings start
 
 start :: String -> CommandStart
 start file = do

Command/Map.hs

@@ -31,8 +31,8 @@ def = [dontCheck repoExists $
 	command "map" paramNothing seek SectionQuery
 		"generate map of repositories"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = do

Command/Merge.hs

@@ -17,11 +17,10 @@ def :: [Command]
 def = [command "merge" paramNothing seek SectionMaintenance
 	"automatically merge changes from remotes"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek =
+seek ps = do
-	[ withNothing mergeBranch
+	withNothing mergeBranch ps
-	, withNothing mergeSynced
+	withNothing mergeSynced ps
-	]
 
 mergeBranch :: CommandStart
 mergeBranch = do

Command/Migrate.hs

@@ -22,8 +22,8 @@ def = [notDirect $
 	command "migrate" paramPaths seek
 		SectionUtility "switch data to different backend"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFilesInGit $ whenAnnexed start]
+seek = withFilesInGit $ whenAnnexed start
 
 start :: FilePath -> (Key, Backend) -> CommandStart
 start file (key, oldbackend) = do

Command/Mirror.hs

@@ -22,13 +22,14 @@ def = [withOptions (fromToOptions ++ keyOptions) $
 	command "mirror" paramPaths seek
 		SectionCommon "mirror content of files to/from another repository"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek =
+seek ps = do
-	[ withField toOption Remote.byNameWithUUID $ \to ->
+	to <- getOptionField toOption Remote.byNameWithUUID
-	  withField fromOption Remote.byNameWithUUID $ \from ->
+	from <- getOptionField fromOption Remote.byNameWithUUID
-	  withKeyOptions (startKey Nothing to from Nothing) $
+	withKeyOptions
-	  withFilesInGit $ whenAnnexed $ start to from
+		(startKey Nothing 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

Command/Move.hs

@@ -26,13 +26,14 @@ def = [withOptions moveOptions $ command "move" paramPaths seek
 moveOptions :: [Option]
 moveOptions = fromToOptions ++ keyOptions
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = 
+seek ps = do
-	[ withField toOption Remote.byNameWithUUID $ \to ->
+	to <- getOptionField toOption Remote.byNameWithUUID
-	  withField fromOption Remote.byNameWithUUID $ \from ->
+	from <- getOptionField fromOption Remote.byNameWithUUID
-	  withKeyOptions (startKey to from True) $
+	withKeyOptions
-	  withFilesInGit $ whenAnnexed $ start to from True
+		(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
@@ -63,7 +64,7 @@ showMoveAction False key Nothing = showStart "copy" (key2file key)
  - 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

@@ -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 Logs.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 n
+		Nothing -> do
+			liftIO $ putStrLn $ "global numcopies is not set"
+			old <- annexNumCopies <$> Annex.getGitConfig
+			case old of
+				Nothing -> liftIO $ putStrLn "(default is 1)"
+				Just n -> liftIO $ putStrLn $ "(deprecated git config annex.numcopies is set to " ++ show n ++ " locally)"
+	return True
+
+startSet :: Int -> CommandStart
+startSet n = do
+	showStart "numcopies" (show n)
+	next $ next $ do
+		setGlobalNumCopies n
+		return True

Command/PreCommit.hs

@@ -9,6 +9,7 @@ module Command.PreCommit where
 
 import Common.Annex
 import Command
+import Config
 import qualified Command.Add
 import qualified Command.Fix
 import Annex.Direct
@@ -17,19 +18,20 @@ def :: [Command]
 def = [command "pre-commit" paramPaths seek SectionPlumbing
 	"run by git pre-commit hook"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek =
+seek ps = ifM isDirect
-	-- fix symlinks to files being committed
-	[ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed Command.Fix.start
-	-- inject unlocked files into the annex
-	, whenNotDirect $ withFilesUnlockedToBeCommitted startIndirect
 	-- 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

@@ -22,8 +22,8 @@ def = [notDirect $ command "rekey"
 	(paramOptional $ paramRepeating $ paramPair paramPath paramKey)
 	seek SectionPlumbing "change keys used for files"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withPairs start]
+seek = withPairs start
 
 start :: (FilePath, String) -> CommandStart
 start (file, keyname) = ifAnnexed file go stop

Command/RecvKey.hs

@@ -26,8 +26,8 @@ def :: [Command]
 def = [noCommit $ command "recvkey" paramKey seek
 	SectionPlumbing "runs rsync in server mode to receive content"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withKeys start]
+seek = withKeys start
 
 start :: Key -> CommandStart
 start key = ifM (inAnnex key)

Command/Reinject.hs

@@ -17,8 +17,8 @@ def :: [Command]
 def = [command "reinject" (paramPair "SRC" "DEST") seek
 	SectionUtility "sets content of annexed file"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [FilePath] -> CommandStart
 start (src:dest:[])

Command/Repair.hs

@@ -20,8 +20,8 @@ def :: [Command]
 def = [noCommit $ dontCheck repoExists $
 	command "repair" paramNothing seek SectionMaintenance "recover broken git repository"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = next $ next $ runRepair =<< Annex.getState Annex.force

Command/RmUrl.hs

@@ -16,8 +16,8 @@ def = [notBareRepo $
 	command "rmurl" (paramPair paramFile paramUrl) seek
 		SectionCommon "record file is not available at url"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withPairs start]
+seek = withPairs start
 
 start :: (FilePath, String) -> CommandStart
 start (file, url) = flip whenAnnexed file $ \_ (key, _) -> do

Command/Schedule.hs

@@ -21,8 +21,8 @@ def :: [Command]
 def = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek
 	SectionSetup "get or set scheduled jobs"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start = parse

Command/Semitrust.hs

@@ -16,8 +16,8 @@ def :: [Command]
 def = [command "semitrust" (paramRepeating paramRemote) seek
 	SectionSetup "return repository to default trust level"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start ws = do

Command/SendKey.hs

@@ -20,8 +20,8 @@ def :: [Command]
 def = [noCommit $ command "sendkey" paramKey seek
 	SectionPlumbing "runs rsync in server mode to send content"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withKeys start]
+seek = withKeys start
 
 start :: Key -> CommandStart
 start key = do

Command/Status.hs

@@ -22,10 +22,8 @@ def = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $
 	command "status" paramPaths seek SectionCommon
 		"show the working tree status"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = 
+seek = withWords start
-	[ withWords start
-	]
 
 start :: [FilePath] -> CommandStart
 start [] = do

Command/Sync.hs

@@ -47,7 +47,7 @@ import Control.Concurrent.MVar
 def :: [Command]
 def = [withOptions syncOptions $
 	command "sync" (paramOptional (paramRepeating paramRemote))
-	[seek] SectionCommon "synchronize local repository with remotes"]
+	seek SectionCommon "synchronize local repository with remotes"]
 
 syncOptions :: [Option]
 syncOptions = [ contentOption ]
@@ -55,7 +55,6 @@ syncOptions = [ contentOption ]
 contentOption :: Option
 contentOption = Option.flag [] "content" "also transfer file contents"
 
--- syncing involves several operations, any of which can independently fail
 seek :: CommandSeek
 seek rs = do
 	prepMerge
@@ -78,18 +77,18 @@ seek rs = do
 	remotes <- syncRemotes rs
 	let gitremotes = filter Remote.gitSyncableRemote remotes
 
-	synccontent <- ifM (Annex.getFlag $ Option.name contentOption)
+	-- Syncing involves many actions, any of which can independently
-		( withFilesInGit (whenAnnexed $ syncContent remotes) []
+	-- fail, without preventing the others from running.
-		, return []
+	seekActions $ return $ concat
-		)
-	
-	return $ concat
 		[ [ commit ]
 		, [ withbranch mergeLocal ]
 		, map (withbranch . pullRemote) gitremotes
-		, [ mergeAnnex ]
+		,  [ mergeAnnex ]
-		, synccontent
+		]
-		, [ withbranch pushLocal ]
+	whenM (Annex.getFlag $ Option.name contentOption) $
+		seekSyncContent remotes
+	seekActions $ return $ concat
+		[ [ withbranch pushLocal ]
 		, map (withbranch . pushRemote) gitremotes
 		]
 
@@ -499,29 +498,24 @@ newer remote b = do
  - Drop it from each remote that has it, where it's not preferred content
  - (honoring numcopies).
  -}
-syncContent :: [Remote] -> FilePath -> (Key, Backend) -> CommandStart
+seekSyncContent :: [Remote] -> Annex ()
-syncContent rs f (k, _) = do
+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
 
-	getresults <- sequence =<< handleget have
+	sequence_ =<< handleget have
-	(putresults, putrs) <- unzip <$> (sequence =<< handleput lack)
+	putrs <- catMaybes . snd . unzip <$> (sequence =<< handleput lack)
 
-	let locs' = catMaybes putrs ++ locs
+	-- Using callCommand rather than commandAction for drops,
-	handleDropsFrom locs' rs "unwanted" True k (Just f) Nothing
+	-- because a failure to drop does not mean the sync failed.
-
+	handleDropsFrom (putrs ++ locs) rs "unwanted" True k (Just f)
-	let results = getresults ++ putresults
+		Nothing callCommand
-	if null results
-		then stop
-		else do
-			showStart "sync" f
-			next $ next $ return $ all id results
   where
-	run a = do
-		r <- a
-		showEndResult r
-		return r
-
   	wantget have = allM id 
 		[ pure (not $ null have)
 		, not <$> inAnnex k
@@ -531,9 +525,9 @@ syncContent rs f (k, _) = do
 		( return [ get have ]
 		, return []
 		)
-	get have = do
+	get have = commandAction $ do
 		showStart "get" f
-		run $ getViaTmp k $ \dest -> getKeyFile' k (Just f) dest have
+		next $ next $ getViaTmp k $ \dest -> getKeyFile' k (Just f) dest have
 
 	wantput r
 		| Remote.readonly r || remoteAnnexReadOnly (Types.Remote.gitconfig r) = return False
@@ -543,10 +537,13 @@ syncContent rs f (k, _) = do
 		, return []
 		)
 	put dest = do
-		showStart "copy" f
+		ok <- commandAction $ do
-		showAction $ "to " ++ Remote.name dest
+			showStart "copy" f
-		ok <- run $ upload (Remote.uuid dest) k (Just f) noRetry $
+			showAction $ "to " ++ Remote.name dest
-			Remote.storeKey dest k (Just f)
+			next $ next $ do
-		when ok $
+				ok <- upload (Remote.uuid dest) k (Just f) noRetry $
-			Remote.logStatus dest k InfoPresent
+					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

@@ -16,8 +16,8 @@ def = [ noRepo startIO $ dontCheck repoExists $
 	command "test" paramNothing seek SectionPlumbing
 		"run built-in test suite"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+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

Command/TransferInfo.hs

@@ -19,8 +19,8 @@ def :: [Command]
 def = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing
 	"updates sender on number of bytes of content received"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 {- Security:
  - 

Command/TransferKey.hs

@@ -28,11 +28,12 @@ transferKeyOptions = fileOption : fromToOptions
 fileOption :: Option
 fileOption = Option.field [] "file" paramFile "the associated file"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withField toOption Remote.byNameWithUUID $ \to ->
+seek ps = do
-	withField fromOption Remote.byNameWithUUID $ \from ->
+	to <- getOptionField toOption Remote.byNameWithUUID
-	withField fileOption return $ \file ->
+	from <- getOptionField fromOption Remote.byNameWithUUID
-		withKeys $ start to from file]
+	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

@@ -25,8 +25,8 @@ def :: [Command]
 def = [command "transferkeys" paramNothing seek
 	SectionPlumbing "transfers keys"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = withHandles $ \(readh, writeh) -> do

Command/Trust.hs

@@ -16,8 +16,8 @@ def :: [Command]
 def = [command "trust" (paramRepeating paramRemote) seek
 	SectionSetup "trust a repository"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start ws = do

Command/Unannex.hs

@@ -23,8 +23,8 @@ def :: [Command]
 def = [command "unannex" paramPaths seek SectionUtility
 		"undo accidential add command"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFilesInGit $ whenAnnexed start]
+seek = withFilesInGit $ whenAnnexed start
 
 start :: FilePath -> (Key, Backend) -> CommandStart
 start file (key, _) = stopUnless (inAnnex key) $ do

Command/Ungroup.hs

@@ -19,8 +19,8 @@ def :: [Command]
 def = [command "ungroup" (paramPair paramRemote paramDesc) seek
 	SectionSetup "remove a repository from a group"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start (name:g:[]) = do

Command/Uninit.hs

@@ -34,12 +34,11 @@ check = do
 	revhead = inRepo $ Git.Command.pipeReadStrict
 		[Params "rev-parse --abbrev-ref HEAD"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = 
+seek ps = do
-	[ withFilesNotInGit $ whenAnnexed startCheckIncomplete
+	withFilesNotInGit (whenAnnexed startCheckIncomplete) ps
-	, withFilesInGit $ whenAnnexed Command.Unannex.start
+	withFilesInGit (whenAnnexed Command.Unannex.start) ps
-	, withNothing start
+	finish
-	]
 
 {- git annex symlinks that are not checked into git could be left by an
  - interrupted add. -}
@@ -50,8 +49,8 @@ startCheckIncomplete file _ = error $ unlines
 	, "Not continuing with uninit; either delete or git annex add the file and retry."
 	]
 
-start :: CommandStart
+finish :: Annex ()
-start = next $ next $ do
+finish = do
 	annexdir <- fromRepo gitAnnexDir
 	annexobjectdir <- fromRepo gitAnnexObjectDir
 	leftovers <- removeUnannexed =<< getKeysPresent

Command/Unlock.hs

@@ -20,8 +20,8 @@ def =
   where
 	c n = notDirect . command n paramPaths seek SectionCommon
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFilesInGit $ whenAnnexed start]
+seek = withFilesInGit $ whenAnnexed start
 
 {- The unlock subcommand replaces the symlink with a copy of the file's
  - content. -}

Command/Untrust.hs

@@ -16,8 +16,8 @@ def :: [Command]
 def = [command "untrust" (paramRepeating paramRemote) seek
 	SectionSetup "do not trust a repository"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start ws = do

Command/Unused.hs

@@ -45,8 +45,8 @@ def = [withOptions [fromOption] $ command "unused" paramNothing seek
 fromOption :: Option
 fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 {- Finds unused content in the annex. -} 
 start :: CommandStart
@@ -326,14 +326,14 @@ data UnusedMaps = UnusedMaps
 	, 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"
 	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]
@@ -349,8 +349,8 @@ unusedSpec m spec
 		_ -> badspec
 	badspec = error $ "Expected number or range, not \"" ++ spec ++ "\""
 
-{- Start action for unused content. Finds the number in the maps, and
+{- Seek action for unused content. Finds the number in the maps, and
- - calls either of 3 actions, depending on the type of unused file. -}
+ - calls one of 3 actions, depending on the type of unused file. -}
 startUnused :: String
 	-> (Key -> CommandPerform)
 	-> (Key -> CommandPerform) 

Command/Upgrade.hs

@@ -16,8 +16,8 @@ def = [dontCheck repoExists $ -- because an old version may not seem to exist
 	command "upgrade" paramNothing seek
 		SectionMaintenance "upgrade repository layout"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = do

Command/Version.hs

@@ -21,8 +21,8 @@ def :: [Command]
 def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
 	command "version" paramNothing seek SectionQuery "show version info"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = do

Command/Vicfg.hs

@@ -30,8 +30,8 @@ def :: [Command]
 def = [command "vicfg" paramNothing seek
 	SectionSetup "edit git-annex's configuration"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withNothing start]
+seek = withNothing start
 
 start :: CommandStart
 start = do

Command/Wanted.hs

@@ -20,8 +20,8 @@ def :: [Command]
 def = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek
 	SectionSetup "get or set preferred content expression"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start = parse

Command/Watch.hs

@@ -17,10 +17,11 @@ def :: [Command]
 def = [notBareRepo $ withOptions [foregroundOption, stopOption] $ 
 	command "watch" paramNothing seek SectionCommon "watch for changes"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withFlag stopOption $ \stopdaemon -> 
+seek ps = do
-	withFlag foregroundOption $ \foreground ->
+	stopdaemon <- getOptionFlag stopOption
-	withNothing $ start False foreground stopdaemon Nothing]
+	foreground <- getOptionFlag foregroundOption
+	withNothing (start False foreground stopdaemon Nothing) ps
 
 foregroundOption :: Option
 foregroundOption = Option.flag [] "foreground" "do not daemonize"

Command/WebApp.hs

@@ -48,9 +48,10 @@ listenOption :: Option
 listenOption = Option.field [] "listen" paramAddress
 	"accept connections to this address"
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withField listenOption return $ \listenhost ->
+seek ps = do
-	withNothing $ start listenhost]
+	listenhost <- getOptionField listenOption return
+	withNothing (start listenhost) ps
 
 start :: Maybe HostName -> CommandStart
 start = start' True
@@ -107,7 +108,7 @@ startNoRepo _ = do
 		(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

@@ -20,9 +20,10 @@ def = [noCommit $ withOptions [jsonOption] $
 	command "whereis" paramPaths seek SectionQuery
 		"lists repositories that have file content"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withValue (remoteMap id) $ \m ->
+seek ps = do
-	withFilesInGit $ whenAnnexed $ start m]
+	m <- remoteMap id
+	withFilesInGit (whenAnnexed $ start m) ps
 
 start :: M.Map UUID Remote -> FilePath -> (Key, Backend) -> CommandStart
 start remotemap file (key, _) = do

Command/XMPPGit.hs

@@ -16,8 +16,8 @@ def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
 	command "xmppgit" paramNothing seek
 		SectionPlumbing "git to XMPP relay"]
 
-seek :: [CommandSeek]
+seek :: CommandSeek
-seek = [withWords start]
+seek = withWords start
 
 start :: [String] -> CommandStart
 start _ = do

Config.hs

@@ -71,7 +71,10 @@ setRemoteAvailability r c = setConfig (remoteConfig r "availability") (show c)
 
 getNumCopies :: Maybe Int -> Annex Int
 getNumCopies (Just v) = return v
-getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig
+getNumCopies Nothing = deprecatedNumCopies
+
+deprecatedNumCopies :: Annex Int
+deprecatedNumCopies = fromMaybe 1 . annexNumCopies <$> Annex.getGitConfig
 
 isDirect :: Annex Bool
 isDirect = annexDirect <$> Annex.getGitConfig

GitAnnex.hs

@@ -50,6 +50,7 @@ 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
@@ -117,6 +118,7 @@ cmds = concat
 	, Command.Unannex.def
 	, Command.Uninit.def
 	, Command.PreCommit.def
+	, Command.NumCopies.def
 	, Command.Trust.def
 	, Command.Untrust.def
 	, Command.Semitrust.def

GitAnnex/Options.hs

@@ -41,6 +41,8 @@ options = Option.common ++
 		"match files present in a remote"
 	, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)
 		"skip files with fewer copies"
+	, Option [] ["numcopiesneeded"] (ReqArg Limit.addNumCopiesNeeded paramNumber)
+		"match files that need more copies"
 	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
 		"match files using a key-value backend"
 	, Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup)
@@ -63,7 +65,7 @@ options = Option.common ++
   where
 	trustArg t = ReqArg (Remote.forceTrust t) paramRemote
 	setnumcopies v = maybe noop
-		(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just n })
+		(\n -> Annex.changeState $ \s -> s { Annex.globalnumcopies = Just n })
 		(readish v)
 	setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
 	setgitconfig v = inRepo (Git.Config.store v)

GitAnnexShell.hs

@@ -104,7 +104,7 @@ builtin cmd dir params = do
 		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) }
+	newcmd opts c = c { cmdseek = addrsyncopts opts (cmdseek c) }
 
 external :: [String] -> IO ()
 external params = do

Limit.hs

@@ -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,6 +23,7 @@ import qualified Backend
 import Annex.Content
 import Annex.UUID
 import Logs.Trust
+import Logs.NumCopies
 import Types.TrustLevel
 import Types.Key
 import Types.Group
@@ -177,6 +178,30 @@ limitCopies want = case split ":" want of
 		| "+" `isSuffixOf` s = (>=) <$> readTrustLevel (beginning s)
 		| otherwise = (==) <$> readTrustLevel s
 
+{- Adds a limit to match files that need more copies made.
+ -
+ - Does not look at annex.numcopies .gitattributes, because that
+ - would require querying git check-attr every time a preferred content
+ - expression is checked, which would probably be quite slow.
+ -}
+addNumCopiesNeeded :: String -> Annex ()
+addNumCopiesNeeded = addLimit . limitNumCopiesNeeded
+
+limitNumCopiesNeeded :: MkLimit
+limitNumCopiesNeeded want = case readish want of
+	Just needed -> Right $ \notpresent -> checkKey $
+		handle needed notpresent
+	Nothing -> Left "bad value for numcopiesneeded"
+  where
+	handle needed notpresent key = do
+		gv <- getGlobalNumCopies
+		case gv of
+			Nothing -> return False
+			Just numcopies -> do
+				us <- filter (`S.notMember` notpresent)
+					<$> (trustExclude UnTrusted =<< Remote.keyLocations key)
+				return $ numcopies - length us >= needed
+
 {- Adds a limit to skip files not believed to be present in all
  - repositories in the specified group. -}
 addInAllGroup :: String -> Annex ()

Logs.hs

@@ -11,7 +11,11 @@ import Common.Annex
 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 :: FilePath -> Maybe LogVariety
 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 @@ presenceLogs f =
 uuidLog :: FilePath
 uuidLog = "uuid.log"
 
+numcopiesLog :: FilePath
+numcopiesLog = "numcopies.log"
+
 remoteLog :: FilePath
 remoteLog = "remote.log"
 
@@ -118,6 +126,7 @@ prop_logs_sane dummykey = all id
 	, 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 @@ prop_logs_sane dummykey = all id
 	isNewUUIDBasedLog _ = False
 	isPresenceLog (PresenceLog k) = k == dummykey
 	isPresenceLog _ = False
+	isSingleValueLog SingleValueLog = True
+	isSingleValueLog _ = False

Logs/NumCopies.hs

@@ -0,0 +1,33 @@
+{- 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 where
+
+import Common.Annex
+import qualified Annex
+import Logs
+import Logs.SingleValue
+
+instance Serializable Int where
+	serialize = show
+	deserialize = readish
+
+setGlobalNumCopies :: Int -> Annex ()
+setGlobalNumCopies = setLog numcopiesLog
+
+{- Cached for speed. -}
+getGlobalNumCopies :: Annex (Maybe Int)
+getGlobalNumCopies = maybe numCopiesLoad (return . Just)
+	=<< Annex.getState Annex.globalnumcopies
+
+numCopiesLoad :: Annex (Maybe Int)
+numCopiesLoad = do
+	v <- getLog numcopiesLog
+	Annex.changeState $ \s -> s { Annex.globalnumcopies = v }
+	return v

Logs/SingleValue.hs

@@ -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 Serializable 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 :: (Serializable v) => Log v -> String
+showLog = unlines . map showline . S.toList
+  where
+	showline (LogEntry t v) = unwords [show t, serialize v]
+
+parseLog :: (Ord v, Serializable 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, Serializable v) => FilePath -> Annex (Log v)
+readLog = parseLog <$$> Annex.Branch.get
+
+getLog :: (Ord v, Serializable v) => FilePath -> Annex (Maybe v)
+getLog = newestValue <$$> readLog
+
+setLog :: (Serializable 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)

RunCommand.hs

@@ -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

@@ -4,7 +4,7 @@
  - the values a user passes to a command, and prepare actions operating
  - on them.
  -
- - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -23,23 +23,14 @@ 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
-
+import RunCommand
-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
+withFilesInGit a params = seekActions $ prepFiltered a $
+	seekHelper LsFiles.inRepo params
 
 withFilesNotInGit :: (FilePath -> CommandStart) -> CommandSeek
 withFilesNotInGit a params = do
@@ -47,7 +38,8 @@ withFilesNotInGit a params = do
 	files <- filter (not . dotfile) <$>
 		seekunless (null ps && not (null params)) ps
 	dotfiles <- seekunless (null dotps) dotps
-	prepFiltered a $ return $ concat $ segmentPaths params (files++dotfiles)
+	seekActions $ prepFiltered a $
+		return $ concat $ segmentPaths params (files++dotfiles)
   where
 	(dotps, ps) = partition dotfile params
 	seekunless True _ = return []
@@ -57,7 +49,8 @@ withFilesNotInGit a params = do
 		liftIO $ Git.Command.leaveZombie <$> LsFiles.notInRepo force l g
 
 withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek
-withPathContents a params = map a . concat <$> liftIO (mapM get params)
+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))
@@ -66,20 +59,20 @@ withPathContents a params = map a . concat <$> liftIO (mapM get params)
 		)
 
 withWords :: ([String] -> CommandStart) -> CommandSeek
-withWords a params = return [a params]
+withWords a params = seekActions $ return [a params]
 
 withStrings :: (String -> CommandStart) -> CommandSeek
-withStrings a params = return $ map a params
+withStrings a params = seekActions $ return $ map a params
 
 withPairs :: ((String, String) -> CommandStart) -> CommandSeek
-withPairs a params = return $ map a $ pairs [] params
+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 = prepFiltered a $
+withFilesToBeCommitted a params = seekActions $ prepFiltered a $
 	seekHelper LsFiles.stagedNotDeleted params
 
 withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek
@@ -94,7 +87,8 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
  - not some other sort of symlink.
  -}
 withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek
-withFilesUnlocked' typechanged a params = prepFiltered a unlockedfiles
+withFilesUnlocked' typechanged a params = seekActions $
+	prepFiltered a unlockedfiles
   where
   	check f = liftIO (notSymlink f) <&&> 
 		(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
@@ -102,32 +96,25 @@ withFilesUnlocked' typechanged a params = prepFiltered a unlockedfiles
 
 {- Finds files that may be modified. -}
 withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek
-withFilesMaybeModified a params =
+withFilesMaybeModified a params = seekActions $
 	prepFiltered a $ seekHelper LsFiles.modified params
 
 withKeys :: (Key -> CommandStart) -> CommandSeek
-withKeys a params = return $ map (a . parse) params
+withKeys a params = seekActions $ return $ map (a . parse) params
   where
 	parse p = fromMaybe (error "bad key") $ file2key p
 
-withValue :: Annex v -> (v -> CommandSeek) -> CommandSeek
+{- Gets the value of a field options, which is fed into
-withValue v a params = do
+ - a conversion function.
-	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
+getOptionField :: Option -> (Maybe String -> Annex a) -> Annex a
-withField option converter = withValue $
+getOptionField option converter = converter <=< Annex.getField $ Option.name option
-	converter <=< Annex.getField $ Option.name option
 
-withFlag :: Option -> (Bool -> CommandSeek) -> CommandSeek
+getOptionFlag :: Option -> Annex Bool
-withFlag option = withValue $ Annex.getFlag (Option.name option)
+getOptionFlag option = Annex.getFlag (Option.name option)
 
 withNothing :: CommandStart -> CommandSeek
-withNothing a [] = return [a]
+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
@@ -159,7 +146,7 @@ withKeyOptions keyop fallbackop params = do
 		unless (null params) $
 			error "Cannot mix --all or --unused with file names."
 		matcher <- Limit.getMatcher
-		map (process matcher) <$> a
+		seekActions $ map (process matcher) <$> a
 	process matcher k = ifM (matcher $ MatchingKey k)
 		( keyop k , return Nothing)
 
@@ -171,11 +158,20 @@ prepFiltered a fs = do
 	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
-
-whenNotDirect :: CommandSeek -> CommandSeek
-whenNotDirect a params = ifM isDirect ( return [] , a params )
-
-whenDirect :: CommandSeek -> CommandSeek
-whenDirect a params = ifM isDirect ( a params, return [] )

Test.hs

@@ -292,6 +292,9 @@ test_drop_withremote :: TestEnv -> Assertion
 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 +514,9 @@ test_trust env = intmpclonerepo env $ do
 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 +545,7 @@ test_fsck_localuntrusted env = intmpclonerepo env $ do
 
 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"

Types/Command.hs

@@ -18,9 +18,9 @@ import Types
 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
+ -    to that command (ie, new files to add), and runs commandAction
- -    a list of start stage actions. -}
+ -    to handle all necessary actions. -}
-type CommandSeek = [String] -> Annex [CommandStart]
+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 @@ data Command = Command
 	, 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/GitConfig.hs

@@ -24,7 +24,7 @@ import Types.Availability
  - such as annex.foo -}
 data GitConfig = GitConfig
 	{ annexVersion :: Maybe String
-	, annexNumCopies :: Int
+	, annexNumCopies :: Maybe Int
 	, annexDiskReserve :: Integer
 	, annexDirect :: Bool
 	, annexBackends :: [String]
@@ -52,7 +52,7 @@ data GitConfig = GitConfig
 extractGitConfig :: Git.Repo -> GitConfig
 extractGitConfig r = GitConfig
 	{ annexVersion = notempty $ getmaybe (annex "version")
-	, annexNumCopies = get (annex "numcopies") 1
+	, annexNumCopies = getmayberead (annex "numcopies")
 	, annexDiskReserve = fromMaybe onemegabyte $
 		readSize dataUnits =<< getmaybe (annex "diskreserve")
 	, annexDirect = getbool (annex "direct") False

Types/StandardGroups.hs

@@ -93,6 +93,6 @@ notArchived :: String
 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. -}
 lastResort :: String -> PreferredContentExpression
-lastResort s = "(" ++ s ++ ") or (not copies=semitrusted+:1)"
+lastResort s = "(" ++ s ++ ") or numcopiesneeded=1"

debian/changelog

@@ -8,6 +8,15 @@ git-annex (5.20140118) UNRELEASED; urgency=medium
   * 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 numcopiesneeded preferred content expression.
+  * Client, transfer, incremental backup, and archive repositories
+    now want to get content that does not yet have enough copies.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 18 Jan 2014 11:54:17 -0400
 

doc/bugs/Share_with_friends_crash_in_osx/comment_10_8d90e23514d9f14283857c57017a5fcf._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.68"
+ subject="comment 10"
+ date="2014-01-20T16:28:43Z"
+ content="""
+I have updated the autobuild again, now nettle is built with more optimisations disabled. I hope this fixes it because I'm running out of things to try.
+"""]]

doc/bugs/Share_with_friends_crash_in_osx/comment_11_1a0e174969e99e7b562854d2c3b3e606._comment

@@ -0,0 +1,19 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawkLdR1fuu5aEz3s9VKTBKVMize_SmeNRJM"
+ nickname="David"
+ subject="Past the SHA issues"
+ date="2014-01-20T23:14:53Z"
+ content="""
+Now we still have an issue with nettle, but now it's part of urandom.  I'm not sure what to suggest...
+
+[[!format sh \"\"\"
+Thread 1 Crashed:
+0   H                             	0x00000001075d9756 do_device_source_urandom + 108
+1   H                             	0x00000001075d9686 do_device_source + 46
+2   H                             	0x00000001075d92b9 wrap_nettle_rnd_init + 74
+3   H                             	0x000000010755d585 _gnutls_rnd_init + 32
+4   H                             	0x0000000107551dae gnutls_global_init + 262
+5   git-annex                     	0x00000001054a28c3 0x103c83000 + 25295043
+6   git-annex                     	0x000000010692ab28 0x103c83000 + 46824232
+\"\"\"]]
+"""]]

doc/bugs/__96__minimal_build__39____fails_due_to_missing_stm_dependency.mdwn

@@ -91,3 +91,5 @@ ExitFailure 1
 
 # End of transcript or log.
 """]]
+
+> [[fixed|done]] --[[Joey]]