tagging package git-annex version 5.20140320

-----BEGIN PGP SIGNATURE-----
 Version: GnuPG v1
 
 iQIVAwUAUytJN8kQ2SIlEuPHAQgcEA//X5MJTU5DXbnTV9Yrqg9zf3WUF9dTeKnb
 fxpUzHd20pjVhH8oqAmwTPpMHViNQax3CBhR2qd/T41eHZA0jljxefihWYd7e+2m
 3KFxTc//9/5BI2cNjr+3cOikairVRK1jjCts0+rWF6YBjK0IRjxCN56ij9hg4B0a
 11J/qu5GelB3VvyMUzyZqheapmP0MKAtIlcIXL0tr695dR2Ar4etvrkX/VFgtuSQ
 2Nir6emXsoxrhl4Ph1WtwC9+mdJi85n2IbZ4l14l5n+sAc1Lmkp+r6RZJp8Efkef
 LN6OsYHV2pqyKUZiZ9y3RgBzd838R7ocpOggsA14RtMslxAYxP5jZP9QwUvSWAqk
 t2gibt6p3sJms1cvASHpOtegnz6d7+LK6pNqIl5XgjugofHlT+XHUEvrzyP/Lan4
 RZK8wUIfJRX+VBju4tCZ+Q/5Br9VM/ZF80DIps0WIYOzLR5b1po8YTTWMskwkiii
 g5UjNw4NVfi9X7N+SjArwzmtpijctAeQj2QkBlb+kaPL+dxx33EDcRegw7KZ+/4Q
 ViyOhwl21Lb5Nzj8n6t/8g5GKRNJBmlOsa/K80vTOraRgukt4QejliFPswK7Z/6b
 DjfItpny+qqwuufa0hWW/U9VgTQfbewEsCt8QdpQHIUpjO+KvGHjOpal/zjnGemy
 qpFXO5EiwOo=
 =AwJK
 -----END PGP SIGNATURE-----

Merge tag '5.20140320' into debian-wheezy-backport

tagging package git-annex version 5.20140320

Conflicts:
	Assistant/Threads/WebApp.hs
	Utility/WebApp.hs
	git-annex.cabal

Annex.hs

@@ -60,6 +60,7 @@ import Types.FileMatcher
 import Types.NumCopies
 import Types.LockPool
 import Types.MetaData
+import Types.CleanupActions
 import qualified Utility.Matcher
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -88,6 +89,7 @@ data AnnexState = AnnexState
 	, gitconfig :: GitConfig
 	, backends :: [BackendA Annex]
 	, remotes :: [Types.Remote.RemoteA Annex]
+	, remoteannexstate :: M.Map UUID AnnexState
 	, output :: MessageState
 	, force :: Bool
 	, fast :: Bool
@@ -113,7 +115,7 @@ data AnnexState = AnnexState
 	, flags :: M.Map String Bool
 	, fields :: M.Map String String
 	, modmeta :: [ModMeta]
-	, cleanup :: M.Map String (Annex ())
+	, cleanup :: M.Map CleanupAction (Annex ())
 	, inodeschanged :: Maybe Bool
 	, useragent :: Maybe String
 	, errcounter :: Integer
@@ -128,6 +130,7 @@ newState c r = AnnexState
 	, gitconfig = c
 	, backends = []
 	, remotes = []
+	, remoteannexstate = M.empty
 	, output = defaultMessageState
 	, force = False
 	, fast = False
