version 3.201211123.20121112

338 files changed, 10304 insertions, 5255 deletions

diff --git a/.ghci b/.ghci
index 318bac2..c5550ce 100644
--- a/.ghci
+++ b/.ghci
@@ -1,4 +1 @@
--- make ghci use precompiled modules, and C library
-:set -outputdir=tmp
-:set -IUtility
 :load Common
diff --git a/.gitignore b/.gitignore
index 4dafe01..eb4a997 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,4 @@ cabal-dev
 .dir-locals.el
 # OSX related
 .DS_Store
+.virthualenv
diff --git a/Annex.hs b/Annex.hs
index a4a56f5..7fb8afd 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -5,11 +5,12 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, MultiParamTypeClasses #-}
+{-# LANGUAGE PackageImports, GeneralizedNewtypeDeriving, TypeFamilies, MultiParamTypeClasses #-}
 
 module Annex (
 	Annex,
 	AnnexState(..),
+	FileInfo(..),
 	PreferredContentMap,
 	new,
 	newState,
@@ -29,7 +30,7 @@ module Annex (
 	fromRepo,
 ) where
 
-import Control.Monad.State.Strict
+import "mtl" Control.Monad.State.Strict
 import Control.Monad.Trans.Control (StM, MonadBaseControl, liftBaseWith, restoreM)
 import Control.Monad.Base (liftBase, MonadBase)
 import System.Posix.Types (Fd)
@@ -72,12 +73,17 @@ instance MonadBaseControl IO Annex where
 	liftBaseWith f = Annex $ liftBaseWith $ \runInIO ->
 		f $ liftM StAnnex . runInIO . runAnnex
 	restoreM = Annex . restoreM . unStAnnex
-		where
-			unStAnnex (StAnnex st) = st
+	  where
+		unStAnnex (StAnnex st) = st
 
 type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a)
 
-type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> FilePath -> Annex Bool))
+data FileInfo = FileInfo
+	{ relFile :: FilePath -- may be relative to cwd
+	, matchFile :: FilePath -- filepath to match on; may be relative to top
+	}
+
+type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> FileInfo -> Annex Bool))
 
 -- internal state storage
 data AnnexState = AnnexState
@@ -94,7 +100,8 @@ data AnnexState = AnnexState
 	, checkattrhandle :: Maybe CheckAttrHandle
 	, forcebackend :: Maybe String
 	, forcenumcopies :: Maybe Int
-	, limit :: Matcher (FilePath -> Annex Bool)
+	, limit :: Matcher (FileInfo -> Annex Bool)
+	, uuidmap :: Maybe UUIDMap
 	, preferredcontentmap :: Maybe PreferredContentMap
 	, shared :: Maybe SharedRepository
 	, forcetrust :: TrustMap
@@ -123,6 +130,7 @@ newState gitrepo = AnnexState
 	, forcebackend = Nothing
 	, forcenumcopies = Nothing
 	, limit = Left []
+	, uuidmap = Nothing
 	, preferredcontentmap = Nothing
 	, shared = Nothing
 	, forcetrust = M.empty
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 3b056ee..243514f 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -147,7 +147,6 @@ updateTo pairs = do
 				then updateIndex branchref
 				else commitBranch branchref merge_desc
 					(nub $ fullname:refs)
-			invalidateCache
 			liftIO cleanjournal
 
 {- Gets the content of a file, which may be in the journal, or committed
@@ -168,20 +167,16 @@ getStale :: FilePath -> Annex String
 getStale = get' True
 
 get' :: Bool -> FilePath -> Annex String
-get' staleok file = fromcache =<< getCache file
+get' staleok file = fromjournal =<< getJournalFile file
 	where
-		fromcache (Just content) = return content
-		fromcache Nothing = fromjournal =<< getJournalFile file
-		fromjournal (Just content) = cache content
+		fromjournal (Just content) = return content
 		fromjournal Nothing
 			| staleok = withIndex frombranch
 			| otherwise = do
 				update
-				withIndex $ frombranch >>= cache
-		frombranch = L.unpack <$> catFile fullname file
-		cache content = do
-			setCache file content
-			return content
+				frombranch
+		frombranch = withIndex $
+			L.unpack <$> catFile fullname file
 
 {- Applies a function to modifiy the content of a file.
  -
@@ -191,11 +186,9 @@ get' staleok file = fromcache =<< getCache file
 change :: FilePath -> (String -> String) -> Annex ()
 change file a = lockJournal $ a <$> getStale file >>= set file
 
-{- Records new content of a file into the journal and cache. -}
+{- Records new content of a file into the journal -}
 set :: FilePath -> String -> Annex ()
-set file content = do
-	setJournalFile file content
-	setCache file content
+set file content = setJournalFile file content
 
 {- Stages the journal, and commits staged changes to the branch. -}
 commit :: String -> Annex ()
diff --git a/Annex/BranchState.hs b/Annex/BranchState.hs
index 2e60d12..9b2f9a0 100644
--- a/Annex/BranchState.hs
+++ b/Annex/BranchState.hs
@@ -1,6 +1,6 @@
 {- git-annex branch state management
  -
- - Runtime state about the git-annex branch, including a small read cache.
+ - Runtime state about the git-annex branch.
  -
  - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
  -
@@ -22,22 +22,6 @@ setState state = Annex.changeState $ \s -> s { Annex.branchstate = state }
 changeState :: (BranchState -> BranchState) -> Annex ()
 changeState changer = setState =<< changer <$> getState
 
-setCache :: FilePath -> String -> Annex ()
-setCache file content = changeState $ \s -> s
-	{ cachedFile = Just file, cachedContent = content}
-
-getCache :: FilePath -> Annex (Maybe String)
-getCache file = from <$> getState
-	where
-		from state
-			| cachedFile state == Just file =
-				Just $ cachedContent state
-			| otherwise = Nothing
-
-invalidateCache :: Annex ()
-invalidateCache = changeState $ \s -> s
-	{ cachedFile = Nothing, cachedContent = "" }
-
 {- Runs an action to check that the index file exists, if it's not been
  - checked before in this run of git-annex. -}
 checkIndexOnce :: Annex () -> Annex ()
diff --git a/Annex/Journal.hs b/Annex/Journal.hs
index 4a56ce3..b6ed792 100644
--- a/Annex/Journal.hs
+++ b/Annex/Journal.hs
@@ -1,4 +1,4 @@
-{- management of the git-annex journal and cache
+{- management of the git-annex journal
  -
  - The journal is used to queue up changes before they are committed to the
  - git-annex branch. Amoung other things, it ensures that if git-annex is
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 294270e..2dd73a8 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -99,17 +99,14 @@ sshCleanup = do
 		stopssh socketfile = do
 			let (host, port) = socket2hostport socketfile
 			(_, params) <- sshInfo (host, port)
-			void $ liftIO $ do
-				-- "ssh -O stop" is noisy on stderr even with -q
-				let cmd = unwords $ toCommand $
-					[ Params "-O stop"
-					] ++ params ++ [Param host]
-				boolSystem "sh"
-					[ Param "-c"
-					, Param $ "ssh " ++ cmd ++ " >/dev/null 2>/dev/null"
-					]
-				-- Cannot remove the lock file; other processes may
-				-- be waiting on our exclusive lock to use it.
+			-- "ssh -O stop" is noisy on stderr even with -q
+			void $ liftIO $ catchMaybeIO $
+				withQuietOutput createProcessSuccess $
+					proc "ssh" $ toCommand $
+						[ Params "-O stop"
+						] ++ params ++ [Param host]
+			-- Cannot remove the lock file; other processes may
+			-- be waiting on our exclusive lock to use it.
 
 hostport2socket :: String -> Maybe Integer -> FilePath
 hostport2socket host Nothing = host
diff --git a/Annex/UUID.hs b/Annex/UUID.hs
index df77ac2..16c25c0 100644
--- a/Annex/UUID.hs
+++ b/Annex/UUID.hs
@@ -18,6 +18,7 @@ module Annex.UUID (
 	prepUUID,
 	genUUID,
 	removeRepoUUID,
+	storeUUID,
 ) where
 
 import Common.Annex
diff --git a/Annex/Wanted.hs b/Annex/Wanted.hs
index d7c28ef..1d98cc0 100644
--- a/Annex/Wanted.hs
+++ b/Annex/Wanted.hs
@@ -9,7 +9,6 @@ module Annex.Wanted where
 
 import Common.Annex
 import Logs.PreferredContent
-import Git.FilePath
 import Annex.UUID
 import Types.Remote
 
@@ -18,22 +17,17 @@ import qualified Data.Set as S
 {- Check if a file is preferred content for the local repository. -}
 wantGet :: AssociatedFile -> Annex Bool
 wantGet Nothing = return True
-wantGet (Just file) = do
-	fp <- inRepo $ toTopFilePath file
-	isPreferredContent Nothing S.empty fp
+wantGet (Just file) = isPreferredContent Nothing S.empty file
 
 {- Check if a file is preferred content for a remote. -}
 wantSend :: AssociatedFile -> UUID -> Annex Bool
 wantSend Nothing _ = return True
-wantSend (Just file) to = do
-	fp <- inRepo $ toTopFilePath file
-	isPreferredContent (Just to) S.empty fp
+wantSend (Just file) to = isPreferredContent (Just to) S.empty file
 
 {- Check if a file can be dropped, maybe from a remote.
  - Don't drop files that are preferred content. -}
 wantDrop :: Maybe UUID -> AssociatedFile -> Annex Bool
 wantDrop _ Nothing = return True
 wantDrop from (Just file) = do
-	fp <- inRepo $ toTopFilePath file
 	u <- maybe getUUID (return . id) from
-	not <$> isPreferredContent (Just u) (S.singleton u) fp
+	not <$> isPreferredContent (Just u) (S.singleton u) file
diff --git a/Assistant.hs b/Assistant.hs
index 8b326c8..5b3dd9c 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -66,7 +66,12 @@
  - 	Uses the ScanRemotes map.a
  - Thread 17: PairListener
  - 	Listens for incoming pairing traffic, and takes action.
- - Thread 18: WebApp
+ - Thread 18: ConfigMonitor
+ - 	Triggered by changes to the git-annex branch, checks for changed
+ - 	config files, and reloads configs.
+ - Thread 19: XMPPClient
+ - 	Built-in XMPP client.
+ - Thread 20: WebApp
  - 	Spawns more threads as necessary to handle clients.
  - 	Displays the DaemonStatus.
  -
@@ -97,6 +102,13 @@
  - ScanRemotes (STM TMVar)
  - 	Remotes that have been disconnected, and should be scanned
  - 	are indicated by writing to this TMVar.
+ - BranchChanged (STM SampleVar)
+ - 	Changes to the git-annex branch are indicated by updating this
+ - 	SampleVar.
+ - NetMessager (STM TChan, TMVar, SampleVar)
+ - 	Used to feed messages to the built-in XMPP client, handle
+ - 	pushes, and signal it when it needs to restart due to configuration
+ - 	or networking changes.
  - UrlRenderer (MVar)
  - 	A Yesod route rendering function is stored here. This allows
  - 	things that need to render Yesod routes to block until the webapp
@@ -108,14 +120,9 @@
 module Assistant where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
-import Assistant.Changes
-import Assistant.Commits
-import Assistant.Pushes
-import Assistant.ScanRemotes
-import Assistant.TransferQueue
-import Assistant.TransferSlots
+import Assistant.NamedThread
+import Assistant.Types.ThreadedMonad
 import Assistant.Threads.DaemonStatus
 import Assistant.Threads.Watcher
 import Assistant.Threads.Committer
@@ -128,12 +135,16 @@ import Assistant.Threads.MountWatcher
 import Assistant.Threads.NetWatcher
 import Assistant.Threads.TransferScanner
 import Assistant.Threads.TransferPoller
+import Assistant.Threads.ConfigMonitor
 #ifdef WITH_WEBAPP
 import Assistant.WebApp
 import Assistant.Threads.WebApp
 #ifdef WITH_PAIRING
 import Assistant.Threads.PairListener
 #endif
+#ifdef WITH_XMPP
+import Assistant.Threads.XMPPClient
+#endif
 #else
 #warning Building without the webapp. You probably need to install Yesod..
 #endif
@@ -158,51 +169,52 @@ startDaemon assistant foreground webappwaiter
 		logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile
 		pidfile <- fromRepo gitAnnexPidFile
 		go $ Utility.Daemon.daemonize logfd (Just pidfile) False
-	where
-		go d = startAssistant assistant d webappwaiter
+  where
+	go d = startAssistant assistant d webappwaiter
 
 startAssistant :: Bool -> (IO () -> IO ()) -> Maybe (String -> FilePath -> IO ()) -> Annex ()
 startAssistant assistant daemonize webappwaiter = withThreadState $ \st -> do
 	checkCanWatch
 	dstatus <- startDaemonStatus
-	liftIO $ daemonize $ run dstatus st
-	where
-		run dstatus st = do
-			changechan <- newChangeChan
-			commitchan <- newCommitChan
-			pushmap <- newFailedPushMap
-			transferqueue <- newTransferQueue
-			transferslots <- newTransferSlots
-			scanremotes <- newScanRemoteMap
+	liftIO $ daemonize $
+		flip runAssistant go =<< newAssistantData st dstatus
+  where
+	go = do
+		d <- getAssistant id
 #ifdef WITH_WEBAPP
-			urlrenderer <- newUrlRenderer
+		urlrenderer <- liftIO newUrlRenderer
 #endif
-			mapM_ (startthread dstatus)
-				[ watch $ commitThread st changechan commitchan transferqueue dstatus
+		mapM_ (startthread d)
+			[ watch $ commitThread
 #ifdef WITH_WEBAPP
-				, assist $ webAppThread (Just st) dstatus scanremotes transferqueue transferslots urlrenderer Nothing webappwaiter
+			, assist $ webAppThread d urlrenderer False Nothing webappwaiter
 #ifdef WITH_PAIRING
-				, assist $ pairListenerThread st dstatus scanremotes urlrenderer
+			, assist $ pairListenerThread urlrenderer
+#endif
+#ifdef WITH_XMPP
+			, assist $ xmppClientThread urlrenderer
 #endif
 #endif
-				, assist $ pushThread st dstatus commitchan pushmap
-				, assist $ pushRetryThread st dstatus pushmap
-				, assist $ mergeThread st dstatus transferqueue
-				, assist $ transferWatcherThread st dstatus transferqueue
-				, assist $ transferPollerThread st dstatus
-				, assist $ transfererThread st dstatus transferqueue transferslots
-				, assist $ daemonStatusThread st dstatus
-				, assist $ sanityCheckerThread st dstatus transferqueue changechan
-				, assist $ mountWatcherThread st dstatus scanremotes
-				, assist $ netWatcherThread st dstatus scanremotes
-				, assist $ netWatcherFallbackThread st dstatus scanremotes
-				, assist $ transferScannerThread st dstatus scanremotes transferqueue
-				, watch $ watchThread st dstatus transferqueue changechan
-				]
-			waitForTermination
-		watch a = (True, a)
-		assist a = (False, a)
-		startthread dstatus (watcher, t)
-			| watcher || assistant = void $ forkIO $
-				runNamedThread dstatus t
-			| otherwise = noop
+			, assist $ pushThread
+			, assist $ pushRetryThread
+			, assist $ mergeThread
+			, assist $ transferWatcherThread
+			, assist $ transferPollerThread
+			, assist $ transfererThread
+			, assist $ daemonStatusThread
+			, assist $ sanityCheckerThread
+			, assist $ mountWatcherThread
+			, assist $ netWatcherThread
+			, assist $ netWatcherFallbackThread
+			, assist $ transferScannerThread
+			, assist $ configMonitorThread
+			, watch $ watchThread
+			]
+		liftIO waitForTermination
+
+	watch a = (True, a)
+	assist a = (False, a)
+	startthread d (watcher, t)
+		| watcher || assistant = void $ liftIO $ forkIO $
+			runAssistant d $ runNamedThread t
+		| otherwise = noop
diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index f11ad8f..7e825d8 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE RankNTypes, OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
 
 module Assistant.Alert where
 
@@ -18,6 +18,7 @@ import qualified Data.Text as T
 import Data.Text (Text)
 import qualified Data.Map as M
 import Data.String
+import Yesod
 
 {- Different classes of alerts are displayed differently. -}
 data AlertClass = Success | Message | Activity | Warning | Error
@@ -33,6 +34,7 @@ data AlertName
 	| SanityCheckFixAlert
 	| WarningAlert String
 	| PairAlert String
+	| XMPPNeededAlert
 	deriving (Eq)
 
 {- The first alert is the new alert, the second is an old alert.
@@ -53,13 +55,18 @@ data Alert = Alert
 	, alertButton :: Maybe AlertButton
 	}
 
-data AlertIcon = ActivityIcon | SuccessIcon | ErrorIcon | InfoIcon
+data AlertIcon = ActivityIcon | SuccessIcon | ErrorIcon | InfoIcon | TheCloud
 
-bootstrapIcon :: AlertIcon -> String
-bootstrapIcon ActivityIcon = "refresh"
-bootstrapIcon InfoIcon = "info-sign"
-bootstrapIcon SuccessIcon = "ok"
-bootstrapIcon ErrorIcon = "exclamation-sign"
+htmlIcon :: AlertIcon -> GWidget sub master ()
+htmlIcon ActivityIcon = bootStrapIcon "refresh"
+htmlIcon InfoIcon = bootStrapIcon "info-sign"
+htmlIcon SuccessIcon = bootStrapIcon "ok"
+htmlIcon ErrorIcon = bootStrapIcon "exclamation-sign"
+-- utf-8 umbrella (utf-8 cloud looks too stormy)
+htmlIcon TheCloud = [whamlet|&#9730;|]
+
+bootStrapIcon :: Text -> GWidget sub master ()
+bootStrapIcon name = [whamlet|<i .icon-#{name}></i>|]
 
 {- When clicked, a button always redirects to a URL
  - It may also run an IO action in the background, which is useful
@@ -151,11 +158,11 @@ makeAlertFiller success alert
 		, alertButton = Nothing
 		, alertIcon = Just $ if success then SuccessIcon else ErrorIcon
 		}
-	where
-		c = alertClass alert
-		c'
-			| success = Success
-			| otherwise = Error
+  where
+	c = alertClass alert
+	c'
+		| success = Success
+		| otherwise = Error
 
 isFiller :: Alert -> Bool
 isFiller alert = alertPriority alert == Filler
@@ -172,23 +179,23 @@ isFiller alert = alertPriority alert == Filler
  -}
 mergeAlert :: AlertId -> Alert -> AlertMap -> AlertMap
 mergeAlert i al m = maybe updatePrune updateCombine (alertCombiner al)
-	where
-		pruneSame k al' = k == i || not (effectivelySameAlert al al')
-		pruneBloat m'
-			| bloat > 0 = M.fromList $ pruneold $ M.toList m'
-			| otherwise = m'
-			where
-				bloat = M.size m' - maxAlerts
-				pruneold l =
-			 		let (f, rest) = partition (\(_, a) -> isFiller a) l
-					in drop bloat f ++ rest
-		updatePrune = pruneBloat $ M.filterWithKey pruneSame $
-			M.insertWith' const i al m
-		updateCombine combiner = 
-			let combined = M.mapMaybe (combiner al) m
-			in if M.null combined
-				then updatePrune
-				else M.delete i $ M.union combined m
+  where
+	pruneSame k al' = k == i || not (effectivelySameAlert al al')
+	pruneBloat m'
+		| bloat > 0 = M.fromList $ pruneold $ M.toList m'
+		| otherwise = m'
+	  where
+		bloat = M.size m' - maxAlerts
+		pruneold l =
+	 		let (f, rest) = partition (\(_, a) -> isFiller a) l
+			in drop bloat f ++ rest
+	updatePrune = pruneBloat $ M.filterWithKey pruneSame $
+		M.insertWith' const i al m
+	updateCombine combiner = 
+		let combined = M.mapMaybe (combiner al) m
+		in if M.null combined
+			then updatePrune
+			else M.delete i $ M.union combined m
 
 baseActivityAlert :: Alert
 baseActivityAlert = Alert
@@ -281,10 +288,10 @@ sanityCheckFixAlert msg = Alert
 	, alertCombiner = Just $ dataCombiner (++)
 	, alertButton = Nothing
 	}
-	where
-		render dta = tenseWords $ alerthead : dta ++ [alertfoot]
-		alerthead = "The daily sanity check found and fixed a problem:"
-		alertfoot = "If these problems persist, consider filing a bug report."
+  where
+	render dta = tenseWords $ alerthead : dta ++ [alertfoot]
+	alerthead = "The daily sanity check found and fixed a problem:"
+	alertfoot = "If these problems persist, consider filing a bug report."
 
 pairingAlert :: AlertButton -> Alert
 pairingAlert button = baseActivityAlert
@@ -294,38 +301,53 @@ pairingAlert button = baseActivityAlert
 	}
 
 pairRequestReceivedAlert :: String -> AlertButton -> Alert
-pairRequestReceivedAlert repo button = Alert
+pairRequestReceivedAlert who button = Alert
 	{ alertClass = Message
 	, alertHeader = Nothing
 	, alertMessageRender = tenseWords
-	, alertData = [UnTensed $ T.pack $ repo ++ " is sending a pair request."]
+	, alertData = [UnTensed $ T.pack $ who ++ " is sending a pair request."]
 	, alertBlockDisplay = False
 	, alertPriority = High
 	, alertClosable = True
 	, alertIcon = Just InfoIcon
-	, alertName = Just $ PairAlert repo
+	, alertName = Just $ PairAlert who
 	, alertCombiner = Just $ dataCombiner $ \_old new -> new
 	, alertButton = Just button
 	}
 
 pairRequestAcknowledgedAlert :: String -> Maybe AlertButton -> Alert
-pairRequestAcknowledgedAlert repo button = baseActivityAlert
-	{ alertData = ["Pair request with", UnTensed (T.pack repo), Tensed "in progress" "complete"]
+pairRequestAcknowledgedAlert who button = baseActivityAlert
+	{ alertData = ["Pairing with", UnTensed (T.pack who), Tensed "in progress" "complete"]
 	, alertPriority = High
 	, alertCombiner = Just $ dataCombiner $ \_old new -> new
 	, alertButton = button
 	}
 
+xmppNeededAlert :: AlertButton -> Alert
+xmppNeededAlert button = Alert
+	{ alertHeader = Just "Share with friends, and keep your devices in sync across the cloud."
+	, alertIcon = Just TheCloud
+	, alertPriority = High
+	, alertButton = Just button
+	, alertClosable = True
+	, alertClass = Message
+	, alertMessageRender = tenseWords
+	, alertBlockDisplay = True
+	, alertName = Just $ XMPPNeededAlert
+	, alertCombiner = Just $ dataCombiner $ \_old new -> new
+	, alertData = []
+	}
+
 fileAlert :: TenseChunk -> FilePath -> Alert
 fileAlert msg file = (activityAlert Nothing [f])
 	{ alertName = Just $ FileAlert msg
 	, alertMessageRender = render
 	, alertCombiner = Just $ dataCombiner combiner
 	}
-	where
-		f = fromString $ shortFile $ takeFileName file
-		render fs = tenseWords $ msg : fs
-		combiner new old = take 10 $ new ++ old
+  where
+	f = fromString $ shortFile $ takeFileName file
+	render fs = tenseWords $ msg : fs
+	combiner new old = take 10 $ new ++ old
 
 addFileAlert :: FilePath -> Alert
 addFileAlert = fileAlert (Tensed "Adding" "Added")
@@ -350,8 +372,8 @@ shortFile :: FilePath -> String
 shortFile f
 	| len < maxlen = f
 	| otherwise = take half f ++ ".." ++ drop (len - half) f
-	where
-		len = length f
-		maxlen = 20
-		half = (maxlen - 2) `div` 2 
+  where
+	len = length f
+	maxlen = 20
+	half = (maxlen - 2) `div` 2 
 
diff --git a/Assistant/BranchChange.hs b/Assistant/BranchChange.hs
new file mode 100644
index 0000000..c935454
--- /dev/null
+++ b/Assistant/BranchChange.hs
@@ -0,0 +1,19 @@
+{- git-annex assistant git-annex branch change tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.BranchChange where
+
+import Assistant.Common
+import Assistant.Types.BranchChange
+
+import Control.Concurrent.MSampleVar
+
+branchChanged :: Assistant ()
+branchChanged = flip writeSV () <<~ (fromBranchChangeHandle . branchChangeHandle)
+
+waitBranchChange :: Assistant ()
+waitBranchChange = readSV <<~ (fromBranchChangeHandle . branchChangeHandle)
diff --git a/Assistant/Changes.hs b/Assistant/Changes.hs
index cccc372..3d39568 100644
--- a/Assistant/Changes.hs
+++ b/Assistant/Changes.hs
@@ -7,78 +7,33 @@
 
 module Assistant.Changes where
 
-import Common.Annex
-import qualified Annex.Queue
-import Types.KeySource
+import Assistant.Common
+import Assistant.Types.Changes
 import Utility.TSet
 
 import Data.Time.Clock
 
-data ChangeType = AddChange | LinkChange | RmChange | RmDirChange
-	deriving (Show, Eq)
-
-type ChangeChan = TSet Change
-
-data Change
-	= Change 
-		{ changeTime :: UTCTime
-		, changeFile :: FilePath
-		, changeType :: ChangeType
-		}
-	| PendingAddChange
-		{ changeTime ::UTCTime
-		, changeFile :: FilePath
-		}
-	| InProcessAddChange
-		{ changeTime ::UTCTime
-		, keySource :: KeySource
-		}
-	deriving (Show)
-
-newChangeChan :: IO ChangeChan
-newChangeChan = newTSet
-
 {- Handlers call this when they made a change that needs to get committed. -}
-madeChange :: FilePath -> ChangeType -> Annex (Maybe Change)
-madeChange f t = do
-	-- Just in case the commit thread is not flushing the queue fast enough.
-	Annex.Queue.flushWhenFull
-	liftIO $ Just <$> (Change <$> getCurrentTime <*> pure f <*> pure t)
+madeChange :: FilePath -> ChangeType -> Assistant (Maybe Change)
+madeChange f t = Just <$> (Change <$> liftIO getCurrentTime <*> pure f <*> pure t)
 
-noChange :: Annex (Maybe Change)
+noChange :: Assistant (Maybe Change)
 noChange = return Nothing
 
 {- Indicates an add needs to be done, but has not started yet. -}
-pendingAddChange :: FilePath -> Annex (Maybe Change)
-pendingAddChange f =
-	liftIO $ Just <$> (PendingAddChange <$> getCurrentTime <*> pure f)
-
-isPendingAddChange :: Change -> Bool
-isPendingAddChange (PendingAddChange {}) = True
-isPendingAddChange _ = False
-
-isInProcessAddChange :: Change -> Bool
-isInProcessAddChange (InProcessAddChange {}) = True
-isInProcessAddChange _ = False
-
-finishedChange :: Change -> Change
-finishedChange c@(InProcessAddChange { keySource = ks }) = Change
-	{ changeTime = changeTime c
-	, changeFile = keyFilename ks
-	, changeType = AddChange
-	}
-finishedChange c = c
+pendingAddChange :: FilePath -> Assistant (Maybe Change)
+pendingAddChange f = Just <$> (PendingAddChange <$> liftIO getCurrentTime <*> pure f)
 
 {- Gets all unhandled changes.
  - Blocks until at least one change is made. -}
-getChanges :: ChangeChan -> IO [Change]
-getChanges = getTSet
+getChanges :: Assistant [Change]
+getChanges = getTSet <<~ changeChan
 
 {- Puts unhandled changes back into the channel.
  - Note: Original order is not preserved. -}
-refillChanges :: ChangeChan -> [Change] -> IO ()
-refillChanges = putTSet
+refillChanges :: [Change] -> Assistant ()
+refillChanges cs = flip putTSet cs <<~ changeChan
 
 {- Records a change in the channel. -}
-recordChange :: ChangeChan -> Change -> IO ()
-recordChange = putTSet1
+recordChange :: Change -> Assistant ()
+recordChange c = flip putTSet1 c <<~ changeChan
diff --git a/Assistant/Commits.hs b/Assistant/Commits.hs
index 86fd759..79555fe 100644
--- a/Assistant/Commits.hs
+++ b/Assistant/Commits.hs
@@ -7,28 +7,21 @@
 
 module Assistant.Commits where
 
-import Utility.TSet
-
-import Data.Time.Clock
-
-type CommitChan = TSet Commit
+import Assistant.Common
+import Assistant.Types.Commits
 
-data Commit = Commit UTCTime
-	deriving (Show)
-
-newCommitChan :: IO CommitChan
-newCommitChan = newTSet
+import Utility.TSet
 
 {- Gets all unhandled commits.
  - Blocks until at least one commit is made. -}
-getCommits :: CommitChan -> IO [Commit]
-getCommits = getTSet
+getCommits :: Assistant [Commit]
+getCommits = getTSet <<~ commitChan
 
 {- Puts unhandled commits back into the channel.
  - Note: Original order is not preserved. -}
-refillCommits :: CommitChan -> [Commit] -> IO ()
-refillCommits = putTSet
+refillCommits :: [Commit] -> Assistant ()
+refillCommits cs = flip putTSet cs <<~ commitChan
 
 {- Records a commit in the channel. -}
-recordCommit :: CommitChan -> Commit -> IO ()
-recordCommit = putTSet1
+recordCommit :: Assistant ()
+recordCommit = flip putTSet1 Commit <<~ commitChan
diff --git a/Assistant/Common.hs b/Assistant/Common.hs
index d6df77f..0be5362 100644
--- a/Assistant/Common.hs
+++ b/Assistant/Common.hs
@@ -1,45 +1,13 @@
-{- Common infrastructure for the git-annex assistant threads.
+{- Common infrastructure for the git-annex assistant.
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Assistant.Common (
-	module X,
-	ThreadName,
-	NamedThread(..),
-	runNamedThread,
-	debug
-) where
+module Assistant.Common (module X) where
 
 import Common.Annex as X
-import Assistant.DaemonStatus
-import Assistant.Alert
-
-import System.Log.Logger
-import qualified Control.Exception as E
-
-type ThreadName = String
-data NamedThread = NamedThread ThreadName (IO ())
-
-debug :: ThreadName -> [String] -> IO ()
-debug threadname ws = debugM threadname $ unwords $ (threadname ++ ":") : ws
-
-runNamedThread :: DaemonStatusHandle -> NamedThread -> IO ()
-runNamedThread dstatus (NamedThread name a) = go
-	where
-		go = do
-			r <- E.try a :: IO (Either E.SomeException ())
-			case r of
-				Right _ -> noop
-				Left e -> do
-					let msg = unwords
-						[ name
-						, "crashed:"
-						, show e
-						]
-					hPutStrLn stderr msg
-					-- TODO click to restart
-					void $ addAlert dstatus $
-						warningAlert name msg
+import Assistant.Monad as X
+import Assistant.Types.DaemonStatus as X
+import Assistant.Types.NamedThread as X
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 60b560b..8a4a7a1 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -5,19 +5,18 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP, RankNTypes, ImpredicativeTypes #-}
-
 module Assistant.DaemonStatus where
 
-import Common.Annex
+import Assistant.Common
 import Assistant.Alert
-import Assistant.Pairing
 import Utility.TempFile
+import Assistant.Types.NetMessager
 import Utility.NotificationBroadcaster
 import Logs.Transfer
 import Logs.Trust
 import qualified Remote
 import qualified Types.Remote as Remote
+import qualified Git
 import Config
 
 import Control.Concurrent.STM
@@ -26,83 +25,42 @@ import Data.Time.Clock.POSIX
 import Data.Time
 import System.Locale
 import qualified Data.Map as M
-
-data DaemonStatus = DaemonStatus
-	-- False when the daemon is performing its startup scan
-	{ scanComplete :: Bool
-	-- Time when a previous process of the daemon was running ok
-	, lastRunning :: Maybe POSIXTime
-	-- True when the sanity checker is running
-	, sanityCheckRunning :: Bool
-	-- Last time the sanity checker ran
-	, lastSanityCheck :: Maybe POSIXTime
-	-- Currently running file content transfers
-	, currentTransfers :: TransferMap
-	-- Messages to display to the user.
-	, alertMap :: AlertMap
-	, lastAlertId :: AlertId
-	-- Ordered list of remotes to sync with.
-	, syncRemotes :: [Remote]
-	-- Pairing request that is in progress.
-	, pairingInProgress :: Maybe PairingInProgress
-	-- Broadcasts notifications about all changes to the DaemonStatus
-	, changeNotifier :: NotificationBroadcaster
-	-- Broadcasts notifications when queued or current transfers change.
-	, transferNotifier :: NotificationBroadcaster
-	-- Broadcasts notifications when there's a change to the alerts
-	, alertNotifier :: NotificationBroadcaster
-	}
-
-type TransferMap = M.Map Transfer TransferInfo
-
-{- This TMVar is never left empty, so accessing it will never block. -}
-type DaemonStatusHandle = TMVar DaemonStatus
-
-newDaemonStatus :: IO DaemonStatus
-newDaemonStatus = DaemonStatus
-	<$> pure False
-	<*> pure Nothing
-	<*> pure False
-	<*> pure Nothing
-	<*> pure M.empty
-	<*> pure M.empty
-	<*> pure firstAlertId
-	<*> pure []
-	<*> pure Nothing
-	<*> newNotificationBroadcaster
-	<*> newNotificationBroadcaster
-	<*> newNotificationBroadcaster
-
-getDaemonStatus :: DaemonStatusHandle -> IO DaemonStatus
-getDaemonStatus = atomically . readTMVar
-
-modifyDaemonStatus_ :: DaemonStatusHandle -> (DaemonStatus -> DaemonStatus) -> IO ()
-modifyDaemonStatus_ dstatus a = modifyDaemonStatus dstatus $ \s -> (a s, ())
-
-modifyDaemonStatus :: DaemonStatusHandle -> (DaemonStatus -> (DaemonStatus, b)) -> IO b
-modifyDaemonStatus dstatus a = do
-	(s, b) <- atomically $ do
-		r@(s, _) <- a <$> takeTMVar dstatus
-		putTMVar dstatus s
-		return r
-	sendNotification $ changeNotifier s
-	return b
-
-{- Syncable remotes ordered by cost. -}
-calcSyncRemotes :: Annex [Remote]
+import qualified Data.Text as T
+
+getDaemonStatus :: Assistant DaemonStatus
+getDaemonStatus = (atomically . readTMVar) <<~ daemonStatusHandle
+
+modifyDaemonStatus_ :: (DaemonStatus -> DaemonStatus) -> Assistant ()
+modifyDaemonStatus_ a = modifyDaemonStatus $ \s -> (a s, ())
+
+modifyDaemonStatus :: (DaemonStatus -> (DaemonStatus, b)) -> Assistant b
+modifyDaemonStatus a = do
+	dstatus <- getAssistant daemonStatusHandle
+	liftIO $ do
+		(s, b) <- atomically $ do
+			r@(s, _) <- a <$> takeTMVar dstatus
+			putTMVar dstatus s
+			return r
+		sendNotification $ changeNotifier s
+		return b
+
+{- Returns a function that updates the lists of syncable remotes. -}
+calcSyncRemotes :: Annex (DaemonStatus -> DaemonStatus)
 calcSyncRemotes = do
 	rs <- filterM (repoSyncable . Remote.repo) =<<
 		concat . Remote.byCost <$> Remote.enabledRemoteList
-	alive <- snd <$> trustPartition DeadTrusted (map Remote.uuid rs)
+	alive <- trustExclude DeadTrusted (map Remote.uuid rs)
 	let good r = Remote.uuid r `elem` alive
-	return $ filter good rs
+	let syncable = filter good rs
+	return $ \dstatus -> dstatus
+		{ syncRemotes = syncable
+		, syncGitRemotes = filter (not . Remote.specialRemote) syncable
+		, syncDataRemotes = filter (not . isXMPPRemote) syncable
+		}
 
 {- Updates the sycRemotes list from the list of all remotes in Annex state. -}
-updateSyncRemotes :: DaemonStatusHandle -> Annex ()
-updateSyncRemotes dstatus = do
-	remotes <- calcSyncRemotes
-	liftIO $ modifyDaemonStatus_ dstatus $
-		\s -> s { syncRemotes = remotes }
+updateSyncRemotes :: Assistant ()
+updateSyncRemotes = modifyDaemonStatus_ =<< liftAnnex calcSyncRemotes
 
 {- Load any previous daemon status file, and store it in a MVar for this
  - process to use as its DaemonStatus. Also gets current transfer status. -}
@@ -112,12 +70,11 @@ startDaemonStatus = do
 	status <- liftIO $
 		flip catchDefaultIO (readDaemonStatusFile file) =<< newDaemonStatus
 	transfers <- M.fromList <$> getTransfers
-	remotes <- calcSyncRemotes
-	liftIO $ atomically $ newTMVar status
+	addsync <- calcSyncRemotes
+	liftIO $ atomically $ newTMVar $ addsync $ status
 		{ scanComplete = False
 		, sanityCheckRunning = False
 		, currentTransfers = transfers
-		, syncRemotes = remotes
 		}
 
 {- Don't just dump out the structure, because it will change over time,
@@ -125,34 +82,34 @@ startDaemonStatus = do
 writeDaemonStatusFile :: FilePath -> DaemonStatus -> IO ()
 writeDaemonStatusFile file status = 
 	viaTmp writeFile file =<< serialized <$> getPOSIXTime
-	where
-		serialized now = unlines
-			[ "lastRunning:" ++ show now
-			, "scanComplete:" ++ show (scanComplete status)
-			, "sanityCheckRunning:" ++ show (sanityCheckRunning status)
-			, "lastSanityCheck:" ++ maybe "" show (lastSanityCheck status)
-			]
+  where
+	serialized now = unlines
+		[ "lastRunning:" ++ show now
+		, "scanComplete:" ++ show (scanComplete status)
+		, "sanityCheckRunning:" ++ show (sanityCheckRunning status)
+		, "lastSanityCheck:" ++ maybe "" show (lastSanityCheck status)
+		]
 
 readDaemonStatusFile :: FilePath -> IO DaemonStatus
 readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFile file
-	where
-		parse status = foldr parseline status . lines
-		parseline line status
-			| key == "lastRunning" = parseval readtime $ \v ->
-				status { lastRunning = Just v }
-			| key == "scanComplete" = parseval readish $ \v ->
-				status { scanComplete = v }
-			| key == "sanityCheckRunning" = parseval readish $ \v ->
-				status { sanityCheckRunning = v }
-			| key == "lastSanityCheck" = parseval readtime $ \v ->
-				status { lastSanityCheck = Just v }
-			| otherwise = status -- unparsable line
-			where
-				(key, value) = separate (== ':') line
-				parseval parser a = maybe status a (parser value)
-				readtime s = do
-					d <- parseTime defaultTimeLocale "%s%Qs" s
-					Just $ utcTimeToPOSIXSeconds d
+  where
+	parse status = foldr parseline status . lines
+	parseline line status
+		| key == "lastRunning" = parseval readtime $ \v ->
+			status { lastRunning = Just v }
+		| key == "scanComplete" = parseval readish $ \v ->
+			status { scanComplete = v }
+		| key == "sanityCheckRunning" = parseval readish $ \v ->
+			status { sanityCheckRunning = v }
+		| key == "lastSanityCheck" = parseval readtime $ \v ->
+			status { lastSanityCheck = Just v }
+		| otherwise = status -- unparsable line
+	  where
+		(key, value) = separate (== ':') line
+		parseval parser a = maybe status a (parser value)
+		readtime s = do
+			d <- parseTime defaultTimeLocale "%s%Qs" s
+			Just $ utcTimeToPOSIXSeconds d
 
 {- Checks if a time stamp was made after the daemon was lastRunning.
  -
@@ -164,9 +121,9 @@ readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFile file
  -}
 afterLastDaemonRun :: EpochTime -> DaemonStatus -> Bool
 afterLastDaemonRun timestamp status = maybe False (< t) (lastRunning status)
-	where
-		t = realToFrac (timestamp + slop) :: POSIXTime
-		slop = fromIntegral tenMinutes
+  where
+	t = realToFrac (timestamp + slop) :: POSIXTime
+	slop = fromIntegral tenMinutes
 
 tenMinutes :: Int
 tenMinutes = 10 * 60
@@ -181,91 +138,100 @@ adjustTransfersSTM dstatus a = do
 	putTMVar dstatus $ s { currentTransfers = a (currentTransfers s) }
 
 {- Alters a transfer's info, if the transfer is in the map. -}
-alterTransferInfo :: DaemonStatusHandle -> Transfer -> (TransferInfo -> TransferInfo) -> IO ()
-alterTransferInfo dstatus t a = updateTransferInfo' dstatus $ M.adjust a t
+alterTransferInfo :: Transfer -> (TransferInfo -> TransferInfo) -> Assistant ()
+alterTransferInfo t a = updateTransferInfo' $ M.adjust a t
 
 {- Updates a transfer's info. Adds the transfer to the map if necessary,
  - or if already present, updates it while preserving the old transferTid,
  - transferPaused, and bytesComplete values, which are not written to disk. -}
-updateTransferInfo :: DaemonStatusHandle -> Transfer -> TransferInfo -> IO ()
-updateTransferInfo dstatus t info = updateTransferInfo' dstatus $
-	M.insertWith' merge t info
-	where
-		merge new old = new
-			{ transferTid = maybe (transferTid new) Just (transferTid old)
-			, transferPaused = transferPaused new || transferPaused old
-			, bytesComplete = maybe (bytesComplete new) Just (bytesComplete old)
-			}
+updateTransferInfo :: Transfer -> TransferInfo -> Assistant ()
+updateTransferInfo t info = updateTransferInfo' $ M.insertWith' merge t info
+  where
+	merge new old = new
+		{ transferTid = maybe (transferTid new) Just (transferTid old)
+		, transferPaused = transferPaused new || transferPaused old
+		, bytesComplete = maybe (bytesComplete new) Just (bytesComplete old)
+		}
 
-updateTransferInfo' :: DaemonStatusHandle -> (TransferMap -> TransferMap) -> IO ()
-updateTransferInfo' dstatus a =
-	notifyTransfer dstatus `after` modifyDaemonStatus_ dstatus go
-	where
-		go s = s { currentTransfers = a (currentTransfers s) }
+updateTransferInfo' :: (TransferMap -> TransferMap) -> Assistant ()
+updateTransferInfo' a = notifyTransfer `after` modifyDaemonStatus_ update
+  where
+	update s = s { currentTransfers = a (currentTransfers s) }
 
 {- Removes a transfer from the map, and returns its info. -}
-removeTransfer :: DaemonStatusHandle -> Transfer -> IO (Maybe TransferInfo)
-removeTransfer dstatus t = 
-	notifyTransfer dstatus `after` modifyDaemonStatus dstatus go
-	where
-		go s =
-			let (info, ts) = M.updateLookupWithKey
-				(\_k _v -> Nothing)
-				t (currentTransfers s)
-			in (s { currentTransfers = ts }, info)
+removeTransfer :: Transfer -> Assistant (Maybe TransferInfo)
+removeTransfer t = notifyTransfer `after` modifyDaemonStatus remove
+  where
+	remove s =
+		let (info, ts) = M.updateLookupWithKey
+			(\_k _v -> Nothing)
+			t (currentTransfers s)
+		in (s { currentTransfers = ts }, info)
 
 {- Send a notification when a transfer is changed. -}
-notifyTransfer :: DaemonStatusHandle -> IO ()
-notifyTransfer dstatus = sendNotification
-	=<< transferNotifier <$> atomically (readTMVar dstatus)
+notifyTransfer :: Assistant ()
+notifyTransfer = do
+	dstatus <- getAssistant daemonStatusHandle
+	liftIO $ sendNotification
+		=<< transferNotifier <$> atomically (readTMVar dstatus)
 
 {- Send a notification when alerts are changed. -}
-notifyAlert :: DaemonStatusHandle -> IO ()
-notifyAlert dstatus = sendNotification
-	=<< alertNotifier <$> atomically (readTMVar dstatus)
+notifyAlert :: Assistant ()
+notifyAlert = do
+	dstatus <- getAssistant daemonStatusHandle
+	liftIO $ sendNotification
+		=<< alertNotifier <$> atomically (readTMVar dstatus)
 
 {- Returns the alert's identifier, which can be used to remove it. -}
-addAlert :: DaemonStatusHandle -> Alert -> IO AlertId
-addAlert dstatus alert = notifyAlert dstatus `after` modifyDaemonStatus dstatus go
-	where
-		go s = (s { lastAlertId = i, alertMap = m }, i)
-			where
-				i = nextAlertId $ lastAlertId s
-				m = mergeAlert i alert (alertMap s)
+addAlert :: Alert -> Assistant AlertId
+addAlert alert = notifyAlert `after` modifyDaemonStatus add
+  where
+	add s = (s { lastAlertId = i, alertMap = m }, i)
+	  where
+		i = nextAlertId $ lastAlertId s
+		m = mergeAlert i alert (alertMap s)
 
-removeAlert :: DaemonStatusHandle -> AlertId -> IO ()
-removeAlert dstatus i = updateAlert dstatus i (const Nothing)
+removeAlert :: AlertId -> Assistant ()
+removeAlert i = updateAlert i (const Nothing)
 
-updateAlert :: DaemonStatusHandle -> AlertId -> (Alert -> Maybe Alert) -> IO ()
-updateAlert dstatus i a = updateAlertMap dstatus $ \m -> M.update a i m
+updateAlert :: AlertId -> (Alert -> Maybe Alert) -> Assistant ()
+updateAlert i a = updateAlertMap $ \m -> M.update a i m
 
-updateAlertMap :: DaemonStatusHandle -> (AlertMap -> AlertMap) -> IO ()
-updateAlertMap dstatus a = notifyAlert dstatus `after` modifyDaemonStatus_ dstatus go
-	where
-		go s = s { alertMap = a (alertMap s) }
+updateAlertMap :: (AlertMap -> AlertMap) -> Assistant ()
+updateAlertMap a = notifyAlert `after` modifyDaemonStatus_ update
+  where
+	update s = s { alertMap = a (alertMap s) }
 
 {- Displays an alert while performing an activity that returns True on
  - success.
  -
  - The alert is left visible afterwards, as filler.
  - Old filler is pruned, to prevent the map growing too large. -}
-alertWhile :: DaemonStatusHandle -> Alert -> IO Bool -> IO Bool
-alertWhile dstatus alert a = alertWhile' dstatus alert $ do
+alertWhile :: Alert -> Assistant Bool -> Assistant Bool
+alertWhile alert a = alertWhile' alert $ do
 	r <- a
 	return (r, r)
 
 {- Like alertWhile, but allows the activity to return a value too. -}
-alertWhile' :: DaemonStatusHandle -> Alert -> IO (Bool, a) -> IO a
-alertWhile' dstatus alert a = do
+alertWhile' :: Alert -> Assistant (Bool, a) -> Assistant a
+alertWhile' alert a = do
 	let alert' = alert { alertClass = Activity }
-	i <- addAlert dstatus alert'
+	i <- addAlert alert'
 	(ok, r) <- a
-	updateAlertMap dstatus $ mergeAlert i $ makeAlertFiller ok alert'
+	updateAlertMap $ mergeAlert i $ makeAlertFiller ok alert'
 	return r
 
 {- Displays an alert while performing an activity, then removes it. -}
-alertDuring :: DaemonStatusHandle -> Alert -> IO a -> IO a
-alertDuring dstatus alert a = do
-	let alert' = alert { alertClass = Activity }
-	i <- addAlert dstatus alert'
-	removeAlert dstatus i `after` a
+alertDuring :: Alert -> Assistant a -> Assistant a
+alertDuring alert a = do
+	i <- addAlert $ alert { alertClass = Activity }
+	removeAlert  i `after` a
+
+{- Remotes using the XMPP transport have urls like xmpp::user@host -}
+isXMPPRemote :: Remote -> Bool
+isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r
+  where
+	r = Remote.repo remote
+
+getXMPPClientID :: Remote -> ClientID
+getXMPPClientID r = T.pack $ drop (length "xmpp::") (Git.repoLocation (Remote.repo r))
diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs
new file mode 100644
index 0000000..66e738a
--- /dev/null
+++ b/Assistant/Drop.hs
@@ -0,0 +1,65 @@
+{- git-annex assistant dropping of unwanted content
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Drop where
+
+import Assistant.Common
+import Assistant.DaemonStatus
+import Logs.Location
+import Logs.Trust
+import Types.Remote (AssociatedFile)
+import qualified Remote
+import qualified Command.Drop
+import Command
+import Annex.Wanted
+import Config
+
+{- Drop from local and/or remote when allowed by the preferred content and
+ - numcopies settings. -}
+handleDrops :: Bool -> Key -> AssociatedFile -> Assistant ()
+handleDrops _ _ Nothing = noop
+handleDrops fromhere key f = do
+	syncrs <- syncDataRemotes <$> getDaemonStatus
+	liftAnnex $ do
+		locs <- loggedLocations key
+		handleDrops' locs syncrs fromhere key f
+
+handleDrops' :: [UUID] -> [Remote] -> Bool -> Key -> AssociatedFile -> Annex ()
+handleDrops' _ _ _ _ Nothing = noop
+handleDrops' locs rs fromhere key (Just f)
+	| fromhere = do
+		n <- getcopies
+		if checkcopies n
+			then go rs =<< dropl n
+			else go rs n
+	| otherwise = go rs =<< getcopies
+  where
+	getcopies = do
+		have <- length <$> trustExclude UnTrusted locs
+		numcopies <- getNumCopies =<< numCopies f
+		return (have, numcopies)
+	checkcopies (have, numcopies) = have > numcopies
+	decrcopies (have, numcopies) = (have - 1, numcopies)
+
+	go [] _ = noop
+	go (r:rest) n
+		| checkcopies n = dropr r n >>= go rest
+		| otherwise = noop
+
+	checkdrop n@(_, numcopies) u a = ifM (wantDrop u (Just f))
+		( ifM (doCommand $ a (Just numcopies))
+			( return $ decrcopies n
+			, return n
+			)
+		, return n
+		)
+
+	dropl n = checkdrop n Nothing $ \numcopies ->
+		Command.Drop.startLocal f numcopies key
+
+	dropr r n  = checkdrop n (Just $ Remote.uuid r) $ \numcopies ->
+		Command.Drop.startRemote f numcopies key r
diff --git a/Assistant/Install.hs b/Assistant/Install.hs
index 1bf424c..635c265 100644
--- a/Assistant/Install.hs
+++ b/Assistant/Install.hs
@@ -36,36 +36,35 @@ standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE"
  -}
 ensureInstalled :: IO ()
 ensureInstalled = go =<< standaloneAppBase
-	where
-		go Nothing = noop
-		go (Just base) = do
-			let program = base ++ "runshell git-annex"
-			programfile <- programFile
-			createDirectoryIfMissing True (parentDir programfile)
-			writeFile programfile program
+  where
+	go Nothing = noop
+	go (Just base) = do
+		let program = base ++ "runshell git-annex"
+		programfile <- programFile
+		createDirectoryIfMissing True (parentDir programfile)
+		writeFile programfile program
 
 #ifdef darwin_HOST_OS
-			autostartfile <- userAutoStart osxAutoStartLabel
+		autostartfile <- userAutoStart osxAutoStartLabel
 #else
-			autostartfile <- autoStartPath "git-annex"
-				<$> userConfigDir
+		autostartfile <- autoStartPath "git-annex" <$> userConfigDir
 #endif
-			installAutoStart program autostartfile
+		installAutoStart program autostartfile
 
-			{- This shim is only updated if it doesn't
-			 - already exist with the right content. This
-			 - ensures that there's no race where it would have
-			 - worked, but is unavailable due to being updated. -}
-			sshdir <- sshDir
-			let shim = sshdir </> "git-annex-shell"
-			let content = unlines
-				[ "#!/bin/sh"
-				, "set -e"
-				, "exec", base </> "runshell" ++ 
-				  " git-annex-shell -c \"$SSH_ORIGINAL_COMMAND\""
-				]
-			curr <- catchDefaultIO "" $ readFileStrict shim
-			when (curr /= content) $ do
-				createDirectoryIfMissing True (parentDir shim)
-				writeFile shim content
-				modifyFileMode shim $ addModes [ownerExecuteMode]
+		{- This shim is only updated if it doesn't
+		 - already exist with the right content. This
+		 - ensures that there's no race where it would have
+		 - worked, but is unavailable due to being updated. -}
+		sshdir <- sshDir
+		let shim = sshdir </> "git-annex-shell"
+		let content = unlines
+			[ "#!/bin/sh"
+			, "set -e"
+			, "exec", base </> "runshell" ++ 
+			  " git-annex-shell -c \"$SSH_ORIGINAL_COMMAND\""
+			]
+		curr <- catchDefaultIO "" $ readFileStrict shim
+		when (curr /= content) $ do
+			createDirectoryIfMissing True (parentDir shim)
+			writeFile shim content
+			modifyFileMode shim $ addModes [ownerExecuteMode]
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index 8aa7cb2..479ebd3 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -8,9 +8,6 @@
 module Assistant.MakeRemote where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
-import Assistant.ScanRemotes
 import Assistant.Ssh
 import Assistant.Sync
 import qualified Types.Remote as R
@@ -22,33 +19,33 @@ import qualified Git.Command
 import qualified Command.InitRemote
 import Logs.UUID
 import Logs.Remote
+import Git.Remote
 
 import qualified Data.Text as T
 import qualified Data.Map as M
-import Data.Char
 
 {- Sets up and begins syncing with a new ssh or rsync remote. -}
-makeSshRemote :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> Bool -> SshData -> IO Remote
-makeSshRemote st dstatus scanremotes forcersync sshdata = do
-	r <- runThreadState st $
+makeSshRemote :: Bool -> SshData -> Assistant Remote
+makeSshRemote forcersync sshdata = do
+	r <- liftAnnex $
 		addRemote $ maker (sshRepoName sshdata) sshurl
-	syncNewRemote st dstatus scanremotes r
+	syncNewRemote r
 	return r
-	where
-		rsync = forcersync || rsyncOnly sshdata
-		maker
-			| rsync = makeRsyncRemote
-			| otherwise = makeGitRemote
-		sshurl = T.unpack $ T.concat $
-			if rsync
-				then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
-				else [T.pack "ssh://", u, h, d, T.pack "/"]
-			where
-				u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
-				h = sshHostName sshdata
-				d
-					| T.pack "/" `T.isPrefixOf` sshDirectory sshdata = d
-					| otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
+  where
+	rsync = forcersync || rsyncOnly sshdata
+	maker
+		| rsync = makeRsyncRemote
+		| otherwise = makeGitRemote
+	sshurl = T.unpack $ T.concat $
+		if rsync
+			then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
+			else [T.pack "ssh://", u, h, d, T.pack "/"]
+	  where
+		u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
+		h = sshHostName sshdata
+		d
+			| T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata
+			| otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
 	
 {- Runs an action that returns a name of the remote, and finishes adding it. -}
 addRemote :: Annex String -> Annex Remote
@@ -61,12 +58,12 @@ addRemote a = do
 makeRsyncRemote :: String -> String -> Annex String
 makeRsyncRemote name location = makeRemote name location $
 	const $ makeSpecialRemote name Rsync.remote config
-	where
-		config = M.fromList
-			[ ("encryption", "shared")
-			, ("rsyncurl", location)
-			, ("type", "rsync")
-			]
+  where
+	config = M.fromList
+		[ ("encryption", "shared")
+		, ("rsyncurl", location)
+		, ("type", "rsync")
+		]
 
 {- Inits a special remote. -}
 makeSpecialRemote :: String -> RemoteType -> R.RemoteConfig -> Annex ()
@@ -98,8 +95,8 @@ makeRemote basename location a = do
 			a name
 			return name
 		else return basename
-	where
-		samelocation x = Git.repoLocation x == location
+  where
+	samelocation x = Git.repoLocation x == location
 
 {- Generate an unused name for a remote, adding a number if
  - necessary.
@@ -109,12 +106,10 @@ uniqueRemoteName :: String -> Int -> Git.Repo -> String
 uniqueRemoteName basename n r
 	| null namecollision = name
 	| otherwise = uniqueRemoteName legalbasename (succ n) r
-	where
-		namecollision = filter samename (Git.remotes r)
-		samename x = Git.remoteName x == Just name
-		name
-			| n == 0 = legalbasename
-			| otherwise = legalbasename ++ show n
-		legalbasename = filter legal basename
-		legal '_' = True
-		legal c = isAlphaNum c
+  where
+	namecollision = filter samename (Git.remotes r)
+	samename x = Git.remoteName x == Just name
+	name
+		| n == 0 = legalbasename
+		| otherwise = legalbasename ++ show n
+	legalbasename = makeLegalName basename
diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs
new file mode 100644
index 0000000..a676bc8
--- /dev/null
+++ b/Assistant/Monad.hs
@@ -0,0 +1,120 @@
+{- git-annex assistant monad
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE PackageImports, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
+
+module Assistant.Monad (
+	Assistant,
+	AssistantData(..),
+	newAssistantData,
+	runAssistant,
+	getAssistant,
+	liftAnnex,
+	(<~>),
+	(<<~),
+	asIO,
+	asIO1,
+	asIO2,
+) where
+
+import "mtl" Control.Monad.Reader
+import Control.Monad.Base (liftBase, MonadBase)
+
+import Common.Annex
+import Assistant.Types.ThreadedMonad
+import Assistant.Types.DaemonStatus
+import Assistant.Types.ScanRemotes
+import Assistant.Types.TransferQueue
+import Assistant.Types.TransferSlots
+import Assistant.Types.Pushes
+import Assistant.Types.BranchChange
+import Assistant.Types.Commits
+import Assistant.Types.Changes
+import Assistant.Types.Buddies
+import Assistant.Types.NetMessager
+
+newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a }
+	deriving (
+		Monad,
+		MonadIO,
+		MonadReader AssistantData,
+		Functor,
+		Applicative
+	)
+
+instance MonadBase IO Assistant where
+	liftBase = Assistant . liftBase
+
+data AssistantData = AssistantData
+	{ threadName :: String
+	, threadState :: ThreadState
+	, daemonStatusHandle :: DaemonStatusHandle
+	, scanRemoteMap :: ScanRemoteMap
+	, transferQueue :: TransferQueue
+	, transferSlots :: TransferSlots
+	, failedPushMap :: FailedPushMap
+	, commitChan :: CommitChan
+	, changeChan :: ChangeChan
+	, branchChangeHandle :: BranchChangeHandle
+	, buddyList :: BuddyList
+	, netMessager :: NetMessager
+	}
+
+newAssistantData :: ThreadState -> DaemonStatusHandle -> IO AssistantData
+newAssistantData st dstatus = AssistantData
+	<$> pure "main"
+	<*> pure st
+	<*> pure dstatus
+	<*> newScanRemoteMap
+	<*> newTransferQueue
+	<*> newTransferSlots
+	<*> newFailedPushMap
+	<*> newCommitChan
+	<*> newChangeChan
+	<*> newBranchChangeHandle
+	<*> newBuddyList
+	<*> newNetMessager
+
+runAssistant :: AssistantData -> Assistant a -> IO a
+runAssistant d a = runReaderT (mkAssistant a) d
+
+getAssistant :: (AssistantData -> a) -> Assistant a
+getAssistant = reader
+
+{- Runs an action in the git-annex monad. Note that the same monad state
+ - is shared amoung all assistant threads, so only one of these can run at
+ - a time. Therefore, long-duration actions should be avoided. -}
+liftAnnex :: Annex a -> Assistant a
+liftAnnex a = do
+	st <- reader threadState
+	liftIO $ runThreadState st a
+
+{- Runs an IO action, passing it an IO action that runs an Assistant action. -}
+(<~>) :: (IO a -> IO b) -> Assistant a -> Assistant b
+io <~> a = do
+	d <- reader id
+	liftIO $ io $ runAssistant d a
+
+{- Creates an IO action that will run an Assistant action when run. -}
+asIO :: Assistant a -> Assistant (IO a)
+asIO a = do
+	d <- reader id
+	return $ runAssistant d a
+
+asIO1 :: (a -> Assistant b) -> Assistant (a -> IO b)
+asIO1 a = do
+	d <- reader id
+	return $ \v -> runAssistant d $ a v
+
+asIO2 :: (a -> b -> Assistant c) -> Assistant (a -> b -> IO c)
+asIO2 a = do
+	d <- reader id
+	return $ \v1 v2 -> runAssistant d (a v1 v2)
+
+{- Runs an IO action on a selected field of the AssistantData. -}
+(<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b
+io <<~ v = reader v >>= liftIO . io
diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs
new file mode 100644
index 0000000..083252f
--- /dev/null
+++ b/Assistant/NamedThread.hs
@@ -0,0 +1,30 @@
+{- git-annex assistant named threads.
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.NamedThread where
+
+import Assistant.Common
+import Assistant.DaemonStatus
+import Assistant.Alert
+
+import qualified Control.Exception as E
+
+runNamedThread :: NamedThread -> Assistant ()
+runNamedThread (NamedThread name a) = do
+	d <- getAssistant id
+	liftIO . go $ d { threadName = name }
+  where
+	go d = do
+		r <- E.try (runAssistant d a) :: IO (Either E.SomeException ())
+		case r of
+			Right _ -> noop
+			Left e -> do
+				let msg = unwords [name, "crashed:", show e]
+				hPutStrLn stderr msg
+				-- TODO click to restart
+				runAssistant d $ void $
+					addAlert $ warningAlert name msg
diff --git a/Assistant/NetMessager.hs b/Assistant/NetMessager.hs
new file mode 100644
index 0000000..d9450ad
--- /dev/null
+++ b/Assistant/NetMessager.hs
@@ -0,0 +1,97 @@
+{- git-annex assistant out of band network messager interface
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.NetMessager where
+
+import Assistant.Common
+import Assistant.Types.NetMessager
+import qualified Types.Remote as Remote
+import qualified Git
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Concurrent.MSampleVar
+import Control.Exception as E
+import qualified Data.Set as S
+import qualified Data.Text as T
+
+sendNetMessage :: NetMessage -> Assistant ()
+sendNetMessage m = 
+	(atomically . flip writeTChan m) <<~ (netMessages . netMessager)
+
+waitNetMessage :: Assistant (NetMessage)
+waitNetMessage = (atomically . readTChan) <<~ (netMessages . netMessager)
+
+notifyNetMessagerRestart :: Assistant ()
+notifyNetMessagerRestart =
+	flip writeSV () <<~ (netMessagerRestart . netMessager)
+
+waitNetMessagerRestart :: Assistant ()
+waitNetMessagerRestart = readSV <<~ (netMessagerRestart . netMessager)
+
+{- Runs an action that runs either the send or receive side of a push.
+ -
+ - While the push is running, netMessagesPush will get messages put into it
+ - relating to this push, while any messages relating to other pushes
+ - on the same side go to netMessagesDeferred. Once the push finishes,
+ - those deferred messages will be fed to handledeferred for processing.
+ -}
+runPush :: PushSide -> ClientID -> (NetMessage -> Assistant ()) -> Assistant a -> Assistant a
+runPush side clientid handledeferred a = do
+	nm <- getAssistant netMessager
+	let runningv = getSide side $ netMessagerPushRunning nm
+	let setup = void $ atomically $ swapTMVar runningv $ Just clientid
+	let cleanup = atomically $ do
+		void $ swapTMVar runningv Nothing
+		emptytchan (getSide side $ netMessagesPush nm)
+	r <- E.bracket_ setup cleanup <~> a
+	(void . forkIO) <~> processdeferred nm
+	return r
+  where
+	emptytchan c = maybe noop (const $ emptytchan c) =<< tryReadTChan c
+	processdeferred nm = do
+		s <- liftIO $ atomically $ swapTMVar (getSide side $ netMessagesPushDeferred nm) S.empty
+		mapM_ rundeferred (S.toList s)
+	rundeferred m = (void . (E.try :: (IO () -> IO (Either SomeException ()))))
+		<~> handledeferred m
+
+{- While a push is running, matching push messages are put into
+ - netMessagesPush, while others that involve the same side go to
+ - netMessagesDeferredPush.
+ -
+ - When no push is running involving the same side, returns False.
+ -
+ - To avoid bloating memory, only messages that initiate pushes are
+ - deferred.
+ -}
+queueNetPushMessage :: NetMessage -> Assistant Bool
+queueNetPushMessage m@(Pushing clientid stage) = do
+	nm <- getAssistant netMessager
+	liftIO $ atomically $ do
+		v <- readTMVar (getSide side $ netMessagerPushRunning nm)
+		case v of
+			Nothing -> return False
+			(Just runningclientid)
+				| runningclientid == clientid -> queue nm
+				| isPushInitiation stage -> defer nm
+				| otherwise -> discard
+  where
+	side = pushDestinationSide stage
+	queue nm = do
+		writeTChan (getSide side $ netMessagesPush nm) m
+		return True
+	defer nm = do
+		let mv = getSide side $ netMessagesPushDeferred nm
+		s <- takeTMVar mv
+		putTMVar mv $ S.insert m s
+		return True
+	discard = return True
+queueNetPushMessage _ = return False
+
+waitNetPushMessage :: PushSide -> Assistant (NetMessage)
+waitNetPushMessage side = (atomically . readTChan)
+	<<~ (getSide side . netMessagesPush . netMessager)
diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs
index ab0bef1..38f9981 100644
--- a/Assistant/Pairing/MakeRemote.hs
+++ b/Assistant/Pairing/MakeRemote.hs
@@ -8,9 +8,6 @@
 module Assistant.Pairing.MakeRemote where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
-import Assistant.ScanRemotes
 import Assistant.Ssh
 import Assistant.Pairing
 import Assistant.Pairing.Network
@@ -21,23 +18,22 @@ import qualified Data.Text as T
 
 {- Authorized keys are set up before pairing is complete, so that the other
  - side can immediately begin syncing. -}
-setupAuthorizedKeys :: PairMsg -> IO ()
-setupAuthorizedKeys msg = do
+setupAuthorizedKeys :: PairMsg -> FilePath -> IO ()
+setupAuthorizedKeys msg repodir = do
 	validateSshPubKey pubkey
-	unlessM (liftIO $ addAuthorizedKeys False pubkey) $
+	unlessM (liftIO $ addAuthorizedKeys False repodir pubkey) $
 		error "failed setting up ssh authorized keys"
-	where
-		pubkey = remoteSshPubKey $ pairMsgData msg
+  where
+	pubkey = remoteSshPubKey $ pairMsgData msg
 
-{- When pairing is complete, this is used to set up the remote for the host
- - we paired with. -}
-finishedPairing :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PairMsg -> SshKeyPair -> IO ()
-finishedPairing st dstatus scanremotes msg keypair = do
-	sshdata <- setupSshKeyPair keypair =<< pairMsgToSshData msg
-	{- Ensure that we know
-	 - the ssh host key for the host we paired with.
+{- When local pairing is complete, this is used to set up the remote for
+ - the host we paired with. -}
+finishedLocalPairing :: PairMsg -> SshKeyPair -> Assistant ()
+finishedLocalPairing msg keypair = do
+	sshdata <- liftIO $ setupSshKeyPair keypair =<< pairMsgToSshData msg
+	{- Ensure that we know the ssh host key for the host we paired with.
 	 - If we don't, ssh over to get it. -}
-	unlessM (knownHost $ sshHostName sshdata) $
+	liftIO $ unlessM (knownHost $ sshHostName sshdata) $
 		void $ sshTranscript
 			[ sshOpt "StrictHostKeyChecking" "no"
 			, sshOpt "NumberOfPasswordPrompts" "0"
@@ -46,7 +42,7 @@ finishedPairing st dstatus scanremotes msg keypair = do
 			, "git-annex-shell -c configlist " ++ T.unpack (sshDirectory sshdata)
 			]
 			""
-	void $ makeSshRemote st dstatus scanremotes False sshdata
+	void $ makeSshRemote False sshdata
 
 {- Mostly a straightforward conversion.  Except:
  -  * Determine the best hostname to use to contact the host.
@@ -82,12 +78,12 @@ bestHostName msg = case remoteHostName $ pairMsgData msg of
 			getAddrInfo Nothing (Just localname) Nothing
 		maybe fallback (const $ return localname) (headMaybe addrs)
 	Nothing -> fallback
-	where
-		fallback = do
-			let a = pairMsgAddr msg
-			let sockaddr = case a of
-				IPv4Addr addr -> SockAddrInet (PortNum 0) addr
-				IPv6Addr addr -> SockAddrInet6 (PortNum 0) 0 addr 0
-			fromMaybe (showAddr a)
-				<$> catchDefaultIO Nothing
-					(fst <$> getNameInfo [] True False sockaddr)
+  where
+	fallback = do
+		let a = pairMsgAddr msg
+		let sockaddr = case a of
+			IPv4Addr addr -> SockAddrInet (PortNum 0) addr
+			IPv6Addr addr -> SockAddrInet6 (PortNum 0) 0 addr 0
+		fromMaybe (showAddr a)
+			<$> catchDefaultIO Nothing
+				(fst <$> getNameInfo [] True False sockaddr)
diff --git a/Assistant/Pairing/Network.hs b/Assistant/Pairing/Network.hs
index a6289c0..44a63df 100644
--- a/Assistant/Pairing/Network.hs
+++ b/Assistant/Pairing/Network.hs
@@ -31,11 +31,12 @@ import Control.Concurrent
 pairingPort :: PortNumber
 pairingPort = 55556
 
-{- This is the All Hosts multicast group, which should reach all hosts
- - on the same network segment. -}
+{- Goal: Reach all hosts on the same network segment.
+ - Method: Use same address that avahi uses. Other broadcast addresses seem
+ - to not be let through some routers. -}
 multicastAddress :: SomeAddr -> HostName
-multicastAddress (IPv4Addr _) = "224.0.0.1"
-multicastAddress (IPv6Addr _) = "ff02::1"
+multicastAddress (IPv4Addr _) = "224.0.0.251"
+multicastAddress (IPv6Addr _) = "ff02::fb"
 
 {- Multicasts a message repeatedly on all interfaces, with a 2 second
  - delay between each transmission. The message is repeated forever
@@ -49,47 +50,50 @@ multicastAddress (IPv6Addr _) = "ff02::1"
  -}
 multicastPairMsg :: Maybe Int -> Secret -> PairData -> PairStage -> IO ()
 multicastPairMsg repeats secret pairdata stage = go M.empty repeats
-	where
-		go _ (Just 0) = noop
-		go cache n = do
-			addrs <- activeNetworkAddresses
-			let cache' = updatecache cache addrs
-			mapM_ (sendinterface cache') addrs
-			threadDelaySeconds (Seconds 2)
-			go cache' $ pred <$> n
-		{- The multicast library currently chokes on ipv6 addresses. -}
-		sendinterface _ (IPv6Addr _) = noop
-		sendinterface cache i = void $ catchMaybeIO $
-			withSocketsDo $ bracket setup cleanup use
-			where
-				setup = multicastSender (multicastAddress i) pairingPort
-				cleanup (sock, _) = sClose sock -- FIXME does not work
-				use (sock, addr) = do
-					setInterface sock (showAddr i)
-					maybe noop (\s -> void $ sendTo sock s addr)
-						(M.lookup i cache)
-		updatecache cache [] = cache
-		updatecache cache (i:is)
-			| M.member i cache = updatecache cache is
-			| otherwise = updatecache (M.insert i (show $ mkmsg i) cache) is
-		mkmsg addr = PairMsg $
-			mkVerifiable (stage, pairdata, addr) secret
+  where
+	go _ (Just 0) = noop
+	go cache n = do
+		addrs <- activeNetworkAddresses
+		let cache' = updatecache cache addrs
+		mapM_ (sendinterface cache') addrs
+		threadDelaySeconds (Seconds 2)
+		go cache' $ pred <$> n
+	{- The multicast library currently chokes on ipv6 addresses. -}
+	sendinterface _ (IPv6Addr _) = noop
+	sendinterface cache i = void $ catchMaybeIO $
+		withSocketsDo $ bracket setup cleanup use
+	  where
+		setup = multicastSender (multicastAddress i) pairingPort
+		cleanup (sock, _) = sClose sock -- FIXME does not work
+		use (sock, addr) = do
+			setInterface sock (showAddr i)
+			maybe noop (\s -> void $ sendTo sock s addr)
+				(M.lookup i cache)
+	updatecache cache [] = cache
+	updatecache cache (i:is)
+		| M.member i cache = updatecache cache is
+		| otherwise = updatecache (M.insert i (show $ mkmsg i) cache) is
+	mkmsg addr = PairMsg $
+		mkVerifiable (stage, pairdata, addr) secret
 
-startSending :: DaemonStatusHandle -> PairingInProgress -> PairStage -> (PairStage -> IO ()) -> IO ()
-startSending dstatus pip stage sender = void $ forkIO $ do
-	tid <- myThreadId
-	let pip' = pip { inProgressPairStage = stage, inProgressThreadId = Just tid }
-	oldpip <- modifyDaemonStatus dstatus $
-		\s -> (s { pairingInProgress = Just pip' }, pairingInProgress s)
-	maybe noop stopold oldpip
-	sender stage
-	where
-		stopold = maybe noop killThread . inProgressThreadId
+startSending :: PairingInProgress -> PairStage -> (PairStage -> IO ()) -> Assistant ()
+startSending pip stage sender = do
+	a <- asIO start
+	void $ liftIO $ forkIO a
+  where
+	start = do
+		tid <- liftIO myThreadId
+		let pip' = pip { inProgressPairStage = stage, inProgressThreadId = Just tid }
+		oldpip <- modifyDaemonStatus $
+			\s -> (s { pairingInProgress = Just pip' }, pairingInProgress s)
+		maybe noop stopold oldpip
+		liftIO $ sender stage
+	stopold = maybe noop (liftIO . killThread) . inProgressThreadId
 
-stopSending :: DaemonStatusHandle ->  PairingInProgress -> IO ()
-stopSending dstatus pip = do
-	maybe noop killThread $ inProgressThreadId pip
-	modifyDaemonStatus_ dstatus $ \s -> s { pairingInProgress = Nothing }
+stopSending :: PairingInProgress -> Assistant ()
+stopSending pip = do
+	maybe noop (liftIO . killThread) $ inProgressThreadId pip
+	modifyDaemonStatus_ $ \s -> s { pairingInProgress = Nothing }
 
 class ToSomeAddr a where
 	toSomeAddr :: a -> SomeAddr
@@ -122,5 +126,5 @@ pairRepo msg = concat
 	, ":"
 	, remoteDirectory d
 	]
-	where
-		d = pairMsgData msg
+  where
+	d = pairMsgData msg
diff --git a/Assistant/Pushes.hs b/Assistant/Pushes.hs
index f411dda..9765b6a 100644
--- a/Assistant/Pushes.hs
+++ b/Assistant/Pushes.hs
@@ -7,40 +7,34 @@
 
 module Assistant.Pushes where
 
-import Common.Annex
+import Assistant.Common
+import Assistant.Types.Pushes
 
 import Control.Concurrent.STM
 import Data.Time.Clock
 import qualified Data.Map as M
 
-{- Track the most recent push failure for each remote. -}
-type PushMap = M.Map Remote UTCTime
-type FailedPushMap = TMVar PushMap
-
-{- The TMVar starts empty, and is left empty when there are no
- - failed pushes. This way we can block until there are some failed pushes.
- -}
-newFailedPushMap :: IO FailedPushMap
-newFailedPushMap = atomically newEmptyTMVar
-
 {- Blocks until there are failed pushes.
  - Returns Remotes whose pushes failed a given time duration or more ago.
  - (This may be an empty list.) -}
-getFailedPushesBefore :: FailedPushMap -> NominalDiffTime -> IO [Remote]
-getFailedPushesBefore v duration = do
-	m <- atomically $ readTMVar v
-	now <- getCurrentTime
-	return $ M.keys $ M.filter (not . toorecent now) m
-	where
-		toorecent now time = now `diffUTCTime` time < duration
+getFailedPushesBefore :: NominalDiffTime -> Assistant [Remote]
+getFailedPushesBefore duration = do
+	v <- getAssistant failedPushMap
+	liftIO $ do
+		m <- atomically $ readTMVar v
+		now <- getCurrentTime
+		return $ M.keys $ M.filter (not . toorecent now) m
+  where
+	toorecent now time = now `diffUTCTime` time < duration
 
 {- Modifies the map. -}
-changeFailedPushMap :: FailedPushMap -> (PushMap -> PushMap) -> IO ()
-changeFailedPushMap v a = atomically $
-	store . a . fromMaybe M.empty =<< tryTakeTMVar v
-	where
- 		{- tryTakeTMVar empties the TMVar; refill it only if
-		 - the modified map is not itself empty -}
-		store m
-			| m == M.empty = noop
-			| otherwise = putTMVar v $! m
+changeFailedPushMap :: (PushMap -> PushMap) -> Assistant ()
+changeFailedPushMap a = do
+	v <- getAssistant failedPushMap
+	liftIO $ atomically $ store v . a . fromMaybe M.empty =<< tryTakeTMVar v
+  where
+ 	{- tryTakeTMVar empties the TMVar; refill it only if
+	 - the modified map is not itself empty -}
+	store v m
+		| m == M.empty = noop
+		| otherwise = putTMVar v $! m
diff --git a/Assistant/ScanRemotes.hs b/Assistant/ScanRemotes.hs
index 661c980..2743c0f 100644
--- a/Assistant/ScanRemotes.hs
+++ b/Assistant/ScanRemotes.hs
@@ -7,42 +7,35 @@
 
 module Assistant.ScanRemotes where
 
-import Common.Annex
+import Assistant.Common
+import Assistant.Types.ScanRemotes
 import qualified Types.Remote as Remote
 
 import Data.Function
 import Control.Concurrent.STM
 import qualified Data.Map as M
 
-data ScanInfo = ScanInfo
-	{ scanPriority :: Int
-	, fullScan :: Bool
-	}
-
-type ScanRemoteMap = TMVar (M.Map Remote ScanInfo)
-
-{- The TMVar starts empty, and is left empty when there are no remotes
- - to scan. -}
-newScanRemoteMap :: IO ScanRemoteMap
-newScanRemoteMap = atomically newEmptyTMVar
-
 {- Blocks until there is a remote or remotes that need to be scanned.
  -
  - The list has higher priority remotes listed first. -}
-getScanRemote :: ScanRemoteMap -> IO [(Remote, ScanInfo)]
-getScanRemote v = atomically $
-	reverse . sortBy (compare `on` scanPriority . snd) . M.toList
-		<$> takeTMVar v
+getScanRemote :: Assistant [(Remote, ScanInfo)]
+getScanRemote = do
+	v <- getAssistant scanRemoteMap
+	liftIO $ atomically $
+		reverse . sortBy (compare `on` scanPriority . snd) . M.toList
+			<$> takeTMVar v
 
 {- Adds new remotes that need scanning. -}
-addScanRemotes :: ScanRemoteMap -> Bool -> [Remote] -> IO ()
-addScanRemotes _ _ [] = noop
-addScanRemotes v full rs = atomically $ do
-	m <- fromMaybe M.empty <$> tryTakeTMVar v
-	putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m
-	where
-		info r = ScanInfo (-1 * Remote.cost r) full
-		merge x y = ScanInfo
-			{ scanPriority = max (scanPriority x) (scanPriority y)
-			, fullScan = fullScan x || fullScan y 
-			}
+addScanRemotes :: Bool -> [Remote] -> Assistant ()
+addScanRemotes _ [] = noop
+addScanRemotes full rs = do
+	v <- getAssistant scanRemoteMap
+	liftIO $ atomically $ do
+		m <- fromMaybe M.empty <$> tryTakeTMVar v
+		putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m
+  where
+	info r = ScanInfo (-1 * Remote.cost r) full
+	merge x y = ScanInfo
+		{ scanPriority = max (scanPriority x) (scanPriority y)
+		, fullScan = fullScan x || fullScan y 
+		}
diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs
index 59ed344..01e44f3 100644
--- a/Assistant/Ssh.hs
+++ b/Assistant/Ssh.hs
@@ -9,6 +9,8 @@ module Assistant.Ssh where
 
 import Common.Annex
 import Utility.TempFile
+import Utility.UserInfo
+import Git.Remote
 
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -50,14 +52,11 @@ sshDir = do
 genSshHost :: Text -> Maybe Text -> String
 genSshHost host user = maybe "" (\v -> T.unpack v ++ "@") user ++ T.unpack host
 
-{- host_dir, with all / in dir replaced by _, and bad characters removed -}
+{- Generates a git remote name, like host_dir or host -}
 genSshRepoName :: String -> FilePath -> String
 genSshRepoName host dir
-	| null dir = filter legal host
-	| otherwise = filter legal $ host ++ "_" ++ replace "/" "_" dir
-	where
-		legal '_' = True
-		legal c = isAlphaNum c
+	| null dir = makeLegalName host
+	| otherwise = makeLegalName $ host ++ "_" ++ dir
 
 {- The output of ssh, including both stdout and stderr. -}
 sshTranscript :: [String] -> String -> IO (String, Bool)
@@ -89,30 +88,40 @@ sshTranscript opts input = do
 	hClose readh
 
 	ok <- checkSuccessProcess pid
-	return ()
 	return (transcript, ok)
 
 {- Ensure that the ssh public key doesn't include any ssh options, like
  - command=foo, or other weirdness -}
 validateSshPubKey :: SshPubKey -> IO ()
-validateSshPubKey pubkey = do
-	let ws = words pubkey
-	when (length ws > 3 || length ws < 2) $
-		error $ "wrong number of words in ssh public key " ++ pubkey
-	let (ssh, keytype) = separate (== '-') (ws !! 0)
-	unless (ssh == "ssh" && all isAlphaNum keytype) $
-		error $ "bad ssh public key prefix " ++ ws !! 0
-	when (length ws == 3) $
-		unless (all (\c -> isAlphaNum c || c == '@') (ws !! 2)) $
-			error $ "bad comment in ssh public key " ++ pubkey
-
-addAuthorizedKeys :: Bool -> SshPubKey -> IO Bool
-addAuthorizedKeys rsynconly pubkey = boolSystem "sh"
-	[ Param "-c" , Param $ addAuthorizedKeysCommand rsynconly pubkey ]
-
-removeAuthorizedKeys :: Bool -> SshPubKey -> IO ()
-removeAuthorizedKeys rsynconly pubkey = do
-	let keyline = authorizedKeysLine rsynconly pubkey
+validateSshPubKey pubkey = either error return $ check $ words pubkey
+  where
+	check [prefix, _key, comment] = do
+		checkprefix prefix
+		checkcomment comment
+	check [prefix, _key] =
+		checkprefix prefix
+	check _ = err "wrong number of words in ssh public key"
+
+	ok = Right ()
+	err msg = Left $ unwords [msg, pubkey]
+
+	checkprefix prefix
+		| ssh == "ssh" && all isAlphaNum keytype = ok
+		| otherwise = err "bad ssh public key prefix"
+	  where
+		(ssh, keytype) = separate (== '-') prefix
+
+	checkcomment comment
+		| all (\c -> isAlphaNum c || c == '@' || c == '-' || c == '_') comment = ok
+		| otherwise = err "bad comment in ssh public key"
+
+addAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO Bool
+addAuthorizedKeys rsynconly dir pubkey = boolSystem "sh"
+	[ Param "-c" , Param $ addAuthorizedKeysCommand rsynconly dir pubkey ]
+
+removeAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO ()
+removeAuthorizedKeys rsynconly dir pubkey = do
+	let keyline = authorizedKeysLine rsynconly dir pubkey
 	sshdir <- sshDir
 	let keyfile = sshdir </> ".authorized_keys"
 	ls <- lines <$> readFileStrict keyfile
@@ -124,8 +133,8 @@ removeAuthorizedKeys rsynconly pubkey = do
  - The ~/.ssh/git-annex-shell wrapper script is created if not already
  - present.
  -}
-addAuthorizedKeysCommand :: Bool -> SshPubKey -> String
-addAuthorizedKeysCommand rsynconly pubkey = join "&&"
+addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String
+addAuthorizedKeysCommand rsynconly dir pubkey = join "&&"
 	[ "mkdir -p ~/.ssh"
 	, join "; "
 		[ "if [ ! -e " ++ wrapper ++ " ]"
@@ -137,27 +146,27 @@ addAuthorizedKeysCommand rsynconly pubkey = join "&&"
 	, "chmod 600 ~/.ssh/authorized_keys"
 	, unwords
 		[ "echo"
-		, shellEscape $ authorizedKeysLine rsynconly pubkey
+		, shellEscape $ authorizedKeysLine rsynconly dir pubkey
 		, ">>~/.ssh/authorized_keys"
 		]
 	]
-	where
-		echoval v = "echo " ++ shellEscape v
-		wrapper = "~/.ssh/git-annex-shell"
-		script =
-			[ "#!/bin/sh"
-			, "set -e"
-			, "exec git-annex-shell -c \"$SSH_ORIGINAL_COMMAND\""
-			]
+  where
+	echoval v = "echo " ++ shellEscape v
+	wrapper = "~/.ssh/git-annex-shell"
+	script =
+		[ "#!/bin/sh"
+		, "set -e"
+		, "exec git-annex-shell -c \"$SSH_ORIGINAL_COMMAND\""
+		]
 
-authorizedKeysLine :: Bool -> SshPubKey -> String
-authorizedKeysLine rsynconly pubkey
+authorizedKeysLine :: Bool -> FilePath -> SshPubKey -> String
+authorizedKeysLine rsynconly dir pubkey
 	{- TODO: Locking down rsync is difficult, requiring a rather
 	 - long perl script. -}
 	| rsynconly = pubkey
 	| otherwise = limitcommand ++ pubkey
-	where
-		limitcommand = "command=\"~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding "
+  where
+	limitcommand = "command=\"GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding "
 
 {- Generates a ssh key pair. -}
 genSshKeyPair :: IO SshKeyPair
@@ -201,12 +210,12 @@ setupSshKeyPair sshkeypair sshdata = do
 			]
 
 	return $ sshdata { sshHostName = T.pack mangledhost }
-	where
-		sshprivkeyfile = "key." ++ mangledhost
-		sshpubkeyfile = sshprivkeyfile ++ ".pub"
-		mangledhost = mangleSshHostName
-			(T.unpack $ sshHostName sshdata)
-			(T.unpack <$> sshUserName sshdata)
+  where
+	sshprivkeyfile = "key." ++ mangledhost
+	sshpubkeyfile = sshprivkeyfile ++ ".pub"
+	mangledhost = mangleSshHostName
+		(T.unpack $ sshHostName sshdata)
+		(T.unpack <$> sshUserName sshdata)
 
 mangleSshHostName :: String -> Maybe String -> String
 mangleSshHostName host user = "git-annex-" ++ host ++ (maybe "-" ('-':) user)
@@ -215,8 +224,8 @@ unMangleSshHostName :: String -> String
 unMangleSshHostName h
 	| "git-annex-" `isPrefixOf` h = join "-" (beginning $ drop 2 dashbits)
 	| otherwise = h
-	where
-		dashbits = split "-" h
+  where
+	dashbits = split "-" h
 
 {- Does ssh have known_hosts data for a hostname? -}
 knownHost :: Text -> IO Bool
@@ -226,7 +235,7 @@ knownHost hostname = do
 		( not . null <$> checkhost
 		, return False
 		)
-	where
-		{- ssh-keygen -F can crash on some old known_hosts file -}
-		checkhost = catchDefaultIO "" $
-			readProcess "ssh-keygen" ["-F", T.unpack hostname]
+  where
+	{- ssh-keygen -F can crash on some old known_hosts file -}
+	checkhost = catchDefaultIO "" $
+		readProcess "ssh-keygen" ["-F", T.unpack hostname]
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 6c167e2..ae2b5ea 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -9,8 +9,9 @@ module Assistant.Sync where
 
 import Assistant.Common
 import Assistant.Pushes
+import Assistant.NetMessager
+import Assistant.Types.NetMessager
 import Assistant.Alert
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.ScanRemotes
 import qualified Command.Sync
@@ -36,32 +37,38 @@ import Control.Concurrent
  - the remotes have diverged from the local git-annex branch. Otherwise,
  - it's sufficient to requeue failed transfers.
  -}
-reconnectRemotes :: ThreadName -> ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> [Remote] -> IO ()
-reconnectRemotes _ _ _ _ [] = noop
-reconnectRemotes threadname st dstatus scanremotes rs = void $
-	alertWhile dstatus (syncAlert rs) $ do
+reconnectRemotes :: Bool -> [Remote] -> Assistant ()
+reconnectRemotes _ [] = noop
+reconnectRemotes notifypushes rs = void $ do
+	alertWhile (syncAlert rs) $ do
 		(ok, diverged) <- sync
-			=<< runThreadState st (inRepo Git.Branch.current)
-		addScanRemotes scanremotes diverged rs
+			=<< liftAnnex (inRepo Git.Branch.current)
+		addScanRemotes diverged rs
 		return ok
-	where
-		(gitremotes, _specialremotes) =
-			partition (Git.repoIsUrl . Remote.repo) rs
-		sync (Just branch) = do
-			diverged <- manualPull st (Just branch) gitremotes
-			now <- getCurrentTime
-			ok <- pushToRemotes threadname now st Nothing gitremotes
-			return (ok, diverged)
-		{- No local branch exists yet, but we can try pulling. -}
-		sync Nothing = do
-			diverged <- manualPull st Nothing gitremotes
-			return (True, diverged)
+  where
+	gitremotes = filter (notspecialremote . Remote.repo) rs
+	notspecialremote r
+		| Git.repoIsUrl r = True
+		| Git.repoIsLocal r = True
+		| otherwise = False
+	sync (Just branch) = do
+		diverged <- snd <$> manualPull (Just branch) gitremotes
+		now <- liftIO getCurrentTime
+		ok <- pushToRemotes now notifypushes gitremotes
+		return (ok, diverged)
+	{- No local branch exists yet, but we can try pulling. -}
+	sync Nothing = do
+		diverged <- snd <$> manualPull Nothing gitremotes
+		return (True, diverged)
 
 {- Updates the local sync branch, then pushes it to all remotes, in
  - parallel, along with the git-annex branch. This is the same
  - as "git annex sync", except in parallel, and will co-exist with use of
  - "git annex sync".
  -
+ - After the pushes to normal git remotes, also signals XMPP clients that
+ - they can request an XMPP push.
+ -
  - Avoids running possibly long-duration commands in the Annex monad, so
  - as not to block other threads.
  -
@@ -76,85 +83,95 @@ reconnectRemotes threadname st dstatus scanremotes rs = void $
  - fallback mode, where our push is guarenteed to succeed if the remote is
  - reachable. If the fallback fails, the push is queued to be retried
  - later.
- -
- - The fallback mode pushes to branches on the remote that have our uuid in
- - them. While ugly, those branches are reserved for pushing by us, and
- - so our pushes will succeed.
  -}
-pushToRemotes :: ThreadName -> UTCTime -> ThreadState -> Maybe FailedPushMap -> [Remote] -> IO Bool
-pushToRemotes threadname now st mpushmap remotes = do
-	(g, branch, u) <- runThreadState st $ (,,)
-		<$> gitRepo
-		<*> inRepo Git.Branch.current
-		<*> getUUID
-	go True branch g u remotes
-	where
-		go _ Nothing _ _ _ = return True -- no branch, so nothing to do
-		go shouldretry (Just branch) g u rs =  do
-			debug threadname
-				[ "pushing to"
-				, show rs
-				]
-			Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
-			(succeeded, failed) <- inParallel (push g branch) rs
-			updatemap succeeded []
-			let ok = null failed
-			if ok
-				then return ok
-				else if shouldretry
-					then retry branch g u failed
-					else fallback branch g u failed
+pushToRemotes :: UTCTime -> Bool -> [Remote] -> Assistant Bool
+pushToRemotes now notifypushes remotes = do
+	(g, branch, u) <- liftAnnex $ do
+		Annex.Branch.commit "update"
+		(,,)
+			<$> gitRepo
+			<*> inRepo Git.Branch.current
+			<*> getUUID
+	let (xmppremotes, normalremotes) = partition isXMPPRemote remotes
+	ret <- go True branch g u normalremotes
+	forM_ xmppremotes $ \r ->
+		sendNetMessage $ Pushing (getXMPPClientID r) CanPush
+	return ret
+  where
+	go _ Nothing _ _ _ = return True -- no branch, so nothing to do
+	go _ _ _ _ [] = return True -- no remotes, so nothing to do
+	go shouldretry (Just branch) g u rs =  do
+		debug ["pushing to", show rs]
+		liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
+		(succeeded, failed) <- liftIO $ inParallel (push g branch) rs
+		updatemap succeeded []
+		if null failed
+			then do
+				when notifypushes $
+					sendNetMessage $ NotifyPush $
+						map Remote.uuid succeeded
+				return True
+			else if shouldretry
+				then retry branch g u failed
+				else fallback branch g u failed
 
-		updatemap succeeded failed = case mpushmap of
-			Nothing -> noop
-			Just pushmap -> changeFailedPushMap pushmap $ \m ->
-				M.union (makemap failed) $
-					M.difference m (makemap succeeded)
-		makemap l = M.fromList $ zip l (repeat now)
+	updatemap succeeded failed = changeFailedPushMap $ \m ->
+		M.union (makemap failed) $
+			M.difference m (makemap succeeded)
+	makemap l = M.fromList $ zip l (repeat now)
 
-		retry branch g u rs = do
-			debug threadname [ "trying manual pull to resolve failed pushes" ]
-			void $ manualPull st (Just branch) rs
-			go False (Just branch) g u rs
+	retry branch g u rs = do
+		debug ["trying manual pull to resolve failed pushes"]
+		void $ manualPull (Just branch) rs
+		go False (Just branch) g u rs
 
-		fallback branch g u rs = do
-			debug threadname
-				[ "fallback pushing to"
-				, show rs
-				]
-			(succeeded, failed) <- inParallel (pushfallback g u branch) rs
-			updatemap succeeded failed
-			return $ null failed
-			
-		push g branch remote = Command.Sync.pushBranch remote branch g
-		pushfallback g u branch remote = Git.Command.runBool "push"
-			[ Param $ Remote.name remote
-			, Param $ refspec Annex.Branch.name
-			, Param $ refspec branch
-			] g
-			where
-				{- Push to refs/synced/uuid/branch; this
-				 - avoids cluttering up the branch display. -}
-				refspec b = concat
-					[ s
-					, ":"
-					, "refs/synced/" ++ fromUUID u ++ "/" ++ s
-					]
-					where s = show $ Git.Ref.base b
+	fallback branch g u rs = do
+		debug ["fallback pushing to", show rs]
+		(succeeded, failed) <- liftIO $
+			inParallel (\r -> pushFallback u branch r g) rs
+		updatemap succeeded failed
+		when (notifypushes && (not $ null succeeded)) $
+			sendNetMessage $ NotifyPush $
+				map Remote.uuid succeeded
+		return $ null failed
+		
+	push g branch remote = Command.Sync.pushBranch remote branch g
+
+{- This fallback push mode pushes to branches on the remote that have our
+ - uuid in them. While ugly, those branches are reserved for pushing by us,
+ - and so our pushes will never conflict with other pushes. -}
+pushFallback :: UUID -> Git.Ref -> Remote -> Git.Repo -> IO Bool
+pushFallback u branch remote = Git.Command.runBool "push" params
+  where
+	params = 
+		[ Param $ Remote.name remote
+		, Param $ refspec Annex.Branch.name
+		, Param $ refspec branch
+		]
+	{- Push to refs/synced/uuid/branch; this
+	 - avoids cluttering up the branch display. -}
+	refspec b = concat
+		[ s
+		, ":"
+		, "refs/synced/" ++ fromUUID u ++ "/" ++ s
+		]
+	  where s = show $ Git.Ref.base b
 
 {- Manually pull from remotes and merge their branches. -}
-manualPull :: ThreadState -> Maybe Git.Ref -> [Remote] -> IO Bool
-manualPull st currentbranch remotes = do
-	g <- runThreadState st gitRepo
-	forM_ remotes $ \r ->
+manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Bool], Bool)
+manualPull currentbranch remotes = do
+	g <- liftAnnex gitRepo
+	results <- liftIO $ forM remotes $ \r ->
 		Git.Command.runBool "fetch" [Param $ Remote.name r] g
-	haddiverged <- runThreadState st Annex.Branch.forceUpdate
+	haddiverged <- liftAnnex Annex.Branch.forceUpdate
 	forM_ remotes $ \r ->
-		runThreadState st $ Command.Sync.mergeRemote r currentbranch
-	return haddiverged
+		liftAnnex $ Command.Sync.mergeRemote r currentbranch
+	return (results, haddiverged)
 
 {- Start syncing a newly added remote, using a background thread. -}
-syncNewRemote :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> Remote -> IO ()
-syncNewRemote st dstatus scanremotes remote = do
-	runThreadState st $ updateSyncRemotes dstatus
-	void $ forkIO $ reconnectRemotes "SyncRemote" st dstatus scanremotes [remote]
+syncNewRemote :: Remote -> Assistant ()
+syncNewRemote remote = do
+	updateSyncRemotes
+	thread <- asIO $ do
+		reconnectRemotes False [remote]
+	void $ liftIO $ forkIO $ thread
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 6b036d0..445e44d 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -11,12 +11,12 @@ module Assistant.Threads.Committer where
 
 import Assistant.Common
 import Assistant.Changes
+import Assistant.Types.Changes
 import Assistant.Commits
 import Assistant.Alert
-import Assistant.ThreadedMonad
+import Assistant.DaemonStatus
 import Assistant.Threads.Watcher
 import Assistant.TransferQueue
-import Assistant.DaemonStatus
 import Logs.Transfer
 import qualified Annex.Queue
 import qualified Git.Command
@@ -37,48 +37,39 @@ import Data.Tuple.Utils
 import qualified Data.Set as S
 import Data.Either
 
-thisThread :: ThreadName
-thisThread = "Committer"
-
 {- This thread makes git commits at appropriate times. -}
-commitThread :: ThreadState -> ChangeChan -> CommitChan -> TransferQueue -> DaemonStatusHandle -> NamedThread
-commitThread st changechan commitchan transferqueue dstatus = thread $ do
-	delayadd <- runThreadState st $
+commitThread :: NamedThread
+commitThread = NamedThread "Committer" $ do
+	delayadd <- liftAnnex $
 		maybe delayaddDefault (Just . Seconds) . readish
 			<$> getConfig (annexConfig "delayadd") "" 
-	runEvery (Seconds 1) $ do
+	runEvery (Seconds 1) <~> do
 		-- We already waited one second as a simple rate limiter.
 		-- Next, wait until at least one change is available for
 		-- processing.
-		changes <- getChanges changechan
+		changes <- getChanges
 		-- Now see if now's a good time to commit.
-		time <- getCurrentTime
+		time <- liftIO getCurrentTime
 		if shouldCommit time changes
 			then do
-				readychanges <- handleAdds delayadd st changechan transferqueue dstatus changes
+				readychanges <- handleAdds delayadd changes
 				if shouldCommit time readychanges
 					then do
-						debug thisThread
+						debug
 							[ "committing"
 							, show (length readychanges)
 							, "changes"
 							]
-						void $ alertWhile dstatus commitAlert $
-							runThreadState st commitStaged
-						recordCommit commitchan (Commit time)
+						void $ alertWhile commitAlert $
+							liftAnnex commitStaged
+						recordCommit
 					else refill readychanges
 			else refill changes
-	where
-		thread = NamedThread thisThread
-		refill [] = noop
-		refill cs = do
-			debug thisThread
-				[ "delaying commit of"
-				, show (length cs)
-				, "changes"
-				]
-			refillChanges changechan cs
-			
+  where
+	refill [] = noop
+	refill cs = do
+		debug ["delaying commit of", show (length cs), "changes"]
+		refillChanges cs
 
 commitStaged :: Annex Bool
 commitStaged = do
@@ -99,12 +90,12 @@ commitStaged = do
 			 - each other out, etc. Git returns nonzero on those,
 			 - so don't propigate out commit failures. -}
 			return True
-	where
-		nomessage ps
-			| Git.Version.older "1.7.2" = Param "-m"
-				: Param "autocommit" : ps
-			| otherwise = Param "--allow-empty-message" 
-				: Param "-m" : Param "" : ps
+  where
+	nomessage ps
+		| Git.Version.older "1.7.2" = Param "-m"
+			: Param "autocommit" : ps
+		| otherwise = Param "--allow-empty-message" 
+			: Param "-m" : Param "" : ps
 
 {- Decide if now is a good time to make a commit.
  - Note that the list of change times has an undefined order.
@@ -118,9 +109,9 @@ shouldCommit now changes
 	| len > 10000 = True -- avoid bloating queue too much
 	| length (filter thisSecond changes) < 10 = True
 	| otherwise = False -- batch activity
-	where
-		len = length changes
-		thisSecond c = now `diffUTCTime` changeTime c <= 1
+  where
+	len = length changes
+	thisSecond c = now `diffUTCTime` changeTime c <= 1
 
 {- OSX needs a short delay after a file is added before locking it down,
  - as pasting a file seems to try to set file permissions or otherwise
@@ -152,77 +143,77 @@ delayaddDefault = Nothing
  - Any pending adds that are not ready yet are put back into the ChangeChan,
  - where they will be retried later.
  -}
-handleAdds :: Maybe Seconds -> ThreadState -> ChangeChan -> TransferQueue -> DaemonStatusHandle -> [Change] -> IO [Change]
-handleAdds delayadd st changechan transferqueue dstatus cs = returnWhen (null incomplete) $ do
+handleAdds :: Maybe Seconds -> [Change] -> Assistant [Change]
+handleAdds delayadd cs = returnWhen (null incomplete) $ do
 	let (pending, inprocess) = partition isPendingAddChange incomplete
 	pending' <- findnew pending
-	(postponed, toadd) <- partitionEithers <$> safeToAdd delayadd st pending' inprocess
+	(postponed, toadd) <- partitionEithers <$> safeToAdd delayadd pending' inprocess
 
 	unless (null postponed) $
-		refillChanges changechan postponed
+		refillChanges postponed
 
 	returnWhen (null toadd) $ do
 		added <- catMaybes <$> forM toadd add
 		if DirWatcher.eventsCoalesce || null added
 			then return $ added ++ otherchanges
 			else do
-				r <- handleAdds delayadd st changechan transferqueue dstatus
-					=<< getChanges changechan
+				r <- handleAdds delayadd =<< getChanges
 				return $ r ++ added ++ otherchanges
-	where
-		(incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs
+  where
+	(incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs
 		
-		findnew [] = return []
-		findnew pending = do
-			(!newfiles, cleanup) <- runThreadState st $
-				inRepo (Git.LsFiles.notInRepo False $ map changeFile pending)
-			void cleanup
-			-- note: timestamp info is lost here
-			let ts = changeTime (pending !! 0)
-			return $ map (PendingAddChange ts) newfiles
+	findnew [] = return []
+	findnew pending@(exemplar:_) = do
+		(!newfiles, cleanup) <- liftAnnex $
+			inRepo (Git.LsFiles.notInRepo False $ map changeFile pending)
+		void $ liftIO cleanup
+		-- note: timestamp info is lost here
+		let ts = changeTime exemplar
+		return $ map (PendingAddChange ts) newfiles
 
-		returnWhen c a
-			| c = return otherchanges
-			| otherwise = a
+	returnWhen c a
+		| c = return otherchanges
+		| otherwise = a
 
-		add :: Change -> IO (Maybe Change)
-		add change@(InProcessAddChange { keySource = ks }) =
-			alertWhile' dstatus (addFileAlert $ keyFilename ks) $
-				liftM ret $ catchMaybeIO $
-					sanitycheck ks $ runThreadState st $ do
+	add :: Change -> Assistant (Maybe Change)
+	add change@(InProcessAddChange { keySource = ks }) = do
+		alertWhile' (addFileAlert $ keyFilename ks) $
+			liftM ret $ catchMaybeIO <~> do
+				sanitycheck ks $ do
+					key <- liftAnnex $ do
 						showStart "add" $ keyFilename ks
-						key <- Command.Add.ingest ks
-						done (finishedChange change) (keyFilename ks) key
-			where
-				{- Add errors tend to be transient and will
-				 - be automatically dealt with, so don't
-				 - pass to the alert code. -}
-				ret (Just j@(Just _)) = (True, j)
-				ret _ = (True, Nothing)
-		add _ = return Nothing
+						Command.Add.ingest ks
+					done (finishedChange change) (keyFilename ks) key
+	  where
+		{- Add errors tend to be transient and will be automatically
+		 - dealt with, so don't pass to the alert code. -}
+		ret (Just j@(Just _)) = (True, j)
+		ret _ = (True, Nothing)
+	add _ = return Nothing
 
-		done _ _ Nothing = do
-			showEndFail
-			return Nothing
-		done change file (Just key) = do
-			link <- Command.Add.link file key True
-			when DirWatcher.eventsCoalesce $ do
+	done _ _ Nothing = do
+		liftAnnex showEndFail
+		return Nothing
+	done change file (Just key) = do
+		link <- liftAnnex $ Command.Add.link file key True
+		when DirWatcher.eventsCoalesce $
+			liftAnnex $ do
 				sha <- inRepo $
 					Git.HashObject.hashObject BlobObject link
 				stageSymlink file sha
-			queueTransfers Next transferqueue dstatus key (Just file) Upload
-			showEndOk
-			return $ Just change
+				showEndOk
+		queueTransfers Next key (Just file) Upload
+		return $ Just change
 
-		{- Check that the keysource's keyFilename still exists,
-		 - and is still a hard link to its contentLocation,
-		 - before ingesting it. -}
-		sanitycheck keysource a = do
-			fs <- getSymbolicLinkStatus $ keyFilename keysource
-			ks <- getSymbolicLinkStatus $ contentLocation keysource
-			if deviceID ks == deviceID fs && fileID ks == fileID fs
-				then a
-				else return Nothing
+	{- Check that the keysource's keyFilename still exists,
+	 - and is still a hard link to its contentLocation,
+	 - before ingesting it. -}
+	sanitycheck keysource a = do
+		fs <- liftIO $ getSymbolicLinkStatus $ keyFilename keysource
+		ks <- liftIO $ getSymbolicLinkStatus $ contentLocation keysource
+		if deviceID ks == deviceID fs && fileID ks == fileID fs
+			then a
+			else return Nothing
 
 {- Files can Either be Right to be added now,
  - or are unsafe, and must be Left for later.
@@ -230,11 +221,11 @@ handleAdds delayadd st changechan transferqueue dstatus cs = returnWhen (null in
  - Check by running lsof on the temp directory, which
  - the KeySources are locked down in.
  -}
-safeToAdd :: Maybe Seconds -> ThreadState -> [Change] -> [Change] -> IO [Either Change Change]
-safeToAdd _ _ [] [] = return []
-safeToAdd delayadd st pending inprocess = do
-	maybe noop threadDelaySeconds delayadd
-	runThreadState st $ do
+safeToAdd :: Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
+safeToAdd _ [] [] = return []
+safeToAdd delayadd pending inprocess = do
+	maybe noop (liftIO . threadDelaySeconds) delayadd
+	liftAnnex $ do
 		keysources <- mapM Command.Add.lockDown (map changeFile pending)
 		let inprocess' = map mkinprocess (zip pending keysources)
 		tmpdir <- fromRepo gitAnnexTmpDir
@@ -250,25 +241,24 @@ safeToAdd delayadd st pending inprocess = do
 				mapM_ canceladd $ lefts checked
 				allRight $ rights checked
 			else return checked
-	where
-		check openfiles change@(InProcessAddChange { keySource = ks })
-			| S.member (contentLocation ks) openfiles = Left change
-		check _ change = Right change
+  where
+	check openfiles change@(InProcessAddChange { keySource = ks })
+		| S.member (contentLocation ks) openfiles = Left change
+	check _ change = Right change
 
-		mkinprocess (c, ks) = InProcessAddChange
-			{ changeTime = changeTime c
-			, keySource = ks
-			}
+	mkinprocess (c, ks) = InProcessAddChange
+		{ changeTime = changeTime c
+		, keySource = ks
+		}
 
-		canceladd (InProcessAddChange { keySource = ks }) = do
-			warning $ keyFilename ks
-				++ " still has writers, not adding"
-			-- remove the hard link
-			void $ liftIO $ tryIO $
-				removeFile $ contentLocation ks
-		canceladd _ = noop
+	canceladd (InProcessAddChange { keySource = ks }) = do
+		warning $ keyFilename ks
+			++ " still has writers, not adding"
+		-- remove the hard link
+		void $ liftIO $ tryIO $ removeFile $ contentLocation ks
+	canceladd _ = noop
 
-		openwrite (_file, mode, _pid) =
-			mode == Lsof.OpenWriteOnly || mode == Lsof.OpenReadWrite
+	openwrite (_file, mode, _pid) =
+		mode == Lsof.OpenWriteOnly || mode == Lsof.OpenReadWrite
 
-		allRight = return . map Right
+	allRight = return . map Right
diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs
new file mode 100644
index 0000000..2d012ad
--- /dev/null
+++ b/Assistant/Threads/ConfigMonitor.hs
@@ -0,0 +1,88 @@
+{- git-annex assistant config monitor thread
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Threads.ConfigMonitor where
+
+import Assistant.Common
+import Assistant.BranchChange
+import Assistant.DaemonStatus
+import Assistant.Commits
+import Utility.ThreadScheduler
+import Logs.UUID
+import Logs.Trust
+import Logs.Remote
+import Logs.PreferredContent
+import Logs.Group
+import Remote.List (remoteListRefresh)
+import qualified Git.LsTree as LsTree
+import qualified Annex.Branch
+
+import qualified Data.Set as S
+
+thisThread :: ThreadName
+thisThread = "ConfigMonitor"
+
+{- This thread detects when configuration changes have been made to the
+ - git-annex branch and reloads cached configuration.
+ -
+ - If the branch is frequently changing, it's checked for configuration
+ - changes no more often than once every 60 seconds. On the other hand,
+ - if the branch has not changed in a while, configuration changes will
+ - be detected immediately.
+ -}
+configMonitorThread :: NamedThread
+configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs
+  where
+	loop old = do
+		waitBranchChange
+		new <- getConfigs
+		when (old /= new) $ do
+			let changedconfigs = new `S.difference` old
+			debug $ "reloading config" : 
+				map fst (S.toList changedconfigs)
+			reloadConfigs new
+			{- Record a commit to get this config
+			 - change pushed out to remotes. -}
+			recordCommit
+		liftIO $ threadDelaySeconds (Seconds 60)
+		loop new
+
+{- Config files, and their checksums. -}
+type Configs = S.Set (FilePath, String)
+
+{- All git-annex's config files, and actions to run when they change. -}
+configFilesActions :: [(FilePath, Annex ())]
+configFilesActions =
+	[ (uuidLog, void $ uuidMapLoad)
+	, (remoteLog, void remoteListRefresh)
+	, (trustLog, void trustMapLoad)
+	, (groupLog, void groupMapLoad)
+	-- Preferred content settings depend on most of the other configs,
+	-- so will be reloaded whenever any configs change.
+	, (preferredContentLog, noop)
+	]
+
+reloadConfigs :: Configs -> Assistant ()
+reloadConfigs changedconfigs = do
+	liftAnnex $ do
+		sequence_ as
+		void preferredContentMapLoad
+	{- Changes to the remote log, or the trust log, can affect the
+	 - syncRemotes list -}
+	when (Logs.Remote.remoteLog `elem` fs || Logs.Trust.trustLog `elem` fs) $
+		updateSyncRemotes
+  where
+	(fs, as) = unzip $ filter (flip S.member changedfiles . fst)
+		configFilesActions
+	changedfiles = S.map fst changedconfigs
+
+getConfigs :: Assistant Configs
+getConfigs = S.fromList . map extract
+	<$> liftAnnex (inRepo $ LsTree.lsTreeFiles Annex.Branch.fullname files)
+  where
+	files = map fst configFilesActions
+	extract treeitem = (LsTree.file treeitem, LsTree.sha treeitem)
diff --git a/Assistant/Threads/DaemonStatus.hs b/Assistant/Threads/DaemonStatus.hs
index f3174c8..07f0986 100644
--- a/Assistant/Threads/DaemonStatus.hs
+++ b/Assistant/Threads/DaemonStatus.hs
@@ -9,28 +9,21 @@ module Assistant.Threads.DaemonStatus where
 
 import Assistant.Common
 import Assistant.DaemonStatus
-import Assistant.ThreadedMonad
 import Utility.ThreadScheduler
 import Utility.NotificationBroadcaster
 
-thisThread :: ThreadName
-thisThread = "DaemonStatus"
-
 {- This writes the daemon status to disk, when it changes, but no more
  - frequently than once every ten minutes.
  -}
-daemonStatusThread :: ThreadState -> DaemonStatusHandle -> NamedThread
-daemonStatusThread st dstatus = thread $ do
-	notifier <- newNotificationHandle
-		=<< changeNotifier <$> getDaemonStatus dstatus
+daemonStatusThread :: NamedThread
+daemonStatusThread = NamedThread "DaemonStatus" $ do
+	notifier <- liftIO . newNotificationHandle
+		=<< changeNotifier <$> getDaemonStatus
 	checkpoint
-	runEvery (Seconds tenMinutes) $ do
-		waitNotification notifier
+	runEvery (Seconds tenMinutes) <~> do
+		liftIO $ waitNotification notifier
 		checkpoint
-	where
-		thread = NamedThread thisThread
-		checkpoint = do
-			status <- getDaemonStatus dstatus
-			file <- runThreadState st $ fromRepo gitAnnexDaemonStatusFile
-			writeDaemonStatusFile file status
-
+  where
+	checkpoint = do
+		file <- liftAnnex $ fromRepo gitAnnexDaemonStatusFile
+		liftIO . writeDaemonStatusFile file =<< getDaemonStatus
diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs
index 46f5162..105f0cc 100644
--- a/Assistant/Threads/Merger.hs
+++ b/Assistant/Threads/Merger.hs
@@ -8,9 +8,8 @@
 module Assistant.Threads.Merger where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
 import Assistant.TransferQueue
+import Assistant.BranchChange
 import Utility.DirWatcher
 import Utility.Types.DirWatcher
 import qualified Annex.Branch
@@ -23,36 +22,34 @@ thisThread = "Merger"
 
 {- This thread watches for changes to .git/refs/, and handles incoming
  - pushes. -}
-mergeThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> NamedThread
-mergeThread st dstatus transferqueue = thread $ do
-	g <- runThreadState st gitRepo
+mergeThread :: NamedThread
+mergeThread = NamedThread "Merger" $ do
+	g <- liftAnnex gitRepo
 	let dir = Git.localGitDir g </> "refs"
-	createDirectoryIfMissing True dir
-	let hook a = Just $ runHandler st dstatus transferqueue a
+	liftIO $ createDirectoryIfMissing True dir
+	let hook a = Just <$> asIO2 (runHandler a)
+	addhook <- hook onAdd
+	errhook <- hook onErr
 	let hooks = mkWatchHooks
-		{ addHook = hook onAdd
-		, errHook = hook onErr
+		{ addHook = addhook
+		, errHook = errhook
 		}
-	void $ watchDir dir (const False) hooks id
-	debug thisThread ["watching", dir]
-	where
-		thread = NamedThread thisThread
+	void $ liftIO $ watchDir dir (const False) hooks id
+	debug ["watching", dir]
 
-type Handler = ThreadState -> DaemonStatusHandle -> TransferQueue -> FilePath -> Maybe FileStatus -> IO ()
+type Handler = FilePath -> Assistant ()
 
 {- Runs an action handler.
  -
  - Exceptions are ignored, otherwise a whole thread could be crashed.
  -}
-runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Handler -> FilePath -> Maybe FileStatus -> IO ()
-runHandler st dstatus transferqueue handler file filestatus = void $
-        either print (const noop) =<< tryIO go
-        where
-                go = handler st dstatus transferqueue file filestatus
+runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
+runHandler handler file _filestatus =
+	either (liftIO . print) (const noop) =<< tryIO <~> handler file
 
 {- Called when there's an error with inotify. -}
 onErr :: Handler
-onErr _ _ _ msg _ = error msg
+onErr msg = error msg
 
 {- Called when a new branch ref is written.
  -
@@ -66,39 +63,38 @@ onErr _ _ _ msg _ = error msg
  - ran are merged in.
  -}
 onAdd :: Handler
-onAdd st dstatus transferqueue file _
+onAdd file
 	| ".lock" `isSuffixOf` file = noop
-	| isAnnexBranch file = runThreadState st $
-		whenM Annex.Branch.forceUpdate $
-			queueDeferredDownloads Later transferqueue dstatus
-	| "/synced/" `isInfixOf` file = runThreadState st $ do
-		mergecurrent =<< inRepo Git.Branch.current
+	| isAnnexBranch file = do
+		branchChanged
+		whenM (liftAnnex Annex.Branch.forceUpdate) $
+			queueDeferredDownloads Later
+	| "/synced/" `isInfixOf` file = do
+		mergecurrent =<< liftAnnex (inRepo Git.Branch.current)
 	| otherwise = noop
-	where
-		changedbranch = fileToBranch file
-		mergecurrent (Just current)
-			| equivBranches changedbranch current = do
-				liftIO $ debug thisThread
-					[ "merging"
-					, show changedbranch
-					, "into"
-					, show current
-					]
-				void $ inRepo $
-					Git.Merge.mergeNonInteractive changedbranch
-		mergecurrent _ = noop
+  where
+	changedbranch = fileToBranch file
+	mergecurrent (Just current)
+		| equivBranches changedbranch current = do
+			debug
+				[ "merging", show changedbranch
+				, "into", show current
+				]
+			void $ liftAnnex $ inRepo $
+				Git.Merge.mergeNonInteractive changedbranch
+	mergecurrent _ = noop
 
 equivBranches :: Git.Ref -> Git.Ref -> Bool
 equivBranches x y = base x == base y
-	where
-		base = takeFileName . show
+  where
+	base = takeFileName . show
 
 isAnnexBranch :: FilePath -> Bool
 isAnnexBranch f = n `isSuffixOf` f
-	where
-		n = "/" ++ show Annex.Branch.name
+  where
+	n = "/" ++ show Annex.Branch.name
 
 fileToBranch :: FilePath -> Git.Ref
 fileToBranch f = Git.Ref $ "refs" </> base
-	where
-		base = Prelude.last $ split "/refs/" f
+  where
+	base = Prelude.last $ split "/refs/" f
diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs
index 462f584..fa7d4ec 100644
--- a/Assistant/Threads/MountWatcher.hs
+++ b/Assistant/Threads/MountWatcher.hs
@@ -11,9 +11,7 @@
 module Assistant.Threads.MountWatcher where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
-import Assistant.ScanRemotes
 import Assistant.Sync
 import qualified Annex
 import qualified Git
@@ -38,74 +36,80 @@ import qualified Control.Exception as E
 thisThread :: ThreadName
 thisThread = "MountWatcher"
 
-mountWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
-mountWatcherThread st handle scanremotes = thread $
+mountWatcherThread :: NamedThread
+mountWatcherThread = NamedThread "MountWatcher" $
 #if WITH_DBUS
-	dbusThread st handle scanremotes
+	dbusThread
 #else
-	pollingThread st handle scanremotes
+	pollingThread
 #endif
-	where
-		thread = NamedThread thisThread
 
 #if WITH_DBUS
 
-dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
-dbusThread st dstatus scanremotes = E.catch (go =<< connectSession) onerr
-	where
-		go client = ifM (checkMountMonitor client)
-			( do
-				{- Store the current mount points in an mvar,
-				 - to be compared later. We could in theory
-				 - work out the mount point from the dbus
-				 - message, but this is easier. -}
-				mvar <- newMVar =<< currentMountPoints
-				forM_ mountChanged $ \matcher ->
-					listen client matcher $ \_event -> do
-						nowmounted <- currentMountPoints
-						wasmounted <- swapMVar mvar nowmounted
-						handleMounts st dstatus scanremotes wasmounted nowmounted
-			, do
-				runThreadState st $
-					warning "No known volume monitor available through dbus; falling back to mtab polling"
-				pollinstead
-			)
-		onerr :: E.SomeException -> IO ()
-		onerr e = do
-			runThreadState st $
-				warning $ "Failed to use dbus; falling back to mtab polling (" ++ show e ++ ")"
-			pollinstead
-		pollinstead = pollingThread st dstatus scanremotes
+dbusThread :: Assistant ()
+dbusThread = do
+	runclient <- asIO1 go
+	r <- liftIO $ E.try $ runClient getSessionAddress runclient
+	either onerr (const noop) r
+  where
+	go client = ifM (checkMountMonitor client)
+		( do
+			{- Store the current mount points in an MVar, to be
+			 - compared later. We could in theory work out the
+			 - mount point from the dbus message, but this is
+			 - easier. -}
+			mvar <- liftIO $ newMVar =<< currentMountPoints
+			handleevent <- asIO1 $ \_event -> do
+				nowmounted <- liftIO $ currentMountPoints
+				wasmounted <- liftIO $ swapMVar mvar nowmounted
+				handleMounts wasmounted nowmounted
+			liftIO $ forM_ mountChanged $ \matcher ->
+				listen client matcher handleevent
+		, do
+			liftAnnex $
+				warning "No known volume monitor available through dbus; falling back to mtab polling"
+			pollingThread
+		)
+	onerr :: E.SomeException -> Assistant ()
+	onerr e = do
+		{- If the session dbus fails, the user probably
+		 - logged out of their desktop. Even if they log
+		 - back in, we won't have access to the dbus
+		 - session key, so polling is the best that can be
+		 - done in this situation. -}
+		liftAnnex $
+			warning $ "dbus failed; falling back to mtab polling (" ++ show e ++ ")"
+		pollingThread
 
 {- Examine the list of services connected to dbus, to see if there
  - are any we can use to monitor mounts. If not, will attempt to start one. -}
-checkMountMonitor :: Client -> IO Bool
+checkMountMonitor :: Client -> Assistant Bool
 checkMountMonitor client = do
 	running <- filter (`elem` usableservices)
-		<$> listServiceNames client
+		<$> liftIO (listServiceNames client)
 	case running of
 		[] -> startOneService client startableservices
 		(service:_) -> do
-			debug thisThread [ "Using running DBUS service"
+			debug [ "Using running DBUS service"
 				, service
 				, "to monitor mount events."
 				]
 			return True
-	where
-		startableservices = [gvfs]
-		usableservices = startableservices ++ [kde]
-		gvfs = "org.gtk.Private.GduVolumeMonitor"
-		kde = "org.kde.DeviceNotifications"
+  where
+	startableservices = [gvfs]
+	usableservices = startableservices ++ [kde]
+	gvfs = "org.gtk.Private.GduVolumeMonitor"
+	kde = "org.kde.DeviceNotifications"
 
-startOneService :: Client -> [ServiceName] -> IO Bool
+startOneService :: Client -> [ServiceName] -> Assistant Bool
 startOneService _ [] = return False
 startOneService client (x:xs) = do
-	_ <- callDBus client "StartServiceByName"
+	_ <- liftIO $ callDBus client "StartServiceByName"
 		[toVariant x, toVariant (0 :: Word32)]
-	ifM (elem x <$> listServiceNames client)
+	ifM (liftIO $ elem x <$> listServiceNames client)
 		( do
-			debug thisThread [ "Started DBUS service"
-				, x
+			debug
+				[ "Started DBUS service", x
 				, "to monitor mount events."
 				]
 			return True
@@ -115,48 +119,47 @@ startOneService client (x:xs) = do
 {- Filter matching events recieved when drives are mounted and unmounted. -}	
 mountChanged :: [MatchRule]
 mountChanged = [gvfs True, gvfs False, kde, kdefallback]
-	where
-		{- gvfs reliably generates this event whenever a drive is mounted/unmounted,
-		 - whether automatically, or manually -}
-		gvfs mount = matchAny
-			{ matchInterface = Just "org.gtk.Private.RemoteVolumeMonitor"
-			, matchMember = Just $ if mount then "MountAdded" else "MountRemoved"
-			}
-		{- This event fires when KDE prompts the user what to do with a drive,
-		 - but maybe not at other times. And it's not received -}
-		kde = matchAny
-			{ matchInterface = Just "org.kde.Solid.Device"
-			, matchMember = Just "setupDone"
-			}
-		{- This event may not be closely related to mounting a drive, but it's
-		 - observed reliably when a drive gets mounted or unmounted. -}
-		kdefallback = matchAny
-			{ matchInterface = Just "org.kde.KDirNotify"
-			, matchMember = Just "enteredDirectory"
-			}
+  where
+	{- gvfs reliably generates this event whenever a
+	 - drive is mounted/unmounted, whether automatically, or manually -}
+	gvfs mount = matchAny
+		{ matchInterface = Just "org.gtk.Private.RemoteVolumeMonitor"
+		, matchMember = Just $ if mount then "MountAdded" else "MountRemoved"
+		}
+	{- This event fires when KDE prompts the user what to do with a drive,
+	 - but maybe not at other times. And it's not received -}
+	kde = matchAny
+		{ matchInterface = Just "org.kde.Solid.Device"
+		, matchMember = Just "setupDone"
+		}
+	{- This event may not be closely related to mounting a drive, but it's
+	 - observed reliably when a drive gets mounted or unmounted. -}
+	kdefallback = matchAny
+		{ matchInterface = Just "org.kde.KDirNotify"
+		, matchMember = Just "enteredDirectory"
+		}
 
 #endif
 
-pollingThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
-pollingThread st dstatus scanremotes = go =<< currentMountPoints
-	where
-		go wasmounted = do
-			threadDelaySeconds (Seconds 10)
-			nowmounted <- currentMountPoints
-			handleMounts st dstatus scanremotes wasmounted nowmounted
-			go nowmounted
-
-handleMounts :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> MountPoints -> MountPoints -> IO ()
-handleMounts st dstatus scanremotes wasmounted nowmounted =
-	mapM_ (handleMount st dstatus scanremotes . mnt_dir) $
+pollingThread :: Assistant ()
+pollingThread = go =<< liftIO currentMountPoints
+  where
+	go wasmounted = do
+		liftIO $ threadDelaySeconds (Seconds 10)
+		nowmounted <- liftIO currentMountPoints
+		handleMounts wasmounted nowmounted
+		go nowmounted
+
+handleMounts :: MountPoints -> MountPoints -> Assistant ()
+handleMounts wasmounted nowmounted =
+	mapM_ (handleMount . mnt_dir) $
 		S.toList $ newMountPoints wasmounted nowmounted
 
-handleMount :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> FilePath -> IO ()
-handleMount st dstatus scanremotes dir = do
-	debug thisThread ["detected mount of", dir]
-	reconnectRemotes thisThread st dstatus scanremotes
-		=<< filter (Git.repoIsLocal . Remote.repo)
-			<$> remotesUnder st dstatus dir
+handleMount :: FilePath -> Assistant ()
+handleMount dir = do
+	debug ["detected mount of", dir]
+	rs <- filter (Git.repoIsLocal . Remote.repo) <$> remotesUnder dir
+	reconnectRemotes True rs
 
 {- Finds remotes located underneath the mount point.
  -
@@ -166,21 +169,21 @@ handleMount st dstatus scanremotes dir = do
  - at startup time, or may have changed (it could even be a different
  - repository at the same remote location..)
  -}
-remotesUnder :: ThreadState -> DaemonStatusHandle -> FilePath -> IO [Remote]
-remotesUnder st dstatus dir = runThreadState st $ do
-	repotop <- fromRepo Git.repoPath
-	rs <- remoteList
-	pairs <- mapM (checkremote repotop) rs
+remotesUnder :: FilePath -> Assistant [Remote]
+remotesUnder dir = do
+	repotop <- liftAnnex $ fromRepo Git.repoPath
+	rs <- liftAnnex remoteList
+	pairs <- liftAnnex $ mapM (checkremote repotop) rs
 	let (waschanged, rs') = unzip pairs
 	when (any id waschanged) $ do
-		Annex.changeState $ \s -> s { Annex.remotes = rs' }
-		updateSyncRemotes dstatus
+		liftAnnex $ Annex.changeState $ \s -> s { Annex.remotes = rs' }
+		updateSyncRemotes
 	return $ map snd $ filter fst pairs
-	where
-		checkremote repotop r = case Remote.localpath r of
-			Just p | dirContains dir (absPathFrom repotop p) ->
-				(,) <$> pure True <*> updateRemote r
-			_ -> return (False, r)
+  where
+	checkremote repotop r = case Remote.localpath r of
+		Just p | dirContains dir (absPathFrom repotop p) ->
+			(,) <$> pure True <*> updateRemote r
+		_ -> return (False, r)
 
 type MountPoints = S.Set Mntent
 
diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs
index a8daa94..c5a48ad 100644
--- a/Assistant/Threads/NetWatcher.hs
+++ b/Assistant/Threads/NetWatcher.hs
@@ -11,9 +11,6 @@
 module Assistant.Threads.NetWatcher where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
-import Assistant.ScanRemotes
 import Assistant.Sync
 import Utility.ThreadScheduler
 import Remote.List
@@ -24,73 +21,72 @@ import Utility.DBus
 import DBus.Client
 import DBus
 import Data.Word (Word32)
-import qualified Control.Exception as E
+import Assistant.NetMessager
 #else
 #warning Building without dbus support; will poll for network connection changes
 #endif
 
-thisThread :: ThreadName
-thisThread = "NetWatcher"
-
-netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
+netWatcherThread :: NamedThread
 #if WITH_DBUS
-netWatcherThread st dstatus scanremotes = thread $
-	dbusThread st dstatus scanremotes
+netWatcherThread = thread dbusThread
 #else
-netWatcherThread _ _ _ = thread noop
+netWatcherThread = thread noop
 #endif
-	where
-		thread = NamedThread thisThread
+  where
+	thread = NamedThread "NetWatcher"
 
 {- This is a fallback for when dbus cannot be used to detect
  - network connection changes, but it also ensures that
  - any networked remotes that may have not been routable for a
  - while (despite the local network staying up), are synced with
  - periodically. -}
-netWatcherFallbackThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
-netWatcherFallbackThread st dstatus scanremotes = thread $
-	runEvery (Seconds 3600) $
-		handleConnection st dstatus scanremotes
-	where
-		thread = NamedThread thisThread
+netWatcherFallbackThread :: NamedThread
+netWatcherFallbackThread = NamedThread "NetWatcherFallback" $
+	runEvery (Seconds 3600) <~> handleConnection
 
 #if WITH_DBUS
 
-dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
-dbusThread st dstatus scanremotes = E.catch (go =<< connectSystem) onerr
-	where
-		go client = ifM (checkNetMonitor client)
-			( do
-				listenNMConnections client handle
-				listenWicdConnections client handle
-			, do
-				runThreadState st $
-					warning "No known network monitor available through dbus; falling back to polling"
-			)
-		onerr :: E.SomeException -> IO ()
-		onerr e = runThreadState st $
-			warning $ "Failed to use dbus; falling back to polling (" ++ show e ++ ")"
-		handle = do
-			debug thisThread ["detected network connection"]
-			handleConnection st dstatus scanremotes
+dbusThread :: Assistant ()
+dbusThread = do
+	handleerr <- asIO2 onerr
+	runclient <- asIO1 go
+	liftIO $ persistentClient getSystemAddress () handleerr runclient
+  where
+	go client = ifM (checkNetMonitor client)
+		( do
+			listenNMConnections client <~> handleconn
+			listenWicdConnections client <~> handleconn
+		, do
+			liftAnnex $
+				warning "No known network monitor available through dbus; falling back to polling"
+		)
+	handleconn = do
+		debug ["detected network connection"]
+		notifyNetMessagerRestart
+		handleConnection
+	onerr e _ = do
+		liftAnnex $
+			warning $ "lost dbus connection; falling back to polling (" ++ show e ++ ")"
+		{- Wait, in hope that dbus will come back -}
+		liftIO $ threadDelaySeconds (Seconds 60)
 
 {- Examine the list of services connected to dbus, to see if there
  - are any we can use to monitor network connections. -}
-checkNetMonitor :: Client -> IO Bool
+checkNetMonitor :: Client -> Assistant Bool
 checkNetMonitor client = do
-	running <- filter (`elem` [networkmanager, wicd])
+	running <- liftIO $ filter (`elem` [networkmanager, wicd])
 		<$> listServiceNames client
 	case running of
 		[] -> return False
 		(service:_) -> do
-			debug thisThread [ "Using running DBUS service"
+			debug [ "Using running DBUS service"
 				, service
 				, "to monitor network connection events."
 				]
 			return True
-	where
-		networkmanager = "org.freedesktop.NetworkManager"
-		wicd = "org.wicd.daemon"
+  where
+	networkmanager = "org.freedesktop.NetworkManager"
+	wicd = "org.wicd.daemon"
 
 {- Listens for new NetworkManager connections. -}
 listenNMConnections :: Client -> IO () -> IO ()
@@ -98,18 +94,18 @@ listenNMConnections client callback =
 	listen client matcher $ \event ->
 		when (Just True == anyM activeconnection (signalBody event)) $
 			callback
-	where
-		matcher = matchAny
-			{ matchInterface = Just "org.freedesktop.NetworkManager.Connection.Active"
-			, matchMember = Just "PropertiesChanged"
-			}
-		nm_connection_activated = toVariant (2 :: Word32)
-		nm_state_key = toVariant ("State" :: String)
-		activeconnection v = do
-			m <- fromVariant v
-			vstate <- lookup nm_state_key $ dictionaryItems m
-			state <- fromVariant vstate
-			return $ state == nm_connection_activated
+  where
+	matcher = matchAny
+		{ matchInterface = Just "org.freedesktop.NetworkManager.Connection.Active"
+		, matchMember = Just "PropertiesChanged"
+		}
+	nm_connection_activated = toVariant (2 :: Word32)
+	nm_state_key = toVariant ("State" :: String)
+	activeconnection v = do
+		m <- fromVariant v
+		vstate <- lookup nm_state_key $ dictionaryItems m
+		state <- fromVariant vstate
+		return $ state == nm_connection_activated
 
 {- Listens for new Wicd connections. -}
 listenWicdConnections :: Client -> IO () -> IO ()
@@ -117,21 +113,19 @@ listenWicdConnections client callback =
 	listen client matcher $ \event ->
 		when (any (== wicd_success) (signalBody event)) $
 			callback
-	where
-		matcher = matchAny
-			{ matchInterface = Just "org.wicd.daemon"
-			, matchMember = Just "ConnectResultsSent"
-			}
-		wicd_success = toVariant ("success" :: String)
+  where
+	matcher = matchAny
+		{ matchInterface = Just "org.wicd.daemon"
+		, matchMember = Just "ConnectResultsSent"
+		}
+	wicd_success = toVariant ("success" :: String)
 
 #endif
 
-handleConnection :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
-handleConnection st dstatus scanremotes =
-	reconnectRemotes thisThread st dstatus scanremotes
-		=<< networkRemotes st
+handleConnection :: Assistant ()
+handleConnection = reconnectRemotes True =<< networkRemotes
 
 {- Finds network remotes. -}
-networkRemotes :: ThreadState -> IO [Remote]
-networkRemotes st = runThreadState st $
+networkRemotes :: Assistant [Remote]
+networkRemotes = liftAnnex $
 	filter (isNothing . Remote.localpath) <$> remoteList
diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index 9875dcb..1f9de09 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -11,13 +11,12 @@ import Assistant.Common
 import Assistant.Pairing
 import Assistant.Pairing.Network
 import Assistant.Pairing.MakeRemote
-import Assistant.ThreadedMonad
-import Assistant.ScanRemotes
-import Assistant.DaemonStatus
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.Alert
+import Assistant.DaemonStatus
 import Utility.ThreadScheduler
+import Git
 
 import Network.Multicast
 import Network.Socket
@@ -27,118 +26,116 @@ import Data.Char
 thisThread :: ThreadName
 thisThread = "PairListener"
 
-pairListenerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> UrlRenderer -> NamedThread
-pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $
-	runEvery (Seconds 1) $ void $ tryIO $ do
-		sock <- getsock
-		go sock [] []
-	where
-		thread = NamedThread thisThread
+pairListenerThread :: UrlRenderer -> NamedThread
+pairListenerThread urlrenderer = NamedThread "PairListener" $ do
+	listener <- asIO1 $ go [] []
+	liftIO $ withSocketsDo $
+		runEvery (Seconds 1) $ void $ tryIO $ 
+			listener =<< getsock
+  where
+	{- Note this can crash if there's no network interface,
+	 - or only one like lo that doesn't support multicast. -}
+	getsock = multicastReceiver (multicastAddress $ IPv4Addr undefined) pairingPort
 		
-		{- Note this can crash if there's no network interface,
-		 - or only one like lo that doesn't support multicast. -}
-		getsock = multicastReceiver (multicastAddress $ IPv4Addr undefined) pairingPort
-		
-		go sock reqs cache = getmsg sock [] >>= \msg -> case readish msg of
-			Nothing -> go sock reqs cache
-			Just m -> do
-				sane <- checkSane msg
-				(pip, verified) <- verificationCheck m
-					=<< (pairingInProgress <$> getDaemonStatus dstatus)
-				let wrongstage = maybe False (\p -> pairMsgStage m <= inProgressPairStage p) pip
-				case (wrongstage, sane, pairMsgStage m) of
-					-- ignore our own messages, and
-					-- out of order messages
-					(True, _, _) -> go sock reqs cache
-					(_, False, _) -> go sock reqs cache
-					(_, _, PairReq) -> if m `elem` reqs
-						then go sock reqs (invalidateCache m cache)
-						else do
-							pairReqReceived verified dstatus urlrenderer m
-							go sock (m:take 10 reqs) (invalidateCache m cache)
-					(_, _, PairAck) ->
-						pairAckReceived verified pip st dstatus scanremotes m cache
-							>>= go sock reqs
-					(_, _, PairDone) -> do
-						pairDoneReceived verified pip st dstatus scanremotes m
-						go sock	reqs cache
+	go reqs cache sock = liftIO (getmsg sock []) >>= \msg -> case readish msg of
+		Nothing -> go reqs cache sock
+		Just m -> do
+			sane <- checkSane msg
+			(pip, verified) <- verificationCheck m
+				=<< (pairingInProgress <$> getDaemonStatus)
+			let wrongstage = maybe False (\p -> pairMsgStage m <= inProgressPairStage p) pip
+			case (wrongstage, sane, pairMsgStage m) of
+				-- ignore our own messages, and
+				-- out of order messages
+				(True, _, _) -> go reqs cache sock
+				(_, False, _) -> go reqs cache sock
+				(_, _, PairReq) -> if m `elem` reqs
+					then go reqs (invalidateCache m cache) sock
+					else do
+						pairReqReceived verified urlrenderer m
+						go (m:take 10 reqs) (invalidateCache m cache) sock
+				(_, _, PairAck) -> do
+					cache' <- pairAckReceived verified pip m cache
+					go reqs cache' sock
+				(_, _, PairDone) -> do
+					pairDoneReceived verified pip m
+					go reqs cache sock
 
-		{- As well as verifying the message using the shared secret,
-		 - check its UUID against the UUID we have stored. If
-		 - they're the same, someone is sending bogus messages,
-		 - which could be an attempt to brute force the shared
-		 - secret.
-		 -}
-		verificationCheck m (Just pip) = do
-			let verified = verifiedPairMsg m pip
-			let sameuuid = pairUUID (inProgressPairData pip) == pairUUID (pairMsgData m)
-			if not verified && sameuuid
-				then do
-					runThreadState st $
-						warning "detected possible pairing brute force attempt; disabled pairing"
-					stopSending dstatus pip
-					return (Nothing, False)
-				else return (Just pip, verified && sameuuid)
-		verificationCheck _ Nothing = return (Nothing, False)
+	{- As well as verifying the message using the shared secret,
+	 - check its UUID against the UUID we have stored. If
+	 - they're the same, someone is sending bogus messages,
+	 - which could be an attempt to brute force the shared secret. -}
+	verificationCheck _ Nothing = return (Nothing, False)
+	verificationCheck m (Just pip)
+		| not verified && sameuuid = do
+			liftAnnex $ warning
+				"detected possible pairing brute force attempt; disabled pairing"
+			stopSending pip
+			return (Nothing, False)
+		|otherwise = return (Just pip, verified && sameuuid)
+	  where
+		verified = verifiedPairMsg m pip
+		sameuuid = pairUUID (inProgressPairData pip) == pairUUID (pairMsgData m)
 		
-		{- Various sanity checks on the content of the message. -}
-		checkSane msg 
-			{- Control characters could be used in a
-			 - console poisoning attack. -}
-			| any isControl msg || any (`elem` "\r\n") msg = do
-				runThreadState st $
-					warning "illegal control characters in pairing message; ignoring"
-				return False
-			| otherwise = return True
+	{- Various sanity checks on the content of the message. -}
+	checkSane msg 
+		{- Control characters could be used in a
+		 - console poisoning attack. -}
+		| any isControl msg || any (`elem` "\r\n") msg = do
+			liftAnnex $ warning
+				"illegal control characters in pairing message; ignoring"
+			return False
+		| otherwise = return True
 
-		{- PairReqs invalidate the cache of recently finished pairings.
-		 - This is so that, if a new pairing is started with the
-		 - same secret used before, a bogus PairDone is not sent. -}
-		invalidateCache msg = filter (not . verifiedPairMsg msg)
+	{- PairReqs invalidate the cache of recently finished pairings.
+	 - This is so that, if a new pairing is started with the
+	 - same secret used before, a bogus PairDone is not sent. -}
+	invalidateCache msg = filter (not . verifiedPairMsg msg)
 
-		getmsg sock c = do
-			(msg, n, _) <- recvFrom sock chunksz
-			if n < chunksz
-				then return $ c ++ msg
-				else getmsg sock $ c ++ msg
-			where
-				chunksz = 1024
+	getmsg sock c = do
+		(msg, n, _) <- recvFrom sock chunksz
+		if n < chunksz
+			then return $ c ++ msg
+			else getmsg sock $ c ++ msg
+	  where
+		chunksz = 1024
 
 {- Show an alert when a PairReq is seen. -}
-pairReqReceived :: Bool -> DaemonStatusHandle -> UrlRenderer -> PairMsg -> IO ()
-pairReqReceived True _ _ _ = noop -- ignore our own PairReq
-pairReqReceived False dstatus urlrenderer msg = do
-	url <- renderUrl urlrenderer (FinishPairR msg) []
-	void $ addAlert dstatus $ pairRequestReceivedAlert repo
+pairReqReceived :: Bool -> UrlRenderer -> PairMsg -> Assistant ()
+pairReqReceived True _ _ = noop -- ignore our own PairReq
+pairReqReceived False urlrenderer msg = do
+	url <- liftIO $ renderUrl urlrenderer (FinishLocalPairR msg) []
+	closealert <- asIO1 removeAlert
+	void $ addAlert $ pairRequestReceivedAlert repo
 		AlertButton
 			{ buttonUrl = url
 			, buttonLabel = T.pack "Respond"
-			, buttonAction = Just $ removeAlert dstatus
+			, buttonAction = Just closealert
 			}
-	where
-		repo = pairRepo msg
+  where
+	repo = pairRepo msg
 
 {- When a verified PairAck is seen, a host is ready to pair with us, and has
  - already configured our ssh key. Stop sending PairReqs, finish the pairing,
- - and send a single PairDone. 
- -}
-pairAckReceived :: Bool -> Maybe PairingInProgress -> ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PairMsg -> [PairingInProgress] -> IO [PairingInProgress]
-pairAckReceived True (Just pip) st dstatus scanremotes msg cache = do
-	stopSending dstatus pip
-	setupAuthorizedKeys msg
-	finishedPairing st dstatus scanremotes msg (inProgressSshKeyPair pip)
-	startSending dstatus pip PairDone $ multicastPairMsg
+ - and send a single PairDone. -}
+pairAckReceived :: Bool -> Maybe PairingInProgress -> PairMsg -> [PairingInProgress] -> Assistant [PairingInProgress]
+pairAckReceived True (Just pip) msg cache = do
+	stopSending pip
+	repodir <- repoPath <$> liftAnnex gitRepo
+	liftIO $ setupAuthorizedKeys msg repodir
+	finishedLocalPairing msg (inProgressSshKeyPair pip)
+	startSending pip PairDone $ multicastPairMsg
 		(Just 1) (inProgressSecret pip) (inProgressPairData pip)
 	return $ pip : take 10 cache
 {- A stale PairAck might also be seen, after we've finished pairing.
  - Perhaps our PairDone was not received. To handle this, we keep
  - a cache of recently finished pairings, and re-send PairDone in
  - response to stale PairAcks for them. -}
-pairAckReceived _ _ _ dstatus _ msg cache = do
+pairAckReceived _ _ msg cache = do
 	let pips = filter (verifiedPairMsg msg) cache
 	unless (null pips) $
 		forM_ pips $ \pip ->
-			startSending dstatus pip PairDone $ multicastPairMsg
+			startSending pip PairDone $ multicastPairMsg
 				(Just 1) (inProgressSecret pip) (inProgressPairData pip)
 	return cache
 
@@ -151,9 +148,9 @@ pairAckReceived _ _ _ dstatus _ msg cache = do
  - entering the secret. Would be better to start a fresh pair request in this
  - situation.
  -}
-pairDoneReceived :: Bool -> Maybe PairingInProgress -> ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PairMsg -> IO ()
-pairDoneReceived False _ _ _ _ _ = noop -- not verified
-pairDoneReceived True Nothing _ _ _ _ = noop -- not in progress
-pairDoneReceived True (Just pip) st dstatus scanremotes msg = do
-	stopSending dstatus pip
-	finishedPairing st dstatus scanremotes msg (inProgressSshKeyPair pip)
+pairDoneReceived :: Bool -> Maybe PairingInProgress -> PairMsg -> Assistant ()
+pairDoneReceived False _ _ = noop -- not verified
+pairDoneReceived True Nothing _ = noop -- not in progress
+pairDoneReceived True (Just pip) msg = do
+	stopSending pip
+	finishedLocalPairing msg (inProgressSshKeyPair pip)
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs
index 4f3a2dd..035a454 100644
--- a/Assistant/Threads/Pusher.hs
+++ b/Assistant/Threads/Pusher.hs
@@ -9,13 +9,12 @@ module Assistant.Threads.Pusher where
 
 import Assistant.Common
 import Assistant.Commits
+import Assistant.Types.Commits
 import Assistant.Pushes
 import Assistant.Alert
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.Sync
 import Utility.ThreadScheduler
-import qualified Remote
 import qualified Types.Remote as Remote
 
 import Data.Time.Clock
@@ -24,52 +23,37 @@ thisThread :: ThreadName
 thisThread = "Pusher"
 
 {- This thread retries pushes that failed before. -}
-pushRetryThread :: ThreadState -> DaemonStatusHandle -> FailedPushMap -> NamedThread
-pushRetryThread st dstatus pushmap = thread $ runEvery (Seconds halfhour) $ do
+pushRetryThread :: NamedThread
+pushRetryThread = NamedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do
 	-- We already waited half an hour, now wait until there are failed
 	-- pushes to retry.
-	topush <- getFailedPushesBefore pushmap (fromIntegral halfhour)
+	topush <- getFailedPushesBefore (fromIntegral halfhour)
 	unless (null topush) $ do
-		debug thisThread
-			[ "retrying"
-			, show (length topush)
-			, "failed pushes"
-			]
-		now <- getCurrentTime
-		void $ alertWhile dstatus (pushRetryAlert topush) $
-			pushToRemotes thisThread now st (Just pushmap) topush
-	where
-		halfhour = 1800
-		thread = NamedThread thisThread
+		debug ["retrying", show (length topush), "failed pushes"]
+		void $ alertWhile (pushRetryAlert topush) $ do
+			now <- liftIO $ getCurrentTime
+			pushToRemotes now True topush
+  where
+	halfhour = 1800
 
 {- This thread pushes git commits out to remotes soon after they are made. -}
-pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> NamedThread
-pushThread st dstatus commitchan pushmap = thread $ runEvery (Seconds 2) $ do
+pushThread :: NamedThread
+pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do
 	-- We already waited two seconds as a simple rate limiter.
 	-- Next, wait until at least one commit has been made
-	commits <- getCommits commitchan
+	commits <- getCommits
 	-- Now see if now's a good time to push.
-	now <- getCurrentTime
-	if shouldPush now commits
+	if shouldPush commits
 		then do
-			remotes <- filter pushable . syncRemotes
-				<$> getDaemonStatus dstatus
-			unless (null remotes) $ 
-				void $ alertWhile dstatus (pushAlert remotes) $
-					pushToRemotes thisThread now st (Just pushmap) remotes
+			remotes <- filter (not . Remote.readonly) 
+				. syncGitRemotes <$> getDaemonStatus
+			unless (null remotes) $
+				void $ alertWhile (pushAlert remotes) $ do
+					now <- liftIO $ getCurrentTime
+					pushToRemotes now True remotes
 		else do
-			debug thisThread
-				[ "delaying push of"
-				, show (length commits)
-				, "commits"
-				]
-			refillCommits commitchan commits
-	where
-		thread = NamedThread thisThread
-		pushable r
-			| Remote.specialRemote r = False
-			| Remote.readonly r = False
-			| otherwise = True
+			debug ["delaying push of", show (length commits), "commits"]
+			refillCommits commits
 
 {- Decide if now is a good time to push to remotes.
  -
@@ -77,7 +61,7 @@ pushThread st dstatus commitchan pushmap = thread $ runEvery (Seconds 2) $ do
  - already determines batches of changes, so we can't easily determine
  - batches better.
  -}
-shouldPush :: UTCTime -> [Commit] -> Bool
-shouldPush _now commits
+shouldPush :: [Commit] -> Bool
+shouldPush commits
 	| not (null commits) = True
 	| otherwise = False
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index 9122700..1871b68 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -11,60 +11,51 @@ module Assistant.Threads.SanityChecker (
 
 import Assistant.Common
 import Assistant.DaemonStatus
-import Assistant.ThreadedMonad
-import Assistant.Changes
 import Assistant.Alert
-import Assistant.TransferQueue
 import qualified Git.LsFiles
 import Utility.ThreadScheduler
 import qualified Assistant.Threads.Watcher as Watcher
 
 import Data.Time.Clock.POSIX
 
-thisThread :: ThreadName
-thisThread = "SanityChecker"
-
 {- This thread wakes up occasionally to make sure the tree is in good shape. -}
-sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> NamedThread
-sanityCheckerThread st dstatus transferqueue changechan = thread $ forever $ do
-	waitForNextCheck dstatus
+sanityCheckerThread :: NamedThread
+sanityCheckerThread = NamedThread "SanityChecker" $ forever $ do
+	waitForNextCheck
 
-	debug thisThread ["starting sanity check"]
+	debug ["starting sanity check"]
+	void $ alertWhile sanityCheckAlert go
+	debug ["sanity check complete"]
+  where
+	go = do
+		modifyDaemonStatus_ $ \s -> s { sanityCheckRunning = True }
 
-	void $ alertWhile dstatus sanityCheckAlert go
-	
-	debug thisThread ["sanity check complete"]
-	where
-		thread = NamedThread thisThread
-		go = do
-			modifyDaemonStatus_ dstatus $ \s -> s
-				{ sanityCheckRunning = True }
+		now <- liftIO $ getPOSIXTime -- before check started
+		r <- either showerr return =<< tryIO <~> check
 
-			now <- getPOSIXTime -- before check started
-			r <- catchIO (check st dstatus transferqueue changechan)
-				$ \e -> do
-					runThreadState st $ warning $ show e
-					return False
+		modifyDaemonStatus_ $ \s -> s
+			{ sanityCheckRunning = False
+			, lastSanityCheck = Just now
+			}
 
-			modifyDaemonStatus_ dstatus $ \s -> s
-				{ sanityCheckRunning = False
-				, lastSanityCheck = Just now
-				}
+		return r
 
-			return r
+	showerr e = do
+		liftAnnex $ warning $ show e
+		return False
 
 {- Only run one check per day, from the time of the last check. -}
-waitForNextCheck :: DaemonStatusHandle -> IO ()
-waitForNextCheck dstatus = do
-	v <- lastSanityCheck <$> getDaemonStatus dstatus
-	now <- getPOSIXTime
-	threadDelaySeconds $ Seconds $ calcdelay now v
-	where
-		calcdelay _ Nothing = oneDay
-		calcdelay now (Just lastcheck)
-			| lastcheck < now = max oneDay $
-				oneDay - truncate (now - lastcheck)
-			| otherwise = oneDay
+waitForNextCheck :: Assistant ()
+waitForNextCheck = do
+	v <- lastSanityCheck <$> getDaemonStatus
+	now <- liftIO getPOSIXTime
+	liftIO $ threadDelaySeconds $ Seconds $ calcdelay now v
+  where
+	calcdelay _ Nothing = oneDay
+	calcdelay now (Just lastcheck)
+		| lastcheck < now = max oneDay $
+			oneDay - truncate (now - lastcheck)
+		| otherwise = oneDay
 
 oneDay :: Int
 oneDay = 24 * 60 * 60
@@ -72,29 +63,26 @@ oneDay = 24 * 60 * 60
 {- It's important to stay out of the Annex monad as much as possible while
  - running potentially expensive parts of this check, since remaining in it
  - will block the watcher. -}
-check :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO Bool
-check st dstatus transferqueue changechan = do
-	g <- runThreadState st gitRepo
+check :: Assistant Bool
+check = do
+	g <- liftAnnex gitRepo
 	-- Find old unstaged symlinks, and add them to git.
-	(unstaged, cleanup) <- Git.LsFiles.notInRepo False ["."] g
-	now <- getPOSIXTime
+	(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g
+	now <- liftIO $ getPOSIXTime
 	forM_ unstaged $ \file -> do
-		ms <- catchMaybeIO $ getSymbolicLinkStatus file
+		ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
 		case ms of
 			Just s	| toonew (statusChangeTime s) now -> noop
-				| isSymbolicLink s ->
-					addsymlink file ms
+				| isSymbolicLink s -> addsymlink file ms
 			_ -> noop
-	void cleanup
+	liftIO $ void cleanup
 	return True
-	where
-		toonew timestamp now = now < (realToFrac (timestamp + slop) :: POSIXTime)
-		slop = fromIntegral tenMinutes
-		insanity msg = do
-			runThreadState st $ warning msg
-			void $ addAlert dstatus $ sanityCheckFixAlert msg
-		addsymlink file s = do
-			Watcher.runHandler thisThread st dstatus
-				transferqueue changechan
-				Watcher.onAddSymlink file s
-			insanity $ "found unstaged symlink: " ++ file
+  where
+	toonew timestamp now = now < (realToFrac (timestamp + slop) :: POSIXTime)
+	slop = fromIntegral tenMinutes
+	insanity msg = do
+		liftAnnex $ warning msg
+		void $ addAlert $ sanityCheckFixAlert msg
+	addsymlink file s = do
+		Watcher.runHandler Watcher.onAddSymlink file s
+		insanity $ "found unstaged symlink: " ++ file
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs
index afead63..9118e9b 100644
--- a/Assistant/Threads/TransferPoller.hs
+++ b/Assistant/Threads/TransferPoller.hs
@@ -8,7 +8,6 @@
 module Assistant.Threads.TransferPoller where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Logs.Transfer
 import Utility.NotificationBroadcaster
@@ -17,46 +16,41 @@ import qualified Assistant.Threads.TransferWatcher as TransferWatcher
 import Control.Concurrent
 import qualified Data.Map as M
 
-thisThread :: ThreadName
-thisThread = "TransferPoller"
-
 {- This thread polls the status of ongoing transfers, determining how much
  - of each transfer is complete. -}
-transferPollerThread :: ThreadState -> DaemonStatusHandle -> NamedThread
-transferPollerThread st dstatus = thread $ do
-	g <- runThreadState st gitRepo
-	tn <- newNotificationHandle =<<
-		transferNotifier <$> getDaemonStatus dstatus
+transferPollerThread :: NamedThread
+transferPollerThread = NamedThread "TransferPoller" $ do
+	g <- liftAnnex gitRepo
+	tn <- liftIO . newNotificationHandle =<<
+		transferNotifier <$> getDaemonStatus
 	forever $ do
-		threadDelay 500000 -- 0.5 seconds
-		ts <- currentTransfers <$> getDaemonStatus dstatus
+		liftIO $ threadDelay 500000 -- 0.5 seconds
+		ts <- currentTransfers <$> getDaemonStatus
 		if M.null ts
-			then waitNotification tn -- block until transfers running
+			-- block until transfers running
+			then liftIO $ waitNotification tn
 			else mapM_ (poll g) $ M.toList ts
-	where
-		thread = NamedThread thisThread
-		poll g (t, info)
-			{- Downloads are polled by checking the size of the
-			 - temp file being used for the transfer. -}
-			| transferDirection t == Download = do
-				let f = gitAnnexTmpLocation (transferKey t) g
-				sz <- catchMaybeIO $
-					fromIntegral . fileSize
-						<$> getFileStatus f
-				newsize t info sz
-			{- Uploads don't need to be polled for when the
-			 - TransferWatcher thread can track file
-			 - modifications. -}
-			| TransferWatcher.watchesTransferSize = noop
-			{- Otherwise, this code polls the upload progress
-			 - by reading the transfer info file. -}
-			| otherwise = do
-				let f = transferFile t g
-				mi <- catchDefaultIO Nothing $
-					readTransferInfoFile Nothing f
-				maybe noop (newsize t info . bytesComplete) mi
-		newsize t info sz
-			| bytesComplete info /= sz && isJust sz = 
-				alterTransferInfo dstatus t $
-					\i -> i { bytesComplete = sz }
-			| otherwise = noop
+  where
+	poll g (t, info)
+		{- Downloads are polled by checking the size of the
+		 - temp file being used for the transfer. -}
+		| transferDirection t == Download = do
+			let f = gitAnnexTmpLocation (transferKey t) g
+			sz <- liftIO $ catchMaybeIO $
+				fromIntegral . fileSize <$> getFileStatus f
+			newsize t info sz
+		{- Uploads don't need to be polled for when the TransferWatcher
+		 - thread can track file modifications. -}
+		| TransferWatcher.watchesTransferSize = noop
+		{- Otherwise, this code polls the upload progress
+		 - by reading the transfer info file. -}
+		| otherwise = do
+			let f = transferFile t g
+			mi <- liftIO $ catchDefaultIO Nothing $
+				readTransferInfoFile Nothing f
+			maybe noop (newsize t info . bytesComplete) mi
+
+	newsize t info sz
+		| bytesComplete info /= sz && isJust sz =
+			alterTransferInfo t $ \i -> i { bytesComplete = sz }
+		| otherwise = noop
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index bc58375..918a266 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -8,11 +8,12 @@
 module Assistant.Threads.TransferScanner where
 
 import Assistant.Common
+import Assistant.Types.ScanRemotes
 import Assistant.ScanRemotes
 import Assistant.TransferQueue
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.Alert
+import Assistant.Drop
 import Logs.Transfer
 import Logs.Location
 import Logs.Web (webUUID)
@@ -20,116 +21,120 @@ import qualified Remote
 import qualified Types.Remote as Remote
 import Utility.ThreadScheduler
 import qualified Git.LsFiles as LsFiles
-import Command
+import qualified Backend
 import Annex.Content
 import Annex.Wanted
 
 import qualified Data.Set as S
 
-thisThread :: ThreadName
-thisThread = "TransferScanner"
-
 {- This thread waits until a remote needs to be scanned, to find transfers
  - that need to be made, to keep data in sync.
  -}
-transferScannerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> TransferQueue -> NamedThread
-transferScannerThread st dstatus scanremotes transferqueue = thread $ do
+transferScannerThread :: NamedThread
+transferScannerThread = NamedThread "TransferScanner" $ do
 	startupScan
 	go S.empty
-	where
-		thread = NamedThread thisThread
-		go scanned = do
-			threadDelaySeconds (Seconds 2)
-			(rs, infos) <- unzip <$> getScanRemote scanremotes
-			if any fullScan infos || any (`S.notMember` scanned) rs
-				then do
-					expensiveScan st dstatus transferqueue rs
-					go $ scanned `S.union` S.fromList rs
-				else do
-					mapM_ (failedTransferScan st dstatus transferqueue) rs
-					go scanned
-		{- All available remotes are scanned in full on startup,
-		 - for multiple reasons, including:
-		 -
-		 - * This may be the first run, and there may be remotes
-		 -   already in place, that need to be synced.
-		 - * We may have run before, and scanned a remote, but
-		 -   only been in a subdirectory of the git remote, and so
-		 -   not synced it all.
-		 - * We may have run before, and had transfers queued,
-		 -   and then the system (or us) crashed, and that info was
-		 -   lost.
-		 -}
-		startupScan = addScanRemotes scanremotes True
-			=<< syncRemotes <$> getDaemonStatus dstatus
+  where
+	go scanned = do
+		liftIO $ threadDelaySeconds (Seconds 2)
+		(rs, infos) <- unzip <$> getScanRemote
+		if any fullScan infos || any (`S.notMember` scanned) rs
+			then do
+				expensiveScan rs
+				go $ scanned `S.union` S.fromList rs
+			else do
+				mapM_ failedTransferScan rs
+				go scanned
+	{- All available remotes are scanned in full on startup,
+	 - for multiple reasons, including:
+	 -
+	 - * This may be the first run, and there may be remotes
+	 -   already in place, that need to be synced.
+	 - * We may have run before, and scanned a remote, but
+	 -   only been in a subdirectory of the git remote, and so
+	 -   not synced it all.
+	 - * We may have run before, and had transfers queued,
+	 -   and then the system (or us) crashed, and that info was
+	 -   lost.
+	 -}
+	startupScan = addScanRemotes True =<< syncDataRemotes <$> getDaemonStatus
 
 {- This is a cheap scan for failed transfers involving a remote. -}
-failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
-failedTransferScan st dstatus transferqueue r = do
-	failed <- runThreadState st $ getFailedTransfers (Remote.uuid r)
-	runThreadState st $ mapM_ removeFailedTransfer $ map fst failed
+failedTransferScan :: Remote -> Assistant ()
+failedTransferScan r = do
+	failed <- liftAnnex $ getFailedTransfers (Remote.uuid r)
+	liftAnnex $ mapM_ removeFailedTransfer $ map fst failed
 	mapM_ retry failed
-	where
-		retry (t, info)
-			| transferDirection t == Download = do
-				{- Check if the remote still has the key.
-				 - If not, relies on the expensiveScan to
-				 - get it queued from some other remote. -}
-				whenM (runThreadState st $ remoteHas r $ transferKey t) $
-					requeue t info
-			| otherwise = do
-				{- The Transferrer checks when uploading
-				 - that the remote doesn't already have the
-				 - key, so it's not redundantly checked
-				 - here. -}
+  where
+	retry (t, info)
+		| transferDirection t == Download = do
+			{- Check if the remote still has the key.
+			 - If not, relies on the expensiveScan to
+			 - get it queued from some other remote. -}
+			whenM (liftAnnex $ remoteHas r $ transferKey t) $
 				requeue t info
-		requeue t info = queueTransferWhenSmall
-			transferqueue dstatus (associatedFile info) t r
+		| otherwise = do
+			{- The Transferrer checks when uploading
+			 - that the remote doesn't already have the
+			 - key, so it's not redundantly checked here. -}
+			requeue t info
+	requeue t info = queueTransferWhenSmall (associatedFile info) t r
 
 {- This is a expensive scan through the full git work tree, finding
- - files to download from or upload to any known remote.
- - 
- - The scan is blocked when the transfer queue gets too large. -}
-expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> [Remote] -> IO ()
-expensiveScan st dstatus transferqueue rs = unless onlyweb $ do
-	liftIO $ debug thisThread ["starting scan of", show visiblers]
-	void $ alertWhile dstatus (scanAlert visiblers) $ do
-		g <- runThreadState st gitRepo
-		(files, cleanup) <- LsFiles.inRepo [] g
-		go files
-		void cleanup
+ - files to transfer. The scan is blocked when the transfer queue gets
+ - too large. 
+ -
+ - This also finds files that are present either here or on a remote
+ - but that are not preferred content, and drops them. Searching for files
+ - to drop is done concurrently with the scan for transfers.
+ -
+ - TODO: It would be better to first drop as much as we can, before
+ - transferring much, to minimise disk use.
+ -}
+expensiveScan :: [Remote] -> Assistant ()
+expensiveScan rs = unless onlyweb $ do
+	debug ["starting scan of", show visiblers]
+	void $ alertWhile (scanAlert visiblers) $ do
+		g <- liftAnnex gitRepo
+		(files, cleanup) <- liftIO $ LsFiles.inRepo [] g
+		forM_ files $ \f -> do
+			ts <- maybe (return []) (findtransfers f)
+				=<< liftAnnex (Backend.lookupFile f)
+			mapM_ (enqueue f) ts
+		void $ liftIO cleanup
 		return True
-	liftIO $ debug thisThread ["finished scan of", show visiblers]
-	where
-		onlyweb = all (== webUUID) $ map Remote.uuid rs
-		visiblers = let rs' = filter (not . Remote.readonly) rs
-			in if null rs' then rs else rs'
-		go [] = noop
-		go (f:fs) = do
-			mapM_ (enqueue f) =<< runThreadState st
-				(ifAnnexed f (findtransfers f) $ return [])
-			go fs
-		enqueue f (r, t) = do
-			debug thisThread ["queuing", show t]
-			queueTransferWhenSmall transferqueue dstatus (Just f) t r
-		findtransfers f (key, _) = do
+	debug ["finished scan of", show visiblers]
+  where
+	onlyweb = all (== webUUID) $ map Remote.uuid rs
+	visiblers = let rs' = filter (not . Remote.readonly) rs
+		in if null rs' then rs else rs'
+	enqueue f (r, t) = do
+		debug ["queuing", show t]
+		queueTransferWhenSmall (Just f) t r
+	findtransfers f (key, _) = do
+		{- The syncable remotes may have changed since this
+		 - scan began. -}
+		syncrs <- syncDataRemotes <$> getDaemonStatus
+		liftAnnex $ do
 			locs <- loggedLocations key
-			{- Queue transfers from any known remote. The known
-			 - remotes may have changed since this scan began. -}
-			let use a = do
-				syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
-				return $ catMaybes $ map (a key locs) syncrs
-			ifM (inAnnex key)
-				( filterM (wantSend (Just f) . Remote.uuid . fst)
-					=<< use (check Upload False)
-				, ifM (wantGet $ Just f)
-					( use (check Download True) , return [] )
-				)
-		check direction want key locs r
-			| direction == Upload && Remote.readonly r = Nothing
-			| (Remote.uuid r `elem` locs) == want = Just
-				(r, Transfer direction (Remote.uuid r) key)
-			| otherwise = Nothing
+			present <- inAnnex key
+
+			handleDrops' locs syncrs present key (Just f)
+
+			let slocs = S.fromList locs
+			let use a = return $ catMaybes $ map (a key slocs) syncrs
+			if present
+				then filterM (wantSend (Just f) . Remote.uuid . fst)
+					=<< use (genTransfer Upload False)
+				else ifM (wantGet $ Just f)
+					( use (genTransfer Download True) , return [] )
+
+genTransfer :: Direction -> Bool -> Key -> S.Set UUID -> Remote -> Maybe (Remote, Transfer)
+genTransfer direction want key slocs r
+	| direction == Upload && Remote.readonly r = Nothing
+	| (S.member (Remote.uuid r) slocs) == want = Just
+		(r, Transfer direction (Remote.uuid r) key)
+	| otherwise = Nothing
 
 remoteHas :: Remote -> Key -> Annex Bool
 remoteHas r key = elem
diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs
index a54128c..7deafb1 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -8,84 +8,78 @@
 module Assistant.Threads.TransferWatcher where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.TransferQueue
+import Assistant.Drop
 import Annex.Content
 import Logs.Transfer
 import Utility.DirWatcher
 import Utility.Types.DirWatcher
 import qualified Remote
 
-thisThread :: ThreadName
-thisThread = "TransferWatcher"
+import Control.Concurrent
 
 {- This thread watches for changes to the gitAnnexTransferDir,
  - and updates the DaemonStatus's map of ongoing transfers. -}
-transferWatcherThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> NamedThread
-transferWatcherThread st dstatus transferqueue = thread $ do
-	g <- runThreadState st gitRepo
-	let dir = gitAnnexTransferDir g
-	createDirectoryIfMissing True dir
-	let hook a = Just $ runHandler st dstatus transferqueue a
+transferWatcherThread :: NamedThread
+transferWatcherThread = NamedThread "TransferWatcher" $ do
+	dir <- liftAnnex $ gitAnnexTransferDir <$> gitRepo
+	liftIO $ createDirectoryIfMissing True dir
+	let hook a = Just <$> asIO2 (runHandler a)
+	addhook <- hook onAdd
+	delhook <- hook onDel
+	modifyhook <- hook onModify
+	errhook <- hook onErr
 	let hooks = mkWatchHooks
-		{ addHook = hook onAdd
-		, delHook = hook onDel
-		, modifyHook = hook onModify
-		, errHook = hook onErr
+		{ addHook = addhook
+		, delHook = delhook
+		, modifyHook = modifyhook
+		, errHook = errhook
 		}
-	void $ watchDir dir (const False) hooks id
-	debug thisThread ["watching for transfers"]
-	where
-		thread = NamedThread thisThread
+	void $ liftIO $ watchDir dir (const False) hooks id
+	debug ["watching for transfers"]
 
-type Handler = ThreadState -> DaemonStatusHandle -> TransferQueue -> FilePath -> Maybe FileStatus -> IO ()
+type Handler = FilePath -> Assistant ()
 
 {- Runs an action handler.
  -
  - Exceptions are ignored, otherwise a whole thread could be crashed.
  -}
-runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Handler -> FilePath -> Maybe FileStatus -> IO ()
-runHandler st dstatus transferqueue handler file filestatus = void $
-        either print (const noop) =<< tryIO go
-        where
-                go = handler st dstatus transferqueue file filestatus
+runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
+runHandler handler file _filestatus =
+        either (liftIO . print) (const noop) =<< tryIO <~> handler file
 
 {- Called when there's an error with inotify. -}
 onErr :: Handler
-onErr _ _ _ msg _ = error msg
+onErr msg = error msg
 
 {- Called when a new transfer information file is written. -}
 onAdd :: Handler
-onAdd st dstatus _ file _ = case parseTransferFile file of
+onAdd file = case parseTransferFile file of
 	Nothing -> noop
-	Just t -> go t =<< runThreadState st (checkTransfer t)
-	where
-		go _ Nothing = noop -- transfer already finished
-		go t (Just info) = do
-			debug thisThread
-				[ "transfer starting:"
-				, show t
-				]
-			r <- headMaybe . filter (sameuuid t)
-				<$> runThreadState st Remote.remoteList
-			updateTransferInfo dstatus t info
-				{ transferRemote = r }
-		sameuuid t r = Remote.uuid r == transferUUID t
+	Just t -> go t =<< liftAnnex (checkTransfer t)
+  where
+	go _ Nothing = noop -- transfer already finished
+	go t (Just info) = do
+		debug [ "transfer starting:", show t]
+		r <- headMaybe . filter (sameuuid t)
+			<$> liftAnnex Remote.remoteList
+		updateTransferInfo t info { transferRemote = r }
+	sameuuid t r = Remote.uuid r == transferUUID t
 
 {- Called when a transfer information file is updated.
  -
  - The only thing that should change in the transfer info is the
  - bytesComplete, so that's the only thing updated in the DaemonStatus. -}
 onModify :: Handler
-onModify _ dstatus _ file _ = do
+onModify file = do
 	case parseTransferFile file of
 		Nothing -> noop
-		Just t -> go t =<< readTransferInfoFile Nothing file
-	where
-		go _ Nothing = noop
-		go t (Just newinfo) = alterTransferInfo dstatus t $ \info ->
-			info { bytesComplete = bytesComplete newinfo }
+		Just t -> go t =<< liftIO (readTransferInfoFile Nothing file)
+  where
+	go _ Nothing = noop
+	go t (Just newinfo) = alterTransferInfo t $
+		\i -> i { bytesComplete = bytesComplete newinfo }
 
 {- This thread can only watch transfer sizes when the DirWatcher supports
  - tracking modificatons to files. -}
@@ -94,24 +88,36 @@ watchesTransferSize = modifyTracked
 
 {- Called when a transfer information file is removed. -}
 onDel :: Handler
-onDel st dstatus transferqueue file _ = case parseTransferFile file of
+onDel file = case parseTransferFile file of
 	Nothing -> noop
 	Just t -> do
-		debug thisThread
-			[ "transfer finishing:"
-			, show t
-			]
-		minfo <- removeTransfer dstatus t
+		debug [ "transfer finishing:", show t]
+		minfo <- removeTransfer t
+
+		finished <- asIO2 finishedTransfer
+		void $ liftIO $ forkIO $ do
+			{- XXX race workaround delay. The location
+ 			 - log needs to be updated before finishedTransfer
+ 			 - runs. -}
+			threadDelay 10000000 -- 10 seconds
+			finished t minfo
+
+{- Queue uploads of files we successfully downloaded, spreading them
+ - out to other reachable remotes.
+ -
+ - Downloading a file may have caused a remote to not want it;
+ - so drop it from the remote.
+ -
+ - Uploading a file may cause the local repo, or some other remote to not
+ - want it; handle that too.
+ -}
+finishedTransfer :: Transfer -> Maybe TransferInfo -> Assistant ()
+finishedTransfer t (Just info)
+	| transferDirection t == Download =
+		whenM (liftAnnex $ inAnnex $ transferKey t) $ do
+			handleDrops False (transferKey t) (associatedFile info)
+			queueTransfersMatching (/= transferUUID t) Later
+				(transferKey t) (associatedFile info) Upload
+	| otherwise = handleDrops True (transferKey t) (associatedFile info)
+finishedTransfer _ _ = noop
 
-		{- Queue uploads of files we successfully downloaded,
-		 - spreading them out to other reachable remotes. -}
-		case (minfo, transferDirection t) of
-			(Just info, Download) -> runThreadState st $
-				whenM (inAnnex $ transferKey t) $
-					queueTransfersMatching 
-						(/= transferUUID t)
-						Later transferqueue dstatus
-						(transferKey t)
-						(associatedFile info)
-						Upload
-			_ -> noop
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index fe06d5f..1d23487 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -8,11 +8,11 @@
 module Assistant.Threads.Transferrer where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.TransferQueue
 import Assistant.TransferSlots
 import Assistant.Alert
+import Assistant.Commits
 import Logs.Transfer
 import Logs.Location
 import Annex.Content
@@ -22,67 +22,71 @@ import Locations.UserConfig
 
 import System.Process (create_group)
 
-thisThread :: ThreadName
-thisThread = "Transferrer"
-
 {- For now only one transfer is run at a time. -}
 maxTransfers :: Int
 maxTransfers = 1
 
 {- Dispatches transfers from the queue. -}
-transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> NamedThread
-transfererThread st dstatus transferqueue slots = thread $ go =<< readProgramFile
-	where
-		thread = NamedThread thisThread
-		go program = forever $ inTransferSlot dstatus slots $
-			maybe (return Nothing) (uncurry $ startTransfer st dstatus program)
-				=<< getNextTransfer transferqueue dstatus notrunning
-		{- Skip transfers that are already running. -}
-		notrunning = isNothing . startedTime
+transfererThread :: NamedThread
+transfererThread = NamedThread "Transferr" $ do
+	program <- liftIO readProgramFile
+	forever $ inTransferSlot $
+		maybe (return Nothing) (uncurry $ startTransfer program)
+			=<< getNextTransfer notrunning
+  where
+	{- Skip transfers that are already running. -}
+	notrunning = isNothing . startedTime
 
 {- By the time this is called, the daemonstatus's transfer map should
  - already have been updated to include the transfer. -}
-startTransfer :: ThreadState -> DaemonStatusHandle -> FilePath -> Transfer -> TransferInfo -> TransferGenerator
-startTransfer st dstatus program t info = case (transferRemote info, associatedFile info) of
-	(Just remote, Just file) -> ifM (runThreadState st $ shouldTransfer t info)
+startTransfer :: FilePath -> Transfer -> TransferInfo -> Assistant (Maybe (Transfer, TransferInfo, Assistant ()))
+startTransfer program t info = case (transferRemote info, associatedFile info) of
+	(Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info)
 		( do
-			debug thisThread [ "Transferring:" , show t ]
-			notifyTransfer dstatus
+			debug [ "Transferring:" , show t ]
+			notifyTransfer
 			return $ Just (t, info, transferprocess remote file)
 		, do
-			debug thisThread [ "Skipping unnecessary transfer:" , show t ]
-			void $ removeTransfer dstatus t
+			debug [ "Skipping unnecessary transfer:" , show t ]
+			void $ removeTransfer t
 			return Nothing
 		)
 	_ -> return Nothing
-	where
-		direction = transferDirection t
-		isdownload = direction == Download
+  where
+	direction = transferDirection t
+	isdownload = direction == Download
 
-		transferprocess remote file = void $ do
-			(_, _, _, pid)
-				<- createProcess (proc program $ toCommand params)
-					{ create_group = True }
-			{- Alerts are only shown for successful transfers.
-			 - Transfers can temporarily fail for many reasons,
-			 - so there's no point in bothering the user about
-			 - those. The assistant should recover. -}
-			whenM ((==) ExitSuccess <$> waitForProcess pid) $ void $
-				addAlert dstatus $
-					makeAlertFiller True $
-						transferFileAlert direction True file
-			where
-				params =
-					[ Param "transferkey"
-					, Param "--quiet"
-					, Param $ key2file $ transferKey t
-					, Param $ if isdownload
-						then "--from"
-						else "--to"
-					, Param $ Remote.name remote
-					, Param "--file"
-					, File file
-					]
+	transferprocess remote file = void $ do
+		(_, _, _, pid)
+			<- liftIO $ createProcess (proc program $ toCommand params)
+				{ create_group = True }
+		{- Alerts are only shown for successful transfers.
+		 - Transfers can temporarily fail for many reasons,
+		 - so there's no point in bothering the user about
+		 - those. The assistant should recover.
+		 -
+		 - Also, after a successful transfer, the location
+		 - log has changed. Indicate that a commit has been
+		 - made, in order to queue a push of the git-annex
+		 - branch out to remotes that did not participate
+		 - in the transfer.
+		 -}
+		whenM (liftIO $ (==) ExitSuccess <$> waitForProcess pid) $ do
+			void $ addAlert $ makeAlertFiller True $
+				transferFileAlert direction True file
+			recordCommit
+	  where
+		params =
+			[ Param "transferkey"
+			, Param "--quiet"
+			, Param $ key2file $ transferKey t
+			, Param $ if isdownload
+				then "--from"
+				else "--to"
+			, Param $ Remote.name remote
+			, Param "--file"
+			, File file
+			]
 
 {- Checks if the file to download is already present, or the remote
  - being uploaded to isn't known to have the file. -}
@@ -100,5 +104,5 @@ shouldTransfer t info
 				notElem (Remote.uuid remote)
 					<$> loggedLocations key
 	| otherwise = return False
-	where
-		key = transferKey t
+  where
+	key = transferKey t
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 1bf9e85..a74976d 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -15,11 +15,12 @@ module Assistant.Threads.Watcher (
 ) where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.Changes
+import Assistant.Types.Changes
 import Assistant.TransferQueue
 import Assistant.Alert
+import Assistant.Drop
 import Logs.Transfer
 import Utility.DirWatcher
 import Utility.Types.DirWatcher
@@ -36,9 +37,6 @@ import Git.Types
 import Data.Bits.Utils
 import qualified Data.ByteString.Lazy as L
 
-thisThread :: ThreadName
-thisThread = "Watcher"
-
 checkCanWatch :: Annex ()
 checkCanWatch
 	| canWatch = 
@@ -54,115 +52,120 @@ needLsof = error $ unlines
 	, "Be warned: This can corrupt data in the annex, and make fsck complain."
 	]
 
-watchThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> NamedThread
-watchThread st dstatus transferqueue changechan = NamedThread thisThread $ do
-	void $ watchDir "." ignored hooks startup
-	debug thisThread [ "watching", "."]
-	where
-		startup = startupScan st dstatus
-		hook a = Just $ runHandler thisThread st dstatus transferqueue changechan a
-		hooks = mkWatchHooks
-			{ addHook = hook onAdd
-			, delHook = hook onDel
-			, addSymlinkHook = hook onAddSymlink
-			, delDirHook = hook onDelDir
-			, errHook = hook onErr
-			}
+watchThread :: NamedThread
+watchThread = NamedThread "Watcher" $ do
+	startup <- asIO1 startupScan
+	addhook <- hook onAdd
+	delhook <- hook onDel
+	addsymlinkhook <- hook onAddSymlink
+	deldirhook <- hook onDelDir
+	errhook <- hook onErr
+	let hooks = mkWatchHooks
+		{ addHook = addhook
+		, delHook = delhook
+		, addSymlinkHook = addsymlinkhook
+		, delDirHook = deldirhook
+		, errHook = errhook
+		}
+	void $ liftIO $ watchDir "." ignored hooks startup
+	debug [ "watching", "."]
+  where
+	hook a = Just <$> asIO2 (runHandler a)
 
 {- Initial scartup scan. The action should return once the scan is complete. -}
-startupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a
-startupScan st dstatus scanner = do
-	runThreadState st $ showAction "scanning"
-	alertWhile' dstatus startupScanAlert $ do
-		r <- scanner
+startupScan :: IO a -> Assistant a
+startupScan scanner = do
+	liftAnnex $ showAction "scanning"
+	alertWhile' startupScanAlert $ do
+		r <- liftIO $ scanner
 
 		-- Notice any files that were deleted before
 		-- watching was started.
-		runThreadState st $ do
+		liftAnnex $ do
 			inRepo $ Git.Command.run "add" [Param "--update"]
 			showAction "started"
 		
-		modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True }
+		modifyDaemonStatus_ $ \s -> s { scanComplete = True }
 
 		return (True, r)
 
 ignored :: FilePath -> Bool
 ignored = ig . takeFileName
-	where
+  where
 	ig ".git" = True
 	ig ".gitignore" = True
 	ig ".gitattributes" = True
 	ig _ = False
 
-type Handler = ThreadName -> FilePath -> Maybe FileStatus -> DaemonStatusHandle -> TransferQueue -> Annex (Maybe Change)
+type Handler = FilePath -> Maybe FileStatus -> Assistant (Maybe Change)
 
-{- Runs an action handler, inside the Annex monad, and if there was a
- - change, adds it to the ChangeChan.
+{- Runs an action handler, and if there was a change, adds it to the ChangeChan.
  -
  - Exceptions are ignored, otherwise a whole watcher thread could be crashed.
  -}
-runHandler :: ThreadName -> ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
-runHandler threadname st dstatus transferqueue changechan handler file filestatus = void $ do
-	r <- tryIO go
+runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
+runHandler handler file filestatus = void $ do
+	r <- tryIO <~> handler file filestatus
 	case r of
-		Left e -> print e
+		Left e -> liftIO $ print e
 		Right Nothing -> noop
-		Right (Just change) -> recordChange changechan change
-	where
-		go = runThreadState st $ handler threadname file filestatus dstatus transferqueue
+		Right (Just change) -> do
+			-- Just in case the commit thread is not
+			-- flushing the queue fast enough.
+			liftAnnex $ Annex.Queue.flushWhenFull
+			recordChange change
 
 onAdd :: Handler
-onAdd _ file filestatus _ _
+onAdd file filestatus
 	| maybe False isRegularFile filestatus = pendingAddChange file
 	| otherwise = noChange
-	where
 
 {- A symlink might be an arbitrary symlink, which is just added.
  - Or, if it is a git-annex symlink, ensure it points to the content
  - before adding it.
  -}
 onAddSymlink :: Handler
-onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.lookupFile file
-	where
-		go (Just (key, _)) = do
-			link <- calcGitLink file key
-			ifM ((==) link <$> liftIO (readSymbolicLink file))
-				( do
-					s <- liftIO $ getDaemonStatus dstatus
-					checkcontent key s
-					ensurestaged link s
-				, do
-					liftIO $ debug threadname ["fix symlink", file]
-					liftIO $ removeFile file
-					liftIO $ createSymbolicLink link file
-					addlink link
-				)
-		go Nothing = do -- other symlink
-			link <- liftIO (readSymbolicLink file)
-			ensurestaged link =<< liftIO (getDaemonStatus dstatus)
-
-		{- This is often called on symlinks that are already
-		 - staged correctly. A symlink may have been deleted
-		 - and being re-added, or added when the watcher was
-		 - not running. So they're normally restaged to make sure.
-		 -
-		 - As an optimisation, during the status scan, avoid
-		 - restaging everything. Only links that were created since
-		 - the last time the daemon was running are staged.
-		 - (If the daemon has never ran before, avoid staging
-		 - links too.)
-		 -}
-		ensurestaged link daemonstatus
-			| scanComplete daemonstatus = addlink link
-			| otherwise = case filestatus of
-				Just s
-					| not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange
-				_ -> addlink link
-
-		{- For speed, tries to reuse the existing blob for
-		 - the symlink target. -}
-		addlink link = do
-			liftIO $ debug threadname ["add symlink", file]
+onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
+  where
+	go (Just (key, _)) = do
+		link <- liftAnnex $ calcGitLink file key
+		ifM ((==) link <$> liftIO (readSymbolicLink file))
+			( do
+				s <- getDaemonStatus
+				checkcontent key s
+				ensurestaged link s
+			, do
+				liftIO $ removeFile file
+				liftIO $ createSymbolicLink link file
+				checkcontent key =<< getDaemonStatus
+				addlink link
+			)
+	go Nothing = do -- other symlink
+		link <- liftIO (readSymbolicLink file)
+		ensurestaged link =<< getDaemonStatus
+
+	{- This is often called on symlinks that are already
+	 - staged correctly. A symlink may have been deleted
+	 - and being re-added, or added when the watcher was
+	 - not running. So they're normally restaged to make sure.
+	 -
+	 - As an optimisation, during the startup scan, avoid
+	 - restaging everything. Only links that were created since
+	 - the last time the daemon was running are staged.
+	 - (If the daemon has never ran before, avoid staging
+	 - links too.)
+	 -}
+	ensurestaged link daemonstatus
+		| scanComplete daemonstatus = addlink link
+		| otherwise = case filestatus of
+			Just s
+				| not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange
+			_ -> addlink link
+
+	{- For speed, tries to reuse the existing blob for symlink target. -}
+	addlink link = do
+		debug ["add symlink", file]
+		liftAnnex $ do
 			v <- catObjectDetails $ Ref $ ':':file
 			case v of
 				Just (currlink, sha)
@@ -172,21 +175,24 @@ onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.l
 					sha <- inRepo $
 						Git.HashObject.hashObject BlobObject link
 					stageSymlink file sha
-			madeChange file LinkChange
-
-		{- When a new link appears, after the startup scan,
-		 - try to get the key's content. -}
-		checkcontent key daemonstatus
-			| scanComplete daemonstatus = unlessM (inAnnex key) $
-				queueTransfers Next transferqueue dstatus
-					key (Just file) Download
-			| otherwise = noop
+		madeChange file LinkChange
+
+	{- When a new link appears, or a link is changed, after the startup
+	 - scan, handle getting or dropping the key's content. -}
+	checkcontent key daemonstatus
+		| scanComplete daemonstatus = do
+			present <- liftAnnex $ inAnnex key
+			unless present $
+				queueTransfers Next key (Just file) Download
+			handleDrops present key (Just file)
+		| otherwise = noop
 
 onDel :: Handler
-onDel threadname file _ _dstatus _ = do
-	liftIO $ debug threadname ["file deleted", file]
-	Annex.Queue.addUpdateIndex =<<
-		inRepo (Git.UpdateIndex.unstageFile file)
+onDel file _ = do
+	debug ["file deleted", file]
+	liftAnnex $ 
+		Annex.Queue.addUpdateIndex =<<
+			inRepo (Git.UpdateIndex.unstageFile file)
 	madeChange file RmChange
 
 {- A directory has been deleted, or moved, so tell git to remove anything
@@ -197,18 +203,18 @@ onDel threadname file _ _dstatus _ = do
  - command to get the recursive list of files in the directory, so rm is
  - just as good. -}
 onDelDir :: Handler
-onDelDir threadname dir _ _dstatus _ = do
-	liftIO $ debug threadname ["directory deleted", dir]
-	Annex.Queue.addCommand "rm"
+onDelDir dir _ = do
+	debug ["directory deleted", dir]
+	liftAnnex $ Annex.Queue.addCommand "rm"
 		[Params "--quiet -r --cached --ignore-unmatch --"] [dir]
 	madeChange dir RmDirChange
 
 {- Called when there's an error with inotify or kqueue. -}
 onErr :: Handler
-onErr _ msg _ dstatus _ = do
-	warning msg
-	void $ liftIO $ addAlert dstatus $ warningAlert "watcher" msg
-	return Nothing
+onErr msg _ = do
+	liftAnnex $ warning msg
+	void $ addAlert $ warningAlert "watcher" msg
+	noChange
 
 {- Adds a symlink to the index, without ever accessing the actual symlink
  - on disk. This avoids a race if git add is used, where the symlink is
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 8b9db1e..be9a9a1 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes, CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Assistant.Threads.WebApp where
@@ -21,14 +21,13 @@ import Assistant.WebApp.Configurators.Edit
 import Assistant.WebApp.Configurators.Local
 import Assistant.WebApp.Configurators.Ssh
 import Assistant.WebApp.Configurators.Pairing
+#ifdef WITH_S3
 import Assistant.WebApp.Configurators.S3
+#endif
+import Assistant.WebApp.Configurators.XMPP
 import Assistant.WebApp.Documentation
 import Assistant.WebApp.OtherRepos
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
-import Assistant.ScanRemotes
-import Assistant.TransferQueue
-import Assistant.TransferSlots
+import Assistant.Types.ThreadedMonad
 import Utility.WebApp
 import Utility.FileMode
 import Utility.TempFile
@@ -46,64 +45,59 @@ mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
 
 type Url = String
 
-webAppThread 
-	:: Maybe ThreadState
-	-> DaemonStatusHandle
-	-> ScanRemoteMap
-	-> TransferQueue
-	-> TransferSlots
+webAppThread
+	:: AssistantData
 	-> UrlRenderer
+	-> Bool
 	-> Maybe (IO String)
 	-> Maybe (Url -> FilePath -> IO ())
 	-> NamedThread
-webAppThread mst dstatus scanremotes transferqueue transferslots urlrenderer postfirstrun onstartup = thread $ do
+webAppThread assistantdata urlrenderer noannex postfirstrun onstartup = thread $ liftIO $ do
 	webapp <- WebApp
-		<$> pure mst
-		<*> pure dstatus
-		<*> pure scanremotes
-		<*> pure transferqueue
-		<*> pure transferslots
+		<$> pure assistantdata
 		<*> (pack <$> genRandomToken)
-		<*> getreldir mst
+		<*> getreldir
 		<*> pure $(embed "static")
 		<*> newWebAppState
 		<*> pure postfirstrun
+		<*> pure noannex
 	setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
 	app <- toWaiAppPlain webapp
 	app' <- ifM debugEnabled
 		( return $ httpDebugLogger app
 		, return app
 		)
-	runWebApp app' $ \port -> case mst of
-		Nothing -> withTempFile "webapp.html" $ \tmpfile _ ->
+	runWebApp app' $ \port -> if noannex
+		then withTempFile "webapp.html" $ \tmpfile _ ->
 			go port webapp tmpfile Nothing
-		Just st -> do
+		else do
+			let st = threadState assistantdata
 			htmlshim <- runThreadState st $ fromRepo gitAnnexHtmlShim
 			urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile
 			go port webapp htmlshim (Just urlfile)
-	where
-		thread = NamedThread thisThread
-		getreldir Nothing = return Nothing
-		getreldir (Just st) = Just <$>
+  where
+	thread = NamedThread thisThread
+	getreldir
+		| noannex = return Nothing
+		| otherwise = Just <$>
 			(relHome =<< absPath
-				=<< runThreadState st (fromRepo repoPath))
-		go port webapp htmlshim urlfile = do
-			debug thisThread ["running on port", show port]
-			let url = myUrl webapp port
-			maybe noop (`writeFile` url) urlfile
-			writeHtmlShim url htmlshim
-			maybe noop (\a -> a url htmlshim) onstartup
+				=<< runThreadState (threadState assistantdata) (fromRepo repoPath))
+	go port webapp htmlshim urlfile = do
+		let url = myUrl webapp port
+		maybe noop (`writeFile` url) urlfile
+		writeHtmlShim url htmlshim
+		maybe noop (\a -> a url htmlshim) onstartup
 
 {- Creates a html shim file that's used to redirect into the webapp,
  - to avoid exposing the secretToken when launching the web browser. -}
 writeHtmlShim :: String -> FilePath -> IO ()
 writeHtmlShim url file = viaTmp go file $ genHtmlShim url
-	where
-		go tmpfile content = do
-			h <- openFile tmpfile WriteMode
-			modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
-			hPutStr h content
-			hClose h
+  where
+	go tmpfile content = do
+		h <- openFile tmpfile WriteMode
+		modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
+		hPutStr h content
+		hClose h
 
 {- TODO: generate this static file using Yesod. -}
 genHtmlShim :: String -> String
@@ -122,5 +116,5 @@ genHtmlShim url = unlines
 
 myUrl :: WebApp -> PortNumber -> Url
 myUrl webapp port = unpack $ yesodRender webapp urlbase HomeR []
-	where
-		urlbase = pack $ "http://localhost:" ++ show port
+  where
+	urlbase = pack $ "http://localhost:" ++ show port
diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
new file mode 100644
index 0000000..df602df
--- /dev/null
+++ b/Assistant/Threads/XMPPClient.hs
@@ -0,0 +1,257 @@
+{- git-annex XMPP client
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Threads.XMPPClient where
+
+import Assistant.Common
+import Assistant.XMPP
+import Assistant.XMPP.Client
+import Assistant.NetMessager
+import Assistant.Types.NetMessager
+import Assistant.Types.Buddies
+import Assistant.XMPP.Buddies
+import Assistant.Sync
+import Assistant.DaemonStatus
+import qualified Remote
+import Utility.ThreadScheduler
+import Assistant.WebApp (UrlRenderer, renderUrl)
+import Assistant.WebApp.Types
+import Assistant.Alert
+import Assistant.Pairing
+import Assistant.XMPP.Git
+import Annex.UUID
+
+import Network.Protocol.XMPP
+import Control.Concurrent
+import qualified Data.Text as T
+import qualified Data.Set as S
+import qualified Data.Map as M
+import qualified Git.Branch
+import Data.Time.Clock
+
+xmppClientThread :: UrlRenderer -> NamedThread
+xmppClientThread urlrenderer = NamedThread "XMPPClient" $
+	restartableClient . xmppClient urlrenderer =<< getAssistant id
+
+{- Runs the client, handing restart events. -}
+restartableClient :: IO () -> Assistant ()
+restartableClient a = forever $ do
+	tid <- liftIO $ forkIO a
+	waitNetMessagerRestart
+	liftIO $ killThread tid
+
+xmppClient :: UrlRenderer -> AssistantData -> IO ()
+xmppClient urlrenderer d = do
+	v <- liftAssistant $ liftAnnex getXMPPCreds
+	case v of
+		Nothing -> noop -- will be restarted once creds get configured
+		Just c -> retry (runclient c) =<< getCurrentTime
+  where
+	liftAssistant = runAssistant d
+	inAssistant = liftIO . liftAssistant
+
+	{- When the client exits, it's restarted;
+ 	 - if it keeps failing, back off to wait 5 minutes before
+	 - trying it again. -}
+	retry client starttime = do
+		e <- client
+		now <- getCurrentTime
+		if diffUTCTime now starttime > 300
+			then do
+				liftAssistant $ debug ["connection lost; reconnecting", show e]
+				retry client now
+			else do
+				liftAssistant $ debug ["connection failed; will retry", show e]
+				threadDelaySeconds (Seconds 300)
+				retry client =<< getCurrentTime
+
+	runclient c = liftIO $ connectXMPP c $ \jid -> do
+		selfjid <- bindJID jid
+		putStanza gitAnnexSignature
+
+		inAssistant $ debug ["connected", show selfjid]
+		{- The buddy list starts empty each time
+		 - the client connects, so that stale info
+		 - is not retained. -}
+		void $ inAssistant $
+			updateBuddyList (const noBuddies) <<~ buddyList
+
+		xmppThread $ receivenotifications selfjid
+		forever $ do
+			a <- inAssistant $ relayNetMessage selfjid
+			a
+
+	receivenotifications selfjid = forever $ do
+		l <- decodeStanza selfjid <$> getStanza
+		-- inAssistant $ debug ["received:", show l]
+		mapM_ (handle selfjid) l
+
+	handle _ (PresenceMessage p) = void $ inAssistant $ 
+		updateBuddyList (updateBuddies p) <<~ buddyList
+	handle _ (GotNetMessage QueryPresence) = putStanza gitAnnexSignature
+	handle _ (GotNetMessage (NotifyPush us)) = void $ inAssistant $ pull us
+	handle selfjid (GotNetMessage (PairingNotification stage c u)) =
+		maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c)
+	handle _ (GotNetMessage m@(Pushing _ pushstage))
+		| isPushInitiation pushstage = inAssistant $
+			unlessM (queueNetPushMessage m) $ 
+				void $ forkIO <~> handlePushInitiation m
+		| otherwise = void $ inAssistant $ queueNetPushMessage m
+	handle _ (Ignorable _) = noop
+	handle _ (Unknown _) = noop
+	handle _ (ProtocolError _) = noop
+
+
+data XMPPEvent
+	= GotNetMessage NetMessage
+	| PresenceMessage Presence
+	| Ignorable ReceivedStanza
+	| Unknown ReceivedStanza
+	| ProtocolError ReceivedStanza
+	deriving Show
+
+{- Decodes an XMPP stanza into one or more events. -}
+decodeStanza :: JID -> ReceivedStanza -> [XMPPEvent]
+decodeStanza selfjid s@(ReceivedPresence p)
+	| presenceType p == PresenceError = [ProtocolError s]
+	| presenceFrom p == Nothing = [Ignorable s]
+	| presenceFrom p == Just selfjid = [Ignorable s]
+	| otherwise = maybe [PresenceMessage p] decode (gitAnnexTagInfo p)
+  where
+	decode i
+		| tagAttr i == pushAttr = impliedp $ GotNetMessage $ NotifyPush $
+			decodePushNotification (tagValue i)
+		| tagAttr i == queryAttr = impliedp $ GotNetMessage QueryPresence
+		| otherwise = [Unknown s]
+	{- Things sent via presence imply a presence message,
+	 - along with their real meaning. -}
+	impliedp v = [PresenceMessage p, v]
+decodeStanza selfjid s@(ReceivedMessage m)
+	| messageFrom m == Nothing = [Ignorable s]
+	| messageFrom m == Just selfjid = [Ignorable s]
+	| messageType m == MessageError = [ProtocolError s]
+	| otherwise = [fromMaybe (Unknown s) (GotNetMessage <$> decodeMessage m)]
+decodeStanza _ s = [Unknown s]
+
+{- Waits for a NetMessager message to be sent, and relays it to XMPP.
+ -
+ - Chat messages must be directed to specific clients, not a base
+ - account JID, due to git-annex clients using a negative presence priority.
+ - PairingNotification messages are always directed at specific
+ - clients, but Pushing messages are sometimes not, and need to be exploded.
+ -}
+relayNetMessage :: JID -> Assistant (XMPP ())
+relayNetMessage selfjid = convert =<< waitNetMessage
+  where
+	convert (NotifyPush us) = return $ putStanza $ pushNotification us
+	convert QueryPresence = return $ putStanza presenceQuery
+	convert (PairingNotification stage c u) = withclient c $ \tojid -> do
+		changeBuddyPairing tojid True
+		return $ putStanza $ pairingNotification stage u tojid selfjid
+	convert (Pushing c pushstage) = withclient c $ \tojid -> do
+		if tojid == baseJID tojid
+			then do
+				bud <- getBuddy (genBuddyKey tojid) <<~ buddyList
+				return $ forM_ (maybe [] (S.toList . buddyAssistants) bud) $ \(Client jid) ->
+					putStanza $ pushMessage pushstage jid selfjid
+			else return $ putStanza $ pushMessage pushstage tojid selfjid
+
+	withclient c a = case parseJID c of
+		Nothing -> return noop
+		Just tojid
+			| tojid == selfjid -> return noop
+			| otherwise -> a tojid
+
+{- Runs a XMPP action in a separate thread, using a session to allow it
+ - to access the same XMPP client. -}
+xmppThread :: XMPP () -> XMPP ()
+xmppThread a = do
+	s <- getSession
+	void $ liftIO $ forkIO $
+		void $ runXMPP s a
+
+{- We only pull from one remote out of the set listed in the push
+ - notification, as an optimisation.
+ -
+ - Note that it might be possible (though very unlikely) for the push
+ - notification to take a while to be sent, and multiple pushes happen
+ - before it is sent, so it includes multiple remotes that were pushed
+ - to at different times. 
+ -
+ - It could then be the case that the remote we choose had the earlier
+ - push sent to it, but then failed to get the later push, and so is not
+ - fully up-to-date. If that happens, the pushRetryThread will come along
+ - and retry the push, and we'll get another notification once it succeeds,
+ - and pull again. -}
+pull :: [UUID] -> Assistant ()
+pull [] = noop
+pull us = do
+	rs <- filter matching . syncGitRemotes <$> getDaemonStatus
+	debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs
+	pullone rs =<< liftAnnex (inRepo Git.Branch.current)
+  where
+	matching r = Remote.uuid r `S.member` s
+	s = S.fromList us
+
+	pullone [] _ = noop
+	pullone (r:rs) branch =
+		unlessM (all id . fst <$> manualPull branch [r]) $
+			pullone rs branch
+
+pairMsgReceived :: UrlRenderer -> PairStage -> UUID -> JID -> JID -> Assistant ()
+pairMsgReceived urlrenderer PairReq theiruuid selfjid theirjid
+	| baseJID selfjid == baseJID theirjid = autoaccept
+	| otherwise = do
+		knownjids <- catMaybes . map (parseJID . getXMPPClientID)
+			. filter isXMPPRemote . syncRemotes <$> getDaemonStatus
+		if any (== baseJID theirjid) knownjids
+			then autoaccept
+			else showalert
+
+  where
+	-- PairReq from another client using our JID, or the JID of
+	-- any repo we're already paired with is automatically accepted.
+	autoaccept = do
+		selfuuid <- liftAnnex getUUID
+		sendNetMessage $
+			PairingNotification PairAck (formatJID theirjid) selfuuid
+		finishXMPPPairing theirjid theiruuid
+	-- Show an alert to let the user decide if they want to pair.
+	showalert = do
+		let route = ConfirmXMPPPairR (PairKey theiruuid $ formatJID theirjid)
+		url <- liftIO $ renderUrl urlrenderer route []
+		close <- asIO1 removeAlert
+		void $ addAlert $ pairRequestReceivedAlert (T.unpack $ buddyName theirjid)
+			AlertButton
+				{ buttonUrl = url
+				, buttonLabel = T.pack "Respond"
+				, buttonAction = Just close
+				}
+
+pairMsgReceived _ PairAck theiruuid _selfjid theirjid =
+	{- PairAck must come from one of the buddies we are pairing with;
+	 - don't pair with just anyone. -}
+	whenM (isBuddyPairing theirjid) $ do
+		changeBuddyPairing theirjid False
+		selfuuid <- liftAnnex getUUID
+		sendNetMessage $
+			PairingNotification PairDone (formatJID theirjid) selfuuid
+		finishXMPPPairing theirjid theiruuid
+
+pairMsgReceived _ PairDone _theiruuid _selfjid theirjid =
+	changeBuddyPairing theirjid False
+
+isBuddyPairing :: JID -> Assistant Bool
+isBuddyPairing jid = maybe False buddyPairing <$> 
+	getBuddy (genBuddyKey jid) <<~ buddyList
+
+changeBuddyPairing :: JID -> Bool -> Assistant ()
+changeBuddyPairing jid ispairing =
+	updateBuddyList (M.adjust set key) <<~ buddyList
+  where
+	key = genBuddyKey jid
+	set b = b { buddyPairing = ispairing }
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index 125b6d1..4d46b09 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -21,8 +21,9 @@ module Assistant.TransferQueue (
 	dequeueTransfers,
 ) where
 
-import Common.Annex
+import Assistant.Common
 import Assistant.DaemonStatus
+import Assistant.Types.TransferQueue
 import Logs.Transfer
 import Types.Remote
 import qualified Remote
@@ -32,24 +33,9 @@ import Annex.Wanted
 import Control.Concurrent.STM
 import qualified Data.Map as M
 
-data TransferQueue = TransferQueue
-	{ queuesize :: TVar Int
-	, queuelist :: TVar [(Transfer, TransferInfo)]
-	, deferreddownloads :: TVar [(Key, AssociatedFile)]
-	}
-
-data Schedule = Next | Later
-	deriving (Eq)
-
-newTransferQueue :: IO TransferQueue
-newTransferQueue = atomically $ TransferQueue
-	<$> newTVar 0
-	<*> newTVar []
-	<*> newTVar []
-
 {- Reads the queue's content without blocking or changing it. -}
-getTransferQueue :: TransferQueue -> IO [(Transfer, TransferInfo)]
-getTransferQueue q = atomically $ readTVar $ queuelist q
+getTransferQueue :: Assistant [(Transfer, TransferInfo)]
+getTransferQueue = (atomically . readTVar . queuelist) <<~ transferQueue
 
 stubInfo :: AssociatedFile -> Remote -> TransferInfo
 stubInfo f r = stubTransferInfo
@@ -59,101 +45,104 @@ stubInfo f r = stubTransferInfo
 
 {- Adds transfers to queue for some of the known remotes.
  - Honors preferred content settings, only transferring wanted files. -}
-queueTransfers :: Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex ()
+queueTransfers :: Schedule -> Key -> AssociatedFile -> Direction -> Assistant ()
 queueTransfers = queueTransfersMatching (const True)
 
 {- Adds transfers to queue for some of the known remotes, that match a
  - condition. Honors preferred content settings. -}
-queueTransfersMatching :: (UUID -> Bool) -> Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex ()
-queueTransfersMatching matching schedule q dstatus k f direction
-	| direction == Download = whenM (wantGet f) go
+queueTransfersMatching :: (UUID -> Bool) -> Schedule -> Key -> AssociatedFile -> Direction -> Assistant ()
+queueTransfersMatching matching schedule k f direction
+	| direction == Download = whenM (liftAnnex $ wantGet f) go
 	| otherwise = go
-	where
-		go = do
-			rs <- sufficientremotes
-				=<< syncRemotes <$> liftIO (getDaemonStatus dstatus)
-			let matchingrs = filter (matching . Remote.uuid) rs
-			if null matchingrs
-				then defer
-				else forM_ matchingrs $ \r -> liftIO $
-					enqueue schedule q dstatus (gentransfer r) (stubInfo f r)
-		sufficientremotes rs
-			{- Queue downloads from all remotes that
-			 - have the key, with the cheapest ones first.
-			 - More expensive ones will only be tried if
-			 - downloading from a cheap one fails. -}
-			| direction == Download = do
-				uuids <- Remote.keyLocations k
-				return $ filter (\r -> uuid r `elem` uuids) rs
-			{- Upload to all remotes that want the content. -}
-			| otherwise = filterM (wantSend f . Remote.uuid) $
-				filter (not . Remote.readonly) rs
-		gentransfer r = Transfer
-			{ transferDirection = direction
-			, transferKey = k
-			, transferUUID = Remote.uuid r
-			}
-		defer
-			{- Defer this download, as no known remote has the key. -}
-			| direction == Download = void $ liftIO $ atomically $
-					modifyTVar' (deferreddownloads q) $
-						\l -> (k, f):l
-			| otherwise = noop
+  where
+	go = do
+		rs <- liftAnnex . sufficientremotes
+			=<< syncDataRemotes <$> getDaemonStatus
+		let matchingrs = filter (matching . Remote.uuid) rs
+		if null matchingrs
+			then defer
+			else forM_ matchingrs $ \r ->
+				enqueue schedule (gentransfer r) (stubInfo f r)
+	sufficientremotes rs
+		{- Queue downloads from all remotes that
+		 - have the key, with the cheapest ones first.
+		 - More expensive ones will only be tried if
+		 - downloading from a cheap one fails. -}
+		| direction == Download = do
+			uuids <- Remote.keyLocations k
+			return $ filter (\r -> uuid r `elem` uuids) rs
+		{- Upload to all remotes that want the content. -}
+		| otherwise = filterM (wantSend f . Remote.uuid) $
+			filter (not . Remote.readonly) rs
+	gentransfer r = Transfer
+		{ transferDirection = direction
+		, transferKey = k
+		, transferUUID = Remote.uuid r
+		}
+	defer
+		{- Defer this download, as no known remote has the key. -}
+		| direction == Download = do
+			q <- getAssistant transferQueue
+			void $ liftIO $ atomically $
+				modifyTVar' (deferreddownloads q) $
+					\l -> (k, f):l
+		| otherwise = noop
 
 {- Queues any deferred downloads that can now be accomplished, leaving
  - any others in the list to try again later. -}
-queueDeferredDownloads :: Schedule -> TransferQueue -> DaemonStatusHandle -> Annex ()
-queueDeferredDownloads schedule q dstatus = do
+queueDeferredDownloads :: Schedule -> Assistant ()
+queueDeferredDownloads schedule = do
+	q <- getAssistant transferQueue
 	l <- liftIO $ atomically $ swapTVar (deferreddownloads q) []
-	rs <- syncRemotes <$> liftIO (getDaemonStatus dstatus)
+	rs <- syncDataRemotes <$> getDaemonStatus
 	left <- filterM (queue rs) l
 	unless (null left) $
 		liftIO $ atomically $ modifyTVar' (deferreddownloads q) $
 			\new -> new ++ left
-	where
-		queue rs (k, f) = do
-			uuids <- Remote.keyLocations k
-			let sources = filter (\r -> uuid r `elem` uuids) rs
-			unless (null sources) $
-				forM_ sources $ \r -> liftIO $
-					enqueue schedule q dstatus
-						(gentransfer r) (stubInfo f r)
-			return $ null sources
-			where
-				gentransfer r = Transfer
-					{ transferDirection = Download
-					, transferKey = k
-					, transferUUID = Remote.uuid r
-					}
-
-enqueue :: Schedule -> TransferQueue -> DaemonStatusHandle -> Transfer -> TransferInfo -> IO ()
-enqueue schedule q dstatus t info
+  where
+	queue rs (k, f) = do
+		uuids <- liftAnnex $ Remote.keyLocations k
+		let sources = filter (\r -> uuid r `elem` uuids) rs
+		unless (null sources) $
+			forM_ sources $ \r ->
+				enqueue schedule (gentransfer r) (stubInfo f r)
+		return $ null sources
+	  where
+		gentransfer r = Transfer
+			{ transferDirection = Download
+			, transferKey = k
+			, transferUUID = Remote.uuid r
+			}
+
+enqueue :: Schedule -> Transfer -> TransferInfo -> Assistant ()
+enqueue schedule t info
 	| schedule == Next = go (new:)
 	| otherwise = go (\l -> l++[new])
-	where
-		new = (t, info)
-		go modlist = do
-			atomically $ do
-				void $ modifyTVar' (queuesize q) succ
-				void $ modifyTVar' (queuelist q) modlist
-			void $ notifyTransfer dstatus
+  where
+	new = (t, info)
+	go modlist = do
+		q <- getAssistant transferQueue
+		liftIO $ atomically $ do
+			void $ modifyTVar' (queuesize q) succ
+			void $ modifyTVar' (queuelist q) modlist
+		notifyTransfer
 
 {- Adds a transfer to the queue. -}
-queueTransfer :: Schedule -> TransferQueue -> DaemonStatusHandle -> AssociatedFile -> Transfer -> Remote -> IO ()
-queueTransfer schedule q dstatus f t remote =
-	enqueue schedule q dstatus t (stubInfo f remote)
+queueTransfer :: Schedule -> AssociatedFile -> Transfer -> Remote -> Assistant ()
+queueTransfer schedule f t remote = enqueue schedule t (stubInfo f remote)
 
 {- Blocks until the queue is no larger than a given size, and then adds a
  - transfer to the queue. -}
-queueTransferAt :: Int -> Schedule -> TransferQueue -> DaemonStatusHandle -> AssociatedFile -> Transfer -> Remote -> IO ()
-queueTransferAt wantsz schedule q dstatus f t remote = do
-	atomically $ do
+queueTransferAt :: Int -> Schedule -> AssociatedFile -> Transfer -> Remote -> Assistant ()
+queueTransferAt wantsz schedule f t remote = do
+	q <- getAssistant transferQueue
+	liftIO $ atomically $ do
 		sz <- readTVar (queuesize q)
 		unless (sz <= wantsz) $
 			retry -- blocks until queuesize changes
-	enqueue schedule q dstatus t (stubInfo f remote)
+	enqueue schedule t (stubInfo f remote)
 
-queueTransferWhenSmall :: TransferQueue -> DaemonStatusHandle -> AssociatedFile -> Transfer -> Remote -> IO ()
+queueTransferWhenSmall :: AssociatedFile -> Transfer -> Remote -> Assistant ()
 queueTransferWhenSmall = queueTransferAt 10 Later
 
 {- Blocks until a pending transfer is available in the queue,
@@ -164,38 +153,45 @@ queueTransferWhenSmall = queueTransferAt 10 Later
  -
  - This is done in a single STM transaction, so there is no window
  - where an observer sees an inconsistent status. -}
-getNextTransfer :: TransferQueue -> DaemonStatusHandle -> (TransferInfo -> Bool) -> IO (Maybe (Transfer, TransferInfo))
-getNextTransfer q dstatus acceptable = atomically $ do
-	sz <- readTVar (queuesize q)
-	if sz < 1
-		then retry -- blocks until queuesize changes
-		else do
-			(r@(t,info):rest) <- readTVar (queuelist q)
-			writeTVar (queuelist q) rest
-			void $ modifyTVar' (queuesize q) pred
-			if acceptable info
-				then do
-					adjustTransfersSTM dstatus $
-						M.insertWith' const t info
-					return $ Just r
-				else return Nothing
+getNextTransfer :: (TransferInfo -> Bool) -> Assistant (Maybe (Transfer, TransferInfo))
+getNextTransfer acceptable = do
+	q <- getAssistant transferQueue
+	dstatus <- getAssistant daemonStatusHandle
+	liftIO $ atomically $ do
+		sz <- readTVar (queuesize q)
+		if sz < 1
+			then retry -- blocks until queuesize changes
+			else do
+				(r@(t,info):rest) <- readTVar (queuelist q)
+				writeTVar (queuelist q) rest
+				void $ modifyTVar' (queuesize q) pred
+				if acceptable info
+					then do
+						adjustTransfersSTM dstatus $
+							M.insertWith' const t info
+						return $ Just r
+					else return Nothing
 
 {- Moves transfers matching a condition from the queue, to the
  - currentTransfers map. -}
-getMatchingTransfers :: TransferQueue -> DaemonStatusHandle -> (Transfer -> Bool) -> IO [(Transfer, TransferInfo)]
-getMatchingTransfers q dstatus c = atomically $ do
-	ts <- dequeueTransfersSTM q c
-	unless (null ts) $
-		adjustTransfersSTM dstatus $ \m -> M.union m $ M.fromList ts
-	return ts
+getMatchingTransfers :: (Transfer -> Bool) -> Assistant [(Transfer, TransferInfo)]
+getMatchingTransfers c = do
+	q <- getAssistant transferQueue
+	dstatus <- getAssistant daemonStatusHandle
+	liftIO $ atomically $ do
+		ts <- dequeueTransfersSTM q c
+		unless (null ts) $
+			adjustTransfersSTM dstatus $ \m -> M.union m $ M.fromList ts
+		return ts
 
 {- Removes transfers matching a condition from the queue, and returns the
  - removed transfers. -}
-dequeueTransfers :: TransferQueue -> DaemonStatusHandle -> (Transfer -> Bool) -> IO [(Transfer, TransferInfo)]
-dequeueTransfers q dstatus c = do
-	removed <- atomically $ dequeueTransfersSTM q c
+dequeueTransfers :: (Transfer -> Bool) -> Assistant [(Transfer, TransferInfo)]
+dequeueTransfers c = do
+	q <- getAssistant transferQueue
+	removed <- liftIO $ atomically $ dequeueTransfersSTM q c
 	unless (null removed) $
-		notifyTransfer dstatus
+		notifyTransfer
 	return removed
 
 dequeueTransfersSTM :: TransferQueue -> (Transfer -> Bool) -> STM [(Transfer, TransferInfo)]
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index 9e9156a..7c9f747 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -5,56 +5,34 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE DeriveDataTypeable #-}
-
 module Assistant.TransferSlots where
 
-import Common.Annex
+import Assistant.Common
 import Utility.ThreadScheduler
+import Assistant.Types.TransferSlots
 import Assistant.DaemonStatus
 import Logs.Transfer
 
 import qualified Control.Exception as E
 import Control.Concurrent
-import Data.Typeable
-
-type TransferSlots = QSemN
-
-{- A special exception that can be thrown to pause or resume a transfer, while
- - keeping its slot in use. -}
-data TransferException = PauseTransfer | ResumeTransfer
-	deriving (Show, Eq, Typeable)
+import qualified Control.Concurrent.MSemN as MSemN
 
-instance E.Exception TransferException
-
-type TransferSlotRunner = DaemonStatusHandle -> TransferSlots -> TransferGenerator -> IO ()
-type TransferGenerator = IO (Maybe (Transfer, TransferInfo, IO ()))
-
-{- Number of concurrent transfers allowed to be run from the assistant.
- -
- - Transfers launched by other means, including by remote assistants,
- - do not currently take up slots.
- -}
-numSlots :: Int
-numSlots = 1
-
-newTransferSlots :: IO TransferSlots
-newTransferSlots = newQSemN numSlots
+type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Assistant ()))
 
 {- Waits until a transfer slot becomes available, then runs a
  - TransferGenerator, and then runs the transfer action in its own thread. 
  -}
-inTransferSlot :: TransferSlotRunner
-inTransferSlot dstatus s gen = do
-	waitQSemN s 1
-	runTransferThread dstatus s =<< gen
+inTransferSlot :: TransferGenerator -> Assistant ()
+inTransferSlot gen = do
+	flip MSemN.wait 1 <<~ transferSlots
+	runTransferThread =<< gen
 
 {- Runs a TransferGenerator, and its transfer action,
  - without waiting for a slot to become available. -}
-inImmediateTransferSlot :: TransferSlotRunner
-inImmediateTransferSlot dstatus s gen = do
-	signalQSemN s (-1)
-	runTransferThread dstatus s =<< gen
+inImmediateTransferSlot :: TransferGenerator -> Assistant ()
+inImmediateTransferSlot gen = do
+	flip MSemN.signal (-1) <<~ transferSlots
+	runTransferThread =<< gen
 
 {- Runs a transfer action, in an already allocated transfer slot.
  - Once it finishes, frees the transfer slot.
@@ -66,24 +44,30 @@ inImmediateTransferSlot dstatus s gen = do
  - then pausing the thread until a ResumeTransfer exception is raised,
  - then rerunning the action.
  -}
-runTransferThread :: DaemonStatusHandle -> TransferSlots -> Maybe (Transfer, TransferInfo, IO ()) -> IO ()
-runTransferThread _ s  Nothing = signalQSemN s 1
-runTransferThread dstatus s (Just (t, info, a)) = do
-	tid <- forkIO go
-	updateTransferInfo dstatus t $ info { transferTid = Just tid }
-	where
-		go = catchPauseResume a
-		pause = catchPauseResume $ runEvery (Seconds 86400) noop
-		{- Note: This must use E.try, rather than E.catch.
-		 - When E.catch is used, and has called go in its exception
-		 - handler, Control.Concurrent.throwTo will block sometimes
-		 - when signaling. Using E.try avoids the problem. -}
-		catchPauseResume a' = do
-			r <- E.try a' :: IO (Either E.SomeException ())
-			case r of
-				Left e -> case E.fromException e of
-					Just PauseTransfer -> pause
-					Just ResumeTransfer -> go
-					_ -> done
+runTransferThread :: Maybe (Transfer, TransferInfo, Assistant ()) -> Assistant ()
+runTransferThread Nothing = flip MSemN.signal 1 <<~ transferSlots
+runTransferThread (Just (t, info, a)) = do
+	d <- getAssistant id
+	aio <- asIO a
+	tid <- liftIO $ forkIO $ runTransferThread' d aio
+	updateTransferInfo t $ info { transferTid = Just tid }
+
+runTransferThread' :: AssistantData -> IO () -> IO ()
+runTransferThread' d a = go
+  where
+	go = catchPauseResume a
+	pause = catchPauseResume $ runEvery (Seconds 86400) noop
+	{- Note: This must use E.try, rather than E.catch.
+	 - When E.catch is used, and has called go in its exception
+	 - handler, Control.Concurrent.throwTo will block sometimes
+	 - when signaling. Using E.try avoids the problem. -}
+	catchPauseResume a' = do
+		r <- E.try a' :: IO (Either E.SomeException ())
+		case r of
+			Left e -> case E.fromException e of
+				Just PauseTransfer -> pause
+				Just ResumeTransfer -> go
 				_ -> done
-		done = signalQSemN s 1
+			_ -> done
+	done = runAssistant d $ 
+		flip MSemN.signal 1 <<~ transferSlots
diff --git a/Assistant/Types/BranchChange.hs b/Assistant/Types/BranchChange.hs
new file mode 100644
index 0000000..399abee
--- /dev/null
+++ b/Assistant/Types/BranchChange.hs
@@ -0,0 +1,19 @@
+{- git-annex assistant git-annex branch change tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.BranchChange where
+
+import Control.Concurrent.MSampleVar
+import Common.Annex
+
+newtype BranchChangeHandle = BranchChangeHandle (MSampleVar ())
+
+newBranchChangeHandle :: IO BranchChangeHandle
+newBranchChangeHandle = BranchChangeHandle <$> newEmptySV
+
+fromBranchChangeHandle :: BranchChangeHandle -> MSampleVar ()
+fromBranchChangeHandle (BranchChangeHandle v) = v
diff --git a/Assistant/Types/Buddies.hs b/Assistant/Types/Buddies.hs
new file mode 100644
index 0000000..36d8a4f
--- /dev/null
+++ b/Assistant/Types/Buddies.hs
@@ -0,0 +1,80 @@
+{- git-annex assistant buddies
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Assistant.Types.Buddies where
+
+import Common.Annex
+
+import qualified Data.Map as M
+import Control.Concurrent.STM
+import Utility.NotificationBroadcaster
+import Data.Text as T
+
+{- For simplicity, dummy types are defined even when XMPP is disabled. -}
+#ifdef WITH_XMPP
+import Network.Protocol.XMPP
+import Data.Set as S
+import Data.Ord
+
+newtype Client = Client JID
+	deriving (Eq, Show)
+
+instance Ord Client where
+	compare = comparing show
+
+data Buddy = Buddy
+	{ buddyPresent :: S.Set Client
+	, buddyAway :: S.Set Client
+	, buddyAssistants :: S.Set Client
+	, buddyPairing :: Bool
+	}
+#else
+data Buddy = Buddy
+#endif
+	deriving (Eq, Show)
+
+data BuddyKey = BuddyKey T.Text
+	deriving (Eq, Ord, Show, Read)
+
+data PairKey = PairKey UUID T.Text
+	deriving (Eq, Ord, Show, Read)
+
+type Buddies = M.Map BuddyKey Buddy
+
+{- A list of buddies, and a way to notify when it changes. -}
+type BuddyList = (TMVar Buddies, NotificationBroadcaster)
+
+noBuddies :: Buddies
+noBuddies = M.empty
+
+newBuddyList :: IO BuddyList
+newBuddyList = (,)
+	<$> atomically (newTMVar noBuddies)
+	<*> newNotificationBroadcaster
+
+getBuddyList :: BuddyList -> IO [Buddy]
+getBuddyList (v, _) = M.elems <$> atomically (readTMVar v)
+
+getBuddy :: BuddyKey -> BuddyList -> IO (Maybe Buddy)
+getBuddy k (v, _) = M.lookup k <$> atomically (readTMVar v)
+
+getBuddyBroadcaster :: BuddyList -> NotificationBroadcaster
+getBuddyBroadcaster (_, h) = h
+
+{- Applies a function to modify the buddy list, and if it's changed,
+ - sends notifications to any listeners. -}
+updateBuddyList :: (Buddies -> Buddies) -> BuddyList -> IO ()
+updateBuddyList a (v, caster) = do
+	changed <- atomically $ do
+		buds <- takeTMVar v
+		let buds' = a buds
+		putTMVar v buds'
+		return $ buds /= buds'
+	when changed $
+		sendNotification caster
diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs
new file mode 100644
index 0000000..887aa81
--- /dev/null
+++ b/Assistant/Types/Changes.hs
@@ -0,0 +1,54 @@
+{- git-annex assistant change tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.Changes where
+
+import Types.KeySource
+import Utility.TSet
+
+import Data.Time.Clock
+
+data ChangeType = AddChange | LinkChange | RmChange | RmDirChange
+	deriving (Show, Eq)
+
+type ChangeChan = TSet Change
+
+data Change
+	= Change 
+		{ changeTime :: UTCTime
+		, changeFile :: FilePath
+		, changeType :: ChangeType
+		}
+	| PendingAddChange
+		{ changeTime ::UTCTime
+		, changeFile :: FilePath
+		}
+	| InProcessAddChange
+		{ changeTime ::UTCTime
+		, keySource :: KeySource
+		}
+	deriving (Show)
+
+newChangeChan :: IO ChangeChan
+newChangeChan = newTSet
+
+isPendingAddChange :: Change -> Bool
+isPendingAddChange (PendingAddChange {}) = True
+isPendingAddChange _ = False
+
+isInProcessAddChange :: Change -> Bool
+isInProcessAddChange (InProcessAddChange {}) = True
+isInProcessAddChange _ = False
+
+finishedChange :: Change -> Change
+finishedChange c@(InProcessAddChange { keySource = ks }) = Change
+	{ changeTime = changeTime c
+	, changeFile = keyFilename ks
+	, changeType = AddChange
+	}
+finishedChange c = c
+
diff --git a/Assistant/Types/Commits.hs b/Assistant/Types/Commits.hs
new file mode 100644
index 0000000..bb17c57
--- /dev/null
+++ b/Assistant/Types/Commits.hs
@@ -0,0 +1,17 @@
+{- git-annex assistant commit tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.Commits where
+
+import Utility.TSet
+
+type CommitChan = TSet Commit
+
+data Commit = Commit
+
+newCommitChan :: IO CommitChan
+newCommitChan = newTSet
diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs
new file mode 100644
index 0000000..df0928d
--- /dev/null
+++ b/Assistant/Types/DaemonStatus.hs
@@ -0,0 +1,72 @@
+{- git-annex assistant daemon status
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE RankNTypes, ImpredicativeTypes #-}
+
+module Assistant.Types.DaemonStatus where
+
+import Common.Annex
+import Assistant.Alert
+import Assistant.Pairing
+import Utility.NotificationBroadcaster
+import Logs.Transfer
+
+import Control.Concurrent.STM
+import Data.Time.Clock.POSIX
+import qualified Data.Map as M
+
+data DaemonStatus = DaemonStatus
+	-- False when the daemon is performing its startup scan
+	{ scanComplete :: Bool
+	-- Time when a previous process of the daemon was running ok
+	, lastRunning :: Maybe POSIXTime
+	-- True when the sanity checker is running
+	, sanityCheckRunning :: Bool
+	-- Last time the sanity checker ran
+	, lastSanityCheck :: Maybe POSIXTime
+	-- Currently running file content transfers
+	, currentTransfers :: TransferMap
+	-- Messages to display to the user.
+	, alertMap :: AlertMap
+	, lastAlertId :: AlertId
+	-- Ordered list of all remotes that can be synced with
+	, syncRemotes :: [Remote]
+	-- Ordered list of remotes to sync git with
+	, syncGitRemotes :: [Remote]
+	-- Ordered list of remotes to sync data with
+	, syncDataRemotes :: [Remote]
+	-- Pairing request that is in progress.
+	, pairingInProgress :: Maybe PairingInProgress
+	-- Broadcasts notifications about all changes to the DaemonStatus
+	, changeNotifier :: NotificationBroadcaster
+	-- Broadcasts notifications when queued or current transfers change.
+	, transferNotifier :: NotificationBroadcaster
+	-- Broadcasts notifications when there's a change to the alerts
+	, alertNotifier :: NotificationBroadcaster
+	}
+
+type TransferMap = M.Map Transfer TransferInfo
+
+{- This TMVar is never left empty, so accessing it will never block. -}
+type DaemonStatusHandle = TMVar DaemonStatus
+
+newDaemonStatus :: IO DaemonStatus
+newDaemonStatus = DaemonStatus
+	<$> pure False
+	<*> pure Nothing
+	<*> pure False
+	<*> pure Nothing
+	<*> pure M.empty
+	<*> pure M.empty
+	<*> pure firstAlertId
+	<*> pure []
+	<*> pure []
+	<*> pure []
+	<*> pure Nothing
+	<*> newNotificationBroadcaster
+	<*> newNotificationBroadcaster
+	<*> newNotificationBroadcaster
diff --git a/Assistant/Types/NamedThread.hs b/Assistant/Types/NamedThread.hs
new file mode 100644
index 0000000..569f787
--- /dev/null
+++ b/Assistant/Types/NamedThread.hs
@@ -0,0 +1,21 @@
+{- git-annex assistant named threads.
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.NamedThread where
+
+import Common.Annex
+import Assistant.Monad
+
+import System.Log.Logger
+
+type ThreadName = String
+data NamedThread = NamedThread ThreadName (Assistant ())
+
+debug :: [String] -> Assistant ()
+debug ws = do
+	name <- getAssistant threadName
+	liftIO $ debugM name $ unwords $ (name ++ ":") : ws
diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs
new file mode 100644
index 0000000..c036d62
--- /dev/null
+++ b/Assistant/Types/NetMessager.hs
@@ -0,0 +1,101 @@
+{- git-annex assistant out of band network messager types
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.NetMessager where
+
+import Common.Annex
+import Assistant.Pairing
+
+import Data.Text (Text)
+import Control.Concurrent.STM
+import Control.Concurrent.MSampleVar
+import Data.ByteString (ByteString)
+import qualified Data.Set as S
+
+{- Messages that can be sent out of band by a network messager. -}
+data NetMessage 
+	-- indicate that pushes have been made to the repos with these uuids
+	= NotifyPush [UUID]
+	-- requests other clients to inform us of their presence
+	| QueryPresence
+	-- notification about a stage in the pairing process,
+	-- involving a client, and a UUID.
+	| PairingNotification PairStage ClientID UUID
+	-- used for git push over the network messager
+	| Pushing ClientID PushStage
+	deriving (Show, Eq, Ord)
+
+{- Something used to identify the client, or clients to send the message to. -}
+type ClientID = Text
+
+data PushStage
+	-- indicates that we have data to push over the out of band network
+	= CanPush
+	-- request that a git push be sent over the out of band network
+	| PushRequest
+	-- indicates that a push is starting
+	| StartingPush
+	-- a chunk of output of git receive-pack
+	| ReceivePackOutput ByteString
+	-- a chuck of output of git send-pack
+	| SendPackOutput ByteString
+	-- sent when git receive-pack exits, with its exit code
+	| ReceivePackDone ExitCode
+	deriving (Show, Eq, Ord)
+
+{- Things that initiate either side of a push, but do not actually send data. -}
+isPushInitiation :: PushStage -> Bool
+isPushInitiation CanPush = True
+isPushInitiation PushRequest = True
+isPushInitiation StartingPush = True
+isPushInitiation _ = False
+
+data PushSide = SendPack | ReceivePack
+	deriving (Eq, Ord)
+
+pushDestinationSide :: PushStage -> PushSide
+pushDestinationSide CanPush = ReceivePack
+pushDestinationSide PushRequest = SendPack
+pushDestinationSide StartingPush = ReceivePack
+pushDestinationSide (ReceivePackOutput _) = SendPack
+pushDestinationSide (SendPackOutput _) = ReceivePack
+pushDestinationSide (ReceivePackDone _) = SendPack
+
+type SideMap a = PushSide -> a
+
+mkSideMap :: STM a -> IO (SideMap a)
+mkSideMap gen = do
+	(sp, rp) <- atomically $ (,) <$> gen <*> gen
+	return $ lookupside sp rp
+  where
+	lookupside sp _ SendPack = sp
+	lookupside _ rp ReceivePack = rp
+
+getSide :: PushSide -> SideMap a -> a
+getSide side m = m side
+
+data NetMessager = NetMessager
+	-- outgoing messages
+	{ netMessages :: TChan (NetMessage)
+	-- write to this to restart the net messager
+	, netMessagerRestart :: MSampleVar ()
+	-- only one side of a push can be running at a time
+	, netMessagerPushRunning :: SideMap (TMVar (Maybe ClientID))
+	-- incoming messages related to a running push
+	, netMessagesPush :: SideMap (TChan NetMessage)
+	-- incoming push messages, deferred to be processed later
+	, netMessagesPushDeferred :: SideMap (TMVar (S.Set NetMessage))
+	}
+
+newNetMessager :: IO NetMessager
+newNetMessager = NetMessager
+	<$> atomically newTChan
+	<*> newEmptySV
+	<*> mkSideMap (newTMVar Nothing)
+	<*> mkSideMap newTChan
+	<*> mkSideMap (newTMVar S.empty)
+  where
diff --git a/Assistant/Types/Pushes.hs b/Assistant/Types/Pushes.hs
new file mode 100644
index 0000000..99e0ee1
--- /dev/null
+++ b/Assistant/Types/Pushes.hs
@@ -0,0 +1,24 @@
+{- git-annex assistant push tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.Pushes where
+
+import Common.Annex
+
+import Control.Concurrent.STM
+import Data.Time.Clock
+import qualified Data.Map as M
+
+{- Track the most recent push failure for each remote. -}
+type PushMap = M.Map Remote UTCTime
+type FailedPushMap = TMVar PushMap
+
+{- The TMVar starts empty, and is left empty when there are no
+ - failed pushes. This way we can block until there are some failed pushes.
+ -}
+newFailedPushMap :: IO FailedPushMap
+newFailedPushMap = atomically newEmptyTMVar
diff --git a/Assistant/Types/ScanRemotes.hs b/Assistant/Types/ScanRemotes.hs
new file mode 100644
index 0000000..d2f0c58
--- /dev/null
+++ b/Assistant/Types/ScanRemotes.hs
@@ -0,0 +1,25 @@
+{- git-annex assistant remotes needing scanning
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.ScanRemotes where
+
+import Common.Annex
+
+import Control.Concurrent.STM
+import qualified Data.Map as M
+
+data ScanInfo = ScanInfo
+	{ scanPriority :: Int
+	, fullScan :: Bool
+	}
+
+type ScanRemoteMap = TMVar (M.Map Remote ScanInfo)
+
+{- The TMVar starts empty, and is left empty when there are no remotes
+ - to scan. -}
+newScanRemoteMap :: IO ScanRemoteMap
+newScanRemoteMap = atomically newEmptyTMVar
diff --git a/Assistant/ThreadedMonad.hs b/Assistant/Types/ThreadedMonad.hs
index 7b915e1..1a2aa7e 100644
--- a/Assistant/ThreadedMonad.hs
+++ b/Assistant/Types/ThreadedMonad.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Assistant.ThreadedMonad where
+module Assistant.Types.ThreadedMonad where
 
 import Common.Annex
 import qualified Annex
diff --git a/Assistant/Types/TransferQueue.hs b/Assistant/Types/TransferQueue.hs
new file mode 100644
index 0000000..6620ebd
--- /dev/null
+++ b/Assistant/Types/TransferQueue.hs
@@ -0,0 +1,29 @@
+{- git-annex assistant pending transfer queue
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.TransferQueue where
+
+import Common.Annex
+import Logs.Transfer
+import Types.Remote
+
+import Control.Concurrent.STM
+
+data TransferQueue = TransferQueue
+	{ queuesize :: TVar Int
+	, queuelist :: TVar [(Transfer, TransferInfo)]
+	, deferreddownloads :: TVar [(Key, AssociatedFile)]
+	}
+
+data Schedule = Next | Later
+	deriving (Eq)
+
+newTransferQueue :: IO TransferQueue
+newTransferQueue = atomically $ TransferQueue
+	<$> newTVar 0
+	<*> newTVar []
+	<*> newTVar []
diff --git a/Assistant/Types/TransferSlots.hs b/Assistant/Types/TransferSlots.hs
new file mode 100644
index 0000000..5140995
--- /dev/null
+++ b/Assistant/Types/TransferSlots.hs
@@ -0,0 +1,34 @@
+{- git-annex assistant transfer slots
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Assistant.Types.TransferSlots where
+
+import qualified Control.Exception as E
+import qualified Control.Concurrent.MSemN as MSemN
+import Data.Typeable
+
+type TransferSlots = MSemN.MSemN Int
+
+{- A special exception that can be thrown to pause or resume a transfer, while
+ - keeping its slot in use. -}
+data TransferException = PauseTransfer | ResumeTransfer
+	deriving (Show, Eq, Typeable)
+
+instance E.Exception TransferException
+
+{- Number of concurrent transfers allowed to be run from the assistant.
+ -
+ - Transfers launched by other means, including by remote assistants,
+ - do not currently take up slots.
+ -}
+numSlots :: Int
+numSlots = 1
+
+newTransferSlots :: IO TransferSlots
+newTransferSlots = MSemN.new numSlots
diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs
index 0b59ccc..325f27f 100644
--- a/Assistant/WebApp.hs
+++ b/Assistant/WebApp.hs
@@ -11,8 +11,6 @@ module Assistant.WebApp where
 
 import Assistant.WebApp.Types
 import Assistant.Common
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
 import Utility.NotificationBroadcaster
 import Utility.Yesod
 import Locations.UserConfig
@@ -62,8 +60,8 @@ bootstrap navbaritem content = do
 		addScript $ StaticR js_bootstrap_modal_js
 		$(widgetFile "page")
 	hamletToRepHtml $(hamletFile $ hamletTemplate "bootstrap")
-	where
-		navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)
+  where
+	navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)
 
 newWebAppState :: IO (TMVar WebAppState)
 newWebAppState = do
@@ -72,15 +70,18 @@ newWebAppState = do
 		{ showIntro = True
 		, otherRepos = otherrepos }
 
+liftAssistant :: forall sub a. (Assistant a) -> GHandler sub WebApp a
+liftAssistant a = liftIO . flip runAssistant a =<< assistantData <$> getYesod
+
 getWebAppState :: forall sub. GHandler sub WebApp WebAppState
 getWebAppState = liftIO . atomically . readTMVar =<< webAppState <$> getYesod
 
 modifyWebAppState :: forall sub. (WebAppState -> WebAppState) -> GHandler sub WebApp ()
 modifyWebAppState a = go =<< webAppState <$> getYesod
-	where
-		go s = liftIO $ atomically $ do
-			v <- takeTMVar s
-			putTMVar s $ a v
+  where
+	go s = liftIO $ atomically $ do
+		v <- takeTMVar s
+		putTMVar s $ a v
 
 {- Runs an Annex action from the webapp.
  -
@@ -88,24 +89,20 @@ modifyWebAppState a = go =<< webAppState <$> getYesod
  - value is returned.
  -}
 runAnnex :: forall sub a. a -> Annex a -> GHandler sub WebApp a
-runAnnex fallback a = maybe (return fallback) go =<< threadState <$> getYesod
-	where
-		go st = liftIO $ runThreadState st a
-
-waitNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> NotificationId -> GHandler sub WebApp ()
-waitNotifier selector nid = do
-	notifier <- getNotifier selector
-	liftIO $ waitNotification $ notificationHandleFromId notifier nid
-
-newNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> GHandler sub WebApp NotificationId
-newNotifier selector = do
-	notifier <- getNotifier selector
-	liftIO $ notificationHandleToId <$> newNotificationHandle notifier
-
-getNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> GHandler sub WebApp NotificationBroadcaster
-getNotifier selector = do
-	webapp <- getYesod
-	liftIO $ selector <$> getDaemonStatus (daemonStatus webapp)
+runAnnex fallback a = ifM (noAnnex <$> getYesod)
+	( return fallback
+	, liftAssistant $ liftAnnex a
+	)
+
+waitNotifier :: forall sub. (Assistant NotificationBroadcaster) -> NotificationId -> GHandler sub WebApp ()
+waitNotifier getbroadcaster nid = liftAssistant $ do
+	b <- getbroadcaster
+	liftIO $ waitNotification $ notificationHandleFromId b nid
+
+newNotifier :: forall sub. (Assistant NotificationBroadcaster) -> GHandler sub WebApp NotificationId
+newNotifier getbroadcaster = liftAssistant $ do
+	b <- getbroadcaster
+	liftIO $ notificationHandleToId <$> newNotificationHandle b
 
 {- Adds the auth parameter as a hidden field on a form. Must be put into
  - every form. -}
diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs
index a1b22d7..89ce503 100644
--- a/Assistant/WebApp/Configurators.hs
+++ b/Assistant/WebApp/Configurators.hs
@@ -5,17 +5,17 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes, CPP #-}
 
 module Assistant.WebApp.Configurators where
 
 import Assistant.Common
+import Assistant.DaemonStatus
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
 import Assistant.WebApp.Utility
 import Assistant.WebApp.Configurators.Local
-import Assistant.DaemonStatus
 import Utility.Yesod
 import qualified Remote
 import qualified Types.Remote as Remote
@@ -23,6 +23,10 @@ import Annex.UUID (getUUID)
 import Logs.Remote
 import Logs.Trust
 import Config
+import qualified Git
+#ifdef WITH_XMPP
+import Assistant.XMPP.Client
+#endif
 
 import Yesod
 import Data.Text (Text)
@@ -33,6 +37,11 @@ getConfigR :: Handler RepHtml
 getConfigR = ifM (inFirstRun)
 	( getFirstRepositoryR
 	, bootstrap (Just Config) $ do
+#ifdef WITH_XMPP
+		xmppconfigured <- lift $ runAnnex False $ isJust <$> getXMPPCreds
+#else
+		let xmppconfigured = False
+#endif
 		sideBarDisplay
 		setTitle "Configuration"
 		$(widgetFile "configurators/main")
@@ -42,21 +51,24 @@ getConfigR = ifM (inFirstRun)
 introDisplay :: Text -> Widget
 introDisplay ident = do
 	webapp <- lift getYesod
-	repolist <- lift $ repoList True False
+	repolist <- lift $ repoList False True False
 	let n = length repolist
 	let numrepos = show n
-	let notenough = n < enough
 	$(widgetFile "configurators/intro")
 	lift $ modifyWebAppState $ \s -> s { showIntro = False }
-	where
-		enough = 2
+
+makeMiscRepositories :: Widget
+makeMiscRepositories = $(widgetFile "configurators/repositories/misc")
+
+makeCloudRepositories :: Widget
+makeCloudRepositories = $(widgetFile "configurators/repositories/cloud")
 
 {- Lists known repositories, followed by options to add more. -}
 getRepositoriesR :: Handler RepHtml
 getRepositoriesR = bootstrap (Just Config) $ do
 	sideBarDisplay
 	setTitle "Repositories"
-	repolist <- lift $ repoList False True
+	repolist <- lift $ repoList False False True
 	$(widgetFile "configurators/repositories")
 
 data Actions
@@ -91,44 +103,61 @@ notSyncing :: Actions -> Bool
 notSyncing (SyncingRepoActions _ _) = False
 notSyncing _ = True
 
+repoTable :: RepoList -> Widget
+repoTable repolist = $(widgetFile "configurators/repositories/table")
+
+type RepoList = [(String, String, Actions)]
+
 {- A numbered list of known repositories,
  - with actions that can be taken on them. -}
-repoList :: Bool -> Bool -> Handler [(String, String, Actions)]
-repoList onlyconfigured includehere
+repoList :: Bool -> Bool -> Bool -> Handler RepoList
+repoList onlycloud onlyconfigured includehere
 	| onlyconfigured = list =<< configured
 	| otherwise = list =<< (++) <$> configured <*> rest
-	where
-		configured = do
-			rs <- filter (not . Remote.readonly) . syncRemotes <$>
-				(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
-			runAnnex [] $ do
-				u <- getUUID
-				let l = map Remote.uuid rs
-				let l' = if includehere then u : l else l
-				return $ zip l' $ map mkSyncingRepoActions l'
-		rest = runAnnex [] $ do
-			m <- readRemoteLog
-			unconfigured <- catMaybes . map (findtype m) . snd
-				<$> (trustPartition DeadTrusted $ M.keys m)
-			unsyncable <- map Remote.uuid <$>
-				(filterM (\r -> not <$> repoSyncable (Remote.repo r))
-					=<< Remote.enabledRemoteList)
-			return $ zip unsyncable (map mkNotSyncingRepoActions unsyncable) ++ unconfigured
-		findtype m u = case M.lookup u m of
-			Nothing -> Nothing
-			Just c -> case M.lookup "type" c of
-				Just "rsync" -> u `enableswith` EnableRsyncR
-				Just "directory" -> u `enableswith` EnableDirectoryR
-				Just "S3" -> u `enableswith` EnableS3R
-				_ -> Nothing
-		u `enableswith` r = Just (u, DisabledRepoActions $ r u)
-		list l = runAnnex [] $ do
-			let l' = nubBy (\x y -> fst x == fst y) l
-			zip3
-				<$> pure counter
-				<*> Remote.prettyListUUIDs (map fst l')
-				<*> pure (map snd l')
-		counter = map show ([1..] :: [Int])
+  where
+	configured = do
+		rs <- filter wantedrepo . syncRemotes
+			<$> liftAssistant getDaemonStatus
+		runAnnex [] $ do
+			u <- getUUID
+			let l = map Remote.uuid rs
+			let l' = if includehere then u : l else l
+			return $ zip l' $ map mkSyncingRepoActions l'
+	rest = runAnnex [] $ do
+		m <- readRemoteLog
+		unconfigured <- map snd . catMaybes . filter wantedremote 
+			. map (findinfo m)
+			<$> (trustExclude DeadTrusted $ M.keys m)
+		unsyncable <- map Remote.uuid . filter wantedrepo <$>
+			(filterM (\r -> not <$> repoSyncable (Remote.repo r))
+				=<< Remote.enabledRemoteList)
+		return $ zip unsyncable (map mkNotSyncingRepoActions unsyncable) ++ unconfigured
+	wantedrepo r
+		| Remote.readonly r = False
+		| onlycloud = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r)
+		| otherwise = True
+	wantedremote Nothing = False
+	wantedremote (Just (iscloud, _))
+		| onlycloud = iscloud
+		| otherwise = True
+	findinfo m u = case M.lookup u m of
+		Nothing -> Nothing
+		Just c -> case M.lookup "type" c of
+			Just "rsync" -> val True EnableRsyncR
+			Just "directory" -> val False EnableDirectoryR
+#ifdef WITH_S3
+			Just "S3" -> val True EnableS3R
+#endif
+			_ -> Nothing
+	  where
+		val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))
+	list l = runAnnex [] $ do
+		let l' = nubBy (\x y -> fst x == fst y) l
+		zip3
+			<$> pure counter
+			<*> Remote.prettyListUUIDs (map fst l')
+			<*> pure (map snd l')
+	counter = map show ([1..] :: [Int])
 
 getEnableSyncR :: UUID -> Handler ()
 getEnableSyncR = flipSync True
diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs
index bb48737..e732123 100644
--- a/Assistant/WebApp/Configurators/Edit.hs
+++ b/Assistant/WebApp/Configurators/Edit.hs
@@ -16,6 +16,7 @@ import Assistant.WebApp.SideBar
 import Assistant.WebApp.Utility
 import Assistant.DaemonStatus
 import Assistant.MakeRemote (uniqueRemoteName)
+import Assistant.WebApp.Configurators.XMPP (xmppNeeded)
 import Utility.Yesod
 import qualified Remote
 import qualified Remote.List as Remote
@@ -26,6 +27,7 @@ import Types.StandardGroups
 import qualified Config
 import qualified Git
 import qualified Git.Command
+import qualified Git.Config
 
 import Yesod
 import Data.Text (Text)
@@ -50,17 +52,18 @@ getRepoConfig uuid r mremote = RepoConfig
 	<*> (maybe Nothing (Just . T.pack) . M.lookup uuid <$> uuidMap)
 	<*> getrepogroup
 	<*> Config.repoSyncable r
-	where
-		getrepogroup = do
-			groups <- lookupGroups uuid
-			return $ 
-				maybe (RepoGroupCustom $ unwords $ S.toList groups) RepoGroupStandard
-					(getStandardGroup groups)
+  where
+	getrepogroup = do
+		groups <- lookupGroups uuid
+		return $ 
+			maybe (RepoGroupCustom $ unwords $ S.toList groups) RepoGroupStandard
+				(getStandardGroup groups)
 
 setRepoConfig :: UUID -> Maybe Remote -> RepoConfig -> RepoConfig -> Handler ()
 setRepoConfig uuid mremote oldc newc = do
-	when (repoDescription oldc /= repoDescription newc) $ runAnnex undefined $
+	when (repoDescription oldc /= repoDescription newc) $ runAnnex undefined $ do
 		maybe noop (describeUUID uuid . T.unpack) (repoDescription newc)
+		void uuidMapLoad
 	when (repoGroup oldc /= repoGroup newc) $ runAnnex undefined $ 
 		case repoGroup newc of
 			RepoGroupStandard g -> setStandardGroup uuid g
@@ -68,16 +71,25 @@ setRepoConfig uuid mremote oldc newc = do
 	when (repoSyncable oldc /= repoSyncable newc) $
 		changeSyncable mremote (repoSyncable newc)
 	when (isJust mremote && repoName oldc /= repoName newc) $ do
-		dstatus <- daemonStatus <$> getYesod
 		runAnnex undefined $ do
 			name <- fromRepo $ uniqueRemoteName (T.unpack $ repoName newc) 0
+			{- git remote rename expects there to be a
+			 - remote.<name>.fetch, and exits nonzero if
+			 - there's not. Special remotes don't normally
+			 - have that, and don't use it. Temporarily add
+			 - it if it's missing. -}
+			let remotefetch = "remote." ++ T.unpack (repoName oldc) ++ ".fetch"
+			needfetch <- isNothing <$> fromRepo (Git.Config.getMaybe remotefetch)
+			when needfetch $
+				inRepo $ Git.Command.run "config"
+					[Param remotefetch, Param ""]
 			inRepo $ Git.Command.run "remote"
 				[ Param "rename"
 				, Param $ T.unpack $ repoName oldc
 				, Param name
 				]
 			void $ Remote.remoteListRefresh
-			updateSyncRemotes dstatus
+		liftAssistant updateSyncRemotes
 
 editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig
 editRepositoryAForm def = RepoConfig
@@ -85,14 +97,14 @@ editRepositoryAForm def = RepoConfig
 	<*> aopt textField "Description" (Just $ repoDescription def)
 	<*> areq (selectFieldList $ customgroups++standardgroups) "Repository group" (Just $ repoGroup def)
 	<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
-	where
-		standardgroups :: [(Text, RepoGroup)]
-		standardgroups = map (\g -> (T.pack $ descStandardGroup g , RepoGroupStandard g))
-			[minBound :: StandardGroup .. maxBound :: StandardGroup]
-		customgroups :: [(Text, RepoGroup)]
-		customgroups = case repoGroup def of
-			RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]
-			_ -> []
+  where
+	standardgroups :: [(Text, RepoGroup)]
+	standardgroups = map (\g -> (T.pack $ descStandardGroup g , RepoGroupStandard g))
+		[minBound :: StandardGroup .. maxBound :: StandardGroup]
+	customgroups :: [(Text, RepoGroup)]
+	customgroups = case repoGroup def of
+		RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]
+		_ -> []
 
 getEditRepositoryR :: UUID -> Handler RepHtml
 getEditRepositoryR = editForm False
@@ -100,6 +112,9 @@ getEditRepositoryR = editForm False
 getEditNewRepositoryR :: UUID -> Handler RepHtml
 getEditNewRepositoryR = editForm True
 
+getEditNewCloudRepositoryR :: UUID -> Handler RepHtml
+getEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
+
 editForm :: Bool -> UUID -> Handler RepHtml
 editForm new uuid = bootstrap (Just Config) $ do
 	sideBarDisplay
@@ -114,8 +129,8 @@ editForm new uuid = bootstrap (Just Config) $ do
 			setRepoConfig uuid mremote curr input
 			redirect RepositoriesR
 		_ -> showform form enctype curr
-	where
-		showform form enctype curr = do
-			let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
-			let authtoken = webAppFormAuthToken
-			$(widgetFile "configurators/editrepository")
+  where
+	showform form enctype curr = do
+		let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
+		let authtoken = webAppFormAuthToken
+		$(widgetFile "configurators/editrepository")
diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs
index d02cecf..f146504 100644
--- a/Assistant/WebApp/Configurators/Local.hs
+++ b/Assistant/WebApp/Configurators/Local.hs
@@ -20,6 +20,7 @@ import Init
 import qualified Git
 import qualified Git.Construct
 import qualified Git.Config
+import qualified Git.Command
 import qualified Annex
 import Locations.UserConfig
 import Utility.FreeDesktop
@@ -31,6 +32,7 @@ import Remote (prettyListUUIDs)
 import Annex.UUID
 import Types.StandardGroups
 import Logs.PreferredContent
+import Utility.UserInfo
 
 import Yesod
 import Data.Text (Text)
@@ -48,17 +50,17 @@ data RepositoryPath = RepositoryPath Text
  - to use as a repository. -}
 repositoryPathField :: forall sub. Bool -> Field sub WebApp Text
 repositoryPathField autofocus = Field { fieldParse = parse, fieldView = view }
-	where
-		view idAttr nameAttr attrs val isReq =
-			[whamlet|<input type="text" *{attrs} id="#{idAttr}" name="#{nameAttr}" :isReq:required :autofocus:autofocus value="#{either id id val}">|]
+  where
+	view idAttr nameAttr attrs val isReq =
+		[whamlet|<input type="text" *{attrs} id="#{idAttr}" name="#{nameAttr}" :isReq:required :autofocus:autofocus value="#{either id id val}">|]
 
-		parse [path]
-			| T.null path = nopath
-			| otherwise = liftIO $ checkRepositoryPath path
-		parse [] = return $ Right Nothing
-		parse _ = nopath
+	parse [path]
+		| T.null path = nopath
+		| otherwise = liftIO $ checkRepositoryPath path
+	parse [] = return $ Right Nothing
+	parse _ = nopath
 
-		nopath = return $ Left "Enter a location for the repository"
+	nopath = return $ Left "Enter a location for the repository"
 
 {- As well as checking the path for a lot of silly things, tilde is
  - expanded in the returned path. -}
@@ -81,14 +83,10 @@ checkRepositoryPath p = do
 		case headMaybe problems of
 			Nothing -> Right $ Just $ T.pack basepath
 			Just prob -> Left prob
-	where
-		runcheck (chk, msg) = ifM (chk)
-			( return $ Just msg
-			, return Nothing
-			)
-		expandTilde home ('~':'/':path) = home </> path
-		expandTilde _ path = path
-		
+  where
+	runcheck (chk, msg) = ifM (chk) ( return $ Just msg, return Nothing )
+	expandTilde home ('~':'/':path) = home </> path
+	expandTilde _ path = path
 
 {- On first run, if run in the home directory, default to putting it in
  - ~/Desktop/annex, when a Desktop directory exists, and ~/annex otherwise.
@@ -102,13 +100,13 @@ defaultRepositoryPath firstrun = do
 	if home == cwd && firstrun
 		then inhome
 		else ifM (canWrite cwd) ( return cwd, inhome )
-	where
-		inhome = do
-			desktop <- userDesktopDir
-			ifM (doesDirectoryExist desktop)
-				( relHome $ desktop </> gitAnnexAssistantDefaultDir
-				, return $ "~" </> gitAnnexAssistantDefaultDir
-				)
+  where
+	inhome = do
+		desktop <- userDesktopDir
+		ifM (doesDirectoryExist desktop)
+			( relHome $ desktop </> gitAnnexAssistantDefaultDir
+			, return $ "~" </> gitAnnexAssistantDefaultDir
+			)
 
 newRepositoryForm :: FilePath -> Form RepositoryPath
 newRepositoryForm defpath msg = do
@@ -162,17 +160,17 @@ selectDriveForm :: [RemovableDrive] -> Maybe RemovableDrive -> Form RemovableDri
 selectDriveForm drives def = renderBootstrap $ RemovableDrive
 	<$> pure Nothing
 	<*> areq (selectFieldList pairs) "Select drive:" (mountPoint <$> def)
-	where
-		pairs = zip (map describe drives) (map mountPoint drives)
-		describe drive = case diskFree drive of
-			Nothing -> mountPoint drive
-			Just free -> 
-				let sz = roughSize storageUnits True free
-				in T.unwords
-					[ mountPoint drive
-					, T.concat ["(", T.pack sz]
-					, "free)"
-					]
+  where
+	pairs = zip (map describe drives) (map mountPoint drives)
+	describe drive = case diskFree drive of
+		Nothing -> mountPoint drive
+		Just free -> 
+			let sz = roughSize storageUnits True free
+			in T.unwords
+				[ mountPoint drive
+				, T.concat ["(", T.pack sz]
+				, "free)"
+				]
 
 {- Adding a removable drive. -}
 getAddDriveR :: Handler RepHtml
@@ -190,33 +188,32 @@ getAddDriveR = bootstrap (Just Config) $ do
 		_ -> do
 			let authtoken = webAppFormAuthToken
 			$(widgetFile "configurators/adddrive")
-	where
-		make mountpoint = do
-			liftIO $ makerepo dir
-			u <- liftIO $ initRepo dir $ Just remotename
-			r <- addremote dir remotename
-			runAnnex () $ setStandardGroup u TransferGroup
-			syncRemote r
-			return u
-			where
-				dir = mountpoint </> gitAnnexAssistantDefaultDir
-				remotename = takeFileName mountpoint
-		{- The repo may already exist, when adding removable media
-		 - that has already been used elsewhere. -}
-		makerepo dir = liftIO $ do
-			r <- E.try (inDir dir $ return True) :: IO (Either E.SomeException Bool)
-			case r of
-				Right _ -> noop
-				Left _e -> do
-					createDirectoryIfMissing True dir
-					makeRepo dir True
-		{- Each repository is made a remote of the other. -}
-		addremote dir name = runAnnex undefined $ do
-			hostname <- maybe "host" id <$> liftIO getHostname
-			hostlocation <- fromRepo Git.repoLocation
-			liftIO $ inDir dir $
-				void $ makeGitRemote hostname hostlocation
-			addRemote $ makeGitRemote name dir
+  where
+	make mountpoint = do
+		liftIO $ makerepo dir
+		u <- liftIO $ initRepo dir $ Just remotename
+		r <- addremote dir remotename
+		runAnnex () $ setStandardGroup u TransferGroup
+		syncRemote r
+		return u
+	  where
+		dir = mountpoint </> gitAnnexAssistantDefaultDir
+		remotename = takeFileName mountpoint
+	{- The repo may already exist, when adding removable media
+	 - that has already been used elsewhere. -}
+	makerepo dir = liftIO $ do
+		r <- E.try (inDir dir $ return True) :: IO (Either E.SomeException Bool)
+		case r of
+			Right _ -> noop
+			Left _e -> do
+				createDirectoryIfMissing True dir
+				makeRepo dir True
+	{- Each repository is made a remote of the other. -}
+	addremote dir name = runAnnex undefined $ do
+		hostname <- maybe "host" id <$> liftIO getHostname
+		hostlocation <- fromRepo Git.repoLocation
+		liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation
+		addRemote $ makeGitRemote name dir
 
 getEnableDirectoryR :: UUID -> Handler RepHtml
 getEnableDirectoryR uuid = bootstrap (Just Config) $ do
@@ -229,23 +226,23 @@ getEnableDirectoryR uuid = bootstrap (Just Config) $ do
 {- List of removable drives. -}
 driveList :: IO [RemovableDrive]
 driveList = mapM (gen . mnt_dir) =<< filter sane <$> getMounts
-	where
-		gen dir = RemovableDrive
-			<$> getDiskFree dir
-			<*> pure (T.pack dir)
-		-- filter out some things that are surely not removable drives
-		sane Mntent { mnt_dir = dir, mnt_fsname = dev }
-			{- We want real disks like /dev/foo, not
-			 - dummy mount points like proc or tmpfs or
-			 - gvfs-fuse-daemon. -}
-			| not ('/' `elem` dev) = False
-			{- Just in case: These mount points are surely not
-			 - removable disks. -}
-			| dir == "/" = False
-			| dir == "/tmp" = False
-			| dir == "/run/shm" = False
-			| dir == "/run/lock" = False
-			| otherwise = True
+  where
+	gen dir = RemovableDrive
+		<$> getDiskFree dir
+		<*> pure (T.pack dir)
+	-- filter out some things that are surely not removable drives
+	sane Mntent { mnt_dir = dir, mnt_fsname = dev }
+		{- We want real disks like /dev/foo, not
+		 - dummy mount points like proc or tmpfs or
+		 - gvfs-fuse-daemon. -}
+		| not ('/' `elem` dev) = False
+		{- Just in case: These mount points are surely not
+		 - removable disks. -}
+		| dir == "/" = False
+		| dir == "/tmp" = False
+		| dir == "/run/shm" = False
+		| dir == "/run/lock" = False
+		| otherwise = True
 
 {- Bootstraps from first run mode to a fully running assistant in a
  - repository, by running the postFirstRun callback, which returns the
@@ -268,11 +265,11 @@ makeRepo :: FilePath -> Bool -> IO ()
 makeRepo path bare = do
 	unlessM (boolSystem "git" params) $
 		error "git init failed!"
-	where
-		baseparams = [Param "init", Param "--quiet"]
-		params
-			| bare = baseparams ++ [Param "--bare", File path]
-			| otherwise = baseparams ++ [File path]
+  where
+	baseparams = [Param "init", Param "--quiet"]
+	params
+		| bare = baseparams ++ [Param "--bare", File path]
+		| otherwise = baseparams ++ [File path]
 
 {- Runs an action in the git-annex repository in the specified directory. -}
 inDir :: FilePath -> Annex a -> IO a
@@ -280,11 +277,20 @@ inDir dir a = do
 	state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir
 	Annex.eval state a
 
-{- Initializes a git-annex repository in a directory with a description. -}
 initRepo :: FilePath -> Maybe String -> IO UUID
 initRepo dir desc = inDir dir $ do
+	{- Initialize a git-annex repository in a directory with a description. -}
 	unlessM isInitialized $
 		initialize desc
+	unlessM (Git.Config.isBare <$> gitRepo) $
+		{- Initialize the master branch, so things that expect
+		 - to have it will work, before any files are added. -}
+		void $ inRepo $ Git.Command.runBool "commit"
+			[ Param "--quiet"
+			, Param "--allow-empty"
+			, Param "-m"
+			, Param "created repository"
+			]
 	getUUID
 
 {- Adds a directory to the autostart file. -}
@@ -310,9 +316,9 @@ canMakeSymlink dir = ifM (doesDirectoryExist dir)
 	( catchBoolIO $ test dir
 	, canMakeSymlink (parentDir dir)
 	)
-	where
-		test d = do
-			let link = d </> "delete.me"
-			createSymbolicLink link link
-			removeLink link
-			return True
+  where
+	test d = do
+		let link = d </> "delete.me"
+		createSymbolicLink link link
+		removeLink link
+		return True
diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs
index dd82a99..c6e9874 100644
--- a/Assistant/WebApp/Configurators/Pairing.hs
+++ b/Assistant/WebApp/Configurators/Pairing.hs
@@ -14,6 +14,7 @@ import Assistant.Pairing
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
+import Assistant.Types.Buddies
 import Utility.Yesod
 #ifdef WITH_PAIRING
 import Assistant.Common
@@ -26,6 +27,19 @@ import Utility.Verifiable
 import Utility.Network
 import Annex.UUID
 #endif
+#ifdef WITH_XMPP
+import Assistant.XMPP
+import Assistant.XMPP.Client
+import Assistant.XMPP.Buddies
+import Assistant.XMPP.Git
+import Network.Protocol.XMPP
+import Assistant.Types.NetMessager
+import Assistant.NetMessager
+import Assistant.WebApp.Configurators
+import Assistant.WebApp.Configurators.XMPP
+#endif
+import Utility.UserInfo
+import Git
 
 import Yesod
 import Data.Text (Text)
@@ -34,49 +48,132 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.ByteString.Lazy as B
 import Data.Char
-import System.Posix.User
 import qualified Control.Exception as E
 import Control.Concurrent
 #endif
+#ifdef WITH_XMPP
+import qualified Data.Set as S
+#endif
+
+getStartXMPPPairR :: Handler RepHtml
+#ifdef WITH_XMPP
+getStartXMPPPairR = ifM (isJust <$> runAnnex Nothing getXMPPCreds)
+	( do
+		{- Ask buddies to send presence info, to get
+		 - the buddy list populated. -}
+		liftAssistant $ sendNetMessage QueryPresence
+		pairPage $
+			$(widgetFile "configurators/pairing/xmpp/prompt")
+	, redirect XMPPForPairingR -- go get XMPP configured, then come back
+	)
+#else
+getStartXMPPPairR = noXMPPPairing
+
+noXMPPPairing :: Handler RepHtml
+noXMPPPairing = noPairing "XMPP"
+#endif
+
+{- Does pairing with an XMPP buddy, or with other clients sharing an
+ - XMPP account. -}
+getRunningXMPPPairR :: BuddyKey -> Handler RepHtml
+#ifdef WITH_XMPP
+getRunningXMPPPairR bid = do
+	buddy <- liftAssistant $ getBuddy bid <<~ buddyList
+	go $ S.toList . buddyAssistants <$> buddy
+  where
+	go (Just (clients@((Client exemplar):_))) = do
+		creds <- runAnnex Nothing getXMPPCreds
+		let ourjid = fromJust $ parseJID =<< xmppJID <$> creds
+		let samejid = baseJID ourjid == baseJID exemplar
+		liftAssistant $ do
+			u <- liftAnnex getUUID
+			forM_ clients $ \(Client c) -> sendNetMessage $
+				PairingNotification PairReq (formatJID c) u
+		xmppPairEnd True $ if samejid then Nothing else Just exemplar
+	-- A buddy could have logged out, or the XMPP client restarted,
+	-- and there be no clients to message; handle unforseen by going back.
+	go _ = redirect StartXMPPPairR
+#else
+getRunningXMPPPairR _ = noXMPPPairing
+#endif
 
-{- Starts sending out pair requests. -}
-getStartPairR :: Handler RepHtml
+{- Starts local pairing. -}
+getStartLocalPairR :: Handler RepHtml
 #ifdef WITH_PAIRING
-getStartPairR = promptSecret Nothing $ startPairing PairReq noop pairingAlert Nothing
+getStartLocalPairR = promptSecret Nothing $
+	startLocalPairing PairReq noop pairingAlert Nothing
 #else
-getStartPairR = noPairing
+getStartLocalPairR = noLocalPairing
+
+noLocalPairing :: Handler RepHtml
+noLocalPairing = noPairing "local"
 #endif
 
-{- Runs on the system that responds to a pair request; sets up the ssh
+{- Runs on the system that responds to a local pair request; sets up the ssh
  - authorized key first so that the originating host can immediately sync
  - with us. -}
-getFinishPairR :: PairMsg -> Handler RepHtml
+getFinishLocalPairR :: PairMsg -> Handler RepHtml
 #ifdef WITH_PAIRING
-getFinishPairR msg = promptSecret (Just msg) $ \_ secret -> do
-	liftIO $ setup
-	startPairing PairAck cleanup alert uuid "" secret
-	where
-		alert = pairRequestAcknowledgedAlert (pairRepo msg) . Just
-		setup  = setupAuthorizedKeys msg
-		cleanup = removeAuthorizedKeys False $
-			remoteSshPubKey $ pairMsgData msg
-		uuid = Just $ pairUUID $ pairMsgData msg
+getFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do
+	repodir <- lift $ repoPath <$> runAnnex undefined gitRepo
+	liftIO $ setup repodir
+	startLocalPairing PairAck (cleanup repodir) alert uuid "" secret
+  where
+	alert = pairRequestAcknowledgedAlert (pairRepo msg) . Just
+	setup repodir = setupAuthorizedKeys msg repodir
+	cleanup repodir = removeAuthorizedKeys False repodir $
+		remoteSshPubKey $ pairMsgData msg
+	uuid = Just $ pairUUID $ pairMsgData msg
 #else
-getFinishPairR _ = noPairing
+getFinishLocalPairR _ = noLocalPairing
+#endif
+
+getConfirmXMPPPairR :: PairKey -> Handler RepHtml
+#ifdef WITH_XMPP
+getConfirmXMPPPairR pairkey@(PairKey _ t) = case parseJID t of
+	Nothing -> error "bad JID"
+	Just theirjid -> pairPage $ do
+		let name = buddyName theirjid
+		$(widgetFile "configurators/pairing/xmpp/confirm")
+#else
+getConfirmXMPPPairR _ = noXMPPPairing
+#endif
+
+getFinishXMPPPairR :: PairKey -> Handler RepHtml
+#ifdef WITH_XMPP
+getFinishXMPPPairR (PairKey theiruuid t) = case parseJID t of
+	Nothing -> error "bad JID"
+	Just theirjid -> do
+		liftAssistant $ do
+			selfuuid <- liftAnnex getUUID
+			sendNetMessage $
+				PairingNotification PairAck (formatJID theirjid) selfuuid
+			finishXMPPPairing theirjid theiruuid
+		xmppPairEnd False $ Just theirjid
+#else
+getFinishXMPPPairR _ = noXMPPPairing
+#endif
+
+#ifdef WITH_XMPP
+xmppPairEnd :: Bool -> Maybe JID -> Handler RepHtml
+xmppPairEnd inprogress theirjid = pairPage $ do
+	let friend = buddyName <$> theirjid
+	cloudrepolist <- lift $ repoList True False False
+	$(widgetFile "configurators/pairing/xmpp/end")
 #endif
 
-getInprogressPairR :: SecretReminder -> Handler RepHtml
+getRunningLocalPairR :: SecretReminder -> Handler RepHtml
 #ifdef WITH_PAIRING
-getInprogressPairR s = pairPage $ do
+getRunningLocalPairR s = pairPage $ do
 	let secret = fromSecretReminder s
-	$(widgetFile "configurators/pairing/inprogress")
+	$(widgetFile "configurators/pairing/local/inprogress")
 #else
-getInprogressPairR _ = noPairing
+getRunningLocalPairR _ = noLocalPairing
 #endif
 
 #ifdef WITH_PAIRING
 
-{- Starts pairing, at either the PairReq (initiating host) or 
+{- Starts local pairing, at either the PairReq (initiating host) or 
  - PairAck (responding host) stage.
  -
  - Displays an alert, and starts a thread sending the pairing message,
@@ -85,48 +182,49 @@ getInprogressPairR _ = noPairing
  -
  - Redirects to the pairing in progress page.
  -}
-startPairing :: PairStage -> IO () -> (AlertButton -> Alert) -> Maybe UUID -> Text -> Secret -> Widget
-startPairing stage oncancel alert muuid displaysecret secret = do
-	dstatus <- daemonStatus <$> lift getYesod
+startLocalPairing :: PairStage -> IO () -> (AlertButton -> Alert) -> Maybe UUID -> Text -> Secret -> Widget
+startLocalPairing stage oncancel alert muuid displaysecret secret = do
 	urlrender <- lift getUrlRender
 	reldir <- fromJust . relDir <$> lift getYesod
 
+	sendrequests <- lift $ liftAssistant $ asIO2 $ mksendrequests urlrender
 	{- Generating a ssh key pair can take a while, so do it in the
 	 - background. -}
-	void $ liftIO $ forkIO $ do
-		keypair <- genSshKeyPair
-		pairdata <- PairData
+	thread <- lift $ liftAssistant $ asIO $ do
+		keypair <- liftIO $ genSshKeyPair
+		pairdata <- liftIO $ PairData
 			<$> getHostname
-			<*> getUserName
+			<*> myUserName
 			<*> pure reldir
 			<*> pure (sshPubKey keypair)
 			<*> (maybe genUUID return muuid)
 		let sender = multicastPairMsg Nothing secret pairdata
 		let pip = PairingInProgress secret Nothing keypair pairdata stage
-		startSending dstatus pip stage $ sendrequests sender dstatus urlrender
-
-	lift $ redirect $ InprogressPairR $ toSecretReminder displaysecret
-	where
-		{- Sends pairing messages until the thread is killed,
-		 - and shows an activity alert while doing it.
-		 -
-		 - The cancel button returns the user to the HomeR. This is
-		 - not ideal, but they have to be sent somewhere, and could
-		 - have been on a page specific to the in-process pairing
-		 - that just stopped, so can't go back there.
-		 -}
-		sendrequests sender dstatus urlrender _stage = do
-			tid <- myThreadId
-			let selfdestruct = AlertButton
-				{ buttonLabel = "Cancel"
-				, buttonUrl = urlrender HomeR
-				, buttonAction = Just $ const $ do
-					oncancel
-					killThread tid
-				}
-			alertDuring dstatus (alert selfdestruct) $ do
-				_ <- E.try (sender stage) :: IO (Either E.SomeException ())
-				return ()
+		startSending pip stage $ sendrequests sender
+	void $ liftIO $ forkIO thread
+
+	lift $ redirect $ RunningLocalPairR $ toSecretReminder displaysecret
+  where
+	{- Sends pairing messages until the thread is killed,
+	 - and shows an activity alert while doing it.
+	 -
+	 - The cancel button returns the user to the HomeR. This is
+	 - not ideal, but they have to be sent somewhere, and could
+	 - have been on a page specific to the in-process pairing
+	 - that just stopped, so can't go back there.
+	 -}
+	mksendrequests urlrender sender _stage = do
+		tid <- liftIO myThreadId
+		let selfdestruct = AlertButton
+			{ buttonLabel = "Cancel"
+			, buttonUrl = urlrender HomeR
+			, buttonAction = Just $ const $ do
+				oncancel
+				killThread tid
+			}
+		alertDuring (alert selfdestruct) $ liftIO $ do
+			_ <- E.try (sender stage) :: IO (Either E.SomeException ())
+			return ()
 
 data InputSecret = InputSecret { secretText :: Maybe Text }
 
@@ -152,18 +250,18 @@ promptSecret msg cont = pairPage $ do
 						else showform form enctype $ Just
 							"That's not the right secret phrase."
                 _ -> showform form enctype Nothing
-        where
-                showform form enctype mproblem = do
-			let start = isNothing msg
-			let badphrase = isJust mproblem
-			let problem = fromMaybe "" mproblem
-			let (username, hostname) = maybe ("", "")
-				(\(_, v, a) -> (T.pack $ remoteUserName v, T.pack $ fromMaybe (showAddr a) (remoteHostName v)))
-				(verifiableVal . fromPairMsg <$> msg)
-			u <- T.pack <$> liftIO getUserName
-			let sameusername = username == u
-                        let authtoken = webAppFormAuthToken
-                        $(widgetFile "configurators/pairing/prompt")
+  where
+	showform form enctype mproblem = do
+		let start = isNothing msg
+		let badphrase = isJust mproblem
+		let problem = fromMaybe "" mproblem
+		let (username, hostname) = maybe ("", "")
+			(\(_, v, a) -> (T.pack $ remoteUserName v, T.pack $ fromMaybe (showAddr a) (remoteHostName v)))
+			(verifiableVal . fromPairMsg <$> msg)
+		u <- T.pack <$> liftIO myUserName
+		let sameusername = username == u
+		let authtoken = webAppFormAuthToken
+		$(widgetFile "configurators/pairing/local/prompt")
 
 {- This counts unicode characters as more than one character,
  - but that's ok; they *do* provide additional entropy. -}
@@ -177,15 +275,6 @@ secretProblem s
 toSecret :: Text -> Secret
 toSecret s = B.fromChunks [T.encodeUtf8 $ T.toLower $ T.filter isAlphaNum s]
 
-getUserName :: IO String
-getUserName = userName <$> (getUserEntryForID =<< getEffectiveUserID)
-
-pairPage :: Widget -> Handler RepHtml
-pairPage w = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Pairing"
-	w
-
 {- From Dickens -}
 sampleQuote :: Text
 sampleQuote = T.unwords
@@ -197,8 +286,14 @@ sampleQuote = T.unwords
 
 #else
 
-noPairing :: Handler RepHtml
-noPairing = pairPage $
-	$(widgetFile "configurators/pairing/disabled")
-
 #endif
+
+pairPage :: Widget -> Handler RepHtml
+pairPage w = bootstrap (Just Config) $ do
+	sideBarDisplay
+	setTitle "Pairing"
+	w
+
+noPairing :: Text -> Handler RepHtml
+noPairing pairingtype = pairPage $
+	$(widgetFile "configurators/pairing/disabled")
diff --git a/Assistant/WebApp/Configurators/S3.hs b/Assistant/WebApp/Configurators/S3.hs
index cd019be..42355ea 100644
--- a/Assistant/WebApp/Configurators/S3.hs
+++ b/Assistant/WebApp/Configurators/S3.hs
@@ -15,7 +15,6 @@ import Assistant.Sync
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
-import Assistant.ThreadedMonad
 import Utility.Yesod
 import qualified Remote.S3 as S3
 import Logs.Remote
@@ -63,12 +62,12 @@ s3InputAForm = S3Input
 	<*> areq textField "Datacenter" (Just "US")
 	<*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy)
 	<*> areq textField "Repository name" (Just "S3")
-	where
-		storageclasses :: [(Text, StorageClass)]
-		storageclasses =
-			[ ("Standard redundancy", StandardRedundancy)
-			, ("Reduced redundancy (costs less)", ReducedRedundancy)
-			]
+  where
+	storageclasses :: [(Text, StorageClass)]
+	storageclasses =
+		[ ("Standard redundancy", StandardRedundancy)
+		, ("Reduced redundancy (costs less)", ReducedRedundancy)
+		]
 
 s3CredsAForm :: AForm WebApp WebApp S3Creds
 s3CredsAForm = S3Creds
@@ -89,12 +88,12 @@ getAddS3R = s3Configurator $ do
 				, ("storageclass", show $ storageClass s3input)
 				]
 		_ -> showform form enctype
-	where
-		showform form enctype = do
-			let authtoken = webAppFormAuthToken
-			$(widgetFile "configurators/adds3")
-		setgroup r = runAnnex () $
-			setStandardGroup (Remote.uuid r) TransferGroup
+  where
+	showform form enctype = do
+		let authtoken = webAppFormAuthToken
+		$(widgetFile "configurators/adds3")
+	setgroup r = runAnnex () $
+		setStandardGroup (Remote.uuid r) TransferGroup
 
 getEnableS3R :: UUID -> Handler RepHtml
 getEnableS3R uuid = s3Configurator $ do
@@ -107,22 +106,20 @@ getEnableS3R uuid = s3Configurator $ do
 				fromJust $ M.lookup uuid m
 			makeS3Remote s3creds name (const noop) M.empty
 		_ -> showform form enctype
-	where
-		showform form enctype = do
-			let authtoken = webAppFormAuthToken
-			description <- lift $ runAnnex "" $
-				T.pack . concat <$> Remote.prettyListUUIDs [uuid]
-			$(widgetFile "configurators/enables3")
+  where
+	showform form enctype = do
+		let authtoken = webAppFormAuthToken
+		description <- lift $ runAnnex "" $
+			T.pack . concat <$> Remote.prettyListUUIDs [uuid]
+		$(widgetFile "configurators/enables3")
 
 makeS3Remote :: S3Creds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
 makeS3Remote (S3Creds ak sk) name setup config = do
-	webapp <- getYesod
-	let st = fromJust $ threadState webapp
 	remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
 	liftIO $ S3.s3SetCredsEnv ( T.unpack ak, T.unpack sk)
-	r <- liftIO $ runThreadState st $ addRemote $ do
+	r <- liftAssistant $ liftAnnex $ addRemote $ do
 		makeSpecialRemote name S3.remote config
 		return remotename
 	setup r
-	liftIO $ syncNewRemote st (daemonStatus webapp) (scanRemotes webapp) r
-	redirect $ EditNewRepositoryR $ Remote.uuid r
+	liftAssistant $ syncNewRemote r
+	redirect $ EditNewCloudRepositoryR $ Remote.uuid r
diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs
index 3edc5a5..7353f61 100644
--- a/Assistant/WebApp/Configurators/Ssh.hs
+++ b/Assistant/WebApp/Configurators/Ssh.hs
@@ -21,13 +21,13 @@ import Logs.Remote
 import Remote
 import Logs.PreferredContent
 import Types.StandardGroups
+import Utility.UserInfo
 
 import Yesod
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Map as M
 import Network.Socket
-import System.Posix.User
 
 sshConfigurator :: Widget -> Handler RepHtml
 sshConfigurator a = bootstrap (Just Config) $ do
@@ -61,25 +61,25 @@ sshInputAForm def = SshInput
 	<$> aopt check_hostname "Host name" (Just $ hostname def)
 	<*> aopt check_username "User name" (Just $ username def)
 	<*> aopt textField "Directory" (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ directory def)
-	where
-		check_hostname = checkM (liftIO . checkdns) textField
-		checkdns t = do
-			let h = T.unpack t
-			r <- catchMaybeIO $ getAddrInfo canonname (Just h) Nothing
-			return $ case catMaybes . map addrCanonName <$> r of
-				-- canonicalize input hostname if it had no dot
-				Just (fullname:_)
-					| '.' `elem` h -> Right t
-					| otherwise -> Right $ T.pack fullname
-				Just [] -> Right t
-				Nothing -> Left bad_hostname
-		canonname = Just $ defaultHints { addrFlags = [AI_CANONNAME] }
+  where
+	check_hostname = checkM (liftIO . checkdns) textField
+	checkdns t = do
+		let h = T.unpack t
+		r <- catchMaybeIO $ getAddrInfo canonname (Just h) Nothing
+		return $ case catMaybes . map addrCanonName <$> r of
+			-- canonicalize input hostname if it had no dot
+			Just (fullname:_)
+				| '.' `elem` h -> Right t
+				| otherwise -> Right $ T.pack fullname
+			Just [] -> Right t
+			Nothing -> Left bad_hostname
+	canonname = Just $ defaultHints { addrFlags = [AI_CANONNAME] }
 
-		check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack)
-			bad_username textField
+	check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack)
+		bad_username textField
 		
-		bad_hostname = "cannot resolve host name" :: Text
-		bad_username = "bad user name" :: Text
+	bad_hostname = "cannot resolve host name" :: Text
+	bad_username = "bad user name" :: Text
 
 data ServerStatus
 	= UntestedServer
@@ -96,8 +96,7 @@ usable UsableSshInput = True
 
 getAddSshR :: Handler RepHtml
 getAddSshR = sshConfigurator $ do
-	u <- liftIO $ T.pack . userName
-		<$> (getUserEntryForID =<< getEffectiveUserID)
+	u <- liftIO $ T.pack <$> myUserName
 	((result, form), enctype) <- lift $
 		runFormGet $ renderBootstrap $ sshInputAForm $
 			SshInput Nothing (Just u) Nothing
@@ -108,10 +107,10 @@ getAddSshR = sshConfigurator $ do
 				Left status -> showform form enctype status
 				Right sshdata -> lift $ redirect $ ConfirmSshR sshdata
 		_ -> showform form enctype UntestedServer
-	where
-		showform form enctype status = do
-			let authtoken = webAppFormAuthToken
-			$(widgetFile "configurators/ssh/add")
+  where
+	showform form enctype status = do
+		let authtoken = webAppFormAuthToken
+		$(widgetFile "configurators/ssh/add")
 
 {- To enable an existing rsync special remote, parse the SshInput from
  - its rsyncurl, and display a form whose only real purpose is to check
@@ -123,31 +122,31 @@ getAddSshR = sshConfigurator $ do
  -}
 getEnableRsyncR :: UUID -> Handler RepHtml
 getEnableRsyncR u = do
-	m <- runAnnex M.empty readRemoteLog
-	case parseSshRsyncUrl =<< M.lookup "rsyncurl" =<< M.lookup u m of
-		Nothing -> redirect AddSshR
-		Just sshinput -> sshConfigurator $ do
+	m <- fromMaybe M.empty . M.lookup u <$> runAnnex M.empty readRemoteLog
+	case (parseSshRsyncUrl =<< M.lookup "rsyncurl" m, M.lookup "name" m) of
+		(Just sshinput, Just reponame) -> sshConfigurator $ do
 			((result, form), enctype) <- lift $
 				runFormGet $ renderBootstrap $ sshInputAForm sshinput
 			case result of
 				FormSuccess sshinput'
 					| isRsyncNet (hostname sshinput') ->
-						void $ lift $ makeRsyncNet sshinput' (const noop)
+						void $ lift $ makeRsyncNet sshinput' reponame (const noop)
 					| otherwise -> do
 						s <- liftIO $ testServer sshinput'
 						case s of
 							Left status -> showform form enctype status
 							Right sshdata -> enable sshdata
+								{ sshRepoName = reponame }
 				_ -> showform form enctype UntestedServer
-	where
-		showform form enctype status = do
-			description <- lift $ runAnnex "" $
-				T.pack . concat <$> prettyListUUIDs [u]
-			let authtoken = webAppFormAuthToken
-			$(widgetFile "configurators/ssh/enable")
-		enable sshdata = 
-			lift $ redirect $ ConfirmSshR $
-				sshdata { rsyncOnly = True }
+		_ -> redirect AddSshR
+  where
+	showform form enctype status = do
+		description <- lift $ runAnnex "" $
+			T.pack . concat <$> prettyListUUIDs [u]
+		let authtoken = webAppFormAuthToken
+		$(widgetFile "configurators/ssh/enable")
+	enable sshdata = lift $ redirect $ ConfirmSshR $
+		sshdata { rsyncOnly = True }
 
 {- Converts a rsyncurl value to a SshInput. But only if it's a ssh rsync
  - url; rsync:// urls or bare path names are not supported.
@@ -164,12 +163,12 @@ parseSshRsyncUrl u
 			, username = if null user then Nothing else val user
 			, directory = val dir
 			}
-		where
-			val = Just . T.pack
-			(userhost, dir) = separate (== ':') u
-			(user, host) = if '@' `elem` userhost
-				then separate (== '@') userhost
-				else (userhost, "")
+  where
+	val = Just . T.pack
+	(userhost, dir) = separate (== ':') u
+	(user, host) = if '@' `elem` userhost
+		then separate (== '@') userhost
+		else (userhost, "")
 
 {- Test if we can ssh into the server.
  -
@@ -179,7 +178,7 @@ parseSshRsyncUrl u
  - a special ssh key will need to be generated just for this server.
  -
  - Once logged into the server, probe to see if git-annex-shell is
- - available, or rsync. Note that on OSX, ~/.ssh/git-annex-shell may be
+ - available, or rsync. Note that, ~/.ssh/git-annex-shell may be
  - present, while git-annex-shell is not in PATH.
  -}
 testServer :: SshInput -> IO (Either ServerStatus SshData)
@@ -194,44 +193,43 @@ testServer sshinput@(SshInput { hostname = Just hn }) = do
 			if usable status'
 				then ret status' True
 				else return $ Left status'
-	where
-		ret status needspubkey = return $ Right $
-			(mkSshData sshinput)
-				{ needsPubKey = needspubkey
-				, rsyncOnly = status == UsableRsyncServer
-				}
-		probe extraopts = do
-			let remotecommand = join ";"
-				[ report "loggedin"
-				, checkcommand "git-annex-shell"
-				, checkcommand "rsync"
-				, checkcommand osx_shim
-				]
-			knownhost <- knownHost hn
-			let sshopts = filter (not . null) $ extraopts ++
-				{- If this is an already known host, let
-				 - ssh check it as usual.
-				 - Otherwise, trust the host key. -}
-				[ if knownhost then "" else sshOpt "StrictHostKeyChecking" "no"
-				, "-n" -- don't read from stdin
-				, genSshHost (fromJust $ hostname sshinput) (username sshinput)
-				, remotecommand
-				]
-			parsetranscript . fst <$> sshTranscript sshopts ""
-		parsetranscript s
-			| reported "git-annex-shell" = UsableSshInput
-			| reported osx_shim = UsableSshInput
-			| reported "rsync" = UsableRsyncServer
-			| reported "loggedin" = UnusableServer
-				"Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?"
-			| otherwise = UnusableServer $ T.pack $
-				"Failed to ssh to the server. Transcript: " ++ s
-			where
-				reported r = token r `isInfixOf` s
-		checkcommand c = "if which " ++ c ++ "; then " ++ report c ++ "; fi"
-		token r = "git-annex-probe " ++ r
-		report r = "echo " ++ token r
-		osx_shim = "~/.ssh/git-annex-shell"
+  where
+	ret status needspubkey = return $ Right $ (mkSshData sshinput)
+		{ needsPubKey = needspubkey
+		, rsyncOnly = status == UsableRsyncServer
+		}
+	probe extraopts = do
+		let remotecommand = join ";"
+			[ report "loggedin"
+			, checkcommand "git-annex-shell"
+			, checkcommand "rsync"
+			, checkcommand shim
+			]
+		knownhost <- knownHost hn
+		let sshopts = filter (not . null) $ extraopts ++
+			{- If this is an already known host, let
+			 - ssh check it as usual.
+			 - Otherwise, trust the host key. -}
+			[ if knownhost then "" else sshOpt "StrictHostKeyChecking" "no"
+			, "-n" -- don't read from stdin
+			, genSshHost (fromJust $ hostname sshinput) (username sshinput)
+			, remotecommand
+			]
+		parsetranscript . fst <$> sshTranscript sshopts ""
+	parsetranscript s
+		| reported "git-annex-shell" = UsableSshInput
+		| reported shim = UsableSshInput
+		| reported "rsync" = UsableRsyncServer
+		| reported "loggedin" = UnusableServer
+			"Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?"
+		| otherwise = UnusableServer $ T.pack $
+			"Failed to ssh to the server. Transcript: " ++ s
+	  where
+		reported r = token r `isInfixOf` s
+	checkcommand c = "if which " ++ c ++ "; then " ++ report c ++ "; fi"
+	token r = "git-annex-probe " ++ r
+	report r = "echo " ++ token r
+	shim = "~/.ssh/git-annex-shell"
 
 {- Runs a ssh command; if it fails shows the user the transcript,
  - and if it succeeds, runs an action. -}
@@ -269,29 +267,24 @@ makeSsh' :: Bool -> (Remote -> Handler ()) -> SshData -> Maybe SshKeyPair -> Han
 makeSsh' rsync setup sshdata keypair =
 	sshSetup [sshhost, remoteCommand] "" $
 		makeSshRepo rsync setup sshdata
-	where
-		sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata)
-		remotedir = T.unpack $ sshDirectory sshdata
-		remoteCommand = join "&&" $ catMaybes
-			[ Just $ "mkdir -p " ++ shellEscape remotedir
-			, Just $ "cd " ++ shellEscape remotedir
-			, if rsync then Nothing else Just "git init --bare --shared"
-			, if rsync then Nothing else Just "git annex init"
-			, if needsPubKey sshdata
-				then addAuthorizedKeysCommand (rsyncOnly sshdata) . sshPubKey <$> keypair
-				else Nothing
-			]
+  where
+	sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata)
+	remotedir = T.unpack $ sshDirectory sshdata
+	remoteCommand = join "&&" $ catMaybes
+		[ Just $ "mkdir -p " ++ shellEscape remotedir
+		, Just $ "cd " ++ shellEscape remotedir
+		, if rsync then Nothing else Just "git init --bare --shared"
+		, if rsync then Nothing else Just "git annex init"
+		, if needsPubKey sshdata
+			then addAuthorizedKeysCommand (rsyncOnly sshdata) remotedir . sshPubKey <$> keypair
+			else Nothing
+		]
 
 makeSshRepo :: Bool -> (Remote -> Handler ()) -> SshData -> Handler RepHtml
 makeSshRepo forcersync setup sshdata = do
-	webapp <- getYesod
-	r <- liftIO $ makeSshRemote
-		(fromJust $ threadState webapp)
-		(daemonStatus webapp)
-		(scanRemotes webapp)
-		forcersync sshdata
+	r <- liftAssistant $ makeSshRemote forcersync sshdata
 	setup r
-	redirect $ EditNewRepositoryR $ Remote.uuid r
+	redirect $ EditNewCloudRepositoryR $ Remote.uuid r
 
 getAddRsyncNetR :: Handler RepHtml
 getAddRsyncNetR = do
@@ -305,20 +298,22 @@ getAddRsyncNetR = do
 		$(widgetFile "configurators/addrsync.net")
 	case result of
 		FormSuccess sshinput
-			| isRsyncNet (hostname sshinput) ->
-				makeRsyncNet sshinput setupGroup
+			| isRsyncNet (hostname sshinput) -> do
+				let reponame = genSshRepoName "rsync.net" 
+					(maybe "" T.unpack $ directory sshinput)
+				makeRsyncNet sshinput reponame setupGroup
 			| otherwise ->
 				showform $ UnusableServer
 					"That is not a rsync.net host name."
 		_ -> showform UntestedServer
 
-makeRsyncNet :: SshInput -> (Remote -> Handler ()) -> Handler RepHtml
-makeRsyncNet sshinput setup = do
+makeRsyncNet :: SshInput -> String -> (Remote -> Handler ()) -> Handler RepHtml
+makeRsyncNet sshinput reponame setup = do
 	knownhost <- liftIO $ maybe (return False) knownHost (hostname sshinput)
 	keypair <- liftIO $ genSshKeyPair
 	sshdata <- liftIO $ setupSshKeyPair keypair $
 		(mkSshData sshinput)
-			{ sshRepoName = "rsync.net"
+			{ sshRepoName = reponame 
 			, needsPubKey = True
 			, rsyncOnly = True
 			}
diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs
new file mode 100644
index 0000000..9d41a85
--- /dev/null
+++ b/Assistant/WebApp/Configurators/XMPP.hs
@@ -0,0 +1,169 @@
+{- git-annex assistant XMPP configuration
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+
+module Assistant.WebApp.Configurators.XMPP where
+
+import Assistant.WebApp
+import Assistant.WebApp.Types
+import Assistant.WebApp.Notifications
+import Assistant.WebApp.SideBar
+import Utility.Yesod
+import Utility.NotificationBroadcaster
+#ifdef WITH_XMPP
+import Assistant.Common
+import Assistant.XMPP.Client
+import Assistant.XMPP.Buddies
+import Assistant.Types.Buddies
+import Assistant.NetMessager
+import Assistant.Alert
+import Assistant.DaemonStatus
+import Utility.SRV
+#endif
+
+import Yesod
+#ifdef WITH_XMPP
+import Network
+import Network.Protocol.XMPP
+import Data.Text (Text)
+import qualified Data.Text as T
+#endif
+
+{- Displays an alert suggesting to configure XMPP, with a button. -}
+xmppNeeded :: Handler ()
+#ifdef WITH_XMPP
+xmppNeeded = whenM (isNothing <$> runAnnex Nothing getXMPPCreds) $ do
+	urlrender <- getUrlRender
+	void $ liftAssistant $ do
+		close <- asIO1 removeAlert
+		addAlert $ xmppNeededAlert $ AlertButton
+			{ buttonLabel = "Configure a Jabber account"
+			, buttonUrl = urlrender XMPPR
+			, buttonAction = Just close
+			}
+#else
+xmppNeeded = return ()
+#endif
+
+getXMPPR :: Handler RepHtml
+#ifdef WITH_XMPP
+getXMPPR = getXMPPR' ConfigR
+#else
+getXMPPR = xmppPage $
+	$(widgetFile "configurators/xmpp/disabled")
+#endif
+
+getXMPPForPairingR :: Handler RepHtml
+#ifdef WITH_XMPP
+getXMPPForPairingR = getXMPPR' StartXMPPPairR
+#else
+getXMPPForPairingR = xmppPage $
+	$(widgetFile "configurators/xmpp/disabled")
+#endif
+
+#ifdef WITH_XMPP
+getXMPPR' :: Route WebApp -> Handler RepHtml
+getXMPPR' redirto = xmppPage $ do
+	((result, form), enctype) <- lift $ do
+		oldcreds <- runAnnex Nothing getXMPPCreds
+		runFormGet $ renderBootstrap $ xmppAForm $
+			creds2Form <$> oldcreds
+	let showform problem = do
+		let authtoken = webAppFormAuthToken
+		$(widgetFile "configurators/xmpp")
+	case result of
+		FormSuccess f -> maybe (showform True) (lift . storecreds)
+			=<< liftIO (validateForm f)
+		_ -> showform False
+  where
+	storecreds creds = do
+		void $ runAnnex undefined $ setXMPPCreds creds
+		liftAssistant notifyNetMessagerRestart
+		redirect redirto
+#endif
+
+{- Called by client to get a list of buddies.
+ -
+ - Returns a div, which will be inserted into the calling page.
+ -}
+getBuddyListR :: NotificationId -> Handler RepHtml
+getBuddyListR nid = do
+	waitNotifier getBuddyListBroadcaster nid
+
+	page <- widgetToPageContent $ buddyListDisplay
+	hamletToRepHtml $ [hamlet|^{pageBody page}|]
+
+buddyListDisplay :: Widget
+buddyListDisplay = do
+	autoUpdate ident NotifierBuddyListR (10 :: Int) (10 :: Int)
+#ifdef WITH_XMPP
+	buddies <- lift $ liftAssistant $ do
+		rs <- filter isXMPPRemote . syncGitRemotes <$> getDaemonStatus
+		let pairedwith = catMaybes $ map (parseJID . getXMPPClientID) rs
+		catMaybes . map (buddySummary pairedwith)
+			<$> (getBuddyList <<~ buddyList)
+	$(widgetFile "configurators/xmpp/buddylist")
+#endif
+  where
+	ident = "buddylist"
+
+#ifdef WITH_XMPP
+
+data XMPPForm = XMPPForm
+	{ formJID :: Text
+	, formPassword :: Text }
+
+creds2Form :: XMPPCreds -> XMPPForm
+creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
+
+xmppAForm :: (Maybe XMPPForm) -> AForm WebApp WebApp XMPPForm
+xmppAForm def = XMPPForm
+	<$> areq jidField "Jabber address" (formJID <$> def)
+	<*> areq passwordField "Password" Nothing
+
+jidField :: Field WebApp WebApp Text
+jidField = checkBool (isJust . parseJID) bad textField
+  where
+	bad :: Text
+	bad = "This should look like an email address.."
+
+validateForm :: XMPPForm -> IO (Maybe XMPPCreds)
+validateForm f = do
+	let jid = fromMaybe (error "bad JID") $ parseJID (formJID f)
+	let domain = T.unpack $ strDomain $ jidDomain jid
+	hostports <- lookupSRV $ mkSRVTcp "xmpp-client" domain
+	let username = fromMaybe "" (strNode <$> jidNode jid)
+	case hostports of
+		((h, PortNumber p):_) -> testXMPP $ XMPPCreds
+			{ xmppUsername = username
+			, xmppPassword = formPassword f
+			, xmppHostname = h
+			, xmppPort = fromIntegral p
+			, xmppJID = formJID f
+			}
+		_ -> testXMPP $ XMPPCreds
+			{ xmppUsername = username
+			, xmppPassword = formPassword f
+			, xmppHostname = T.unpack $ strDomain $ jidDomain jid
+			, xmppPort = 5222
+			, xmppJID = formJID f
+			}
+
+testXMPP :: XMPPCreds -> IO (Maybe XMPPCreds)
+testXMPP creds = either (const $ return Nothing)
+	(const $ return $ Just creds)
+	=<< connectXMPP creds (const noop)
+
+#endif
+
+xmppPage :: Widget -> Handler RepHtml
+xmppPage w = bootstrap (Just Config) $ do
+	sideBarDisplay
+	setTitle "Jabber"
+	w
diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs
index 897fddf..44e6461 100644
--- a/Assistant/WebApp/DashBoard.hs
+++ b/Assistant/WebApp/DashBoard.hs
@@ -16,7 +16,6 @@ import Assistant.WebApp.Utility
 import Assistant.WebApp.SideBar
 import Assistant.WebApp.Notifications
 import Assistant.WebApp.Configurators
-import Assistant.DaemonStatus
 import Assistant.TransferQueue
 import Utility.NotificationBroadcaster
 import Utility.Yesod
@@ -39,7 +38,7 @@ transfersDisplay :: Bool -> Widget
 transfersDisplay warnNoScript = do
 	webapp <- lift getYesod
 	current <- lift $ M.toList <$> getCurrentTransfers
-	queued <- liftIO $ getTransferQueue $ transferQueue webapp
+	queued <- lift $ liftAssistant getTransferQueue
 	autoUpdate ident NotifierTransfersR (10 :: Int) (10 :: Int)
 	let transfers = simplifyTransfers $ current ++ queued
 	if null transfers
@@ -48,10 +47,10 @@ transfersDisplay warnNoScript = do
 			, $(widgetFile "dashboard/transfers")
 			)
 		else $(widgetFile "dashboard/transfers")
-	where
-		ident = "transfers"
-		isrunning info = not $
-			transferPaused info || isNothing (startedTime info)
+  where
+	ident = "transfers"
+	isrunning info = not $
+		transferPaused info || isNothing (startedTime info)
 
 {- Simplifies a list of transfers, avoiding display of redundant
  - equivilant transfers. -}
@@ -72,7 +71,7 @@ simplifyTransfers (v@(t1, _):r@((t2, _):l))
  -}
 getTransfersR :: NotificationId -> Handler RepHtml
 getTransfersR nid = do
-	waitNotifier transferNotifier nid
+	waitNotifier getTransferBroadcaster nid
 
 	page <- widgetToPageContent $ transfersDisplay False
 	hamletToRepHtml $ [hamlet|^{pageBody page}|]
@@ -137,11 +136,11 @@ openFileBrowser = do
 			void $ redirectUltDest HomeR
 			return False
 		)
-	where
+  where
 #ifdef darwin_HOST_OS
-		cmd = "open"
+	cmd = "open"
 #else
-		cmd = "xdg-open"
+	cmd = "xdg-open"
 #endif
 
 {- Transfer controls. The GET is done in noscript mode and redirects back
diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs
index 7e71ee6..c841049 100644
--- a/Assistant/WebApp/Notifications.hs
+++ b/Assistant/WebApp/Notifications.hs
@@ -13,6 +13,7 @@ import Assistant.Common
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.DaemonStatus
+import Assistant.Types.Buddies
 import Utility.NotificationBroadcaster
 import Utility.Yesod
 
@@ -41,9 +42,9 @@ autoUpdate ident geturl ms_delay ms_startdelay = do
  - of NotificationIds when noscript pages are loaded. This constructs a
  - notifier url for a given Route and NotificationBroadcaster.
  -}
-notifierUrl :: (NotificationId -> Route WebApp) -> (DaemonStatus -> NotificationBroadcaster) -> Handler RepPlain
-notifierUrl route selector = do
-	(urlbits, _params) <- renderRoute . route <$> newNotifier selector
+notifierUrl :: (NotificationId -> Route WebApp) -> Assistant NotificationBroadcaster -> Handler RepPlain
+notifierUrl route broadcaster = do
+	(urlbits, _params) <- renderRoute . route <$> newNotifier broadcaster
 	webapp <- getYesod
 	return $ RepPlain $ toContent $ T.concat
 		[ "/"
@@ -53,7 +54,19 @@ notifierUrl route selector = do
 		]
 
 getNotifierTransfersR :: Handler RepPlain
-getNotifierTransfersR = notifierUrl TransfersR transferNotifier
+getNotifierTransfersR = notifierUrl TransfersR getTransferBroadcaster
 
 getNotifierSideBarR :: Handler RepPlain
-getNotifierSideBarR = notifierUrl SideBarR alertNotifier
+getNotifierSideBarR = notifierUrl SideBarR getAlertBroadcaster
+
+getNotifierBuddyListR :: Handler RepPlain
+getNotifierBuddyListR = notifierUrl BuddyListR getBuddyListBroadcaster
+
+getTransferBroadcaster :: Assistant NotificationBroadcaster
+getTransferBroadcaster = transferNotifier <$> getDaemonStatus
+
+getAlertBroadcaster :: Assistant NotificationBroadcaster
+getAlertBroadcaster = alertNotifier <$> getDaemonStatus
+
+getBuddyListBroadcaster :: Assistant NotificationBroadcaster
+getBuddyListBroadcaster =  getBuddyBroadcaster <$> getAssistant buddyList
diff --git a/Assistant/WebApp/OtherRepos.hs b/Assistant/WebApp/OtherRepos.hs
index 301c4ce..49dd0df 100644
--- a/Assistant/WebApp/OtherRepos.hs
+++ b/Assistant/WebApp/OtherRepos.hs
@@ -29,25 +29,23 @@ getSwitchToRepositoryR repo = do
 	liftIO startassistant
 	url <- liftIO geturl
 	redirect url
-	where
-		startassistant = do
-			program <- readProgramFile
-			void $ forkIO $ void $ createProcess $
-				(proc program ["assistant"])
-					{ cwd = Just repo }
-		geturl = do
-			r <- Git.Config.read =<< Git.Construct.fromPath repo
-			waiturl $ gitAnnexUrlFile r
-		waiturl urlfile = do
-			v <- tryIO $ readFile urlfile
-			case v of
-				Left _ -> delayed $ waiturl urlfile
-				Right url -> ifM (listening url)
-					( return url
-					, delayed $ waiturl urlfile
-					)
-		listening url = catchBoolIO $ 
-			fst <$> Url.exists url []
-		delayed a = do
-			threadDelay 100000 -- 1/10th of a second
-			a
+  where
+	startassistant = do
+		program <- readProgramFile
+		void $ forkIO $ void $ createProcess $
+			(proc program ["assistant"]) { cwd = Just repo }
+	geturl = do
+		r <- Git.Config.read =<< Git.Construct.fromPath repo
+		waiturl $ gitAnnexUrlFile r
+	waiturl urlfile = do
+		v <- tryIO $ readFile urlfile
+		case v of
+			Left _ -> delayed $ waiturl urlfile
+			Right url -> ifM (listening url)
+				( return url
+				, delayed $ waiturl urlfile
+				)
+	listening url = catchBoolIO $ fst <$> Url.exists url []
+	delayed a = do
+		threadDelay 100000 -- 1/10th of a second
+		a
diff --git a/Assistant/WebApp/SideBar.hs b/Assistant/WebApp/SideBar.hs
index 6c76592..c8ccbed 100644
--- a/Assistant/WebApp/SideBar.hs
+++ b/Assistant/WebApp/SideBar.hs
@@ -13,8 +13,8 @@ import Assistant.Common
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.Notifications
-import Assistant.DaemonStatus
 import Assistant.Alert
+import Assistant.DaemonStatus
 import Utility.NotificationBroadcaster
 import Utility.Yesod
 
@@ -27,28 +27,27 @@ sideBarDisplay :: Widget
 sideBarDisplay = do
 	let content = do
 		{- Add newest alerts to the sidebar. -}
-		webapp <- lift getYesod
-		alertpairs <- M.toList . alertMap
-			<$> liftIO (getDaemonStatus $ daemonStatus webapp)
+		alertpairs <- lift $ M.toList . alertMap
+			<$> liftAssistant getDaemonStatus
 		mapM_ renderalert $
 			take displayAlerts $ reverse $ sortAlertPairs alertpairs
 	let ident = "sidebar"
 	$(widgetFile "sidebar/main")
 	autoUpdate ident NotifierSideBarR (10 :: Int) (10 :: Int)
-	where
-		bootstrapclass :: AlertClass -> Text
-		bootstrapclass Activity = "alert-info"
-		bootstrapclass Warning = "alert"
-		bootstrapclass Error = "alert-error"
-		bootstrapclass Success = "alert-success"
-		bootstrapclass Message = "alert-info"
+  where
+	bootstrapclass :: AlertClass -> Text
+	bootstrapclass Activity = "alert-info"
+	bootstrapclass Warning = "alert"
+	bootstrapclass Error = "alert-error"
+	bootstrapclass Success = "alert-success"
+	bootstrapclass Message = "alert-info"
 
-		renderalert (aid, alert) = do
-			let alertid = show aid
-			let closable = alertClosable alert
-			let block = alertBlockDisplay alert
-			let divclass = bootstrapclass $ alertClass alert
-			$(widgetFile "sidebar/alert")
+	renderalert (aid, alert) = do
+		let alertid = show aid
+		let closable = alertClosable alert
+		let block = alertBlockDisplay alert
+		let divclass = bootstrapclass $ alertClass alert
+		$(widgetFile "sidebar/alert")
 
 {- Called by client to get a sidebar display.
  -
@@ -60,7 +59,7 @@ sideBarDisplay = do
  -}
 getSideBarR :: NotificationId -> Handler RepHtml
 getSideBarR nid = do
-	waitNotifier alertNotifier nid
+	waitNotifier getAlertBroadcaster nid
 
 	{- This 0.1 second delay avoids very transient notifications from
 	 - being displayed and churning the sidebar unnecesarily. 
@@ -74,15 +73,12 @@ getSideBarR nid = do
 
 {- Called by the client to close an alert. -}
 getCloseAlert :: AlertId -> Handler ()
-getCloseAlert i = do
-	webapp <- getYesod
-	liftIO $ removeAlert (daemonStatus webapp) i
+getCloseAlert = liftAssistant . removeAlert
 
 {- When an alert with a button is clicked on, the button takes us here. -}
 getClickAlert :: AlertId -> Handler ()
 getClickAlert i = do
-	webapp <- getYesod
-	m <- alertMap <$> liftIO (getDaemonStatus $ daemonStatus webapp)
+	m <- alertMap <$> liftAssistant getDaemonStatus
 	case M.lookup i m of
 		Just (Alert { alertButton = Just b }) -> do
 			{- Spawn a thread to run the action while redirecting. -}
diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs
index bc5eb04..b95b683 100644
--- a/Assistant/WebApp/Types.hs
+++ b/Assistant/WebApp/Types.hs
@@ -12,13 +12,9 @@ module Assistant.WebApp.Types where
 
 import Assistant.Common
 import Assistant.Ssh
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
-import Assistant.ScanRemotes
-import Assistant.TransferQueue
-import Assistant.TransferSlots
 import Assistant.Alert
 import Assistant.Pairing
+import Assistant.Types.Buddies
 import Utility.NotificationBroadcaster
 import Utility.WebApp
 import Logs.Transfer
@@ -33,16 +29,13 @@ publicFiles "static"
 mkYesodData "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
 
 data WebApp = WebApp
-	{ threadState :: Maybe ThreadState
-	, daemonStatus :: DaemonStatusHandle
-	, scanRemotes :: ScanRemoteMap
-	, transferQueue :: TransferQueue
-	, transferSlots :: TransferSlots
+	{ assistantData :: AssistantData
 	, secretToken :: Text
 	, relDir :: Maybe FilePath
 	, getStatic :: Static
 	, webAppState :: TMVar WebAppState
 	, postFirstRun :: Maybe (IO String)
+	, noAnnex :: Bool
 	}
 
 instance Yesod WebApp where
@@ -52,9 +45,9 @@ instance Yesod WebApp where
 	{- Add the auth token to every url generated, except static subsite
          - urls (which can show up in Permission Denied pages). -}
 	joinPath = insertAuthToken secretToken excludeStatic
-		where
-			excludeStatic [] = True
-			excludeStatic (p:_) = p /= "static"
+	  where
+		excludeStatic [] = True
+		excludeStatic (p:_) = p /= "static"
 
 	makeSessionBackend = webAppSessionBackend
 	jsLoader _ = BottomOfHeadBlocking
@@ -96,3 +89,11 @@ instance PathPiece SecretReminder where
 instance PathPiece UUID where
     toPathPiece = pack . show
     fromPathPiece = readish . unpack
+
+instance PathPiece BuddyKey where
+    toPathPiece = pack . show
+    fromPathPiece = readish . unpack
+
+instance PathPiece PairKey where
+    toPathPiece = pack . show
+    fromPathPiece = readish . unpack
diff --git a/Assistant/WebApp/Utility.hs b/Assistant/WebApp/Utility.hs
index d9fa669..d4d59a9 100644
--- a/Assistant/WebApp/Utility.hs
+++ b/Assistant/WebApp/Utility.hs
@@ -11,8 +11,8 @@ import Assistant.Common
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.DaemonStatus
-import Assistant.ThreadedMonad
 import Assistant.TransferQueue
+import Assistant.Types.TransferSlots
 import Assistant.TransferSlots
 import Assistant.Sync
 import qualified Remote
@@ -23,7 +23,6 @@ import Logs.Transfer
 import Locations.UserConfig
 import qualified Config
 
-import Yesod
 import qualified Data.Map as M
 import Control.Concurrent
 import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)
@@ -37,108 +36,81 @@ changeSyncable (Just r) True = do
 	syncRemote r
 changeSyncable (Just r) False = do
 	changeSyncFlag r False
-	webapp <- getYesod
-	let dstatus = daemonStatus webapp
-	let st = fromJust $ threadState webapp
-	liftIO $ runThreadState st $ updateSyncRemotes dstatus
+	liftAssistant $ updateSyncRemotes
 	{- Stop all transfers to or from this remote.
 	 - XXX Can't stop any ongoing scan, or git syncs. -}
-	void $ liftIO $ dequeueTransfers (transferQueue webapp) dstatus tofrom
+	void $ liftAssistant $ dequeueTransfers tofrom
 	mapM_ (cancelTransfer False) =<<
 		filter tofrom . M.keys <$>
-			liftIO (currentTransfers <$> getDaemonStatus dstatus)
-	where
-		tofrom t = transferUUID t == Remote.uuid r
+			liftAssistant (currentTransfers <$> getDaemonStatus)
+  where
+	tofrom t = transferUUID t == Remote.uuid r
 
 changeSyncFlag :: Remote -> Bool -> Handler ()
 changeSyncFlag r enabled = runAnnex undefined $ do
 	Config.setConfig key value
 	void $ Remote.remoteListRefresh
-	where
-		key = Config.remoteConfig (Remote.repo r) "sync"
-		value
-			| enabled = "true"
-			| otherwise = "false"
+  where
+	key = Config.remoteConfig (Remote.repo r) "sync"
+	value
+		| enabled = "true"
+		| otherwise = "false"
 
 {- Start syncing remote, using a background thread. -}
 syncRemote :: Remote -> Handler ()
-syncRemote remote = do
-	webapp <- getYesod
-	liftIO $ syncNewRemote
-		(fromJust $ threadState webapp)
-		(daemonStatus webapp)
-		(scanRemotes webapp)
-		remote
+syncRemote = liftAssistant . syncNewRemote
 
 pauseTransfer :: Transfer -> Handler ()
 pauseTransfer = cancelTransfer True
 
 cancelTransfer :: Bool -> Transfer -> Handler ()
 cancelTransfer pause t = do
-	webapp <- getYesod
-	let dstatus = daemonStatus webapp
 	m <- getCurrentTransfers
-	liftIO $ do
-		unless pause $
-			{- remove queued transfer -}
-			void $ dequeueTransfers (transferQueue webapp) dstatus $
-				equivilantTransfer t
-		{- stop running transfer -}
-		maybe noop (stop dstatus) (M.lookup t m)
-	where
-		stop dstatus info = do
-			{- When there's a thread associated with the
-			 - transfer, it's signaled first, to avoid it
-			 - displaying any alert about the transfer having
-			 - failed when the transfer process is killed. -}
-			maybe noop signalthread $ transferTid info
-			maybe noop killproc $ transferPid info
-			if pause
-				then void $
-					alterTransferInfo dstatus t $ \i -> i
-						{ transferPaused = True }
-				else void $
-					removeTransfer dstatus t
-		signalthread tid
-			| pause = throwTo tid PauseTransfer
-			| otherwise = killThread tid
-		{- In order to stop helper processes like rsync,
-		 - kill the whole process group of the process running the 
-		 - transfer. -}
-		killproc pid = do
-			g <- getProcessGroupIDOf pid
-			void $ tryIO $ signalProcessGroup sigTERM g
-			threadDelay 50000 -- 0.05 second grace period
-			void $ tryIO $ signalProcessGroup sigKILL g
+	unless pause $
+		{- remove queued transfer -}
+		void $ liftAssistant $ dequeueTransfers $ equivilantTransfer t
+	{- stop running transfer -}
+	maybe noop stop (M.lookup t m)
+  where
+	stop info = liftAssistant $ do
+		{- When there's a thread associated with the
+		 - transfer, it's signaled first, to avoid it
+		 - displaying any alert about the transfer having
+		 - failed when the transfer process is killed. -}
+		liftIO $ maybe noop signalthread $ transferTid info
+		liftIO $ maybe noop killproc $ transferPid info
+		if pause
+			then void $ alterTransferInfo t $
+				\i -> i { transferPaused = True }
+			else void $ removeTransfer t
+	signalthread tid
+		| pause = throwTo tid PauseTransfer
+		| otherwise = killThread tid
+	{- In order to stop helper processes like rsync,
+	 - kill the whole process group of the process running the transfer. -}
+	killproc pid = do
+		g <- getProcessGroupIDOf pid
+		void $ tryIO $ signalProcessGroup sigTERM g
+		threadDelay 50000 -- 0.05 second grace period
+		void $ tryIO $ signalProcessGroup sigKILL g
 
 startTransfer :: Transfer -> Handler ()
 startTransfer t = do
 	m <- getCurrentTransfers
 	maybe startqueued go (M.lookup t m)
-	where
-		go info = maybe (start info) resume $ transferTid info
-		startqueued = do
-			webapp <- getYesod
-			let dstatus = daemonStatus webapp
-			let q = transferQueue webapp
-			is <- liftIO $ map snd <$> getMatchingTransfers q dstatus (== t)
-			maybe noop start $ headMaybe is
-		resume tid = do
-			webapp <- getYesod
-			let dstatus = daemonStatus webapp
-			liftIO $ do
-				alterTransferInfo dstatus t $ \i -> i
-					{ transferPaused = False }
-				throwTo tid ResumeTransfer
-		start info = do
-			webapp <- getYesod
-			let st = fromJust $ threadState webapp
-			let dstatus = daemonStatus webapp
-			let slots = transferSlots webapp
-			liftIO $ inImmediateTransferSlot dstatus slots $ do
-				program <- readProgramFile
-				Transferrer.startTransfer st dstatus program t info
+  where
+	go info = maybe (start info) resume $ transferTid info
+	startqueued = do
+		is <- liftAssistant $ map snd <$> getMatchingTransfers (== t)
+		maybe noop start $ headMaybe is
+	resume tid = do
+		liftAssistant $ alterTransferInfo t $
+			\i -> i { transferPaused = False }
+		liftIO $ throwTo tid ResumeTransfer
+	start info = liftAssistant $ do
+		program <- liftIO readProgramFile
+		inImmediateTransferSlot $
+			Transferrer.startTransfer program t info
 
 getCurrentTransfers :: Handler TransferMap
-getCurrentTransfers = currentTransfers
-	<$> (liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
+getCurrentTransfers = currentTransfers <$> liftAssistant getDaemonStatus
diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes
index 0991f22..2d64672 100644
--- a/Assistant/WebApp/routes
+++ b/Assistant/WebApp/routes
@@ -6,12 +6,15 @@
 
 /config ConfigR GET
 /config/repository RepositoriesR GET
+/config/xmpp XMPPR GET
+/config/xmpp/for/pairing XMPPForPairingR GET
 
 /config/repository/new/first FirstRepositoryR GET
 /config/repository/new NewRepositoryR GET
 /config/repository/switchto/#FilePath SwitchToRepositoryR GET
 /config/repository/edit/#UUID EditRepositoryR GET
 /config/repository/edit/new/#UUID EditNewRepositoryR GET
+/config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET
 /config/repository/sync/disable/#UUID DisableSyncR GET
 /config/repository/sync/enable/#UUID EnableSyncR GET
 
@@ -23,18 +26,27 @@
 /config/repository/add/cloud/rsync.net AddRsyncNetR GET
 /config/repository/add/cloud/S3 AddS3R GET
 
-/config/repository/pair/start StartPairR GET
-/config/repository/pair/inprogress/#SecretReminder InprogressPairR GET
-/config/repository/pair/finish/#PairMsg FinishPairR GET
+/config/repository/pair/local/start StartLocalPairR GET
+/config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET
+/config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET
+/config/repository/pair/xmpp/start StartXMPPPairR GET
+/config/repository/pair/xmpp/running/#BuddyKey RunningXMPPPairR GET
+/config/repository/pair/xmpp/accept/#PairKey ConfirmXMPPPairR GET
+/config/repository/pair/xmpp/finish/#PairKey FinishXMPPPairR GET
 
 /config/repository/enable/rsync/#UUID EnableRsyncR GET
 /config/repository/enable/directory/#UUID EnableDirectoryR GET
 /config/repository/enable/S3/#UUID EnableS3R GET
 
 /transfers/#NotificationId TransfersR GET
-/sidebar/#NotificationId SideBarR GET
 /notifier/transfers NotifierTransfersR GET
+
+/sidebar/#NotificationId SideBarR GET
 /notifier/sidebar NotifierSideBarR GET
+
+/buddylist/#NotificationId BuddyListR GET
+/notifier/buddylist NotifierBuddyListR GET
+
 /alert/close/#AlertId CloseAlert GET
 /alert/click/#AlertId ClickAlert GET
 /filebrowser FileBrowserR GET POST
diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs
new file mode 100644
index 0000000..2c00044
--- /dev/null
+++ b/Assistant/XMPP.hs
@@ -0,0 +1,241 @@
+{- core xmpp support
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Assistant.XMPP where
+
+import Assistant.Common
+import Assistant.Types.NetMessager
+import Assistant.Pairing
+
+import Network.Protocol.XMPP hiding (Node)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Map as M
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Data.XML.Types
+import qualified Codec.Binary.Base64 as B64
+
+{- Name of the git-annex tag, in our own XML namespace.
+ - (Not using a namespace URL to avoid unnecessary bloat.) -}
+gitAnnexTagName :: Name
+gitAnnexTagName  = "{git-annex}git-annex"
+
+{- Creates a git-annex tag containing a particular attribute and value. -}
+gitAnnexTag :: Name -> Text -> Element
+gitAnnexTag attr val = gitAnnexTagContent attr val []
+
+{- Also with some content. -}
+gitAnnexTagContent :: Name -> Text -> [Node] -> Element
+gitAnnexTagContent attr val = Element gitAnnexTagName [(attr, [ContentText val])]
+
+isGitAnnexTag :: Element -> Bool
+isGitAnnexTag t = elementName t == gitAnnexTagName
+
+{- Things that a git-annex tag can inserted into. -}
+class GitAnnexTaggable a where
+	insertGitAnnexTag :: a -> Element -> a
+
+	extractGitAnnexTag :: a -> Maybe Element
+
+	hasGitAnnexTag :: a -> Bool
+	hasGitAnnexTag = isJust . extractGitAnnexTag
+
+instance GitAnnexTaggable Message where
+	insertGitAnnexTag m elt = m { messagePayloads = elt : messagePayloads m }
+	extractGitAnnexTag = headMaybe . filter isGitAnnexTag . messagePayloads
+
+instance GitAnnexTaggable Presence where
+	-- always mark extended away and set presence priority to negative
+	insertGitAnnexTag p elt = p
+		{ presencePayloads = extendedAway : negativePriority : elt : presencePayloads p }
+	extractGitAnnexTag = headMaybe . filter isGitAnnexTag . presencePayloads
+
+data GitAnnexTagInfo = GitAnnexTagInfo
+	{ tagAttr :: Name
+	, tagValue :: Text
+	, tagElement :: Element
+	}
+
+type Decoder = Message -> GitAnnexTagInfo -> Maybe NetMessage
+
+gitAnnexTagInfo :: GitAnnexTaggable a => a -> Maybe GitAnnexTagInfo
+gitAnnexTagInfo v = case extractGitAnnexTag v of
+	{- Each git-annex tag has a single attribute. -}
+	Just (tag@(Element _ [(attr, _)] _)) -> GitAnnexTagInfo
+		<$> pure attr
+		<*> attributeText attr tag
+		<*> pure tag
+	_ -> Nothing
+
+{- A presence with a git-annex tag in it. -}
+gitAnnexPresence :: Element -> Presence
+gitAnnexPresence = insertGitAnnexTag $ emptyPresence PresenceAvailable
+
+{- A presence with an empty git-annex tag in it, used for letting other
+ - clients know we're around and are a git-annex client. -}
+gitAnnexSignature :: Presence
+gitAnnexSignature = gitAnnexPresence $ Element gitAnnexTagName [] []
+
+{- A message with a git-annex tag in it. -}
+gitAnnexMessage :: Element -> JID -> JID -> Message
+gitAnnexMessage elt tojid fromjid = (insertGitAnnexTag silentMessage elt)
+	{ messageTo = Just tojid
+	, messageFrom = Just fromjid
+	}
+
+{- A notification that we've pushed to some repositories, listing their
+ - UUIDs. -}
+pushNotification :: [UUID] -> Presence
+pushNotification = gitAnnexPresence . gitAnnexTag pushAttr . encodePushNotification
+
+encodePushNotification :: [UUID] -> Text
+encodePushNotification = T.intercalate uuidSep . map (T.pack . fromUUID)
+
+decodePushNotification :: Text -> [UUID]
+decodePushNotification = map (toUUID . T.unpack) . T.splitOn uuidSep
+
+uuidSep :: Text
+uuidSep = ","
+
+{- A request for other git-annex clients to send presence. -}
+presenceQuery :: Presence
+presenceQuery = gitAnnexPresence $ gitAnnexTag queryAttr T.empty
+
+{- A notification about a stage of pairing. -}
+pairingNotification :: PairStage -> UUID -> JID -> JID -> Message
+pairingNotification pairstage u = gitAnnexMessage $ 
+	gitAnnexTag pairAttr $ encodePairingNotification pairstage u
+
+encodePairingNotification :: PairStage -> UUID -> Text
+encodePairingNotification pairstage u = T.unwords $ map T.pack
+	[ show pairstage
+	, fromUUID u
+	]
+
+decodePairingNotification :: Decoder
+decodePairingNotification m = parse . words . T.unpack . tagValue
+  where
+	parse [stage, u] = PairingNotification
+		<$> readish stage
+		<*> (formatJID <$> messageFrom m)
+		<*> pure (toUUID u)
+	parse _ = Nothing
+
+pushMessage :: PushStage -> JID -> JID -> Message
+pushMessage = gitAnnexMessage . encode
+  where
+	encode CanPush = gitAnnexTag canPushAttr T.empty
+	encode PushRequest = gitAnnexTag pushRequestAttr T.empty
+	encode StartingPush = gitAnnexTag startingPushAttr T.empty
+	encode (ReceivePackOutput b) = 
+		gitAnnexTagContent receivePackAttr T.empty $ encodeTagContent b
+	encode (SendPackOutput b) =
+		gitAnnexTagContent sendPackAttr T.empty $ encodeTagContent b
+	encode (ReceivePackDone code) =
+		gitAnnexTag receivePackDoneAttr $ 
+			T.pack $ show $ encodeExitCode code
+
+decodeMessage :: Message -> Maybe NetMessage
+decodeMessage m = decode =<< gitAnnexTagInfo m
+  where
+	decode i = M.lookup (tagAttr i) decoders >>= rundecoder i
+	rundecoder i d = d m i
+	decoders = M.fromList $ zip
+		[ pairAttr
+		, canPushAttr
+		, pushRequestAttr
+		, startingPushAttr
+		, receivePackAttr
+		, sendPackAttr
+		, receivePackDoneAttr
+		]
+		[ decodePairingNotification
+		, pushdecoder $ const $ Just CanPush
+		, pushdecoder $ const $ Just PushRequest
+		, pushdecoder $ const $ Just StartingPush
+		, pushdecoder $ 
+			fmap ReceivePackOutput . decodeTagContent . tagElement
+		, pushdecoder $
+			fmap SendPackOutput . decodeTagContent . tagElement
+		, pushdecoder $
+			fmap (ReceivePackDone . decodeExitCode) . readish .
+				T.unpack . tagValue
+		]
+	pushdecoder a m' i = Pushing
+		<$> (formatJID <$> messageFrom m')
+		<*> a i
+
+decodeExitCode :: Int -> ExitCode
+decodeExitCode 0 = ExitSuccess
+decodeExitCode n = ExitFailure n
+	
+encodeExitCode :: ExitCode -> Int
+encodeExitCode ExitSuccess = 0
+encodeExitCode (ExitFailure n) = n
+
+{- Base 64 encoding a ByteString to use as the content of a tag. -}
+encodeTagContent :: ByteString -> [Node]
+encodeTagContent b = [NodeContent $ ContentText $ T.pack $ B64.encode $ B.unpack b]
+
+decodeTagContent :: Element -> Maybe ByteString
+decodeTagContent elt = B.pack <$> B64.decode s
+  where
+	s = T.unpack $ T.concat $ elementText elt
+
+{- The JID without the client part. -}
+baseJID :: JID -> JID
+baseJID j = JID (jidNode j) (jidDomain j) Nothing
+
+{- An XMPP chat message with an empty body. This should not be displayed
+ - by clients, but can be used for communications. -}
+silentMessage :: Message
+silentMessage = (emptyMessage MessageChat)
+	{ messagePayloads = [ emptybody ] }
+  where
+	emptybody = Element
+		{ elementName = "body"
+		, elementAttributes = []
+		, elementNodes = []
+		}
+
+{- Add to a presence to mark its client as extended away. -}
+extendedAway :: Element
+extendedAway = Element "show" [] [NodeContent $ ContentText "xa"]
+
+{- Add to a presence to give it a negative priority. -}
+negativePriority :: Element
+negativePriority = Element "priority" [] [NodeContent $ ContentText "-1"]
+
+pushAttr :: Name
+pushAttr = "push"
+
+queryAttr :: Name
+queryAttr = "query"
+
+pairAttr :: Name
+pairAttr = "pair"
+
+canPushAttr :: Name
+canPushAttr = "canpush"
+
+pushRequestAttr :: Name
+pushRequestAttr = "pushrequest"
+
+startingPushAttr :: Name
+startingPushAttr = "startingpush"
+
+receivePackAttr :: Name
+receivePackAttr = "rp"
+
+sendPackAttr :: Name
+sendPackAttr = "sp"
+
+receivePackDoneAttr :: Name
+receivePackDoneAttr = "rpdone"
diff --git a/Assistant/XMPP/Buddies.hs b/Assistant/XMPP/Buddies.hs
new file mode 100644
index 0000000..7383c38
--- /dev/null
+++ b/Assistant/XMPP/Buddies.hs
@@ -0,0 +1,83 @@
+{- xmpp buddies
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.XMPP.Buddies where
+
+import Assistant.XMPP
+import Common.Annex
+import Assistant.Types.Buddies
+
+import Network.Protocol.XMPP
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Text (Text)
+import qualified Data.Text as T
+
+genBuddyKey :: JID -> BuddyKey
+genBuddyKey j = BuddyKey $ formatJID $ baseJID j
+
+buddyName :: JID -> Text
+buddyName j = maybe (T.pack "") strNode (jidNode j)
+
+{- Summary of info about a buddy.
+ -
+ - If the buddy has no clients at all anymore, returns Nothing. -}
+buddySummary :: [JID] -> Buddy -> Maybe (Text, Bool, Bool, Bool, BuddyKey)
+buddySummary pairedwith b = case clients of
+	((Client j):_) -> Just (buddyName j, away, canpair, alreadypaired j, genBuddyKey j)
+	[] -> Nothing
+  where
+	away = S.null (buddyPresent b) && S.null (buddyAssistants b)
+	canpair = not $ S.null (buddyAssistants b)
+	clients = S.toList $ buddyPresent b `S.union` buddyAway b `S.union` buddyAssistants b
+	alreadypaired j = baseJID j `elem` pairedwith
+
+{- Updates the buddies with XMPP presence info. -}
+updateBuddies :: Presence -> Buddies -> Buddies
+updateBuddies p@(Presence { presenceFrom = Just jid }) = M.alter update key
+  where
+	key = genBuddyKey jid
+	update (Just b) = Just $ applyPresence p b
+	update Nothing = newBuddy p
+updateBuddies _ = id
+
+{- Creates a new buddy based on XMPP presence info. -}
+newBuddy :: Presence -> Maybe Buddy
+newBuddy p
+	| presenceType p == PresenceAvailable = go
+	| presenceType p == PresenceUnavailable = go
+	| otherwise = Nothing
+  where
+	go = make <$> presenceFrom p
+	make _jid = applyPresence p $ Buddy
+		{ buddyPresent = S.empty
+		, buddyAway = S.empty
+		, buddyAssistants = S.empty
+		, buddyPairing = False
+		}
+
+applyPresence :: Presence -> Buddy -> Buddy
+applyPresence p b = fromMaybe b $! go <$> presenceFrom p
+  where
+	go jid
+		| presenceType p == PresenceUnavailable = b
+			{ buddyAway = addto $ buddyAway b
+			, buddyPresent = removefrom $ buddyPresent b
+			, buddyAssistants = removefrom $ buddyAssistants b
+			}
+		| hasGitAnnexTag p = b
+			{ buddyAssistants = addto $ buddyAssistants b
+			, buddyAway = removefrom $ buddyAway b }
+		| presenceType p == PresenceAvailable = b
+			{ buddyPresent = addto $ buddyPresent b
+			, buddyAway = removefrom $ buddyAway b
+			}
+		| otherwise = b
+	  where
+		client = Client jid
+		removefrom = S.filter (/= client)
+		addto = S.insert client
diff --git a/Assistant/XMPP/Client.hs b/Assistant/XMPP/Client.hs
new file mode 100644
index 0000000..8ab0c28
--- /dev/null
+++ b/Assistant/XMPP/Client.hs
@@ -0,0 +1,85 @@
+{- xmpp client support
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.XMPP.Client where
+
+import Assistant.Common
+import Utility.FileMode
+import Utility.SRV
+
+import Network.Protocol.XMPP
+import Network
+import Control.Concurrent
+import qualified Data.Text as T
+import Control.Exception (SomeException)
+
+{- Everything we need to know to connect to an XMPP server. -}
+data XMPPCreds = XMPPCreds
+	{ xmppUsername :: T.Text
+	, xmppPassword :: T.Text
+	, xmppHostname :: HostName
+	, xmppPort :: Int
+	, xmppJID :: T.Text
+	}
+	deriving (Read, Show)
+
+connectXMPP :: XMPPCreds -> (JID -> XMPP a) -> IO (Either SomeException ())
+connectXMPP c a = case parseJID (xmppJID c) of
+	Nothing -> error "bad JID"
+	Just jid -> connectXMPP' jid c a
+
+{- Do a SRV lookup, but if it fails, fall back to the cached xmppHostname. -}
+connectXMPP' :: JID -> XMPPCreds -> (JID -> XMPP a) -> IO (Either SomeException ())
+connectXMPP' jid c a = go =<< lookupSRV srvrecord
+  where
+	srvrecord = mkSRVTcp "xmpp-client" $
+		T.unpack $ strDomain $ jidDomain jid
+	serverjid = JID Nothing (jidDomain jid) Nothing
+
+	go [] = run (xmppHostname c)
+			(PortNumber $ fromIntegral $ xmppPort c)
+			(a jid)
+	go ((h,p):rest) = do
+		{- Try each SRV record in turn, until one connects,
+		 - at which point the MVar will be full. -}
+		mv <- newEmptyMVar
+		r <- run h p $ do
+			liftIO $ putMVar mv ()
+			a jid
+		ifM (isEmptyMVar mv) (go rest, return r)
+
+	{- Async exceptions are let through so the XMPP thread can
+	 - be killed. -}
+	run h p a' = tryNonAsync $
+		runClientError (Server serverjid h p) jid
+			(xmppUsername c) (xmppPassword c) (void a')
+
+{- XMPP runClient, that throws errors rather than returning an Either -}
+runClientError :: Server -> JID -> T.Text -> T.Text -> XMPP a -> IO a
+runClientError s j u p x = either (error . show) return =<< runClient s j u p x
+
+getXMPPCreds :: Annex (Maybe XMPPCreds)
+getXMPPCreds = do
+	f <- xmppCredsFile
+	s <- liftIO $ catchMaybeIO $ readFile f
+	return $ readish =<< s
+
+setXMPPCreds :: XMPPCreds -> Annex ()
+setXMPPCreds creds = do
+	f <- xmppCredsFile
+	liftIO $ do
+		createDirectoryIfMissing True (parentDir f)
+		h <- openFile f WriteMode
+		modifyFileMode f $ removeModes
+			[groupReadMode, otherReadMode]
+		hPutStr h (show creds)
+		hClose h	
+
+xmppCredsFile :: Annex FilePath
+xmppCredsFile = do
+	dir <- fromRepo gitAnnexCredsDir
+	return $ dir </> "xmpp"
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs
new file mode 100644
index 0000000..da143ea
--- /dev/null
+++ b/Assistant/XMPP/Git.hs
@@ -0,0 +1,295 @@
+{- git over XMPP
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.XMPP.Git where
+
+import Assistant.Common
+import Assistant.NetMessager
+import Assistant.Types.NetMessager
+import Assistant.XMPP
+import Assistant.XMPP.Buddies
+import Assistant.DaemonStatus
+import Assistant.Alert
+import Assistant.MakeRemote
+import Assistant.Sync
+import qualified Command.Sync
+import qualified Annex.Branch
+import Annex.UUID
+import Config
+import Git
+import qualified Git.Branch
+import Locations.UserConfig
+import qualified Types.Remote as Remote
+import Utility.FileMode
+import Utility.ThreadScheduler
+
+import Network.Protocol.XMPP
+import qualified Data.Text as T
+import System.Posix.Env
+import System.Posix.Types
+import System.Process (std_in, std_out, std_err)
+import Control.Concurrent
+import qualified Data.ByteString as B
+import qualified Data.Map as M
+
+finishXMPPPairing :: JID -> UUID -> Assistant ()
+finishXMPPPairing jid u = void $ alertWhile alert $
+	makeXMPPGitRemote buddy (baseJID jid) u
+  where
+	buddy = T.unpack $ buddyName jid
+	alert = pairRequestAcknowledgedAlert buddy Nothing
+
+gitXMPPLocation :: JID -> String
+gitXMPPLocation jid = "xmpp::" ++ T.unpack (formatJID $ baseJID jid)
+
+makeXMPPGitRemote :: String -> JID -> UUID -> Assistant Bool
+makeXMPPGitRemote buddyname jid u = do
+	remote <- liftAnnex $ addRemote $
+		makeGitRemote buddyname $ gitXMPPLocation jid
+	liftAnnex $ storeUUID (remoteConfig (Remote.repo remote) "uuid") u
+	syncNewRemote remote
+	return True
+
+{- Pushes over XMPP, communicating with a specific client.
+ - Runs an arbitrary IO action to push, which should run git-push with
+ - an xmpp:: url.
+ -
+ - To handle xmpp:: urls, git push will run git-remote-xmpp, which is
+ - injected into its PATH, and in turn runs git-annex xmppgit. The
+ - dataflow them becomes:
+ - 
+ - git push <--> git-annex xmppgit <--> xmppPush <-------> xmpp
+ -                                                          |
+ - git receive-pack <--> xmppReceivePack <---------------> xmpp
+ - 
+ - The pipe between git-annex xmppgit and us is set up and communicated
+ - using two environment variables, relayIn and relayOut, that are set
+ - to the file descriptors to use. Another, relayControl, is used to
+ - propigate the exit status of git receive-pack.
+ -
+ - We listen at the other end of the pipe and relay to and from XMPP.
+ -}
+xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> Assistant Bool
+xmppPush cid gitpush = runPush SendPack cid handleDeferred $ do
+	sendNetMessage $ Pushing cid StartingPush
+
+	(Fd inf, writepush) <- liftIO createPipe
+	(readpush, Fd outf) <- liftIO createPipe
+	(Fd controlf, writecontrol) <- liftIO createPipe
+
+	tmp <- liftAnnex $ fromRepo gitAnnexTmpDir
+	let tmpdir = tmp </> "xmppgit"
+	installwrapper tmpdir
+
+	env <- liftIO getEnvironment
+	path <- liftIO getSearchPath
+	let myenv = M.fromList
+		[ ("PATH", join [searchPathSeparator] $ tmpdir:path)
+		, (relayIn, show inf)
+		, (relayOut, show outf)
+		, (relayControl, show controlf)
+		]
+		`M.union` M.fromList env
+
+	inh <- liftIO $ fdToHandle readpush
+	outh <- liftIO $ fdToHandle writepush
+	controlh <- liftIO $ fdToHandle writecontrol
+	
+	t1 <- forkIO <~> toxmpp inh
+	t2 <- forkIO <~> fromxmpp outh controlh
+
+	{- This can take a long time to run, so avoid running it in the
+	 - Annex monad. Also, override environment. -}
+	g <- liftAnnex gitRepo
+	r <- liftIO $ gitpush $ g { gitEnv = Just $ M.toList myenv }
+
+	liftIO $ do
+		mapM_ killThread [t1, t2]
+		mapM_ hClose [inh, outh, controlh]
+
+	return r
+  where
+	toxmpp inh = forever $ do
+		b <- liftIO $ B.hGetSome inh chunkSize
+		if B.null b
+			then liftIO $ killThread =<< myThreadId
+			else sendNetMessage $ Pushing cid $ SendPackOutput b
+	fromxmpp outh controlh = forever $ do
+		m <- runTimeout xmppTimeout <~> waitNetPushMessage SendPack
+		case m of
+			(Right (Pushing _ (ReceivePackOutput b))) -> 
+				liftIO $ writeChunk outh b
+			(Right (Pushing _ (ReceivePackDone exitcode))) ->
+				liftIO $ do
+					hPrint controlh exitcode
+					hFlush controlh
+			(Right _) -> noop
+			(Left _) -> do
+				debug ["timeout waiting for git receive-pack output via XMPP"]
+				-- Send a synthetic exit code to git-annex
+				-- xmppgit, which will exit and cause git push
+				-- to die.
+				liftIO $ do
+					hPrint controlh (ExitFailure 1)
+					hFlush controlh
+	installwrapper tmpdir = liftIO $ do
+		createDirectoryIfMissing True tmpdir
+		let wrapper = tmpdir </> "git-remote-xmpp"
+		program <- readProgramFile
+		writeFile wrapper $ unlines
+			[ "#!/bin/sh"
+			, "exec " ++ program ++ " xmppgit"
+			]
+		modifyFileMode wrapper $ addModes executeModes
+
+type EnvVar = String
+
+envVar :: String -> EnvVar
+envVar s = "GIT_ANNEX_XMPPGIT_" ++ s
+
+relayIn :: EnvVar
+relayIn = envVar "IN"
+
+relayOut :: EnvVar
+relayOut = envVar "OUT"
+
+relayControl :: EnvVar
+relayControl = envVar "CONTROL"
+
+relayHandle :: EnvVar -> IO Handle
+relayHandle var = do
+	v <- getEnv var
+	case readish =<< v of
+		Nothing -> error $ var ++ " not set"
+		Just n -> fdToHandle $ Fd n
+
+{- Called by git-annex xmppgit.
+ -
+ - git-push is talking to us on stdin
+ - we're talking to git-push on stdout
+ - git-receive-pack is talking to us on relayIn (via XMPP)
+ - we're talking to git-receive-pack on relayOut (via XMPP)
+ - git-receive-pack's exit code will be passed to us on relayControl
+ -}
+xmppGitRelay :: IO ()
+xmppGitRelay = do
+	flip relay stdout =<< relayHandle relayIn
+	relay stdin =<< relayHandle relayOut
+	code <- hGetLine =<< relayHandle relayControl
+	exitWith $ fromMaybe (ExitFailure 1) $ readish code
+  where
+	{- Is it possible to set up pipes and not need to copy the data
+	 - ourselves? See splice(2) -}
+	relay fromh toh = void $ forkIO $ forever $ do
+		b <- B.hGetSome fromh chunkSize
+		when (B.null b) $ do
+			hClose fromh
+			hClose toh
+			killThread =<< myThreadId
+		writeChunk toh b
+
+{- Relays git receive-pack stdin and stdout via XMPP, as well as propigating
+ - its exit status to XMPP. -}
+xmppReceivePack :: ClientID -> Assistant Bool
+xmppReceivePack cid = runPush ReceivePack cid handleDeferred $ do
+	repodir <- liftAnnex $ fromRepo repoPath
+	let p = (proc "git" ["receive-pack", repodir])
+		{ std_in = CreatePipe
+		, std_out = CreatePipe
+		, std_err = Inherit
+		}
+	(Just inh, Just outh, _, pid) <- liftIO $ createProcess p
+	readertid <- forkIO <~> relayfromxmpp inh
+	relaytoxmpp outh
+	code <- liftIO $ waitForProcess pid
+	void $ sendNetMessage $ Pushing cid $ ReceivePackDone code
+	liftIO $ do
+		killThread readertid
+		hClose inh
+		hClose outh
+		return $ code == ExitSuccess
+  where
+	relaytoxmpp outh = do
+		b <- liftIO $ B.hGetSome outh chunkSize
+		-- empty is EOF, so exit
+		unless (B.null b) $ do
+			sendNetMessage $ Pushing cid $ ReceivePackOutput b
+			relaytoxmpp outh
+	relayfromxmpp inh = forever $ do
+		m <- runTimeout xmppTimeout <~> waitNetPushMessage ReceivePack
+		case m of
+			(Right (Pushing _ (SendPackOutput b))) ->
+				liftIO $ writeChunk inh b
+			(Right _) -> noop
+			(Left _) -> do
+				debug ["timeout waiting for git send-pack output via XMPP"]
+				-- closing the handle will make
+				-- git receive-pack exit
+				liftIO $ do
+					hClose inh
+					killThread =<< myThreadId
+
+xmppRemotes :: ClientID -> Assistant [Remote]
+xmppRemotes cid = case baseJID <$> parseJID cid of
+	Nothing -> return []
+	Just jid -> do
+		let loc = gitXMPPLocation jid
+		filter (matching loc . Remote.repo) . syncGitRemotes 
+			<$> getDaemonStatus
+  where
+	matching loc r = repoIsUrl r && repoLocation r == loc
+
+whenXMPPRemote :: ClientID -> Assistant () -> Assistant ()
+whenXMPPRemote cid = unlessM (null <$> xmppRemotes cid)
+
+handlePushInitiation :: NetMessage -> Assistant ()
+handlePushInitiation (Pushing cid CanPush) =
+	whenXMPPRemote cid $ 
+		sendNetMessage $ Pushing cid PushRequest
+
+handlePushInitiation (Pushing cid PushRequest) =
+	go =<< liftAnnex (inRepo Git.Branch.current)
+  where
+	go Nothing = noop
+	go (Just branch) = do
+		rs <- xmppRemotes cid
+		liftAnnex $ Annex.Branch.commit "update"
+		(g, u) <- liftAnnex $ (,)
+			<$> gitRepo
+			<*> getUUID
+		liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
+		debug ["pushing to", show rs]
+		forM_ rs $ \r -> xmppPush cid $ pushFallback u branch r
+
+handlePushInitiation (Pushing cid StartingPush) =
+	whenXMPPRemote cid $
+		void $ xmppReceivePack cid
+handlePushInitiation _ = noop
+
+handleDeferred :: NetMessage -> Assistant ()
+handleDeferred = handlePushInitiation
+
+writeChunk :: Handle -> B.ByteString -> IO ()
+writeChunk h b = do
+	B.hPut h b
+	hFlush h
+
+{- Largest chunk of data to send in a single XMPP message. -}
+chunkSize :: Int
+chunkSize = 4096
+
+{- How long to wait for an expected message before assuming the other side
+ - has gone away and canceling a push. 
+ -
+ - This needs to be long enough to allow a message of up to 2+ times
+ - chunkSize to propigate up to a XMPP server, perhaps across to another
+ - server, and back down to us. On the other hand, other XMPP pushes can be
+ - delayed for running until the timeout is reached, so it should not be
+ - excessive.
+ -}
+xmppTimeout :: Seconds
+xmppTimeout = Seconds 120
diff --git a/Backend.hs b/Backend.hs
index d1dfdef..b66e613 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -40,16 +40,16 @@ orderedList = do
 	if not $ null l
 		then return l
 		else handle =<< Annex.getState Annex.forcebackend
-	where
-		handle Nothing = standard
-		handle (Just "") = standard
-		handle (Just name) = do
-			l' <- (lookupBackendName name :) <$> standard
-			Annex.changeState $ \s -> s { Annex.backends = l' }
-			return l'
-		standard = parseBackendList <$> getConfig (annexConfig "backends") ""
-		parseBackendList [] = list
-		parseBackendList s = map lookupBackendName $ words s
+  where
+	handle Nothing = standard
+	handle (Just "") = standard
+	handle (Just name) = do
+		l' <- (lookupBackendName name :) <$> standard
+		Annex.changeState $ \s -> s { Annex.backends = l' }
+		return l'
+	standard = parseBackendList <$> getConfig (annexConfig "backends") ""
+	parseBackendList [] = list
+	parseBackendList s = map lookupBackendName $ words s
 
 {- Generates a key for a file, trying each backend in turn until one
  - accepts it.
@@ -66,12 +66,12 @@ genKey' (b:bs) source = do
 	case r of
 		Nothing -> genKey' bs source
 		Just k -> return $ Just (makesane k, b)
-	where
-		-- keyNames should not contain newline characters.
-		makesane k = k { keyName = map fixbadchar (keyName k) }
-		fixbadchar c
-			| c == '\n' = '_'
-			| otherwise = c
+  where
+	-- keyNames should not contain newline characters.
+	makesane k = k { keyName = map fixbadchar (keyName k) }
+	fixbadchar c
+		| c == '\n' = '_'
+		| otherwise = c
 
 {- Looks up the key and backend corresponding to an annexed file,
  - by examining what the file symlinks to. -}
@@ -81,35 +81,33 @@ lookupFile file = do
 	case tl of
 		Left _ -> return Nothing
 		Right l -> makekey l
-	where
-		makekey l = maybe (return Nothing) (makeret l) (fileKey $ takeFileName l)
-		makeret l k = let bname = keyBackendName k in
-			case maybeLookupBackendName bname of
-				Just backend -> do
-					return $ Just (k, backend)
-				Nothing -> do
-					when (isLinkToAnnex l) $ warning $
-						"skipping " ++ file ++
-						" (unknown backend " ++
-						bname ++ ")"
-					return Nothing
+  where
+	makekey l = maybe (return Nothing) (makeret l) (fileKey $ takeFileName l)
+	makeret l k = let bname = keyBackendName k in
+		case maybeLookupBackendName bname of
+			Just backend -> do
+				return $ Just (k, backend)
+			Nothing -> do
+				when (isLinkToAnnex l) $ warning $
+					"skipping " ++ file ++
+					" (unknown backend " ++ bname ++ ")"
+				return Nothing
 
 {- Looks up the backend that should be used for a file.
  - That can be configured on a per-file basis in the gitattributes file.
  -}
 chooseBackend :: FilePath -> Annex (Maybe Backend)
 chooseBackend f = Annex.getState Annex.forcebackend >>= go
-	where
-		go Nothing =  maybeLookupBackendName <$>
-			checkAttr "annex.backend" f
-		go (Just _) = Just . Prelude.head <$> orderedList
+  where
+	go Nothing =  maybeLookupBackendName <$> checkAttr "annex.backend" f
+	go (Just _) = Just . Prelude.head <$> orderedList
 
 {- Looks up a backend by name. May fail if unknown. -}
 lookupBackendName :: String -> Backend
 lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s
-	where
-		unknown = error $ "unknown backend " ++ s
+  where
+	unknown = error $ "unknown backend " ++ s
 maybeLookupBackendName :: String -> Maybe Backend
 maybeLookupBackendName s = headMaybe matches
-	where
-		matches = filter (\b -> s == B.name b) list
+  where
+	matches = filter (\b -> s == B.name b) list
diff --git a/Backend/SHA.hs b/Backend/SHA.hs
index bfb94df..ef0e92d 100644
--- a/Backend/SHA.hs
+++ b/Backend/SHA.hs
@@ -57,24 +57,23 @@ shaN shasize file filesize = do
 		Left sha -> liftIO $ sha <$> L.readFile file
 		Right command -> liftIO $ parse command . lines <$>
 			readsha command (toCommand [File file])
-	where
-		parse command [] = bad command
-		parse command (l:_)
-			| null sha = bad command
-			| otherwise = sha
-			where
-				sha = fst $ separate (== ' ') l
-		bad command = error $ command ++ " parse error"
-		{- sha commands output the filename, so need to set fileEncoding -}
-		readsha command args =
-			withHandle StdoutHandle createProcessSuccess p $ \h -> do
-				fileEncoding h
-				output  <- hGetContentsStrict h
-				hClose h
-				return output
-			where
-				p = (proc command args)
-					{ std_out = CreatePipe }
+  where
+	parse command [] = bad command
+	parse command (l:_)
+		| null sha = bad command
+		| otherwise = sha
+	  where
+		sha = fst $ separate (== ' ') l
+	bad command = error $ command ++ " parse error"
+	{- sha commands output the filename, so need to set fileEncoding -}
+	readsha command args =
+		withHandle StdoutHandle createProcessSuccess p $ \h -> do
+			fileEncoding h
+			output  <- hGetContentsStrict h
+			hClose h
+			return output
+	  where
+		p = (proc command args) { std_out = CreatePipe }
 
 shaCommand :: SHASize -> Integer -> Either (L.ByteString -> String) String
 shaCommand shasize filesize
@@ -84,14 +83,14 @@ shaCommand shasize filesize
 	| shasize == 384 = use SysConfig.sha384 sha384
 	| shasize == 512 = use SysConfig.sha512 sha512
 	| otherwise = error $ "bad sha size " ++ show shasize
-	where
-		use Nothing sha = Left $ showDigest . sha
-		use (Just c) sha
-			-- use builtin, but slower sha for small files
-			-- benchmarking indicates it's faster up to
-			-- and slightly beyond 50 kb files
-			| filesize < 51200 = use Nothing sha
-			| otherwise = Right c
+  where
+	use Nothing sha = Left $ showDigest . sha
+	use (Just c) sha
+		{- use builtin, but slower sha for small files
+		 - benchmarking indicates it's faster up to
+		 - and slightly beyond 50 kb files -}
+		| filesize < 51200 = use Nothing sha
+		| otherwise = Right c
 
 {- A key is a checksum of its contents. -}
 keyValue :: SHASize -> KeySource -> Annex (Maybe Key)
@@ -109,23 +108,23 @@ keyValue shasize source = do
 {- Extension preserving keys. -}
 keyValueE :: SHASize -> KeySource -> Annex (Maybe Key)
 keyValueE size source = keyValue size source >>= maybe (return Nothing) addE
-	where
-		addE k = return $ Just $ k
-			{ keyName = keyName k ++ selectExtension (keyFilename source)
-			, keyBackendName = shaNameE size
-			}
+  where
+	addE k = return $ Just $ k
+		{ keyName = keyName k ++ selectExtension (keyFilename source)
+		, keyBackendName = shaNameE size
+		}
 
 selectExtension :: FilePath -> String
 selectExtension f
 	| null es = ""
 	| otherwise = join "." ("":es)
-	where
-		es = filter (not . null) $ reverse $
-			take 2 $ takeWhile shortenough $
-			reverse $ split "." $ takeExtensions f
-		shortenough e
-			| '\n' `elem` e = False -- newline in extension?!
-			| otherwise = length e <= 4 -- long enough for "jpeg"
+  where
+	es = filter (not . null) $ reverse $
+		take 2 $ takeWhile shortenough $
+		reverse $ split "." $ takeExtensions f
+	shortenough e
+		| '\n' `elem` e = False -- newline in extension?!
+		| otherwise = length e <= 4 -- long enough for "jpeg"
 
 {- A key's checksum is checked during fsck. -}
 checkKeyChecksum :: SHASize -> Key -> FilePath -> Annex Bool
@@ -137,7 +136,7 @@ checkKeyChecksum size key file = do
 			let filesize = fromIntegral $ fileSize stat
 			check <$> shaN size file filesize
 		_ -> return True
-	where
-		check s
-			| s == dropExtensions (keyName key) = True
-			| otherwise = False
+  where
+	check s
+		| s == dropExtensions (keyName key) = True
+		| otherwise = False
diff --git a/Backend/URL.hs b/Backend/URL.hs
index cc9112a..81c287c 100644
--- a/Backend/URL.hs
+++ b/Backend/URL.hs
@@ -32,10 +32,10 @@ fromUrl url size = stubKey
 	, keyBackendName = "URL"
 	, keySize = size
 	}
-	where
-		-- when it's not too long, use the url as the key name
-		-- 256 is the absolute filename max, but use a shorter
-		-- length because this is not the entire key filename.
-		key
-			| length url < 128 = url
-			| otherwise = take 128 url ++ "-" ++ md5s (Str url)
+  where
+	{- when it's not too long, use the url as the key name
+	 - 256 is the absolute filename max, but use a shorter
+	 - length because this is not the entire key filename. -}
+	key
+		| length url < 128 = url
+		| otherwise = take 128 url ++ "-" ++ md5s (Str url)
diff --git a/Build/Configure.hs b/Build/Configure.hs
index 7fb195a..d25445f 100644
--- a/Build/Configure.hs
+++ b/Build/Configure.hs
@@ -19,7 +19,7 @@ tests =
 	, testCp "cp_a" "-a"
 	, testCp "cp_p" "-p"
 	, testCp "cp_reflink_auto" "--reflink=auto"
-	, TestCase "uuid generator" $ selectCmd "uuid" ["uuid -m", "uuid", "uuidgen"] ""
+	, TestCase "uuid generator" $ selectCmd "uuid" [("uuid -m", ""), ("uuid", ""), ("uuidgen", "")]
 	, TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0 </dev/null"
 	, TestCase "rsync" $ requireCmd "rsync" "rsync --version >/dev/null"
 	, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
@@ -28,20 +28,35 @@ tests =
 	, TestCase "gpg" $ testCmd "gpg" "gpg --version >/dev/null"
 	, TestCase "lsof" $ testCmd "lsof" "lsof -v >/dev/null 2>&1"
 	, TestCase "ssh connection caching" getSshConnectionCaching
-	] ++ shaTestCases [1, 256, 512, 224, 384]
+	] ++ shaTestCases
+	[ (1, "da39a3ee5e6b4b0d3255bfef95601890afd80709")
+	, (256, "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")
+	, (512, "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e")
+	, (224, "d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f")
+	, (384, "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b")
+	]
 
-shaTestCases :: [Int] -> [TestCase]
+{- shaNsum are the program names used by coreutils. Some systems like OSX
+ - sometimes install these with 'g' prefixes.
+ -
+ - On some systems, shaN is used instead, but on other
+ - systems, it might be "hashalot", which does not produce
+ - usable checksums. Only accept programs that produce
+ - known-good hashes. -}
+shaTestCases :: [(Int, String)] -> [TestCase]
 shaTestCases l = map make l
-	where
-		make n = TestCase key $ maybeSelectCmd key (shacmds n) "</dev/null"
-			where
-				key = "sha" ++ show n
-		shacmds n = concatMap (\x -> [x, osxpath </> x]) $
-			map (\x -> "sha" ++ show n ++ x) ["", "sum"]
-		-- Max OSX puts GNU tools outside PATH, so look in
-		-- the location it uses, and remember where to run them
-		-- from.
-		osxpath = "/opt/local/libexec/gnubin"
+  where
+	make (n, knowngood) = TestCase key $ maybeSelectCmd key $ 
+		zip (shacmds n) (repeat check)
+	  where
+		key = "sha" ++ show n
+		check = "</dev/null | grep -q '" ++ knowngood ++ "'"
+	shacmds n = concatMap (\x -> [x, 'g':x, osxpath </> x]) $
+		map (\x -> "sha" ++ show n ++ x) ["sum", ""]
+	{- Max OSX sometimes puts GNU tools outside PATH, so look in
+	 - the location it uses, and remember where to run them
+	 - from. -}
+	osxpath = "/opt/local/libexec/gnubin"
 
 tmpDir :: String
 tmpDir = "tmp"
@@ -51,9 +66,9 @@ testFile = tmpDir ++ "/testfile"
 
 testCp :: ConfigKey -> String -> TestCase
 testCp k option = TestCase cmd $ testCmd k cmdline
-	where
-		cmd = "cp " ++ option
-		cmdline = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
+  where
+	cmd = "cp " ++ option
+	cmdline = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
 
 {- Pulls package version out of the changelog. -}
 getVersion :: Test
@@ -66,8 +81,8 @@ getVersionString = do
 	changelog <- readFile "CHANGELOG"
 	let verline = head $ lines changelog
 	return $ middle (words verline !! 1)
-	where
-		middle = drop 1 . init
+  where
+	middle = drop 1 . init
 
 getGitVersion :: Test
 getGitVersion = do
@@ -88,14 +103,14 @@ cabalSetup = do
 		map (setfield "Version" version) $
 		lines cabal
 	renameFile tmpcabalfile cabalfile
-	where
-		cabalfile = "git-annex.cabal"
-		tmpcabalfile = cabalfile++".tmp"
-		setfield field value s
-			| fullfield `isPrefixOf` s = fullfield ++ value
-			| otherwise = s
-			where
-				fullfield = field ++ ": "
+  where
+	cabalfile = "git-annex.cabal"
+	tmpcabalfile = cabalfile++".tmp"
+	setfield field value s
+		| fullfield `isPrefixOf` s = fullfield ++ value
+		| otherwise = s
+	  where
+		fullfield = field ++ ": "
 
 setup :: IO ()
 setup = do
diff --git a/Build/InstallDesktopFile.hs b/Build/InstallDesktopFile.hs
index 1bcba70..6339791 100644
--- a/Build/InstallDesktopFile.hs
+++ b/Build/InstallDesktopFile.hs
@@ -46,11 +46,11 @@ autostart command = genDesktopEntry
 
 systemwideInstall :: IO Bool
 systemwideInstall = isroot <||> destdirset
-	where
-		isroot = do
-			uid <- fromIntegral <$> getRealUserID
-			return $ uid == (0 :: Int)
-		destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR")
+  where
+	isroot = do
+		uid <- fromIntegral <$> getRealUserID
+		return $ uid == (0 :: Int)
+	destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR")
 
 inDestDir :: FilePath -> IO FilePath
 inDestDir f = do
@@ -74,32 +74,6 @@ writeOSXDesktop command = do
 		, userAutoStart osxAutoStartLabel
 		)
 
-	{- Install the OSX app in non-self-contained mode. -}
-	let appdir = "git-annex.app"
-	installOSXAppFile appdir "Contents/Info.plist" Nothing
-	installOSXAppFile appdir "Contents/Resources/git-annex.icns" Nothing
-	installOSXAppFile appdir "Contents/MacOS/git-annex-webapp" (Just webappscript)
-	where
-		webappscript = unlines
-			[ "#!/bin/sh"
-			, command ++ " webapp"
-			]
-
-installOSXAppFile :: FilePath -> FilePath -> Maybe String -> IO ()
-installOSXAppFile appdir appfile mcontent = do
-	let src = "standalone" </> "osx" </> appdir </> appfile
-	home <- myHomeDir
-	dest <- ifM systemwideInstall
-		( return $ "/Applications" </> appdir </> appfile
-		, return $ home </> "Desktop" </> appdir </> appfile
-		)
-	createDirectoryIfMissing True (parentDir dest)
-	case mcontent of
-		Just content -> writeFile dest content
-		Nothing -> copyFile src dest
-	mode <- fileMode <$> getFileStatus src
-	setFileMode dest mode
-
 install :: FilePath -> IO ()
 install command = do
 #ifdef darwin_HOST_OS
@@ -117,6 +91,6 @@ install command = do
 
 main :: IO ()
 main = getArgs >>= go
-	where
-		go [] = error "specify git-annex command"
-		go (command:_) = install command
+  where
+	go [] = error "specify git-annex command"
+	go (command:_) = install command
diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs
index 0cc2019..92f6f68 100644
--- a/Build/TestConfig.hs
+++ b/Build/TestConfig.hs
@@ -29,22 +29,22 @@ instance Show Config where
 		[ key ++ " :: " ++ valuetype value
 		, key ++ " = " ++ show value
 		]
-		where
-			valuetype (BoolConfig _) = "Bool"
-			valuetype (StringConfig _) = "String"
-			valuetype (MaybeStringConfig _) = "Maybe String"
-			valuetype (MaybeBoolConfig _) = "Maybe Bool"
+	  where
+		valuetype (BoolConfig _) = "Bool"
+		valuetype (StringConfig _) = "String"
+		valuetype (MaybeStringConfig _) = "Maybe String"
+		valuetype (MaybeBoolConfig _) = "Maybe Bool"
 
 writeSysConfig :: [Config] -> IO ()
 writeSysConfig config = writeFile "Build/SysConfig.hs" body
-	where
-		body = unlines $ header ++ map show config ++ footer
-		header = [
-			  "{- Automatically generated. -}"
-			, "module Build.SysConfig where"
-			, ""
-			]
-		footer = []
+  where
+	body = unlines $ header ++ map show config ++ footer
+	header = [
+		  "{- Automatically generated. -}"
+		, "module Build.SysConfig where"
+		, ""
+		]
+	footer = []
 
 runTests :: [TestCase] -> IO [Config]
 runTests [] = return []
@@ -60,12 +60,12 @@ requireCmd :: ConfigKey -> String -> Test
 requireCmd k cmdline = do
 	ret <- testCmd k cmdline
 	handle ret
-	where
-		handle r@(Config _ (BoolConfig True)) = return r
-		handle r = do
-			testEnd r
-			error $ "** the " ++ c ++ " command is required"
-		c = head $ words cmdline
+  where
+	handle r@(Config _ (BoolConfig True)) = return r
+	handle r = do
+		testEnd r
+		error $ "** the " ++ c ++ " command is required"
+	c = head $ words cmdline
 
 {- Checks if a command is available by running a command line. -}
 testCmd :: ConfigKey -> String -> Test
@@ -75,7 +75,7 @@ testCmd k cmdline = do
 
 {- Ensures that one of a set of commands is available by running each in
  - turn. The Config is set to the first one found. -}
-selectCmd :: ConfigKey -> [String] -> String -> Test
+selectCmd :: ConfigKey -> [(String, String)] -> Test
 selectCmd k = searchCmd
 		(return . Config k . StringConfig)
 		(\cmds -> do
@@ -83,20 +83,20 @@ selectCmd k = searchCmd
 			error $ "* need one of these commands, but none are available: " ++ show cmds
 		)
 
-maybeSelectCmd :: ConfigKey -> [String] -> String -> Test
+maybeSelectCmd :: ConfigKey -> [(String, String)] -> Test
 maybeSelectCmd k = searchCmd
 		(return . Config k . MaybeStringConfig . Just)
 		(\_ -> return $ Config k $ MaybeStringConfig Nothing)
 
-searchCmd :: (String -> Test) -> ([String] -> Test) -> [String] -> String -> Test
-searchCmd success failure cmds param = search cmds
-	where
-		search [] = failure cmds
-		search (c:cs) = do
-			ret <- system $ quiet c ++ " " ++ param
-			if ret == ExitSuccess
-				then success c
-				else search cs
+searchCmd :: (String -> Test) -> ([String] -> Test) -> [(String, String)] -> Test
+searchCmd success failure cmdsparams = search cmdsparams
+  where
+	search [] = failure $ fst $ unzip cmdsparams
+	search ((c, params):cs) = do
+		ret <- system $ quiet $ c ++ " " ++ params
+		if ret == ExitSuccess
+			then success c
+			else search cs
 
 quiet :: String -> String
 quiet s = s ++ " >/dev/null 2>&1"
diff --git a/CHANGELOG b/CHANGELOG
index 0e01ba3..c05d529 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,54 @@
+git-annex (3.20121112) unstable; urgency=low
+
+  * assistant: Can use XMPP to notify other nodes about pushes made to other
+    repositories, as well as pushing to them directly over XMPP.
+  * wepapp: Added an XMPP configuration interface.
+  * webapp: Supports pairing over XMPP, with both friends, and other repos
+    using the same account.
+  * assistant: Drops non-preferred content when possible.
+  * assistant: Notices, and applies config changes as they are made to
+    the git-annex branch, including config changes pushed in from remotes.
+  * git-annex-shell: GIT_ANNEX_SHELL_DIRECTORY can be set to limit it
+    to operating on a specified directory.
+  * webapp: When setting up authorized_keys, use GIT_ANNEX_SHELL_DIRECTORY.
+  * Preferred content path matching bugfix.
+  * Preferred content expressions cannot use "in=".
+  * Preferred content expressions can use "present".
+  * Fix handling of GIT_DIR when it refers to a git submodule.
+  * Depend on and use the Haskell SafeSemaphore library, which provides
+    exception-safe versions of SampleVar and QSemN.
+    Thanks, Ben Gamari for an excellent patch set.
+  * file:/// URLs can now be used with the web special remote.
+  * webapp: Allow dashes in ssh key comments when pairing.
+  * uninit: Check and abort if there are symlinks to annexed content that
+    are not checked into git.
+  * webapp: Switched to using the same multicast IP address that avahi uses.
+  * bup: Don't pass - to bup-split to make it read stdin; bup 0.25
+    does not accept that.
+  * bugfix: Don't fail transferring content from read-only repos.
+    Closes: #691341
+  * configure: Check that checksum programs produce correct checksums.
+  * Re-enable dbus, using a new version of the library that fixes the memory
+    leak.
+  * NetWatcher: When dbus connection is lost, try to reconnect.
+  * Use USER and HOME environment when set, and only fall back to getpwent,
+    which doesn't work with LDAP or NIS.
+  * rsync special remote: Include annex-rsync-options when running rsync
+    to test a key's presence.
+  * The standalone tarball's runshell now takes care of installing a
+    ~/.ssh/git-annex-shell wrapper the first time it's run.
+  * webapp: Make an initial, empty commit so there is a master branch 
+  * assistant: Fix syncing local drives.
+  * webapp: Fix creation of rsync.net repositories.
+  * webapp: Fix renaming of special remotes.
+  * webapp: Generate better git remote names.
+  * webapp: Ensure that rsync special remotes are enabled using the same
+    name they were originally created using.
+  * Bugfix: Fix hang in webapp when setting up a ssh remote with an absolute
+    path.
+
+ -- Joey Hess <joeyh@debian.org>  Mon, 12 Nov 2012 10:39:47 -0400
+
 git-annex (3.20121017) unstable; urgency=low
 
   * Fix zombie cleanup reversion introduced in 3.20121009.
diff --git a/CmdLine.hs b/CmdLine.hs
index 331c363..0b15521 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -44,13 +44,13 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
 				sequence_ flags
 				prepCommand cmd params
 		 	tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdnocommit cmd]
-	where
-		err msg = msg ++ "\n\n" ++ usage header allcmds commonoptions
-		cmd = Prelude.head cmds
-		(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
-		(flags, params) = getOptCmd args cmd commonoptions err
-		checkfuzzy = when fuzzy $
-			inRepo $ Git.AutoCorrect.prepare name cmdname cmds
+  where
+	err msg = msg ++ "\n\n" ++ usage header allcmds commonoptions
+	cmd = Prelude.head cmds
+	(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
+	(flags, params) = getOptCmd args cmd commonoptions err
+	checkfuzzy = when fuzzy $
+		inRepo $ Git.AutoCorrect.prepare name cmdname cmds
 
 {- Parses command line params far enough to find the Command to run, and
  - returns the remaining params.
@@ -61,25 +61,25 @@ findCmd fuzzyok argv cmds err
 	| not (null exactcmds) = (False, exactcmds, fromJust name, args)
 	| fuzzyok && not (null inexactcmds) = (True, inexactcmds, fromJust name, args)
 	| otherwise = error $ err $ "unknown command " ++ fromJust name
-	where
-		(name, args) = findname argv []
-		findname [] c = (Nothing, reverse c)
-		findname (a:as) c
-			| "-" `isPrefixOf` a = findname as (a:c)
-			| otherwise = (Just a, reverse c ++ as)
-		exactcmds = filter (\c -> name == Just (cmdname c)) cmds
-		inexactcmds = case name of
-			Nothing -> []
-			Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds
+  where
+	(name, args) = findname argv []
+	findname [] c = (Nothing, reverse c)
+	findname (a:as) c
+		| "-" `isPrefixOf` a = findname as (a:c)
+		| otherwise = (Just a, reverse c ++ as)
+	exactcmds = filter (\c -> name == Just (cmdname c)) cmds
+	inexactcmds = case name of
+		Nothing -> []
+		Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds
 
 {- Parses command line options, and returns actions to run to configure flags
  - and the remaining parameters for the command. -}
 getOptCmd :: Params -> Command -> [Option] -> (String -> String) -> (Flags, Params)
 getOptCmd argv cmd commonoptions err = check $
 	getOpt Permute (commonoptions ++ cmdoptions cmd) argv
-	where
-		check (flags, rest, []) = (flags, rest)
-		check (_, _, errs) = error $ err $ concat errs
+  where
+	check (flags, rest, []) = (flags, rest)
+	check (_, _, errs) = error $ err $ concat errs
 
 {- Runs a list of Annex actions. Catches IO errors and continues
  - (but explicitly thrown errors terminate the whole command).
@@ -93,18 +93,18 @@ tryRun' errnum _ cmd []
 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
+  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
@@ -117,5 +117,6 @@ shutdown :: Bool -> Annex Bool
 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
diff --git a/Command.hs b/Command.hs
index 145ad50..bac2666 100644
--- a/Command.hs
+++ b/Command.hs
@@ -39,7 +39,6 @@ import Usage as ReExported
 import Logs.Trust
 import Config
 import Annex.CheckAttr
-import qualified Git.Command
 
 {- Generates a normal command -}
 command :: String -> String -> [CommandSeek] -> String -> Command
@@ -81,17 +80,14 @@ prepCommand Command { cmdseek = seek, cmdcheck = c } params = do
 {- 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 $ end
-		stage = (=<<)
-		skip = return True
-		failure = showEndFail >> return False
-		end r = do
-			-- zombies from long-running git processes
-			liftIO Git.Command.reap
-			showEndResult r >> return r
+  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. -}
@@ -122,26 +118,26 @@ numCopies file = readish <$> checkAttr "annex.numcopies" file
  -}
 autoCopies :: FilePath -> Key -> (Int -> Int -> Bool) -> CommandStart -> CommandStart
 autoCopies file key vs a = Annex.getState Annex.auto >>= go
-	where
-		go False = a
-		go True = do
-			numcopiesattr <- numCopies file
-			needed <- getNumCopies numcopiesattr
-			(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
-			if length have `vs` needed then a else stop
+  where
+	go False = a
+	go True = do
+		numcopiesattr <- numCopies file
+		needed <- getNumCopies numcopiesattr
+		have <- trustExclude UnTrusted =<< Remote.keyLocations key
+		if length have `vs` needed then a else stop
 
 autoCopiesWith :: FilePath -> Key -> (Int -> Int -> Bool) -> (Maybe Int -> CommandStart) -> CommandStart
 autoCopiesWith file key vs a = do
 	numcopiesattr <- numCopies file
 	Annex.getState Annex.auto >>= auto numcopiesattr
-	where
-		auto numcopiesattr False = a numcopiesattr
-		auto numcopiesattr True = do
-			needed <- getNumCopies numcopiesattr
-			(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
-			if length have `vs` needed
-				then a numcopiesattr
-				else stop
+  where
+	auto numcopiesattr False = a numcopiesattr
+	auto numcopiesattr True = do
+		needed <- getNumCopies numcopiesattr
+		have <- trustExclude UnTrusted =<< Remote.keyLocations key
+		if length have `vs` needed
+			then a numcopiesattr
+			else stop
 
 checkAuto :: Annex Bool -> Annex Bool
 checkAuto checker = ifM (Annex.getState Annex.auto)
diff --git a/Command/Add.hs b/Command/Add.hs
index 73edb5e..7fa7cb3 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -32,20 +32,20 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
  - to its content. -}
 start :: FilePath -> CommandStart
 start file = notBareRepo $ ifAnnexed file fixup add
-	where
-		add = do
-			s <- liftIO $ getSymbolicLinkStatus file
-			if isSymbolicLink s || not (isRegularFile s)
-				then stop
-				else do
-					showStart "add" file
-					next $ perform file
-		fixup (key, _) = do
-			-- fixup from an interrupted add; the symlink
-			-- is present but not yet added to git
-			showStart "add" file
-			liftIO $ removeFile file
-			next $ next $ cleanup file key =<< inAnnex key
+  where
+	add = do
+		s <- liftIO $ getSymbolicLinkStatus file
+		if isSymbolicLink s || not (isRegularFile s)
+			then stop
+			else do
+				showStart "add" file
+				next $ perform file
+	fixup (key, _) = do
+		-- fixup from an interrupted add; the symlink
+		-- is present but not yet added to git
+		showStart "add" file
+		liftIO $ removeFile file
+		next $ next $ cleanup file key =<< inAnnex key
 
 {- The file that's being added is locked down before a key is generated,
  - to prevent it from being modified in between. It's hard linked into a
@@ -67,15 +67,15 @@ ingest :: KeySource -> Annex (Maybe Key)
 ingest source = do
 	backend <- chooseBackend $ keyFilename source
 	genKey source backend >>= go
-	where
-		go Nothing = do
-			liftIO $ nukeFile $ contentLocation source
-			return Nothing
-		go (Just (key, _)) = do
-			handle (undo (keyFilename source) key) $
-				moveAnnex key $ contentLocation source
-			liftIO $ nukeFile $ keyFilename source
-			return $ Just key
+  where
+	go Nothing = do
+		liftIO $ nukeFile $ contentLocation source
+		return Nothing
+	go (Just (key, _)) = do
+		handle (undo (keyFilename source) key) $
+			moveAnnex key $ contentLocation source
+		liftIO $ nukeFile $ keyFilename source
+		return $ Just key
 
 perform :: FilePath -> CommandPerform
 perform file = 
@@ -91,12 +91,12 @@ undo file key e = do
 		handle tryharder $ fromAnnex key file
 		logStatus key InfoMissing
 	throw e
-	where
-		-- fromAnnex could fail if the file ownership is weird
-		tryharder :: IOException -> Annex ()
-		tryharder _ = do
-			src <- inRepo $ gitAnnexLocation key
-			liftIO $ moveFile src file
+  where
+	-- fromAnnex could fail if the file ownership is weird
+	tryharder :: IOException -> Annex ()
+	tryharder _ = do
+		src <- inRepo $ gitAnnexLocation key
+		liftIO $ moveFile src file
 
 {- Creates the symlink to the annexed content, returns the link target. -}
 link :: FilePath -> Key -> Bool -> Annex String
diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs
index f705003..519c67e 100644
--- a/Command/AddUnused.hs
+++ b/Command/AddUnused.hs
@@ -25,8 +25,8 @@ start = startUnused "addunused" perform (performOther "bad") (performOther "tmp"
 
 perform :: Key -> CommandPerform
 perform key = next $ Command.Add.cleanup file key True
-	where
-		file = "unused." ++ key2file key
+  where
+	file = "unused." ++ key2file key
 
 {- The content is not in the annex, but in another directory, and
  - it seems better to error out, rather than moving bad/tmp content into
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index bef1d68..0003237 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -40,31 +40,31 @@ seek = [withField fileOption return $ \f ->
 
 start :: Maybe FilePath -> Maybe Int -> String -> CommandStart
 start optfile pathdepth s = notBareRepo $ go $ fromMaybe bad $ parseURI s
-	where
-		bad = fromMaybe (error $ "bad url " ++ s) $
-			parseURI $ escapeURIString isUnescapedInURI s
-		go url = do
-			let file = fromMaybe (url2file url pathdepth) optfile
-			showStart "addurl" file
-			next $ perform s file
+  where
+	bad = fromMaybe (error $ "bad url " ++ s) $
+		parseURI $ escapeURIString isUnescapedInURI s
+	go url = do
+		let file = fromMaybe (url2file url pathdepth) optfile
+		showStart "addurl" file
+		next $ perform s file
 
 perform :: String -> FilePath -> CommandPerform
 perform url file = ifAnnexed file addurl geturl
-	where
-		geturl = do
-			liftIO $ createDirectoryIfMissing True (parentDir file)
-			ifM (Annex.getState Annex.fast)
-				( nodownload url file , download url file )
-		addurl (key, _backend) = do
-			headers <- getHttpHeaders
-			ifM (liftIO $ Url.check url headers $ keySize key)
-				( do
-					setUrlPresent key url
-					next $ return True
-				, do
-					warning $ "failed to verify url: " ++ url
-					stop
-				)
+  where
+	geturl = do
+		liftIO $ createDirectoryIfMissing True (parentDir file)
+		ifM (Annex.getState Annex.fast)
+			( nodownload url file , download url file )
+	addurl (key, _backend) = do
+		headers <- getHttpHeaders
+		ifM (liftIO $ Url.check url headers $ keySize key)
+			( do
+				setUrlPresent key url
+				next $ return True
+			, do
+				warning $ "failed to verify url: " ++ url
+				stop
+			)
 
 download :: String -> FilePath -> CommandPerform
 download url file = do
@@ -103,10 +103,10 @@ url2file url pathdepth = case pathdepth of
 		| depth > 0 -> frombits $ drop depth
 		| depth < 0 -> frombits $ reverse . take (negate depth) . reverse
 		| otherwise -> error "bad --pathdepth"
-	where
-		fullurl = uriRegName auth ++ uriPath url ++ uriQuery url
-		frombits a = join "/" $ a urlbits
-		urlbits = map (filesize . escape) $ filter (not . null) $ split "/" fullurl
-		auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
-		filesize = take 255
-		escape = replace "/" "_" . replace "?" "_"
+  where
+	fullurl = uriRegName auth ++ uriPath url ++ uriQuery url
+	frombits a = join "/" $ a urlbits
+	urlbits = map (filesize . escape) $ filter (not . null) $ split "/" fullurl
+	auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
+	filesize = take 255
+	escape = replace "/" "_" . replace "?" "_"
diff --git a/Command/Assistant.hs b/Command/Assistant.hs
index b039e27..ea8a87a 100644
--- a/Command/Assistant.hs
+++ b/Command/Assistant.hs
@@ -65,7 +65,7 @@ autoStart = do
 					)
 		, nothing
 		)
-	where
-		go program dir = do
-			changeWorkingDirectory dir
-			boolSystem program [Param "assistant"]
+  where
+	go program dir = do
+		changeWorkingDirectory dir
+		boolSystem program [Param "assistant"]
diff --git a/Command/Commit.hs b/Command/Commit.hs
index d3ce3d7..1659061 100644
--- a/Command/Commit.hs
+++ b/Command/Commit.hs
@@ -24,6 +24,6 @@ start = next $ next $ do
 	Annex.Branch.commit "update"
 	_ <- runhook <=< inRepo $ Git.hookPath "annex-content"
 	return True
-	where
-		runhook (Just hook) = liftIO $ boolSystem hook []
-		runhook Nothing = return True
+  where
+	runhook (Just hook) = liftIO $ boolSystem hook []
+	runhook Nothing = return True
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 4352aaa..dd55992 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -29,7 +29,7 @@ start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandSt
 start to from file (key, backend) = autoCopies file key (<) $
 	stopUnless shouldCopy $ 
 		Command.Move.start to from False file (key, backend)
-	where
-		shouldCopy = case to of
-			Nothing -> checkAuto $ wantGet (Just file)
-			Just r -> checkAuto $ wantSend (Just file) (Remote.uuid r)
+  where
+	shouldCopy = case to of
+		Nothing -> checkAuto $ wantGet (Just file)
+		Just r -> checkAuto $ wantSend (Just file) (Remote.uuid r)
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 26e80f8..6c210b1 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -48,7 +48,7 @@ startLocal file numcopies key = stopUnless (inAnnex key) $ do
 
 startRemote :: FilePath -> Maybe Int -> Key -> Remote -> CommandStart
 startRemote file numcopies key remote = do
-	showStart "drop" file
+	showStart ("drop " ++ Remote.name remote) file
 	next $ performRemote key numcopies remote
 
 performLocal :: Key -> Maybe Int -> CommandPerform
@@ -76,8 +76,8 @@ performRemote key numcopies remote = lockContent key $ do
 	stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do
 		ok <- Remote.removeKey remote key
 		next $ cleanupRemote key remote ok
-	where
-		uuid = Remote.uuid remote
+ where
+	uuid = Remote.uuid remote
 
 cleanupLocal :: Key -> CommandCleanup
 cleanupLocal key = do
@@ -106,20 +106,20 @@ canDropKey key numcopiesM have check skip = do
 
 findCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
 findCopies key need skip = helper []
-	where
-		helper bad have []
-			| length have >= need = return True
-			| otherwise = notEnoughCopies key need have skip bad
-		helper bad have (r:rs)
-			| length have >= need = return True
-			| otherwise = do
-				let u = Remote.uuid r
-				let duplicate = u `elem` have
-				haskey <- Remote.hasKey r key
-				case (duplicate, haskey) of
-					(False, Right True) -> helper bad (u:have) rs
-					(False, Left _)     -> helper (r:bad) have rs
-					_                   -> helper bad have rs
+  where
+	helper bad have []
+		| length have >= need = return True
+		| otherwise = notEnoughCopies key need have skip bad
+	helper bad have (r:rs)
+		| length have >= need = return True
+		| otherwise = do
+			let u = Remote.uuid r
+			let duplicate = u `elem` have
+			haskey <- Remote.hasKey r key
+			case (duplicate, haskey) of
+				(False, Right True) -> helper bad (u:have) rs
+				(False, Left _)     -> helper (r:bad) have rs
+				_                   -> helper bad have rs
 
 notEnoughCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
 notEnoughCopies key need have skip bad = do
@@ -132,6 +132,6 @@ notEnoughCopies key need have skip bad = do
 	Remote.showLocations key (have++skip)
 	hint
 	return False
-	where
-		unsafe = showNote "unsafe"
-		hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)"
+  where
+	unsafe = showNote "unsafe"
+	hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)"
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 597a4ee..00c0eec 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -29,13 +29,13 @@ start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (per
 
 perform :: Key -> CommandPerform
 perform key = maybe droplocal dropremote =<< Remote.byName =<< from
-	where
-		dropremote r = do
-			showAction $ "from " ++ Remote.name r
-			ok <- Remote.removeKey r key
-			next $ Command.Drop.cleanupRemote key r ok
-		droplocal = Command.Drop.performLocal key (Just 0) -- force drop
-		from = Annex.getField $ Option.name Command.Drop.fromOption
+  where
+	dropremote r = do
+		showAction $ "from " ++ Remote.name r
+		ok <- Remote.removeKey r key
+		next $ Command.Drop.cleanupRemote key r ok
+	droplocal = Command.Drop.performLocal key (Just 0) -- force drop
+	from = Annex.getField $ Option.name Command.Drop.fromOption
 
 performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
 performOther filespec key = do
diff --git a/Command/Find.hs b/Command/Find.hs
index 177b794..1e509d1 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -29,14 +29,14 @@ formatOption = Option.field [] "format" paramFormat "control format of output"
 print0Option :: Option
 print0Option = Option.Option [] ["print0"] (Option.NoArg set)
 	"terminate output with null"
-	where
-		set = Annex.setField (Option.name formatOption) "${file}\0"
+  where
+	set = Annex.setField (Option.name formatOption) "${file}\0"
 
 seek :: [CommandSeek]
 seek = [withField formatOption formatconverter $ \f ->
 		withFilesInGit $ whenAnnexed $ start f]
-	where
-		formatconverter = return . fmap Utility.Format.gen
+  where
+	formatconverter = return . fmap Utility.Format.gen
 
 start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
 start format file (key, _) = do
@@ -50,12 +50,12 @@ start format file (key, _) = do
 					Utility.Format.format formatter $
 						M.fromList vars
 	stop
-	where
-		vars =
-			[ ("file", file)
-			, ("key", key2file key)
-			, ("backend", keyBackendName key)
-			, ("bytesize", size show)
-			, ("humansize", size $ roughSize storageUnits True)
-			]
-		size c = maybe "unknown" c $ keySize key
+  where
+	vars =
+		[ ("file", file)
+		, ("key", key2file key)
+		, ("backend", keyBackendName key)
+		, ("bytesize", size show)
+		, ("humansize", size $ roughSize storageUnits True)
+		]
+	size c = maybe "unknown" c $ keySize key
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 5e130c9..deb3a5c 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -78,22 +78,22 @@ withIncremental = withValue $ do
 		(True, _, _) ->
 			maybe startIncremental (return . ContIncremental . Just)
 				=<< getStartTime
-	where
-		startIncremental = do
-			recordStartTime
-			return StartIncremental
-
-		checkschedule Nothing = error "bad --incremental-schedule value"
-		checkschedule (Just delta) = do
-			Annex.addCleanup "" $ do
-				v <- getStartTime
-				case v of
-					Nothing -> noop
-					Just started -> do
-						now <- liftIO getPOSIXTime
-						when (now - realToFrac started >= delta) $
-							resetStartTime
-			return True
+  where
+	startIncremental = do
+		recordStartTime
+		return StartIncremental
+
+	checkschedule Nothing = error "bad --incremental-schedule value"
+	checkschedule (Just delta) = do
+		Annex.addCleanup "" $ do
+			v <- getStartTime
+			case v of
+				Nothing -> noop
+				Just started -> do
+					now <- liftIO getPOSIXTime
+					when (now - realToFrac started >= delta) $
+						resetStartTime
+		return True
 
 start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart
 start from inc file (key, backend) = do
@@ -101,8 +101,8 @@ start from inc file (key, backend) = do
 	case from of
 		Nothing -> go $ perform key file backend numcopies
 		Just r -> go $ performRemote key file backend numcopies r
-	where
-		go = runFsck inc file key
+  where
+	go = runFsck inc file key
 
 perform :: Key -> FilePath -> Backend -> Maybe Int -> Annex Bool
 perform key file backend numcopies = check
@@ -119,48 +119,48 @@ perform key file backend numcopies = check
 performRemote :: Key -> FilePath -> Backend -> Maybe Int -> Remote -> Annex Bool
 performRemote key file backend numcopies remote =
 	dispatch =<< Remote.hasKey remote key
-	where
-		dispatch (Left err) = do
-			showNote err
-			return False
-		dispatch (Right True) = withtmp $ \tmpfile ->
-			ifM (getfile tmpfile)
-				( go True (Just tmpfile)
-				, go True Nothing
-				)
-		dispatch (Right False) = go False Nothing
-		go present localcopy = check
-			[ verifyLocationLogRemote key file remote present
-			, checkKeySizeRemote key remote localcopy
-			, checkBackendRemote backend key remote localcopy
-			, checkKeyNumCopies key file numcopies
-			]
-		withtmp a = do
-			pid <- liftIO getProcessID
-			t <- fromRepo gitAnnexTmpDir
-			createAnnexDirectory t
-			let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
-			let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
-			cleanup
-			cleanup `after` a tmp
-		getfile tmp =
-			ifM (Remote.retrieveKeyFileCheap remote key tmp)
-				( return True
-				, ifM (Annex.getState Annex.fast)
-					( return False
-					, Remote.retrieveKeyFile remote key Nothing tmp
-					)
+  where
+	dispatch (Left err) = do
+		showNote err
+		return False
+	dispatch (Right True) = withtmp $ \tmpfile ->
+		ifM (getfile tmpfile)
+			( go True (Just tmpfile)
+			, go True Nothing
+			)
+	dispatch (Right False) = go False Nothing
+	go present localcopy = check
+		[ verifyLocationLogRemote key file remote present
+		, checkKeySizeRemote key remote localcopy
+		, checkBackendRemote backend key remote localcopy
+		, checkKeyNumCopies key file numcopies
+		]
+	withtmp a = do
+		pid <- liftIO getProcessID
+		t <- fromRepo gitAnnexTmpDir
+		createAnnexDirectory t
+		let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
+		let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
+		cleanup
+		cleanup `after` a tmp
+	getfile tmp =
+		ifM (Remote.retrieveKeyFileCheap remote key tmp)
+			( return True
+			, ifM (Annex.getState Annex.fast)
+				( return False
+				, Remote.retrieveKeyFile remote key Nothing tmp
 				)
+			)
 
 {- To fsck a bare repository, fsck each key in the location log. -}
 withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek
 withBarePresentKeys a params = isBareRepo >>= go
-	where
-		go False = return []
-		go True = do
-			unless (null params) $
-				error "fsck should be run without parameters in a bare repository"
-			map a <$> loggedKeys
+  where
+	go False = return []
+	go True = do
+		unless (null params) $
+			error "fsck should be run without parameters in a bare repository"
+		map a <$> loggedKeys
 
 startBare :: Incremental -> Key -> CommandStart
 startBare inc key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of
@@ -242,10 +242,10 @@ verifyLocationLog' key desc present u bad = do
 					"but its content is missing."
 				return False
 		_ -> return True
-	where
-		fix s = do
-			showNote "fixing location log"
-			bad s
+  where
+	fix s = do
+		showNote "fixing location log"
+		bad s
 
 {- The size of the data for a key is checked against the size encoded in
  - the key's metadata, if available. -}
@@ -269,19 +269,19 @@ checkKeySizeOr bad key file = case Types.Key.keySize key of
 		size' <- fromIntegral . fileSize
 			<$> liftIO (getFileStatus file)
 		comparesizes size size'
-	where
-		comparesizes a b = do
-			let same = a == b
-			unless same $ badsize a b
-			return same
-		badsize a b = do
-			msg <- bad key
-			warning $ concat
-				[ "Bad file size ("
-				, compareSizes storageUnits True a b
-				, "); "
-				, msg
-				]
+  where
+	comparesizes a b = do
+		let same = a == b
+		unless same $ badsize a b
+		return same
+	badsize a b = do
+		msg <- bad key
+		warning $ concat
+			[ "Bad file size ("
+			, compareSizes storageUnits True a b
+			, "); "
+			, msg
+			]
 
 checkBackend :: Backend -> Key -> Annex Bool
 checkBackend backend key = do
@@ -290,8 +290,8 @@ checkBackend backend key = do
 
 checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
 checkBackendRemote backend key remote = maybe (return True) go
-	where
-		go = checkBackendOr (badContentRemote remote) backend key
+  where
+	go = checkBackendOr (badContentRemote remote) backend key
 
 checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool
 checkBackendOr bad backend key file =
@@ -414,9 +414,9 @@ recordStartTime = do
 		t <- modificationTime <$> getFileStatus f
 		hPutStr h $ showTime $ realToFrac t
 		hClose h
-	where
-		showTime :: POSIXTime -> String
-		showTime = show
+  where
+	showTime :: POSIXTime -> String
+	showTime = show
 
 resetStartTime :: Annex ()
 resetStartTime = liftIO . nukeFile =<< fromRepo gitAnnexFsckState
@@ -431,7 +431,7 @@ getStartTime = do
 		return $ if Just (realToFrac timestamp) == t
 			then Just timestamp
 			else Nothing
-	where
-		readishTime :: String -> Maybe POSIXTime
-		readishTime s = utcTimeToPOSIXSeconds <$>
-			parseTime defaultTimeLocale "%s%Qs" s
+  where
+	readishTime :: String -> Maybe POSIXTime
+	readishTime s = utcTimeToPOSIXSeconds <$>
+		parseTime defaultTimeLocale "%s%Qs" s
diff --git a/Command/Get.hs b/Command/Get.hs
index c95e4eb..7f02e79 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -32,10 +32,10 @@ start from file (key, _) = stopUnless ((not <$> inAnnex key) <&&> checkAuto (wan
 				-- get --from = copy --from
 				stopUnless (Command.Move.fromOk src key) $
 					go $ Command.Move.fromPerform src False key file
-	where
-		go a = do
-			showStart "get" file
-			next a
+  where
+	go a = do
+		showStart "get" file
+		next a
 
 perform :: Key -> FilePath -> CommandPerform
 perform key file = stopUnless (getViaTmp key $ getKeyFile key file) $
@@ -45,29 +45,29 @@ perform key file = stopUnless (getViaTmp key $ getKeyFile key file) $
  - and copy it to here. -}
 getKeyFile :: Key -> FilePath -> FilePath -> Annex Bool
 getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key
-	where
-		dispatch [] = do
-			showNote "not available"
-			Remote.showLocations key []
-			return False
-		dispatch remotes = trycopy remotes remotes
-		trycopy full [] = do
-			Remote.showTriedRemotes full
-			Remote.showLocations key []
-			return False
-		trycopy full (r:rs) =
-			ifM (probablyPresent r)
-				( docopy r (trycopy full rs)
-				, trycopy full rs
-				)
-		-- This check is to avoid an ugly message if a remote is a
-		-- drive that is not mounted.
-		probablyPresent r
-			| Remote.hasKeyCheap r =
-				either (const False) id <$> Remote.hasKey r key
-			| otherwise = return True
-		docopy r continue = do
-			ok <- download (Remote.uuid r) key (Just file) noRetry $ do
-				showAction $ "from " ++ Remote.name r
-				Remote.retrieveKeyFile r key (Just file) dest
-			if ok then return ok else continue
+  where
+	dispatch [] = do
+		showNote "not available"
+		Remote.showLocations key []
+		return False
+	dispatch remotes = trycopy remotes remotes
+	trycopy full [] = do
+		Remote.showTriedRemotes full
+		Remote.showLocations key []
+		return False
+	trycopy full (r:rs) =
+		ifM (probablyPresent r)
+			( docopy r (trycopy full rs)
+			, trycopy full rs
+			)
+	-- This check is to avoid an ugly message if a remote is a
+	-- drive that is not mounted.
+	probablyPresent r
+		| Remote.hasKeyCheap r =
+			either (const False) id <$> Remote.hasKey r key
+		| otherwise = return True
+	docopy r continue = do
+		ok <- download (Remote.uuid r) key (Just file) noRetry $ do
+			showAction $ "from " ++ Remote.name r
+			Remote.retrieveKeyFile r key (Just file) dest
+		if ok then return ok else continue
diff --git a/Command/Help.hs b/Command/Help.hs
index 80a7b95..95033eb 100644
--- a/Command/Help.hs
+++ b/Command/Help.hs
@@ -47,5 +47,5 @@ showHelp = liftIO $ putStrLn $ unlines
 		]
 	, "Run git-annex without any options for a complete command and option list."
 	]
-	where
-		cmdline c = "\t" ++ cmdname c ++ "\t" ++ cmddesc c
+  where
+	cmdline c = "\t" ++ cmdname c ++ "\t" ++ cmddesc c
diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs
index ac4af8d..cd4bff2 100644
--- a/Command/InAnnex.hs
+++ b/Command/InAnnex.hs
@@ -20,8 +20,8 @@ seek = [withKeys start]
 
 start :: Key -> CommandStart
 start key = inAnnexSafe key >>= dispatch
-	where
-		dispatch (Just True) = stop
-		dispatch (Just False) = exit 1
-		dispatch Nothing = exit 100
-		exit n = liftIO $ exitWith $ ExitFailure n
+  where
+	dispatch (Just True) = stop
+	dispatch (Just False) = exit 1
+	dispatch Nothing = exit 100
+	exit n = liftIO $ exitWith $ ExitFailure n
diff --git a/Command/Init.hs b/Command/Init.hs
index bbabdc4..342ef84 100644
--- a/Command/Init.hs
+++ b/Command/Init.hs
@@ -22,8 +22,8 @@ start :: [String] -> CommandStart
 start ws = do
 	showStart "init" description
 	next $ perform description
-	where
-		description = unwords ws
+  where
+	description = unwords ws
 
 perform :: String -> CommandPerform
 perform description = do
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs
index ad93529..720fddd 100644
--- a/Command/InitRemote.hs
+++ b/Command/InitRemote.hs
@@ -40,8 +40,8 @@ start (name:ws) = do
 	showStart "initremote" name
 	next $ perform t u name $ M.union config c
 
-	where
-		config = Logs.Remote.keyValToConfig ws
+  where
+	config = Logs.Remote.keyValToConfig ws
 
 perform :: RemoteType -> UUID -> String -> R.RemoteConfig -> CommandPerform
 perform t u name c = do
@@ -59,19 +59,19 @@ findByName :: String -> Annex (UUID, R.RemoteConfig)
 findByName name = do
 	m <- Logs.Remote.readRemoteLog
 	maybe generate return $ findByName' name m
-	where
-		generate = do
-			uuid <- liftIO genUUID
-			return (uuid, M.insert nameKey name M.empty)
+  where
+	generate = do
+		uuid <- liftIO genUUID
+		return (uuid, M.insert nameKey name M.empty)
 
 findByName' :: String ->  M.Map UUID R.RemoteConfig -> Maybe (UUID, R.RemoteConfig)
 findByName' n = headMaybe . filter (matching . snd) . M.toList
-	where
-		matching c = case M.lookup nameKey c of
-			Nothing -> False
-			Just n'
-				| n' == n -> True
-				| otherwise -> False
+  where
+	matching c = case M.lookup nameKey c of
+		Nothing -> False
+		Just n'
+			| n' == n -> True
+			| otherwise -> False
 
 remoteNames :: Annex [String]
 remoteNames = do
@@ -81,12 +81,12 @@ remoteNames = do
 {- find the specified remote type -}
 findType :: R.RemoteConfig -> Annex RemoteType
 findType config = maybe unspecified specified $ M.lookup typeKey config
-	where
-		unspecified = error "Specify the type of remote with type="
-		specified s = case filter (findtype s) Remote.remoteTypes of
-			[] -> error $ "Unknown remote type " ++ s
-			(t:_) -> return t
-		findtype s i = R.typename i == s
+  where
+	unspecified = error "Specify the type of remote with type="
+	specified s = case filter (findtype s) Remote.remoteTypes of
+		[] -> error $ "Unknown remote type " ++ s
+		(t:_) -> return t
+	findtype s i = R.typename i == s
 
 {- The name of a configured remote is stored in its config using this key. -}
 nameKey :: String
diff --git a/Command/Log.hs b/Command/Log.hs
index c3ce679..6608a99 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -47,9 +47,8 @@ passthruOptions = map odate ["since", "after", "until", "before"] ++
 	[ Option.field ['n'] "max-count" paramNumber
 		"limit number of logs displayed"
 	]
-	where
-		odate n = Option.field [] n paramDate $
-			"show log " ++ n ++ " date"
+  where
+	odate n = Option.field [] n paramDate $ "show log " ++ n ++ " date"
 
 gourceOption :: Option
 gourceOption = Option.flag [] "gource" "format output for gource"
@@ -60,53 +59,53 @@ seek = [withValue Remote.uuidDescriptions $ \m ->
 	withValue (concat <$> mapM getoption passthruOptions) $ \os ->
 	withFlag gourceOption $ \gource ->
 	withFilesInGit $ whenAnnexed $ start m zone os gource]
-	where
-		getoption o = maybe [] (use o) <$>
-			Annex.getField (Option.name o)
-		use o v = [Param ("--" ++ Option.name o), Param v]
+  where
+	getoption o = maybe [] (use o) <$>
+		Annex.getField (Option.name o)
+	use o v = [Param ("--" ++ Option.name o), Param v]
 
 start :: M.Map UUID String -> TimeZone -> [CommandParam] -> Bool ->
 	FilePath -> (Key, Backend) -> CommandStart
 start m zone os gource file (key, _) = do
 	showLog output =<< readLog <$> getLog key os
 	-- getLog produces a zombie; reap it
-	liftIO Git.Command.reap
+	liftIO reapZombies
 	stop
-	where
-		output
-			| gource = gourceOutput lookupdescription file
-			| otherwise = normalOutput lookupdescription file zone
-		lookupdescription u = fromMaybe (fromUUID u) $ M.lookup u m
+  where
+	output
+		| gource = gourceOutput lookupdescription file
+		| otherwise = normalOutput lookupdescription file zone
+	lookupdescription u = fromMaybe (fromUUID u) $ M.lookup u m
 
 showLog :: Outputter -> [RefChange] -> Annex ()
 showLog outputter ps = do
 	sets <- mapM (getset newref) ps
 	previous <- maybe (return genesis) (getset oldref) (lastMaybe ps)
 	sequence_ $ compareChanges outputter $ sets ++ [previous]
-	where
-		genesis = (0, S.empty)
-		getset select change = do
-			s <- S.fromList <$> get (select change)
-			return (changetime change, s)
-		get ref = map toUUID . Logs.Presence.getLog . L.unpack <$>
-			catObject ref
+  where
+	genesis = (0, S.empty)
+	getset select change = do
+		s <- S.fromList <$> get (select change)
+		return (changetime change, s)
+	get ref = map toUUID . Logs.Presence.getLog . L.unpack <$>
+		catObject ref
 
 normalOutput :: (UUID -> String) -> FilePath -> TimeZone -> Outputter
 normalOutput lookupdescription file zone present ts us =
 	liftIO $ mapM_ (putStrLn . format) us
-	where
-		time = showTimeStamp zone ts
-		addel = if present then "+" else "-"
-		format u = unwords [ addel, time, file, "|", 
-			fromUUID u ++ " -- " ++ lookupdescription u ]
+  where
+	time = showTimeStamp zone ts
+	addel = if present then "+" else "-"
+	format u = unwords [ addel, time, file, "|", 
+		fromUUID u ++ " -- " ++ lookupdescription u ]
 
 gourceOutput :: (UUID -> String) -> FilePath -> Outputter
 gourceOutput lookupdescription file present ts us =
 	liftIO $ mapM_ (putStrLn . intercalate "|" . format) us
-	where
-		time = takeWhile isDigit $ show ts
-		addel = if present then "A" else "M"
-		format u = [ time, lookupdescription u, addel, file ]
+  where
+	time = takeWhile isDigit $ show ts
+	addel = if present then "A" else "M"
+	format u = [ time, lookupdescription u, addel, file ]
 
 {- Generates a display of the changes (which are ordered with newest first),
  - by comparing each change with the previous change.
@@ -114,12 +113,12 @@ gourceOutput lookupdescription file present ts us =
  - removed. -}
 compareChanges :: Ord a => (Bool -> POSIXTime -> [a] -> b) -> [(POSIXTime, S.Set a)] -> [b]
 compareChanges format changes = concatMap diff $ zip changes (drop 1 changes)
-	where
-		diff ((ts, new), (_, old)) =
-			[format True ts added, format False ts removed]
-			where
-				added = S.toList $ S.difference new old
-				removed = S.toList $ S.difference old new
+  where
+	diff ((ts, new), (_, old)) =
+		[format True ts added, format False ts removed]
+	  where
+		added = S.toList $ S.difference new old
+		removed = S.toList $ S.difference old new
 
 {- Gets the git log for a given location log file.
  -
@@ -148,22 +147,21 @@ getLog key os = do
 
 readLog :: [String] -> [RefChange]
 readLog = mapMaybe (parse . lines)
-	where
-		parse (ts:raw:[]) = let (old, new) = parseRaw raw in
-			Just RefChange
-				{ changetime = parseTimeStamp ts
-				, oldref = old
-				, newref = new
-				}
-		parse _ = Nothing
+  where
+	parse (ts:raw:[]) = let (old, new) = parseRaw raw in
+		Just RefChange
+			{ changetime = parseTimeStamp ts
+			, oldref = old
+			, newref = new
+			}
+	parse _ = Nothing
 
 -- Parses something like ":100644 100644 oldsha newsha M"
 parseRaw :: String -> (Git.Ref, Git.Ref)
-parseRaw l = (Git.Ref oldsha, Git.Ref newsha)
-	where
-		ws = words l
-		oldsha = ws !! 2
-		newsha = ws !! 3
+parseRaw l = go $ words l
+  where
+	go (_:_:oldsha:newsha:_) = (Git.Ref oldsha, Git.Ref newsha)
+	go _ = error $ "unable to parse git log output: " ++ l
 
 parseTimeStamp :: String -> POSIXTime
 parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (error "bad timestamp") .
diff --git a/Command/Map.hs b/Command/Map.hs
index 3dbdadb..94b1289 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -63,14 +63,13 @@ start = do
  -}
 drawMap :: [Git.Repo] -> M.Map UUID String -> [UUID] -> String
 drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others
-	where
-		repos = map (node umap rs) rs
-		ruuids = ts ++ map getUncachedUUID rs
-		others = map (unreachable . uuidnode) $
-			filter (`notElem` ruuids) (M.keys umap)
-		trusted = map (trustworthy . uuidnode) ts
-		uuidnode u = Dot.graphNode (fromUUID u) $
-			M.findWithDefault "" u umap
+  where
+	repos = map (node umap rs) rs
+	ruuids = ts ++ map getUncachedUUID rs
+	others = map (unreachable . uuidnode) $
+		filter (`notElem` ruuids) (M.keys umap)
+	trusted = map (trustworthy . uuidnode) ts
+	uuidnode u = Dot.graphNode (fromUUID u) $ M.findWithDefault "" u umap
 
 hostname :: Git.Repo -> String
 hostname r
@@ -86,9 +85,9 @@ repoName :: M.Map UUID String -> Git.Repo -> String
 repoName umap r
 	| repouuid == NoUUID = fallback
 	| otherwise = M.findWithDefault fallback repouuid umap
-	where
-		repouuid = getUncachedUUID r
-		fallback = fromMaybe "unknown" $ Git.remoteName r
+  where
+	repouuid = getUncachedUUID r
+	fallback = fromMaybe "unknown" $ Git.remoteName r
 
 {- A unique id for the node for a repo. Uses the annex.uuid if available. -}
 nodeId :: Git.Repo -> String
@@ -100,32 +99,32 @@ nodeId r =
 {- A node representing a repo. -}
 node :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> String
 node umap fullinfo r = unlines $ n:edges
-	where
-		n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $
-			decorate $ Dot.graphNode (nodeId r) (repoName umap r)
-		edges = map (edge umap fullinfo r) (Git.remotes r)
-		decorate
-			| Git.config r == M.empty = unreachable
-			| otherwise = reachable
+  where
+	n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $
+		decorate $ Dot.graphNode (nodeId r) (repoName umap r)
+	edges = map (edge umap fullinfo r) (Git.remotes r)
+	decorate
+		| Git.config r == M.empty = unreachable
+		| otherwise = reachable
 
 {- An edge between two repos. The second repo is a remote of the first. -}
 edge :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> Git.Repo -> String	
 edge umap fullinfo from to =
 	Dot.graphEdge (nodeId from) (nodeId fullto) edgename
-	where
-		-- get the full info for the remote, to get its UUID
-		fullto = findfullinfo to
-		findfullinfo n =
-			case filter (same n) fullinfo of
-				[] -> n
-				(n':_) -> n'
-		{- Only name an edge if the name is different than the name
-		 - that will be used for the destination node, and is
-		 - different from its hostname. (This reduces visual clutter.) -}
-		edgename = maybe Nothing calcname $ Git.remoteName to
-		calcname n
-			| n `elem` [repoName umap fullto, hostname fullto] = Nothing
-			| otherwise = Just n
+  where
+	-- get the full info for the remote, to get its UUID
+	fullto = findfullinfo to
+	findfullinfo n =
+		case filter (same n) fullinfo of
+			[] -> n
+			(n':_) -> n'
+	{- Only name an edge if the name is different than the name
+	 - that will be used for the destination node, and is
+	 - different from its hostname. (This reduces visual clutter.) -}
+	edgename = maybe Nothing calcname $ Git.remoteName to
+	calcname n
+		| n `elem` [repoName umap fullto, hostname fullto] = Nothing
+		| otherwise = Just n
 
 unreachable :: String -> String
 unreachable = Dot.fillColor "red"
@@ -165,11 +164,10 @@ same a b
 	| both Git.repoIsUrl && neither Git.repoIsSsh = matching show
 	| neither Git.repoIsSsh = matching Git.repoPath
 	| otherwise = False
-		
-	where
-		matching t = t a == t b
-		both t = t a && t b
-		neither t = not (t a) && not (t b)
+  where
+	matching t = t a == t b
+	both t = t a && t b
+	neither t = not (t a) && not (t b)
 
 {- reads the config of a remote, with progress display -}
 scan :: Git.Repo -> Annex Git.Repo
@@ -192,50 +190,49 @@ tryScan r
 	| Git.repoIsSsh r = sshscan
 	| Git.repoIsUrl r = return Nothing
 	| otherwise = safely $ Git.Config.read r
-	where
-		safely a = do
-			result <- liftIO (try a :: IO (Either SomeException Git.Repo))
-			case result of
-				Left _ -> return Nothing
-				Right r' -> return $ Just r'
-		pipedconfig cmd params = safely $
-			withHandle StdoutHandle createProcessSuccess p $
-				Git.Config.hRead r
-			where
-				p = proc cmd $ toCommand params
-
-		configlist =
-			onRemote r (pipedconfig, Nothing) "configlist" [] []
-		manualconfiglist = do
-			sshparams <- sshToRepo r [Param sshcmd]
-			liftIO $ pipedconfig "ssh" sshparams
-			where
-				sshcmd = cddir ++ " && " ++
-					"git config --null --list"
-				dir = Git.repoPath r
-				cddir
-					| "/~" `isPrefixOf` dir =
-						let (userhome, reldir) = span (/= '/') (drop 1 dir)
-						in "cd " ++ userhome ++ " && cd " ++ shellEscape (drop 1 reldir)
-					| otherwise = "cd " ++ shellEscape dir
-
-		-- First, try sshing and running git config manually,
-		-- only fall back to git-annex-shell configlist if that
-		-- fails.
-		-- 
-		-- This is done for two reasons, first I'd like this
-		-- subcommand to be usable on non-git-annex repos.
-		-- Secondly, configlist doesn't include information about
-		-- the remote's remotes.
-		sshscan = do
-			sshnote
-			v <- manualconfiglist
-			case v of
-				Nothing -> do
-					sshnote
-					configlist
-				ok -> return ok
-
-		sshnote = do
-			showAction "sshing"
-			showOutput
+  where
+	safely a = do
+		result <- liftIO (try a :: IO (Either SomeException Git.Repo))
+		case result of
+			Left _ -> return Nothing
+			Right r' -> return $ Just r'
+	pipedconfig cmd params = safely $
+		withHandle StdoutHandle createProcessSuccess p $
+			Git.Config.hRead r
+	  where
+		p = proc cmd $ toCommand params
+
+	configlist = onRemote r (pipedconfig, Nothing) "configlist" [] []
+	manualconfiglist = do
+		sshparams <- sshToRepo r [Param sshcmd]
+		liftIO $ pipedconfig "ssh" sshparams
+	  where
+		sshcmd = cddir ++ " && " ++
+			"git config --null --list"
+		dir = Git.repoPath r
+		cddir
+			| "/~" `isPrefixOf` dir =
+				let (userhome, reldir) = span (/= '/') (drop 1 dir)
+				in "cd " ++ userhome ++ " && cd " ++ shellEscape (drop 1 reldir)
+			| otherwise = "cd " ++ shellEscape dir
+
+	-- First, try sshing and running git config manually,
+	-- only fall back to git-annex-shell configlist if that
+	-- fails.
+	-- 
+	-- This is done for two reasons, first I'd like this
+	-- subcommand to be usable on non-git-annex repos.
+	-- Secondly, configlist doesn't include information about
+	-- the remote's remotes.
+	sshscan = do
+		sshnote
+		v <- manualconfiglist
+		case v of
+			Nothing -> do
+				sshnote
+				configlist
+			ok -> return ok
+
+	sshnote = do
+		showAction "sshing"
+		showOutput
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index d3b29ee..0b23c2a 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -31,9 +31,9 @@ start file (key, oldbackend) = do
 			showStart "migrate" file
 			next $ perform file key oldbackend newbackend
 		else stop
-	where
-		choosebackend Nothing = Prelude.head <$> orderedList
-		choosebackend (Just backend) = return backend
+  where
+	choosebackend Nothing = Prelude.head <$> orderedList
+	choosebackend (Just backend) = return backend
 
 {- Checks if a key is upgradable to a newer representation. -}
 {- Ideally, all keys have file size metadata. Old keys may not. -}
@@ -49,10 +49,10 @@ perform file oldkey oldbackend newbackend = do
 		( maybe stop go =<< genkey
 		, stop
 		)
-	where
-		go newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
-			next $ Command.ReKey.cleanup file oldkey newkey
-		genkey = do
-			content <- inRepo $ gitAnnexLocation oldkey
-			let source = KeySource { keyFilename = file, contentLocation = content }
-			liftM fst <$> genKey source (Just newbackend)
+  where
+	go newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
+		next $ Command.ReKey.cleanup file oldkey newkey
+	genkey = do
+		content <- inRepo $ gitAnnexLocation oldkey
+		let source = KeySource { keyFilename = file, contentLocation = content }
+		liftM fst <$> genKey source (Just newbackend)
diff --git a/Command/Move.hs b/Command/Move.hs
index 41daab4..316e419 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -44,9 +44,9 @@ start to from move file (key, _) = do
 		(Nothing, Just dest) -> toStart dest move file key
 		(Just src, Nothing) -> fromStart src move file key
 		(_ ,  _) -> error "only one of --from or --to can be specified"
-	where
-		noAuto = when move $ whenM (Annex.getState Annex.auto) $ error
-			"--auto is not supported for move"
+  where
+	noAuto = when move $ whenM (Annex.getState Annex.auto) $ error
+		"--auto is not supported for move"
 
 showMoveAction :: Bool -> FilePath -> Annex ()
 showMoveAction True file = showStart "move" file
@@ -98,15 +98,15 @@ toPerform dest move key file = moveLock move key $ do
 						warning "This could have failed because --fast is enabled."
 					stop
 		Right True -> finish False
-	where
-		finish remotechanged = do
-			when remotechanged $
-				Remote.logStatus dest key InfoPresent
-			if move
-				then do
-					whenM (inAnnex key) $ removeAnnex key
-					next $ Command.Drop.cleanupLocal key
-				else next $ return True
+  where
+	finish remotechanged = do
+		when remotechanged $
+			Remote.logStatus dest key InfoPresent
+		if move
+			then do
+				whenM (inAnnex key) $ removeAnnex key
+				next $ Command.Drop.cleanupLocal key
+			else next $ return True
 
 {- Moves (or copies) the content of an annexed file from a remote
  - to the current repository.
@@ -118,35 +118,37 @@ fromStart :: Remote -> Bool -> FilePath -> Key -> CommandStart
 fromStart src move file key
 	| move = go
 	| otherwise = stopUnless (not <$> inAnnex key) go
-	where
-		go = stopUnless (fromOk src key) $ do
-			showMoveAction move file
-			next $ fromPerform src move key file
+  where
+	go = stopUnless (fromOk src key) $ do
+		showMoveAction move file
+		next $ fromPerform src move key file
+
 fromOk :: Remote -> Key -> Annex Bool
 fromOk src key
 	| Remote.hasKeyCheap src =
 		either (const expensive) return =<< Remote.hasKey src key
 	| otherwise = expensive
-	where
-		expensive = do
-			u <- getUUID
-			remotes <- Remote.keyPossibilities key
-			return $ u /= Remote.uuid src && elem src remotes
+  where
+	expensive = do
+		u <- getUUID
+		remotes <- Remote.keyPossibilities key
+		return $ u /= Remote.uuid src && elem src remotes
+
 fromPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform
 fromPerform src move key file = moveLock move key $
 	ifM (inAnnex key)
 		( handle move True
 		, handle move =<< go
 		)
-	where
-		go = download (Remote.uuid src) key (Just file) noRetry $ do
-			showAction $ "from " ++ Remote.name src
-			getViaTmp key $ Remote.retrieveKeyFile src key (Just file)
-		handle _ False = stop -- failed
-		handle False True = next $ return True -- copy complete
-		handle True True = do -- finish moving
-			ok <- Remote.removeKey src key
-			next $ Command.Drop.cleanupRemote key src ok
+  where
+	go = download (Remote.uuid src) key (Just file) noRetry $ do
+		showAction $ "from " ++ Remote.name src
+		getViaTmp key $ Remote.retrieveKeyFile src key (Just file)
+	handle _ False = stop -- failed
+	handle False True = next $ return True -- copy complete
+	handle True True = do -- finish moving
+		ok <- Remote.removeKey src key
+		next $ Command.Drop.cleanupRemote key src ok
 
 {- Locks a key in order for it to be moved.
  - No lock is needed when a key is being copied. -}
diff --git a/Command/ReKey.hs b/Command/ReKey.hs
index 5bd419c..ea06873 100644
--- a/Command/ReKey.hs
+++ b/Command/ReKey.hs
@@ -25,13 +25,13 @@ seek = [withPairs start]
 
 start :: (FilePath, String) -> CommandStart
 start (file, keyname) = ifAnnexed file go stop
-	where
-		newkey = fromMaybe (error "bad key") $ file2key keyname
-		go (oldkey, _)
-			| oldkey == newkey = stop
-			| otherwise = do
-				showStart "rekey" file
-				next $ perform file oldkey newkey
+  where
+	newkey = fromMaybe (error "bad key") $ file2key keyname
+	go (oldkey, _)
+		| oldkey == newkey = stop
+		| otherwise = do
+			showStart "rekey" file
+			next $ perform file oldkey newkey
 
 perform :: FilePath -> Key -> Key -> CommandPerform
 perform file oldkey newkey = do
diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index 112b7fa..d346925 100644
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -27,10 +27,10 @@ start (src:dest:[])
 		ifAnnexed src
 			(error $ "cannot used annexed file as src: " ++ src)
 			go
-	where
-		go = do
-			showStart "reinject" dest
-			next $ whenAnnexed (perform src) dest
+  where
+	go = do
+		showStart "reinject" dest
+		next $ whenAnnexed (perform src) dest
 start _ = error "specify a src file and a dest file"
 
 perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform
@@ -43,14 +43,14 @@ perform src _dest (key, backend) = do
 			next $ cleanup key
 		, error "not reinjecting"
 		)
-	where
-		-- the file might be on a different filesystem,
-		-- so mv is used rather than simply calling
-		-- moveToObjectDir; disk space is also
-		-- checked this way.
-		move = getViaTmp key $ \tmp ->
-			liftIO $ boolSystem "mv" [File src, File tmp]
-		reject = const $ return "wrong file?"
+  where
+	-- the file might be on a different filesystem,
+	-- so mv is used rather than simply calling
+	-- moveToObjectDir; disk space is also
+	-- checked this way.
+	move = getViaTmp key $ \tmp ->
+		liftIO $ boolSystem "mv" [File src, File tmp]
+	reject = const $ return "wrong file?"
 
 cleanup :: Key -> CommandCleanup
 cleanup key = do
diff --git a/Command/Status.hs b/Command/Status.hs
index ab7dbb0..593e8a0 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -5,11 +5,11 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE PackageImports, BangPatterns #-}
 
 module Command.Status where
 
-import Control.Monad.State.Strict
+import "mtl" Control.Monad.State.Strict
 import qualified Data.Map as M
 import Text.JSON
 import Data.Tuple
@@ -114,10 +114,10 @@ nojson a _ = a
 
 showStat :: Stat -> StatState ()
 showStat s = maybe noop calc =<< s
-	where
-		calc (desc, a) = do
-			(lift . showHeader) desc
-			lift . showRaw =<< a
+  where
+	calc (desc, a) = do
+		(lift . showHeader) desc
+		lift . showRaw =<< a
 
 supported_backends :: Stat
 supported_backends = stat "supported backends" $ json unwords $
@@ -133,8 +133,8 @@ remote_list level = stat n $ nojson $ lift $ do
 	rs <- fst <$> trustPartition level us
 	s <- prettyPrintUUIDs n rs
 	return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s
-	where
-		n = showTrustLevel level ++ " repositories"
+  where
+	n = showTrustLevel level ++ " repositories"
 	
 local_annex_size :: Stat
 local_annex_size = stat "local annex size" $ json id $
@@ -182,42 +182,42 @@ transfer_list = stat "transfers in progress" $ nojson $ lift $ do
 		then return "none"
 		else return $ multiLine $
 			map (\(t, i) -> line uuidmap t i) $ sort ts
-	where
-		line uuidmap t i = unwords
-			[ showLcDirection (transferDirection t) ++ "ing"
-			, fromMaybe (key2file $ transferKey t) (associatedFile i)
-			, if transferDirection t == Upload then "to" else "from"
-			, maybe (fromUUID $ transferUUID t) Remote.name $
-				M.lookup (transferUUID t) uuidmap
-			]
+  where
+	line uuidmap t i = unwords
+		[ showLcDirection (transferDirection t) ++ "ing"
+		, fromMaybe (key2file $ transferKey t) (associatedFile i)
+		, if transferDirection t == Upload then "to" else "from"
+		, maybe (fromUUID $ transferUUID t) Remote.name $
+			M.lookup (transferUUID t) uuidmap
+		]
 
 disk_size :: Stat
 disk_size = stat "available local disk space" $ json id $ lift $
 	calcfree
 		<$> getDiskReserve
 		<*> inRepo (getDiskFree . gitAnnexDir)
-	where
-		calcfree reserve (Just have) = unwords
-			[ roughSize storageUnits False $ nonneg $ have - reserve
-			, "(+" ++ roughSize storageUnits False reserve
-			, "reserved)"
-			]
-			
-		calcfree _ _ = "unknown"
-		nonneg x
-			| x >= 0 = x
-			| otherwise = 0
+  where
+	calcfree reserve (Just have) = unwords
+		[ roughSize storageUnits False $ nonneg $ have - reserve
+		, "(+" ++ roughSize storageUnits False reserve
+		, "reserved)"
+		]			
+	calcfree _ _ = "unknown"
+
+	nonneg x
+		| x >= 0 = x
+		| otherwise = 0
 
 backend_usage :: Stat
 backend_usage = stat "backend usage" $ nojson $
 	calc
 		<$> (backendsKeys <$> cachedReferencedData)
 		<*> (backendsKeys <$> cachedPresentData)
-	where
-		calc x y = multiLine $
-			map (\(n, b) -> b ++ ": " ++ show n) $
-			reverse $ sort $ map swap $ M.toList $
-			M.unionWith (+) x y
+  where
+	calc x y = multiLine $
+		map (\(n, b) -> b ++ ": " ++ show n) $
+		reverse $ sort $ map swap $ M.toList $
+		M.unionWith (+) x y
 
 cachedPresentData :: StatState KeyData
 cachedPresentData = do
@@ -249,39 +249,38 @@ foldKeys = foldl' (flip addKey) emptyKeyData
 addKey :: Key -> KeyData -> KeyData
 addKey key (KeyData count size unknownsize backends) =
 	KeyData count' size' unknownsize' backends'
-	where
-		{- All calculations strict to avoid thunks when repeatedly
-		 - applied to many keys. -}
-		!count' = count + 1
-		!backends' = M.insertWith' (+) (keyBackendName key) 1 backends
-		!size' = maybe size (+ size) ks
-		!unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks
-		ks = keySize key
+  where
+	{- All calculations strict to avoid thunks when repeatedly
+	 - applied to many keys. -}
+	!count' = count + 1
+	!backends' = M.insertWith' (+) (keyBackendName key) 1 backends
+	!size' = maybe size (+ size) ks
+	!unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks
+	ks = keySize key
 
 showSizeKeys :: KeyData -> String
 showSizeKeys d = total ++ missingnote
-	where
-		total = roughSize storageUnits False $ sizeKeys d
-		missingnote
-			| unknownSizeKeys d == 0 = ""
-			| otherwise = aside $
-				"+ " ++ show (unknownSizeKeys d) ++
-				" keys of unknown size"
+  where
+	total = roughSize storageUnits False $ sizeKeys d
+	missingnote
+		| unknownSizeKeys d == 0 = ""
+		| otherwise = aside $
+			"+ " ++ show (unknownSizeKeys d) ++
+			" keys of unknown size"
 
 staleSize :: String -> (Git.Repo -> FilePath) -> Stat
 staleSize label dirspec = go =<< lift (Command.Unused.staleKeys dirspec)
-	where
-		go [] = nostat
-		go keys = onsize =<< sum <$> keysizes keys
-		onsize 0 = nostat
-		onsize size = stat label $
-			json (++ aside "clean up with git-annex unused") $
-				return $ roughSize storageUnits False size
-		keysizes keys = map (fromIntegral . fileSize) <$> stats keys
-		stats keys = do
-			dir <- lift $ fromRepo dirspec
-			liftIO $ forM keys $ \k ->
-				getFileStatus (dir </> keyFile k)
+  where
+	go [] = nostat
+	go keys = onsize =<< sum <$> keysizes keys
+	onsize 0 = nostat
+	onsize size = stat label $
+		json (++ aside "clean up with git-annex unused") $
+			return $ roughSize storageUnits False size
+	keysizes keys = map (fromIntegral . fileSize) <$> stats keys
+	stats keys = do
+		dir <- lift $ fromRepo dirspec
+		liftIO $ forM keys $ \k -> getFileStatus (dir </> keyFile k)
 
 aside :: String -> String
 aside s = " (" ++ s ++ ")"
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 1795a61..f741011 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -48,8 +48,8 @@ seek rs = do
 		, [ pushLocal branch ]
 		, [ pushRemote remote branch | remote <- remotes ]
 		]
-	where
-		nobranch = error "no branch is checked out"
+  where
+	nobranch = error "no branch is checked out"
 
 syncBranch :: Git.Ref -> Git.Ref
 syncBranch = Git.Ref.under "refs/heads/synced/"
@@ -59,23 +59,23 @@ remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote
 
 syncRemotes :: [String] -> Annex [Remote]
 syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
-	where
-		pickfast = (++) <$> listed <*> (good =<< fastest <$> available)
-		wanted
-			| null rs = good =<< concat . Remote.byCost <$> available
-			| otherwise = listed
-		listed = do
-			l <- catMaybes <$> mapM (Remote.byName . Just) rs
-			let s = filter Remote.specialRemote l
-			unless (null s) $
-				error $ "cannot sync special remotes: " ++
-					unwords (map Types.Remote.name s)
-			return l
-		available = filter (not . Remote.specialRemote)
-			<$> (filterM (repoSyncable . Types.Remote.repo)
-				=<< Remote.enabledRemoteList)
-		good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
-		fastest = fromMaybe [] . headMaybe . Remote.byCost
+  where
+	pickfast = (++) <$> listed <*> (good =<< fastest <$> available)
+	wanted
+		| null rs = good =<< concat . Remote.byCost <$> available
+		| otherwise = listed
+	listed = do
+		l <- catMaybes <$> mapM (Remote.byName . Just) rs
+		let s = filter Remote.specialRemote l
+		unless (null s) $
+			error $ "cannot sync special remotes: " ++
+				unwords (map Types.Remote.name s)
+		return l
+	available = filter (not . Remote.specialRemote)
+		<$> (filterM (repoSyncable . Types.Remote.repo)
+			=<< Remote.enabledRemoteList)
+	good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
+	fastest = fromMaybe [] . headMaybe . Remote.byCost
 
 commit :: CommandStart
 commit = do
@@ -90,16 +90,16 @@ commit = do
 
 mergeLocal :: Git.Ref -> CommandStart
 mergeLocal branch = go =<< needmerge
-	where
-		syncbranch = syncBranch branch
-		needmerge = do
-			unlessM (inRepo $ Git.Ref.exists syncbranch) $
-				inRepo $ updateBranch syncbranch
-			inRepo $ Git.Branch.changed branch syncbranch
-		go False = stop
-		go True = do
-			showStart "merge" $ Git.Ref.describe syncbranch
-			next $ next $ mergeFrom syncbranch
+  where
+	syncbranch = syncBranch branch
+	needmerge = do
+		unlessM (inRepo $ Git.Ref.exists syncbranch) $
+			inRepo $ updateBranch syncbranch
+		inRepo $ Git.Branch.changed branch syncbranch
+	go False = stop
+	go True = do
+		showStart "merge" $ Git.Ref.describe syncbranch
+		next $ next $ mergeFrom syncbranch
 
 pushLocal :: Git.Ref -> CommandStart
 pushLocal branch = do
@@ -109,11 +109,11 @@ pushLocal branch = do
 updateBranch :: Git.Ref -> Git.Repo -> IO ()
 updateBranch syncbranch g = 
 	unlessM go $ error $ "failed to update " ++ show syncbranch
-	where
-		go = Git.Command.runBool "branch"
-			[ Param "-f"
-			, Param $ show $ Git.Ref.base syncbranch
-			] g
+  where
+	go = Git.Command.runBool "branch"
+		[ Param "-f"
+		, Param $ show $ Git.Ref.base syncbranch
+		] g
 
 pullRemote :: Remote -> Git.Ref -> CommandStart
 pullRemote remote branch = do
@@ -122,9 +122,9 @@ pullRemote remote branch = do
 		showOutput
 		stopUnless fetch $
 			next $ mergeRemote remote (Just branch)
-	where
-		fetch = inRepo $ Git.Command.runBool "fetch"
-			[Param $ Remote.name remote]
+  where
+	fetch = inRepo $ Git.Command.runBool "fetch"
+		[Param $ Remote.name remote]
 
 {- The remote probably has both a master and a synced/master branch.
  - Which to merge from? Well, the master has whatever latest changes
@@ -136,22 +136,22 @@ mergeRemote remote b = case b of
 		branch <- inRepo Git.Branch.currentUnsafe
 		all id <$> (mapM merge $ branchlist branch)
 	Just _ -> all id <$> (mapM merge =<< tomerge (branchlist b))
-	where
-		merge = mergeFrom . remoteBranch remote
-		tomerge branches = filterM (changed remote) branches
-		branchlist Nothing = []
-		branchlist (Just branch) = [branch, syncBranch branch]
+  where
+	merge = mergeFrom . remoteBranch remote
+	tomerge branches = filterM (changed remote) branches
+	branchlist Nothing = []
+	branchlist (Just branch) = [branch, syncBranch branch]
 
 pushRemote :: Remote -> Git.Ref -> CommandStart
 pushRemote remote branch = go =<< needpush
-	where
-		needpush = anyM (newer remote) [syncBranch branch, Annex.Branch.name]
-		go False = stop
-		go True = do
-			showStart "push" (Remote.name remote)
-			next $ next $ do
-				showOutput
-				inRepo $ pushBranch remote branch
+  where
+	needpush = anyM (newer remote) [syncBranch branch, Annex.Branch.name]
+	go False = stop
+	go True = do
+		showStart "push" (Remote.name remote)
+		next $ next $ do
+			showOutput
+			inRepo $ pushBranch remote branch
 
 pushBranch :: Remote -> Git.Ref -> Git.Repo -> IO Bool
 pushBranch remote branch g =
@@ -160,12 +160,12 @@ pushBranch remote branch g =
 		, Param $ refspec Annex.Branch.name
 		, Param $ refspec branch
 		] g
-	where
-		refspec b = concat 
-			[ show $ Git.Ref.base b
-			,  ":"
-			, show $ Git.Ref.base $ syncBranch b
-			]
+  where
+	refspec b = concat 
+		[ show $ Git.Ref.base b
+		,  ":"
+		, show $ Git.Ref.base $ syncBranch b
+		]
 
 mergeAnnex :: CommandStart
 mergeAnnex = do
@@ -213,37 +213,37 @@ resolveMerge' u
 		withKey LsFiles.valUs $ \keyUs ->
 		withKey LsFiles.valThem $ \keyThem -> go keyUs keyThem
 	| otherwise = return False
-	where
-		go keyUs keyThem
-			| keyUs == keyThem = do
-				makelink keyUs
-				return True
-			| otherwise = do
-				liftIO $ nukeFile file
-				Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
-				makelink keyUs
-				makelink keyThem
-				return True
-		file = LsFiles.unmergedFile u
-		issymlink select = any (select (LsFiles.unmergedBlobType u) ==)
-			[Just SymlinkBlob, Nothing]
-		makelink (Just key) = do
-			let dest = mergeFile file key
-			l <- calcGitLink dest key
-			liftIO $ do
-				nukeFile dest
-				createSymbolicLink l dest
-			Annex.Queue.addCommand "add" [Param "--force", Param "--"] [dest]
-		makelink _ = noop
-		withKey select a = do
-			let msha = select $ LsFiles.unmergedSha u
-			case msha of
-				Nothing -> a Nothing
-				Just sha -> do
-					key <- fileKey . takeFileName
-						. encodeW8 . L.unpack 
-						<$> catObject sha
-					maybe (return False) (a . Just) key
+  where
+	go keyUs keyThem
+		| keyUs == keyThem = do
+			makelink keyUs
+			return True
+		| otherwise = do
+			liftIO $ nukeFile file
+			Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
+			makelink keyUs
+			makelink keyThem
+			return True
+	file = LsFiles.unmergedFile u
+	issymlink select = any (select (LsFiles.unmergedBlobType u) ==)
+		[Just SymlinkBlob, Nothing]
+	makelink (Just key) = do
+		let dest = mergeFile file key
+		l <- calcGitLink dest key
+		liftIO $ do
+			nukeFile dest
+			createSymbolicLink l dest
+		Annex.Queue.addCommand "add" [Param "--force", Param "--"] [dest]
+	makelink _ = noop
+	withKey select a = do
+		let msha = select $ LsFiles.unmergedSha u
+		case msha of
+			Nothing -> a Nothing
+			Just sha -> do
+				key <- fileKey . takeFileName
+					. encodeW8 . L.unpack 
+					<$> catObject sha
+				maybe (return False) (a . Just) key
 
 {- The filename to use when resolving a conflicted merge of a file,
  - that points to a key.
@@ -262,13 +262,13 @@ mergeFile :: FilePath -> Key -> FilePath
 mergeFile file key
 	| doubleconflict = go $ key2file key
 	| otherwise = go $ shortHash $ key2file key
-	where
-		varmarker = ".variant-"
-		doubleconflict = varmarker `isSuffixOf` (dropExtension file)
-		go v = takeDirectory file
-			</> dropExtension (takeFileName file)
-			++ varmarker ++ v
-			++ takeExtension file
+  where
+	varmarker = ".variant-"
+	doubleconflict = varmarker `isSuffixOf` (dropExtension file)
+	go v = takeDirectory file
+		</> dropExtension (takeFileName file)
+		++ varmarker ++ v
+		++ takeExtension file
 		
 shortHash :: String -> String
 shortHash = take 4 . md5s . md5FilePath
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index 6ac3e12..b365e8c 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -30,13 +30,26 @@ check = do
 	cwd <- liftIO getCurrentDirectory
 	whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $
 		error "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
-			[Params "rev-parse --abbrev-ref HEAD"]
+  where
+	current_branch = Git.Ref . Prelude.head . lines <$> revhead
+	revhead = inRepo $ Git.Command.pipeReadStrict
+		[Params "rev-parse --abbrev-ref HEAD"]
 
 seek :: [CommandSeek]
-seek = [withFilesInGit $ whenAnnexed startUnannex, withNothing start]
+seek = [
+	withFilesNotInGit $ whenAnnexed startCheckIncomplete,
+	withFilesInGit $ whenAnnexed startUnannex
+	, withNothing start
+	]
+
+{- git annex symlinks that are not checked into git could be left by an
+ - interrupted add. -}
+startCheckIncomplete :: FilePath -> (Key, Backend) -> CommandStart
+startCheckIncomplete file _ = error $ 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."
+	]
 
 startUnannex :: FilePath -> (Key, Backend) -> CommandStart
 startUnannex file info = do
@@ -47,13 +60,7 @@ startUnannex file info = do
 	Command.Unannex.start file info
 
 start :: CommandStart
-start = next perform
-
-perform :: CommandPerform
-perform = next cleanup
-
-cleanup :: CommandCleanup
-cleanup = do
+start = next $ next $ do
 	annexdir <- fromRepo gitAnnexDir
 	uninitialize
 	mapM_ removeAnnex =<< getKeysPresent
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index f3ffd31..6489fc3 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -17,8 +17,8 @@ def =
 	[ c "unlock" "unlock files for modification"
 	, c "edit" "same as unlock"
 	]
-	where
-		c n = command n paramPaths seek
+  where
+	c n = command n paramPaths seek
 
 seek :: [CommandSeek]
 seek = [withFilesInGit $ whenAnnexed start]
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 79285f7..c0551dd 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -64,27 +64,26 @@ checkUnused = chain 0
 	, check "bad" staleBadMsg $ staleKeysPrune gitAnnexBadDir
 	, check "tmp" staleTmpMsg $ staleKeysPrune gitAnnexTmpDir
 	]
-	where
-		findunused True = do
-			showNote "fast mode enabled; only finding stale files"
-			return []
-		findunused False = do
-			showAction "checking for unused data"
-			excludeReferenced =<< getKeysPresent
-		chain _ [] = next $ return True
-		chain v (a:as) = do
-			v' <- a v
-			chain v' as
+  where
+	findunused True = do
+		showNote "fast mode enabled; only finding stale files"
+		return []
+	findunused False = do
+		showAction "checking for unused data"
+		excludeReferenced =<< getKeysPresent
+	chain _ [] = next $ return True
+	chain v (a:as) = do
+		v' <- a v
+		chain v' as
 
 checkRemoteUnused :: String -> CommandPerform
 checkRemoteUnused name = go =<< fromJust <$> Remote.byName (Just name)
-	where
-		go r = do
-			showAction "checking for unused data"
-			_ <- check "" (remoteUnusedMsg r) (remoteunused r) 0
-			next $ return True
-		remoteunused r =
-			excludeReferenced <=< loggedKeysFor $ Remote.uuid r
+  where
+	go r = do
+		showAction "checking for unused data"
+		_ <- check "" (remoteUnusedMsg r) (remoteunused r) 0
+		next $ return True
+	remoteunused r = excludeReferenced <=< loggedKeysFor $ Remote.uuid r
 
 check :: FilePath -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int
 check file msg a c = do
@@ -100,9 +99,9 @@ number n (x:xs) = (n+1, x) : number (n+1) xs
 
 table :: [(Int, Key)] -> [String]
 table l = "  NUMBER  KEY" : map cols l
-	where
-		cols (n,k) = "  " ++ pad 6 (show n) ++ "  " ++ key2file k
-		pad n s = s ++ replicate (n - length s) ' '
+  where
+	cols (n,k) = "  " ++ pad 6 (show n) ++ "  " ++ key2file k
+	pad n s = s ++ replicate (n - length s) ' '
 
 staleTmpMsg :: [(Int, Key)] -> String
 staleTmpMsg t = unlines $ 
@@ -129,8 +128,8 @@ remoteUnusedMsg :: Remote -> [(Int, Key)] -> String
 remoteUnusedMsg r u = unusedMsg' u
 	["Some annexed data on " ++ name ++ " is not used by any files:"]
 	[dropMsg $ Just r]
-	where
-		name = Remote.name r 
+  where
+	name = Remote.name r 
 
 dropMsg :: Maybe Remote -> String
 dropMsg Nothing = dropMsg' ""
@@ -159,11 +158,11 @@ dropMsg' s = "\nTo remove unwanted data: git-annex dropunused" ++ s ++ " NUMBER\
  -}
 excludeReferenced :: [Key] -> Annex [Key]
 excludeReferenced ks = runfilter firstlevel ks >>= runfilter secondlevel
-	where
-		runfilter _ [] = return [] -- optimisation
-		runfilter a l = bloomFilter show l <$> genBloomFilter show a
-		firstlevel = withKeysReferencedM
-		secondlevel = withKeysReferencedInGit
+  where
+	runfilter _ [] = return [] -- optimisation
+	runfilter a l = bloomFilter show l <$> genBloomFilter show a
+	firstlevel = withKeysReferencedM
+	secondlevel = withKeysReferencedInGit
 
 {- Finds items in the first, smaller list, that are not
  - present in the second, larger list.
@@ -174,8 +173,8 @@ excludeReferenced ks = runfilter firstlevel ks >>= runfilter secondlevel
 exclude :: Ord a => [a] -> [a] -> [a]
 exclude [] _ = [] -- optimisation
 exclude smaller larger = S.toList $ remove larger $ S.fromList smaller
-	where
-		remove a b = foldl (flip S.delete) b a
+  where
+	remove a b = foldl (flip S.delete) b a
 
 {- A bloom filter capable of holding half a million keys with a
  - false positive rate of 1 in 1000 uses around 8 mb of memory,
@@ -208,8 +207,8 @@ genBloomFilter convert populate = do
 	bloom <- lift $ newMB (cheapHashes numhashes) numbits
 	_ <- populate $ \v -> lift $ insertMB bloom (convert v)
 	lift $ unsafeFreezeMB bloom
-	where
-		lift = liftIO . stToIO
+  where
+	lift = liftIO . stToIO
 
 bloomFilter :: Hashable t => (v -> t) -> [v] -> Bloom t -> [v]
 bloomFilter convert l bloom = filter (\k -> convert k `notElemB` bloom) l
@@ -218,14 +217,14 @@ bloomFilter convert l bloom = filter (\k -> convert k `notElemB` bloom) l
  - symlinks in the git repo. -}
 withKeysReferenced :: v -> (Key -> v -> v) -> Annex v
 withKeysReferenced initial a = withKeysReferenced' initial folda
-	where
-		folda k v = return $ a k v
+  where
+	folda k v = return $ a k v
 
 {- Runs an action on each referenced key in the git repo. -}
 withKeysReferencedM :: (Key -> Annex ()) -> Annex ()
 withKeysReferencedM a = withKeysReferenced' () calla
-	where
-		calla k _ = a k
+  where
+	calla k _ = a k
 
 withKeysReferenced' :: v -> (Key -> v -> Annex v) -> Annex v
 withKeysReferenced' initial a = do
@@ -233,54 +232,53 @@ withKeysReferenced' initial a = do
 	r <- go initial files
 	liftIO $ void clean
 	return r
-	where
-		getfiles = ifM isBareRepo
-			( return ([], return True)
-			, do
-				top <- fromRepo Git.repoPath
-				inRepo $ LsFiles.inRepo [top]
-			)
-		go v [] = return v
-		go v (f:fs) = do
-			x <- Backend.lookupFile f
-			case x of
-				Nothing -> go v fs
-				Just (k, _) -> do
-					!v' <- a k v
-					go v' fs
-
+  where
+	getfiles = ifM isBareRepo
+		( return ([], return True)
+		, do
+			top <- fromRepo Git.repoPath
+			inRepo $ LsFiles.inRepo [top]
+		)
+	go v [] = return v
+	go v (f:fs) = do
+		x <- Backend.lookupFile f
+		case x of
+			Nothing -> go v fs
+			Just (k, _) -> do
+				!v' <- a k v
+				go v' fs
 
 withKeysReferencedInGit :: (Key -> Annex ()) -> Annex ()
 withKeysReferencedInGit a = do
 	rs <- relevantrefs <$> showref
 	forM_ rs (withKeysReferencedInGitRef a)
-	where
-		showref = inRepo $ Git.Command.pipeReadStrict [Param "show-ref"]
-		relevantrefs = map (Git.Ref .  snd) .
-			nubBy uniqref .
-			filter ourbranches .
-			map (separate (== ' ')) . lines
-		uniqref (x, _) (y, _) = x == y
-		ourbranchend = '/' : show Annex.Branch.name
-		ourbranches (_, b) = not (ourbranchend `isSuffixOf` b)
-			&& not ("refs/synced/" `isPrefixOf` b)
+  where
+	showref = inRepo $ Git.Command.pipeReadStrict [Param "show-ref"]
+	relevantrefs = map (Git.Ref .  snd) .
+		nubBy uniqref .
+		filter ourbranches .
+		map (separate (== ' ')) . lines
+	uniqref (x, _) (y, _) = x == y
+	ourbranchend = '/' : show Annex.Branch.name
+	ourbranches (_, b) = not (ourbranchend `isSuffixOf` b)
+		&& not ("refs/synced/" `isPrefixOf` b)
 
 withKeysReferencedInGitRef :: (Key -> Annex ()) -> Git.Ref -> Annex ()
 withKeysReferencedInGitRef a ref = do
 	showAction $ "checking " ++ Git.Ref.describe ref
 	go <=< inRepo $ LsTree.lsTree ref
-	where
-		go [] = noop
-		go (l:ls)
-			| isSymLink (LsTree.mode l) = do
-				content <- encodeW8 . L.unpack
-					<$> catFile ref (LsTree.file l)
-				case fileKey (takeFileName content) of
-					Nothing -> go ls
-					Just k -> do
-						a k
-						go ls
-			| otherwise = go ls
+  where
+	go [] = noop
+	go (l:ls)
+		| isSymLink (LsTree.mode l) = do
+			content <- encodeW8 . L.unpack
+				<$> catFile ref (LsTree.file l)
+			case fileKey (takeFileName content) of
+				Nothing -> go ls
+				Just k -> do
+					a k
+					go ls
+		| otherwise = go ls
 
 {- Looks in the specified directory for bad/tmp keys, and returns a list
  - of those that might still have value, or might be stale and removable.
diff --git a/Command/Version.hs b/Command/Version.hs
index 4cc5cb4..907811e 100644
--- a/Command/Version.hs
+++ b/Command/Version.hs
@@ -29,8 +29,8 @@ start = do
 		putStrLn $ "supported repository versions: " ++ vs supportedVersions
 		putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions
 	stop
-	where
-		vs = join " "
+  where
+	vs = join " "
 
 showPackageVersion :: IO ()
 showPackageVersion = putStrLn $ "git-annex version: " ++ SysConfig.packageversion
diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs
index 0466c0c..cfe051c 100644
--- a/Command/Vicfg.hs
+++ b/Command/Vicfg.hs
@@ -75,119 +75,116 @@ setCfg curcfg newcfg = do
 
 diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group), M.Map UUID String)
 diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap)
-	where
-		diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)
-			(f newcfg) (f curcfg)
+  where
+	diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)
+		(f newcfg) (f curcfg)
 
 genCfg :: Cfg -> M.Map UUID String -> String
 genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
-	where
-		intro =
-			[ com "git-annex configuration"
-			, com ""
-			, com "Changes saved to this file will be recorded in the git-annex branch."
-			, com ""
-			, com "Lines in this file have the format:"
-			, com "  setting uuid = value"
-			]
-
-		trust = settings cfgTrustMap
-			[ ""
-			, com "Repository trust configuration"
-			, com "(Valid trust levels: " ++
-			  unwords (map showTrustLevel [Trusted .. DeadTrusted]) ++
-			  ")"
-			]
-			(\(t, u) -> line "trust" u $ showTrustLevel t)
-			(\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted)
-
-		groups = settings cfgGroupMap
-			[ ""
-			, com "Repository groups"
-			, com "(Separate group names with spaces)"
-			]
-			(\(s, u) -> line "group" u $ unwords $ S.toList s)
-			(\u -> lcom $ line "group" u "")
-
-		preferredcontent = settings cfgPreferredContentMap
-			[ ""
-			, com "Repository preferred contents"
-			]
-			(\(s, u) -> line "preferred-content" u s)
-			(\u -> line "preferred-content" u "")
-
-		settings field desc showvals showdefaults = concat
-			[ desc
-			, concatMap showvals $
-				sort $ map swap $ M.toList $ field cfg
-			, concatMap (\u -> lcom $ showdefaults u) $
-				missing field
-			]
-
-		line setting u value =
-			[ com $ "(for " ++ (fromMaybe "" $ M.lookup u descs) ++ ")"
-			, unwords [setting, fromUUID u, "=", value]
-			]
-		lcom = map (\l -> if "#" `isPrefixOf` l then l else "#" ++ l)
-		missing field = S.toList $ M.keysSet descs `S.difference` M.keysSet (field cfg)
+  where
+	intro =
+		[ com "git-annex configuration"
+		, com ""
+		, com "Changes saved to this file will be recorded in the git-annex branch."
+		, com ""
+		, com "Lines in this file have the format:"
+		, com "  setting uuid = value"
+		]
+
+	trust = settings cfgTrustMap
+		[ ""
+		, com "Repository trust configuration"
+		, com "(Valid trust levels: " ++
+		  unwords (map showTrustLevel [Trusted .. DeadTrusted]) ++
+		  ")"
+		]
+		(\(t, u) -> line "trust" u $ showTrustLevel t)
+		(\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted)
+
+	groups = settings cfgGroupMap
+		[ ""
+		, com "Repository groups"
+		, com "(Separate group names with spaces)"
+		]
+		(\(s, u) -> line "group" u $ unwords $ S.toList s)
+		(\u -> lcom $ line "group" u "")
+
+	preferredcontent = settings cfgPreferredContentMap
+		[ ""
+		, com "Repository preferred contents"
+		]
+		(\(s, u) -> line "preferred-content" u s)
+		(\u -> line "preferred-content" u "")
+
+	settings field desc showvals showdefaults = concat
+		[ desc
+		, concatMap showvals $ sort $ map swap $ M.toList $ field cfg
+		, concatMap (\u -> lcom $ showdefaults u) $ missing field
+		]
+
+	line setting u value =
+		[ com $ "(for " ++ (fromMaybe "" $ M.lookup u descs) ++ ")"
+		, unwords [setting, fromUUID u, "=", value]
+		]
+	lcom = map (\l -> if "#" `isPrefixOf` l then l else "#" ++ l)
+	missing field = S.toList $ M.keysSet descs `S.difference` M.keysSet (field cfg)
 
 {- If there's a parse error, returns a new version of the file,
  - with the problem lines noted. -}
 parseCfg :: Cfg -> String -> Either String Cfg
 parseCfg curcfg = go [] curcfg . lines
-	where
-		go c cfg []
-			| null (catMaybes $ map fst c) = Right cfg
-			| otherwise = Left $ unlines $
-				badheader ++ concatMap showerr (reverse c)
-		go c cfg (l:ls) = case parse (dropWhile isSpace l) cfg of
-			Left msg -> go ((Just msg, l):c) cfg ls
-			Right cfg' -> go ((Nothing, l):c) cfg' ls
-
-		parse l cfg
-			| null l = Right cfg
-			| "#" `isPrefixOf` l = Right cfg
-			| null setting || null u = Left "missing repository uuid"
-			| otherwise = handle cfg (toUUID u) setting value'
-			where
-				(setting, rest) = separate isSpace l
-				(r, value) = separate (== '=') rest
-				value' = trimspace value
-				u = reverse $ trimspace $
-					reverse $ trimspace r
-				trimspace = dropWhile isSpace
-
-		handle cfg u setting value
-			| setting == "trust" = case readTrustLevel value of
-				Nothing -> badval "trust value" value
-				Just t ->
-					let m = M.insert u t (cfgTrustMap cfg)
-					in Right $ cfg { cfgTrustMap = m }
-			| setting == "group" =
-				let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
-				in Right $ cfg { cfgGroupMap = m }
-			| setting == "preferred-content" = 
-				case checkPreferredContentExpression value of
-					Just e -> Left e
-					Nothing ->
-						let m = M.insert u value (cfgPreferredContentMap cfg)
-						in Right $ cfg { cfgPreferredContentMap = m }
-			| otherwise = badval "setting" setting
-
-		showerr (Just msg, l) = [parseerr ++ msg, l]
-		showerr (Nothing, l)
-			-- filter out the header and parse error lines
-			-- from any previous parse failure
-			| any (`isPrefixOf` l) (parseerr:badheader) = []
-			| otherwise = [l]
-
-		badval desc val = Left $ "unknown " ++ desc ++ " \"" ++ val ++ "\""
-		badheader = 
-			[ com "There was a problem parsing your input."
-			, com "Search for \"Parse error\" to find the bad lines."
-			, com "Either fix the bad lines, or delete them (to discard your changes)."
-			]
-		parseerr = com "Parse error in next line: "
+  where
+	go c cfg []
+		| null (catMaybes $ map fst c) = Right cfg
+		| otherwise = Left $ unlines $
+			badheader ++ concatMap showerr (reverse c)
+	go c cfg (l:ls) = case parse (dropWhile isSpace l) cfg of
+		Left msg -> go ((Just msg, l):c) cfg ls
+		Right cfg' -> go ((Nothing, l):c) cfg' ls
+
+	parse l cfg
+		| null l = Right cfg
+		| "#" `isPrefixOf` l = Right cfg
+		| null setting || null u = Left "missing repository uuid"
+		| otherwise = handle cfg (toUUID u) setting value'
+	  where
+		(setting, rest) = separate isSpace l
+		(r, value) = separate (== '=') rest
+		value' = trimspace value
+		u = reverse $ trimspace $ reverse $ trimspace r
+		trimspace = dropWhile isSpace
+
+	handle cfg u setting value
+		| setting == "trust" = case readTrustLevel value of
+			Nothing -> badval "trust value" value
+			Just t ->
+				let m = M.insert u t (cfgTrustMap cfg)
+				in Right $ cfg { cfgTrustMap = m }
+		| setting == "group" =
+			let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
+			in Right $ cfg { cfgGroupMap = m }
+		| setting == "preferred-content" = 
+			case checkPreferredContentExpression value of
+				Just e -> Left e
+				Nothing ->
+					let m = M.insert u value (cfgPreferredContentMap cfg)
+					in Right $ cfg { cfgPreferredContentMap = m }
+		| otherwise = badval "setting" setting
+
+	showerr (Just msg, l) = [parseerr ++ msg, l]
+	showerr (Nothing, l)
+		-- filter out the header and parse error lines
+		-- from any previous parse failure
+		| any (`isPrefixOf` l) (parseerr:badheader) = []
+		| otherwise = [l]
+
+	badval desc val = Left $ "unknown " ++ desc ++ " \"" ++ val ++ "\""
+	badheader = 
+		[ com "There was a problem parsing your input."
+		, com "Search for \"Parse error\" to find the bad lines."
+		, com "Either fix the bad lines, or delete them (to discard your changes)."
+		]
+	parseerr = com "Parse error in next line: "
 
 com :: String -> String
 com s = "# " ++ s
diff --git a/Command/WebApp.hs b/Command/WebApp.hs
index f87ea98..a0bd2e7 100644
--- a/Command/WebApp.hs
+++ b/Command/WebApp.hs
@@ -11,10 +11,7 @@ import Common.Annex
 import Command
 import Assistant
 import Assistant.Common
-import Assistant.DaemonStatus
-import Assistant.ScanRemotes
-import Assistant.TransferQueue
-import Assistant.TransferSlots
+import Assistant.NamedThread
 import Assistant.Threads.WebApp
 import Assistant.WebApp
 import Assistant.Install
@@ -46,24 +43,24 @@ start' allowauto = notBareRepo $ do
 	liftIO $ ensureInstalled
 	ifM isInitialized ( go , auto )
 	stop
-	where
-		go = do
-			browser <- fromRepo webBrowser
-			f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
-			ifM (checkpid <&&> checkshim f)
-				( liftIO $ openBrowser browser f 
-				, startDaemon True True $ Just $
-					const $ openBrowser browser
-				)
-		auto
-			| allowauto = liftIO startNoRepo
-			| otherwise = do
-				d <- liftIO getCurrentDirectory
-				error $ "no git repository in " ++ d
-		checkpid = do
-			pidfile <- fromRepo gitAnnexPidFile
-			liftIO $ isJust <$> checkDaemon pidfile
-		checkshim f = liftIO $ doesFileExist f
+  where
+	go = do
+		browser <- fromRepo webBrowser
+		f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
+		ifM (checkpid <&&> checkshim f)
+			( liftIO $ openBrowser browser f 
+			, startDaemon True True $ Just $
+				const $ openBrowser browser
+			)
+	auto
+		| allowauto = liftIO startNoRepo
+		| otherwise = do
+			d <- liftIO getCurrentDirectory
+			error $ "no git repository in " ++ d
+	checkpid = do
+		pidfile <- fromRepo gitAnnexPidFile
+		liftIO $ isJust <$> checkDaemon pidfile
+	checkshim f = liftIO $ doesFileExist f
 
 {- When run without a repo, see if there is an autoStartFile,
  - and if so, start the first available listed repository.
@@ -99,46 +96,50 @@ autoStart autostartfile = do
  -}
 firstRun :: IO ()
 firstRun = do
+	{- Without a repository, we cannot have an Annex monad, so cannot
+	 - get a ThreadState. Using undefined is only safe because the
+	 - webapp checks its noAnnex field before accessing the
+	 - threadstate. -}
+	let st = undefined
+	{- Get a DaemonStatus without running in the Annex monad. -}
 	dstatus <- atomically . newTMVar =<< newDaemonStatus
-	scanremotes <- newScanRemoteMap
-	transferqueue <- newTransferQueue
-	transferslots <- newTransferSlots
+	d <- newAssistantData st dstatus
 	urlrenderer <- newUrlRenderer
 	v <- newEmptyMVar
 	let callback a = Just $ a v
-	void $ runNamedThread dstatus $
-		webAppThread Nothing dstatus scanremotes
-			transferqueue transferslots urlrenderer
-			(callback signaler) (callback mainthread)
-	where
-		signaler v = do
-			putMVar v ""
-			takeMVar v
-		mainthread v _url htmlshim = do
-			browser <- maybe Nothing webBrowser <$> Git.Config.global
-			openBrowser browser htmlshim
-
-			_wait <- takeMVar v
+	void $ runAssistant d $ runNamedThread $
+		webAppThread d urlrenderer True 
+			(callback signaler)
+			(callback mainthread)
+  where
+	signaler v = do
+		putMVar v ""
+		takeMVar v
+	mainthread v _url htmlshim = do
+		browser <- maybe Nothing webBrowser <$> Git.Config.global
+		openBrowser browser htmlshim
 
-			state <- Annex.new =<< Git.CurrentRepo.get
-			Annex.eval state $ do
-				dummydaemonize
-				startAssistant True id $ Just $ sendurlback v
-		sendurlback v url _htmlshim = putMVar v url
-		{- Set up the pid file in the new repo. -}
-		dummydaemonize =
-			liftIO . lockPidFile =<< fromRepo gitAnnexPidFile
+		_wait <- takeMVar v
+
+		state <- Annex.new =<< Git.CurrentRepo.get
+		Annex.eval state $ do
+			dummydaemonize
+			startAssistant True id $ Just $ sendurlback v
+	sendurlback v url _htmlshim = putMVar v url
+
+	{- Set up the pid file in the new repo. -}
+	dummydaemonize = liftIO . lockPidFile =<< fromRepo gitAnnexPidFile
 
 openBrowser :: Maybe FilePath -> FilePath -> IO ()
 openBrowser cmd htmlshim = go $ maybe runBrowser runCustomBrowser cmd
-	where
-		url = fileUrl htmlshim
-		go a = do
-			putStrLn ""
-			putStrLn $ "Launching web browser on " ++ url
-			unlessM (a url) $
-				error $ "failed to start web browser"
-		runCustomBrowser c u = boolSystem c [Param u]
+  where
+	url = fileUrl htmlshim
+	go a = do
+		putStrLn ""
+		putStrLn $ "Launching web browser on " ++ url
+		unlessM (a url) $
+			error $ "failed to start web browser"
+	runCustomBrowser c u = boolSystem c [Param u]
 
 {- web.browser is a generic git config setting for a web browser program -}
 webBrowser :: Git.Repo -> Maybe FilePath
diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index c77b3a0..251c4ec 100644
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -40,15 +40,15 @@ perform remotemap key = do
 	forM_ (mapMaybe (`M.lookup` remotemap) locations) $
 		performRemote key
 	if null safelocations then stop else next $ return True
-	where
-		copiesplural 1 = "copy"
-		copiesplural _ = "copies"
-		untrustedheader = "The following untrusted locations may also have copies:\n"
+  where
+	copiesplural 1 = "copy"
+	copiesplural _ = "copies"
+	untrustedheader = "The following untrusted locations may also have copies:\n"
 
 performRemote :: Key -> Remote -> Annex () 
 performRemote key remote = maybe noop go $ whereisKey remote
-	where
-		go a = do
-			ls <- a key
-			unless (null ls) $ showLongNote $ unlines $
-				map (\l -> name remote ++ ": " ++ l) ls
+  where
+	go a = do
+		ls <- a key
+		unless (null ls) $ showLongNote $ unlines $
+			map (\l -> name remote ++ ": " ++ l) ls
diff --git a/Command/XMPPGit.hs b/Command/XMPPGit.hs
new file mode 100644
index 0000000..c54d6a8
--- /dev/null
+++ b/Command/XMPPGit.hs
@@ -0,0 +1,42 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.XMPPGit where
+
+import Common.Annex
+import Command
+import Assistant.XMPP.Git
+
+def :: [Command]
+def = [noCommit $ noRepo xmppGitRelay $ dontCheck repoExists $
+	command "xmppgit" paramNothing seek "git to XMPP relay (internal use)"]
+
+seek :: [CommandSeek]
+seek = [withWords start]
+
+start :: [String] -> CommandStart
+start _ = do
+	liftIO gitRemoteHelper
+	liftIO xmppGitRelay
+	stop
+
+{- A basic implementation of the git-remote-helpers protocol. -}
+gitRemoteHelper :: IO ()
+gitRemoteHelper = do
+	expect "capabilities"
+	respond ["connect"]
+	expect "connect git-receive-pack"
+	respond []
+  where
+	expect s = do
+		cmd <- getLine
+		unless (cmd == s) $
+			error $ "git-remote-helpers protocol error: expected: " ++ s ++ ", but got: " ++ cmd
+	respond l = do
+		mapM_ putStrLn l
+		putStrLn ""
+		hFlush stdout
diff --git a/Common.hs b/Common.hs
index 04ec1e0..5b53f37 100644
--- a/Common.hs
+++ b/Common.hs
@@ -1,9 +1,11 @@
+{-# LANGUAGE PackageImports #-}
+
 module Common (module X) where
 
 import Control.Monad as X hiding (join)
 import Control.Monad.IfElse as X
 import Control.Applicative as X
-import Control.Monad.State.Strict as X (liftIO)
+import "mtl" Control.Monad.State.Strict as X (liftIO)
 import Control.Exception.Extensible as X (IOException)
 
 import Data.Maybe as X
diff --git a/Config.hs b/Config.hs
index 04ab665..1077730 100644
--- a/Config.hs
+++ b/Config.hs
@@ -95,24 +95,24 @@ repoSyncable r = fromMaybe True . Git.Config.isTrue
  - in git config. forcenumcopies overrides everything. -}
 getNumCopies :: Maybe Int -> Annex Int
 getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies
-	where
-		use (Just n) = return n
-		use Nothing = perhaps (return 1) =<< 
-			readish <$> getConfig (annexConfig "numcopies") "1"
-		perhaps fallback = maybe fallback (return . id)
+  where
+	use (Just n) = return n
+	use Nothing = perhaps (return 1) =<< 
+		readish <$> getConfig (annexConfig "numcopies") "1"
+	perhaps fallback = maybe fallback (return . id)
 
 {- Gets the trust level set for a remote in git config. -}
 getTrustLevel :: Git.Repo -> Annex (Maybe String)
 getTrustLevel r = fromRepo $ Git.Config.getMaybe key
-	where
-		(ConfigKey key) = remoteConfig r "trustlevel"
+  where
+	(ConfigKey key) = remoteConfig r "trustlevel"
 
 {- Gets annex.diskreserve setting. -}
 getDiskReserve :: Annex Integer
 getDiskReserve = fromMaybe megabyte . readSize dataUnits
 	<$> getConfig (annexConfig "diskreserve") ""
-	where
-		megabyte = 1000000
+  where
+	megabyte = 1000000
 
 {- Gets annex.httpheaders or annex.httpheaders-command setting,
  - splitting it into lines. -}
diff --git a/Crypto.hs b/Crypto.hs
index 3387be1..071fb7a 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -75,16 +75,16 @@ updateEncryptedCipher keyid encipher@(EncryptedCipher _ ks) = do
 	ks' <- Gpg.findPubKeys keyid
 	cipher <- decryptCipher encipher
 	encryptCipher cipher (merge ks ks')
-	where
-		merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
+  where
+	merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
 
 describeCipher :: StorableCipher -> String
 describeCipher (SharedCipher _) = "shared cipher"
 describeCipher (EncryptedCipher _ (KeyIds ks)) =
 	"with gpg " ++ keys ks ++ " " ++ unwords ks
-	where
-		keys [_] = "key"
-		keys _ = "keys"
+  where
+	keys [_] = "key"
+	keys _ = "keys"
 
 {- Encrypts a Cipher to the specified KeyIds. -}
 encryptCipher :: Cipher -> KeyIds -> IO StorableCipher
@@ -92,20 +92,20 @@ encryptCipher (Cipher c) (KeyIds ks) = do
 	let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids
 	encipher <- Gpg.pipeStrict (encrypt++recipients ks') c
 	return $ EncryptedCipher encipher (KeyIds ks')
-	where
-		encrypt = [ Params "--encrypt" ]
-		recipients l = force_recipients :
-			concatMap (\k -> [Param "--recipient", Param k]) l
-		-- Force gpg to only encrypt to the specified
-		-- recipients, not configured defaults.
-		force_recipients = Params "--no-encrypt-to --no-default-recipient"
+ where
+	encrypt = [ Params "--encrypt" ]
+	recipients l = force_recipients :
+		concatMap (\k -> [Param "--recipient", Param k]) l
+	-- Force gpg to only encrypt to the specified
+	-- recipients, not configured defaults.
+	force_recipients = Params "--no-encrypt-to --no-default-recipient"
 
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: StorableCipher -> IO Cipher
 decryptCipher (SharedCipher t) = return $ Cipher t
 decryptCipher (EncryptedCipher t _) = Cipher <$> Gpg.pipeStrict decrypt t
-	where
-		decrypt = [ Param "--decrypt" ]
+  where
+	decrypt = [ Param "--decrypt" ]
 
 {- Generates an encrypted form of a Key. The encryption does not need to be
  - reversable, nor does it need to be the same type of encryption used
@@ -136,8 +136,12 @@ withEncryptedContent = pass withEncryptedHandle
 withDecryptedContent :: Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
 withDecryptedContent = pass withDecryptedHandle
 
-pass :: (Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a) 
-      -> Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
+pass
+	:: (Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a) 
+	-> Cipher
+	-> IO L.ByteString
+	-> (L.ByteString -> IO a)
+	-> IO a
 pass to n s a = to n s $ a <=< L.hGetContents
 
 hmacWithCipher :: Cipher -> String -> String
@@ -148,5 +152,5 @@ hmacWithCipher' c s = showDigest $ hmacSha1 (fromString c) (fromString s)
 {- Ensure that hmacWithCipher' returns the same thing forevermore. -}
 prop_hmacWithCipher_sane :: Bool
 prop_hmacWithCipher_sane = known_good == hmacWithCipher' "foo" "bar"
-	where
-		known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51"
+  where
+	known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51"
diff --git a/Git.hs b/Git.hs
index eab33f1..46f995e 100644
--- a/Git.hs
+++ b/Git.hs
@@ -81,8 +81,8 @@ repoIsSsh Repo { location = Url url }
 	| scheme == "git+ssh:" = True
 	| scheme == "ssh+git:" = True
 	| otherwise = False
-	where
-		scheme = uriScheme url
+  where
+	scheme = uriScheme url
 repoIsSsh _ = False
 
 repoIsHttp :: Repo -> Bool
@@ -126,5 +126,5 @@ hookPath script repo = do
 	let hook = localGitDir repo </> "hooks" </> script
 	ifM (catchBoolIO $ isexecutable hook)
 		( return $ Just hook , return Nothing )
-	where
-		isexecutable f = isExecutable . fileMode <$> getFileStatus f
+  where
+	isexecutable f = isExecutable . fileMode <$> getFileStatus f
diff --git a/Git/Command.hs b/Git/Command.hs
index 5f2dd47..37df447 100644
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -7,7 +7,6 @@
 
 module Git.Command where
 
-import System.Posix.Process (getAnyProcessStatus)
 import System.Process (std_out, env)
 
 import Common
@@ -97,17 +96,6 @@ pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
 leaveZombie :: (a, IO Bool) -> a
 leaveZombie = fst
 
-{- Reaps any zombie git processes. 
- -
- - Warning: Not thread safe. Anything that was expecting to wait
- - on a process and get back an exit status is going to be confused
- - if this reap gets there first. -}
-reap :: IO ()
-reap = do
-	-- throws an exception when there are no child processes
-	catchDefaultIO Nothing (getAnyProcessStatus False True)
-		>>= maybe noop (const reap)
-
 {- Runs a git command as a coprocess. -}
 gitCoProcessStart :: [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle
 gitCoProcessStart params repo = CoProcess.start "git" (toCommand $ gitCommandLine params repo) (gitEnv repo)
diff --git a/Git/Config.hs b/Git/Config.hs
index cc9b27b..0d6d67f 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -15,6 +15,7 @@ import Common
 import Git
 import Git.Types
 import qualified Git.Construct
+import Utility.UserInfo
 
 {- Returns a single git config setting, or a default value if not set. -}
 get :: String -> String -> Repo -> String
diff --git a/Git/Construct.hs b/Git/Construct.hs
index 3d39b08..e367c09 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -27,6 +27,7 @@ import Common
 import Git.Types
 import Git
 import qualified Git.Url as Url
+import Utility.UserInfo
 
 {- Finds the git repository used for the cwd, which may be in a parent
  - directory. -}
@@ -158,7 +159,10 @@ fromRemoteLocation s repo = gen $ calcloc s
 				(prefix, suffix) = ("url." , ".insteadof")
 		urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v
 		-- git remotes can be written scp style -- [user@]host:dir
-		scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v)
+		-- but foo::bar is a git-remote-helper location instead
+		scpstyle v = ":" `isInfixOf` v 
+			&& not ("//" `isInfixOf` v)
+			&& not ("::" `isInfixOf` v)
 		scptourl v = "ssh://" ++ host ++ slash dir
 			where
 				(host, dir) = separate (== ':') v
diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs
index 908cc38..29bb281 100644
--- a/Git/CurrentRepo.hs
+++ b/Git/CurrentRepo.hs
@@ -30,7 +30,7 @@ import qualified Git.Config
 get :: IO Repo
 get = do
 	gd <- pathenv "GIT_DIR"
-	r <- configure gd =<< maybe fromCwd fromPath gd
+	r <- configure gd =<< fromCwd
 	wt <- maybe (worktree $ location r) Just <$> pathenv "GIT_WORK_TREE"
 	case wt of
 		Nothing -> return r
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index 5dd988f..4f8ac3f 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -120,17 +120,19 @@ data InternalUnmerged = InternalUnmerged
 
 parseUnmerged :: String -> Maybe InternalUnmerged
 parseUnmerged s
-	| null file || length ws < 3 = Nothing
-	| otherwise = do
-		stage <- readish (ws !! 2) :: Maybe Int
-		unless (stage == 2 || stage == 3) $
-			fail undefined -- skip stage 1
-		blobtype <- readBlobType (ws !! 0)
-		sha <- extractSha (ws !! 1)
-		return $ InternalUnmerged (stage == 2) file (Just blobtype) (Just sha)
+	| null file = Nothing
+	| otherwise = case words metadata of
+		(rawblobtype:rawsha:rawstage:_) -> do
+			stage <- readish rawstage :: Maybe Int
+			unless (stage == 2 || stage == 3) $
+				fail undefined -- skip stage 1
+			blobtype <- readBlobType rawblobtype
+			sha <- extractSha rawsha
+			return $ InternalUnmerged (stage == 2) file
+				(Just blobtype) (Just sha)
+		_ -> Nothing
 	where
 		(metadata, file) = separate (== '\t') s
-		ws = words metadata
 
 reduceUnmerged :: [Unmerged] -> [InternalUnmerged] -> [Unmerged]
 reduceUnmerged c [] = c
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index dc03b88..64187b8 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -8,6 +8,7 @@
 module Git.LsTree (
 	TreeItem(..),
 	lsTree,
+	lsTreeFiles,
 	parseLsTree
 ) where
 
@@ -27,11 +28,16 @@ data TreeItem = TreeItem
 	, file :: FilePath
 	} deriving Show
 
-{- Lists the contents of a Ref -}
+{- Lists the complete contents of a tree. -}
 lsTree :: Ref -> Repo -> IO [TreeItem]
 lsTree t repo = map parseLsTree <$>
 	pipeNullSplitZombie [Params "ls-tree --full-tree -z -r --", File $ show t] repo
 
+{- Lists specified files in a tree. -}
+lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
+lsTreeFiles t fs repo = map parseLsTree <$>
+	pipeNullSplitZombie ([Params "ls-tree -z --", File $ show t] ++ map File fs) repo
+
 {- Parses a line of ls-tree output.
  - (The --long format is not currently supported.) -}
 parseLsTree :: String -> TreeItem
diff --git a/Git/Remote.hs b/Git/Remote.hs
new file mode 100644
index 0000000..5640e9f
--- /dev/null
+++ b/Git/Remote.hs
@@ -0,0 +1,33 @@
+{- git remote stuff
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Remote where
+
+import Common
+import Data.Char
+
+{- Construct a legal git remote name out of an arbitrary input string.
+ -
+ - There seems to be no formal definition of this in the git source,
+ - just some ad-hoc checks, and some other things that fail with certian
+ - types of names (like ones starting with '-').
+ -}
+makeLegalName :: String -> String
+makeLegalName s = case filter legal $ replace "/" "_" s of
+	-- it can't be empty
+	[] -> "unnamed"
+	-- it can't start with / or - or .
+	'.':s' -> makeLegalName s'
+	'/':s' -> makeLegalName s'
+	'-':s' -> makeLegalName s'
+	s' -> s'
+  where
+	{- Only alphanumerics, and a few common bits of punctuation common
+	 - in hostnames. -}
+	legal '_' = True
+	legal '.' = True
+	legal c = isAlphaNum c
diff --git a/GitAnnex.hs b/GitAnnex.hs
index c35846d..81667ee 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -64,14 +64,17 @@ import qualified Command.Import
 import qualified Command.Map
 import qualified Command.Upgrade
 import qualified Command.Version
+import qualified Command.Help
 #ifdef WITH_ASSISTANT
 import qualified Command.Watch
 import qualified Command.Assistant
 #ifdef WITH_WEBAPP
 import qualified Command.WebApp
 #endif
+#ifdef WITH_XMPP
+import qualified Command.XMPPGit
+#endif
 #endif
-import qualified Command.Help
 
 cmds :: [Command]
 cmds = concat
@@ -117,14 +120,17 @@ cmds = concat
 	, Command.Map.def
 	, Command.Upgrade.def
 	, Command.Version.def
+	, Command.Help.def
 #ifdef WITH_ASSISTANT
 	, Command.Watch.def
 	, Command.Assistant.def
 #ifdef WITH_WEBAPP
 	, Command.WebApp.def
 #endif
+#ifdef WITH_XMPP
+	, Command.XMPPGit.def
+#endif
 #endif
-	, Command.Help.def
 	]
 
 options :: [Option]
@@ -158,12 +164,13 @@ options = Option.common ++
 	, Option ['T'] ["time-limit"] (ReqArg Limit.addTimeLimit paramTime)
 		"stop after the specified amount of time"
 	] ++ Option.matcher
-	where
-		setnumcopies v = Annex.changeState $ \s -> s { Annex.forcenumcopies = readish v }
-		setgitconfig :: String -> Annex ()
-		setgitconfig v = do
-			newg <- inRepo $ Git.Config.store v
-			Annex.changeState $ \s -> s { Annex.repo = newg }
+  where
+	setnumcopies v = Annex.changeState $
+		\s -> s { Annex.forcenumcopies = readish v }
+	setgitconfig :: String -> Annex ()
+	setgitconfig v = do
+		newg <- inRepo $ Git.Config.store v
+		Annex.changeState $ \s -> s { Annex.repo = newg }
 
 header :: String
 header = "Usage: git-annex command [option ..]"
diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs
index dc15a6c..f77347a 100644
--- a/GitAnnexShell.hs
+++ b/GitAnnexShell.hs
@@ -1,13 +1,13 @@
 {- git-annex-shell main program
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module GitAnnexShell where
 
-import System.Environment
+import System.Posix.Env
 import System.Console.GetOpt
 
 import Common.Annex
@@ -17,6 +17,7 @@ import Command
 import Annex.UUID
 import qualified Option
 import Fields
+import Utility.UserInfo
 
 import qualified Command.ConfigList
 import qualified Command.InAnnex
@@ -43,24 +44,22 @@ cmds_notreadonly = concat
 
 cmds :: [Command]
 cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
-	where
-		adddirparam c = c
-			{ cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c
-			}
+  where
+	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
 
 options :: [OptDescr (Annex ())]
 options = Option.common ++
 	[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "local repository uuid"
 	]
-	where
-		checkuuid expected = getUUID >>= check
-			where
-				check u | u == toUUID expected = noop
-				check NoUUID = unexpected "uninitialized repository"
-				check u = unexpected $ "UUID " ++ fromUUID u
-				unexpected s = error $
-					"expected repository UUID " ++
-					expected ++ " but found " ++ s
+  where
+	checkuuid expected = getUUID >>= check
+	  where
+		check u | u == toUUID expected = noop
+		check NoUUID = unexpected "uninitialized repository"
+		check u = unexpected $ "UUID " ++ fromUUID u
+		unexpected s = error $
+			"expected repository UUID " ++
+			expected ++ " but found " ++ s
 
 header :: String
 header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]"
@@ -86,6 +85,7 @@ builtins = map cmdname cmds
 builtin :: String -> String -> [String] -> IO ()
 builtin cmd dir params = do
 	checkNotReadOnly cmd
+	checkDirectory $ Just dir
 	let (params', fieldparams) = partitionParams params
 	let fields = filter checkField $ parseFields fieldparams
 	dispatch False (cmd : params') cmds options fields header $
@@ -93,6 +93,10 @@ builtin cmd dir params = do
 
 external :: [String] -> IO ()
 external params = do
+	{- Normal git-shell commands all have the directory as their last
+	 - parameter. -}
+	let lastparam = lastMaybe =<< shellUnEscape <$> lastMaybe params
+	checkDirectory lastparam
 	checkNotLimited
 	unlessM (boolSystem "git-shell" $ map Param $ "-c":fst (partitionParams params)) $
 		error "git-shell failed"
@@ -131,7 +135,40 @@ checkNotReadOnly cmd
 	| cmd `elem` map cmdname cmds_readonly = noop
 	| otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"
 
+checkDirectory :: Maybe FilePath -> IO ()
+checkDirectory mdir = do
+	v <- getEnv "GIT_ANNEX_SHELL_DIRECTORY"
+	case (v, mdir) of
+		(Nothing, _) -> noop
+		(Just d, Nothing) -> req d Nothing
+		(Just d, Just dir)
+			|  d `equalFilePath` dir -> noop
+			| otherwise -> do
+				home <- myHomeDir
+				d' <- canondir home d
+				dir' <- canondir home dir
+				if d' `equalFilePath` dir'
+					then noop
+					else req d' (Just dir')
+  where
+	req d mdir' = error $ unwords 
+		[ "Only allowed to access"
+		, d
+		, maybe "and could not determine directory from command line" ("not " ++) mdir'
+		]
+
+	{- A directory may start with ~/ or in some cases, even /~/,
+	 - or could just be relative to home, or of course could
+	 - be absolute. -}
+	canondir home d
+		| "~/" `isPrefixOf` d = return d
+		| "/~/" `isPrefixOf` d = return $ drop 1 d
+		| otherwise = relHome $ absPathFrom home d
+
 checkEnv :: String -> IO ()
-checkEnv var =
-	whenM (not . null <$> catchDefaultIO "" (getEnv var)) $
-		error $ "Action blocked by " ++ var
+checkEnv var = do
+	v <- getEnv var
+	case v of
+		Nothing -> noop
+		Just "" -> noop
+		Just _ -> error $ "Action blocked by " ++ var
diff --git a/INSTALL b/INSTALL
index 7e88fc0..40a526c 100644
--- a/INSTALL
+++ b/INSTALL
@@ -11,7 +11,6 @@ detailed instructions | quick install
 [[ArchLinux]]         | `yaourt -Sy git-annex`
 [[NixOS]]             | `nix-env -i git-annex`
 [[Gentoo]]            | `emerge git-annex`
-[[NixOS]]             | `nix install git-annex`
 [[ScientificLinux5]]  | (and other RHEL5 clones like CentOS5)
 [[openSUSE]]          | 
 Windows               | [[sorry, Windows not supported yet|todo/windows_support]]
diff --git a/Init.hs b/Init.hs
index aae1016..effa61e 100644
--- a/Init.hs
+++ b/Init.hs
@@ -20,20 +20,16 @@ import qualified Annex.Branch
 import Logs.UUID
 import Annex.Version
 import Annex.UUID
-
-import System.Posix.User
+import Utility.UserInfo
 
 genDescription :: Maybe String -> Annex String
 genDescription (Just d) = return d
 genDescription Nothing = do
 	hostname <- maybe "" id <$> liftIO getHostname
 	let at = if null hostname then "" else "@"
-	username <- clicketyclickety
+	username <- liftIO myUserName
 	reldir <- liftIO . relHome =<< fromRepo Git.repoPath
 	return $ concat [username, at, hostname, ":", reldir]
-	where
-		clicketyclickety = liftIO $ userName <$>
-			(getUserEntryForID =<< getEffectiveUserID)
 
 initialize :: Maybe String -> Annex ()
 initialize mdescription = do
@@ -56,11 +52,11 @@ uninitialize = do
    repos that did not intend to use it. -}
 ensureInitialized :: Annex ()
 ensureInitialized = getVersion >>= maybe needsinit checkVersion
-	where
-		needsinit = ifM Annex.Branch.hasSibling
-				( initialize Nothing
-				, error "First run: git-annex init"
-				)
+  where
+	needsinit = ifM Annex.Branch.hasSibling
+			( initialize Nothing
+			, error "First run: git-annex init"
+			)
 
 {- Checks if a repository is initialized. Does not check version for ugrade. -}
 isInitialized :: Annex Bool
diff --git a/Limit.hs b/Limit.hs
index f39e2d6..e9c9901 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -28,7 +28,7 @@ import Logs.Group
 import Utility.HumanTime
 import Utility.DataUnits
 
-type MatchFiles = AssumeNotPresent -> FilePath -> Annex Bool
+type MatchFiles = AssumeNotPresent -> Annex.FileInfo -> Annex Bool
 type MkLimit = String -> Either String MatchFiles
 type AssumeNotPresent = S.Set UUID
 
@@ -38,10 +38,10 @@ limited = (not . Utility.Matcher.matchesAny) <$> getMatcher'
 
 {- Gets a matcher for the user-specified limits. The matcher is cached for
  - speed; once it's obtained the user-specified limits can't change. -}
-getMatcher :: Annex (FilePath -> Annex Bool)
+getMatcher :: Annex (Annex.FileInfo -> Annex Bool)
 getMatcher = Utility.Matcher.matchM <$> getMatcher'
 
-getMatcher' :: Annex (Utility.Matcher.Matcher (FilePath -> Annex Bool))
+getMatcher' :: Annex (Utility.Matcher.Matcher (Annex.FileInfo -> Annex Bool))
 getMatcher' = do
 	m <- Annex.getState Annex.limit
 	case m of
@@ -52,11 +52,11 @@ getMatcher' = do
 			return matcher
 
 {- Adds something to the limit list, which is built up reversed. -}
-add :: Utility.Matcher.Token (FilePath -> Annex Bool) -> Annex ()
+add :: Utility.Matcher.Token (Annex.FileInfo -> Annex Bool) -> Annex ()
 add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
-	where
-		prepend (Left ls) = Left $ l:ls
-		prepend _ = error "internal"
+  where
+	prepend (Left ls) = Left $ l:ls
+	prepend _ = error "internal"
 
 {- Adds a new token. -}
 addToken :: String -> Annex ()
@@ -80,11 +80,12 @@ addExclude = addLimit . limitExclude
 limitExclude :: MkLimit
 limitExclude glob = Right $ const $ return . not . matchglob glob
 
-matchglob :: String -> FilePath -> Bool
-matchglob glob f = isJust $ match cregex f []
-	where
-		cregex = compile regex []
-		regex = '^':wildToRegex glob
+matchglob :: String -> Annex.FileInfo -> Bool
+matchglob glob (Annex.FileInfo { Annex.matchFile = f }) =
+	isJust $ match cregex f []
+  where
+	cregex = compile regex []
+	regex = '^':wildToRegex glob
 
 {- Adds a limit to skip files not believed to be present
  - in a specfied repository. -}
@@ -96,21 +97,35 @@ limitIn name = Right $ \notpresent -> check $
 	if name == "."
 		then inhere notpresent
 		else inremote notpresent
-	where
-		check a = Backend.lookupFile >=> handle a
-		handle _ Nothing = return False
-		handle a (Just (key, _)) = a key
-		inremote notpresent key = do
-			u <- Remote.nameToUUID name
+  where
+	check a = lookupFile >=> handle a
+	handle _ Nothing = return False
+	handle a (Just (key, _)) = a key
+	inremote notpresent key = do
+		u <- Remote.nameToUUID name
+		us <- Remote.keyLocations key
+		return $ u `elem` us && u `S.notMember` notpresent
+	inhere notpresent key
+		| S.null notpresent = inAnnex key
+		| otherwise = do
+			u <- getUUID
+			if u `S.member` notpresent
+				then return False
+				else inAnnex key
+
+{- Limit to content that is currently present on a uuid. -}
+limitPresent :: Maybe UUID -> MkLimit
+limitPresent u _ = Right $ const $ check $ \key -> do
+	hereu <- getUUID
+	if u == Just hereu || u == Nothing
+		then inAnnex key
+		else do
 			us <- Remote.keyLocations key
-			return $ u `elem` us && u `S.notMember` notpresent
-		inhere notpresent key
-			| S.null notpresent = inAnnex key
-			| otherwise = do
-				u <- getUUID
-				if u `S.member` notpresent
-					then return False
-					else inAnnex key
+			return $ maybe False (`elem` us) u
+  where
+	check a = lookupFile >=> handle a
+	handle _ Nothing = return False
+	handle a (Just (key, _)) = a key
 
 {- Adds a limit to skip files not believed to have the specified number
  - of copies. -}
@@ -124,18 +139,18 @@ limitCopies want = case split ":" want of
 		Nothing -> go n $ checkgroup v
 	[n] -> go n $ const $ return True
 	_ -> Left "bad value for copies"
-	where
-		go num good = case readish num of
-			Nothing -> Left "bad number for copies"
-			Just n -> Right $ \notpresent ->
-				Backend.lookupFile >=> handle n good notpresent
-		handle _ _ _ Nothing = return False
-		handle n good notpresent (Just (key, _)) = do
-			us <- filter (`S.notMember` notpresent)
-				<$> (filterM good =<< Remote.keyLocations key)
-			return $ length us >= n
-		checktrust t u = (== t) <$> lookupTrust u
-		checkgroup g u = S.member g <$> lookupGroups u
+  where
+	go num good = case readish num of
+		Nothing -> Left "bad number for copies"
+		Just n -> Right $ \notpresent f ->
+			lookupFile f >>= handle n good notpresent
+	handle _ _ _ Nothing = return False
+	handle n good notpresent (Just (key, _)) = do
+		us <- filter (`S.notMember` notpresent)
+			<$> (filterM good =<< Remote.keyLocations key)
+		return $ length us >= n
+	checktrust t u = (== t) <$> lookupTrust u
+	checkgroup g u = S.member g <$> lookupGroups u
 
 {- Adds a limit to skip files not believed to be present in all
  - repositories in the specified group. -}
@@ -147,27 +162,26 @@ addInAllGroup groupname = do
 limitInAllGroup :: GroupMap -> MkLimit
 limitInAllGroup m groupname
 	| S.null want = Right $ const $ const $ return True
-	| otherwise = Right $ \notpresent ->
-		Backend.lookupFile >=> check notpresent
-	where
-		want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
-		check _ Nothing = return False
-		check notpresent (Just (key, _))
-			-- optimisation: Check if a wanted uuid is notpresent.
-			| not (S.null (S.intersection want notpresent))	= return False
-			| otherwise = do
-				present <- S.fromList <$> Remote.keyLocations key
-				return $ S.null $ want `S.difference` present
+	| otherwise = Right $ \notpresent -> lookupFile >=> check notpresent
+  where
+	want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
+	check _ Nothing = return False
+	check notpresent (Just (key, _))
+		-- optimisation: Check if a wanted uuid is notpresent.
+		| not (S.null (S.intersection want notpresent))	= return False
+		| otherwise = do
+			present <- S.fromList <$> Remote.keyLocations key
+			return $ S.null $ want `S.difference` present
 
 {- Adds a limit to skip files not using a specified key-value backend. -}
 addInBackend :: String -> Annex ()
 addInBackend = addLimit . limitInBackend
 
 limitInBackend :: MkLimit
-limitInBackend name = Right $ const $ Backend.lookupFile >=> check
-	where
-		wanted = Backend.lookupBackendName name
-		check = return . maybe False ((==) wanted . snd)
+limitInBackend name = Right $ const $ lookupFile >=> check
+  where
+	wanted = Backend.lookupBackendName name
+	check = return . maybe False ((==) wanted . snd)
 
 {- Adds a limit to skip files that are too large or too small -}
 addLargerThan :: String -> Annex ()
@@ -179,10 +193,10 @@ addSmallerThan = addLimit . limitSize (<)
 limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit
 limitSize vs s = case readSize dataUnits s of
 	Nothing -> Left "bad size"
-	Just sz -> Right $ const $ Backend.lookupFile >=> check sz
-	where
-		check _ Nothing = return False
-		check sz (Just (key, _)) = return $ keySize key `vs` Just sz
+	Just sz -> Right $ const $ lookupFile >=> check sz
+  where
+	check _ Nothing = return False
+	check sz (Just (key, _)) = return $ keySize key `vs` Just sz
 
 addTimeLimit :: String -> Annex ()
 addTimeLimit s = do
@@ -196,3 +210,6 @@ addTimeLimit s = do
 				warning $ "Time limit (" ++ s ++ ") reached!"
 				liftIO $ exitWith $ ExitFailure 101
 			else return True
+
+lookupFile :: Annex.FileInfo -> Annex (Maybe (Key, Backend))
+lookupFile = Backend.lookupFile . Annex.relFile
diff --git a/Locations.hs b/Locations.hs
index 4bb2a22..3a7c89e 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -100,10 +100,10 @@ gitAnnexLocation key r
 		 - don't need to do any work to check if the file is
 		 - present. -}
 		return $ inrepo $ annexLocation key hashDirMixed
-	where
-		inrepo d = Git.localGitDir r </> d
-		check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs
-		check [] = error "internal"
+  where
+	inrepo d = Git.localGitDir r </> d
+	check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs
+	check [] = error "internal"
 
 {- The annex directory of a repository. -}
 gitAnnexDir :: Git.Repo -> FilePath
@@ -204,8 +204,8 @@ gitAnnexAssistantDefaultDir = "annex"
 {- Checks a symlink target to see if it appears to point to annexed content. -}
 isLinkToAnnex :: FilePath -> Bool
 isLinkToAnnex s = ('/':d) `isInfixOf` s || d `isPrefixOf` s
-	where
-		d = ".git" </> objectDir
+  where
+	d = ".git" </> objectDir
 
 {- Converts a key into a filename fragment without any directory.
  -
@@ -232,8 +232,8 @@ keyFile key = replace "/" "%" $ replace ":" "&c" $
  -}
 keyPath :: Key -> Hasher -> FilePath
 keyPath key hasher = hasher key </> f </> f
-	where
-		f = keyFile key
+  where
+	f = keyFile key
 
 {- All possibile locations to store a key using different directory hashes. -}
 keyPaths :: Key -> [FilePath]
@@ -249,7 +249,8 @@ fileKey file = file2key $
 {- for quickcheck -}
 prop_idempotent_fileKey :: String -> Bool
 prop_idempotent_fileKey s = Just k == fileKey (keyFile k)
-	where k = stubKey { keyName = s, keyBackendName = "test" }
+  where
+	k = stubKey { keyName = s, keyBackendName = "test" }
 
 {- Two different directory hashes may be used. The mixed case hash
  - came first, and is fine, except for the problem of case-strict
@@ -262,14 +263,14 @@ annexHashes = [hashDirLower, hashDirMixed]
 
 hashDirMixed :: Hasher
 hashDirMixed k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir
-	where
-		dir = take 4 $ display_32bits_as_dir =<< [a,b,c,d]
-		ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file k
+  where
+	dir = take 4 $ display_32bits_as_dir =<< [a,b,c,d]
+	ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file k
 
 hashDirLower :: Hasher
 hashDirLower k = addTrailingPathSeparator $ take 3 dir </> drop 3 dir
-	where
-		dir = take 6 $ md5s $ md5FilePath $ key2file k
+  where
+	dir = take 6 $ md5s $ md5FilePath $ key2file k
 
 {- modified version of display_32bits_as_hex from Data.Hash.MD5
  -   Copyright (C) 2001 Ian Lynagh 
@@ -277,13 +278,13 @@ hashDirLower k = addTrailingPathSeparator $ take 3 dir </> drop 3 dir
  -}
 display_32bits_as_dir :: Word32 -> String
 display_32bits_as_dir w = trim $ swap_pairs cs
-	where 
-		-- Need 32 characters to use. To avoid inaverdently making
-		-- a real word, use letters that appear less frequently.
-		chars = ['0'..'9'] ++ "zqjxkmvwgpfZQJXKMVWGPF"
-		cs = map (\x -> getc $ (shiftR w (6*x)) .&. 31) [0..7]
-		getc n = chars !! fromIntegral n
-		swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs
-		swap_pairs _ = []
-		-- Last 2 will always be 00, so omit.
-		trim = take 6
+  where 
+	-- Need 32 characters to use. To avoid inaverdently making
+	-- a real word, use letters that appear less frequently.
+	chars = ['0'..'9'] ++ "zqjxkmvwgpfZQJXKMVWGPF"
+	cs = map (\x -> getc $ (shiftR w (6*x)) .&. 31) [0..7]
+	getc n = chars !! fromIntegral n
+	swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs
+	swap_pairs _ = []
+	-- Last 2 will always be 00, so omit.
+	trim = take 6
diff --git a/Logs/Group.hs b/Logs/Group.hs
index 9fd7486..a069edc 100644
--- a/Logs/Group.hs
+++ b/Logs/Group.hs
@@ -6,10 +6,12 @@
  -}
 
 module Logs.Group (
+	groupLog,
 	groupChange,
 	groupSet,
 	lookupGroups,
 	groupMap,
+	groupMapLoad,
 	getStandardGroup,
 ) where
 
@@ -47,25 +49,25 @@ groupChange NoUUID _ = error "unknown UUID; cannot modify"
 groupSet :: UUID -> S.Set Group -> Annex ()
 groupSet u g = groupChange u (const g)
 
-{- Read the groupLog into a map. The map is cached for speed. -}
+{- The map is cached for speed. -}
 groupMap :: Annex GroupMap
-groupMap = do
-	cached <- Annex.getState Annex.groupmap
-	case cached of
-		Just m -> return m
-		Nothing -> do
-			m <- makeGroupMap . simpleMap . 
-				parseLog (Just . S.fromList . words) <$>
-					Annex.Branch.get groupLog
-			Annex.changeState $ \s -> s { Annex.groupmap = Just m }
-			return m
+groupMap = maybe groupMapLoad return =<< Annex.getState Annex.groupmap
+
+{- Loads the map, updating the cache. -}
+groupMapLoad :: Annex GroupMap
+groupMapLoad = do
+	m <- makeGroupMap . simpleMap .
+		parseLog (Just . S.fromList . words) <$>
+			Annex.Branch.get groupLog
+	Annex.changeState $ \s -> s { Annex.groupmap = Just m }
+	return m
 
 makeGroupMap :: M.Map UUID (S.Set Group) -> GroupMap
 makeGroupMap byuuid = GroupMap byuuid bygroup
-	where
-		bygroup = M.fromListWith S.union $
-			concat $ map explode $ M.toList byuuid
-		explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s)
+  where
+	bygroup = M.fromListWith S.union $
+		concat $ map explode $ M.toList byuuid
+	explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s)
 
 {- If a repository is in exactly one standard group, returns it. -}
 getStandardGroup :: S.Set Group -> Maybe StandardGroup
diff --git a/Logs/Location.hs b/Logs/Location.hs
index e27ece5..4273710 100644
--- a/Logs/Location.hs
+++ b/Logs/Location.hs
@@ -47,13 +47,13 @@ loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Annex.Branch.files
  - they are present for the specified repository. -}
 loggedKeysFor :: UUID -> Annex [Key]
 loggedKeysFor u = filterM isthere =<< loggedKeys
-	where
-		{- This should run strictly to avoid the filterM
-		 - building many thunks containing keyLocations data. -}
-		isthere k = do
-			us <- loggedLocations k
-			let !there = u `elem` us
-			return there
+  where
+	{- This should run strictly to avoid the filterM
+	 - building many thunks containing keyLocations data. -}
+	isthere k = do
+		us <- loggedLocations k
+		let !there = u `elem` us
+		return there
 
 {- The filename of the log file for a given key. -}
 logFile :: Key -> String
@@ -64,5 +64,5 @@ logFileKey :: FilePath -> Maybe Key
 logFileKey file
 	| ext == ".log" = fileKey base
 	| otherwise = Nothing
-	where
-		(base, ext) = splitAt (length file - 4) file
+  where
+	(base, ext) = splitAt (length file - 4) file
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index 049d6b8..ddcc2ac 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -6,9 +6,11 @@
  -}
 
 module Logs.PreferredContent (
+	preferredContentLog,
 	preferredContentSet,
 	isPreferredContent,
 	preferredContentMap,
+	preferredContentMapLoad,
 	preferredContentMapRaw,
 	checkPreferredContentExpression,
 	setStandardGroup,
@@ -46,29 +48,34 @@ preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
 
 {- Checks if a file is preferred content for the specified repository
  - (or the current repository if none is specified). -}
-isPreferredContent :: Maybe UUID -> AssumeNotPresent -> TopFilePath -> Annex Bool
+isPreferredContent :: Maybe UUID -> AssumeNotPresent -> FilePath -> Annex Bool
 isPreferredContent mu notpresent file = do
+	matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)
+	let fi = Annex.FileInfo
+		{ Annex.matchFile = matchfile
+		, Annex.relFile = file
+		}
 	u <- maybe getUUID return mu
 	m <- preferredContentMap
 	case M.lookup u m of
 		Nothing -> return True
-		Just matcher ->
-			Utility.Matcher.matchMrun matcher $ \a ->
-				a notpresent (getTopFilePath file)
+		Just matcher -> Utility.Matcher.matchMrun matcher $ \a ->
+			a notpresent fi
 
-{- Read the preferredContentLog into a map. The map is cached for speed. -}
+{- The map is cached for speed. -}
 preferredContentMap :: Annex Annex.PreferredContentMap
-preferredContentMap = do
+preferredContentMap = maybe preferredContentMapLoad return
+	=<< Annex.getState Annex.preferredcontentmap
+
+{- Loads the map, updating the cache. -}
+preferredContentMapLoad :: Annex Annex.PreferredContentMap
+preferredContentMapLoad = do
 	groupmap <- groupMap
-	cached <- Annex.getState Annex.preferredcontentmap
-	case cached of
-		Just m -> return m
-		Nothing -> do
-			m <- simpleMap
-				. parseLogWithUUID ((Just .) . makeMatcher groupmap)
-				<$> Annex.Branch.get preferredContentLog
-			Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
-			return m
+	m <- simpleMap
+		. parseLogWithUUID ((Just .) . makeMatcher groupmap)
+		<$> Annex.Branch.get preferredContentLog
+	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
+	return m
 
 preferredContentMapRaw :: Annex (M.Map UUID String)
 preferredContentMapRaw = simpleMap . parseLog Just
@@ -83,8 +90,8 @@ makeMatcher groupmap u s
 	| s == "standard" = standardMatcher groupmap u
 	| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
  	| otherwise = matchAll
-	where
-		tokens = map (parseToken groupmap) (tokenizeMatcher s)
+  where
+	tokens = map (parseToken (Just u) groupmap) (tokenizeMatcher s)
 
 {- Standard matchers are pre-defined for some groups. If none is defined,
  - or a repository is in multiple groups with standard matchers, match all. -}
@@ -99,35 +106,35 @@ matchAll = Utility.Matcher.generate []
 checkPreferredContentExpression :: String -> Maybe String
 checkPreferredContentExpression s
 	| s == "standard" = Nothing
-	| otherwise = case lefts $ map (parseToken emptyGroupMap) (tokenizeMatcher s) of
+	| otherwise = case lefts $ map (parseToken Nothing emptyGroupMap) (tokenizeMatcher s) of
 		[] -> Nothing
 		l -> Just $ unwords $ map ("Parse failure: " ++) l
 
-parseToken :: GroupMap -> String -> Either String (Utility.Matcher.Token MatchFiles)
-parseToken groupmap t
+parseToken :: (Maybe UUID) -> GroupMap -> String -> Either String (Utility.Matcher.Token MatchFiles)
+parseToken mu groupmap t
 	| any (== t) Utility.Matcher.tokens = Right $ Utility.Matcher.token t
-	| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k m
-	where
-		(k, v) = separate (== '=') t
-		m = M.fromList
+	| t == "present" = use $ limitPresent mu
+	| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k $
+		M.fromList
 			[ ("include", limitInclude)
 			, ("exclude", limitExclude)
-			, ("in", limitIn)
 			, ("copies", limitCopies)
 			, ("inbackend", limitInBackend)
 			, ("largerthan", limitSize (>))
 			, ("smallerthan", limitSize (<))
 			, ("inallgroup", limitInAllGroup groupmap)
 			]
-		use a = Utility.Matcher.Operation <$> a v
+  where
+	(k, v) = separate (== '=') t
+	use a = Utility.Matcher.Operation <$> a v
 
 {- This is really dumb tokenization; there's no support for quoted values.
  - Open and close parens are always treated as standalone tokens;
  - otherwise tokens must be separated by whitespace. -}
 tokenizeMatcher :: String -> [String]
 tokenizeMatcher = filter (not . null ) . concatMap splitparens . words
-	where
-		splitparens = segmentDelim (`elem` "()")
+  where
+	splitparens = segmentDelim (`elem` "()")
 
 {- Puts a UUID in a standard group, and sets its preferred content to use
  - the standard expression for that group, unless something is already set. -}
diff --git a/Logs/Presence.hs b/Logs/Presence.hs
index e75e1e4..ce5dd57 100644
--- a/Logs/Presence.hs
+++ b/Logs/Presence.hs
@@ -53,23 +53,23 @@ readLog = parseLog <$$> Annex.Branch.get
 {- Parses a log file. Unparseable lines are ignored. -}
 parseLog :: String -> [LogLine]
 parseLog = mapMaybe (parseline . words) . lines
-	where
-		parseline (a:b:c:_) = do
-			d <- parseTime defaultTimeLocale "%s%Qs" a
-			s <- parsestatus b
-			Just $ LogLine (utcTimeToPOSIXSeconds d) s c
-		parseline _ = Nothing
-		parsestatus "1" = Just InfoPresent
-		parsestatus "0" = Just InfoMissing
-		parsestatus _ = Nothing
+  where
+	parseline (a:b:c:_) = do
+		d <- parseTime defaultTimeLocale "%s%Qs" a
+		s <- parsestatus b
+		Just $ LogLine (utcTimeToPOSIXSeconds d) s c
+	parseline _ = Nothing
+	parsestatus "1" = Just InfoPresent
+	parsestatus "0" = Just InfoMissing
+	parsestatus _ = Nothing
 
 {- Generates a log file. -}
 showLog :: [LogLine] -> String
 showLog = unlines . map genline
-	where
-		genline (LogLine d s i) = unwords [show d, genstatus s, i]
-		genstatus InfoPresent = "1"
-		genstatus InfoMissing = "0"
+  where
+	genline (LogLine d s i) = unwords [show d, genstatus s, i]
+	genstatus InfoPresent = "1"
+	genstatus InfoMissing = "0"
 
 {- Generates a new LogLine with the current date. -}
 logNow :: LogStatus -> String -> Annex LogLine
@@ -102,7 +102,7 @@ mapLog :: LogLine -> LogMap -> LogMap
 mapLog l m
 	| better = M.insert i l m
 	| otherwise = m
-	where
-		better = maybe True newer $ M.lookup i m
-		newer l' = date l' <= date l
-		i = info l
+  where
+	better = maybe True newer $ M.lookup i m
+	newer l' = date l' <= date l
+	i = info l
diff --git a/Logs/Remote.hs b/Logs/Remote.hs
index b75573a..3348059 100644
--- a/Logs/Remote.hs
+++ b/Logs/Remote.hs
@@ -6,6 +6,7 @@
  -}
 
 module Logs.Remote (
+	remoteLog,
 	readRemoteLog,
 	configSet,
 	keyValToConfig,
@@ -47,40 +48,40 @@ showConfig = unwords . configToKeyVal
 {- Given Strings like "key=value", generates a RemoteConfig. -}
 keyValToConfig :: [String] -> RemoteConfig
 keyValToConfig ws = M.fromList $ map (/=/) ws
-	where
-		(/=/) s = (k, v)
-			where
-				k = takeWhile (/= '=') s
-				v = configUnEscape $ drop (1 + length k) s
+  where
+	(/=/) s = (k, v)
+	  where
+		k = takeWhile (/= '=') s
+		v = configUnEscape $ drop (1 + length k) s
 
 configToKeyVal :: M.Map String String -> [String]
 configToKeyVal m = map toword $ sort $ M.toList m
-	where
-		toword (k, v) = k ++ "=" ++ configEscape v
+  where
+	toword (k, v) = k ++ "=" ++ configEscape v
 
 configEscape :: String -> String
 configEscape = concatMap escape
-	where
-		escape c
-			| isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";"
-			| otherwise = [c]
+  where
+	escape c
+		| isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";"
+		| otherwise = [c]
 
 configUnEscape :: String -> String
 configUnEscape = unescape
-	where
-		unescape [] = []
-		unescape (c:rest)
-			| c == '&' = entity rest
-			| otherwise = c : unescape rest
-		entity s
-			| not (null num) && ";" `isPrefixOf` r =
-				chr (Prelude.read num) : unescape rest
-			| otherwise =
-				'&' : unescape s
-			where
-				num = takeWhile isNumber s
-				r = drop (length num) s
-				rest = drop 1 r
+  where
+	unescape [] = []
+	unescape (c:rest)
+		| c == '&' = entity rest
+		| otherwise = c : unescape rest
+	entity s
+		| not (null num) && ";" `isPrefixOf` r =
+			chr (Prelude.read num) : unescape rest
+		| otherwise =
+			'&' : unescape s
+	  where
+		num = takeWhile isNumber s
+		r = drop (length num) s
+		rest = drop 1 r
 
 {- for quickcheck -}
 prop_idempotent_configEscape :: String -> Bool
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 3b68eee..0135f32 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -96,6 +96,9 @@ download u key file shouldretry a = runTransfer (Transfer Download u key) file s
  -
  - If the transfer action returns False, the transfer info is 
  - left in the failedTransferDir.
+ -
+ - An upload can be run from a read-only filesystem, and in this case
+ - no transfer information or lock file is used.
  -}
 runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
 runTransfer t file shouldretry a = do
@@ -106,42 +109,42 @@ runTransfer t file shouldretry a = do
 		bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
 	unless ok $ failed info
 	return ok
-	where
-		prep tfile mode info = do
-			fd <- openFd (transferLockFile tfile) ReadWrite (Just mode)
-				defaultFileFlags { trunc = True }
-			locked <- catchMaybeIO $
-				setLock fd (WriteLock, AbsoluteSeek, 0, 0)
-			when (locked == Nothing) $
-				error $ "transfer already in progress"
-			writeTransferInfoFile info tfile
-			return fd
-		cleanup tfile fd = do
-			void $ tryIO $ removeFile tfile
-			void $ tryIO $ removeFile $ transferLockFile tfile
-			closeFd fd
-		failed info = do
-			failedtfile <- fromRepo $ failedTransferFile t
-			createAnnexDirectory $ takeDirectory failedtfile
-			liftIO $ writeTransferInfoFile info failedtfile
-		retry oldinfo metervar run = do
-			v <- tryAnnex run
-			case v of
-				Right b -> return b
-				Left _ -> do
-					b <- getbytescomplete metervar
-					let newinfo = oldinfo { bytesComplete = Just b }
-					if shouldretry oldinfo newinfo
-						then retry newinfo metervar run
-						else return False
-		getbytescomplete metervar
-			| transferDirection t == Upload =
-				liftIO $ readMVar metervar
-			| otherwise = do
-				f <- fromRepo $ gitAnnexTmpLocation (transferKey t)
-				liftIO $ catchDefaultIO 0 $
-					fromIntegral . fileSize
-						<$> getFileStatus f
+  where
+	prep tfile mode info = catchMaybeIO $ do
+		fd <- openFd (transferLockFile tfile) ReadWrite (Just mode)
+			defaultFileFlags { trunc = True }
+		locked <- catchMaybeIO $
+			setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+		when (locked == Nothing) $
+			error $ "transfer already in progress"
+		writeTransferInfoFile info tfile
+		return fd
+	cleanup _ Nothing = noop
+	cleanup tfile (Just fd) = do
+		void $ tryIO $ removeFile tfile
+		void $ tryIO $ removeFile $ transferLockFile tfile
+		closeFd fd
+	failed info = do
+		failedtfile <- fromRepo $ failedTransferFile t
+		createAnnexDirectory $ takeDirectory failedtfile
+		liftIO $ writeTransferInfoFile info failedtfile
+	retry oldinfo metervar run = do
+		v <- tryAnnex run
+		case v of
+			Right b -> return b
+			Left _ -> do
+				b <- getbytescomplete metervar
+				let newinfo = oldinfo { bytesComplete = Just b }
+				if shouldretry oldinfo newinfo
+					then retry newinfo metervar run
+					else return False
+	getbytescomplete metervar
+		| transferDirection t == Upload =
+			liftIO $ readMVar metervar
+		| otherwise = do
+			f <- fromRepo $ gitAnnexTmpLocation (transferKey t)
+			liftIO $ catchDefaultIO 0 $
+				fromIntegral . fileSize <$> getFileStatus f
 
 {- Generates a callback that can be called as transfer progresses to update
  - the transfer info file. Also returns the file it'll be updating, and a
@@ -149,23 +152,23 @@ runTransfer t file shouldretry a = do
 mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, MVar Integer)
 mkProgressUpdater t info = do
 	tfile <- fromRepo $ transferFile t
-	createAnnexDirectory $ takeDirectory tfile
+	_ <- tryAnnex $ createAnnexDirectory $ takeDirectory tfile
 	mvar <- liftIO $ newMVar 0
 	return (liftIO . updater tfile mvar, tfile, mvar)
-	where
-		updater tfile mvar bytes = modifyMVar_ mvar $ \oldbytes -> do
-			if (bytes - oldbytes >= mindelta)
-				then do
-					let info' = info { bytesComplete = Just bytes }
-					writeTransferInfoFile info' tfile
-					return bytes
-				else return oldbytes
-		{- The minimum change in bytesComplete that is worth
-		 - updating a transfer info file for is 1% of the total
-		 - keySize, rounded down. -}
-		mindelta = case keySize (transferKey t) of
-			Just sz -> sz `div` 100
-			Nothing -> 100 * 1024 -- arbitrarily, 100 kb
+  where
+	updater tfile mvar bytes = modifyMVar_ mvar $ \oldbytes -> do
+		if (bytes - oldbytes >= mindelta)
+			then do
+				let info' = info { bytesComplete = Just bytes }
+				_ <- tryIO $ writeTransferInfoFile info' tfile
+				return bytes
+			else return oldbytes
+	{- The minimum change in bytesComplete that is worth
+	 - updating a transfer info file for is 1% of the total
+	 - keySize, rounded down. -}
+	mindelta = case keySize (transferKey t) of
+		Just sz -> sz `div` 100
+		Nothing -> 100 * 1024 -- arbitrarily, 100 kb
 
 startTransferInfo :: Maybe FilePath -> IO TransferInfo
 startTransferInfo file = TransferInfo
@@ -202,25 +205,23 @@ getTransfers = do
 	infos <- mapM checkTransfer transfers
 	return $ map (\(t, Just i) -> (t, i)) $
 		filter running $ zip transfers infos
-	where
-		findfiles = liftIO . mapM dirContentsRecursive
-			=<< mapM (fromRepo . transferDir)
-				[Download, Upload]
-		running (_, i) = isJust i
+  where
+	findfiles = liftIO . mapM dirContentsRecursive
+		=<< mapM (fromRepo . transferDir) [Download, Upload]
+	running (_, i) = isJust i
 
 {- Gets failed transfers for a given remote UUID. -}
 getFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)]
 getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles)
-	where
-		getpairs = mapM $ \f -> do
-			let mt = parseTransferFile f
-			mi <- readTransferInfoFile Nothing f
-			return $ case (mt, mi) of
-				(Just t, Just i) -> Just (t, i)
-				_ -> Nothing
-		findfiles = liftIO . mapM dirContentsRecursive
-			=<< mapM (fromRepo . failedTransferDir u)
-				[Download, Upload]
+  where
+	getpairs = mapM $ \f -> do
+		let mt = parseTransferFile f
+		mi <- readTransferInfoFile Nothing f
+		return $ case (mt, mi) of
+			(Just t, Just i) -> Just (t, i)
+			_ -> Nothing
+	findfiles = liftIO . mapM dirContentsRecursive
+		=<< mapM (fromRepo . failedTransferDir u) [Download, Upload]
 
 removeFailedTransfer :: Transfer -> Annex ()
 removeFailedTransfer t = do
@@ -253,8 +254,8 @@ parseTransferFile file
 			<*> pure (toUUID u)
 			<*> fileKey key
 		_ -> Nothing
-	where
-		bits = splitDirectories file
+  where
+	bits = splitDirectories file
 
 writeTransferInfoFile :: TransferInfo -> FilePath -> IO ()
 writeTransferInfoFile info tfile = do
@@ -291,16 +292,16 @@ readTransferInfo mpid s = TransferInfo
 	<*> bytes
 	<*> pure (if null filename then Nothing else Just filename)
 	<*> pure False
-	where
-		(firstline, filename) = separate (== '\n') s
-		bits = split " " firstline
-		numbits = length bits
-		time = if numbits > 0
-			then Just <$> parsePOSIXTime (bits !! 0)
-			else pure Nothing
-		bytes = if numbits > 1
-			then Just <$> readish (bits !! 1)
-			else pure Nothing
+  where
+	(firstline, filename) = separate (== '\n') s
+	bits = split " " firstline
+	numbits = length bits
+	time = if numbits > 0
+		then Just <$> parsePOSIXTime =<< headMaybe bits
+		else pure Nothing -- not failure
+	bytes = if numbits > 1
+		then Just <$> readish =<< headMaybe (drop 1 bits)
+		else pure Nothing -- not failure
 
 parsePOSIXTime :: String -> Maybe POSIXTime
 parsePOSIXTime s = utcTimeToPOSIXSeconds
diff --git a/Logs/Trust.hs b/Logs/Trust.hs
index 1a29f8c..e5322e0 100644
--- a/Logs/Trust.hs
+++ b/Logs/Trust.hs
@@ -6,11 +6,14 @@
  -}
 
 module Logs.Trust (
+	trustLog,
 	TrustLevel(..),
 	trustGet,
 	trustSet,
 	trustPartition,
+	trustExclude,
 	lookupTrust,
+	trustMapLoad,
 	trustMapRaw,
 ) where
 
@@ -65,27 +68,32 @@ trustPartition level ls
 		candidates <- trustGet level
 		return $ partition (`elem` candidates) ls
 
-{- Read the trustLog into a map, overriding with any
- - values from forcetrust or the git config. The map is cached for speed. -}
+{- Filters UUIDs to those not matching a TrustLevel. -}
+trustExclude :: TrustLevel -> [UUID] -> Annex ([UUID])
+trustExclude level ls = snd <$> trustPartition level ls
+
+{- trustLog in a map, overridden with any values from forcetrust or
+ - the git config. The map is cached for speed. -}
 trustMap :: Annex TrustMap
-trustMap = do
-	cached <- Annex.getState Annex.trustmap
-	case cached of
-		Just m -> return m
-		Nothing -> do
-			overrides <- Annex.getState Annex.forcetrust
-			logged <- trustMapRaw
-			configured <- M.fromList . catMaybes
-				<$> (mapM configuredtrust =<< remoteList)
-			let m = M.union overrides $ M.union configured logged
-			Annex.changeState $ \s -> s { Annex.trustmap = Just m }
-			return m
-	where
-		configuredtrust r =
-			maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$>
-				maybe Nothing readTrustLevel
-					<$> getTrustLevel (Types.Remote.repo r)
+trustMap = maybe trustMapLoad return =<< Annex.getState Annex.trustmap
+
+{- Loads the map, updating the cache, -}
+trustMapLoad :: Annex TrustMap
+trustMapLoad = do
+	overrides <- Annex.getState Annex.forcetrust
+	logged <- trustMapRaw
+	configured <- M.fromList . catMaybes
+		<$> (mapM configuredtrust =<< remoteList)
+	let m = M.union overrides $ M.union configured logged
+	Annex.changeState $ \s -> s { Annex.trustmap = Just m }
+	return m
+  where
+	configuredtrust r = maybe Nothing (\l -> Just (Types.Remote.uuid r, l))
+		<$> maybe Nothing readTrustLevel
+			<$> getTrustLevel (Types.Remote.repo r)
 
+{- Does not include forcetrust or git config values, just those from the
+ - log file. -}
 trustMapRaw :: Annex TrustMap
 trustMapRaw = simpleMap . parseLog (Just . parseTrustLog)
 	<$> Annex.Branch.get trustLog
@@ -94,11 +102,11 @@ trustMapRaw = simpleMap . parseLog (Just . parseTrustLog)
  - trust status, which is why this defaults to Trusted. -}
 parseTrustLog :: String -> TrustLevel
 parseTrustLog s = maybe Trusted parse $ headMaybe $ words s
-	where
-		parse "1" = Trusted
-		parse "0" = UnTrusted
-		parse "X" = DeadTrusted
-		parse _ = SemiTrusted
+  where
+	parse "1" = Trusted
+	parse "0" = UnTrusted
+	parse "X" = DeadTrusted
+	parse _ = SemiTrusted
 
 showTrustLog :: TrustLevel -> String
 showTrustLog Trusted = "1"
diff --git a/Logs/UUID.hs b/Logs/UUID.hs
index d825e11..2f24a38 100644
--- a/Logs/UUID.hs
+++ b/Logs/UUID.hs
@@ -8,34 +8,38 @@
  -
  - uuid.log stores a list of known uuids, and their descriptions.
  -
- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Logs.UUID (
+	uuidLog,
 	describeUUID,
 	recordUUID,
-	uuidMap
+	uuidMap,
+	uuidMapLoad
 ) where
 
 import qualified Data.Map as M
 import Data.Time.Clock.POSIX
 
+import Types.UUID
 import Common.Annex
+import qualified Annex
 import qualified Annex.Branch
 import Logs.UUIDBased
 import qualified Annex.UUID
 
 {- Filename of uuid.log. -}
-logfile :: FilePath
-logfile = "uuid.log"
+uuidLog :: FilePath
+uuidLog = "uuid.log"
 
 {- Records a description for a uuid in the log. -}
 describeUUID :: UUID -> String -> Annex ()
 describeUUID uuid desc = do
 	ts <- liftIO getPOSIXTime
-	Annex.Branch.change logfile $
+	Annex.Branch.change uuidLog $
 		showLog id . changeLog ts uuid desc . fixBadUUID . parseLog Just
 
 {- Temporarily here to fix badly formatted uuid logs generated by
@@ -49,41 +53,47 @@ describeUUID uuid desc = do
  -}
 fixBadUUID :: Log String -> Log String
 fixBadUUID = M.fromList . map fixup . M.toList
-	where
-		fixup (k, v)
-			| isbad = (fixeduuid, LogEntry (Date $ newertime v) fixedvalue)
-			| otherwise = (k, v)
-			where
-				kuuid = fromUUID k
-				isbad = not (isuuid kuuid) && isuuid lastword
-				ws = words $ value v
-				lastword = Prelude.last ws
-				fixeduuid = toUUID lastword
-				fixedvalue = unwords $ kuuid: Prelude.init ws
-		-- For the fixed line to take precidence, it should be
-		-- slightly newer, but only slightly.
-		newertime (LogEntry (Date d) _) = d + minimumPOSIXTimeSlice
-		newertime (LogEntry Unknown _) = minimumPOSIXTimeSlice
-		minimumPOSIXTimeSlice = 0.000001
-		isuuid s = length s == 36 && length (split "-" s) == 5
+  where
+	fixup (k, v)
+		| isbad = (fixeduuid, LogEntry (Date $ newertime v) fixedvalue)
+		| otherwise = (k, v)
+	  where
+		kuuid = fromUUID k
+		isbad = not (isuuid kuuid) && isuuid lastword
+		ws = words $ value v
+		lastword = Prelude.last ws
+		fixeduuid = toUUID lastword
+		fixedvalue = unwords $ kuuid: Prelude.init ws
+	-- For the fixed line to take precidence, it should be
+	-- slightly newer, but only slightly.
+	newertime (LogEntry (Date d) _) = d + minimumPOSIXTimeSlice
+	newertime (LogEntry Unknown _) = minimumPOSIXTimeSlice
+	minimumPOSIXTimeSlice = 0.000001
+	isuuid s = length s == 36 && length (split "-" s) == 5
 
 {- Records the uuid in the log, if it's not already there. -}
 recordUUID :: UUID -> Annex ()
 recordUUID u = go . M.lookup u =<< uuidMap 
-	where
-		go (Just "") = set
-		go Nothing = set
-		go _ = noop
-		set = describeUUID u ""
+  where
+	go (Just "") = set
+	go Nothing = set
+	go _ = noop
+	set = describeUUID u ""
+
+{- The map is cached for speed. -}
+uuidMap :: Annex UUIDMap
+uuidMap = maybe uuidMapLoad return =<< Annex.getState Annex.uuidmap
 
 {- Read the uuidLog into a simple Map.
  -
  - The UUID of the current repository is included explicitly, since
  - it may not have been described and so otherwise would not appear. -}
-uuidMap :: Annex (M.Map UUID String)
-uuidMap = do
-	m <- (simpleMap . parseLog Just) <$> Annex.Branch.get logfile
+uuidMapLoad :: Annex UUIDMap
+uuidMapLoad = do
+	m <- (simpleMap . parseLog Just) <$> Annex.Branch.get uuidLog
 	u <- Annex.UUID.getUUID
-	return $ M.insertWith' preferold u "" m
-	where
-		preferold = flip const
+	let m' = M.insertWith' preferold u "" m
+	Annex.changeState $ \s -> s { Annex.uuidmap = Just m' }
+	return m'
+  where
+	preferold = flip const
diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs
index 674ac21..c1901ee 100644
--- a/Logs/UUIDBased.hs
+++ b/Logs/UUIDBased.hs
@@ -50,36 +50,36 @@ tskey = "timestamp="
 
 showLog :: (a -> String) -> Log a -> String
 showLog shower = unlines . map showpair . M.toList
-	where
-		showpair (k, LogEntry (Date p) v) =
-			unwords [fromUUID k, shower v, tskey ++ show p]
-		showpair (k, LogEntry Unknown v) =
-			unwords [fromUUID k, shower v]
+  where
+	showpair (k, LogEntry (Date p) v) =
+		unwords [fromUUID k, shower v, tskey ++ show p]
+	showpair (k, LogEntry Unknown v) =
+		unwords [fromUUID k, shower v]
 
 parseLog :: (String -> Maybe a) -> String -> Log a
 parseLog = parseLogWithUUID . const
 
 parseLogWithUUID :: (UUID -> String -> Maybe a) -> String -> Log a
 parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines
-	where
-		parse line
-			| null ws = Nothing
-			| otherwise = parser u (unwords info) >>= makepair
-			where
-				makepair v = Just (u, LogEntry ts v)
-				ws = words line
-				u = toUUID $ Prelude.head ws
-				t = Prelude.last ws
-				ts
-					| tskey `isPrefixOf` t =
-						pdate $ drop 1 $ dropWhile (/= '=') t
-					| otherwise = Unknown
-				info
-					| ts == Unknown = drop 1 ws
-					| otherwise = drop 1 $ beginning ws
-				pdate s = case parseTime defaultTimeLocale "%s%Qs" s of
-					Nothing -> Unknown
-					Just d -> Date $ utcTimeToPOSIXSeconds d
+  where
+	parse line
+		| null ws = Nothing
+		| otherwise = parser u (unwords info) >>= makepair
+	  where
+		makepair v = Just (u, LogEntry ts v)
+		ws = words line
+		u = toUUID $ Prelude.head ws
+		t = Prelude.last ws
+		ts
+			| tskey `isPrefixOf` t =
+				pdate $ drop 1 $ dropWhile (/= '=') t
+			| otherwise = Unknown
+		info
+			| ts == Unknown = drop 1 ws
+			| otherwise = drop 1 $ beginning ws
+		pdate s = case parseTime defaultTimeLocale "%s%Qs" s of
+			Nothing -> Unknown
+			Just d -> Date $ utcTimeToPOSIXSeconds d
 
 changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a
 changeLog t u v = M.insert u $ LogEntry (Date t) v
@@ -106,9 +106,9 @@ prop_TimeStamp_sane = Unknown < Date 1
 
 prop_addLog_sane :: Bool
 prop_addLog_sane = newWins && newestWins
-	where
-		newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2
-		newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2
+  where
+	newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2
+	newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2
 
-		l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")]
-		l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")]
+	l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")]
+	l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")]
diff --git a/Logs/Unused.hs b/Logs/Unused.hs
index 522c523..9f1278d 100644
--- a/Logs/Unused.hs
+++ b/Logs/Unused.hs
@@ -35,13 +35,12 @@ readUnusedLog prefix = do
 			<$> liftIO (readFile f)
 		, return M.empty
 		)
-	where
-		parse line =
-			case (readish tag, file2key rest) of
-				(Just num, Just key) -> Just (num, key)
-				_ -> Nothing
-			where
-				(tag, rest) = separate (== ' ') line
+  where
+	parse line = case (readish tag, file2key rest) of
+		(Just num, Just key) -> Just (num, key)
+		_ -> Nothing
+	  where
+		(tag, rest) = separate (== ' ') line
 
 type UnusedMap = M.Map Int Key
 
@@ -64,10 +63,10 @@ unusedSpec :: String -> [Int]
 unusedSpec spec
 	| "-" `isInfixOf` spec = range $ separate (== '-') spec
 	| otherwise = catMaybes [readish spec]
-	where
-		range (a, b) = case (readish a, readish b) of
-			(Just x, Just y) -> [x..y]
-			_ -> []
+  where
+	range (a, b) = case (readish a, readish b) of
+		(Just x, Just y) -> [x..y]
+		_ -> []
 
 {- Start action for unused content. Finds the number in the maps, and
  - calls either of 3 actions, depending on the type of unused file. -}
@@ -81,11 +80,11 @@ startUnused message unused badunused tmpunused maps n = search
 	, (unusedBadMap maps, badunused)
 	, (unusedTmpMap maps, tmpunused)
 	]
-	where
-		search [] = stop
-		search ((m, a):rest) =
-			case M.lookup n m of
-				Nothing -> search rest
-				Just key -> do
-					showStart message (show n)
-					next $ a key
+  where
+	search [] = stop
+	search ((m, a):rest) =
+		case M.lookup n m of
+			Nothing -> search rest
+			Just key -> do
+				showStart message (show n)
+				next $ a key
diff --git a/Logs/Web.hs b/Logs/Web.hs
index 534bd53..c2a4deb 100644
--- a/Logs/Web.hs
+++ b/Logs/Web.hs
@@ -37,13 +37,13 @@ oldurlLogs key =
 {- Gets all urls that a key might be available from. -}
 getUrls :: Key -> Annex [URLString]
 getUrls key = go $ urlLog key : oldurlLogs key
-	where
-		go [] = return []
-		go (l:ls) = do
-			us <- currentLog l
-			if null us
-				then go ls
-				else return us
+  where
+	go [] = return []
+	go (l:ls) = do
+		us <- currentLog l
+		if null us
+			then go ls
+			else return us
 
 {- Records a change in an url for a key. -}
 setUrl :: Key -> URLString -> LogStatus -> Annex ()
diff --git a/Makefile b/Makefile
index 1292bba..a98949e 100644
--- a/Makefile
+++ b/Makefile
@@ -1,13 +1,13 @@
 CFLAGS=-Wall
 GIT_ANNEX_TMP_BUILD_DIR?=tmp
-IGNORE=-ignore-package monads-fd -ignore-package monads-tf
-BASEFLAGS=-Wall $(IGNORE) -outputdir $(GIT_ANNEX_TMP_BUILD_DIR) -IUtility
+BASEFLAGS=-Wall -outputdir $(GIT_ANNEX_TMP_BUILD_DIR) -IUtility
 
 # If you get build failures due to missing haskell libraries,
 # you can turn off some of these features.
 #
 # If you're using an old version of yesod, enable -DWITH_OLD_YESOD
-FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBAPP -DWITH_PAIRING
+# Or with an old version of the uri library, enable -DWITH_OLD_URI
+FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS
 
 bins=git-annex
 mans=git-annex.1 git-annex-shell.1
@@ -16,10 +16,14 @@ all=$(bins) $(mans) docs
 
 OS:=$(shell uname | sed 's/[-_].*//')
 ifeq ($(OS),Linux)
-OPTFLAGS?=-DWITH_INOTIFY
+OPTFLAGS?=-DWITH_INOTIFY -DWITH_DBUS
 clibs=Utility/libdiskfree.o Utility/libmounts.o
 THREADFLAGS=$(shell if test -e  `ghc --print-libdir`/libHSrts_thr.a; then printf -- -threaded; fi)
 else
+ifeq ($(OS),SunOS)
+# Solaris is not supported by the assistant or watch command.
+FEATURES:=$(shell echo $(FEATURES) | sed -e 's/-DWITH_ASSISTANT//' -e 's/-DWITH_WEBAPP//')
+else
 # BSD system
 THREADFLAGS=-threaded
 OPTFLAGS?=-DWITH_KQUEUE
@@ -32,6 +36,7 @@ CFLAGS=-Wall -m32
 endif
 endif
 endif
+endif
 
 ALLFLAGS = $(BASEFLAGS) $(FEATURES) $(OPTFLAGS) $(THREADFLAGS)
 
@@ -139,11 +144,10 @@ hackage: sdist
 	@cabal upload dist/*.tar.gz
 
 THIRDPARTY_BINS=git curl lsof xargs rsync uuid wget gpg \
-	sha1sum sha224sum sha256sum sha384sum sha512sum
+	sha1sum sha224sum sha256sum sha384sum sha512sum cp
 
 LINUXSTANDALONE_DEST=$(GIT_ANNEX_TMP_BUILD_DIR)/git-annex.linux
 linuxstandalone:
-	$(MAKE) clean
 	GIT_ANNEX_LOCAL_FEATURES="$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_OLD_SSH" $(MAKE) git-annex
 
 	rm -rf "$(LINUXSTANDALONE_DEST)"
@@ -182,7 +186,6 @@ linuxstandalone:
 OSXAPP_DEST=$(GIT_ANNEX_TMP_BUILD_DIR)/build-dmg/git-annex.app
 OSXAPP_BASE=$(OSXAPP_DEST)/Contents/MacOS
 osxapp:
-	$(MAKE) clean
 	GIT_ANNEX_LOCAL_FEATURES="$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_OLD_SSH" $(MAKE) git-annex
 
 	rm -rf "$(OSXAPP_DEST)"
@@ -218,4 +221,8 @@ osxapp:
 	rm -f tmp/git-annex.dmg.bz2
 	bzip2 tmp/git-annex.dmg
 
+# used by ./ghci
+getflags:
+	@echo $(ALLFLAGS) $(clibs)
+
 .PHONY: $(bins) test install
diff --git a/Messages.hs b/Messages.hs
index d8d84d1..f3cd9fc 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -65,29 +65,29 @@ showProgress = handle q $
  - The action is passed a callback to use to update the meter. -}
 metered :: (Maybe MeterUpdate) -> Key -> (MeterUpdate -> Annex a) -> Annex a
 metered combinemeterupdate key a = withOutputType $ go (keySize key)
-	where
-		go (Just size) NormalOutput = do
-			progress <- liftIO $ newProgress "" size
-			meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
-			showOutput
-			liftIO $ displayMeter stdout meter
-			r <- a $ \n -> liftIO $ do
-				incrP progress n
-				displayMeter stdout meter
-				maybe noop (\m -> m n) combinemeterupdate
-			liftIO $ clearMeter stdout meter
-			return r
-                go _ _ = a (const noop)
+  where
+	go (Just size) NormalOutput = do
+		progress <- liftIO $ newProgress "" size
+		meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
+		showOutput
+		liftIO $ displayMeter stdout meter
+		r <- a $ \n -> liftIO $ do
+			incrP progress n
+			displayMeter stdout meter
+			maybe noop (\m -> m n) combinemeterupdate
+		liftIO $ clearMeter stdout meter
+		return r
+	go _ _ = a (const noop)
 
 showSideAction :: String -> Annex ()
 showSideAction m = Annex.getState Annex.output >>= go
-	where
-		go (MessageState v StartBlock) = do
-			p
-	 		Annex.changeState $ \s -> s { Annex.output = MessageState v InBlock }
-		go (MessageState _ InBlock) = return ()
-		go _ = p
-		p = handle q $ putStrLn $ "(" ++ m ++ "...)"
+  where
+	go (MessageState v StartBlock) = do
+		p
+		Annex.changeState $ \s -> s { Annex.output = MessageState v InBlock }
+	go (MessageState _ InBlock) = return ()
+	go _ = p
+	p = handle q $ putStrLn $ "(" ++ m ++ "...)"
 			
 showStoringStateAction :: Annex ()
 showStoringStateAction = showSideAction "Recording state in git"
@@ -106,8 +106,8 @@ doSideAction' b a = do
 	o <- Annex.getState Annex.output
 	set $ o { sideActionBlock = b }
 	set o `after` a
-	where
-		set o = Annex.changeState $ \s -> s {  Annex.output = o }
+  where
+	set o = Annex.changeState $ \s -> s {  Annex.output = o }
 
 showOutput :: Annex ()
 showOutput = handle q $
@@ -125,10 +125,10 @@ showEndFail = showEndResult False
 
 showEndResult :: Bool -> Annex ()
 showEndResult ok = handle (JSON.end ok) $ putStrLn msg
-	where
-		msg
-			| ok = "ok"
-			| otherwise = "failed"
+  where
+	msg
+		| ok = "ok"
+		| otherwise = "failed"
 
 showErr :: (Show a) => a -> Annex ()
 showErr e = warning' $ "git-annex: " ++ show e
@@ -153,9 +153,9 @@ maybeShowJSON v = handle (JSON.add v) q
 {- Shows a complete JSON value, only when in json mode. -}
 showFullJSON :: JSON a => [(String, a)] -> Annex Bool
 showFullJSON v = withOutputType $ liftIO . go
-	where
-		go JSONOutput = JSON.complete v >> return True
-		go _ = return False
+  where
+	go JSONOutput = JSON.complete v >> return True
+	go _ = return False
 
 {- Performs an action that outputs nonstandard/customized output, and
  - in JSON mode wraps its output in JSON.start and JSON.end, so it's
@@ -184,10 +184,10 @@ setupConsole = do
 
 handle :: IO () -> IO () -> Annex ()
 handle json normal = withOutputType go
-	where
-		go NormalOutput = liftIO normal
-		go QuietOutput = q
-		go JSONOutput = liftIO $ flushed json
+  where
+	go NormalOutput = liftIO normal
+	go QuietOutput = q
+	go JSONOutput = liftIO $ flushed json
 
 q :: Monad m => m ()
 q = noop
diff --git a/Messages/JSON.hs b/Messages/JSON.hs
index f7a031e..e262192 100644
--- a/Messages/JSON.hs
+++ b/Messages/JSON.hs
@@ -20,9 +20,9 @@ import qualified Utility.JSONStream as Stream
 start :: String -> Maybe String -> IO ()
 start command file =
 	putStr $ Stream.start $ ("command", command) : filepart file
-	where
-		filepart Nothing = []
-		filepart (Just f) = [("file", f)]
+  where
+	filepart Nothing = []
+	filepart (Just f) = [("file", f)]
 
 end :: Bool -> IO ()
 end b = putStr $ Stream.add [("success", b)] ++ Stream.end
diff --git a/Option.hs b/Option.hs
index ff70fb6..1475aaf 100644
--- a/Option.hs
+++ b/Option.hs
@@ -46,18 +46,18 @@ common =
 	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
 		"specify key-value backend to use"
 	]
-	where
-		setforce v = Annex.changeState $ \s -> s { Annex.force = v }
-		setfast v = Annex.changeState $ \s -> s { Annex.fast = v }
-		setauto v = Annex.changeState $ \s -> s { Annex.auto = v }
-		setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
-		setdebug = liftIO $ do
-			s <- simpledebug
-			updateGlobalLogger rootLoggerName
-				(setLevel DEBUG . setHandlers [s])
-		simpledebug = setFormatter
-			<$> streamHandler stderr DEBUG
-			<*> pure (simpleLogFormatter "[$time] $msg")
+  where
+	setforce v = Annex.changeState $ \s -> s { Annex.force = v }
+	setfast v = Annex.changeState $ \s -> s { Annex.fast = v }
+	setauto v = Annex.changeState $ \s -> s { Annex.auto = v }
+	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
+	setdebug = liftIO $ do
+		s <- simpledebug
+		updateGlobalLogger rootLoggerName
+			(setLevel DEBUG . setHandlers [s])
+	simpledebug = setFormatter
+		<$> streamHandler stderr DEBUG
+		<*> pure (simpleLogFormatter "[$time] $msg")
 
 matcher :: [Option]
 matcher =
@@ -67,9 +67,9 @@ matcher =
 	, shortopt "(" "open group of options"
 	, shortopt ")" "close group of options"
 	]
-	where
-		longopt o = Option [] [o] $ NoArg $ addToken o
-		shortopt o = Option o [] $ NoArg $ addToken o
+  where
+	longopt o = Option [] [o] $ NoArg $ addToken o
+	shortopt o = Option o [] $ NoArg $ addToken o
 
 {- An option that sets a flag. -}
 flag :: String -> String -> String -> Option
diff --git a/Remote.hs b/Remote.hs
index e1ff9e7..721b64e 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -80,10 +80,10 @@ byName (Just n) = either error Just <$> byName' n
 byName' :: String -> Annex (Either String Remote)
 byName' "" = return $ Left "no remote specified"
 byName' n = handle . filter matching <$> remoteList
-	where
-		handle [] = Left $ "there is no available git remote named \"" ++ n ++ "\""
-		handle match = Right $ Prelude.head match
-		matching r = n == name r || toUUID n == uuid r
+  where
+	handle [] = Left $ "there is no available git remote named \"" ++ n ++ "\""
+	handle match = Right $ Prelude.head match
+	matching r = n == name r || toUUID n == uuid r
 
 {- Looks up a remote by name (or by UUID, or even by description),
  - and returns its UUID. Finds even remotes that are not configured in
@@ -93,17 +93,17 @@ nameToUUID "." = getUUID -- special case for current repo
 nameToUUID "here" = getUUID
 nameToUUID "" = error "no remote specified"
 nameToUUID n = byName' n >>= go
-	where
-		go (Right r) = return $ uuid r
-		go (Left e) = fromMaybe (error e) <$> bydescription
-		bydescription = do
-			m <- uuidMap
-			case M.lookup n $ transform swap m of
-				Just u -> return $ Just u
-				Nothing -> return $ byuuid m
-		byuuid m = M.lookup (toUUID n) $ transform double m
-		transform a = M.fromList . map a . M.toList
-		double (a, _) = (a, a)
+  where
+	go (Right r) = return $ uuid r
+	go (Left e) = fromMaybe (error e) <$> bydescription
+	bydescription = do
+		m <- uuidMap
+		case M.lookup n $ transform swap m of
+			Just u -> return $ Just u
+			Nothing -> return $ byuuid m
+	byuuid m = M.lookup (toUUID n) $ transform double m
+	transform a = M.fromList . map a . M.toList
+	double (a, _) = (a, a)
 
 {- Pretty-prints a list of UUIDs of remotes, for human display.
  -
@@ -115,23 +115,23 @@ prettyPrintUUIDs desc uuids = do
 	m <- uuidDescriptions
 	maybeShowJSON [(desc, map (jsonify m hereu) uuids)]
 	return $ unwords $ map (\u -> "\t" ++ prettify m hereu u ++ "\n") uuids
-	where
-		finddescription m u = M.findWithDefault "" u m
-		prettify m hereu u
-			| not (null d) = fromUUID u ++ " -- " ++ d
-			| otherwise = fromUUID u
-			where
-				ishere = hereu == u
-				n = finddescription m u
-				d
-					| null n && ishere = "here"
-					| ishere = addName n "here"
-					| otherwise = n
-		jsonify m hereu u = toJSObject
-			[ ("uuid", toJSON $ fromUUID u)
-			, ("description", toJSON $ finddescription m u)
-			, ("here", toJSON $ hereu == u)
-			]
+  where
+	finddescription m u = M.findWithDefault "" u m
+	prettify m hereu u
+		| not (null d) = fromUUID u ++ " -- " ++ d
+		| otherwise = fromUUID u
+	  where
+		ishere = hereu == u
+		n = finddescription m u
+		d
+			| null n && ishere = "here"
+			| ishere = addName n "here"
+			| otherwise = n
+	jsonify m hereu u = toJSObject
+		[ ("uuid", toJSON $ fromUUID u)
+		, ("description", toJSON $ finddescription m u)
+		, ("here", toJSON $ hereu == u)
+		]
 
 {- List of remote names and/or descriptions, for human display.  -}
 prettyListUUIDs :: [UUID] -> Annex [String]
@@ -139,13 +139,13 @@ prettyListUUIDs uuids = do
 	hereu <- getUUID
 	m <- uuidDescriptions
 	return $ map (\u -> prettify m hereu u) uuids
-	where
-		finddescription m u = M.findWithDefault "" u m
-		prettify m hereu u
-			| u == hereu = addName n "here"
-			| otherwise = n
-			where
-				n = finddescription m u
+  where
+	finddescription m u = M.findWithDefault "" u m
+	prettify m hereu u
+		| u == hereu = addName n "here"
+		| otherwise = n
+	  where
+		n = finddescription m u
 
 {- Gets the git repo associated with a UUID.
  - There's no associated remote when this is the UUID of the local repo. -}
@@ -169,7 +169,7 @@ remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
 {- List of repository UUIDs that the location log indicates may have a key.
  - Dead repositories are excluded. -}
 keyLocations :: Key -> Annex [UUID]
-keyLocations key = snd <$> (trustPartition DeadTrusted =<< loggedLocations key)
+keyLocations key = trustExclude DeadTrusted =<< loggedLocations key
 
 {- Cost ordered lists of remotes that the location log indicates
  - may have a key.
@@ -213,12 +213,12 @@ showLocations key exclude = do
 	ppuuidswanted <- Remote.prettyPrintUUIDs "wanted" uuidswanted
 	ppuuidsskipped <- Remote.prettyPrintUUIDs "skipped" uuidsskipped
 	showLongNote $ message ppuuidswanted ppuuidsskipped
-	where
-		filteruuids l x = filter (`notElem` x) l
-		message [] [] = "No other repository is known to contain the file."
-		message rs [] = "Try making some of these repositories available:\n" ++ rs
-		message [] us = "Also these untrusted repositories may contain the file:\n" ++ us
-		message rs us = message rs [] ++ message [] us
+  where
+	filteruuids l x = filter (`notElem` x) l
+	message [] [] = "No other repository is known to contain the file."
+	message rs [] = "Try making some of these repositories available:\n" ++ rs
+	message [] us = "Also these untrusted repositories may contain the file:\n" ++ us
+	message rs us = message rs [] ++ message [] us
 
 showTriedRemotes :: [Remote] -> Annex ()
 showTriedRemotes [] = noop
@@ -242,6 +242,6 @@ logStatus remote key = logChange key (uuid remote)
 {- Orders remotes by cost, with ones with the lowest cost grouped together. -}
 byCost :: [Remote] -> [[Remote]]
 byCost = map snd . sort . M.toList . costmap
-	where
-		costmap = M.fromListWith (++) . map costpair
-		costpair r = (cost r, [r])
+  where
+	costmap = M.fromListWith (++) . map costpair
+	costpair r = (cost r, [r])
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 2249f5b..f5bcc4f 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -26,6 +26,7 @@ import Remote.Helper.Encryptable
 import Crypto
 import Data.ByteString.Lazy.UTF8 (fromString)
 import Data.Digest.Pure.SHA
+import Utility.UserInfo
 
 type BupRepo = String
 
@@ -105,24 +106,24 @@ pipeBup params inh outh = do
 		ExitSuccess -> return True
 		_ -> return False
 
-bupSplitParams :: Git.Repo -> BupRepo -> Key -> CommandParam -> Annex [CommandParam]
+bupSplitParams :: Git.Repo -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam]
 bupSplitParams r buprepo k src = do
 	o <- getRemoteConfig r "bup-split-options" ""
 	let os = map Param $ words o
 	showOutput -- make way for bup output
 	return $ bupParams "split" buprepo 
-		(os ++ [Param "-n", Param (bupRef k), src])
+		(os ++ [Param "-n", Param (bupRef k)] ++ src)
 
 store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store r buprepo k _f _p = do
 	src <- inRepo $ gitAnnexLocation k
-	params <- bupSplitParams r buprepo k (File src)
+	params <- bupSplitParams r buprepo k [File src]
 	liftIO $ boolSystem "bup" params
 
 storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted r buprepo (cipher, enck) k _p = do
 	src <- inRepo $ gitAnnexLocation k
-	params <- bupSplitParams r buprepo enck (Param "-")
+	params <- bupSplitParams r buprepo enck []
 	liftIO $ catchBoolIO $
 		withEncryptedHandle cipher (L.readFile src) $ \h ->
 			pipeBup params (Just h) Nothing
@@ -142,9 +143,9 @@ retrieveEncrypted buprepo (cipher, enck) _ f = liftIO $ catchBoolIO $
 	withHandle StdoutHandle createProcessSuccess p $ \h -> do
 		withDecryptedContent cipher (L.hGetContents h) $ L.writeFile f
 		return True
-	where
-		params = bupParams "join" buprepo [Param $ bupRef enck]
-		p = proc "bup" $ toCommand params
+  where
+	params = bupParams "join" buprepo [Param $ bupRef enck]
+	p = proc "bup" $ toCommand params
 
 remove :: Key -> Annex Bool
 remove _ = do
@@ -163,10 +164,11 @@ checkPresent r bupr k
 		return $ Right ok
 	| otherwise = liftIO $ catchMsgIO $
 		boolSystem "git" $ Git.Command.gitCommandLine params bupr
-	where
-		params = 
-			[ Params "show-ref --quiet --verify"
-			, Param $ "refs/heads/" ++ bupRef k]
+  where
+	params = 
+		[ Params "show-ref --quiet --verify"
+		, Param $ "refs/heads/" ++ bupRef k
+		]
 
 {- Store UUID in the annex.uuid setting of the bup repository. -}
 storeBupUUID :: UUID -> BupRepo -> Annex ()
@@ -184,8 +186,8 @@ storeBupUUID u buprepo = do
 			when (olduuid == "") $
 				Git.Command.run "config"
 					[Param "annex.uuid", Param v] r'
-	where
-		v = fromUUID u
+  where
+	v = fromUUID u
 
 onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a
 onBupRemote r a command params = do
@@ -226,17 +228,17 @@ bup2GitRemote r
 			then Git.Construct.fromAbsPath r
 			else error "please specify an absolute path"
 	| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
-		where
-			bits = split ":" r
-			host = Prelude.head bits
-			dir = join ":" $ drop 1 bits
-			-- "host:~user/dir" is not supported specially by bup;
-			-- "host:dir" is relative to the home directory;
-			-- "host:" goes in ~/.bup
-			slash d
-				| null d = "/~/.bup"
-				| "/" `isPrefixOf` d = d
-				| otherwise = "/~/" ++ d
+  where
+	bits = split ":" r
+	host = Prelude.head bits
+	dir = join ":" $ drop 1 bits
+	-- "host:~user/dir" is not supported specially by bup;
+	-- "host:dir" is relative to the home directory;
+	-- "host:" goes in ~/.bup
+	slash d
+		| null d = "/~/.bup"
+		| "/" `isPrefixOf` d = d
+		| otherwise = "/~/" ++ d
 
 {- Converts a key into a git ref name, which bup-split -n will use to point
  - to it. -}
@@ -244,8 +246,8 @@ bupRef :: Key -> String
 bupRef k
 	| Git.Ref.legal True shown = shown
 	| otherwise = "git-annex-" ++ showDigest (sha256 (fromString shown))
-	where
-		shown = key2file k
+  where
+	shown = key2file k
 
 bupLocal :: BupRepo -> Bool
 bupLocal = notElem ':'
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index bac5318..006638a 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -57,7 +57,6 @@ gen r u c = do
 			readonly = False,
 			remotetype = remote
 		}
-	where
 
 type ChunkSize = Maybe Int64
 
@@ -101,25 +100,25 @@ chunkCount f = f ++ ".chunkcount"
 withCheckedFiles :: (FilePath -> IO Bool) -> ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
 withCheckedFiles _ _ [] _ _ = return False
 withCheckedFiles check Nothing d k a = go $ locations d k
-	where
-		go [] = return False
-		go (f:fs) = ifM (check f) ( a [f] , go fs )
+  where
+	go [] = return False
+	go (f:fs) = ifM (check f) ( a [f] , go fs )
 withCheckedFiles check (Just _) d k a = go $ locations d k
-	where
-		go [] = return False
-		go (f:fs) = do
-			let chunkcount = chunkCount f
-			use <- check chunkcount
-			if use
-				then do
-					count <- readcount chunkcount
-					let chunks = take count $ chunkStream f
-					ifM (all id <$> mapM check chunks)
-						( a chunks , return False )
-				else go fs
-		readcount f = fromMaybe (error $ "cannot parse " ++ f)
-			. (readish :: String -> Maybe Int)
-			<$> readFile f
+  where
+	go [] = return False
+	go (f:fs) = do
+		let chunkcount = chunkCount f
+		ifM (check chunkcount)
+			( do
+				count <- readcount chunkcount
+				let chunks = take count $ chunkStream f
+				ifM (all id <$> mapM check chunks)
+					( a chunks , return False )
+			, go fs
+			)
+	readcount f = fromMaybe (error $ "cannot parse " ++ f)
+		. (readish :: String -> Maybe Int)
+		<$> readFile f
 
 withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
 withStoredFiles = withCheckedFiles doesFileExist
@@ -170,39 +169,39 @@ storeSplit' _ _  _ [] c = return $ reverse c
 storeSplit' meterupdate chunksize (d:dests) bs c = do
 	bs' <- E.bracket (openFile d WriteMode) hClose (feed chunksize bs)
 	storeSplit' meterupdate chunksize dests bs' (d:c)
-	where
-		feed _ [] _ = return []
-		feed sz (l:ls) h = do
-			let s = fromIntegral $ S.length l
-			if s <= sz
-				then do
-					S.hPut h l
-					meterupdate $ toInteger s
-					feed (sz - s) ls h
-				else return (l:ls)
+  where
+	feed _ [] _ = return []
+	feed sz (l:ls) h = do
+		let s = fromIntegral $ S.length l
+		if s <= sz
+			then do
+				S.hPut h l
+				meterupdate $ toInteger s
+				feed (sz - s) ls h
+			else return (l:ls)
 
 {- Write a L.ByteString to a file, updating a progress meter
  - after each chunk of the L.ByteString, typically every 64 kb or so. -}
 meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO ()
 meteredWriteFile meterupdate dest b =
 	meteredWriteFile' meterupdate dest (L.toChunks b) feeder
-	where
-		feeder chunks = return ([], chunks)
+  where
+	feeder chunks = return ([], chunks)
 
 {- Writes a series of S.ByteString chunks to a file, updating a progress
  - meter after each chunk. The feeder is called to get more chunks. -}
 meteredWriteFile' :: MeterUpdate -> FilePath -> s -> (s -> IO (s, [S.ByteString])) -> IO ()
 meteredWriteFile' meterupdate dest startstate feeder =
 	E.bracket (openFile dest WriteMode) hClose (feed startstate [])
-	where
-		feed state [] h = do
-			(state', cs) <- feeder state
-			unless (null cs) $
-				feed state' cs h
-		feed state (c:cs) h = do
-			S.hPut h c
-			meterupdate $ toInteger $ S.length c
-			feed state cs h
+  where
+	feed state [] h = do
+		(state', cs) <- feeder state
+		unless (null cs) $
+			feed state' cs h
+	feed state (c:cs) h = do
+		S.hPut h c
+		meterupdate $ toInteger $ S.length c
+		feed state cs h
 
 {- Generates a list of destinations to write to in order to store a key.
  - When chunksize is specified, this list will be a list of chunks.
@@ -213,36 +212,36 @@ meteredWriteFile' meterupdate dest startstate feeder =
  -}
 storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool
 storeHelper d chunksize key a = prep <&&> check <&&> go
-	where
-		desttemplate = Prelude.head $ locations d key
-		dir = parentDir desttemplate
-		tmpdests = case chunksize of
-			Nothing -> [desttemplate ++ tmpprefix]
-			Just _ -> map (++ tmpprefix) (chunkStream desttemplate)
-		tmpprefix = ".tmp"
-		detmpprefix f = take (length f - tmpprefixlen) f
-		tmpprefixlen = length tmpprefix
-		prep = liftIO $ catchBoolIO $ do
-			createDirectoryIfMissing True dir
-			allowWrite dir
-			return True
-		{- The size is not exactly known when encrypting the key;
-		 - this assumes that at least the size of the key is
-		 - needed as free space. -}
-		check = checkDiskSpace (Just dir) key 0
-		go = liftIO $ catchBoolIO $ do
-			stored <- a tmpdests
-			forM_ stored $ \f -> do
-				let dest = detmpprefix f
-				renameFile f dest
-				preventWrite dest
-			when (chunksize /= Nothing) $ do
-				let chunkcount = chunkCount desttemplate
-				_ <- tryIO $ allowWrite chunkcount
-				writeFile chunkcount (show $ length stored)
-				preventWrite chunkcount
-			preventWrite dir
-			return (not $ null stored)
+  where
+	desttemplate = Prelude.head $ locations d key
+	dir = parentDir desttemplate
+	tmpdests = case chunksize of
+		Nothing -> [desttemplate ++ tmpprefix]
+		Just _ -> map (++ tmpprefix) (chunkStream desttemplate)
+	tmpprefix = ".tmp"
+	detmpprefix f = take (length f - tmpprefixlen) f
+	tmpprefixlen = length tmpprefix
+	prep = liftIO $ catchBoolIO $ do
+		createDirectoryIfMissing True dir
+		allowWrite dir
+		return True
+	{- The size is not exactly known when encrypting the key;
+	 - this assumes that at least the size of the key is
+	 - needed as free space. -}
+	check = checkDiskSpace (Just dir) key 0
+	go = liftIO $ catchBoolIO $ do
+		stored <- a tmpdests
+		forM_ stored $ \f -> do
+			let dest = detmpprefix f
+			renameFile f dest
+			preventWrite dest
+		when (chunksize /= Nothing) $ do
+			let chunkcount = chunkCount desttemplate
+			_ <- tryIO $ allowWrite chunkcount
+			writeFile chunkcount (show $ length stored)
+			preventWrite chunkcount
+		preventWrite dir
+		return (not $ null stored)
 
 retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex Bool
 retrieve d chunksize k _ f = metered Nothing k $ \meterupdate ->
@@ -250,11 +249,11 @@ retrieve d chunksize k _ f = metered Nothing k $ \meterupdate ->
 		catchBoolIO $ do
 			meteredWriteFile' meterupdate f files feeder
 			return True
-	where
-		feeder [] = return ([], [])
-		feeder (x:xs) = do
-			chunks <- L.toChunks <$> L.readFile x
-			return (xs, chunks)
+  where
+	feeder [] = return ([], [])
+	feeder (x:xs) = do
+		chunks <- L.toChunks <$> L.readFile x
+		return (xs, chunks)
 
 retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
 retrieveEncrypted d chunksize (cipher, enck) k f = metered Nothing k $ \meterupdate ->
@@ -267,20 +266,20 @@ retrieveEncrypted d chunksize (cipher, enck) k f = metered Nothing k $ \meterupd
 retrieveCheap :: FilePath -> ChunkSize -> Key -> FilePath -> Annex Bool
 retrieveCheap _ (Just _) _ _ = return False -- no cheap retrieval for chunks
 retrieveCheap d _ k f = liftIO $ withStoredFiles Nothing d k go
-	where
-		go [file] = catchBoolIO $ createSymbolicLink file f >> return True
-		go _files = return False
+  where
+	go [file] = catchBoolIO $ createSymbolicLink file f >> return True
+	go _files = return False
 
 remove :: FilePath -> ChunkSize -> Key -> Annex Bool
 remove d chunksize k = liftIO $ withStoredFiles chunksize d k go
-	where
-		go = all id <$$> mapM removefile
-		removefile file = catchBoolIO $ do
-			let dir = parentDir file
-			allowWrite dir
-			removeFile file
-			_ <- tryIO $ removeDirectory dir
-			return True
+  where
+	go = all id <$$> mapM removefile
+	removefile file = catchBoolIO $ do
+		let dir = parentDir file
+		allowWrite dir
+		removeFile file
+		_ <- tryIO $ removeDirectory dir
+		return True
 
 checkPresent :: FilePath -> ChunkSize -> Key -> Annex (Either String Bool)
 checkPresent d chunksize k = liftIO $ catchMsgIO $ withStoredFiles chunksize d k $
diff --git a/Remote/Git.hs b/Remote/Git.hs
index cc524fd..24dd9bf 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -39,6 +39,7 @@ import Types.Key
 import qualified Fields
 
 import Control.Concurrent
+import Control.Concurrent.MSampleVar
 import System.Process (std_in, std_err)
 
 remote :: RemoteType
@@ -54,15 +55,15 @@ list = do
 	c <- fromRepo Git.config
 	rs <- mapM (tweakurl c) =<< fromRepo Git.remotes
 	mapM configRead rs
-	where
-		annexurl n = "remote." ++ n ++ ".annexurl"
-		tweakurl c r = do
-			let n = fromJust $ Git.remoteName r
-			case M.lookup (annexurl n) c of
-				Nothing -> return r
-				Just url -> inRepo $ \g ->
-					Git.Construct.remoteNamed n $
-						Git.Construct.fromRemoteLocation url g
+  where
+	annexurl n = "remote." ++ n ++ ".annexurl"
+	tweakurl c r = do
+		let n = fromJust $ Git.remoteName r
+		case M.lookup (annexurl n) c of
+			Nothing -> return r
+			Just url -> inRepo $ \g ->
+				Git.Construct.remoteNamed n $
+					Git.Construct.fromRemoteLocation url g
 
 {- It's assumed to be cheap to read the config of non-URL remotes, so this is
  - done each time git-annex is run in a way that uses remotes.
@@ -84,28 +85,27 @@ repoCheap = not . Git.repoIsUrl
 
 gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
 gen r u _ = new <$> remoteCost r defcst
-	where
-		defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
-		new cst = Remote 
-			{ uuid = u
-			, cost = cst
-			, name = Git.repoDescribe r
-			, storeKey = copyToRemote r
-			, retrieveKeyFile = copyFromRemote r
-			, retrieveKeyFileCheap = copyFromRemoteCheap r
-			, removeKey = dropKey r
-			, hasKey = inAnnex r
-			, hasKeyCheap = repoCheap r
-			, whereisKey = Nothing
-			, config = Nothing
-			, localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
-				then Just $ Git.repoPath r
-				else Nothing
-			, repo = r
-			, readonly = Git.repoIsHttp r
-			, remotetype = remote
-			}
-		
+  where
+	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
+	new cst = Remote 
+		{ uuid = u
+		, cost = cst
+		, name = Git.repoDescribe r
+		, storeKey = copyToRemote r
+		, retrieveKeyFile = copyFromRemote r
+		, retrieveKeyFileCheap = copyFromRemoteCheap r
+		, removeKey = dropKey r
+		, hasKey = inAnnex r
+		, hasKeyCheap = repoCheap r
+		, whereisKey = Nothing
+		, config = Nothing
+		, localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
+			then Just $ Git.repoPath r
+			else Nothing
+		, repo = r
+		, readonly = Git.repoIsHttp r
+		, remotetype = remote
+		}
 
 {- Checks relatively inexpensively if a repository is available for use. -}
 repoAvail :: Git.Repo -> Annex Bool
@@ -148,40 +148,40 @@ tryGitConfigRead r
 	| otherwise = store $ safely $ onLocal r $ do 
 		ensureInitialized
 		Annex.getState Annex.repo
-	where
-		-- Reading config can fail due to IO error or
-		-- for other reasons; catch all possible exceptions.
-		safely a = either (const $ return r) return
-				=<< liftIO (try a :: IO (Either SomeException Git.Repo))
+  where
+	-- Reading config can fail due to IO error or
+	-- for other reasons; catch all possible exceptions.
+	safely a = either (const $ return r) return
+			=<< liftIO (try a :: IO (Either SomeException Git.Repo))
 
-		pipedconfig cmd params =
-			withHandle StdoutHandle createProcessSuccess p $
-				Git.Config.hRead r
-			where
-				p = proc cmd $ toCommand params
+	pipedconfig cmd params =
+		withHandle StdoutHandle createProcessSuccess p $
+			Git.Config.hRead r
+	  where
+		p = proc cmd $ toCommand params
 
-		pipedsshconfig cmd params =
-			liftIO (try (pipedconfig cmd params) :: IO (Either SomeException Git.Repo))
+	pipedsshconfig cmd params =
+		liftIO (try (pipedconfig cmd params) :: IO (Either SomeException Git.Repo))
 
-		geturlconfig headers = do
-			s <- Url.get (Git.repoLocation r ++ "/config") headers
-			withTempFile "git-annex.tmp" $ \tmpfile h -> do
-				hPutStr h s
-				hClose h
-				safely $ pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
+	geturlconfig headers = do
+		s <- Url.get (Git.repoLocation r ++ "/config") headers
+		withTempFile "git-annex.tmp" $ \tmpfile h -> do
+			hPutStr h s
+			hClose h
+			safely $ pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
 
-		store = observe $ \r' -> do
-			g <- gitRepo
-			let l = Git.remotes g
-			let g' = g { Git.remotes = exchange l r' }
-			Annex.changeState $ \s -> s { Annex.repo = g' }
+	store = observe $ \r' -> do
+		g <- gitRepo
+		let l = Git.remotes g
+		let g' = g { Git.remotes = exchange l r' }
+		Annex.changeState $ \s -> s { Annex.repo = g' }
 
-		exchange [] _ = []
-		exchange (old:ls) new
-			| Git.remoteName old == Git.remoteName new =
-				new : exchange ls new
-			| otherwise =
-				old : exchange ls new
+	exchange [] _ = []
+	exchange (old:ls) new
+		| Git.remoteName old == Git.remoteName new =
+			new : exchange ls new
+		| otherwise =
+			old : exchange ls new
 
 {- Checks if a given remote has the content for a key inAnnex.
  - If the remote cannot be accessed, or if it cannot determine
@@ -192,32 +192,32 @@ inAnnex r key
 	| Git.repoIsHttp r = checkhttp =<< getHttpHeaders
 	| Git.repoIsUrl r = checkremote
 	| otherwise = checklocal
-	where
-		checkhttp headers = liftIO $ go undefined $ keyUrls r key
-			where
-				go e [] = return $ Left e
-				go _ (u:us) = do
-					res <- catchMsgIO $
-						Url.check u headers (keySize key)
-					case res of
-						Left e -> go e us
-						v -> return v
-		checkremote = do
-			showAction $ "checking " ++ Git.repoDescribe r
-			onRemote r (check, unknown) "inannex" [Param (key2file key)] []
-			where
-				check c p = dispatch <$> safeSystem c p
-				dispatch ExitSuccess = Right True
-				dispatch (ExitFailure 1) = Right False
-				dispatch _ = unknown
-		checklocal = guardUsable r unknown $ dispatch <$> check
-			where
-				check = liftIO $ catchMsgIO $ onLocal r $
-					Annex.Content.inAnnexSafe key
-				dispatch (Left e) = Left e
-				dispatch (Right (Just b)) = Right b
-				dispatch (Right Nothing) = unknown
-		unknown = Left $ "unable to check " ++ Git.repoDescribe r
+  where
+	checkhttp headers = liftIO $ go undefined $ keyUrls r key
+	  where
+		go e [] = return $ Left e
+		go _ (u:us) = do
+			res <- catchMsgIO $
+				Url.check u headers (keySize key)
+			case res of
+				Left e -> go e us
+				v -> return v
+	checkremote = do
+		showAction $ "checking " ++ Git.repoDescribe r
+		onRemote r (check, unknown) "inannex" [Param (key2file key)] []
+	  where
+		check c p = dispatch <$> safeSystem c p
+		dispatch ExitSuccess = Right True
+		dispatch (ExitFailure 1) = Right False
+		dispatch _ = unknown
+	checklocal = guardUsable r unknown $ dispatch <$> check
+	  where
+		check = liftIO $ catchMsgIO $ onLocal r $
+			Annex.Content.inAnnexSafe key
+		dispatch (Left e) = Left e
+		dispatch (Right (Just b)) = Right b
+		dispatch (Right Nothing) = unknown
+	unknown = Left $ "unable to check " ++ Git.repoDescribe r
 
 {- Runs an action on a local repository inexpensively, by making an annex
  - monad using that repository. -}
@@ -232,8 +232,8 @@ onLocal r a = do
 
 keyUrls :: Git.Repo -> Key -> [String]
 keyUrls r key = map tourl (annexLocations key)
-	where
-		tourl l = Git.repoLocation r ++ "/" ++ l
+  where
+	tourl l = Git.repoLocation r ++ "/" ++ l
 
 dropKey :: Git.Repo -> Key -> Annex Bool
 dropKey r key
@@ -270,44 +270,44 @@ copyFromRemote r key file dest
 			=<< rsyncParamsRemote r True key dest file
 	| Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) dest
 	| otherwise = error "copying from non-ssh, non-http repo not supported"
-	where
-		{- Feed local rsync's progress info back to the remote,
-		 - by forking a feeder thread that runs
-		 - git-annex-shell transferinfo at the same time
-		 - git-annex-shell sendkey is running.
-		 -
-		 - Note that it actually waits for rsync to indicate
-		 - progress before starting transferinfo, in order
-		 - to ensure ssh connection caching works and reuses 
-		 - the connection set up for the sendkey.
-		 -
-		 - Also note that older git-annex-shell does not support
-		 - transferinfo, so stderr is dropped and failure ignored.
-		 -}
-		feedprogressback a = do
-			u <- getUUID
-			let fields = (Fields.remoteUUID, fromUUID u)
-				: maybe [] (\f -> [(Fields.associatedFile, f)]) file
-			Just (cmd, params) <- git_annex_shell r "transferinfo" 
-				[Param $ key2file key] fields
-			v <- liftIO $ newEmptySampleVar
-			tid <- liftIO $ forkIO $ void $ tryIO $ do
-				bytes <- readSampleVar v
-				p <- createProcess $
-					 (proc cmd (toCommand params))
-						{ std_in = CreatePipe
-						, std_err = CreatePipe
-						}
-				hClose $ stderrHandle p
-				let h = stdinHandle p
-				let send b = do
-					hPutStrLn h $ show b
-					hFlush h
-				send bytes
-				forever $
-					send =<< readSampleVar v
-			let feeder = writeSampleVar v
-			bracketIO noop (const $ tryIO $ killThread tid) (a feeder)
+  where
+	{- Feed local rsync's progress info back to the remote,
+	 - by forking a feeder thread that runs
+	 - git-annex-shell transferinfo at the same time
+	 - git-annex-shell sendkey is running.
+	 -
+	 - Note that it actually waits for rsync to indicate
+	 - progress before starting transferinfo, in order
+	 - to ensure ssh connection caching works and reuses 
+	 - the connection set up for the sendkey.
+	 -
+	 - Also note that older git-annex-shell does not support
+	 - transferinfo, so stderr is dropped and failure ignored.
+	 -}
+	feedprogressback a = do
+		u <- getUUID
+		let fields = (Fields.remoteUUID, fromUUID u)
+			: maybe [] (\f -> [(Fields.associatedFile, f)]) file
+		Just (cmd, params) <- git_annex_shell r "transferinfo" 
+			[Param $ key2file key] fields
+		v <- liftIO $ newEmptySV
+		tid <- liftIO $ forkIO $ void $ tryIO $ do
+			bytes <- readSV v
+			p <- createProcess $
+				 (proc cmd (toCommand params))
+					{ std_in = CreatePipe
+					, std_err = CreatePipe
+					}
+			hClose $ stderrHandle p
+			let h = stdinHandle p
+			let send b = do
+				hPutStrLn h $ show b
+				hFlush h
+			send bytes
+			forever $
+				send =<< readSV v
+		let feeder = writeSV v
+		bracketIO noop (const $ tryIO $ killThread tid) (a feeder)
 
 copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool
 copyFromRemoteCheap r key file
@@ -358,26 +358,26 @@ rsyncHelper callback params = do
 rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool
 rsyncOrCopyFile rsyncparams src dest p =
 	ifM (sameDeviceIds src dest) (docopy, dorsync)
-	where
-		sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b)
-		getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
-		dorsync = rsyncHelper (Just p) $
-			rsyncparams ++ [Param src, Param dest]
-		docopy = liftIO $ bracket
-			(forkIO $ watchfilesize 0)
-			(void . tryIO . killThread)
-			(const $ copyFileExternal src dest)
-		watchfilesize oldsz = do
-			threadDelay 500000 -- 0.5 seconds
-			v <- catchMaybeIO $
-				fromIntegral . fileSize
-					<$> getFileStatus dest
-			case v of
-				Just sz
-					| sz /= oldsz -> do
-						p sz
-						watchfilesize sz
-				_ -> watchfilesize oldsz
+  where
+	sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b)
+	getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
+	dorsync = rsyncHelper (Just p) $
+		rsyncparams ++ [Param src, Param dest]
+	docopy = liftIO $ bracket
+		(forkIO $ watchfilesize 0)
+		(void . tryIO . killThread)
+		(const $ copyFileExternal src dest)
+	watchfilesize oldsz = do
+		threadDelay 500000 -- 0.5 seconds
+		v <- catchMaybeIO $
+			fromIntegral . fileSize
+				<$> getFileStatus dest
+		case v of
+			Just sz
+				| sz /= oldsz -> do
+					p sz
+					watchfilesize sz
+			_ -> watchfilesize oldsz
 
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}
@@ -396,42 +396,43 @@ rsyncParamsRemote r sending key file afile = do
 	if sending
 		then return $ o ++ rsyncopts eparam dummy (File file)
 		else return $ o ++ rsyncopts eparam (File file) dummy
-	where
-		rsyncopts ps source dest
-			| end ps == [dashdash] = ps ++ [source, dest]
-			| otherwise = ps ++ [dashdash, source, dest]
-		dashdash = Param "--"
-		-- The rsync shell parameter controls where rsync
-		-- goes, so the source/dest parameter can be a dummy value,
-		-- that just enables remote rsync mode.
-		-- For maximum compatability with some patched rsyncs,
-		-- the dummy value needs to still contain a hostname,
-		-- even though this hostname will never be used.
-		dummy = Param "dummy:"
+  where
+	rsyncopts ps source dest
+		| end ps == [dashdash] = ps ++ [source, dest]
+		| otherwise = ps ++ [dashdash, source, dest]
+	dashdash = Param "--"
+	{- The rsync shell parameter controls where rsync
+	 - goes, so the source/dest parameter can be a dummy value,
+	 - that just enables remote rsync mode.
+	 - For maximum compatability with some patched rsyncs,
+	 - the dummy value needs to still contain a hostname,
+	 - even though this hostname will never be used. -}
+	dummy = Param "dummy:"
 
 rsyncParams :: Git.Repo -> Annex [CommandParam]
 rsyncParams r = do
 	o <- getRemoteConfig r "rsync-options" ""
 	return $ options ++ map Param (words o)
-	where
- 		-- --inplace to resume partial files
-		options = [Params "-p --progress --inplace"]
+  where
+ 	-- --inplace to resume partial files
+	options = [Params "-p --progress --inplace"]
 
 commitOnCleanup :: Git.Repo -> Annex a -> Annex a
 commitOnCleanup r a = go `after` a
-	where
-		go = Annex.addCleanup (Git.repoLocation r) cleanup
-		cleanup
-			| not $ Git.repoIsUrl r = liftIO $ onLocal r $
-				doQuietSideAction $
-					Annex.Branch.commit "update"
-			| otherwise = void $ do
-				Just (shellcmd, shellparams) <-
-					git_annex_shell r "commit" [] []
-				-- Throw away stderr, since the remote may not
-				-- have a new enough git-annex shell to
-				-- support committing.
-				let cmd = shellcmd ++ " "
-					++ unwords (map shellEscape $ toCommand shellparams)
-					++ ">/dev/null 2>/dev/null"
-				liftIO $ boolSystem "sh" [Param "-c", Param cmd]
+  where
+	go = Annex.addCleanup (Git.repoLocation r) cleanup
+	cleanup
+		| not $ Git.repoIsUrl r = liftIO $ onLocal r $
+			doQuietSideAction $
+				Annex.Branch.commit "update"
+		| otherwise = void $ do
+			Just (shellcmd, shellparams) <-
+				git_annex_shell r "commit" [] []
+			
+			-- Throw away stderr, since the remote may not
+			-- have a new enough git-annex shell to
+			-- support committing.
+			liftIO $ catchMaybeIO $ do
+				withQuietOutput createProcessSuccess $
+					proc shellcmd $
+						toCommand shellparams
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 8ed2fed..12c7d37 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -32,12 +32,12 @@ encryptionSetup c = case (M.lookup "encryption" c, extractCipher c) of
 	(Just "shared", Nothing) -> use "encryption setup" $ genSharedCipher
 	(Just keyid, Nothing) -> use "encryption setup" $ genEncryptedCipher keyid
 	(Just keyid, Just v) -> use "encryption updated" $ updateEncryptedCipher keyid v
-	where
-		cannotchange = error "Cannot change encryption type of existing remote."
-		use m a = do
-			cipher <- liftIO a
-			showNote $ m ++ " " ++ describeCipher cipher
-			return $ M.delete "encryption" $ storeCipher c cipher
+  where
+	cannotchange = error "Cannot change encryption type of existing remote."
+	use m a = do
+		cipher <- liftIO a
+		showNote $ m ++ " " ++ describeCipher cipher
+		return $ M.delete "encryption" $ storeCipher c cipher
 
 {- Modifies a Remote to support encryption.
  -
@@ -58,35 +58,35 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
 		hasKey = withkey $ hasKey r,
 		cost = cost r + encryptedRemoteCostAdj
 	}
-	where
-		store k f p = cip k >>= maybe
-			(storeKey r k f p)
-			(\enck -> storeKeyEncrypted enck k p)
-		retrieve k f d = cip k >>= maybe
-			(retrieveKeyFile r k f d)
-			(\enck -> retrieveKeyFileEncrypted enck k d)
-		retrieveCheap k d = cip k >>= maybe
-			(retrieveKeyFileCheap r k d)
-			(\_ -> return False)
-		withkey a k = cip k >>= maybe (a k) (a . snd)
-		cip = cipherKey c
+  where
+	store k f p = cip k >>= maybe
+		(storeKey r k f p)
+		(\enck -> storeKeyEncrypted enck k p)
+	retrieve k f d = cip k >>= maybe
+		(retrieveKeyFile r k f d)
+		(\enck -> retrieveKeyFileEncrypted enck k d)
+	retrieveCheap k d = cip k >>= maybe
+		(retrieveKeyFileCheap r k d)
+		(\_ -> return False)
+	withkey a k = cip k >>= maybe (a k) (a . snd)
+	cip = cipherKey c
 
 {- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
  - state. -}
 remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
 remoteCipher c = go $ extractCipher c
-	where
-		go Nothing = return Nothing
-		go (Just encipher) = do
-			cache <- Annex.getState Annex.ciphers
-			case M.lookup encipher cache of
-				Just cipher -> return