Merge branch 'master' into no-xmpp

Command/Add.hs

@@ -41,9 +41,6 @@ optParser desc = AddOptions
 		)
 	<*> parseBatchOption
 
-{- 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 :: AddOptions -> CommandSeek
 seek o = allowConcurrentOutput $ do
 	matcher <- largeFilesMatcher
@@ -59,10 +56,9 @@ seek o = allowConcurrentOutput $ do
 		NoBatch -> do
 			let go a = a gofile (addThese o)
 			go (withFilesNotInGit (not $ includeDotFiles o))
-			ifM (versionSupportsUnlockedPointers <||> isDirect)
-				( go withFilesMaybeModified
-				, go withFilesOldUnlocked
-				)
+			go withFilesMaybeModified
+			unlessM (versionSupportsUnlockedPointers <||> isDirect) $
+				go withFilesOldUnlocked
 
 {- Pass file off to git-add. -}
 startSmall :: FilePath -> CommandStart

Command/AddUnused.hs

@@ -38,4 +38,4 @@ perform key = next $ do
  - it seems better to error out, rather than moving bad/tmp content into
  - the annex. -}
 performOther :: String -> Key -> CommandPerform
-performOther other _ = error $ "cannot addunused " ++ other ++ "content"
+performOther other _ = giveup $ "cannot addunused " ++ other ++ "content"

Command/AddUrl.hs

@@ -27,6 +27,7 @@ import Types.UrlContents
 import Annex.FileMatcher
 import Logs.Location
 import Utility.Metered
+import Utility.FileSystemEncoding
 import qualified Annex.Transfer as Transfer
 import Annex.Quvi
 import qualified Utility.Quvi as Quvi
@@ -133,7 +134,7 @@ checkUrl r o u = do
 				let f' = adjustFile o (deffile </> fromSafeFilePath f)
 				void $ commandAction $
 					startRemote r (relaxedOption o) f' u' sz
-		| otherwise = error $ unwords
+		| otherwise = giveup $ unwords
 			[ "That url contains multiple files according to the"
 			, Remote.name r
 			, " remote; cannot add it to a single file."
@@ -182,7 +183,7 @@ startWeb :: AddUrlOptions -> String -> CommandStart
 startWeb o s = go $ fromMaybe bad $ parseURI urlstring
   where
 	(urlstring, downloader) = getDownloader s
-	bad = fromMaybe (error $ "bad url " ++ urlstring) $
+	bad = fromMaybe (giveup $ "bad url " ++ urlstring) $
 		Url.parseURIRelaxed $ urlstring
 	go url = case downloader of
 		QuviDownloader -> usequvi
@@ -208,7 +209,7 @@ startWeb o s = go $ fromMaybe bad $ parseURI urlstring
 						)
 		showStart "addurl" file
 		next $ performWeb (relaxedOption o) urlstring file urlinfo
-	badquvi = error $ "quvi does not know how to download url " ++ urlstring
+	badquvi = giveup $ "quvi does not know how to download url " ++ urlstring
 	usequvi = do
 		page <- fromMaybe badquvi
 			<$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] urlstring
@@ -340,13 +341,18 @@ cleanup :: UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()
 cleanup u url file key mtmp = case mtmp of
 	Nothing -> go
 	Just tmp -> do
+		-- Move to final location for large file check.
+		liftIO $ renameFile tmp file
 		largematcher <- largeFilesMatcher
-		ifM (checkFileMatcher largematcher file)
-			( go
-			, do
-				liftIO $ renameFile tmp file
-				void $ Command.Add.addSmall file
-			)
+		large <- checkFileMatcher largematcher file
+		if large
+			then do
+				-- Move back to tmp because addAnnexedFile
+				-- needs the file in a different location
+				-- than the work tree file.
+				liftIO $ renameFile file tmp
+				go
+			else void $ Command.Add.addSmall file
   where
 	go = do
 		maybeShowJSON $ JSONChunk [("key", key2file key)]
@@ -372,7 +378,7 @@ url2file url pathdepth pathmax = case pathdepth of
 		| depth >= length urlbits -> frombits id
 		| depth > 0 -> frombits $ drop depth
 		| depth < 0 -> frombits $ reverse . take (negate depth) . reverse
-		| otherwise -> error "bad --pathdepth"
+		| otherwise -> giveup "bad --pathdepth"
   where
 	fullurl = concat
 		[ maybe "" uriRegName (uriAuthority url)
@@ -385,7 +391,7 @@ url2file url pathdepth pathmax = case pathdepth of
 
 urlString2file :: URLString -> Maybe Int -> Int -> FilePath
 urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of
-	Nothing -> error $ "bad uri " ++ s
+	Nothing -> giveup $ "bad uri " ++ s
 	Just u -> url2file u pathdepth pathmax
 
 adjustFile :: AddUrlOptions -> FilePath -> FilePath

Command/Assistant.hs

@@ -66,14 +66,14 @@ startNoRepo :: AssistantOptions -> IO ()
 startNoRepo o
 	| autoStartOption o = autoStart o
 	| autoStopOption o = autoStop
-	| otherwise = error "Not in a git repository."
+	| otherwise = giveup "Not in a git repository."
 
 autoStart :: AssistantOptions -> IO ()
 autoStart o = do
 	dirs <- liftIO readAutoStartFile
 	when (null dirs) $ do
 		f <- autoStartFile
-		error $ "Nothing listed in " ++ f
+		giveup $ "Nothing listed in " ++ f
 	program <- programPath
 	haveionice <- pure Build.SysConfig.ionice <&&> inPath "ionice"
 	forM_ dirs $ \d -> do

Command/CheckPresentKey.hs

@@ -40,7 +40,7 @@ seek o = case batchOption o of
 			_ -> wrongnumparams
 		batchInput Right $ checker >=> batchResult
   where
-	wrongnumparams = error "Wrong number of parameters"
+	wrongnumparams = giveup "Wrong number of parameters"
 					
 data Result = Present | NotPresent | CheckFailure String
 
@@ -71,8 +71,8 @@ batchResult Present = liftIO $ putStrLn "1"
 batchResult _ = liftIO $ putStrLn "0"
 
 toKey :: String -> Key
-toKey = fromMaybe (error "Bad key") . file2key
+toKey = fromMaybe (giveup "Bad key") . file2key
 
 toRemote :: String -> Annex Remote
-toRemote rn = maybe (error "Unknown remote") return
+toRemote rn = maybe (giveup "Unknown remote") return
 	=<< Remote.byNameWithUUID (Just rn)

Command/ContentLocation.hs

@@ -19,7 +19,7 @@ cmd = noCommit $ noMessages $
 
 run :: () -> String -> Annex Bool
 run _ p = do
-	let k = fromMaybe (error "bad key") $ file2key p
+	let k = fromMaybe (giveup "bad key") $ file2key p
 	maybe (return False) (\f -> liftIO (putStrLn f) >> return True)
 		=<< inAnnex' (pure True) Nothing check k
   where

Command/Dead.hs

@@ -37,7 +37,7 @@ startKey key = do
 	ls <- keyLocations key
 	case ls of
 		[] -> next $ performKey key
-		_ -> error "This key is still known to be present in some locations; not marking as dead."
+		_ -> giveup "This key is still known to be present in some locations; not marking as dead."
 		
 performKey :: Key -> CommandPerform
 performKey key = do

Command/Describe.hs

@@ -25,7 +25,7 @@ start (name:description) = do
 	showStart "describe" name
 	u <- Remote.nameToUUID name
 	next $ perform u $ unwords description
-start _ = error "Specify a repository and a description."	
+start _ = giveup "Specify a repository and a description."	
 
 perform :: UUID -> String -> CommandPerform
 perform u description = do

Command/DiffDriver.hs

@@ -73,7 +73,7 @@ parseReq opts = case separate (== "--") opts of
 	mk (unmergedpath:[]) = UnmergedReq { rPath = unmergedpath }
 	mk _ = badopts
 
-	badopts = error $ "Unexpected input: " ++ unwords opts
+	badopts = giveup $ "Unexpected input: " ++ unwords opts
 
 {- Check if either file is a symlink to a git-annex object,
  - which git-diff will leave as a normal file containing the link text.

Command/Direct.hs

@@ -26,7 +26,7 @@ seek = withNothing start
 start :: CommandStart
 start = ifM versionSupportsDirectMode
 	( ifM isDirect ( stop , next perform )
-	, error "Direct mode is not suppported by this repository version. Use git-annex unlock instead."
+	, giveup "Direct mode is not suppported by this repository version. Use git-annex unlock instead."
 	)
 
 perform :: CommandPerform

Command/DropKey.hs

@@ -32,7 +32,7 @@ optParser desc = DropKeyOptions
 seek :: DropKeyOptions -> CommandSeek
 seek o = do
 	unlessM (Annex.getState Annex.force) $
-		error "dropkey can cause data loss; use --force if you're sure you want to do this"
+		giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
 	withKeys start (toDrop o)
 	case batchOption o of
 		Batch -> batchInput parsekey $ batchCommandAction . start

Command/EnableRemote.hs

@@ -12,6 +12,7 @@ import qualified Annex
 import qualified Logs.Remote
 import qualified Types.Remote as R
 import qualified Git
+import qualified Git.Types as Git
 import qualified Annex.SpecialRemote
 import qualified Remote
 import qualified Types.Remote as Remote
@@ -40,9 +41,7 @@ start (name:rest) = go =<< filter matchingname <$> Annex.fromRepo Git.remotes
 		=<< Annex.SpecialRemote.findExisting name
 	go (r:_) = startNormalRemote name r
 
-type RemoteName = String
-
-startNormalRemote :: RemoteName -> Git.Repo -> CommandStart
+startNormalRemote :: Git.RemoteName -> Git.Repo -> CommandStart
 startNormalRemote name r = do
 	showStart "enableremote" name
 	next $ next $ do
@@ -51,7 +50,7 @@ startNormalRemote name r = do
 		u <- getRepoUUID r'
 		return $ u /= NoUUID
 
-startSpecialRemote :: RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig) -> CommandStart
+startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig) -> CommandStart
 startSpecialRemote name config Nothing = do
 	m <- Annex.SpecialRemote.specialRemoteMap
 	confm <- Logs.Remote.readRemoteLog