@@ -208,9 +211,9 @@ setField field value = changeState $ \s ->
 	s { fields = M.insertWith' const field value $ fields s }
 
 {- Adds a cleanup action to perform. -}
-addCleanup :: String -> Annex () -> Annex ()
+addCleanup :: CleanupAction -> Annex () -> Annex ()
-addCleanup uid a = changeState $ \s ->
+addCleanup k a = changeState $ \s ->
-	s { cleanup = M.insertWith' const uid a $ cleanup s }
+	s { cleanup = M.insertWith' const k a $ cleanup s }
 
 {- Sets the type of output to emit. -}
 setOutput :: OutputType -> Annex ()

Annex/CatFile.hs

@@ -80,7 +80,7 @@ catKey = catKey' True
 catKey' :: Bool -> Ref -> FileMode -> Annex (Maybe Key)
 catKey' modeguaranteed ref mode
 	| isSymLink mode = do
-		l <- fromInternalGitPath . encodeW8 . L.unpack <$> get
+		l <- fromInternalGitPath . decodeBS <$> get
 		return $ if isLinkToAnnex l
 			then fileKey $ takeFileName l
 			else Nothing

Annex/Content.hs

@@ -24,6 +24,7 @@ module Annex.Content (
 	removeAnnex,
 	fromAnnex,
 	moveBad,
+	KeyLocation(..),
 	getKeysPresent,
 	saveState,
 	downloadUrl,
@@ -466,22 +467,33 @@ moveBad key = do
 	logStatus key InfoMissing
 	return dest
 
-{- List of keys whose content exists in the annex. -}
+data KeyLocation = InAnnex | InRepository
-getKeysPresent :: Annex [Key]
+
-getKeysPresent = do
+{- List of keys whose content exists in the specified location.
+ 
+ - InAnnex only lists keys under .git/annex/objects,
+ - while InRepository, in direct mode, also finds keys located in the
+ - work tree.
+ -
+ - Note that InRepository has to check whether direct mode files
+ - have goodContent.
+ -}
+getKeysPresent :: KeyLocation -> Annex [Key]
+getKeysPresent keyloc = do
 	direct <- isDirect
 	dir <- fromRepo gitAnnexObjectDir
-	liftIO $ traverse direct (2 :: Int) dir
+	s <- getstate direct
+	liftIO $ traverse s direct (2 :: Int) dir
   where
-	traverse direct depth dir = do
+	traverse s direct depth dir = do
 		contents <- catchDefaultIO [] (dirContents dir)
 		if depth == 0
 			then do
-				contents' <- filterM (present direct) contents
+				contents' <- filterM (present s direct) contents
 				let keys = mapMaybe (fileKey . takeFileName) contents'
 				continue keys []
 			else do
-				let deeper = traverse direct (depth - 1)
+				let deeper = traverse s direct (depth - 1)
 				continue [] (map deeper contents)
 	continue keys [] = return keys
 	continue keys (a:as) = do
@@ -489,15 +501,31 @@ getKeysPresent = do
 		morekeys <- unsafeInterleaveIO a
 		continue (morekeys++keys) as
 
-	{- In indirect mode, look for the key. In direct mode,
+	present _ False d = presentInAnnex d
-	 - the inode cache file is only present when a key's content
+	present s True d = presentDirect s d <||> presentInAnnex d
-	 - is present, so can be used as a surrogate if the content
+
-	 - is not located in the annex directory. -}
+	presentInAnnex = doesFileExist . contentfile
-	present False d = doesFileExist $ contentfile d
-	present True d = doesFileExist (contentfile d ++ ".cache")
-		<||> present False d
 	contentfile d = d </> takeFileName d
 
+	presentDirect s d = case keyloc of
+		InAnnex -> return False
+		InRepository -> case fileKey (takeFileName d) of
+			Nothing -> return False
+			Just k -> Annex.eval s $ 
+				anyM (goodContent k) =<< associatedFiles k
+
+	{- In order to run Annex monad actions within unsafeInterleaveIO,
+	 - the current state is taken and reused. No changes made to this
+	 - state will be preserved. 
+	 -
+	 - As an optimsation, call inodesChanged to prime the state with
+	 - a cached value that will be used in the call to goodContent.
+	 -}
+	getstate direct = do
+		when direct $
+			void $ inodesChanged
+		Annex.getState id
+
 {- Things to do to record changes to content when shutting down.
  -
  - It's acceptable to avoid committing changes to the branch,

Annex/FileMatcher.hs

@@ -56,23 +56,27 @@ parsedToMatcher parsed = case partitionEithers parsed of
 	([], vs) -> Right $ generate vs
 	(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es
 
-exprParser :: GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)]
+exprParser :: FileMatcher -> FileMatcher -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)]
-exprParser groupmap configmap mu expr =
+exprParser matchstandard matchgroupwanted groupmap configmap mu expr =
 	map parse $ tokenizeMatcher expr
   where
-	parse = parseToken 
+	parse = parseToken
+		matchstandard
+		matchgroupwanted
 		(limitPresent mu)
 		(limitInDir preferreddir)
 		groupmap
 	preferreddir = fromMaybe "public" $
 		M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
 
-parseToken :: MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
+parseToken :: FileMatcher -> FileMatcher -> MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
-parseToken checkpresent checkpreferreddir groupmap t
+parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupmap t
 	| t `elem` tokens = Right $ token t
+	| t == "standard" = call matchstandard
+	| t == "groupwanted" = call matchgroupwanted
 	| t == "present" = use checkpresent
 	| t == "inpreferreddir" = use checkpreferreddir
-	| t == "unused" = Right (Operation limitUnused)
+	| t == "unused" = Right $ Operation limitUnused
 	| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k $
 		M.fromList
 			[ ("include", limitInclude)
@@ -89,6 +93,8 @@ parseToken checkpresent checkpreferreddir groupmap t
   where
 	(k, v) = separate (== '=') t
 	use a = Operation <$> a v
+	call sub = Right $ Operation $ \notpresent mi ->
+		matchMrun sub $ \a -> a notpresent mi
 
 {- This is really dumb tokenization; there's no support for quoted values.
  - Open and close parens are always treated as standalone tokens;
@@ -109,5 +115,5 @@ largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
 		rc <- readRemoteLog
 		u <- getUUID
 		either badexpr return $
-			parsedToMatcher $ exprParser gm rc (Just u) expr
+			parsedToMatcher $ exprParser matchAll matchAll gm rc (Just u) expr
 	badexpr e = error $ "bad annex.largefiles configuration: " ++ e

Annex/Init.hs

@@ -198,7 +198,7 @@ enableDirectMode = unlessM isDirect $ do
  -}
 fixBadBare :: Annex ()
 fixBadBare = whenM checkBadBare $ do
-	ks <- getKeysPresent
+	ks <- getKeysPresent InAnnex
 	liftIO $ debugM "Init" $ unwords
 		[ "Detected bad bare repository with"
 		, show (length ks)

Annex/MetaData.hs

@@ -5,11 +5,15 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Annex.MetaData where
+module Annex.MetaData (
+	genMetaData,
+	module X
+) where
 
 import Common.Annex
 import qualified Annex
-import Types.MetaData
+import Types.MetaData as X
+import Annex.MetaData.StandardFields as X
 import Logs.MetaData
 import Annex.CatFile
 
@@ -19,15 +23,6 @@ import Data.Time.Calendar
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 
-tagMetaField :: MetaField
-tagMetaField = mkMetaFieldUnchecked "tag"
-
-yearMetaField :: MetaField
-yearMetaField = mkMetaFieldUnchecked "year"
-
-monthMetaField :: MetaField
-monthMetaField = mkMetaFieldUnchecked "month"
-
 {- Adds metadata for a file that has just been ingested into the
  - annex, but has not yet been committed to git.
  -

Annex/MetaData/StandardFields.hs

@@ -0,0 +1,47 @@
+{- git-annex metadata, standard fields
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.MetaData.StandardFields (
+	tagMetaField,
+	yearMetaField,
+	monthMetaField,
+	lastChangedField,
+	mkLastChangedField,
+	isLastChangedField
+) where
+
+import Types.MetaData
+
+import Data.List
+
+tagMetaField :: MetaField
+tagMetaField = mkMetaFieldUnchecked "tag"
+
+yearMetaField :: MetaField
+yearMetaField = mkMetaFieldUnchecked "year"
+
+monthMetaField :: MetaField
+monthMetaField = mkMetaFieldUnchecked "month"
+
+lastChangedField :: MetaField
+lastChangedField = mkMetaFieldUnchecked lastchanged
+
+mkLastChangedField :: MetaField -> MetaField
+mkLastChangedField f = mkMetaFieldUnchecked (fromMetaField f ++ lastchangedSuffix)
+
+isLastChangedField :: MetaField -> Bool
+isLastChangedField f
+	| f == lastChangedField = True
+	| otherwise = lastchanged `isSuffixOf` s && s /= lastchangedSuffix
+  where
+	s = fromMetaField f
+
+lastchanged :: String
+lastchanged = "lastchanged"
+
+lastchangedSuffix :: String
+lastchangedSuffix = "-lastchanged"

Annex/Ssh.hs

@@ -9,7 +9,6 @@
 
 module Annex.Ssh (
 	sshCachingOptions,
-	sshCleanup,
 	sshCacheDir,
 	sshReadPort,
 ) where
@@ -24,6 +23,7 @@ import qualified Build.SysConfig as SysConfig
 import qualified Annex
 import Config
 import Utility.Env
+import Types.CleanupActions
 #ifndef mingw32_HOST_OS
 import Annex.Perms
 #endif
@@ -31,7 +31,9 @@ import Annex.Perms
 {- Generates parameters to ssh to a given host (or user@host) on a given
  - port, with connection caching. -}
 sshCachingOptions :: (String, Maybe Integer) -> [CommandParam] -> Annex [CommandParam]
-sshCachingOptions (host, port) opts = go =<< sshInfo (host, port)
+sshCachingOptions (host, port) opts = do
+	Annex.addCleanup SshCachingCleanup sshCleanup
+	go =<< sshInfo (host, port)
   where
 	go (Nothing, params) = ret params
 	go (Just socketfile, params) = do
@@ -144,8 +146,9 @@ sshCleanup = go =<< sshCacheDir
 			withQuietOutput createProcessSuccess $
 				(proc "ssh" $ toCommand $
 					[ Params "-O stop"
-					] ++ params ++ [Param "any"])
+					] ++ params ++ [Param "localhost"])
 					{ cwd = Just dir }
+		liftIO $ nukeFile socketfile
 		-- Cannot remove the lock file; other processes may
 		-- be waiting on our exclusive lock to use it.
 

Assistant.hs

@@ -45,7 +45,6 @@ import Assistant.Threads.XMPPClient
 import Assistant.Threads.XMPPPusher
 #endif
 #else
-#warning Building without the webapp. You probably need to install Yesod..
 import Assistant.Types.UrlRenderer
 #endif
 import qualified Utility.Daemon

Assistant/Alert/Utility.hs

@@ -14,6 +14,7 @@ import Utility.Tense
 import qualified Data.Text as T
 import Data.Text (Text)
 import qualified Data.Map as M
+import Data.Monoid
 
 {- This is as many alerts as it makes sense to display at a time.
  - A display might be smaller, or larger, the point is to not overwhelm the
@@ -43,8 +44,8 @@ compareAlertPairs
 	(aid, Alert { alertClass = aclass, alertPriority = aprio })
 	(bid, Alert { alertClass = bclass, alertPriority = bprio })
 	 = compare aprio bprio
-		`thenOrd` compare aid bid
+		`mappend` compare aid bid
-			`thenOrd` compare aclass bclass
+			`mappend` compare aclass bclass
 
 sortAlertPairs :: [AlertPair] -> [AlertPair]
 sortAlertPairs = sortBy compareAlertPairs

Assistant/Install/Menu.hs

@@ -21,7 +21,7 @@ installMenu command menufile iconsrcdir icondir = do
 	writeDesktopMenuFile (fdoDesktopMenu command) menufile
 	installIcon (iconsrcdir </> "logo.svg") $
 		iconFilePath (iconBaseName ++ ".svg") "scalable" icondir
-	installIcon (iconsrcdir </> "favicon.png") $
+	installIcon (iconsrcdir </> "logo_16x16.png") $
 		iconFilePath (iconBaseName ++ ".png") "16x16" icondir
 #endif
 

Assistant/Threads/WebApp.hs

@@ -73,7 +73,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
 #endif
 	webapp <- WebApp
 		<$> pure assistantdata
-		<*> (pack <$> genRandomToken)
+		<*> genAuthToken
 		<*> getreldir
 		<*> pure staticRoutes
 		<*> pure postfirstrun
@@ -125,7 +125,7 @@ myUrl tlssettings webapp addr = unpack $ yesodRender webapp urlbase DashboardR [
 
 getTlsSettings :: Annex (Maybe TLS.TLSSettings)
 getTlsSettings = do
-#ifdef WITH_WEBAPP_HTTPS
+#ifdef WITH_WEBAPP_SECURE
 	cert <- fromRepo gitAnnexWebCertificate
 	privkey <- fromRepo gitAnnexWebPrivKey
 	ifM (liftIO $ allM doesFileExist [cert, privkey])

Assistant/WebApp.hs

@@ -14,6 +14,7 @@ import Assistant.WebApp.Types
 import Assistant.Common
 import Utility.NotificationBroadcaster
 import Utility.Yesod
+import Utility.WebApp
 
 import Data.Text (Text)
 import Control.Concurrent
@@ -36,7 +37,7 @@ newNotifier getbroadcaster = liftAssistant $ do
 webAppFormAuthToken :: Widget
 webAppFormAuthToken = do
 	webapp <- liftH getYesod
-	[whamlet|<input type="hidden" name="auth" value="#{secretToken webapp}">|]
+	[whamlet|<input type="hidden" name="auth" value="#{fromAuthToken (authToken webapp)}">|]
 
 {- A button with an icon, and maybe label or tooltip, that can be
  - clicked to perform some action.

Assistant/WebApp/Notifications.hs

@@ -22,6 +22,7 @@ import Assistant.DaemonStatus
 import Assistant.Types.Buddies
 import Utility.NotificationBroadcaster
 import Utility.Yesod
+import Utility.WebApp
 
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -64,7 +65,7 @@ notifierUrl route broadcaster = do
 		[ "/"
 		, T.intercalate "/" urlbits
 		, "?auth="
-		, secretToken webapp
+		, fromAuthToken (authToken webapp)
 		]
 
 getNotifierTransfersR :: Handler RepPlain

Assistant/WebApp/RepoList.hs

@@ -31,6 +31,7 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Function
+import Control.Concurrent
 
 type RepoList = [(RepoDesc, RepoId, Actions)]
 
@@ -238,3 +239,15 @@ reorderCosts remote rs = zip rs'' (insertCostAfter costs i)
 	costs = map Remote.cost rs'
 	rs'' = (\(x, y) -> x ++ [remote] ++ y) $ splitAt (i + 1) rs'
 
+getSyncNowRepositoryR :: UUID -> Handler ()
+getSyncNowRepositoryR uuid = do
+	u <- liftAnnex getUUID
+	if u == uuid
+		then do
+			thread <- liftAssistant $ asIO $
+				reconnectRemotes True
+					=<< (syncRemotes <$> getDaemonStatus)
+			void $ liftIO $ forkIO thread
+		else maybe noop (liftAssistant . syncRemote)
+			=<< liftAnnex (Remote.remoteFromUUID uuid)
+	redirectBack

Assistant/WebApp/Types.hs

@@ -41,7 +41,7 @@ mkYesodData "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
 
 data WebApp = WebApp
 	{ assistantData :: AssistantData
-	, secretToken :: Text
+	, authToken :: AuthToken
 	, relDir :: Maybe FilePath
 	, getStatic :: Static
 	, postFirstRun :: Maybe (IO String)
@@ -52,11 +52,11 @@ data WebApp = WebApp
 
 instance Yesod WebApp where
 	{- Require an auth token be set when accessing any (non-static) route -}
-	isAuthorized _ _ = checkAuthToken secretToken
+	isAuthorized _ _ = checkAuthToken authToken
 
 	{- Add the auth token to every url generated, except static subsite
 	 - urls (which can show up in Permission Denied pages). -}
-	joinPath = insertAuthToken secretToken excludeStatic
+	joinPath = insertAuthToken authToken excludeStatic
 	  where
 		excludeStatic [] = True
 		excludeStatic (p:_) = p /= "static"

Assistant/WebApp/routes

@@ -82,6 +82,7 @@
 
 /config/repository/reorder RepositoriesReorderR GET
 
+/config/repository/syncnow/#UUID SyncNowRepositoryR GET
 /config/repository/disable/#UUID DisableRepositoryR GET
 
 /config/repository/delete/confirm/#UUID DeleteRepositoryR GET

Build/Configure.hs

@@ -3,20 +3,14 @@
 module Build.Configure where
 
 import System.Directory
-import Data.List
-import System.Process
 import Control.Applicative
-import System.FilePath
 import System.Environment (getArgs)
-import Data.Maybe
 import Control.Monad.IfElse
 import Control.Monad
-import Data.Char
 
 import Build.TestConfig
 import Build.Version
 import Utility.SafeCommand
-import Utility.Monad
 import Utility.ExternalSHA
 import Utility.Env
 import qualified Git.Version

Build/DesktopFile.hs

@@ -24,9 +24,7 @@ import System.Directory
 import System.Environment
 #ifndef mingw32_HOST_OS
 import System.Posix.User
-import System.Posix.Files
 #endif
-import System.FilePath
 import Data.Maybe
 
 systemwideInstall :: IO Bool

Build/NullSoftInstaller.hs

@@ -67,7 +67,7 @@ uninstaller :: FilePath
 uninstaller = "git-annex-uninstall.exe"
 
 gitInstallDir :: Exp FilePath
-gitInstallDir = fromString "$PROGRAMFILES\\Git\\cmd"
+gitInstallDir = fromString "$PROGRAMFILES\\Git\\bin"
 
 startMenuItem :: Exp FilePath
 startMenuItem = "$SMPROGRAMS/git-annex.lnk"

Build/TestConfig.hs

@@ -7,8 +7,6 @@ import Utility.Monad
 import Utility.SafeCommand
 
 import System.IO
-import System.Cmd
-import System.Exit
 import System.FilePath
 import System.Directory
 

BuildFlags.hs

@@ -14,24 +14,36 @@ buildFlags = filter (not . null)
 	[ ""
 #ifdef WITH_ASSISTANT
 	, "Assistant"
+#else
+#warning Building without the assistant.
 #endif
 #ifdef WITH_WEBAPP
 	, "Webapp"
+#else
+#warning Building without the webapp. You probably need to install Yesod..
 #endif
-#ifdef WITH_WEBAPP_HTTPS
+#ifdef WITH_WEBAPP_SECURE
-	, "Webapp-https"
+	, "Webapp-secure"
 #endif
 #ifdef WITH_PAIRING
 	, "Pairing"
+#else
+#warning Building without local pairing.
 #endif
 #ifdef WITH_TESTSUITE
 	, "Testsuite"
+#else
+#warning Building without the testsuite.
 #endif
 #ifdef WITH_S3
 	, "S3"
+#else
+#warning Building without S3.
 #endif
 #ifdef WITH_WEBDAV
 	, "WebDAV"
+#else
+#warning Building without WebDAV.
 #endif
 #ifdef WITH_INOTIFY
 	, "Inotify"
@@ -47,21 +59,29 @@ buildFlags = filter (not . null)
 #endif
 #ifdef WITH_XMPP
 	, "XMPP"
+#else
+#warning Building without XMPP.
 #endif
 #ifdef WITH_DNS
 	, "DNS"
 #endif
 #ifdef WITH_FEED
 	, "Feeds"
+#else
+#warning Building without Feeds.
 #endif
 #ifdef WITH_QUVI
 	, "Quvi"
+#else
+#warning Building without quvi.
 #endif
 #ifdef WITH_TDFA
 	, "TDFA"
 #endif
 #ifdef WITH_CRYPTOHASH
 	, "CryptoHash"
+#else
+#warning Building without CryptoHash.
 #endif
 #ifdef WITH_EKG
 	, "EKG"

CmdLine.hs

@@ -26,7 +26,6 @@ import qualified Annex
 import qualified Git
 import qualified Git.AutoCorrect
 import Annex.Content
-import Annex.Ssh
 import Annex.Environment
 import Command
 import Types.Messages
@@ -107,4 +106,3 @@ shutdown nocommit = do
 	saveState nocommit
 	sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
 	liftIO reapZombies -- zombies from long-running git processes
-	sshCleanup -- ssh connection caching

CmdLine/Usage.hs

@@ -73,6 +73,8 @@ paramNumRange :: String
 paramNumRange = "NUM|RANGE"
 paramRemote :: String
 paramRemote = "REMOTE"
+paramField :: String
+paramField = "FIELD"
 paramGlob :: String
 paramGlob = "GLOB"
 paramName :: String

Command/Add.hs

@@ -93,12 +93,15 @@ start file = ifAnnexed file addpresent add
  - Lockdown can fail if a file gets deleted, and Nothing will be returned.
  -}
 lockDown :: FilePath -> Annex (Maybe KeySource)
-lockDown file = ifM crippledFileSystem
+lockDown = either (\e -> showErr e >> return Nothing) (return . Just) <=< lockDown'
-	( liftIO $ catchMaybeIO nohardlink
+
-	, do
+lockDown' :: FilePath -> Annex (Either IOException KeySource)
+lockDown' file = ifM crippledFileSystem
+	( liftIO $ tryIO nohardlink
+	, tryAnnexIO $ do
 		tmp <- fromRepo gitAnnexTmpMiscDir
 		createAnnexDirectory tmp
-		eitherToMaybe <$> tryAnnexIO (go tmp)
+		go tmp
 	)
   where
 	{- In indirect mode, the write bit is removed from the file as part

Command/Fsck.hs

@@ -29,6 +29,7 @@ import Utility.DataUnits
 import Utility.FileMode
 import Config
 import Types.Key
+import Types.CleanupActions
 import Utility.HumanTime
 import Git.FilePath
 import Utility.PID
@@ -93,7 +94,7 @@ getIncremental = do
 
 	checkschedule Nothing = error "bad --incremental-schedule value"
 	checkschedule (Just delta) = do
-		Annex.addCleanup "" $ do
+		Annex.addCleanup FsckCleanup $ do
 			v <- getStartTime
 			case v of
 				Nothing -> noop

Command/Info.hs

@@ -281,7 +281,7 @@ cachedPresentData = do
 	case presentData s of
 		Just v -> return v
 		Nothing -> do
-			v <- foldKeys <$> lift getKeysPresent
+			v <- foldKeys <$> lift (getKeysPresent InRepository)
 			put s { presentData = Just v }
 			return v
 

Command/Map.hs

@@ -158,7 +158,8 @@ absRepo reference r
 	| Git.repoIsUrl r = return r
 	| otherwise = liftIO $ do
 		r' <- Git.Construct.fromAbsPath =<< absPath (Git.repoPath r)
-		flip Annex.eval Annex.gitRepo =<< Annex.new r'
+		r'' <- safely $ flip Annex.eval Annex.gitRepo =<< Annex.new r'
+		return (fromMaybe r' r'')
 
 {- Checks if two repos are the same. -}
 same :: Git.Repo -> Git.Repo -> Bool
@@ -192,14 +193,9 @@ tryScan :: Git.Repo -> Annex (Maybe Git.Repo)
 tryScan r
 	| Git.repoIsSsh r = sshscan
 	| Git.repoIsUrl r = return Nothing
-	| otherwise = safely $ Git.Config.read r
+	| otherwise = liftIO $ safely $ Git.Config.read r
   where
-	safely a = do
+	pipedconfig cmd params = liftIO $ safely $
-		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
@@ -247,3 +243,10 @@ combineSame = map snd . nubBy sameuuid . map pair
   where
 	sameuuid (u1, _) (u2, _) = u1 == u2 && u1 /= NoUUID
 	pair r = (getUncachedUUID r, r)
+
+safely :: IO Git.Repo -> IO (Maybe Git.Repo)
+safely a = do
+	result <- try a :: IO (Either SomeException Git.Repo)
+	case result of
+		Left _ -> return Nothing
+		Right r' -> return $ Just r'

Command/MetaData.hs

@@ -12,16 +12,24 @@ import qualified Annex
 import Command
 import Annex.MetaData
 import Logs.MetaData
-import Types.MetaData
 
 import qualified Data.Set as S
 import Data.Time.Clock.POSIX
 
 def :: [Command]
-def = [withOptions [setOption, tagOption, untagOption, jsonOption] $
+def = [withOptions metaDataOptions $
 	command "metadata" paramPaths seek
 	SectionMetaData "sets metadata of a file"]
 
+metaDataOptions :: [Option]
+metaDataOptions =
+	[ setOption
+	, tagOption
+	, untagOption
+	, getOption
+	, jsonOption
+	] ++ keyOptions
+
 storeModMeta :: ModMeta -> Annex ()
 storeModMeta modmeta = Annex.changeState $
 	\s -> s { Annex.modmeta = modmeta:Annex.modmeta s }
@@ -31,6 +39,9 @@ setOption = Option ['s'] ["set"] (ReqArg mkmod "FIELD[+-]=VALUE") "set metadata"
   where
 	mkmod = either error storeModMeta . parseModMeta
 
+getOption :: Option
+getOption = fieldOption ['g'] "get" paramField "get single metadata field"
+
 tagOption :: Option
 tagOption = Option ['t'] ["tag"] (ReqArg mkmod "TAG") "set a tag"
   where
@@ -44,19 +55,35 @@ untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag"
 seek :: CommandSeek
 seek ps = do
 	modmeta <- Annex.getState Annex.modmeta
+	getfield <- getOptionField getOption $ \ms ->
+		return $ either error id . mkMetaField <$> ms
 	now <- liftIO getPOSIXTime
-	withFilesInGit (whenAnnexed $ start now modmeta) ps
+	withKeyOptions
+		(startKeys now getfield modmeta)
+		(withFilesInGit (whenAnnexed $ start now getfield modmeta))
+		ps
 
-start :: POSIXTime -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart
+start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart
-start now ms file (k, _) = do
+start now f ms file (k, _) = start' (Just file) now f ms k
-	showStart "metadata" file
+
+startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
+startKeys = start' Nothing
+
+start' :: AssociatedFile -> POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
+start' afile now Nothing ms k = do
+	showStart' "metadata" k afile
 	next $ perform now ms k
+start' _ _ (Just f) _ k = do
+	l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
+	liftIO $ forM_ l $
+		putStrLn . fromMetaValue
+	stop
 
 perform :: POSIXTime -> [ModMeta] -> Key -> CommandPerform
 perform _ [] k = next $ cleanup k
 perform now ms k = do
 	oldm <- getCurrentMetaData k
-	let m = foldl' unionMetaData emptyMetaData $ map (modMeta oldm) ms
+	let m = combineMetaData $ map (modMeta oldm) ms
 	addMetaData' k m now
 	next $ cleanup k
 	

Command/Move.hs

@@ -69,20 +69,29 @@ toStart dest move afile key = do
 	ishere <- inAnnex key
 	if not ishere || u == Remote.uuid dest
 		then stop -- not here, so nothing to do
-		else do
+		else toStart' dest move afile key
-			showMoveAction move key afile
+
-			next $ toPerform dest move key afile
+toStart' :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
-toPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform
+toStart' dest move afile key = do
-toPerform dest move key afile = moveLock move key $ do
-	-- Checking the remote is expensive, so not done in the start step.
-	-- In fast mode, location tracking is assumed to be correct,
-	-- and an explicit check is not done, when copying. When moving,
-	-- it has to be done, to avoid inaverdent data loss.
 	fast <- Annex.getState Annex.fast
-	let fastcheck = fast && not move && not (Remote.hasKeyCheap dest)
+	if fast && not move && not (Remote.hasKeyCheap dest)
-	isthere <- if fastcheck
+		then ifM (expectedPresent dest key)
-		then Right <$> expectedpresent
+			( stop
-		else Remote.hasKey dest key
+			, go True (pure $ Right False)
+			)
+		else go False (Remote.hasKey dest key)
+  where
+	go fastcheck isthere = do
+		showMoveAction move key afile
+		next $ toPerform dest move key afile fastcheck =<< isthere
+
+expectedPresent :: Remote -> Key -> Annex Bool
+expectedPresent dest key = do
+	remotes <- Remote.keyPossibilities key
+	return $ dest `elem` remotes
+
+toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
+toPerform dest move key afile fastcheck isthere = moveLock move key $
 	case isthere of
 		Left err -> do
 			showNote err
@@ -100,7 +109,7 @@ toPerform dest move key afile = moveLock move key $ do
 						warning "This could have failed because --fast is enabled."
 					stop
 		Right True -> do
-			unlessM expectedpresent $
+			unlessM (expectedPresent dest key) $
 				Remote.logStatus dest key InfoPresent
 			finish
   where
@@ -109,9 +118,6 @@ toPerform dest move key afile = moveLock move key $ do
 			removeAnnex key
 			next $ Command.Drop.cleanupLocal key
 		| otherwise = next $ return True
-	expectedpresent = do
-		remotes <- Remote.keyPossibilities key
-		return $ dest `elem` remotes
 
 {- Moves (or copies) the content of an annexed file from a remote
  - to the current repository.

Command/Sync.hs

@@ -376,5 +376,5 @@ syncFile rs f (k, _) = do
 	put dest = do
 		ok <- commandAction $ do
 			showStart "copy" f
-			next $ Command.Move.toPerform dest False k (Just f)
+			Command.Move.toStart' dest False (Just f) k
 		return (ok, if ok then Just (Remote.uuid dest) else Nothing)

Command/Uninit.hs

@@ -53,7 +53,7 @@ finish :: Annex ()
 finish = do
 	annexdir <- fromRepo gitAnnexDir
 	annexobjectdir <- fromRepo gitAnnexObjectDir
-	leftovers <- removeUnannexed =<< getKeysPresent
+	leftovers <- removeUnannexed =<< getKeysPresent InAnnex
 	if null leftovers
 		then liftIO $ removeDirectoryRecursive annexdir
 		else error $ unlines

Command/Unused.hs

@@ -10,7 +10,6 @@
 module Command.Unused where
 
 import qualified Data.Set as S
-import qualified Data.ByteString.Lazy as L
 import Data.BloomFilter
 import Data.BloomFilter.Easy
 import Data.BloomFilter.Hash
@@ -71,7 +70,9 @@ checkUnused = chain 0
 		return []
 	findunused False = do
 		showAction "checking for unused data"
-		excludeReferenced =<< getKeysPresent
+		-- InAnnex, not InRepository because if a direct mode
+		-- file exists, it is obviously not unused.
+		excludeReferenced =<< getKeysPresent InAnnex
 	chain _ [] = next $ return True
 	chain v (a:as) = do
 		v' <- a v
@@ -294,7 +295,7 @@ withKeysReferencedInGitRef a ref = do
 	liftIO $ void clean
   where
 	tKey True = fmap fst <$$> Backend.lookupFile . getTopFilePath . DiffTree.file
-	tKey False = fileKey . takeFileName . encodeW8 . L.unpack <$$>
+	tKey False = fileKey . takeFileName . decodeBS <$$>
 		catFile ref . getTopFilePath . DiffTree.file
 
 {- Looks in the specified directory for bad/tmp keys, and returns a list

Command/Vicfg.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -60,7 +60,8 @@ vicfg curcfg f = do
 data Cfg = Cfg
 	{ cfgTrustMap :: TrustMap
 	, cfgGroupMap :: M.Map UUID (S.Set Group)
-	, cfgPreferredContentMap :: M.Map UUID String
+	, cfgPreferredContentMap :: M.Map UUID PreferredContentExpression
+	, cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression
 	, cfgScheduleMap :: M.Map UUID [ScheduledActivity]
 	}
 
@@ -69,25 +70,40 @@ getCfg = Cfg
 	<$> trustMapRaw -- without local trust overrides
 	<*> (groupsByUUID <$> groupMap)
 	<*> preferredContentMapRaw
+	<*> groupPreferredContentMapRaw
 	<*> scheduleMap
 
 setCfg :: Cfg -> Cfg -> Annex ()
 setCfg curcfg newcfg = do
-	let (trustchanges, groupchanges, preferredcontentchanges, schedulechanges) = diffCfg curcfg newcfg
+	let diff = diffCfg curcfg newcfg
-	mapM_ (uncurry trustSet) $ M.toList trustchanges
+	mapM_ (uncurry trustSet) $ M.toList $ cfgTrustMap diff
-	mapM_ (uncurry groupSet) $ M.toList groupchanges
+	mapM_ (uncurry groupSet) $ M.toList $ cfgGroupMap diff
-	mapM_ (uncurry preferredContentSet) $ M.toList preferredcontentchanges
+	mapM_ (uncurry preferredContentSet) $ M.toList $ cfgPreferredContentMap diff
-	mapM_ (uncurry scheduleSet) $ M.toList schedulechanges
+	mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff
+	mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff
 
-diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group), M.Map UUID String, M.Map UUID [ScheduledActivity])
+diffCfg :: Cfg -> Cfg -> Cfg
-diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap, diff cfgScheduleMap)
+diffCfg curcfg newcfg = Cfg
+	{ cfgTrustMap = diff cfgTrustMap
+	, cfgGroupMap = diff cfgGroupMap
+	, cfgPreferredContentMap = diff cfgPreferredContentMap
+	, cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap
+	, cfgScheduleMap = diff cfgScheduleMap
+	}
   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
+genCfg cfg descs = unlines $ intercalate [""]
-	[intro, trust, groups, preferredcontent, schedule]
+	[ intro
+	, trust
+	, groups
+	, preferredcontent
+	, grouppreferredcontent
+	, standardgroups
+	, schedule
+	]
   where
 	intro =
 		[ com "git-annex configuration"
@@ -95,22 +111,20 @@ genCfg cfg descs = unlines $ concat
 		, 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"
+		, com "  setting field = value"
 		]
 
-	trust = settings cfgTrustMap
+	trust = settings cfg descs cfgTrustMap
-		[ ""
+		[ com "Repository trust configuration"
-		, com "Repository trust configuration"
 		, com "(Valid trust levels: " ++ trustlevels ++ ")"
 		]
 		(\(t, u) -> line "trust" u $ showTrustLevel t)
 		(\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted)
 	  where
-	  	trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted]
+		trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted]
 
-	groups = settings cfgGroupMap
+	groups = settings cfg descs cfgGroupMap
-		[ ""
+		[ com "Repository groups"
-		, com "Repository groups"
 		, com $ "(Standard groups: " ++ grouplist ++ ")"
 		, com "(Separate group names with spaces)"
 		]
@@ -119,33 +133,60 @@ genCfg cfg descs = unlines $ concat
 	  where
 	  	grouplist = unwords $ map fromStandardGroup [minBound..]
 
-	preferredcontent = settings cfgPreferredContentMap
+	preferredcontent = settings cfg descs cfgPreferredContentMap
-		[ ""
+		[ com "Repository preferred contents" ]
-		, com "Repository preferred contents"
+		(\(s, u) -> line "wanted" u s)
-		]
+		(\u -> line "wanted" u "standard")
-		(\(s, u) -> line "content" u s)
-		(\u -> line "content" u "")
 
-	schedule = settings cfgScheduleMap
+	grouppreferredcontent = settings' cfg allgroups cfgGroupPreferredContentMap
-		[ ""
+		[ com "Group preferred contents"
-		, com "Scheduled activities"
+		, com "(Used by repositories with \"groupwanted\" in their preferred contents)"
+		]
+		(\(s, g) -> gline g s)
+		(\g -> gline g "standard")
+	  where
+	  	gline g value = [ unwords ["groupwanted", g, "=", value] ]
+		allgroups = S.unions $ stdgroups : M.elems (cfgGroupMap cfg)
+		stdgroups = S.fromList $ map fromStandardGroup [minBound..maxBound]
+
+	standardgroups =
+		[ com "Standard preferred contents"
+		, com "(Used by wanted or groupwanted expressions containing \"standard\")"
+		, com "(For reference only; built-in and cannot be changed!)"
+		]
+		++ map gline [minBound..maxBound]
+	  where
+		gline g = com $ unwords
+			[ "standard"
+			, fromStandardGroup g, "=", standardPreferredContent g
+			]
+	
+	schedule = settings cfg descs cfgScheduleMap
+		[ com "Scheduled activities"
 		, com "(Separate multiple activities with \"; \")"
 		]
 		(\(l, u) -> line "schedule" u $ fromScheduledActivities l)
 		(\u -> line "schedule" u "")
 
-	settings field desc showvals showdefaults = concat
-		[ desc
-		, concatMap showvals $ sort $ map swap $ M.toList $ field cfg
-		, concatMap (lcom . showdefaults) $ 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)
+settings :: Ord v => Cfg -> M.Map UUID String -> (Cfg -> M.Map UUID v) -> [String] -> ((v, UUID) -> [String]) -> (UUID -> [String]) -> [String]
+settings cfg descs = settings' cfg (M.keysSet descs)
+
+settings' :: (Ord v, Ord f) => Cfg -> S.Set f -> (Cfg -> M.Map f v) -> [String] -> ((v, f) -> [String]) -> (f -> [String]) -> [String]
+settings' cfg s field desc showvals showdefaults = concat
+	[ desc
+	, concatMap showvals $ sort $ map swap $ M.toList $ field cfg
+	, concatMap (lcom . showdefaults) missing
+	]
+  where
+	missing = S.toList $ s `S.difference` M.keysSet (field cfg)
+
+lcom :: [String] -> [String]
+lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l)
 
 {- If there's a parse error, returns a new version of the file,
  - with the problem lines noted. -}
@@ -163,16 +204,16 @@ parseCfg curcfg = go [] curcfg . lines
 	parse l cfg
 		| null l = Right cfg
 		| "#" `isPrefixOf` l = Right cfg
-		| null setting || null u = Left "missing repository uuid"
+		| null setting || null f = Left "missing field"
-		| otherwise = handle cfg (toUUID u) setting value'
+		| otherwise = handle cfg f setting value'
 	  where
 		(setting, rest) = separate isSpace l
 		(r, value) = separate (== '=') rest
 		value' = trimspace value
-		u = reverse $ trimspace $ reverse $ trimspace r
+		f = reverse $ trimspace $ reverse $ trimspace r
 		trimspace = dropWhile isSpace
 
-	handle cfg u setting value
+	handle cfg f setting value
 		| setting == "trust" = case readTrustLevel value of
 			Nothing -> badval "trust value" value
 			Just t ->
@@ -181,18 +222,26 @@ parseCfg curcfg = go [] curcfg . lines
 		| setting == "group" =
 			let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
 			in Right $ cfg { cfgGroupMap = m }
-		| setting == "content" = 
+		| setting == "wanted" = 
 			case checkPreferredContentExpression value of
 				Just e -> Left e
 				Nothing ->
 					let m = M.insert u value (cfgPreferredContentMap cfg)
 					in Right $ cfg { cfgPreferredContentMap = m }
+		| setting == "groupwanted" =
+			case checkPreferredContentExpression value of
+				Just e -> Left e
+				Nothing ->
+					let m = M.insert f value (cfgGroupPreferredContentMap cfg)
+					in Right $ cfg { cfgGroupPreferredContentMap = m }
 		| setting == "schedule" = case parseScheduledActivities value of
 			Left e -> Left e
 			Right l -> 
 				let m = M.insert u l (cfgScheduleMap cfg)
 				in Right $ cfg { cfgScheduleMap = m }
 		| otherwise = badval "setting" setting
+	  where
+		u = toUUID f
 
 	showerr (Just msg, l) = [parseerr ++ msg, l]
 	showerr (Nothing, l)
@@ -203,11 +252,12 @@ parseCfg curcfg = go [] curcfg . lines
 
 	badval desc val = Left $ "unknown " ++ desc ++ " \"" ++ val ++ "\""
 	badheader = 
-		[ com "There was a problem parsing your input."
+		[ com "** There was a problem parsing your input!"
-		, com "Search for \"Parse error\" to find the bad lines."
+		, com "** Search for \"Parse error\" to find the bad lines."
-		, com "Either fix the bad lines, or delete them (to discard your changes)."
+		, com "** Either fix the bad lines, or delete them (to discard your changes)."
+		, ""
 		]
-	parseerr = com "Parse error in next line: "
+	parseerr = com "** Parse error in next line: "
 
 com :: String -> String
 com s = "# " ++ s

Git/CatFile.hs

@@ -108,6 +108,6 @@ catTree h treeref = go <$> catObjectDetails h treeref
 	dropsha = L.drop 21
 
 	parsemodefile b = 
-		let (modestr, file) = separate (== ' ') (encodeW8 $ L.unpack b)
+		let (modestr, file) = separate (== ' ') (decodeBS b)
 		in (file, readmode modestr)
 	readmode = fst . fromMaybe (0, undefined) . headMaybe . readOct

Git/Fsck.hs

@@ -23,10 +23,17 @@ import Utility.Batch
 import qualified Git.Version
 
 import qualified Data.Set as S
+import System.Process (std_out, std_err)
+import Control.Concurrent.Async
 
 type MissingObjects = S.Set Sha
 
-data FsckResults = FsckFoundMissing MissingObjects | FsckFailed
+data FsckResults 
+	= FsckFoundMissing
+		{ missingObjects :: MissingObjects
+		, missingObjectsTruncated :: Bool
+		}
+	| FsckFailed
 	deriving (Show)
 
 {- Runs fsck to find some of the broken objects in the repository.
@@ -46,20 +53,32 @@ findBroken batchmode r = do
 	(command', params') <- if batchmode
 		then toBatchCommand (command, params)
 		else return (command, params)
-	(output, fsckok) <- processTranscript command' (toCommand params') Nothing
+	
-	let objs = findShas supportsNoDangling output
+	p@(_, _, _, pid) <- createProcess $
-	badobjs <- findMissing objs r
+		(proc command' (toCommand params'))
+			{ std_out = CreatePipe
+			, std_err = CreatePipe
+			}
+	(bad1, bad2) <- concurrently
+		(readMissingObjs maxobjs r supportsNoDangling (stdoutHandle p))
+		(readMissingObjs maxobjs r supportsNoDangling (stderrHandle p))
+	fsckok <- checkSuccessProcess pid
+	let truncated = S.size bad1 == maxobjs || S.size bad1 == maxobjs
+	let badobjs = S.union bad1 bad2
+
 	if S.null badobjs && not fsckok
 		then return FsckFailed
-		else return $ FsckFoundMissing badobjs
+		else return $ FsckFoundMissing badobjs truncated
+  where
+	maxobjs = 10000
 
 foundBroken :: FsckResults -> Bool
 foundBroken FsckFailed = True
-foundBroken (FsckFoundMissing s) = not (S.null s)
+foundBroken (FsckFoundMissing s _) = not (S.null s)
 
 knownMissing :: FsckResults -> MissingObjects
 knownMissing FsckFailed = S.empty
-knownMissing (FsckFoundMissing s) = s
+knownMissing (FsckFoundMissing s _) = s
 
 {- Finds objects that are missing from the git repsitory, or are corrupt.
  -
@@ -69,6 +88,11 @@ knownMissing (FsckFoundMissing s) = s
 findMissing :: [Sha] -> Repo -> IO MissingObjects
 findMissing objs r = S.fromList <$> filterM (`isMissing` r) objs
 
+readMissingObjs :: Int -> Repo -> Bool -> Handle -> IO MissingObjects
+readMissingObjs maxobjs r supportsNoDangling h = do
+	objs <- take maxobjs . findShas supportsNoDangling <$> hGetContents h
+	findMissing objs r
+
 isMissing :: Sha -> Repo -> IO Bool
 isMissing s r = either (const True) (const False) <$> tryIO dump
   where

Git/Repair.hs

@@ -1,7 +1,6 @@
 {- git repository recovery
-import qualified Data.Set as S
  -
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -45,35 +44,18 @@ import qualified Data.ByteString.Lazy as L
 import Data.Tuple.Utils
 
 {- Given a set of bad objects found by git fsck, which may not
- - be complete, finds and removes all corrupt objects,
+ - be complete, finds and removes all corrupt objects. -}
- - and returns missing objects.
+cleanCorruptObjects :: FsckResults -> Repo -> IO ()
- -}
-cleanCorruptObjects :: FsckResults -> Repo -> IO FsckResults
 cleanCorruptObjects fsckresults r = do
 	void $ explodePacks r
-	objs <- listLooseObjectShas r
+	mapM_ removeLoose (S.toList $ knownMissing fsckresults)
-	mapM_ (tryIO . allowRead . looseObjectFile r) objs
+	mapM_ removeBad =<< listLooseObjectShas r
-	bad <- findMissing objs r
+  where
-	void $ removeLoose r $ S.union bad (knownMissing fsckresults)
+	removeLoose s = nukeFile (looseObjectFile r s)
-	-- Rather than returning the loose objects that were removed, re-run
+	removeBad s = do
-	-- fsck. Other missing objects may have been in the packs,
+		void $ tryIO $ allowRead $  looseObjectFile r s
-	-- and this way fsck will find them.
+		whenM (isMissing s r) $
-	findBroken False r
+			removeLoose s
-
-removeLoose :: Repo -> MissingObjects -> IO Bool
-removeLoose r s = do
-	fs <- filterM doesFileExist (map (looseObjectFile r) (S.toList s))
-	let count = length fs
-	if count > 0
-		then do
-			putStrLn $ unwords
-				[ "Removing"
-				, show count
-				, "corrupt loose objects."
-				]
-			mapM_ nukeFile fs
-			return True
-		else return False
 
 {- Explodes all pack files, and deletes them.
  -
@@ -132,7 +114,9 @@ retrieveMissingObjects missing referencerepo r
 				void $ copyObjects tmpr r
 				case stillmissing of
 					FsckFailed -> return $ FsckFailed
-					FsckFoundMissing s -> FsckFoundMissing <$> findMissing (S.toList s) r
+					FsckFoundMissing s t -> FsckFoundMissing 
+						<$> findMissing (S.toList s) r
+						<*> pure t
 			, return stillmissing
 			)
 	pullremotes tmpr (rmt:rmts) fetchrefs ms
@@ -145,9 +129,9 @@ retrieveMissingObjects missing referencerepo r
 					void $ copyObjects tmpr r
 					case ms of
 						FsckFailed -> pullremotes tmpr rmts fetchrefs ms
-						FsckFoundMissing s -> do
+						FsckFoundMissing s t -> do
 							stillmissing <- findMissing (S.toList s) r
-							pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing)
+							pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing t)
 				, pullremotes tmpr rmts fetchrefs ms
 				)
 	fetchfrom fetchurl ps = runBool $
@@ -295,7 +279,7 @@ findUncorruptedCommit missing goodcommits branch r = do
 			then return (Just c, gcs')
 			else findfirst gcs' cs
 
-{- Verifies tha none of the missing objects in the set are used by
+{- Verifies that none of the missing objects in the set are used by
  - the commit. Also adds to a set of commit shas that have been verified to
  - be good, which can be passed into subsequent calls to avoid
  - redundant work when eg, chasing down branches to find the first
@@ -465,10 +449,11 @@ runRepairOf fsckresult removablebranch forced referencerepo g = do
 
 runRepair' :: (Ref -> Bool) -> FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
 runRepair' removablebranch fsckresult forced referencerepo g = do
-	missing <- cleanCorruptObjects fsckresult g
+	cleanCorruptObjects fsckresult g
+	missing <- findBroken False g
 	stillmissing <- retrieveMissingObjects missing referencerepo g
 	case stillmissing of
-		FsckFoundMissing s
+		FsckFoundMissing s t
 			| S.null s -> if repoIsLocalBare g
 				then successfulfinish []
 				else ifM (checkIndex g)
@@ -481,7 +466,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
 					)
 			| otherwise -> if forced
 				then ifM (checkIndex g)
-					( continuerepairs s
+					( forcerepair s t
 					, corruptedindex
 					)
 				else do
@@ -493,17 +478,17 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
 		FsckFailed
 			| forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex g)
 				( do
-					missing' <- cleanCorruptObjects FsckFailed g
+					cleanCorruptObjects FsckFailed g
-					case missing' of
+					stillmissing' <- findBroken False g
+					case stillmissing' of
 						FsckFailed -> return (False, [])
-						FsckFoundMissing stillmissing' ->
+						FsckFoundMissing s t -> forcerepair s t
-							continuerepairs stillmissing'
 				, corruptedindex
 				)
 			| otherwise -> unsuccessfulfinish
   where
-	continuerepairs stillmissing = do
+	repairbranches missing = do
-		(removedbranches, goodcommits) <- removeBadBranches removablebranch stillmissing emptyGoodCommits g
+		(removedbranches, goodcommits) <- removeBadBranches removablebranch missing emptyGoodCommits g
 		let remotebranches = filter isTrackingBranch removedbranches
 		unless (null remotebranches) $
 			putStrLn $ unwords
@@ -511,32 +496,43 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
 				, show (length remotebranches)
 				, "remote tracking branches that referred to missing objects."
 				]
-		(resetbranches, deletedbranches, _) <- resetLocalBranches stillmissing goodcommits g
+		(resetbranches, deletedbranches, _) <- resetLocalBranches missing goodcommits g
 		displayList (map fromRef resetbranches)
 			"Reset these local branches to old versions before the missing objects were committed:"
 		displayList (map fromRef deletedbranches)
 			"Deleted these local branches, which could not be recovered due to missing objects:"
+		return (resetbranches ++ deletedbranches)
+
+	forcerepair missing fscktruncated = do
+		modifiedbranches <- repairbranches missing
 		deindexedfiles <- rewriteIndex g
 		displayList deindexedfiles
 			"Removed these missing files from the index. You should look at what files are present in your working tree and git add them back to the index when appropriate."
-		let modifiedbranches = resetbranches ++ deletedbranches
+
-		if null resetbranches && null deletedbranches
+		-- When the fsck results were truncated, try
-			then successfulfinish modifiedbranches
+		-- fscking again, and as long as different
-			else do
+		-- missing objects are found, continue
-				unless (repoIsLocalBare g) $ do
+		-- the repair process.
-					mcurr <- Branch.currentUnsafe g
+		if fscktruncated
-					case mcurr of
+			then do
-						Nothing -> return ()
+				fsckresult' <- findBroken False g
-						Just curr -> when (any (== curr) modifiedbranches) $ do
+				case fsckresult' of
+					FsckFailed -> do
+						putStrLn "git fsck is failing"
+						return (False, modifiedbranches)
+					FsckFoundMissing s _
+						| S.null s -> successfulfinish modifiedbranches
+						| S.null (s `S.difference` missing) -> do
 							putStrLn $ unwords
-								[ "You currently have"
+								[ show (S.size s)
-								, fromRef curr
+								, "missing objects could not be recovered!"
-								, "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!"
 								]
-				putStrLn "Successfully recovered repository!"
+							return (False, modifiedbranches)	
-				putStrLn "Please carefully check that the changes mentioned above are ok.."
+						| otherwise -> do
-				return (True, modifiedbranches)
+							(ok, modifiedbranches') <- runRepairOf fsckresult' removablebranch forced referencerepo g
-	
+							return (ok, modifiedbranches++modifiedbranches')
+			else successfulfinish modifiedbranches
+
 	corruptedindex = do
 		nukeFile (indexFile g)
 		-- The corrupted index can prevent fsck from finding other
@@ -546,12 +542,28 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
 		putStrLn "Removed the corrupted index file. You should look at what files are present in your working tree and git add them back to the index when appropriate."
 		return result
 
-	successfulfinish modifiedbranches = do
+	successfulfinish modifiedbranches
-		mapM_ putStrLn
+		| null modifiedbranches = do
-			[ "Successfully recovered repository!"
+			mapM_ putStrLn
-			, "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok."
+				[ "Successfully recovered repository!"
-			]
+				, "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok."
-		return (True, modifiedbranches)
+				]
+			return (True, modifiedbranches)
+		| otherwise = do
+			unless (repoIsLocalBare g) $ do
+				mcurr <- Branch.currentUnsafe g
+				case mcurr of
+					Nothing -> return ()
+					Just curr -> when (any (== curr) modifiedbranches) $ do
+						putStrLn $ unwords
+							[ "You currently have"
+							, fromRef curr
+							, "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!"
+							]
+			putStrLn "Successfully recovered repository!"
+			putStrLn "Please carefully check that the changes mentioned above are ok.."
+			return (True, modifiedbranches)
+	
 	unsuccessfulfinish = do
 		if repoIsLocalBare g
 			then do

Limit.hs

@@ -94,18 +94,16 @@ matchGlobFile glob = go
 {- Adds a limit to skip files not believed to be present
  - in a specfied repository. Optionally on a prior date. -}
 addIn :: String -> Annex ()
-addIn = addLimit . limitIn
+addIn s = addLimit =<< mk
-
-limitIn :: MkLimit
-limitIn s = Right $ \notpresent -> checkKey $ \key ->
-	if name == "."
-		then if null date
-			then inhere notpresent key
-			else inuuid notpresent key =<< getUUID
-		else inuuid notpresent key =<< Remote.nameToUUID name
   where
 	(name, date) = separate (== '@') s
-	inuuid notpresent key u
+	mk
+		| name == "." = if null date
+			then use inhere
+			else use . inuuid =<< getUUID
+		| otherwise = use . inuuid =<< Remote.nameToUUID name
+	use a = return $ Right $ \notpresent -> checkKey (a notpresent)
+	inuuid u notpresent key
 		| null date = do
 			us <- Remote.keyLocations key
 			return $ u `elem` us && u `S.notMember` notpresent
@@ -122,7 +120,10 @@ limitIn s = Right $ \notpresent -> checkKey $ \key ->
 
 {- Limit to content that is currently present on a uuid. -}
 limitPresent :: Maybe UUID -> MkLimit
-limitPresent u _ = Right $ const $ checkKey $ \key -> do
+limitPresent u _ = Right $ matchPresent u
+
+matchPresent :: Maybe UUID -> MatchFiles
+matchPresent u _ = checkKey $ \key -> do
 	hereu <- getUUID
 	if u == Just hereu || isNothing u
 		then inAnnex key

Logs.hs

@@ -24,7 +24,7 @@ getLogVariety :: FilePath -> Maybe LogVariety
 getLogVariety f
 	| f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog
 	| isRemoteStateLog f = Just NewUUIDBasedLog
-	| isMetaDataLog f || f == numcopiesLog = Just OtherLog
+	| isMetaDataLog f || f `elem` otherLogs = Just OtherLog
 	| otherwise = PresenceLog <$> firstJust (presenceLogs f)
 
 {- All the uuid-based logs stored in the top of the git-annex branch. -}
@@ -45,6 +45,13 @@ presenceLogs f =
 	, locationLogFileKey f
 	]
 
+{- Logs that are neither UUID based nor presence logs. -}
+otherLogs :: [FilePath]
+otherLogs =
+	[ numcopiesLog
+	, groupPreferredContentLog
+	]
+
 uuidLog :: FilePath
 uuidLog = "uuid.log"
 
@@ -63,6 +70,9 @@ groupLog = "group.log"
 preferredContentLog :: FilePath
 preferredContentLog = "preferred-content.log"
 
+groupPreferredContentLog :: FilePath
+groupPreferredContentLog = "group-preferred-content.log"
+
 scheduleLog :: FilePath
 scheduleLog = "schedule.log"
 

Logs/FsckResults.hs

@@ -23,25 +23,31 @@ writeFsckResults u fsckresults = do
 	logfile <- fromRepo $ gitAnnexFsckResultsLog u
 	liftIO $ 
 		case fsckresults of
-			FsckFailed -> store S.empty logfile
+			FsckFailed -> store S.empty False logfile
-			FsckFoundMissing s
+			FsckFoundMissing s t
 				| S.null s -> nukeFile logfile
-				| otherwise -> store s logfile
+				| otherwise -> store s t logfile
   where
-  	store s logfile = do 
+  	store s t logfile = do 
 		createDirectoryIfMissing True (parentDir logfile)
-		liftIO $ viaTmp writeFile logfile $ serialize s
+		liftIO $ viaTmp writeFile logfile $ serialize s t
-	serialize = unlines . map fromRef . S.toList
+	serialize s t =
+		let ls = map fromRef (S.toList s)
+		in if t
+			then unlines ("truncated":ls)
+			else unlines ls
 
 readFsckResults :: UUID -> Annex FsckResults
 readFsckResults u = do
 	logfile <- fromRepo $ gitAnnexFsckResultsLog u
-	liftIO $ catchDefaultIO (FsckFoundMissing S.empty) $
+	liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $
-		deserialize <$> readFile logfile
+		deserialize . lines <$> readFile logfile
   where
-	deserialize l = 
+	deserialize ("truncated":ls) = deserialize' ls True
-		let s = S.fromList $ map Ref $ lines l
+	deserialize ls = deserialize' ls False
-		in if S.null s then FsckFailed else FsckFoundMissing s
+	deserialize' ls t =
+		let s = S.fromList $ map Ref ls
+		in if S.null s then FsckFailed else FsckFoundMissing s t
 
 clearFsckResults :: UUID -> Annex ()
 clearFsckResults = liftIO . nukeFile <=< fromRepo . gitAnnexFsckResultsLog

Logs/MapLog.hs

@@ -0,0 +1,81 @@
+{- git-annex Map log
+ -
+ - This is used to store a Map, in a way that can be union merged.
+ -
+ - A line of the log will look like: "timestamp field value"
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.MapLog where
+
+import qualified Data.Map as M
+import Data.Time.Clock.POSIX
+import Data.Time
+import System.Locale
+  
+import Common
+
+data TimeStamp = Unknown | Date POSIXTime
+	deriving (Eq, Ord, Show)
+
+data LogEntry v = LogEntry
+	{ changed :: TimeStamp
+	, value :: v
+	} deriving (Eq, Show)
+
+type MapLog f v = M.Map f (LogEntry v)
+
+showMapLog :: (f -> String) -> (v -> String) -> MapLog f v -> String
+showMapLog fieldshower valueshower = unlines . map showpair . M.toList
+  where
+	showpair (f, LogEntry (Date p) v) =
+		unwords [show p, fieldshower f, valueshower v]
+	showpair (f, LogEntry Unknown v) =
+		unwords ["0", fieldshower f, valueshower v]
+
+parseMapLog :: Ord f => (String -> Maybe f) -> (String -> Maybe v) -> String -> MapLog f v
+parseMapLog fieldparser valueparser = M.fromListWith best . mapMaybe parse . lines
+  where
+	parse line = do
+		let (ts, rest) = splitword line
+		    (sf, sv) = splitword rest
+		date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts
+		f <- fieldparser sf
+		v <- valueparser sv
+		Just (f, LogEntry date v)
+	splitword = separate (== ' ')
+
+changeMapLog :: Ord f => POSIXTime -> f -> v -> MapLog f v -> MapLog f v
+changeMapLog t f v = M.insert f $ LogEntry (Date t) v
+
+{- Only add an LogEntry if it's newer (or at least as new as) than any
+ - existing LogEntry for a field. -}
+addMapLog :: Ord f => f -> LogEntry v -> MapLog f v -> MapLog f v
+addMapLog = M.insertWith' best
+
+{- Converts a MapLog into a simple Map without the timestamp information.
+ - This is a one-way trip, but useful for code that never needs to change
+ - the log. -}
+simpleMap :: MapLog f v -> M.Map f v
+simpleMap = M.map value
+
+best :: LogEntry v -> LogEntry v -> LogEntry v
+best new old
+	| changed old > changed new = old
+	| otherwise = new
+
+-- Unknown is oldest.
+prop_TimeStamp_sane :: Bool
+prop_TimeStamp_sane = Unknown < Date 1
+
+prop_addMapLog_sane :: Bool
+prop_addMapLog_sane = newWins && newestWins
+  where
+	newWins = addMapLog ("foo") (LogEntry (Date 1) "new") l == l2
+	newestWins = addMapLog ("foo") (LogEntry (Date 1) "newest") l2 /= l2
+
+	l = M.fromList [("foo", LogEntry (Date 0) "old")]
+	l2 = M.fromList [("foo", LogEntry (Date 1) "new")]

Logs/MetaData.hs

@@ -36,26 +36,54 @@ module Logs.MetaData (
 
 import Common.Annex
 import Types.MetaData
+import Annex.MetaData.StandardFields
 import qualified Annex.Branch
 import Logs
 import Logs.SingleValue
 
 import qualified Data.Set as S
+import qualified Data.Map as M
 import Data.Time.Clock.POSIX
+import Data.Time.Format
+import System.Locale
 
 instance SingleValueSerializable MetaData where
 	serialize = Types.MetaData.serialize
 	deserialize = Types.MetaData.deserialize
 
-getMetaData :: Key -> Annex (Log MetaData)
+getMetaDataLog :: Key -> Annex (Log MetaData)
-getMetaData = readLog . metaDataLogFile
+getMetaDataLog = readLog . metaDataLogFile
 
 {- Go through the log from oldest to newest, and combine it all
- - into a single MetaData representing the current state. -}
+ - into a single MetaData representing the current state.
+ -
+ - Automatically generates a lastchanged metadata for each field that's
+ - currently set, based on timestamps in the log.
+ -}
 getCurrentMetaData :: Key -> Annex MetaData
-getCurrentMetaData = currentMetaData . collect <$$> getMetaData
+getCurrentMetaData k = do
+	ls <- S.toAscList <$> getMetaDataLog k
+	let loggedmeta = currentMetaData $ combineMetaData $ map value ls
+	return $ currentMetaData $ unionMetaData loggedmeta
+		(lastchanged ls loggedmeta)
   where
-	collect = foldl' unionMetaData emptyMetaData . map value . S.toAscList
+  	lastchanged [] _ = emptyMetaData
+	lastchanged ls (MetaData currentlyset) =
+		let m = foldl' (flip M.union) M.empty (map genlastchanged ls)
+		in MetaData $
+			-- Add a overall lastchanged using the oldest log
+			-- item (log is in ascending order).
+			M.insert lastChangedField (lastchangedval $ Prelude.last ls) $
+			M.mapKeys mkLastChangedField $
+			-- Only include fields that are currently set.
+			m `M.intersection` currentlyset
+	-- Makes each field have the timestamp as its value.
+	genlastchanged l =
+		let MetaData m = value l
+		    ts = lastchangedval l
+		in M.map (const ts) m
+	lastchangedval l = S.singleton $ toMetaValue $ showts $ changed l
+	showts = formatTime defaultTimeLocale "%F@%H-%M-%S" . posixSecondsToUTCTime
 
 {- Adds in some metadata, which can override existing values, or unset
  - them, but otherwise leaves any existing metadata as-is. -}
@@ -67,10 +95,12 @@ addMetaData k metadata = addMetaData' k metadata =<< liftIO getPOSIXTime
  - will tend to be generated across the different log files, and so
  - git will be able to pack the data more efficiently. -}
 addMetaData' :: Key -> MetaData -> POSIXTime -> Annex ()
-addMetaData' k metadata now = Annex.Branch.change (metaDataLogFile k) $
+addMetaData' k (MetaData m) now = Annex.Branch.change (metaDataLogFile k) $
 	showLog . simplifyLog 
-		. S.insert (LogEntry now metadata) 
+		. S.insert (LogEntry now metadata)
 		. parseLog
+  where
+	metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m
 
 {- Simplify a log, removing historical values that are no longer
  - needed. 
@@ -148,7 +178,7 @@ copyMetaData :: Key -> Key -> Annex ()
 copyMetaData oldkey newkey
 	| oldkey == newkey = noop
 	| otherwise = do
-		l <- getMetaData oldkey
+		l <- getMetaDataLog oldkey
 		unless (S.null l) $
 			Annex.Branch.change (metaDataLogFile newkey) $
 				const $ showLog l

Logs/PreferredContent.hs

@@ -1,6 +1,6 @@
 {- git-annex preferred content matcher configuration
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -8,10 +8,12 @@
 module Logs.PreferredContent (
 	preferredContentLog,
 	preferredContentSet,
+	groupPreferredContentSet,
 	isPreferredContent,
 	preferredContentMap,
 	preferredContentMapLoad,
 	preferredContentMapRaw,
+	groupPreferredContentMapRaw,
 	checkPreferredContentExpression,
 	setStandardGroup,
 ) where
@@ -35,6 +37,7 @@ import Types.Remote (RemoteConfig)
 import Logs.Group
 import Logs.Remote
 import Types.StandardGroups
+import Limit
 
 {- Checks if a file is preferred content for the specified repository
  - (or the current repository if none is specified). -}
@@ -56,40 +59,61 @@ preferredContentMapLoad :: Annex Annex.PreferredContentMap
 preferredContentMapLoad = do
 	groupmap <- groupMap
 	configmap <- readRemoteLog
+	groupwantedmap <- groupPreferredContentMapRaw
 	m <- simpleMap
-		. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap)
+		. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap groupwantedmap)
 		<$> Annex.Branch.get preferredContentLog
 	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
 	return m
 
 {- This intentionally never fails, even on unparsable expressions,
  - because the configuration is shared among repositories and newer
- - versions of git-annex may add new features. Instead, parse errors
+ - versions of git-annex may add new features. -}
- - result in a Matcher that will always succeed. -}
+makeMatcher
-makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> PreferredContentExpression -> FileMatcher
+	:: GroupMap
-makeMatcher groupmap configmap u expr
+	-> M.Map UUID RemoteConfig
-	| expr == "standard" = standardMatcher groupmap configmap u
+	-> M.Map Group PreferredContentExpression
-	| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
+	-> UUID
-	| otherwise = matchAll
+	-> PreferredContentExpression
+	-> FileMatcher
+makeMatcher groupmap configmap groupwantedmap u = go True True
   where
-	tokens = exprParser groupmap configmap (Just u) expr
+	go expandstandard expandgroupwanted expr
+		| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
+		| otherwise = unknownMatcher u
+	  where
+		tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr
+		matchstandard
+			| expandstandard = maybe (unknownMatcher u) (go False False)
+				(standardPreferredContent <$> getStandardGroup mygroups)
+			| otherwise = unknownMatcher u
+		matchgroupwanted
+			| expandgroupwanted = maybe (unknownMatcher u) (go True False)
+				(groupwanted mygroups)
+			| otherwise = unknownMatcher u
+		mygroups = fromMaybe S.empty (u `M.lookup` groupsByUUID groupmap)
+		groupwanted s = case M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of
+			[pc] -> Just pc
+			_ -> Nothing
 
-{- Standard matchers are pre-defined for some groups. If none is defined,
+{- When a preferred content expression cannot be parsed, but is already
- - or a repository is in multiple groups with standard matchers, match all. -}
+ - in the log (eg, put there by a newer version of git-annex),
-standardMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> FileMatcher
+ - the fallback behavior is to match only files that are currently present.
-standardMatcher groupmap configmap u = 
+ -
-	maybe matchAll (makeMatcher groupmap configmap u . preferredContent) $
+ - This avoid unwanted/expensive changes to the content, until the problem
-		getStandardGroup =<< u `M.lookup` groupsByUUID groupmap
+ - is resolved. -}
+unknownMatcher :: UUID -> FileMatcher
+unknownMatcher u = Utility.Matcher.generate [present]
+  where
+	present = Utility.Matcher.Operation $ matchPresent (Just u)
 
 {- Checks if an expression can be parsed, if not returns Just error -}
 checkPreferredContentExpression :: PreferredContentExpression -> Maybe String
-checkPreferredContentExpression expr
+checkPreferredContentExpression expr = case parsedToMatcher tokens of
-	| expr == "standard" = Nothing
+	Left e -> Just e
-	| otherwise = case parsedToMatcher tokens of
+	Right _ -> Nothing
-		Left e -> Just e
-		Right _ -> Nothing
   where
-	tokens = exprParser emptyGroupMap M.empty Nothing expr
+	tokens = exprParser matchAll matchAll emptyGroupMap M.empty Nothing expr
 
 {- 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. -}

Logs/PreferredContent/Raw.hs

@@ -1,6 +1,6 @@
 {- unparsed preferred content expressions
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -15,17 +15,35 @@ import qualified Annex.Branch
 import qualified Annex
 import Logs
 import Logs.UUIDBased
+import Logs.MapLog
 import Types.StandardGroups
+import Types.Group
 
 {- Changes the preferred content configuration of a remote. -}
 preferredContentSet :: UUID -> PreferredContentExpression -> Annex ()
 preferredContentSet uuid@(UUID _) val = do
 	ts <- liftIO getPOSIXTime
 	Annex.Branch.change preferredContentLog $
-		showLog id . changeLog ts uuid val . parseLog Just
+		showLog id
+		. changeLog ts uuid val
+		. parseLog Just
 	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
 preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
 
+{- Changes the preferred content configuration of a group. -}
+groupPreferredContentSet :: Group -> PreferredContentExpression -> Annex ()
+groupPreferredContentSet g val = do
+	ts <- liftIO getPOSIXTime
+	Annex.Branch.change groupPreferredContentLog $
+		showMapLog id id 
+		. changeMapLog ts g val 
+		. parseMapLog Just Just
+	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
+
 preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
 preferredContentMapRaw = simpleMap . parseLog Just
 	<$> Annex.Branch.get preferredContentLog
+
+groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression)
+groupPreferredContentMapRaw = simpleMap . parseMapLog Just Just
+	<$> Annex.Branch.get groupPreferredContentLog

Logs/UUIDBased.hs

@@ -26,9 +26,6 @@ module Logs.UUIDBased (
 	changeLog,
 	addLog,
 	simpleMap,
-
-	prop_TimeStamp_sane,
-	prop_addLog_sane,
 ) where
 
 import qualified Data.Map as M
@@ -38,21 +35,11 @@ import System.Locale
 
 import Common
 import Types.UUID
+import Logs.MapLog
 
-data TimeStamp = Unknown | Date POSIXTime
+type Log v = MapLog UUID v
-	deriving (Eq, Ord, Show)
 
-data LogEntry a = LogEntry
+showLog :: (v -> String) -> Log v -> String
-	{ changed :: TimeStamp
-	, value :: a
-	} deriving (Eq, Show)
-
-type Log a = M.Map UUID (LogEntry a)
-
-tskey :: String
-tskey = "timestamp="
-
-showLog :: (a -> String) -> Log a -> String
 showLog shower = unlines . map showpair . M.toList
   where
 	showpair (k, LogEntry (Date p) v) =
@@ -60,14 +47,6 @@ showLog shower = unlines . map showpair . M.toList
 	showpair (k, LogEntry Unknown v) =
 		unwords [fromUUID k, shower v]
 
-showLogNew :: (a -> String) -> Log a -> String
-showLogNew shower = unlines . map showpair . M.toList
-  where
-	showpair (k, LogEntry (Date p) v) =
-		unwords [show p, fromUUID k, shower v]
-	showpair (k, LogEntry Unknown v) =
-		unwords ["0", fromUUID k, shower v]
-
 parseLog :: (String -> Maybe a) -> String -> Log a
 parseLog = parseLogWithUUID . const
 
@@ -98,45 +77,17 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines
 			Nothing -> Unknown
 			Just d -> Date $ utcTimeToPOSIXSeconds d
 
-parseLogNew :: (String -> Maybe a) -> String -> Log a
+showLogNew :: (v -> String) -> Log v -> String
-parseLogNew parser = M.fromListWith best . mapMaybe parse . lines
+showLogNew = showMapLog fromUUID
-  where
-	parse line = do
-		let (ts, rest) = splitword line
-		    (u, v) = splitword rest
-		date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts
-		val <- parser v
-		Just (toUUID u, LogEntry date val)
-	splitword = separate (== ' ')
 
-changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a
+parseLogNew :: (String -> Maybe v) -> String -> Log v
-changeLog t u v = M.insert u $ LogEntry (Date t) v
+parseLogNew = parseMapLog (Just . toUUID)
 
-{- Only add an LogEntry if it's newer (or at least as new as) than any
+changeLog :: POSIXTime -> UUID -> v -> Log v -> Log v
- - existing LogEntry for a UUID. -}
+changeLog = changeMapLog
-addLog :: UUID -> LogEntry a -> Log a -> Log a
-addLog = M.insertWith' best
 
-{- Converts a Log into a simple Map without the timestamp information.
+addLog :: UUID -> LogEntry v -> Log v -> Log v
- - This is a one-way trip, but useful for code that never needs to change
+addLog = addMapLog
- - the log. -}
-simpleMap :: Log a -> M.Map UUID a
-simpleMap = M.map value
 
-best :: LogEntry a -> LogEntry a -> LogEntry a
+tskey :: String
-best new old
+tskey = "timestamp="
-	| changed old > changed new = old
-	| otherwise = new
-
--- Unknown is oldest.
-prop_TimeStamp_sane :: Bool
-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
-
-	l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")]
-	l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")]

Logs/Unused.hs

@@ -67,7 +67,7 @@ updateUnusedLog prefix m = do
 writeUnusedLog :: FilePath -> UnusedLog -> Annex ()
 writeUnusedLog prefix l = do
 	logfile <- fromRepo $ gitAnnexUnusedLog prefix
-	liftIO $ viaTmp writeFile logfile $ unlines $ map format $ M.toList l
+	liftIO $ viaTmp writeFileAnyEncoding logfile $ unlines $ map format $ M.toList l
   where
 	format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t
 	format (k, (i, Nothing)) = show i ++ " " ++ key2file k
@@ -77,7 +77,7 @@ readUnusedLog prefix = do
 	f <- fromRepo $ gitAnnexUnusedLog prefix
 	ifM (liftIO $ doesFileExist f)
 		( M.fromList . mapMaybe parse . lines
-			<$> liftIO (readFile f)
+			<$> liftIO (readFileStrictAnyEncoding f)
 		, return M.empty
 		)
   where
@@ -99,7 +99,6 @@ dateUnusedLog prefix = do
 	f <- fromRepo $ gitAnnexUnusedLog prefix
 	liftIO $ catchMaybeIO $ getModificationTime f
 #else
-#warning foo
 -- old ghc's getModificationTime returned a ClockTime
 dateUnusedLog _prefix = return Nothing
 #endif

Makefile

@@ -119,7 +119,7 @@ linuxstandalone-nobuild: Build/Standalone Build/LinuxMkLibs
 	strip "$(LINUXSTANDALONE_DEST)/bin/git-annex"
 	ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-annex-shell"
 	zcat standalone/licences.gz > $(LINUXSTANDALONE_DEST)/LICENSE
-	cp doc/favicon.png doc/logo.svg $(LINUXSTANDALONE_DEST)
+	cp doc/logo_16x16.png doc/logo.svg $(LINUXSTANDALONE_DEST)
 
 	./Build/Standalone "$(LINUXSTANDALONE_DEST)"
 	

Remote.hs

@@ -37,6 +37,7 @@ module Remote (
 	keyPossibilities,
 	keyPossibilitiesTrusted,
 	nameToUUID,
+	nameToUUID',
 	showTriedRemotes,
 	showLocations,
 	forceTrust,
@@ -48,7 +49,6 @@ module Remote (
 import qualified Data.Map as M
 import Text.JSON
 import Text.JSON.Generic
-import Data.Tuple
 import Data.Ord
 
 import Common.Annex
@@ -121,23 +121,25 @@ noRemoteUUIDMsg r = "cannot determine uuid for " ++ name r
  - and returns its UUID. Finds even repositories that are not
  - configured in .git/config. -}
 nameToUUID :: RemoteName -> Annex UUID
-nameToUUID "." = getUUID -- special case for current repo
+nameToUUID = either error return <=< nameToUUID'
-nameToUUID "here" = getUUID
+
-nameToUUID "" = error "no remote specified"
+nameToUUID' :: RemoteName -> Annex (Either String UUID)
-nameToUUID n = byName' n >>= go
+nameToUUID' "." = Right <$> getUUID -- special case for current repo
+nameToUUID' "here" = Right <$> getUUID
+nameToUUID' n = byName' n >>= go
   where
-	go (Right r) = case uuid r of
+	go (Right r) = return $ case uuid r of
-		NoUUID -> error $ noRemoteUUIDMsg r
+		NoUUID -> Left $ noRemoteUUIDMsg r
-		u -> return u
+		u -> Right u
-	go (Left e) = fromMaybe (error e) <$> bydescription
+	go (Left e) = do
-	bydescription = do
 		m <- uuidMap
-		case M.lookup n $ transform swap m of
+		return $ case M.keys (M.filter (== n) m) of
-			Just u -> return $ Just u
+			[u] -> Right u
-			Nothing -> return $ byuuid m
+			[] -> let u = toUUID n
-	byuuid m = M.lookup (toUUID n) $ transform double m
+				in case M.keys (M.filterWithKey (\k _ -> k == u) m) of
-	transform a = M.fromList . map a . M.toList
+					[] -> Left e
-	double (a, _) = (a, a)
+					_ -> Right u
+			_us -> Left "Found multiple repositories with that description"
 
 {- Pretty-prints a list of UUIDs of remotes, for human display.
  -

Remote/External.hs

@@ -11,6 +11,7 @@ import Remote.External.Types
 import qualified Annex
 import Common.Annex
 import Types.Remote
+import Types.CleanupActions
 import qualified Git
 import Config
 import Remote.Helper.Special
@@ -43,7 +44,7 @@ remote = RemoteType {
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	external <- newExternal externaltype u c
-	Annex.addCleanup (fromUUID u) $ stopExternal external
+	Annex.addCleanup (RemoteCleanup u) $ stopExternal external
 	cst <- getCost external r gc
 	avail <- getAvailability external r gc
 	return $ Just $ encryptableRemote c

Remote/Git.hs

@@ -36,6 +36,7 @@ import Config
 import Config.Cost
 import Annex.Init
 import Types.Key
+import Types.CleanupActions
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Logs.Location
 import Utility.Metered
@@ -144,7 +145,7 @@ repoAvail r
 				else return True
 	| Git.repoIsUrl r = return True
 	| Git.repoIsLocalUnknown r = return False
-	| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
+	| otherwise = liftIO $ isJust <$> catchMaybeIO (Git.Config.read r)
 
 {- Tries to read the config for a specified remote, updates state, and
  - returns the updated repo. -}
@@ -161,9 +162,12 @@ tryGitConfigRead r
 	| Git.repoIsHttp r = store geturlconfig
 	| Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteConfig r "uuid")
 	| Git.repoIsUrl r = return r
-	| otherwise = store $ safely $ onLocal r $ do 
+	| otherwise = store $ safely $ do
-		ensureInitialized
+		s <- Annex.new r
-		Annex.getState Annex.repo
+		Annex.eval s $ do
+			Annex.BranchState.disableUpdate
+			ensureInitialized
+			Annex.getState Annex.repo
   where
 	haveconfig = not . M.null . Git.config
 
@@ -267,8 +271,8 @@ inAnnex rmt key
 	checkremote = Ssh.inAnnex r key
 	checklocal = guardUsable r (cantCheck r) $ dispatch <$> check
 	  where
-		check = liftIO $ catchMsgIO $ onLocal r $
+		check = either (Left . show) Right 
-			Annex.Content.inAnnexSafe key
+			<$> tryAnnex (onLocal rmt $ Annex.Content.inAnnexSafe key)
 		dispatch (Left e) = Left e
 		dispatch (Right (Just b)) = Right b
 		dispatch (Right Nothing) = cantCheck r
@@ -291,7 +295,7 @@ keyUrls r key = map tourl locs'
 dropKey :: Remote -> Key -> Annex Bool
 dropKey r key
 	| not $ Git.repoIsUrl (repo r) =
-		guardUsable (repo r) False $ commitOnCleanup r $ liftIO $ onLocal (repo r) $ do
+		guardUsable (repo r) False $ commitOnCleanup r $ onLocal r $ do
 			ensureInitialized
 			whenM (Annex.Content.inAnnex key) $ do
 				Annex.Content.lockContent key $
@@ -311,7 +315,7 @@ copyFromRemote' r key file dest
 		let params = Ssh.rsyncParams r Download
 		u <- getUUID
 		-- run copy from perspective of remote
-		liftIO $ onLocal (repo r) $ do
+		onLocal r $ do
 			ensureInitialized
 			v <- Annex.Content.prepSendAnnex key
 			case v of
@@ -410,7 +414,7 @@ copyToRemote r key file p
 		let params = Ssh.rsyncParams r Upload
 		u <- getUUID
 		-- run copy from perspective of remote
-		liftIO $ onLocal (repo r) $ ifM (Annex.Content.inAnnex key)
+		onLocal r $ ifM (Annex.Content.inAnnex key)
 			( return True
 			, do
 				ensureInitialized
@@ -439,19 +443,40 @@ fsckOnRemote r params
 
 {- The passed repair action is run in the Annex monad of the remote. -}
 repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool)
-repairRemote r a = return $ Remote.Git.onLocal r a
+repairRemote r a = return $ do
-
-{- Runs an action on a local repository inexpensively, by making an annex
- - monad using that repository. -}
-onLocal :: Git.Repo -> Annex a -> IO a
-onLocal r a = do
 	s <- Annex.new r
 	Annex.eval s $ do
-		-- No need to update the branch; its data is not used
-		-- for anything onLocal is used to do.
 		Annex.BranchState.disableUpdate
+		ensureInitialized
 		a
 
+{- Runs an action from the perspective of a local remote.
+ -
+ - The AnnexState is cached for speed and to avoid resource leaks.
+ -
+ - The repository's git-annex branch is not updated, as an optimisation.
+ - No caller of onLocal can query data from the branch and be ensured
+ - it gets a current value. Caller of onLocal can make changes to
+ - the branch, however.
+ -}
+onLocal :: Remote -> Annex a -> Annex a
+onLocal r a = do
+	m <- Annex.getState Annex.remoteannexstate
+	case M.lookup (uuid r) m of
+		Nothing -> do
+			st <- liftIO $ Annex.new (repo r)
+			go st $ do
+				Annex.BranchState.disableUpdate	
+				a
+		Just st -> go st a
+  where
+	cache st = Annex.changeState $ \s -> s
+		{ Annex.remoteannexstate = M.insert (uuid r) st (Annex.remoteannexstate s) }
+	go st a' = do
+		(ret, st') <- liftIO $ Annex.run st a'
+		cache st'
+		return ret
+
 {- Copys a file with rsync unless both locations are on the same
  - filesystem. Then cp could be faster. -}
 rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool
@@ -486,9 +511,9 @@ rsyncOrCopyFile rsyncparams src dest p =
 commitOnCleanup :: Remote -> Annex a -> Annex a
 commitOnCleanup r a = go `after` a
   where
-	go = Annex.addCleanup (Git.repoLocation $ repo r) cleanup
+	go = Annex.addCleanup (RemoteCleanup $ uuid r) cleanup
 	cleanup
-		| not $ Git.repoIsUrl (repo r) = liftIO $ onLocal (repo r) $
+		| not $ Git.repoIsUrl (repo r) = onLocal r $
 			doQuietSideAction $
 				Annex.Branch.commit "update"
 		| otherwise = void $ do

Remote/Helper/Hooks.hs

@@ -13,6 +13,7 @@ import qualified Data.Map as M
 
 import Common.Annex
 import Types.Remote
+import Types.CleanupActions
 import qualified Annex
 import Annex.LockPool
 #ifndef mingw32_HOST_OS
@@ -74,7 +75,7 @@ runHooks r starthook stophook a = do
 		-- So, requiring idempotency is the right approach.
 		run starthook
 
-		Annex.addCleanup (remoteid ++ "-stop-command") $ runstop lck
+		Annex.addCleanup (StopHook $ uuid r) $ runstop lck
 	runstop lck = do
 		-- Drop any shared lock we have, and take an
 		-- exclusive lock, without blocking. If the lock

Remote/Rsync.hs

@@ -28,6 +28,7 @@ import Annex.UUID
 import Annex.Ssh
 import Remote.Helper.Special
 import Remote.Helper.Encryptable
+import Remote.Rsync.RsyncUrl
 import Crypto
 import Utility.Rsync
 import Utility.CopyFile
@@ -40,16 +41,6 @@ import Types.Creds
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 
-type RsyncUrl = String
-
-data RsyncOpts = RsyncOpts
-	{ rsyncUrl :: RsyncUrl
-	, rsyncOptions :: [CommandParam]
-	, rsyncUploadOptions :: [CommandParam]
-	, rsyncDownloadOptions :: [CommandParam]
-	, rsyncShellEscape :: Bool
-}
-
 remote :: RemoteType
 remote = RemoteType {
 	typename = "rsync",
@@ -148,17 +139,6 @@ rsyncSetup mu _ c = do
 	gitConfigSpecialRemote u c' "rsyncurl" url
 	return (c', u)
 
-rsyncEscape :: RsyncOpts -> String -> String
-rsyncEscape o s
-	| rsyncShellEscape o && rsyncUrlIsShell (rsyncUrl o) = shellEscape s
-	| otherwise = s
-
-rsyncUrls :: RsyncOpts -> Key -> [String]
-rsyncUrls o k = map use annexHashes
-  where
-	use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f)
-	f = keyFile k
-
 store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store o k _f p = sendAnnex k (void $ remove o k) $ rsyncSend o p k False
 

Remote/Rsync/RsyncUrl.hs

@@ -0,0 +1,46 @@
+{- Rsync urls.
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Remote.Rsync.RsyncUrl where
+
+import Types
+import Locations
+import Utility.Rsync
+import Utility.SafeCommand
+
+import System.FilePath.Posix
+#ifdef mingw32_HOST_OS
+import Data.String.Utils
+#endif
+
+type RsyncUrl = String
+
+data RsyncOpts = RsyncOpts
+	{ rsyncUrl :: RsyncUrl
+	, rsyncOptions :: [CommandParam]
+	, rsyncUploadOptions :: [CommandParam]
+	, rsyncDownloadOptions :: [CommandParam]
+	, rsyncShellEscape :: Bool
+}
+
+rsyncEscape :: RsyncOpts -> RsyncUrl -> RsyncUrl
+rsyncEscape o u
+	| rsyncShellEscape o && rsyncUrlIsShell (rsyncUrl o) = shellEscape u
+	| otherwise = u
+
+rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl]
+rsyncUrls o k = map use annexHashes
+  where
+	use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f)
+	f = keyFile k
+#ifndef mingw32_HOST_OS
+	hash h = h k
+#else
+	hash h = replace "\\" "/" (h k)
+#endif

Setup.hs

@@ -16,15 +16,14 @@ import System.Directory
 import qualified Build.DesktopFile as DesktopFile
 import qualified Build.Configure as Configure
 
+main :: IO ()
 main = defaultMainWithHooks simpleUserHooks
-	{ preConf = configure
+	{ preConf = \_ _ -> do
+		Configure.run Configure.tests
+		return (Nothing, [])	
 	, postInst = myPostInst
 	}
 
-configure _ _ = do
-	Configure.run Configure.tests
-	return (Nothing, [])
-
 myPostInst :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
 myPostInst _ (InstallFlags { installVerbosity }) pkg lbi = do
 	installGitAnnexShell dest verbosity pkg lbi
@@ -57,7 +56,7 @@ installManpages copyDest verbosity pkg lbi =
 	manpages    = ["git-annex.1", "git-annex-shell.1"]
 
 installDesktopFile :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-installDesktopFile copyDest verbosity pkg lbi =
+installDesktopFile copyDest _verbosity pkg lbi =
 	DesktopFile.install $ dstBinDir </> "git-annex"
   where
 	dstBinDir = bindir $ absoluteInstallDirs pkg lbi copyDest

Test.hs

@@ -17,12 +17,14 @@ import Test.Tasty.Ingredients.Rerun
 import Data.Monoid
 
 import Options.Applicative hiding (command)
+#if MIN_VERSION_optparse_applicative(0,8,0)
+import qualified Options.Applicative.Types as Opt
+#endif
 import Control.Exception.Extensible
 import qualified Data.Map as M
 import System.IO.HVFS (SystemFS(..))
 import qualified Text.JSON
 import System.Path
-import qualified Data.ByteString.Lazy as L
 
 import Common
 
@@ -43,7 +45,7 @@ import qualified Types.Backend
 import qualified Types.TrustLevel
 import qualified Types
 import qualified Logs
-import qualified Logs.UUIDBased
+import qualified Logs.MapLog
 import qualified Logs.Trust
 import qualified Logs.Remote
 import qualified Logs.Unused
@@ -104,8 +106,7 @@ main ps = do
 	-- parameters is "test".
 	let pinfo = info (helper <*> suiteOptionParser ingredients tests)
 		( fullDesc <> header "Builtin test suite" )
-	opts <- either (\f -> error =<< errMessage f "git-annex test") return $
+	opts <- parseOpts (prefs idm) pinfo ps
-		execParserPure (prefs idm) pinfo ps
 	case tryIngredients ingredients opts tests of
 		Nothing -> error "No tests found!?"
 		Just act -> ifM act
@@ -115,6 +116,18 @@ main ps = do
 				putStrLn "   with utilities, such as git, installed on this system.)"
 				exitFailure
 			)
+  where
+  	progdesc = "git-annex test"
+	parseOpts pprefs pinfo args =
+#if MIN_VERSION_optparse_applicative(0,8,0)
+		pure $ case execParserPure pprefs pinfo args of
+			Opt.Success v -> v
+			Opt.Failure f -> error $ fst $ Opt.execFailure f progdesc
+			Opt.CompletionInvoked _ -> error "completion not supported"
+#else
+		either (error <=< flip errMessage progdesc) return $
+			execParserPure pprefs pinfo args
+#endif
 
 ingredients :: [Ingredient]
 ingredients =
@@ -140,8 +153,8 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
 	, testProperty "prop_cost_sane" Config.Cost.prop_cost_sane
 	, testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane
 	, testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane
-	, testProperty "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
+	, testProperty "prop_TimeStamp_sane" Logs.MapLog.prop_TimeStamp_sane
-	, testProperty "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
+	, testProperty "prop_addMapLog_sane" Logs.MapLog.prop_addMapLog_sane
 	, testProperty "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
 	, testProperty "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
 	, testProperty "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo
@@ -1272,7 +1285,7 @@ test_add_subdirs env = intmpclonerepo env $ do
 	{- Regression test for Windows bug where symlinks were not
 	 - calculated correctly for files in subdirs. -}
 	git_annex env "sync" [] @? "sync failed"
-	l <- annexeval $ encodeW8 . L.unpack <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo")
+	l <- annexeval $ decodeBS <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo")
 	"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l)
 
 	createDirectory "dir2"

Types/CleanupActions.hs

@@ -0,0 +1,17 @@
+{- Enumeration of cleanup actions
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.CleanupActions where
+
+import Types.UUID
+
+data CleanupAction
+	= RemoteCleanup UUID
+	| StopHook UUID
+	| FsckCleanup
+	| SshCachingCleanup
+	deriving (Eq, Ord)

Types/MetaData.hs

@@ -28,6 +28,7 @@ module Types.MetaData (
 	emptyMetaData,
 	updateMetaData,
 	unionMetaData,
+	combineMetaData,
 	differenceMetaData,
 	isSet,
 	currentMetaData,
@@ -140,7 +141,7 @@ toMetaField f
  - that would break views.
  -
  - So, require they have an alphanumeric first letter, with the remainder
- - being either alphanumeric or a small set of shitelisted common punctuation.
+ - being either alphanumeric or a small set of whitelisted common punctuation.
  -}
 legalField :: String -> Bool
 legalField [] = False
@@ -188,6 +189,9 @@ unionMetaData :: MetaData -> MetaData -> MetaData
 unionMetaData (MetaData old) (MetaData new) = MetaData $
 	M.unionWith S.union new old
 
+combineMetaData :: [MetaData] -> MetaData
+combineMetaData = foldl' unionMetaData emptyMetaData
+
 differenceMetaData :: MetaData -> MetaData -> MetaData
 differenceMetaData (MetaData m) (MetaData excludem) = MetaData $
 	M.differenceWith diff m excludem

Types/StandardGroups.hs

@@ -8,6 +8,7 @@
 module Types.StandardGroups where
 
 import Types.Remote (RemoteConfig)
+import Types.Group
 
 import qualified Data.Map as M
 import Data.Maybe
@@ -27,7 +28,7 @@ data StandardGroup
 	| UnwantedGroup
 	deriving (Eq, Ord, Enum, Bounded, Show)
 
-fromStandardGroup :: StandardGroup -> String
+fromStandardGroup :: StandardGroup -> Group
 fromStandardGroup ClientGroup = "client"
 fromStandardGroup TransferGroup = "transfer"
 fromStandardGroup BackupGroup = "backup"
@@ -39,7 +40,7 @@ fromStandardGroup ManualGroup = "manual"
 fromStandardGroup PublicGroup = "public"
 fromStandardGroup UnwantedGroup = "unwanted"
 
-toStandardGroup :: String -> Maybe StandardGroup
+toStandardGroup :: Group -> Maybe StandardGroup
 toStandardGroup "client" = Just ClientGroup
 toStandardGroup "transfer" = Just TransferGroup
 toStandardGroup "backup" = Just BackupGroup
@@ -77,21 +78,21 @@ specialRemoteOnly PublicGroup = True
 specialRemoteOnly _ = False
 
 {- See doc/preferred_content.mdwn for explanations of these expressions. -}
-preferredContent :: StandardGroup -> PreferredContentExpression
+standardPreferredContent :: StandardGroup -> PreferredContentExpression
-preferredContent ClientGroup = lastResort $
+standardPreferredContent ClientGroup = lastResort $
 	"((exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")) and not unused"
-preferredContent TransferGroup = lastResort $
+standardPreferredContent TransferGroup = lastResort $
-	"not (inallgroup=client and copies=client:2) and (" ++ preferredContent ClientGroup ++ ")"
+	"not (inallgroup=client and copies=client:2) and (" ++ standardPreferredContent ClientGroup ++ ")"
-preferredContent BackupGroup = "include=* or unused"
+standardPreferredContent BackupGroup = "include=* or unused"
-preferredContent IncrementalBackupGroup = lastResort
+standardPreferredContent IncrementalBackupGroup = lastResort
 	"(include=* or unused) and (not copies=incrementalbackup:1)"
-preferredContent SmallArchiveGroup = lastResort $
+standardPreferredContent SmallArchiveGroup = lastResort $
-	"(include=*/archive/* or include=archive/*) and (" ++ preferredContent FullArchiveGroup ++ ")"
+	"(include=*/archive/* or include=archive/*) and (" ++ standardPreferredContent FullArchiveGroup ++ ")"
-preferredContent FullArchiveGroup = lastResort notArchived
+standardPreferredContent FullArchiveGroup = lastResort notArchived
-preferredContent SourceGroup = "not (copies=1)"
+standardPreferredContent SourceGroup = "not (copies=1)"
-preferredContent ManualGroup = "present and (" ++ preferredContent ClientGroup ++ ")"
+standardPreferredContent ManualGroup = "present and (" ++ standardPreferredContent ClientGroup ++ ")"
-preferredContent PublicGroup = "inpreferreddir"
+standardPreferredContent PublicGroup = "inpreferreddir"
-preferredContent UnwantedGroup = "exclude=*"
+standardPreferredContent UnwantedGroup = "exclude=*"
 
 notArchived :: String
 notArchived = "not (copies=archive:1 or copies=smallarchive:1)"

Utility/FileMode.hs

@@ -99,13 +99,20 @@ noUmask :: FileMode -> IO a -> IO a
 #ifndef mingw32_HOST_OS
 noUmask mode a
 	| mode == stdFileMode = a
-	| otherwise = bracket setup cleanup go
+	| otherwise = withUmask nullFileMode a
+#else
+noUmask _ a = a
+#endif
+
+withUmask :: FileMode -> IO a -> IO a
+#ifndef mingw32_HOST_OS
+withUmask umask a = bracket setup cleanup go
   where
-	setup = setFileCreationMask nullFileMode
+	setup = setFileCreationMask umask
 	cleanup = setFileCreationMask
 	go _ = a
 #else
-noUmask _ a = a
+withUmask _ a = a
 #endif
 
 combineModes :: [FileMode] -> FileMode
@@ -127,14 +134,20 @@ setSticky f = modifyFileMode f $ addModes [stickyMode]
 #endif
 
 {- Writes a file, ensuring that its modes do not allow it to be read
- - by anyone other than the current user, before any content is written.
+ - or written by anyone other than the current user,
+ - before any content is written.
+ -
+ - When possible, this is done using the umask.
  -
  - On a filesystem that does not support file permissions, this is the same
  - as writeFile.
  -}
 writeFileProtected :: FilePath -> String -> IO ()
-writeFileProtected file content = withFile file WriteMode $ \h -> do
+writeFileProtected file content = withUmask 0o0077 $
-	void $ tryIO $
+	withFile file WriteMode $ \h -> do
-		modifyFileMode file $
+		void $ tryIO $ modifyFileMode file $
-			removeModes [groupReadMode, otherReadMode]
+			removeModes
-	hPutStr h content
+				[ groupReadMode, otherReadMode
+				, groupWriteMode, otherWriteMode
+				]
+		hPutStr h content

Utility/FileSystemEncoding.hs

@@ -1,14 +1,17 @@
 {- GHC File system encoding handling.
  -
- - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Utility.FileSystemEncoding (
 	fileEncoding,
 	withFilePath,
 	md5FilePath,
+	decodeBS,
 	decodeW8,
 	encodeW8,
 	truncateFilePath,
@@ -22,13 +25,24 @@ import System.IO.Unsafe
 import qualified Data.Hash.MD5 as MD5
 import Data.Word
 import Data.Bits.Utils
+import qualified Data.ByteString.Lazy as L
+#ifdef mingw32_HOST_OS
+import qualified Data.ByteString.Lazy.UTF8 as L8
+#endif
 
 {- Sets a Handle to use the filesystem encoding. This causes data
  - written or read from it to be encoded/decoded the same
  - as ghc 7.4 does to filenames etc. This special encoding
- - allows "arbitrary undecodable bytes to be round-tripped through it". -}
+ - allows "arbitrary undecodable bytes to be round-tripped through it".
+ -}
 fileEncoding :: Handle -> IO ()
+#ifndef mingw32_HOST_OS
 fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding
+#else
+{- The file system encoding does not work well on Windows,
+ - and Windows only has utf FilePaths anyway. -}
+fileEncoding h = hSetEncoding h Encoding.utf8
+#endif
 
 {- Marshal a Haskell FilePath into a NUL terminated C string using temporary
  - storage. The FilePath is encoded using the filesystem encoding,
@@ -60,6 +74,16 @@ _encodeFilePath fp = unsafePerformIO $ do
 md5FilePath :: FilePath -> MD5.Str
 md5FilePath = MD5.Str . _encodeFilePath
 
+{- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
+decodeBS :: L.ByteString -> FilePath
+#ifndef mingw32_HOST_OS
+decodeBS = encodeW8 . L.unpack
+#else
+{- On Windows, we assume that the ByteString is utf-8, since Windows
+ - only uses unicode for filenames. -}
+decodeBS = L8.toString
+#endif
+
 {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
  -
  - w82c produces a String, which may contain Chars that are invalid
@@ -84,6 +108,7 @@ decodeW8 = s2w8 . _encodeFilePath
  - cost of efficiency when running on a large FilePath.
  -}
 truncateFilePath :: Int -> FilePath -> FilePath
+#ifndef mingw32_HOST_OS
 truncateFilePath n = go . reverse
   where
   	go f =
@@ -91,3 +116,17 @@ truncateFilePath n = go . reverse
 		in if length bytes <= n
 			then reverse f
 			else go (drop 1 f)
+#else
+{- On Windows, count the number of bytes used by each utf8 character. -}
+truncateFilePath n = reverse . go [] n . L8.fromString
+  where
+	go coll cnt bs
+		| cnt <= 0 = coll
+		| otherwise = case L8.decode bs of
+			Just (c, x) | c /= L8.replacement_char ->
+				let x' = fromIntegral x
+				in if cnt - x' < 0
+					then coll
+					else go (c:coll) (cnt - x') (L8.drop 1 bs)
+			_ -> coll
+#endif

Utility/Misc.hs

@@ -109,18 +109,6 @@ massReplace vs = go [] vs
 			go (replacement:acc) vs (drop (length val) s)
 		| otherwise = go acc rest s
 
-{- Given two orderings, returns the second if the first is EQ and returns
- - the first otherwise.
- -
- - Example use:
- -
- - compare lname1 lname2 `thenOrd` compare fname1 fname2
- -}
-thenOrd :: Ordering -> Ordering -> Ordering
-thenOrd EQ x = x
-thenOrd x _ = x
-{-# INLINE thenOrd #-}
-
 {- Wrapper around hGetBufSome that returns a String.
  -
  - The null string is returned on eof, otherwise returns whatever

Utility/QuickCheck.hs

@@ -28,10 +28,10 @@ instance (Arbitrary v, Eq v, Ord v) => Arbitrary (S.Set v) where
 
 {- Times before the epoch are excluded. -}
 instance Arbitrary POSIXTime where
-	arbitrary = nonNegative arbitrarySizedIntegral
+	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral
 
 instance Arbitrary EpochTime where
-	arbitrary = nonNegative arbitrarySizedIntegral
+	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral
 
 {- Pids are never negative, or 0. -}
 instance Arbitrary ProcessID where

Utility/WebApp.hs

@@ -1,6 +1,6 @@
 {- Yesod webapp
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -36,6 +36,10 @@ import Blaze.ByteString.Builder (Builder)
 import Data.Monoid
 import Control.Arrow ((***))
 import Control.Concurrent
+#ifdef WITH_WEBAPP_SECURE
+import Data.SecureMem
+import Data.Byteable
+#endif
 #ifdef __ANDROID__
 import Data.Endian
 #endif
@@ -74,14 +78,14 @@ browserProc url = proc "xdg-open" [url]
 runWebApp :: Maybe TLSSettings -> Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO ()
 runWebApp tlssettings h app observer = withSocketsDo $ do
 	sock <- getSocket h
-	void $ forkIO $ run webAppSettings sock app	
+	void $ forkIO $ go webAppSettings sock app	
 	sockaddr <- fixSockAddr <$> getSocketName sock
 	observer sockaddr
   where
-#ifdef WITH_WEBAPP_HTTPS
+#ifdef WITH_WEBAPP_SECURE
-	run = (maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings)
+	go = (maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings)
 #else
-	run = runSettingsSocket
+	go = runSettingsSocket
 #endif
 
 fixSockAddr :: SockAddr -> SockAddr
@@ -208,15 +212,35 @@ webAppSessionBackend _ = do
 #endif
 #endif
 
-{- Generates a random sha512 string, suitable to be used for an
+#ifdef WITH_WEBAPP_SECURE
- - authentication secret. -}
+type AuthToken = SecureMem
-genRandomToken :: IO String
+#else
-genRandomToken = do
+type AuthToken = T.Text
+#endif
+
+toAuthToken :: T.Text -> AuthToken
+#ifdef WITH_WEBAPP_SECURE
+toAuthToken = secureMemFromByteString . TE.encodeUtf8
+#else
+toAuthToken = id
+#endif
+
+fromAuthToken :: AuthToken -> T.Text
+#ifdef WITH_WEBAPP_SECURE
+fromAuthToken = TE.decodeLatin1 . toBytes
+#else
+fromAuthToken = id
+#endif
+
+{- Generates a random sha512 string, encapsulated in a SecureMem,
+ - suitable to be used for an authentication secret. -}
+genAuthToken :: IO AuthToken
+genAuthToken = do
 	g <- newGenIO :: IO SystemRandom
 	return $
 		case genBytes 512 g of
-			Left e -> error $ "failed to generate secret token: " ++ show e
+			Left e -> error $ "failed to generate auth token: " ++ show e
-			Right (s, _) -> show $ sha512 $ L.fromChunks [s]
+			Right (s, _) -> toAuthToken $ T.pack $ show $ sha512 $ L.fromChunks [s]
 
 {- A Yesod isAuthorized method, which checks the auth cgi parameter
  - against a token extracted from the Yesod application.
@@ -225,15 +249,15 @@ genRandomToken = do
  - possibly leaking the auth token in urls on that page!
  -}
 #if MIN_VERSION_yesod(1,2,0)
-checkAuthToken :: (Monad m, Yesod.MonadHandler m) => (Yesod.HandlerSite m -> T.Text) -> m Yesod.AuthResult
+checkAuthToken :: (Monad m, Yesod.MonadHandler m) => (Yesod.HandlerSite m -> AuthToken) -> m Yesod.AuthResult
 #else
-checkAuthToken :: forall t sub. (t -> T.Text) -> Yesod.GHandler sub t Yesod.AuthResult
+checkAuthToken :: forall t sub. (t -> AuthToken) -> Yesod.GHandler sub t Yesod.AuthResult
 #endif
-checkAuthToken extractToken = do
+checkAuthToken extractAuthToken = do
 	webapp <- Yesod.getYesod
 	req <- Yesod.getRequest
 	let params = Yesod.reqGetParams req
-	if lookup "auth" params == Just (extractToken webapp)
+	if (toAuthToken <$> lookup "auth" params) == Just (extractAuthToken webapp)
 		then return Yesod.Authorized
 		else Yesod.sendResponseStatus unauthorized401 ()
 
@@ -243,21 +267,21 @@ checkAuthToken extractToken = do
  - 
  - A typical predicate would exclude files under /static.
  -}
-insertAuthToken :: forall y. (y -> T.Text)
+insertAuthToken :: forall y. (y -> AuthToken)
 	-> ([T.Text] -> Bool)
 	-> y
 	-> T.Text
 	-> [T.Text]
 	-> [(T.Text, T.Text)]
 	-> Builder
-insertAuthToken extractToken predicate webapp root pathbits params =
+insertAuthToken extractAuthToken predicate webapp root pathbits params =
 	fromText root `mappend` encodePath pathbits' encodedparams
   where
 	pathbits' = if null pathbits then [T.empty] else pathbits
 	encodedparams = map (TE.encodeUtf8 *** go) params'
 	go "" = Nothing
 	go x = Just $ TE.encodeUtf8 x
-	authparam = (T.pack "auth", extractToken webapp)
+	authparam = (T.pack "auth", fromAuthToken (extractAuthToken webapp))
 	params'
 		| predicate pathbits = authparam:params
 		| otherwise = params

debian/changelog

@@ -1,3 +1,43 @@
+git-annex (5.20140320) unstable; urgency=medium
+
+  * Fix zombie leak and general inneficiency when copying files to a
+    local git repo.
+  * Fix ssh connection caching stop method to work with openssh 6.5p1,
+    which broke the old method.
+  * webapp: Added a "Sync now" item to each repository's menu.
+  * webapp: Use securemem for constant time auth token comparisons.
+  * copy --fast --to remote: Avoid printing anything for files that
+    are already believed to be present on the remote.
+  * Commands that allow specifying which repository to act on using
+    the repository's description will now fail when multiple repositories
+    match, rather than picking a repository at random.
+    (So will --in=)
+  * Better workaround for problem umasks when eg, setting up ssh keys.
+  * "standard" can now be used as a first-class keyword in preferred content
+    expressions. For example "standard or (include=otherdir/*)"
+  * groupwanted can be used in preferred content expressions.
+  * vicfg: Allows editing preferred content expressions for groups.
+  * Improve behavior when unable to parse a preferred content expression
+    (thanks, ion).
+  * metadata: Add --get
+  * metadata: Support --key option (and some other ones like --all)
+  * For each metadata field, there's now an automatically maintained
+    "$field-lastchanged" that gives the date of the last change to that
+    field. Also the "lastchanged" field for the date of the last change
+    to any of a file's metadata.
+  * unused: In direct mode, files that are deleted from the work tree
+    and so have no content present are no longer incorrectly detected as
+    unused.
+  * Avoid encoding errors when using the unused log file.
+  * map: Fix crash when one of the remotes of a repo is a local directory
+    that does not exist, or is not a git repo.
+  * repair: Improve memory usage when git fsck finds a great many broken
+    objects.
+  * Windows: Fix some filename encoding bugs.
+  * rsync special remote: Fix slashes when used on Windows.
+
+ -- Joey Hess <joeyh@debian.org>  Thu, 20 Mar 2014 13:21:12 -0400
+
 git-annex (5.20140306~bpo70+1) wheezy-backports; urgency=high
 
   * Updating backport to newest release.

debian/control

@@ -38,6 +38,9 @@ Build-Depends:
 	libghc-warp-tls-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
 	libghc-wai-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
 	libghc-wai-logger-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
+	libghc-securemem-dev,
+	libghc-byteable-dev,
+	libghc-dns-dev,
 	libghc-case-insensitive-dev,
 	libghc-http-types-dev,
 	libghc-blaze-builder-dev,

doc/Android/oldcomments/comment_1_cc9caa5dd22dd67e5c1d22d697096dd2._comment

@@ -1,4 +1,4 @@
-[[!comment format=txt
+[[!comment format=mdwn
  username="http://yarikoptic.myopenid.com/"
  nickname="site-myopenid"
  subject="Does it require the device to be rooted?"

doc/assistant/remote_sharing_walkthrough/comment_6_770c4f1802fc40d76bbaf7783bb3b4ac._comment

@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="severo"
+ ip="88.182.182.135"
+ subject="git-assistant and transfer repository"
+ date="2014-03-16T17:05:43Z"
+ content="""
+In your comment http://git-annex.branchable.com/assistant/remote_sharing_walkthrough/#comment-f97efe1d05c0101232684b4e4edc4866, you describe a way to synchronize two devices using an intermediate USB drive configured as a \"transfer repository\".
+
+I understand that in that case, the USB drive can only be used as a \"transmitter\", in a git repository form, not as a copy of the files structure. This means the files contained by the USB drive cannot be accessed without git/git-annnex.
+
+Is there a way to use the USB drive as a \"client repository\" in order to allow synchronization, as described earlier, but also as a simple copy of the files, in order to access them from any device (opening them with windows in a cyber coffee for example).
+
+Thanks
+"""]]

doc/assistant/remote_sharing_walkthrough/comment_7_61c1f5b00381b2fa891a8578267881ab._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.154"
+ subject="comment 7"
+ date="2014-03-17T19:50:48Z"
+ content="""
+@severo the web app does not support setting up that use case. However, you can make a non-bare clone of your repository onto a removable drive, and if you do the assistant will use it just the same as if you'd set up a removable drive using the webapp. Note that you will need to run `git annex sync` inside that repository in order to update the tree it displays.
+"""]]

doc/assistant/remote_sharing_walkthrough/comment_8_35e00cd10e89ae4bcc66af7dadf6bb5c._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="severo"
+ ip="95.152.107.168"
+ subject="comment 8"
+ date="2014-03-18T10:06:50Z"
+ content="""
+Thansk @joeyh.name for your answer. Do you think this feature could be integrated into the git-annex assistant ?
+"""]]

doc/assistant/remote_sharing_walkthrough/comment_9_c900e4ef49388826c87cadef4235c073._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="severo"
+ ip="95.152.107.168"
+ subject="comment 9"
+ date="2014-03-18T11:16:19Z"
+ content="""
+Some explanations in French on how to do: http://seenthis.net/messages/237648#message238202
+"""]]

doc/automatic_conflict_resolution/comment_1_307898855f91a2a189d4fa5eae62cce1._comment

@@ -1,4 +1,4 @@
-[[!comment format=txt
+[[!comment format=mdwn
  username="https://www.google.com/accounts/o8/id?id=AItOawnJTqmRu1YCKS2Hsm4vtOflLhP4fU-k98w"
  nickname="Ahmed"
  subject="Customise conflict resolution behaviour"

doc/automatic_conflict_resolution/comment_2_0a8ea42764dde1a33d2112197b961c51._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawn3p4i4lk_zMilvjnJ9sS6g2nerpgz0Fjc"
+ nickname="Matthias"
+ subject="Use automatic merge without syncing"
+ date="2014-03-20T10:03:41Z"
+ content="""
+Is there a possibility to use the automatic merge logic without using \"git annex sync\"? I don't want to have the \"synced\"-branches, but the auto-conflict-resolution is very nice.
+"""]]

doc/automatic_conflict_resolution/comment_3_5c587c6633cae1c8547ca970d55ee97e._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.102"
+ subject="comment 3"
+ date="2014-03-20T16:10:10Z"
+ content="""
+@Matthias `git annex merge` will do what you want, as long as you have git-annex 4.20130709 or newer.
+"""]]

doc/bugs/Android_:_handling_DCIM__47__Camera_not_being_configurable.mdwn

@@ -11,3 +11,6 @@ In order to handle the fact that the directory where pictures are saved is not c
 In the log, there are many "too many open files" errors like these :
 
 git:createProcess: runInteractiveProcess: pipe: resource exhausted (Too many open files)
+
+[[!tag moreinfo]]
+[[!meta title="too many open files on android"]]

doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_10_b47d543e06a1a243211a2fa0cb5d09a3._comment

@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="108.236.230.124"
+ subject="comment 10"
+ date="2014-03-10T17:34:56Z"
+ content="""
+I've found the 1 second delay on failure to accept in the warp source code.
+
+It's using Network.Socket.accept, which uses accept4 with NONBLOCK by default, but can be built without `HAVE_ACCEPT4` and in that case uses `accept` with blocking.
+
+I've put in a patch to build network without accept4 support, and am rebuilding the arm autobuilder. This will take a while..
+
+"""]]

doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_11_399c1e4455dce105df95414fe3ff939d._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.154"
+ subject="comment 11"
+ date="2014-03-11T03:02:21Z"
+ content="""
+Autobuild is now updated with the accept fix.
+"""]]

doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_12_1cfdd76e751ee3726bd80359cfc85c47._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.102"
+ subject="ping?"
+ date="2014-03-19T20:29:12Z"
+ content="""
+Could either greg or Schnouki  please test with the current arm autobuild and see if you can connect to the webapp?
+"""]]

doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_5_6b9b87bfb8b94171b3dba51919fd1ceb._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.146"
+ subject="comment 5"
+ date="2014-03-06T18:12:57Z"
+ content="""
+Again the accept message does not seem to be related to dbus. A dbus client has no reason to do that; a web server does. The use of `O_NONBLOCK` with accept4 seems likely to be the culprit to me.
+
+How frequently is dbus mentioned in the log?
+"""]]

doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_6_51f35f069c95a5ea7bd4dbab47b5702b._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://schnouki.net/"
+ nickname="Schnouki"
+ subject="comment 6"
+ date="2014-03-07T08:52:12Z"
+ content="""
+Agreed, the dbus and accept messages are probably unrelated. I just commented here because it's the same bug I'm encountering.
+
+The dbus message only appears once in the log (shortly after startup). The accept messages appears every second.
+"""]]

doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_7_691661d902acbf9c11d713541d5d39e4._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.146"
+ subject="comment 7"
+ date="2014-03-07T17:03:30Z"
+ content="""
+Are you sure that the accept message happens every second? I don't see why the webapp would continue to try to bind a socket it it failed with a 1 second delay. (It does try 100 times if it fails, per [[!commit fe3009d83b08563875856152034e7c59a0c6ecca]], before ending with \"unable to bind to local socket\".)
+"""]]

doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_8_ef559feb7b350f2014055680d087c2bc._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.146"
+ subject="comment 8"
+ date="2014-03-07T17:16:41Z"
+ content="""
+greg has confirmed that he can connect to the webapp, but it never replies to http requests. So, this could be the port being bound, but the accept failing.
+
+I don't know why it would retry the accept once per second, but this could be something in warp or the network library.
+"""]]

doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_9_278b41aaa73a214b2b38881242a29b17._comment

@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="http://schnouki.net/"
+ nickname="Schnouki"
+ subject="comment 9"
+ date="2014-03-09T16:29:26Z"
+ content="""
+I did some more testing today.
+
+I have this message when using either git-annex assistant or git-annex webapp. When running the webapp, I can connect to its port, but there's no response from git-annex (either from a browser or when using telnet to send a simple \"GET / HTTP/1.0\").
+
+The accept message comes every second, the dbus one very minute (didn't test long enough last time, sorry about that).
+"""]]

doc/bugs/Auto-repair_greatly_slows_down_the_machine/comment_5_9fe529034ad0115792b58d7da99c167e._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.146"
+ subject="comment 5"
+ date="2014-03-06T18:14:37Z"
+ content="""
+auto-repair is only done if git fsck detects a problem. You can run git fsck yourself to see.
+"""]]

doc/bugs/Auto-repair_greatly_slows_down_the_machine/comment_6_93ed991ef2a74c18575073ca72e06185._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawnX1msQxnLoSeu7q-i-c9BWghonsN7Qmns"
+ nickname="Jan Ulrich"
+ subject="comment 6"
+ date="2014-03-10T14:14:06Z"
+ content="""
+I manually ran git fsck without problems but git-annex still wants to repair something.
+"""]]

doc/bugs/Backup_repository_doesn__39__t_get_all_files.mdwn

@@ -35,3 +35,6 @@ What this tells me is that any changes that occur whilst I am not networked are
 git-annex version: 5.20131130-gc25be33
 
 
+> This was fixed in 5.20140127; the assistant now does a daily sweep of
+> unused files to move them to backup repositories when possible. [[done]]
+> --[[Joey]]

doc/bugs/Bug_Report_doesn__39__t_work.mdwn

@@ -0,0 +1,20 @@
+### Please describe the problem.
+Bug Report doesn't work
+
+### What steps will reproduce the problem?
+
+
+### What version of git-annex are you using? On what operating system?
+
+
+### Please provide any additional information below.
+
+[[!format sh """
+# If you can, paste a complete transcript of the problem occurring here.
+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log
+
+
+# End of transcript or log.
+"""]]
+
+[[fixed|done]] --[[Joey]]