@@ -63,7 +62,7 @@ startSpecialRemote name config Nothing = do
 		_ -> unknownNameError "Unknown remote name."
 startSpecialRemote name config (Just (u, c)) = do
 	let fullconfig = config `M.union` c	
-	t <- either error return (Annex.SpecialRemote.findType fullconfig)
+	t <- either giveup return (Annex.SpecialRemote.findType fullconfig)
 	showStart "enableremote" name
 	gc <- maybe def Remote.gitconfig <$> Remote.byUUID u
 	next $ performSpecialRemote t u fullconfig gc
@@ -94,7 +93,7 @@ unknownNameError prefix = do
 	disabledremotes <- filterM isdisabled =<< Annex.fromRepo Git.remotes
 	let remotesmsg = unlines $ map ("\t" ++) $
 		mapMaybe Git.remoteName disabledremotes
-	error $ concat $ filter (not . null) [prefix ++ "\n", remotesmsg, specialmsg]
+	giveup $ concat $ filter (not . null) [prefix ++ "\n", remotesmsg, specialmsg]
   where
 	isdisabled r = anyM id
 		[ (==) NoUUID <$> getRepoUUID r

Command/EnableTor.hs

@@ -0,0 +1,130 @@
+{- git-annex command
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Command.EnableTor where
+
+import Command
+import qualified Annex
+import P2P.Address
+import Utility.Tor
+import Annex.UUID
+import Config.Files
+import P2P.IO
+import qualified P2P.Protocol as P2P
+import Utility.ThreadScheduler
+
+import Control.Concurrent.Async
+import qualified Network.Socket as S
+#ifndef mingw32_HOST_OS
+import Utility.Su
+import System.Posix.User
+#endif
+
+cmd :: Command
+cmd = noCommit $ dontCheck repoExists $
+	command "enable-tor" SectionSetup "enable tor hidden service"
+		"uid" (withParams seek)
+
+seek :: CmdParams -> CommandSeek
+seek = withWords start
+
+-- This runs as root, so avoid making any commits or initializing
+-- git-annex, or doing other things that create root-owned files.
+start :: [String] -> CommandStart
+start os = do
+	uuid <- getUUID
+	when (uuid == NoUUID) $
+		giveup "This can only be run in a git-annex repository."
+#ifndef mingw32_HOST_OS
+	curruserid <- liftIO getEffectiveUserID
+	if curruserid == 0
+		then case readish =<< headMaybe os of
+			Nothing -> giveup "Need user-id parameter."
+			Just userid -> go uuid userid
+		else do
+			showStart "enable-tor" ""
+			showLongNote "Need root access to enable tor..."
+			gitannex <- liftIO readProgramFile
+			let ps = [Param (cmdname cmd), Param (show curruserid)]
+			ifM (liftIO $ runAsRoot gitannex ps)
+				( next $ next checkHiddenService
+				, giveup $ unwords $
+					[ "Failed to run as root:" , gitannex ] ++ toCommand ps
+				)
+#else
+	go uuid 0
+#endif
+  where
+	go uuid userid = do
+		(onionaddr, onionport) <- liftIO $
+			addHiddenService torAppName userid (fromUUID uuid)
+		storeP2PAddress $ TorAnnex onionaddr onionport
+		stop
+
+checkHiddenService :: CommandCleanup
+checkHiddenService = bracket setup cleanup go
+  where
+	setup = do
+		showLongNote "Tor hidden service is configured. Checking connection to it. This may take a few minutes."
+		startlistener
+	
+	cleanup = liftIO . cancel
+	
+	go _ = check (150 :: Int) =<< filter istoraddr <$> loadP2PAddresses
+	
+	istoraddr (TorAnnex _ _) = True
+
+	check 0 _ = giveup "Still unable to connect to hidden service. It might not yet be usable by others. Please check Tor's logs for details."
+	check _ [] = giveup "Somehow didn't get an onion address."
+	check n addrs@(addr:_) = do
+		g <- Annex.gitRepo
+		-- Connect but don't bother trying to auth,
+		-- we just want to know if the tor circuit works.
+		cv <- liftIO $ tryNonAsync $ connectPeer g addr
+		case cv of
+			Left e -> do
+				warning $ "Unable to connect to hidden service. It may not yet have propigated to the Tor network. (" ++ show e ++ ") Will retry.."
+				liftIO $ threadDelaySeconds (Seconds 2)
+				check (n-1) addrs
+			Right conn -> do
+				liftIO $ closeConnection conn
+				showLongNote "Tor hidden service is working."
+				return True
+	
+	-- Unless the remotedaemon is already listening on the hidden
+	-- service's socket, start a listener. This is only run during the
+	-- check, and it refuses all auth attempts.
+	startlistener = do
+		r <- Annex.gitRepo
+		u <- getUUID
+		uid <- liftIO getRealUserID
+		let ident = fromUUID u
+		v <- liftIO $ getHiddenServiceSocketFile torAppName uid ident
+		case v of
+			Just sockfile -> ifM (liftIO $ haslistener sockfile)
+				( liftIO $ async $ return ()
+				, liftIO $ async $ runlistener sockfile u r
+				)
+			Nothing -> giveup "Could not find socket file in Tor configuration!"
+	
+	runlistener sockfile u r = serveUnixSocket sockfile $ \h -> do
+		let conn = P2PConnection
+			{ connRepo = r
+			, connCheckAuth = const False
+			, connIhdl = h
+			, connOhdl = h
+			}
+		void $ runNetProto conn $ P2P.serveAuth u
+		hClose h
+
+	haslistener sockfile = catchBoolIO $ do
+		soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
+		S.connect soc (S.SockAddrUnix sockfile)
+		S.close soc
+		return True

Command/ExamineKey.hs

@@ -21,6 +21,6 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
 
 run :: Maybe Utility.Format.Format -> String -> Annex Bool
 run format p = do
-	let k = fromMaybe (error "bad key") $ file2key p
+	let k = fromMaybe (giveup "bad key") $ file2key p
 	showFormatted format (key2file k) (keyVars k)
 	return True

Command/Expire.hs

@@ -92,7 +92,7 @@ start (Expire expire) noact actlog descs u =
 data Expire = Expire (M.Map (Maybe UUID) (Maybe POSIXTime))
 
 parseExpire :: [String] -> Annex Expire
-parseExpire [] = error "Specify an expire time."
+parseExpire [] = giveup "Specify an expire time."
 parseExpire ps = do
 	now <- liftIO getPOSIXTime
 	Expire . M.fromList <$> mapM (parse now) ps
@@ -104,7 +104,7 @@ parseExpire ps = do
 			return (Just r, parsetime now t)
 	parsetime _ "never" = Nothing
 	parsetime now s = case parseDuration s of
-		Nothing -> error $ "bad expire time: " ++ s
+		Nothing -> giveup $ "bad expire time: " ++ s
 		Just d -> Just (now - durationToPOSIXTime d)
 
 parseActivity :: Monad m => String -> m Activity

Command/FromKey.hs

@@ -20,30 +20,32 @@ import Network.URI
 cmd :: Command
 cmd = notDirect $ notBareRepo $
 	command "fromkey" SectionPlumbing "adds a file using a specific key"
-		(paramPair paramKey paramPath)
+		(paramRepeating (paramPair paramKey paramPath))
 		(withParams seek)
 
 seek :: CmdParams -> CommandSeek
+seek [] = withNothing startMass []
 seek ps = do
 	force <- Annex.getState Annex.force
-	withWords (start force) ps
+	withPairs (start force) ps
 
-start :: Bool -> [String] -> CommandStart
-start force (keyname:file:[]) = do
+start :: Bool -> (String, FilePath) -> CommandStart
+start force (keyname, file) = do
 	let key = mkKey keyname
 	unless force $ do
 		inbackend <- inAnnex key
-		unless inbackend $ error $
+		unless inbackend $ giveup $
 			"key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"
 	showStart "fromkey" file
 	next $ perform key file
-start _ [] = do
+
+startMass :: CommandStart
+startMass = do
 	showStart "fromkey" "stdin"
 	next massAdd
-start _ _ = error "specify a key and a dest file"
 
 massAdd :: CommandPerform
-massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
+massAdd = go True =<< map (separate (== ' ')) <$> batchLines
   where
 	go status [] = next $ return status
 	go status ((keyname,f):rest) | not (null keyname) && not (null f) = do
@@ -51,7 +53,7 @@ massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
 		ok <- perform' key f
 		let !status' = status && ok
 		go status' rest
-	go _ _ = error "Expected pairs of key and file on stdin, but got something else."
+	go _ _ = giveup "Expected pairs of key and file on stdin, but got something else."
 
 -- From user input to a Key.
 -- User can input either a serialized key, or an url.
@@ -66,7 +68,7 @@ mkKey s = case parseURI s of
 		Backend.URL.fromUrl s Nothing
 	_ -> case file2key s of
 		Just k -> k
-		Nothing -> error $ "bad key/url " ++ s
+		Nothing -> giveup $ "bad key/url " ++ s
 
 perform :: Key -> FilePath -> CommandPerform
 perform key file = do

Command/Fsck.hs

@@ -89,7 +89,7 @@ seek o = allowConcurrentOutput $ do
 	checkDeadRepo u
 	i <- prepIncremental u (incrementalOpt o)
 	withKeyOptions (keyOptions o) False
-		(\k ai -> startKey i k ai =<< getNumCopies)
+		(\k ai -> startKey from i k ai =<< getNumCopies)
 		(withFilesInGit $ whenAnnexed $ start from i)
 		(fsckFiles o)
 	cleanupIncremental i
@@ -109,7 +109,7 @@ start from inc file key = do
 			numcopies <- getFileNumCopies file
 			case from of
 				Nothing -> go $ perform key file backend numcopies
-				Just r -> go $ performRemote key file backend numcopies r
+				Just r -> go $ performRemote key (Just file) backend numcopies r
   where
 	go = runFsck inc (mkActionItem (Just file)) key
 
@@ -129,8 +129,8 @@ perform key file backend numcopies = do
 
 {- To fsck a remote, the content is retrieved to a tmp file,
  - and checked locally. -}
-performRemote :: Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool
-performRemote key file backend numcopies remote =
+performRemote :: Key -> AssociatedFile -> Backend -> NumCopies -> Remote -> Annex Bool
+performRemote key afile backend numcopies remote =
 	dispatch =<< Remote.hasKey remote key
   where
 	dispatch (Left err) = do
@@ -147,10 +147,10 @@ performRemote key file backend numcopies remote =
 				return False
 	dispatch (Right False) = go False Nothing
 	go present localcopy = check
-		[ verifyLocationLogRemote key file remote present
+		[ verifyLocationLogRemote key (maybe (key2file key) id afile) remote present
 		, checkKeySizeRemote key remote localcopy
 		, checkBackendRemote backend key remote localcopy
-		, checkKeyNumCopies key (Just file) numcopies
+		, checkKeyNumCopies key afile numcopies
 		]
 	withtmp a = do
 		pid <- liftIO getPID
@@ -161,7 +161,7 @@ performRemote key file backend numcopies remote =
 		cleanup
 		cleanup `after` a tmp
 	getfile tmp = ifM (checkDiskSpace (Just (takeDirectory tmp)) key 0 True)
-		( ifM (Remote.retrieveKeyFileCheap remote key (Just file) tmp)
+		( ifM (Remote.retrieveKeyFileCheap remote key afile tmp)
 			( return (Just True)
 			, ifM (Annex.getState Annex.fast)
 				( return Nothing
@@ -173,12 +173,14 @@ performRemote key file backend numcopies remote =
 		)
 	dummymeter _ = noop
 
-startKey :: Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
-startKey inc key ai numcopies =
+startKey :: Maybe Remote -> Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
+startKey from inc key ai numcopies =
 	case Backend.maybeLookupBackendName (keyBackendName key) of
 		Nothing -> stop
 		Just backend -> runFsck inc ai key $
-			performKey key backend numcopies
+			case from of
+				Nothing -> performKey key backend numcopies
+				Just r -> performRemote key Nothing backend numcopies r
 
 performKey :: Key -> Backend -> NumCopies -> Annex Bool
 performKey key backend numcopies = do
@@ -584,7 +586,7 @@ prepIncremental u (Just StartIncrementalO) = do
 	recordStartTime u
 	ifM (FsckDb.newPass u)
 		( StartIncremental <$> openFsckDb u
-		, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
+		, giveup "Cannot start a new --incremental fsck pass; another fsck process is already running."
 		)
 prepIncremental u (Just MoreIncrementalO) =
 	ContIncremental <$> openFsckDb u

Command/FuzzTest.hs

@@ -39,7 +39,7 @@ start = do
 
 guardTest :: Annex ()
 guardTest = unlessM (fromMaybe False . Git.Config.isTrue <$> getConfig key "") $
-	error $ unlines
+	giveup $ unlines
 		[ "Running fuzz tests *writes* to and *deletes* files in"
 		, "this repository, and pushes those changes to other"
 		, "repositories! This is a developer tool, not something"

Command/GCryptSetup.hs

@@ -25,7 +25,7 @@ start :: String -> CommandStart
 start gcryptid = next $ next $ do
 	u <- getUUID
 	when (u /= NoUUID) $
-		error "gcryptsetup refusing to run; this repository already has a git-annex uuid!"
+		giveup "gcryptsetup refusing to run; this repository already has a git-annex uuid!"
 	
 	g <- gitRepo
 	gu <- Remote.GCrypt.getGCryptUUID True g
@@ -35,5 +35,5 @@ start gcryptid = next $ next $ do
 			then do
 				void $ Remote.GCrypt.setupRepo gcryptid g
 				return True
-			else error "cannot use gcrypt in a non-bare repository"
-		else error "gcryptsetup uuid mismatch"
+			else giveup "cannot use gcrypt in a non-bare repository"
+		else giveup "gcryptsetup uuid mismatch"

Command/Group.hs

@@ -30,7 +30,7 @@ start (name:[]) = do
 	u <- Remote.nameToUUID name
 	showRaw . unwords . S.toList =<< lookupGroups u
 	stop
-start _ = error "Specify a repository and a group."
+start _ = giveup "Specify a repository and a group."
 
 setGroup :: UUID -> Group -> CommandPerform
 setGroup uuid g = do

Command/GroupWanted.hs

@@ -25,4 +25,4 @@ start (g:[]) = next $ performGet groupPreferredContentMapRaw g
 start (g:expr:[]) = do
 	showStart "groupwanted" g
 	next $ performSet groupPreferredContentSet expr g
-start _ = error "Specify a group."
+start _ = giveup "Specify a group."

Command/Import.hs

@@ -62,7 +62,7 @@ seek o = allowConcurrentOutput $ do
 	repopath <- liftIO . absPath =<< fromRepo Git.repoPath
 	inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath (importFiles o)
 	unless (null inrepops) $ do
-		error $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
+		giveup $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
 	largematcher <- largeFilesMatcher
 	withPathContents (start largematcher (duplicateMode o)) (importFiles o)
 

Command/ImportFeed.hs

@@ -138,23 +138,25 @@ findDownloads u = go =<< downloadFeed u
 			Just $ ToDownload f u i $ Enclosure enclosureurl
 		Nothing -> mkquvi f i
 	mkquvi f i = case getItemLink i of
-		Just link -> ifM (quviSupported link)
-			( return $ Just $ ToDownload f u i $ QuviLink link
-			, return Nothing
-			)
+		Just link -> do
+			liftIO $ print ("link", link)
+			ifM (quviSupported link)
+				( return $ Just $ ToDownload f u i $ QuviLink link
+				, return Nothing
+				)
 		Nothing -> return Nothing
 
 {- Feeds change, so a feed download cannot be resumed. -}
 downloadFeed :: URLString -> Annex (Maybe Feed)
 downloadFeed url
-	| Url.parseURIRelaxed url == Nothing = error "invalid feed url"
+	| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url"
 	| otherwise = do
 		showOutput
 		uo <- Url.getUrlOptions
 		liftIO $ withTmpFile "feed" $ \f h -> do
 			hClose h
 			ifM (Url.download url f uo)
-				( parseFeedString <$> readFileStrictAnyEncoding f
+				( parseFeedString <$> readFileStrict f
 				, return Nothing
 				)
 
@@ -336,7 +338,7 @@ noneValue = "none"
  - Throws an error if the feed is broken, otherwise shows a warning. -}
 feedProblem :: URLString -> String -> Annex ()
 feedProblem url message = ifM (checkFeedBroken url)
-	( error $ message ++ " (having repeated problems with feed: " ++ url ++ ")"
+	( giveup $ message ++ " (having repeated problems with feed: " ++ url ++ ")"
 	, warning $ "warning: " ++ message
 	)
 

Command/Indirect.hs

@@ -33,9 +33,9 @@ start :: CommandStart
 start = ifM isDirect
 	( do
 		unlessM (coreSymlinks <$> Annex.getGitConfig) $
-			error "Git is configured to not use symlinks, so you must use direct mode."
+			giveup "Git is configured to not use symlinks, so you must use direct mode."
 		whenM probeCrippledFileSystem $
-			error "This repository seems to be on a crippled filesystem, you must use direct mode."
+			giveup "This repository seems to be on a crippled filesystem, you must use direct mode."
 		next perform
 	, stop
 	)

Command/InitRemote.hs

@@ -26,16 +26,16 @@ seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart
-start [] = error "Specify a name for the remote."
+start [] = giveup "Specify a name for the remote."
 start (name:ws) = ifM (isJust <$> findExisting name)
-	( error $ "There is already a special remote named \"" ++ name ++
+	( giveup $ "There is already a special remote named \"" ++ name ++
 		"\". (Use enableremote to enable an existing special remote.)"
 	, do
 		ifM (isJust <$> Remote.byNameOnly name)
-			( error $ "There is already a remote named \"" ++ name ++ "\""
+			( giveup $ "There is already a remote named \"" ++ name ++ "\""
 			, do
 				let c = newConfig name
-				t <- either error return (findType config)
+				t <- either giveup return (findType config)
 
 				showStart "initremote" name
 				next $ perform t name $ M.union config c

Command/Lock.hs

@@ -79,7 +79,7 @@ performNew file key = do
 		unlessM (sameInodeCache obj (maybeToList mfc)) $ do
 			modifyContent obj $ replaceFile obj $ \tmp -> do
 				unlessM (checkedCopyFile key obj tmp Nothing) $
-					error "unable to lock file"
+					giveup "unable to lock file"
 			Database.Keys.storeInodeCaches key [obj]
 
 	-- Try to repopulate obj from an unmodified associated file.
@@ -115,4 +115,4 @@ performOld file = do
 	next $ return True
 
 errorModified :: a
-errorModified =  error "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"
+errorModified =  giveup "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"

Command/LockContent.hs

@@ -10,6 +10,7 @@ module Command.LockContent where
 import Command
 import Annex.Content
 import Remote.Helper.Ssh (contentLockedMarker)
+import Utility.SimpleProtocol
 
 cmd :: Command
 cmd = noCommit $ 
@@ -32,13 +33,13 @@ start [ks] = do
 		then exitSuccess
 		else exitFailure
   where
-	k = fromMaybe (error "bad key") (file2key ks)
+	k = fromMaybe (giveup "bad key") (file2key ks)
 	locksuccess = ifM (inAnnex k)
 		( liftIO $ do
 			putStrLn contentLockedMarker
 			hFlush stdout
-			_ <- getLine
+			_ <- getProtocolLine stdin
 			return True
 		, return False
 		)
-start _ = error "Specify exactly 1 key."
+start _ = giveup "Specify exactly 1 key."

Command/Log.hs

@@ -93,7 +93,7 @@ seek o = do
 	case (logFiles o, allOption o) of
 		(fs, False) -> withFilesInGit (whenAnnexed $ start o outputter) fs
 		([], True) -> commandAction (startAll o outputter)
-		(_, True) -> error "Cannot specify both files and --all"
+		(_, True) -> giveup "Cannot specify both files and --all"
 
 start :: LogOptions -> (FilePath -> Outputter) -> FilePath -> Key -> CommandStart
 start o outputter file key = do

Command/Map.hs

@@ -47,15 +47,25 @@ start = do
 	liftIO $ writeFile file (drawMap rs trustmap umap)
 	next $ next $
 		ifM (Annex.getState Annex.fast)
-			( do
-				showLongNote $ "left map in " ++ file
-				return True
-			, do
-				showLongNote $ "running: dot -Tx11 " ++ file
-				showOutput
-				liftIO $ boolSystem "dot" [Param "-Tx11", File file]
+			( runViewer file []
+			, runViewer file
+	 			[ ("xdot", [File file])
+				, ("dot", [Param "-Tx11", File file])
+				]	
 			)
 
+runViewer :: FilePath -> [(String, [CommandParam])] -> Annex Bool
+runViewer file [] = do
+	showLongNote $ "left map in " ++ file
+	return True
+runViewer file ((c, ps):rest) = ifM (liftIO $ inPath c)
+	( do
+		showLongNote $ "running: " ++ c ++ unwords (toCommand ps)
+		showOutput
+		liftIO $ boolSystem c ps
+	, runViewer file rest
+	)
+
 {- Generates a graph for dot(1). Each repository, and any other uuids
  - (except for dead ones), are displayed as a node, and each of its
  - remotes is represented as an edge pointing at the node for the remote.

Command/MetaData.hs

@@ -20,6 +20,7 @@ import qualified Data.Text as T
 import qualified Data.ByteString.Lazy.UTF8 as BU
 import Data.Time.Clock.POSIX
 import Data.Aeson
+import Control.Concurrent
 
 cmd :: Command
 cmd = withGlobalOptions ([jsonOption] ++ annexedMatchingOptions) $ 
@@ -65,23 +66,22 @@ optParser desc = MetaDataOptions
 			)
 
 seek :: MetaDataOptions -> CommandSeek
-seek o = do
-	now <- liftIO getPOSIXTime
-	case batchOption o of
-		NoBatch -> do
-			let seeker = case getSet o of
-				Get _ -> withFilesInGit
-				GetAll -> withFilesInGit
-				Set _ -> withFilesInGitNonRecursive
-					"Not recursively setting metadata. Use --force to do that."
-			withKeyOptions (keyOptions o) False
-				(startKeys now o)
-				(seeker $ whenAnnexed $ start now o)
-				(forFiles o)
-		Batch -> withMessageState $ \s -> case outputType s of
-			JSONOutput _ -> batchInput parseJSONInput $
-				commandAction . startBatch now
-			_ -> error "--batch is currently only supported in --json mode"
+seek o = case batchOption o of
+	NoBatch -> do
+		now <- liftIO getPOSIXTime
+		let seeker = case getSet o of
+			Get _ -> withFilesInGit
+			GetAll -> withFilesInGit
+			Set _ -> withFilesInGitNonRecursive
+				"Not recursively setting metadata. Use --force to do that."
+		withKeyOptions (keyOptions o) False
+			(startKeys now o)
+			(seeker $ whenAnnexed $ start now o)
+			(forFiles o)
+	Batch -> withMessageState $ \s -> case outputType s of
+		JSONOutput _ -> batchInput parseJSONInput $
+			commandAction . startBatch
+		_ -> giveup "--batch is currently only supported in --json mode"
 
 start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
 start now o file k = startKeys now o k (mkActionItem afile)
@@ -150,13 +150,13 @@ parseJSONInput i = do
 		(Nothing, Just f) -> Right (Left f, m)
 		(Nothing, Nothing) -> Left "JSON input is missing either file or key"
 
-startBatch :: POSIXTime -> (Either FilePath Key, MetaData) -> CommandStart
-startBatch now (i, (MetaData m)) = case i of
+startBatch :: (Either FilePath Key, MetaData) -> CommandStart
+startBatch (i, (MetaData m)) = case i of
 	Left f -> do
 		mk <- lookupFile f
 		case mk of
 			Just k -> go k (mkActionItem (Just f))
-			Nothing -> error $ "not an annexed file: " ++ f
+			Nothing -> giveup $ "not an annexed file: " ++ f
 	Right k -> go k (mkActionItem k)
   where
 	go k ai = do
@@ -169,6 +169,15 @@ startBatch now (i, (MetaData m)) = case i of
 			, keyOptions = Nothing
 			, batchOption = NoBatch
 			}
+		now <- liftIO getPOSIXTime
+		-- It would be bad if two batch mode changes used exactly
+		-- the same timestamp, since the order of adds and removals
+		-- of the same metadata value would then be indeterminate.
+		-- To guarantee that never happens, delay 1 microsecond,
+		-- so the timestamp will always be different. This is
+		-- probably less expensive than cleaner methods,
+		-- such as taking from a list of increasing timestamps.
+		liftIO $ threadDelay 1
 		next $ perform now o k
 	mkModMeta (f, s)
 		| S.null s = DelMeta f Nothing

Command/Move.hs

@@ -197,4 +197,4 @@ fromPerform src move key afile = ifM (inAnnex key)
 			]
 		ok <- Remote.removeKey src key
 		next $ Command.Drop.cleanupRemote key src ok
-	faileddropremote = error "Unable to drop from remote."
+	faileddropremote = giveup "Unable to drop from remote."

Command/NotifyChanges.hs

@@ -8,15 +8,11 @@
 module Command.NotifyChanges where
 
 import Command
-import Utility.DirWatcher
-import Utility.DirWatcher.Types
-import qualified Git
-import Git.Sha
+import Annex.ChangedRefs
 import RemoteDaemon.Transport.Ssh.Types
+import Utility.SimpleProtocol
 
-import Control.Concurrent
 import Control.Concurrent.Async
-import Control.Concurrent.STM
 
 cmd :: Command
 cmd = noCommit $ 
@@ -28,55 +24,19 @@ seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart
-start = do
-	-- This channel is used to accumulate notifcations,
-	-- because the DirWatcher might have multiple threads that find
-	-- changes at the same time.
-	chan <- liftIO newTChanIO
-	
-	g <- gitRepo
-	let refdir = Git.localGitDir g </> "refs"
-	liftIO $ createDirectoryIfMissing True refdir
-
-	let notifyhook = Just $ notifyHook chan
-	let hooks = mkWatchHooks
-		{ addHook = notifyhook
-		, modifyHook = notifyhook
-		}
-
-	void $ liftIO $ watchDir refdir (const False) True hooks id
-
-	let sender = do
-		send READY
-		forever $ send . CHANGED =<< drain chan
-	
-	-- No messages need to be received from the caller,
-	-- but when it closes the connection, notice and terminate.
-	let receiver = forever $ void getLine
-	void $ liftIO $ concurrently sender receiver
-	stop
-
-notifyHook :: TChan Git.Sha -> FilePath -> Maybe FileStatus -> IO ()
-notifyHook chan reffile _
-	| ".lock" `isSuffixOf` reffile = noop
-	| otherwise = void $ do
-		sha <- catchDefaultIO Nothing $
-			extractSha <$> readFile reffile
-		maybe noop (atomically . writeTChan chan) sha
-
--- When possible, coalesce ref writes that occur closely together
--- in time. Delay up to 0.05 seconds to get more ref writes.
-drain :: TChan Git.Sha -> IO [Git.Sha]
-drain chan = do
-	r <- atomically $ readTChan chan
-	threadDelay 50000
-	rs <- atomically $ drain' chan
-	return (r:rs)
-
-drain' :: TChan Git.Sha -> STM [Git.Sha]
-drain' chan = loop []
+start = go =<< watchChangedRefs
   where
-	loop rs = maybe (return rs) (\r -> loop (r:rs)) =<< tryReadTChan chan
+	go (Just h) = do
+		-- No messages need to be received from the caller,
+		-- but when it closes the connection, notice and terminate.
+		let receiver = forever $ void $ getProtocolLine stdin
+		let sender = forever $ send . CHANGED =<< waitChangedRefs h
+
+		liftIO $ send READY
+		void $ liftIO $ concurrently sender receiver
+		liftIO $ stopWatchingChangedRefs h
+		stop
+	go Nothing = stop
 
 send :: Notification -> IO ()
 send n = do

Command/NumCopies.hs

@@ -23,15 +23,15 @@ seek = withWords start
 start :: [String] -> CommandStart
 start [] = startGet
 start [s] = case readish s of
-	Nothing -> error $ "Bad number: " ++ s
+	Nothing -> giveup $ "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."
+			, giveup "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."
+		| otherwise -> giveup "Number cannot be negative!"
+start _ = giveup "Specify a single number."
 
 startGet :: CommandStart
 startGet = next $ next $ do

Command/P2P.hs

@@ -0,0 +1,302 @@
+{- git-annex command
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.P2P where
+
+import Command
+import P2P.Address
+import P2P.Auth
+import P2P.IO
+import qualified P2P.Protocol as P2P
+import Git.Types
+import qualified Git.Remote
+import qualified Git.Command
+import qualified Annex
+import Annex.UUID
+import Config
+import Utility.AuthToken
+import Utility.Tmp
+import Utility.FileMode
+import Utility.ThreadScheduler
+import qualified Utility.MagicWormhole as Wormhole
+
+import Control.Concurrent.Async
+import qualified Data.Text as T
+
+cmd :: Command
+cmd = command "p2p" SectionSetup
+	"configure peer-2-peer links between repositories"
+	paramNothing (seek <$$> optParser)
+
+data P2POpts
+	= GenAddresses
+	| LinkRemote
+	| Pair
+
+optParser :: CmdParamsDesc -> Parser (P2POpts, Maybe RemoteName)
+optParser _ = (,)
+	<$> (pair <|> linkremote <|> genaddresses)
+	<*> optional name
+  where
+	genaddresses = flag' GenAddresses
+		( long "gen-addresses"
+		<> help "generate addresses that allow accessing this repository over P2P networks"
+		)
+	linkremote = flag' LinkRemote
+		( long "link"
+		<> help "set up a P2P link to a git remote"
+		)
+	pair = flag' Pair
+		( long "pair"
+		<> help "pair with another repository"
+		)
+	name = Git.Remote.makeLegalName <$> strOption
+		( long "name"
+		<> metavar paramName
+		<> help "name of remote"
+		)
+
+seek :: (P2POpts, Maybe RemoteName) -> CommandSeek
+seek (GenAddresses, _) = genAddresses =<< loadP2PAddresses
+seek (LinkRemote, Just name) = commandAction $
+	linkRemote name
+seek (LinkRemote, Nothing) = commandAction $
+	linkRemote =<< unusedPeerRemoteName
+seek (Pair, Just name) = commandAction $
+	startPairing name =<< loadP2PAddresses
+seek (Pair, Nothing) = commandAction $ do
+	name <- unusedPeerRemoteName
+	startPairing name =<< loadP2PAddresses
+
+unusedPeerRemoteName :: Annex RemoteName
+unusedPeerRemoteName = go (1 :: Integer) =<< usednames
+  where
+	usednames = mapMaybe remoteName . remotes <$> Annex.gitRepo
+	go n names = do
+		let name = "peer" ++ show n
+		if name `elem` names
+			then go (n+1) names
+			else return name
+
+-- Only addresses are output to stdout, to allow scripting.
+genAddresses :: [P2PAddress] -> Annex ()
+genAddresses [] = giveup "No P2P networks are currrently available."
+genAddresses addrs = do
+	authtoken <- liftIO $ genAuthToken 128
+	storeP2PAuthToken authtoken
+	earlyWarning "These addresses allow access to this git-annex repository. Only share them with people you trust with that access, using trusted communication channels!"
+	liftIO $ putStr $ unlines $
+		map formatP2PAddress $
+			map (`P2PAddressAuth` authtoken) addrs
+
+-- Address is read from stdin, to avoid leaking it in shell history.
+linkRemote :: RemoteName -> CommandStart
+linkRemote remotename = do
+	showStart "p2p link" remotename
+	next $ next prompt
+  where
+	prompt = do
+		liftIO $ putStrLn ""
+		liftIO $ putStr "Enter peer address: "
+		liftIO $ hFlush stdout
+		s <- liftIO getLine
+		if null s
+			then do
+				liftIO $ hPutStrLn stderr "Nothing entered, giving up."
+				return False
+			else case unformatP2PAddress s of
+				Nothing -> do
+					liftIO $ hPutStrLn stderr "Unable to parse that address, please check its format and try again."
+					prompt
+				Just addr -> do
+					r <- setupLink remotename addr
+					case r of
+						LinkSuccess -> return True
+						ConnectionError e -> giveup e
+						AuthenticationError e -> giveup e
+
+startPairing :: RemoteName -> [P2PAddress] -> CommandStart
+startPairing _ [] = giveup "No P2P networks are currrently available."
+startPairing remotename addrs = do
+	showStart "p2p pair" remotename
+	ifM (liftIO Wormhole.isInstalled)
+		( next $ performPairing remotename addrs
+		, giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/"
+		) 
+
+performPairing :: RemoteName -> [P2PAddress] -> CommandPerform
+performPairing remotename addrs = do
+	-- This note is displayed mainly so when magic wormhole
+	-- complains about possible protocol mismatches or other problems,
+	-- it's clear what's doing the complaining.
+	showNote "using Magic Wormhole"
+	next $ do
+		showOutput
+		r <- wormholePairing remotename addrs ui
+		case r of
+			PairSuccess -> return True
+			SendFailed -> do
+				warning "Failed sending data to pair."
+				return False
+			ReceiveFailed -> do
+				warning "Failed receiving data from pair."
+				return False
+			LinkFailed e -> do
+				warning $ "Failed linking to pair: " ++ e
+				return False
+  where
+	ui observer producer = do
+		ourcode <- Wormhole.waitCode observer
+		putStrLn ""
+		putStrLn $ "This repository's pairing code is: " ++
+			Wormhole.fromCode ourcode
+		putStrLn ""
+		theircode <- getcode ourcode
+		Wormhole.sendCode producer theircode
+	
+	getcode ourcode = do
+		putStr "Enter the other repository's pairing code: "
+		hFlush stdout
+		l <- getLine
+		case Wormhole.toCode l of
+			Just code
+				| code /= ourcode -> do
+					putStrLn "Exchanging pairing data..."
+					return code
+				| otherwise -> do
+					putStrLn "Oops -- You entered this repository's pairing code. We need the pairing code of the *other* repository."
+					getcode ourcode
+			Nothing -> do
+				putStrLn "That does not look like a valid code. Try again..."
+				getcode ourcode
+
+-- We generate half of the authtoken; the pair will provide
+-- the other half.
+newtype HalfAuthToken = HalfAuthToken T.Text
+	deriving (Show)
+
+data PairData = PairData HalfAuthToken [P2PAddress]
+	deriving (Show)
+
+serializePairData :: PairData -> String
+serializePairData (PairData (HalfAuthToken ha) addrs) = unlines $
+	T.unpack ha : map formatP2PAddress addrs
+
+deserializePairData :: String -> Maybe PairData
+deserializePairData s = case lines s of
+	[] -> Nothing
+	(ha:l) -> do
+		addrs <- mapM unformatP2PAddress l
+		return (PairData (HalfAuthToken (T.pack ha)) addrs)
+
+data PairingResult
+	= PairSuccess
+	| SendFailed
+	| ReceiveFailed
+	| LinkFailed String
+
+wormholePairing
+	:: RemoteName
+	-> [P2PAddress]
+	-> (Wormhole.CodeObserver -> Wormhole.CodeProducer -> IO ())
+	-> Annex PairingResult
+wormholePairing remotename ouraddrs ui = do
+	ourhalf <- liftIO $ HalfAuthToken . fromAuthToken
+		<$> genAuthToken 64
+	let ourpairdata = PairData ourhalf ouraddrs
+
+	-- The magic wormhole interface only supports exchanging
+	-- files. Permissions of received files may allow others
+	-- to read them. So, set up a temp directory that only
+	-- we can read.
+	withTmpDir "pair" $ \tmp -> do
+		liftIO $ void $ tryIO $ modifyFileMode tmp $ 
+			removeModes otherGroupModes
+		let sendf = tmp </> "send"
+		let recvf = tmp </> "recv"
+		liftIO $ writeFileProtected sendf $
+			serializePairData ourpairdata
+
+		observer <- liftIO Wormhole.mkCodeObserver
+		producer <- liftIO Wormhole.mkCodeProducer
+		void $ liftIO $ async $ ui observer producer
+		(sendres, recvres) <- liftIO $
+			Wormhole.sendFile sendf observer []
+				`concurrently`
+			Wormhole.receiveFile recvf producer []
+		liftIO $ nukeFile sendf
+		if sendres /= True
+			then return SendFailed
+			else if recvres /= True
+				then return ReceiveFailed
+				else do
+					r <- liftIO $ tryIO $
+						readFileStrict recvf
+					case r of
+						Left _e -> return ReceiveFailed
+						Right s -> maybe 
+							(return ReceiveFailed)
+							(finishPairing 100 remotename ourhalf)
+							(deserializePairData s)
+
+-- | Allow the peer we're pairing with to authenticate to us,
+-- using an authtoken constructed from the two HalfAuthTokens.
+-- Connect to the peer we're pairing with, and try to link to them.
+--
+-- Multiple addresses may have been received for the peer. This only
+-- makes a link to one address.
+--
+-- Since we're racing the peer as they do the same, the first try is likely
+-- to fail to authenticate. Can retry any number of times, to avoid the
+-- users needing to redo the whole process.
+finishPairing :: Int -> RemoteName -> HalfAuthToken -> PairData -> Annex PairingResult
+finishPairing retries remotename (HalfAuthToken ourhalf) (PairData (HalfAuthToken theirhalf) theiraddrs) = do
+	case (toAuthToken (ourhalf <> theirhalf), toAuthToken (theirhalf <> ourhalf)) of
+		(Just ourauthtoken, Just theirauthtoken) -> do
+			liftIO $ putStrLn $ "Successfully exchanged pairing data. Connecting to " ++ remotename ++  "..."
+			storeP2PAuthToken ourauthtoken
+			go retries theiraddrs theirauthtoken
+		_ -> return ReceiveFailed
+  where
+	go 0 [] _ = return $ LinkFailed $ "Unable to connect to " ++ remotename ++ "."
+	go n [] theirauthtoken = do
+		liftIO $ threadDelaySeconds (Seconds 2)
+		liftIO $ putStrLn $ "Unable to connect to " ++ remotename ++ ". Retrying..."
+		go (n-1) theiraddrs theirauthtoken
+	go n (addr:rest) theirauthtoken = do
+		r <- setupLink remotename (P2PAddressAuth addr theirauthtoken)
+		case r of
+			LinkSuccess -> return PairSuccess
+			_ -> go n rest theirauthtoken
+
+data LinkResult
+	= LinkSuccess
+	| ConnectionError String
+	| AuthenticationError String
+
+setupLink :: RemoteName -> P2PAddressAuth -> Annex LinkResult
+setupLink remotename (P2PAddressAuth addr authtoken) = do
+	g <- Annex.gitRepo
+	cv <- liftIO $ tryNonAsync $ connectPeer g addr
+	case cv of
+		Left e -> return $ ConnectionError $ "Unable to connect with peer. Please check that the peer is connected to the network, and try again. ("  ++ show e ++ ")"
+		Right conn -> do
+			u <- getUUID
+			go =<< liftIO (runNetProto conn $ P2P.auth u authtoken)
+  where
+	go (Right (Just theiruuid)) = do
+		ok <- inRepo $ Git.Command.runBool
+			[ Param "remote", Param "add"
+			, Param remotename
+			, Param (formatP2PAddress addr)
+			]
+		when ok $ do
+			storeUUIDIn (remoteConfig remotename "uuid") theiruuid
+			storeP2PRemoteAuthToken addr authtoken
+		return LinkSuccess
+	go (Right Nothing) = return $ AuthenticationError "Unable to authenticate with peer. Please check the address and try again."
+	go (Left e) = return $ AuthenticationError $ "Unable to authenticate with peer: " ++ e

Command/PreCommit.hs

@@ -46,7 +46,7 @@ seek ps = lockPreCommitHook $ ifM isDirect
 			( do
 				(fs, cleanup) <- inRepo $ Git.typeChangedStaged ps
 				whenM (anyM isOldUnlocked fs) $
-					error "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit."
+					giveup "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit."
 				void $ liftIO cleanup
 			, do
 				-- fix symlinks to files being committed

Command/Proxy.hs

@@ -30,7 +30,7 @@ seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart
-start [] = error "Did not specify command to run."
+start [] = giveup "Did not specify command to run."
 start (c:ps) = liftIO . exitWith =<< ifM isDirect
 	( do
 		tmp <- gitAnnexTmpMiscDir <$> gitRepo

Command/ReKey.hs

@@ -25,15 +25,39 @@ cmd = notDirect $
 	command "rekey" SectionPlumbing
 		"change keys used for files"
 		(paramRepeating $ paramPair paramPath paramKey)
-		(withParams seek)
+		(seek <$$> optParser)
 
-seek :: CmdParams -> CommandSeek
-seek = withPairs start
+data ReKeyOptions = ReKeyOptions
+	{ reKeyThese :: CmdParams
+	, batchOption :: BatchMode
+	}
 
-start :: (FilePath, String) -> CommandStart
-start (file, keyname) = ifAnnexed file go stop
+optParser :: CmdParamsDesc -> Parser ReKeyOptions
+optParser desc = ReKeyOptions
+	<$> cmdParams desc
+	<*> parseBatchOption
+
+-- Split on the last space, since a FilePath can contain whitespace,
+-- but a Key very rarely does.
+batchParser :: String -> Either String (FilePath, Key)
+batchParser s = case separate (== ' ') (reverse s) of
+	(rk, rf)
+		| null rk || null rf -> Left "Expected: \"file key\""
+		| otherwise -> case file2key (reverse rk) of
+			Nothing -> Left "bad key"
+			Just k -> Right (reverse rf, k)
+
+seek :: ReKeyOptions -> CommandSeek
+seek o = case batchOption o of
+	Batch -> batchInput batchParser (batchCommandAction . start)
+	NoBatch -> withPairs (start . parsekey) (reKeyThese o)
+  where
+	parsekey (file, skey) =
+		(file, fromMaybe (giveup "bad key") (file2key skey))
+
+start :: (FilePath, Key) -> CommandStart
+start (file, newkey) = ifAnnexed file go stop
   where
-	newkey = fromMaybe (error "bad key") $ file2key keyname
 	go oldkey
 		| oldkey == newkey = stop
 		| otherwise = do
@@ -44,9 +68,9 @@ perform :: FilePath -> Key -> Key -> CommandPerform
 perform file oldkey newkey = do
 	ifM (inAnnex oldkey) 
 		( unlessM (linkKey file oldkey newkey) $
-			error "failed"
+			giveup "failed"
 		, unlessM (Annex.getState Annex.force) $
-			error $ file ++ " is not available (use --force to override)"
+			giveup $ file ++ " is not available (use --force to override)"
 		)
 	next $ cleanup file oldkey newkey
 
@@ -102,6 +126,6 @@ cleanup file oldkey newkey = do
 			Database.Keys.removeAssociatedFile oldkey 
 				=<< inRepo (toTopFilePath file)
 		)
-
-	logStatus newkey InfoPresent
+	whenM (inAnnex newkey) $
+		logStatus newkey InfoPresent
 	return True

Command/ReadPresentKey.hs

@@ -27,5 +27,5 @@ start (ks:us:[]) = do
 		then liftIO exitSuccess
 		else liftIO exitFailure
   where
-	k = fromMaybe (error "bad key") (file2key ks)
-start _ = error "Wrong number of parameters"
+	k = fromMaybe (giveup "bad key") (file2key ks)
+start _ = giveup "Wrong number of parameters"

Command/RegisterUrl.hs

@@ -32,10 +32,10 @@ start (keyname:url:[]) = do
 start [] = do
 	showStart "registerurl" "stdin"
 	next massAdd
-start _ = error "specify a key and an url"
+start _ = giveup "specify a key and an url"
 
 massAdd :: CommandPerform
-massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
+massAdd = go True =<< map (separate (== ' ')) <$> batchLines
   where
 	go status [] = next $ return status
 	go status ((keyname,u):rest) | not (null keyname) && not (null u) = do
@@ -43,7 +43,7 @@ massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
 		ok <- perform' key u
 		let !status' = status && ok
 		go status' rest
-	go _ _ = error "Expected pairs of key and url on stdin, but got something else."
+	go _ _ = giveup "Expected pairs of key and url on stdin, but got something else."
 
 perform :: Key -> URLString -> CommandPerform
 perform key url = do

Command/Reinject.hs

@@ -16,8 +16,7 @@ import Types.KeySource
 cmd :: Command
 cmd = command "reinject" SectionUtility 
 	"inject content of file back into annex"
-	(paramRepeating (paramPair "SRC" "DEST")
-		`paramOr` "--known " ++ paramRepeating "SRC")
+	(paramRepeating (paramPair "SRC" "DEST"))
 	(seek <$$> optParser)
 
 data ReinjectOptions = ReinjectOptions
@@ -47,7 +46,7 @@ startSrcDest (src:dest:[])
 		next $ ifAnnexed dest
 			(\key -> perform src key (verifyKeyContent DefaultVerify UnVerified key src))
 			stop
-startSrcDest _ = error "specify a src file and a dest file"
+startSrcDest _ = giveup "specify a src file and a dest file"
 
 startKnown :: FilePath -> CommandStart
 startKnown src = notAnnexed src $ do
@@ -63,7 +62,8 @@ startKnown src = notAnnexed src $ do
 			)
 
 notAnnexed :: FilePath -> CommandStart -> CommandStart
-notAnnexed src = ifAnnexed src (error $ "cannot used annexed file as src: " ++ src)
+notAnnexed src = ifAnnexed src $
+	giveup $ "cannot used annexed file as src: " ++ src
 
 perform :: FilePath -> Key -> Annex Bool -> CommandPerform
 perform src key verify = ifM move

Command/RemoteDaemon.hs

@@ -1,25 +1,32 @@
 {- git-annex command
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Command.RemoteDaemon where
 
 import Command
 import RemoteDaemon.Core
+import Utility.Daemon
 
 cmd :: Command
-cmd = noCommit $ 
-	command "remotedaemon" SectionPlumbing
-		"detects when remotes have changed, and fetches from them"
-		paramNothing (withParams seek)
+cmd = noCommit $
+	command "remotedaemon" SectionMaintenance
+		"persistent communication with remotes"
+		paramNothing (run <$$> const parseDaemonOptions)
 
-seek :: CmdParams -> CommandSeek
-seek = withNothing start
-
-start :: CommandStart
-start = do
-	liftIO runForeground
-	stop
+run :: DaemonOptions -> CommandSeek
+run o
+	| stopDaemonOption o = error "--stop not implemented for remotedaemon"
+	| foregroundDaemonOption o = liftIO runInteractive
+	| otherwise = do
+#ifndef mingw32_HOST_OS
+		nullfd <- liftIO $ openFd "/dev/null" ReadOnly Nothing defaultFileFlags
+		liftIO $ daemonize nullfd Nothing False runNonInteractive
+#else
+		liftIO $ foreground Nothing runNonInteractive	
+#endif

Command/ResolveMerge.hs

@@ -33,8 +33,8 @@ start = do
 		( do
 			void $ commitResolvedMerge Git.Branch.ManualCommit
 			next $ next $ return True
-		, error "Merge conflict could not be automatically resolved."
+		, giveup "Merge conflict could not be automatically resolved."
 		)
   where
-	nobranch = error "No branch is currently checked out."
-	nomergehead = error "No SHA found in .git/merge_head"
+	nobranch = giveup "No branch is currently checked out."
+	nomergehead = giveup "No SHA found in .git/merge_head"

Command/RmUrl.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -15,13 +15,33 @@ cmd :: Command
 cmd = notBareRepo $
 	command "rmurl" SectionCommon 
 		"record file is not available at url"
-		(paramPair paramFile paramUrl)
-		(withParams seek)
+		(paramRepeating (paramPair paramFile paramUrl))
+		(seek <$$> optParser)
 
-seek :: CmdParams -> CommandSeek
-seek = withPairs start
+data RmUrlOptions = RmUrlOptions
+	{ rmThese :: CmdParams
+	, batchOption :: BatchMode
+	}
 
-start :: (FilePath, String) -> CommandStart
+optParser :: CmdParamsDesc -> Parser RmUrlOptions
+optParser desc = RmUrlOptions
+	<$> cmdParams desc
+	<*> parseBatchOption
+
+seek :: RmUrlOptions -> CommandSeek
+seek o = case batchOption o of
+	Batch -> batchInput batchParser (batchCommandAction . start)
+	NoBatch -> withPairs start (rmThese o)
+
+-- Split on the last space, since a FilePath can contain whitespace,
+-- but a url should not.
+batchParser :: String -> Either String (FilePath, URLString)
+batchParser s = case separate (== ' ') (reverse s) of
+	(ru, rf)
+		| null ru || null rf -> Left "Expected: \"file url\""
+		| otherwise -> Right (reverse rf, reverse ru)
+
+start :: (FilePath, URLString) -> CommandStart
 start (file, url) = flip whenAnnexed file $ \_ key -> do
 	showStart "rmurl" file
 	next $ next $ cleanup url key

Command/Schedule.hs

@@ -29,9 +29,9 @@ start = parse
   where
 	parse (name:[]) = go name performGet
 	parse (name:expr:[]) = go name $ \uuid -> do
-		showStart "schedile" name
+		showStart "schedule" name
 		performSet expr uuid
-	parse _ = error "Specify a repository."
+	parse _ = giveup "Specify a repository."
 
 	go name a = do
 		u <- Remote.nameToUUID name
@@ -47,7 +47,7 @@ performGet uuid = do
 
 performSet :: String -> UUID -> CommandPerform
 performSet expr uuid = case parseScheduledActivities expr of
-	Left e -> error $ "Parse error: " ++ e
+	Left e -> giveup $ "Parse error: " ++ e
 	Right l -> do
 		scheduleSet uuid l
 		next $ return True

Command/SetKey.hs

@@ -23,10 +23,10 @@ start :: [String] -> CommandStart
 start (keyname:file:[]) = do
 	showStart "setkey" file
 	next $ perform file (mkKey keyname)
-start _ = error "specify a key and a content file"
+start _ = giveup "specify a key and a content file"
 
 mkKey :: String -> Key
-mkKey = fromMaybe (error "bad key") . file2key
+mkKey = fromMaybe (giveup "bad key") . file2key
 
 perform :: FilePath -> Key -> CommandPerform
 perform file key = do

Command/SetPresentKey.hs

@@ -26,9 +26,9 @@ start (ks:us:vs:[]) = do
 	showStart' "setpresentkey" k (mkActionItem k)
 	next $ perform k (toUUID us) s
   where
-	k = fromMaybe (error "bad key") (file2key ks)
-	s = fromMaybe (error "bad value") (parseStatus vs)
-start _ = error "Wrong number of parameters"
+	k = fromMaybe (giveup "bad key") (file2key ks)
+	s = fromMaybe (giveup "bad value") (parseStatus vs)
+start _ = giveup "Wrong number of parameters"
 
 perform :: Key -> UUID -> LogStatus -> CommandPerform
 perform k u s = next $ do

Command/Sync.hs

@@ -169,7 +169,15 @@ prepMerge :: Annex ()
 prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
 
 mergeConfig :: [Git.Merge.MergeConfig]	
-mergeConfig = [Git.Merge.MergeNonInteractive]
+mergeConfig = 
+	[ Git.Merge.MergeNonInteractive
+	-- In several situations, unrelated histories should be merged
+	-- together. This includes pairing in the assistant, and merging
+	-- from a remote into a newly created direct mode repo.
+	-- (Once direct mode is removed, this could be changed, so only
+	-- the assistant uses it.)
+	, Git.Merge.MergeUnrelatedHistories
+	]
 
 merge :: CurrBranch -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
 merge (Just b, Just adj) mergeconfig commitmode tomerge =
@@ -287,7 +295,7 @@ updateSyncBranch (Just branch, madj) = do
 
 updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO ()
 updateBranch syncbranch updateto g = 
-	unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch
+	unlessM go $ giveup $ "failed to update " ++ Git.fromRef syncbranch
   where
 	go = Git.Command.runBool
 		[ Param "branch"

Command/TestRemote.hs

@@ -57,7 +57,7 @@ seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o)
 start :: Int -> RemoteName -> CommandStart
 start basesz name = do
 	showStart "testremote" name
-	r <- either error id <$> Remote.byName' name
+	r <- either giveup id <$> Remote.byName' name
 	showAction "generating test keys"
 	fast <- Annex.getState Annex.fast
 	ks <- mapM randKey (keySizes basesz fast)

Command/TransferInfo.hs

@@ -13,6 +13,7 @@ import Types.Transfer
 import Logs.Transfer
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Utility.Metered
+import Utility.SimpleProtocol
 
 cmd :: Command
 cmd = noCommit $ 
@@ -59,7 +60,7 @@ start (k:[]) = do
 				, exitSuccess
 				]
 	stop
-start _ = error "wrong number of parameters"
+start _ = giveup "wrong number of parameters"
 
 readUpdate :: IO (Maybe Integer)
-readUpdate = readish <$> getLine
+readUpdate = maybe Nothing readish <$> getProtocolLine stdin

Command/TransferKeys.hs

@@ -56,10 +56,7 @@ runRequests
 	-> (TransferRequest -> Annex Bool)
 	-> Annex ()
 runRequests readh writeh a = do
-	liftIO $ do
-		hSetBuffering readh NoBuffering
-		fileEncoding readh
-		fileEncoding writeh
+	liftIO $ hSetBuffering readh NoBuffering
 	go =<< readrequests
   where
 	go (d:rn:k:f:rest) = do

Command/Unannex.hs

@@ -45,7 +45,7 @@ wrapUnannex a = ifM (versionSupportsUnlockedPointers <||> isDirect)
 	 -}
 	, ifM cleanindex
 		( lockPreCommitHook $ commit `after` a
-		, error "Cannot proceed with uncommitted changes staged in the index. Recommend you: git commit"
+		, giveup "Cannot proceed with uncommitted changes staged in the index. Recommend you: git commit"
 		)
 	)
   where

Command/Undo.hs

@@ -32,7 +32,7 @@ seek ps = do
 	-- in the index.
 	(fs, cleanup) <- inRepo $ LsFiles.notInRepo False ps
 	unless (null fs) $
-		error $ "Cannot undo changes to files that are not checked into git: " ++ unwords fs
+		giveup $ "Cannot undo changes to files that are not checked into git: " ++ unwords fs
 	void $ liftIO $ cleanup
 
 	-- Committing staged changes before undo allows later

Command/Ungroup.hs

@@ -26,7 +26,7 @@ start (name:g:[]) = do
 	showStart "ungroup" name
 	u <- Remote.nameToUUID name
 	next $ perform u g
-start _ = error "Specify a repository and a group."
+start _ = giveup "Specify a repository and a group."
 
 perform :: UUID -> Group -> CommandPerform
 perform uuid g = do

Command/Uninit.hs

@@ -30,12 +30,12 @@ cmd = addCheck check $
 check :: Annex ()
 check = do
 	b <- current_branch
-	when (b == Annex.Branch.name) $ error $
+	when (b == Annex.Branch.name) $ giveup $
 		"cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out"
 	top <- fromRepo Git.repoPath
 	currdir <- liftIO getCurrentDirectory
 	whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
-		error "can only run uninit from the top of the git repository"
+		giveup "can only run uninit from the top of the git repository"
   where
 	current_branch = Git.Ref . Prelude.head . lines <$> revhead
 	revhead = inRepo $ Git.Command.pipeReadStrict
@@ -51,7 +51,7 @@ seek ps = do
 {- git annex symlinks that are not checked into git could be left by an
  - interrupted add. -}
 startCheckIncomplete :: FilePath -> Key -> CommandStart
-startCheckIncomplete file _ = error $ unlines
+startCheckIncomplete file _ = giveup $ unlines
 	[ file ++ " points to annexed content, but is not checked into git."
 	, "Perhaps this was left behind by an interrupted git annex add?"
 	, "Not continuing with uninit; either delete or git annex add the file and retry."
@@ -65,7 +65,7 @@ finish = do
 	prepareRemoveAnnexDir annexdir
 	if null leftovers
 		then liftIO $ removeDirectoryRecursive annexdir
-		else error $ unlines
+		else giveup $ unlines
 			[ "Not fully uninitialized"
 			, "Some annexed data is still left in " ++ annexobjectdir
 			, "This may include deleted files, or old versions of modified files."

Command/Unused.hs

@@ -320,7 +320,7 @@ unusedSpec m spec
 	range (a, b) = case (readish a, readish b) of
 		(Just x, Just y) -> [x..y]
 		_ -> badspec
-	badspec = error $ "Expected number or range, not \"" ++ spec ++ "\""
+	badspec = giveup $ "Expected number or range, not \"" ++ spec ++ "\""
 
 {- Seek action for unused content. Finds the number in the maps, and
  - calls one of 3 actions, depending on the type of unused file. -}
@@ -335,7 +335,7 @@ startUnused message unused badunused tmpunused maps n = search
 	, (unusedTmpMap maps, tmpunused)
 	]
   where
-	search [] = error $ show n ++ " not valid (run git annex unused for list)"
+	search [] = giveup $ show n ++ " not valid (run git annex unused for list)"
 	search ((m, a):rest) =
 		case M.lookup n m of
 			Nothing -> search rest

Command/VAdd.hs

@@ -33,6 +33,6 @@ start params = do
 				next $ next $ return True
 			Narrowing -> next $ next $ do
 				if visibleViewSize view' == visibleViewSize view
-					then error "That would not add an additional level of directory structure to the view. To filter the view, use vfilter instead of vadd."
+					then giveup "That would not add an additional level of directory structure to the view. To filter the view, use vfilter instead of vadd."
 					else checkoutViewBranch view' narrowView
-			Widening -> error "Widening view to match more files is not currently supported."
+			Widening -> giveup "Widening view to match more files is not currently supported."

Command/VCycle.hs

@@ -25,7 +25,7 @@ seek = withNothing start
 start ::CommandStart
 start = go =<< currentView
   where
-	go Nothing = error "Not in a view."
+	go Nothing = giveup "Not in a view."
 	go (Just v) = do
 		showStart "vcycle" ""
 		let v' = v { viewComponents = vcycle [] (viewComponents v) }

Command/VFilter.hs

@@ -26,5 +26,5 @@ start params = do
 		let view' = filterView view $
 			map parseViewParam $ reverse params
 		next $ next $ if visibleViewSize view' > visibleViewSize view
-			then error "That would add an additional level of directory structure to the view, rather than filtering it. If you want to do that, use vadd instead of vfilter."
+			then giveup "That would add an additional level of directory structure to the view, rather than filtering it. If you want to do that, use vadd instead of vfilter."
 			else checkoutViewBranch view' narrowView

Command/VPop.hs

@@ -26,7 +26,7 @@ seek = withWords start
 start :: [String] -> CommandStart
 start ps = go =<< currentView
   where
-	go Nothing = error "Not in a view."
+	go Nothing = giveup "Not in a view."
 	go (Just v) = do
 		showStart "vpop" (show num)
 		removeView v

Command/Vicfg.hs

@@ -41,7 +41,7 @@ start = do
 	createAnnexDirectory $ parentDir f
 	cfg <- getCfg
 	descs <- uuidDescriptions
-	liftIO $ writeFileAnyEncoding f $ genCfg cfg descs
+	liftIO $ writeFile f $ genCfg cfg descs
 	vicfg cfg f
 	stop
 
@@ -50,12 +50,12 @@ vicfg curcfg f = do
 	vi <- liftIO $ catchDefaultIO "vi" $ getEnv "EDITOR"
 	-- Allow EDITOR to be processed by the shell, so it can contain options.
 	unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $
-		error $ vi ++ " exited nonzero; aborting"
-	r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrictAnyEncoding f)
+		giveup $ vi ++ " exited nonzero; aborting"
+	r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f)
 	liftIO $ nukeFile f
 	case r of
 		Left s -> do
-			liftIO $ writeFileAnyEncoding f s
+			liftIO $ writeFile f s
 			vicfg curcfg f
 		Right newcfg -> setCfg curcfg newcfg
 

Command/View.hs

@@ -25,7 +25,7 @@ seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart
-start [] = error "Specify metadata to include in view"
+start [] = giveup "Specify metadata to include in view"
 start ps = do
 	showStart "view" ""
 	view <- mkView ps
@@ -34,7 +34,7 @@ start ps = do
 	go view Nothing = next $ perform view
 	go view (Just v)
 		| v == view = stop
-		| otherwise = error "Already in a view. Use the vfilter and vadd commands to further refine this view."
+		| otherwise = giveup "Already in a view. Use the vfilter and vadd commands to further refine this view."
 
 perform :: View -> CommandPerform
 perform view = do
@@ -47,7 +47,7 @@ paramView = paramRepeating "FIELD=VALUE"
 mkView :: [String] -> Annex View
 mkView ps = go =<< inRepo Git.Branch.current
   where
-	go Nothing = error "not on any branch!"
+	go Nothing = giveup "not on any branch!"
 	go (Just b) = return $ fst $ refineView (View b []) $
 		map parseViewParam $ reverse ps
 

Command/Wanted.hs

@@ -37,7 +37,7 @@ cmd' name desc getter setter = command name SectionSetup desc pdesc (withParams
 	start (rname:expr:[]) = go rname $ \uuid -> do
 		showStart name rname
 		performSet setter expr uuid
-	start _ = error "Specify a repository."
+	start _ = giveup "Specify a repository."
 		
 	go rname a = do
 		u <- Remote.nameToUUID rname
@@ -52,7 +52,7 @@ performGet getter a = do
 
 performSet :: (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform
 performSet setter expr a = case checkPreferredContentExpression expr of
-	Just e -> error $ "Parse error: " ++ e
+	Just e -> giveup $ "Parse error: " ++ e
 	Nothing -> do
 		setter a expr
 		next $ return True

Command/WebApp.hs

@@ -77,7 +77,7 @@ start' allowauto o = do
 			else annexListen <$> Annex.getGitConfig
 		ifM (checkpid <&&> checkshim f)
 			( if isJust (listenAddress o)
-				then error "The assistant is already running, so --listen cannot be used."
+				then giveup "The assistant is already running, so --listen cannot be used."
 				else do
 					url <- liftIO . readFile
 						=<< fromRepo gitAnnexUrlFile
@@ -125,7 +125,7 @@ startNoRepo o = go =<< liftIO (filterM doesDirectoryExist =<< readAutoStartFile)
 				go ds
 			Right state -> void $ Annex.eval state $ do
 				whenM (fromRepo Git.repoIsLocalBare) $
-					error $ d ++ " is a bare git repository, cannot run the webapp in it"
+					giveup $ d ++ " is a bare git repository, cannot run the webapp in it"
 				callCommandAction $
 					start' False o