doc/bugs/Can__39__t_access_files_from___39__Removable_drive__39___repo_even_if_set_as_client.mdwn

@@ -19,3 +19,4 @@ I'm using 9e57edff287ac53fc4b1cefef7271e9ed17f2285 (Fri Feb 22 15:19:25 2013 +00
 Ubuntu 12.10 x86_64
 
 [[!tag /design/assistant]]
+[[!meta title="assistant should set up non-bare repos on removable drives, and update them when syncing with them"]]

doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too.mdwn

@@ -31,3 +31,6 @@ I noticed the problem yesterday afternoon (Thu 24 Oct).
 
 # End of transcript or log.
 """]]
+
+> [[moreinfo]]; either I don't have enough information to work on this,
+> or it might have just been user error. --[[Joey]]

doc/bugs/Could_not_read_from_remote_repository.mdwn

@@ -22,3 +22,5 @@ fatal: Could not read from remote repository.
 Please make sure you have the correct access rights
 and the repository exists.
 """]]
+
+[[!meta title="xmpp syncing sometimes fails"]]

doc/bugs/Disconcerting_warning_from_git-annex.mdwn

@@ -4,3 +4,5 @@ I did a "git annex add" of a bunch of files on a storage server with low IOPS, a
 failed
 
 How is that even possible, when the server is doing nothing else?
+
+[[!tag moreinfo]]

doc/bugs/Disconcerting_warning_from_git-annex/comment_3_13999207f4ddac2f9c345415f25f7ada._comment

@@ -0,0 +1,28 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.102"
+ subject="moreinfo"
+ date="2014-03-19T20:49:47Z"
+ content="""
+What I don't understand about this is, how does `open` fail due to a file being locked? This is Linux, it doesn't have mandatory locking that I know of, and git-annex certianly doesn't use such a thing.
+
+I really need a way to reproduce this and/or a strace. As it is, I've never seen this reported by anyone else and don't understand the failure mode at all.
+
+The relevant part of the code seems to be here:
+
+[[!format haskell \"\"\"
+setJournalFile :: JournalLocked -> FilePath -> String -> Annex ()
+setJournalFile _jl file content = do
+        tmp <- fromRepo gitAnnexTmpMiscDir
+        createAnnexDirectory =<< fromRepo gitAnnexJournalDir
+        createAnnexDirectory tmp
+        -- journal file is written atomically
+        jfile <- fromRepo $ journalFile file
+        let tmpfile = tmp </> takeFileName jfile
+        liftIO $ do
+                writeBinaryFile tmpfile content
+                moveFile tmpfile jfile
+\"\"\"]]
+
+While there is some ctnl locking going on, it locks a special sentinal file, not the file it's writing to.
+"""]]

doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn

@@ -19,3 +19,5 @@ This is with git-annex installed on the remote server; without it the process ge
 
 ### What version of git-annex are you using? On what operating system?
 Latest nightly build on ubuntu 13.10
+
+[[!tag moreinfo]]

doc/bugs/Incorrect_symlink_path_in_simple_submodule_use_case.mdwn

@@ -68,3 +68,5 @@ Mac OS X Mountain Lion. git-annex files are from within the downloadable git-ann
 
 
 Thanks for your help :)
+
+> This is a duplicate of [[Git_annexed_files_symlink_are_wrong_when_submodule_is_not_in_the_same_path]] [[done]] --[[Joey]]   

doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp.mdwn

@@ -0,0 +1,12 @@
+Latest build for Mac OS X (both autobuild and release versions) does not contain webapp.
+
+git annex version for OS X,
+
+    git-annex version: 5.20140306-g309a73c
+    build flags: Assistant Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash
+    key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN2 56 SKEIN512 WORM URL                                                                                                
+    remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external
+
+whereas on my Linux box build flags include webapp. On os x when I run git annex webapp it does nothing, just prints the help info.
+
+> [[fixed|done]] --[[Joey]] 

doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp/comment_1_b918a741f2397b6588e7a9f1feca7e66._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.146"
+ subject="comment 1"
+ date="2014-03-07T15:17:16Z"
+ content="""
+I've fixed the missing warp-tls dep on the autobuilder and updated the builds.
+"""]]

doc/bugs/Older_version_of_git_causes_Internal_Server_Error_when_push.default___61___simple.mdwn

@@ -62,3 +62,6 @@ My .gitconfig is as follows:
 > to a more recent version of git. done --[[Joey]] 
 >> Reopened, because the Linux autobuilds have been downgraded to Debian
 >> stable and have this problem again. --[[Joey]]
+
+>>> Closing again! Autobuilders all run unstable and will have a current
+>>> git. [[done]] --[[Joey]] 

doc/bugs/On_restart__44___most_repositories__44___including_original_one__44___gone..mdwn

@@ -228,3 +228,13 @@ Everything up-to-date
 """]]
 
 Well, I see that thing about "failed to lock". I can imagine that my 'killall git-annex' to kill a leftover process that was hanging around after I'd done git-annex assistant --stop might have left stale lock files, somewhere... but of course I only got as far as doing that because I was already encountering problems, just trying to return to the webapp.
+
+> The original bug report seems to be a case of user confusion, 
+> and not a bug. (Although perhaps the UI is confusing?)
+> 
+> The "resource exhausted" that came up later is quite likely the problem
+> fixed in [[!commit 4d06037fdd44ba38fcd4c118d1e6330f06e22366]],
+> which affected local git remotes.
+> 
+> [[closing|done]]; I don't see any value keeping this open, I'm afraid.
+> --[[Joey]]

doc/bugs/Share_with_friends_crash_in_osx.mdwn

@@ -366,3 +366,5 @@ Here is the crash report osx creates
 
 # End of transcript or log.
 """]]
+
+> Apparently this is [[fixed|done]] in the latest release. --[[Joey]]

doc/bugs/Share_with_friends_crash_in_osx/comment_12_dfde39222a91923c570e5405d9e527f4._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawkLdR1fuu5aEz3s9VKTBKVMize_SmeNRJM"
+ nickname="David"
+ subject="Seems to be working now"
+ date="2014-03-12T02:36:59Z"
+ content="""
+Just tried again off of the most recent osx release build and it appears to be working without crashing.  Not sure what else you did but thanks!
+"""]]