Merge commit '3.20110906' into debian-stable

Conflicts:
	Command/Add.hs
	debian/control
	doc/install/Fedora.mdwn
	doc/install/OSX.mdwn
	git-annex.cabal

.gitignore

@@ -2,7 +2,7 @@
 *.o
 test
 configure
-SysConfig.hs
+Build/SysConfig.hs
 git-annex
 git-annex-shell
 git-union-merge
@@ -13,7 +13,7 @@ doc/.ikiwiki
 html
 *.tix
 .hpc
-Touch.hs
+Utility/Touch.hs
-StatFS.hs
+Utility/StatFS.hs
 Remote/S3.hs
 dist

Annex.hs

@@ -5,9 +5,12 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Annex (
 	Annex,
 	AnnexState(..),
+	OutputType(..),
 	new,
 	run,
 	eval,
@@ -17,6 +20,8 @@ module Annex (
 ) where
 
 import Control.Monad.State
+import Control.Monad.IO.Control
+import Control.Applicative hiding (empty)
 
 import qualified Git
 import Git.Queue
@@ -28,7 +33,15 @@ import Types.TrustLevel
 import Types.UUID
 
 -- git-annex's monad
-type Annex = StateT AnnexState IO
+newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
+	deriving (
+		Monad,
+		MonadIO,
+		MonadControlIO,
+		MonadState AnnexState,
+		Functor,
+		Applicative
+	)
 
 -- internal state storage
 data AnnexState = AnnexState
@@ -36,7 +49,7 @@ data AnnexState = AnnexState
 	, backends :: [Backend Annex]
 	, remotes :: [Remote Annex]
 	, repoqueue :: Queue
-	, quiet :: Bool
+	, output :: OutputType
 	, force :: Bool
 	, fast :: Bool
 	, branchstate :: BranchState
@@ -51,13 +64,15 @@ data AnnexState = AnnexState
 	, cipher :: Maybe Cipher
 	}
 
+data OutputType = NormalOutput | QuietOutput | JSONOutput
+
 newState :: Git.Repo -> AnnexState
 newState gitrepo = AnnexState
 	{ repo = gitrepo
 	, backends = []
 	, remotes = []
 	, repoqueue = empty
-	, quiet = False
+	, output = NormalOutput
 	, force = False
 	, fast = False
 	, branchstate = startBranchState
@@ -74,13 +89,13 @@ newState gitrepo = AnnexState
 
 {- Create and returns an Annex state object for the specified git repo. -}
 new :: Git.Repo -> IO AnnexState
-new gitrepo = newState `liftM` (liftIO . Git.configRead) gitrepo
+new gitrepo = newState <$> Git.configRead gitrepo
 
 {- performs an action in the Annex monad -}
 run :: AnnexState -> Annex a -> IO (a, AnnexState)
-run = flip runStateT
+run s a = runStateT (runAnnex a) s
 eval :: AnnexState -> Annex a -> IO a
-eval = flip evalStateT
+eval s a = evalStateT (runAnnex a) s
 
 {- Gets a value from the internal state, selected by the passed value
  - constructor. -}

AnnexQueue.hs

@@ -17,10 +17,9 @@ import Control.Monad (when, unless)
 import Annex
 import Messages
 import qualified Git.Queue
-import Utility
+import Utility.SafeCommand
 
-{- Adds a git command to the queue, possibly running previously queued
+{- Adds a git command to the queue. -}
- - actions if enough have accumulated. -}
 add :: String -> [CommandParam] -> [FilePath] -> Annex ()
 add command params files = do
 	q <- getState repoqueue

Backend.hs

@@ -32,9 +32,10 @@ import Messages
 -- When adding a new backend, import it here and add it to the list.
 import qualified Backend.WORM
 import qualified Backend.SHA
+import qualified Backend.URL
 
 list :: [Backend Annex]
-list = Backend.WORM.backends ++ Backend.SHA.backends
+list = Backend.WORM.backends ++ Backend.SHA.backends ++ Backend.URL.backends
 
 {- List of backends in the order to try them when storing a new key. -}
 orderedList :: Annex [Backend Annex]
@@ -121,8 +122,7 @@ lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s
 	where
 		unknown = error $ "unknown backend " ++ s
 maybeLookupBackendName :: String -> Maybe (Backend Annex)
-maybeLookupBackendName s =
+maybeLookupBackendName s
-	if 1 /= length matches
+	| length matches == 1 = Just $ head matches
-		then Nothing
+	| otherwise = Nothing
-		else Just $ head matches
 	where matches = filter (\b -> s == B.name b) list

Backend/SHA.hs

@@ -23,8 +23,8 @@ import Content
 import Types
 import Types.Backend
 import Types.Key
-import Utility
+import Utility.SafeCommand
-import qualified SysConfig
+import qualified Build.SysConfig as SysConfig
 
 type SHASize = Int
 
@@ -107,7 +107,7 @@ keyValueE size file = keyValue size file >>= maybe (return Nothing) addE
 				then "" -- probably not really an extension
 				else naiveextension
 
--- A key's checksum is checked during fsck.
+{- A key's checksum is checked during fsck. -}
 checkKeyChecksum :: SHASize -> Key -> Annex Bool
 checkKeyChecksum size key = do
 	g <- Annex.gitRepo

Backend/URL.hs

@@ -0,0 +1,28 @@
+{- git-annex "URL" backend -- keys whose content is available from urls.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Backend.URL (
+	backends,
+	fromUrl
+) where
+
+import Types.Backend
+import Types.Key
+import Types
+
+backends :: [Backend Annex]
+backends = [backend]
+
+backend :: Backend Annex
+backend = Types.Backend.Backend {
+	name = "URL",
+	getKey = const (return Nothing),
+	fsckKey = const (return True)
+}
+
+fromUrl :: String -> Key
+fromUrl url = stubKey { keyName = url, keyBackendName = "URL" }

Branch.hs

@@ -14,11 +14,13 @@ module Branch (
 	files,
 	refExists,
 	hasOrigin,
+	hasSomeBranch,
 	name	
 ) where
 
 import Control.Monad (when, unless, liftM)
 import Control.Monad.State (liftIO)
+import Control.Applicative ((<$>))
 import System.FilePath
 import System.Directory
 import Data.String.Utils
@@ -36,6 +38,8 @@ import qualified Git
 import qualified Git.UnionMerge
 import qualified Annex
 import Utility
+import Utility.Conditional
+import Utility.SafeCommand
 import Types
 import Messages
 import Locations
@@ -124,7 +128,7 @@ getCache file = getState >>= handle
 
 {- Creates the branch, if it does not already exist. -}
 create :: Annex ()
-create = unlessM (refExists fullname) $ do
+create = unlessM hasBranch $ do
 	g <- Annex.gitRepo
 	e <- hasOrigin
 	if e
@@ -154,19 +158,14 @@ update = do
 		 -}
 		staged <- stageJournalFiles
 
+		refs <- siblingBranches
+		updated <- catMaybes <$> mapM updateRef refs
 		g <- Annex.gitRepo
-		r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name]
-		let refs = map (last . words) (lines r)
-		updated <- catMaybes `liftM` mapM updateRef refs
 		unless (null updated && not staged) $ liftIO $
 			Git.commit g "update" fullname (fullname:updated)
 		Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } }
 		invalidateCache
 
-{- Does origin/git-annex exist? -}
-hasOrigin :: Annex Bool
-hasOrigin = refExists originname
-
 {- Checks if a git ref exists. -}
 refExists :: GitRef -> Annex Bool
 refExists ref = do
@@ -174,6 +173,26 @@ refExists ref = do
 	liftIO $ Git.runBool g "show-ref"
 		[Param "--verify", Param "-q", Param ref]
 
+{- Does the main git-annex branch exist? -}
+hasBranch :: Annex Bool
+hasBranch = refExists fullname
+
+{- Does origin/git-annex exist? -}
+hasOrigin :: Annex Bool
+hasOrigin = refExists originname
+
+{- Does the git-annex branch or a foo/git-annex branch exist? -}
+hasSomeBranch :: Annex Bool
+hasSomeBranch = not . null <$> siblingBranches
+
+{- List of all git-annex branches, including the main one and any
+ - from remotes. -}
+siblingBranches :: Annex [String]
+siblingBranches = do
+	g <- Annex.gitRepo
+	r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name]
+	return $ map (last . words) (lines r)
+
 {- Ensures that a given ref has been merged into the index. -}
 updateRef :: GitRef -> Annex (Maybe String)
 updateRef ref
@@ -305,7 +324,7 @@ getJournalFile file = do
 
 {- List of journal files. -}
 getJournalFiles :: Annex [FilePath]
-getJournalFiles = fmap (map fileJournal) getJournalFilesRaw
+getJournalFiles = map fileJournal <$> getJournalFilesRaw
 
 getJournalFilesRaw :: Annex [FilePath]
 getJournalFilesRaw = do

Build/TestConfig.hs

@@ -1,6 +1,6 @@
-{- Tests the system and generates SysConfig.hs. -}
+{- Tests the system and generates Build.SysConfig.hs. -}
 
-module TestConfig where
+module Build.TestConfig where
 
 import System.IO
 import System.Cmd
@@ -33,12 +33,12 @@ instance Show Config where
 			valuetype (MaybeStringConfig _) = "Maybe String"
 
 writeSysConfig :: [Config] -> IO ()
-writeSysConfig config = writeFile "SysConfig.hs" body
+writeSysConfig config = writeFile "Build/SysConfig.hs" body
 	where
 		body = unlines $ header ++ map show config ++ footer
 		header = [
 			  "{- Automatically generated. -}"
-			, "module SysConfig where"
+			, "module Build.SysConfig where"
 			, ""
 			]
 		footer = []

CmdLine.hs

@@ -22,10 +22,9 @@ import qualified Git
 import Content
 import Types
 import Command
-import Version
 import Options
 import Messages
-import UUID
+import Init
 
 {- Runs the passed command line. -}
 dispatch :: [String] -> [Command] -> [Option] -> String -> Git.Repo -> IO ()
@@ -45,7 +44,7 @@ parseCmd argv header cmds options = do
 		[] -> error $ "unknown command" ++ usagemsg
 		[command] -> do
 			_ <- sequence flags
-			when (cmdusesrepo command) checkVersion
+			checkCmdEnviron command
 			prepCommand command (drop 1 params)
 		_ -> error "internal error: multiple matching commands"
 	where
@@ -57,6 +56,10 @@ parseCmd argv header cmds options = do
 		lookupCmd cmd = filter (\c -> cmd  == cmdname c) cmds
 		usagemsg = "\n\n" ++ usage header cmds options
 
+{- Checks that the command can be run in the current environment. -}
+checkCmdEnviron :: Command -> Annex ()
+checkCmdEnviron command = when (cmdusesrepo command) ensureInitialized
+
 {- Usage message with lists of commands and options. -}
 usage :: String -> [Command] -> [Option] -> String
 usage header cmds options =
@@ -86,8 +89,8 @@ tryRun' errnum state (a:as) = do
 	case result of
 		Left err -> do
 			Annex.eval state $ do
-				showEndFail
 				showErr err
+				showEndFail
 			tryRun' (errnum + 1) state as
 		Right (True,state') -> tryRun' errnum state' as
 		Right (False,state') -> tryRun' (errnum + 1) state' as
@@ -95,9 +98,7 @@ tryRun' errnum _ [] = when (errnum > 0) $ error $ show errnum ++ " failed"
 
 {- Actions to perform each time ran. -}
 startup :: Annex Bool
-startup = do
+startup = return True
-	prepUUID
-	return True
 
 {- Cleanup actions. -}
 shutdown :: Annex Bool

Command.hs

@@ -11,6 +11,7 @@ import Control.Monad.State (liftIO)
 import System.Directory
 import System.Posix.Files
 import Control.Monad (filterM, liftM, when)
+import Control.Applicative
 import System.Path.WildMatch
 import Text.Regex.PCRE.Light.Char8
 import Data.List
@@ -102,7 +103,6 @@ doCommand = start
 		stage a b = b >>= a
 		success = return True
 		failure = do
-			showOutput -- avoid clutter around error message
 			showEndFail
 			return False
 
@@ -178,14 +178,12 @@ withKeys :: CommandSeekKeys
 withKeys a params = return $ map (a . parse) params
 	where
 		parse p = fromMaybe (error "bad key") $ readKey p
-withTempFile :: CommandSeekStrings
-withTempFile a params = return $ map a params
 withNothing :: CommandSeekNothing
 withNothing a [] = return [a]
 withNothing _ _ = error "This command takes no parameters."
 
 backendPairs :: CommandSeekBackendFiles
-backendPairs a files = liftM (map a) $ Backend.chooseBackends files
+backendPairs a files = map a <$> Backend.chooseBackends files
 
 {- Filter out files those matching the exclude glob pattern,
  - if it was specified. -}
@@ -206,7 +204,7 @@ wildsRegex ws = compile regex []
 
 {- filter out symlinks -}	
 notSymlink :: FilePath -> IO Bool
-notSymlink f = liftM (not . isSymbolicLink) $ liftIO $ getSymbolicLinkStatus f
+notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
 
 {- Descriptions of params used in usage messages. -}
 paramRepeating :: String -> String
@@ -273,4 +271,4 @@ preserveOrder orig new = collect orig new
  - of git file list commands, that assumption tends to hold.
  -}
 runPreserveOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
-runPreserveOrder a files = liftM (preserveOrder files) (a files)
+runPreserveOrder a files = preserveOrder files <$> a files

Command/Add.hs

@@ -8,6 +8,7 @@
 module Command.Add where
 
 import Control.Monad.State (liftIO)
+import Control.Monad (when)
 import System.Posix.Files
 
 import Command
@@ -18,8 +19,10 @@ import LocationLog
 import Types
 import Content
 import Messages
-import Utility
+import Utility.Conditional
-import Touch
+import Utility.Touch
+import Utility.SafeCommand
+import Locations
 
 command :: [Command]
 command = [repoCommand "add" paramPath seek "add files to annex"]

Command/AddUrl.hs

@@ -14,15 +14,16 @@ import System.Directory
 
 import Command
 import qualified Backend
+import qualified Utility.Url as Url
 import qualified Remote.Web
 import qualified Command.Add
 import qualified Annex
+import qualified Backend.URL
 import Messages
 import Content
 import PresenceLog
-import Types.Key
 import Locations
-import Utility
+import Utility.Path
 
 command :: [Command]
 command = [repoCommand "addurl" paramPath seek "add urls to annex"]
@@ -42,12 +43,17 @@ start s = do
 			
 perform :: String -> FilePath -> CommandPerform
 perform url file = do
+	fast <- Annex.getState Annex.fast
+	if fast then nodownload url file else download url file
+
+download :: String -> FilePath -> CommandPerform
+download url file = do
 	g <- Annex.gitRepo
 	showAction $ "downloading " ++ url ++ " "
-	let dummykey = stubKey { keyName = url, keyBackendName = "URL" }
+	let dummykey = Backend.URL.fromUrl url
 	let tmp = gitAnnexTmpLocation g dummykey
 	liftIO $ createDirectoryIfMissing True (parentDir tmp)
-	ok <- Remote.Web.download [url] tmp
+	ok <- Url.download url tmp
 	if ok
 		then do
 			[(_, backend)] <- Backend.chooseBackends [file]
@@ -57,9 +63,16 @@ perform url file = do
 				Just (key, _) -> do
 					moveAnnex key tmp
 					Remote.Web.setUrl key url InfoPresent
-					next $ Command.Add.cleanup file key
+					next $ Command.Add.cleanup file key True
 		else stop
 
+nodownload :: String -> FilePath -> CommandPerform
+nodownload url file = do
+	let key = Backend.URL.fromUrl url
+	Remote.Web.setUrl key url InfoPresent
+	
+	next $ Command.Add.cleanup file key False
+
 url2file :: URI -> IO FilePath
 url2file url = do
 	let parts = filter safe $ split "/" $ uriPath url
@@ -75,8 +88,7 @@ url2file url = do
 			e <- doesFileExist file
 			when e $ error "already have this url"
 			return file
-		safe s
+		safe "" = False
-			| null s = False
+		safe "." = False
-			| s == "." = False
+		safe ".." = False
-			| s == ".." = False
+		safe _ = True
-			| otherwise = True

Command/ConfigList.hs

@@ -14,7 +14,7 @@ import Command
 import UUID
 
 command :: [Command]
-command = [standaloneCommand "configlist" paramNothing seek
+command = [repoCommand "configlist" paramNothing seek
 		"outputs relevant git configuration"]
 
 seek :: [CommandSeek]

Command/Drop.hs

@@ -15,6 +15,7 @@ import Types
 import Content
 import Messages
 import Utility
+import Utility.Conditional
 import Trust
 import Config
 

Command/DropUnused.hs

@@ -22,7 +22,7 @@ import qualified Command.Move
 import qualified Remote
 import qualified Git
 import Types.Key
-import Utility
+import Utility.Conditional
 
 type UnusedMap = M.Map String Key
 

Command/Find.hs

@@ -11,7 +11,7 @@ import Control.Monad.State (liftIO)
 
 import Command
 import Content
-import Utility
+import Utility.Conditional
 
 command :: [Command]
 command = [repoCommand "find" (paramOptional $ paramRepeating paramPath) seek

Command/Fix.hs

@@ -13,7 +13,8 @@ import System.Directory
 
 import Command
 import qualified AnnexQueue
-import Utility
+import Utility.Path
+import Utility.SafeCommand
 import Content
 import Messages
 

Command/FromKey.hs

@@ -14,10 +14,11 @@ import Control.Monad (unless)
 
 import Command
 import qualified AnnexQueue
-import Utility
+import Utility.SafeCommand
 import Content
 import Messages
 import Types.Key
+import Utility.Path
 
 command :: [Command]
 command = [repoCommand "fromkey" paramPath seek

Command/Fsck.hs

@@ -27,6 +27,7 @@ import LocationLog
 import Locations
 import Trust
 import Utility.DataUnits
+import Utility.Path
 import Config
 
 command :: [Command]
@@ -130,7 +131,7 @@ checkKeyNumCopies key file numcopies = do
 	let present = length safelocations
 	if present < needed
 		then do
-			ppuuids <- Remote.prettyPrintUUIDs untrustedlocations
+			ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations
 			warning $ missingNote (filename file key) present needed ppuuids
 			return False
 		else return True

Command/Init.hs

@@ -7,31 +7,21 @@
 
 module Command.Init where
 
-import Control.Monad.State (liftIO)
-import Control.Monad (when, unless)
-import System.Directory
-
 import Command
 import qualified Annex
-import qualified Git
-import qualified Branch
 import UUID
-import Version
 import Messages
-import Types
+import Init
-import Utility
 	
 command :: [Command]
 command = [standaloneCommand "init" paramDesc seek
-		"initialize git-annex with repository description"]
+		"initialize git-annex"]
 
 seek :: [CommandSeek]
 seek = [withWords start]
 
 start :: CommandStartWords
 start ws = do
-	when (null description) $
-		error "please specify a description of this repository\n"
 	showStart "init" description
 	next $ perform description
 	where
@@ -39,34 +29,8 @@ start ws = do
 
 perform :: String -> CommandPerform
 perform description = do
-	Branch.create
+	initialize
 	g <- Annex.gitRepo
 	u <- getUUID g
-	setVersion
 	describeUUID u description
-	unless (Git.repoIsLocalBare g) $
-		gitPreCommitHookWrite g
 	next $ return True
-
-{- set up a git pre-commit hook, if one is not already present -}
-gitPreCommitHookWrite :: Git.Repo -> Annex ()
-gitPreCommitHookWrite repo = do
-	exists <- liftIO $ doesFileExist hook
-	if exists
-		then warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
-		else liftIO $ do
-			viaTmp writeFile hook preCommitScript
-			p <- getPermissions hook
-			setPermissions hook $ p {executable = True}
-	where
-		hook = preCommitHook repo
-
-preCommitHook :: Git.Repo -> FilePath
-preCommitHook repo = 
-	Git.workTree repo ++ "/" ++ Git.gitDir repo ++ "/hooks/pre-commit"
-
-preCommitScript :: String
-preCommitScript = 
-		"#!/bin/sh\n" ++
-		"# automatically configured by git-annex\n" ++ 
-		"git annex pre-commit .\n"

Command/Lock.hs

@@ -13,7 +13,7 @@ import System.Directory
 import Command
 import Messages
 import qualified AnnexQueue
-import Utility
+import Utility.SafeCommand
 	
 command :: [Command]
 command = [repoCommand "lock" paramPath seek "undo unlock command"]

Command/Map.hs

@@ -19,10 +19,10 @@ import qualified Annex
 import qualified Git
 import Messages
 import Types
-import Utility
+import Utility.SafeCommand
 import UUID
 import Trust
-import Remote.Ssh
+import Utility.Ssh
 import qualified Utility.Dot as Dot
 
 -- a link from the first repository to the second (its remote)

Command/Migrate.hs

@@ -8,6 +8,7 @@
 module Command.Migrate where
 
 import Control.Monad.State (liftIO)
+import Control.Applicative
 import System.Posix.Files
 import System.Directory
 import System.FilePath
@@ -20,7 +21,7 @@ import Locations
 import Types
 import Content
 import Messages
-import Utility
+import Utility.Conditional
 import qualified Command.Add
 
 command :: [Command]
@@ -39,7 +40,7 @@ start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
 			next $ perform file key newbackend
 		else stop
 	where
-		choosebackend Nothing = return . head =<< Backend.orderedList
+		choosebackend Nothing = head <$> Backend.orderedList
 		choosebackend (Just backend) = return backend
 
 {- Checks if a key is upgradable to a newer representation. -}
@@ -72,7 +73,7 @@ perform file oldkey newbackend = do
 				then do
 					-- Update symlink to use the new key.
 					liftIO $ removeFile file
-					next $ Command.Add.cleanup file newkey
+					next $ Command.Add.cleanup file newkey True
 				else stop
 	where
 		cleantmp t = whenM (doesFileExist t) $ removeFile t

Command/RecvKey.hs

@@ -13,8 +13,8 @@ import System.Exit
 import Command
 import CmdLine
 import Content
-import Utility
 import Utility.RsyncFile
+import Utility.Conditional
 
 command :: [Command]
 command = [repoCommand "recvkey" paramKey seek

Command/SendKey.hs

@@ -14,8 +14,8 @@ import Locations
 import qualified Annex
 import Command
 import Content
-import Utility
 import Utility.RsyncFile
+import Utility.Conditional
 import Messages
 
 command :: [Command]

Command/SetKey.hs

@@ -10,7 +10,7 @@ module Command.SetKey where
 import Control.Monad.State (liftIO)
 
 import Command
-import Utility
+import Utility.SafeCommand
 import LocationLog
 import Content
 import Messages
@@ -20,7 +20,7 @@ command = [repoCommand "setkey" paramPath seek
 	"sets annexed content for a key using a temp file"]
 
 seek :: [CommandSeek]
-seek = [withTempFile start]
+seek = [withStrings start]
 
 {- Sets cached content for a key. -}
 start :: CommandStartString

Command/Status.hs

@@ -8,6 +8,7 @@
 module Command.Status where
 
 import Control.Monad.State
+import Control.Applicative
 import Data.Maybe
 import System.IO
 import Data.List
@@ -112,12 +113,10 @@ total_annex_size = stat "total annex size" $
 	cachedKeysReferenced >>= keySizeSum
 
 local_annex_keys :: Stat
-local_annex_keys = stat "local annex keys" $ 
+local_annex_keys = stat "local annex keys" $ show . snd <$> cachedKeysPresent
-	return . show . snd =<< cachedKeysPresent
 
 total_annex_keys :: Stat
-total_annex_keys = stat "total annex keys" $
+total_annex_keys = stat "total annex keys" $ show . snd <$> cachedKeysReferenced
-	return . show . snd =<< cachedKeysReferenced
 
 tmp_size :: Stat
 tmp_size = staleSize "temporary directory size" gitAnnexTmpDir
@@ -126,8 +125,7 @@ bad_data_size :: Stat
 bad_data_size = staleSize "bad keys size" gitAnnexBadDir
 
 backend_usage :: Stat
-backend_usage = stat "backend usage" $
+backend_usage = stat "backend usage" $ usage <$> cachedKeysReferenced
-	return . usage =<< cachedKeysReferenced
 	where
 		usage (ks, _) = pp "" $ sort $ map swap $ splits ks
 		splits :: [Key] -> [(String, Integer)]

Command/Unannex.hs

@@ -16,7 +16,8 @@ import Command
 import qualified Command.Drop
 import qualified Annex
 import qualified AnnexQueue
-import Utility
+import Utility.SafeCommand
+import Utility.Path
 import LocationLog
 import Types
 import Content

Command/Uninit.hs

@@ -12,13 +12,11 @@ import System.Directory
 import System.Exit
 
 import Command
-import Messages
+import Utility.SafeCommand
-import Types
-import Utility
 import qualified Git
 import qualified Annex
 import qualified Command.Unannex
-import qualified Command.Init
+import Init
 import qualified Branch
 import Content
 import Locations
@@ -47,7 +45,7 @@ perform = next cleanup
 cleanup :: CommandCleanup
 cleanup = do
 	g <- Annex.gitRepo
-	gitPreCommitHookUnWrite g
+	uninitialize
 	mapM_ removeAnnex =<< getKeysPresent
 	liftIO $ removeDirectoryRecursive (gitAnnexDir g)
 	-- avoid normal shutdown
@@ -55,14 +53,3 @@ cleanup = do
 	liftIO $ do
 		Git.run g "branch" [Param "-D", Param Branch.name]
 		exitSuccess
-
-gitPreCommitHookUnWrite :: Git.Repo -> Annex ()
-gitPreCommitHookUnWrite repo = do
-	let hook = Command.Init.preCommitHook repo
-	whenM (liftIO $ doesFileExist hook) $ do
-		c <- liftIO $ readFile hook
-		if c == Command.Init.preCommitScript
-			then liftIO $ removeFile hook
-			else warning $ "pre-commit hook (" ++ hook ++ 
-				") contents modified; not deleting." ++
-				" Edit it to remove call to git annex."

Command/Unlock.hs

@@ -16,8 +16,9 @@ import Types
 import Messages
 import Locations
 import Content
+import Utility.Conditional
 import Utility.CopyFile
-import Utility
+import Utility.Path
 
 command :: [Command]
 command =

Command/Unused.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE BangPatterns #-}
+
 module Command.Unused where
 
 import Control.Monad (filterM, unless, forM_)
@@ -78,9 +80,12 @@ checkRemoteUnused' r = do
 		showLongNote $ remoteUnusedMsg r list
 		showLongNote "\n"
 	where
+		{- This should run strictly to avoid the filterM
+		 - building many thunks containing keyLocations data. -}
 		isthere k = do
 			us <- keyLocations k
-			return $ uuid `elem` us
+			let !there = uuid `elem` us
+			return there
 		uuid = Remote.uuid r
 
 writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex ()

Command/Version.hs

@@ -12,7 +12,7 @@ import Data.String.Utils
 import Data.Maybe
 
 import Command
-import qualified SysConfig
+import qualified Build.SysConfig as SysConfig
 import Version
 
 command :: [Command]

Command/Whereis.hs

@@ -33,7 +33,7 @@ perform key = do
 	if null uuids
 		then stop
 		else do
-			pp <- prettyPrintUUIDs uuids
+			pp <- prettyPrintUUIDs "whereis" uuids
 			showLongNote pp
 			showOutput
 			next $ return True

Config.hs

@@ -9,11 +9,14 @@ module Config where
 
 import Data.Maybe
 import Control.Monad.State (liftIO)
+import Control.Applicative
+import System.Cmd.Utils
 
 import qualified Git
 import qualified Annex
 import Types
 import Utility
+import Utility.SafeCommand
 
 type ConfigKey = String
 
@@ -37,17 +40,22 @@ getConfig r key def = do
 remoteConfig :: Git.Repo -> ConfigKey -> String
 remoteConfig r key = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-" ++ key
 
-{- Calculates cost for a remote.
+{- Calculates cost for a remote. Either the default, or as configured 
- -
+ - by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
- - The default cost is 100 for local repositories, and 200 for remote
+ - is set and prints a number, that is used.
- - repositories; it can also be configured by remote.<name>.annex-cost
  -}
 remoteCost :: Git.Repo -> Int -> Annex Int
 remoteCost r def = do
-	c <- getConfig r "cost" ""
+	cmd <- getConfig r "cost-command" ""
-	if not $ null c
+	safeparse <$> if not $ null cmd
-		then return $ read c
+			then liftIO $ snd <$> pipeFrom "sh" ["-c", cmd]
-		else return def
+			else getConfig r "cost" ""
+	where
+		safeparse v
+			| null ws = def
+			| otherwise = fromMaybe def $ readMaybe $ head ws
+			where
+				ws = words v
 
 cheapRemoteCost :: Int
 cheapRemoteCost = 100

Content.hs

@@ -23,11 +23,10 @@ module Content (
 	saveState
 ) where
 
-import System.IO.Error (try)
 import System.Directory
 import Control.Monad.State (liftIO)
 import System.Path
-import Control.Monad (when, filterM)
+import Control.Monad
 import System.Posix.Files
 import System.FilePath
 import Data.Maybe
@@ -41,7 +40,9 @@ import qualified Annex
 import qualified AnnexQueue
 import qualified Branch
 import Utility
-import StatFS
+import Utility.Conditional
+import Utility.StatFS
+import Utility.Path
 import Types.Key
 import Utility.DataUnits
 import Config
@@ -252,15 +253,8 @@ getKeysPresent' dir = do
 			levela <- dirContents dir
 			levelb <- mapM dirContents levela
 			contents <- mapM dirContents (concat levelb)
-			files <- filterM present (concat contents)
+			let files = concat contents
 			return $ mapMaybe (fileKey . takeFileName) files
-	where
-		present d = do
-			result <- try $
-				getFileStatus $ d </> takeFileName d
-			case result of
-				Right s -> return $ isRegularFile s
-				Left _ -> return False
 
 {- Things to do to record changes to content. -}
 saveState :: Annex ()

Crypto.hs

@@ -38,6 +38,7 @@ import System.IO
 import System.Posix.IO
 import System.Posix.Types
 import System.Posix.Process
+import Control.Applicative
 import Control.Concurrent
 import Control.Exception (finally)
 import System.Exit
@@ -48,6 +49,7 @@ import Types.Key
 import Types.Remote
 import Utility
 import Utility.Base64
+import Utility.SafeCommand
 import Types.Crypto
 
 {- The first half of a Cipher is used for HMAC; the remainder
@@ -135,7 +137,7 @@ encryptCipher (Cipher c) (KeyIds ks) = do
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: RemoteConfig -> EncryptedCipher -> IO Cipher
 decryptCipher _ (EncryptedCipher encipher _) = 
-	return . Cipher =<< gpgPipeStrict decrypt encipher
+	Cipher <$> gpgPipeStrict decrypt encipher
 	where
 		decrypt = [ Param "--decrypt" ]
 

Git.hs

@@ -17,6 +17,7 @@ module Git (
 	localToUrl,
 	repoIsUrl,
 	repoIsSsh,
+	repoIsHttp,
 	repoIsLocalBare,
 	repoDescribe,
 	repoLocation,
@@ -62,6 +63,7 @@ module Git (
 ) where
 
 import Control.Monad (unless, when)
+import Control.Applicative
 import System.Directory
 import System.FilePath
 import System.Posix.Directory
@@ -84,6 +86,9 @@ import System.Exit
 import System.Posix.Env (setEnv, unsetEnv, getEnv)
 
 import Utility
+import Utility.Path
+import Utility.Conditional
+import Utility.SafeCommand
 
 {- There are two types of repositories; those on local disk and those
  - accessed via an URL. -}
@@ -206,6 +211,13 @@ repoIsSsh Repo { location = Url url }
 	| otherwise = False
 repoIsSsh _ = False
 
+repoIsHttp :: Repo -> Bool
+repoIsHttp Repo { location = Url url } 
+	| uriScheme url == "http:" = True
+	| uriScheme url == "https:" = True
+	| otherwise = False
+repoIsHttp _ = False
+
 configAvail ::Repo -> Bool
 configAvail Repo { config = c } = c /= M.empty
 
@@ -239,11 +251,11 @@ attributes repo
 	| configBare repo = workTree repo ++ "/info/.gitattributes"
 	| otherwise = workTree repo ++ "/.gitattributes"
 
-{- Path to a repository's .git directory, relative to its workTree. -}
+{- Path to a repository's .git directory. -}
 gitDir :: Repo -> String
 gitDir repo
-	| configBare repo = ""
+	| configBare repo = workTree repo
-	| otherwise = ".git"
+	| otherwise = workTree repo </> ".git"
 
 {- Path to a repository's --work-tree, that is, its top.
  -
@@ -337,10 +349,10 @@ urlAuthPart _ repo = assertUrl repo $ error "internal"
 
 {- Constructs a git command line operating on the specified repo. -}
 gitCommandLine :: Repo -> [CommandParam] -> [CommandParam]
-gitCommandLine repo@(Repo { location = Dir d} ) params =
+gitCommandLine repo@(Repo { location = Dir _ } ) params =
 	-- force use of specified repo via --git-dir and --work-tree
-	[ Param ("--git-dir=" ++ d ++ "/" ++ gitDir repo)
+	[ Param ("--git-dir=" ++ gitDir repo)
-	, Param ("--work-tree=" ++ d)
+	, Param ("--work-tree=" ++ workTree repo)
 	] ++ params
 gitCommandLine repo _ = assertLocal repo $ error "internal"
 
@@ -435,7 +447,7 @@ commit g message newref parentrefs = do
 		pipeWriteRead g (map Param $ ["commit-tree", tree] ++ ps) message
 	run g "update-ref" [Param newref, Param sha]
 	where
-		ignorehandle a = return . snd =<< a
+		ignorehandle a = snd <$> a
 		ps = concatMap (\r -> ["-p", r]) parentrefs
 
 {- Reads null terminated output of a git command (as enabled by the -z 

Git/LsFiles.hs

@@ -16,7 +16,7 @@ module Git.LsFiles (
 ) where
 
 import Git
-import Utility
+import Utility.SafeCommand
 
 {- Scans for files that are checked into git at the specified locations. -}
 inRepo :: Repo -> [FilePath] -> IO [FilePath]

Git/Queue.hs

@@ -19,15 +19,15 @@ import System.IO
 import System.Cmd.Utils
 import Data.String.Utils
 import Control.Monad (forM_)
-import Utility
+import Utility.SafeCommand
 
 import Git
 
 {- An action to perform in a git repository. The file to act on
  - is not included, and must be able to be appended after the params. -}
-data Action = Action {
+data Action = Action
-		getSubcommand :: String,
+	{ getSubcommand :: String
-		getParams :: [CommandParam]
+	, getParams :: [CommandParam]
 	} deriving (Show, Eq, Ord)
 
 {- A queue of actions to perform (in any order) on a git repository,

Git/UnionMerge.hs

@@ -18,7 +18,7 @@ import Data.Maybe
 import Data.String.Utils
 
 import Git
-import Utility
+import Utility.SafeCommand
 
 {- Performs a union merge between two branches, staging it in the index.
  - Any previously staged changes in the index will be lost.

Init.hs

@@ -0,0 +1,89 @@
+{- git-annex repository initialization
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Init (
+	ensureInitialized,
+	initialize,
+	uninitialize
+) where
+
+import Control.Monad.State (liftIO)
+import Control.Monad (unless)
+import System.Directory
+
+import qualified Annex
+import qualified Git
+import qualified Branch
+import Version
+import Messages
+import Types
+import Utility
+import Utility.Conditional
+import UUID
+
+initialize :: Annex ()
+initialize = do
+	prepUUID
+	Branch.create
+	setVersion
+	gitPreCommitHookWrite
+
+uninitialize :: Annex ()
+uninitialize = do
+	gitPreCommitHookUnWrite
+
+{- Will automatically initialize if there is already a git-annex
+   branch from somewhere. Otherwise, require a manual init
+   to avoid git-annex accidentially being run in git
+   repos that did not intend to use it. -}
+ensureInitialized :: Annex ()
+ensureInitialized = getVersion >>= maybe needsinit checkVersion
+	where
+		needsinit = do
+			annexed <- Branch.hasSomeBranch
+			if annexed
+				then initialize
+				else error "First run: git-annex init"
+
+{- set up a git pre-commit hook, if one is not already present -}
+gitPreCommitHookWrite :: Annex ()
+gitPreCommitHookWrite = unlessBare $ do
+	hook <- preCommitHook
+	exists <- liftIO $ doesFileExist hook
+	if exists
+		then warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
+		else liftIO $ do
+			viaTmp writeFile hook preCommitScript
+			p <- getPermissions hook
+			setPermissions hook $ p {executable = True}
+
+gitPreCommitHookUnWrite :: Annex ()
+gitPreCommitHookUnWrite = unlessBare $ do
+	hook <- preCommitHook
+	whenM (liftIO $ doesFileExist hook) $ do
+		c <- liftIO $ readFile hook
+		if c == preCommitScript
+			then liftIO $ removeFile hook
+			else warning $ "pre-commit hook (" ++ hook ++ 
+				") contents modified; not deleting." ++
+				" Edit it to remove call to git annex."
+
+unlessBare :: Annex () -> Annex ()
+unlessBare a = do
+	g <- Annex.gitRepo
+	unless (Git.repoIsLocalBare g) a
+
+preCommitHook :: Annex FilePath
+preCommitHook = do
+	g <- Annex.gitRepo
+	return $ Git.gitDir g ++ "/hooks/pre-commit"
+
+preCommitScript :: String
+preCommitScript = 
+		"#!/bin/sh\n" ++
+		"# automatically configured by git-annex\n" ++ 
+		"git annex pre-commit .\n"

LocationLog.hs

@@ -24,6 +24,7 @@ module LocationLog (
 
 import System.FilePath
 import Control.Monad (when)
+import Control.Applicative
 import Data.Maybe
 
 import qualified Git
@@ -49,7 +50,7 @@ keyLocations key = currentLog $ logFile key
 {- Finds all keys that have location log information.
  - (There may be duplicate keys in the list.) -}
 loggedKeys :: Annex [Key]
-loggedKeys = return . mapMaybe (logFileKey . takeFileName) =<< Branch.files
+loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Branch.files
 
 {- The filename of the log file for a given key. -}
 logFile :: Key -> String

Makefile

@@ -8,12 +8,11 @@ GHCMAKE=ghc $(GHCFLAGS) --make
 
 bins=git-annex git-annex-shell git-union-merge
 mans=git-annex.1 git-annex-shell.1 git-union-merge.1
+sources=Build/SysConfig.hs Utility/StatFS.hs Utility/Touch.hs Remote/S3.hs
 
 all: $(bins) $(mans) docs
 
-sources: SysConfig.hs StatFS.hs Touch.hs Remote/S3.hs
+Build/SysConfig.hs: configure.hs Build/TestConfig.hs
-
-SysConfig.hs: configure.hs TestConfig.hs
 	$(GHCMAKE) configure
 	./configure
 
@@ -30,7 +29,9 @@ Remote/S3.o: Remote/S3.hs
 		echo "** building without S3 support"; \
 	fi
 
-$(bins): SysConfig.hs Touch.hs StatFS.hs Remote/S3.o
+sources: $(sources)
+
+$(bins): sources
 	$(GHCMAKE) $@
 
 git-annex.1: doc/git-annex.mdwn
@@ -54,7 +55,9 @@ test: $(bins)
 	@if ! $(GHCMAKE) -O0 test; then \
 		echo "** not running test suite" >&2; \
 	else \
-		./test; \
+		if ! ./test; then \
+			echo "** test suite failed!" >&2; \
+		fi; \
 	fi
 
 testcoverage: $(bins)
@@ -82,8 +85,7 @@ docs: $(mans)
 		--exclude='news/.*'
 
 clean:
-	rm -rf build $(bins) $(mans) test configure  *.tix .hpc \
+	rm -rf build $(bins) $(mans) test configure  *.tix .hpc $(sources)
-		StatFS.hs Touch.hs SysConfig.hs Remote/S3.hs
 	rm -rf doc/.ikiwiki html dist
 	find . \( -name \*.o -or -name \*.hi \) -exec rm {} \;
 

Messages.hs

@@ -5,28 +5,40 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Messages where
+module Messages (
+	showStart,
+	showNote,
+	showAction,
+	showProgress,
+	showSideAction,
+	showOutput,
+	showLongNote,
+	showEndOk,
+	showEndFail,
+	showEndResult,
+	showErr,
+	warning,
+	indent,
+	maybeShowJSON,
+	setupConsole
+) where
 
 import Control.Monad.State (liftIO)
 import System.IO
-import Control.Monad (unless)
 import Data.String.Utils
+import Text.JSON
 
 import Types
 import qualified Annex
-
+import qualified Messages.JSON as JSON
-verbose :: Annex () -> Annex ()
-verbose a = do
-	q <- Annex.getState Annex.quiet
-	unless q a
 
 showStart :: String -> String -> Annex ()
-showStart command file = verbose $ liftIO $ do
+showStart command file = handle (JSON.start command file) $ do
 	putStr $ command ++ " " ++ file ++ " "
 	hFlush stdout
 
 showNote :: String -> Annex ()
-showNote s = verbose $ liftIO $ do
+showNote s = handle (JSON.note s) $ do
 	putStr $ "(" ++ s ++ ") "
 	hFlush stdout
 
@@ -34,40 +46,44 @@ showAction :: String -> Annex ()
 showAction s = showNote $ s ++ "..."
 
 showProgress :: Annex ()
-showProgress = verbose $ liftIO $ do
+showProgress = handle q $ do
 	putStr "."
 	hFlush stdout
 
 showSideAction :: String -> Annex ()
-showSideAction s = verbose $ liftIO $ putStrLn $ "(" ++ s ++ "...)"
+showSideAction s = handle q $ putStrLn $ "(" ++ s ++ "...)"
 
 showOutput :: Annex ()
-showOutput = verbose $ liftIO $ putStr "\n"
+showOutput = handle q $ putStr "\n"
 
 showLongNote :: String -> Annex ()
-showLongNote s = verbose $ liftIO $ putStr $ '\n' : indent s
+showLongNote s = handle (JSON.note s) $ putStr $ '\n' : indent s
 
 showEndOk :: Annex ()
-showEndOk = verbose $ liftIO $ putStrLn "ok"
+showEndOk = showEndResult True
 
 showEndFail :: Annex ()
-showEndFail = verbose $ liftIO $ putStrLn "failed"
+showEndFail = showEndResult False
 
 showEndResult :: Bool -> Annex ()
-showEndResult True = showEndOk
+showEndResult b = handle (JSON.end b) $ putStrLn msg
-showEndResult False = showEndFail
+	where
+		msg
+			| b = "ok"
+			| otherwise = "failed"
 
 showErr :: (Show a) => a -> Annex ()
-showErr e = liftIO $ do
+showErr e = warning' $ "git-annex: " ++ show e
-	hFlush stdout
-	hPutStrLn stderr $ "git-annex: " ++ show e
 
 warning :: String -> Annex ()
-warning w = do
+warning w = warning' (indent w)
-	verbose $ liftIO $ putStr "\n"
+
+warning' :: String -> Annex ()
+warning' w = do
+	handle q $ putStr "\n"
 	liftIO $ do
 		hFlush stdout
-		hPutStrLn stderr $ indent w
+		hPutStrLn stderr w
 
 indent :: String -> String
 indent s = join "\n" $ map (\l -> "  " ++ l) $ lines s
@@ -84,3 +100,18 @@ setupConsole :: IO ()
 setupConsole = do
 	hSetBinaryMode stdout True
 	hSetBinaryMode stderr True
+
+handle :: IO () -> IO () -> Annex ()
+handle json normal = do
+	output <- Annex.getState Annex.output
+	case output of
+		Annex.NormalOutput -> liftIO normal
+		Annex.QuietOutput -> q
+		Annex.JSONOutput -> liftIO json
+
+{- Shows a JSON value only when in json mode. -}
+maybeShowJSON :: JSON a => [(String, a)] -> Annex ()
+maybeShowJSON v = handle (JSON.add v) q
+
+q :: Monad m => m ()
+q = return ()

Messages/JSON.hs

@@ -0,0 +1,29 @@
+{- git-annex JSON output
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Messages.JSON (
+	start,
+	end,
+	note,
+	add
+) where
+
+import Text.JSON
+
+import qualified Utility.JSONStream as Stream
+
+start :: String -> String -> IO ()
+start command file = putStr $ Stream.start [("command", command), ("file", file)]
+
+end :: Bool -> IO ()
+end b = putStr $ Stream.add [("success", b)] ++ Stream.end
+
+note :: String -> IO ()
+note s = add [("note", s)]
+
+add :: JSON a => [(String, a)] -> IO ()
+add v = putStr $ Stream.add v

Options.hs

@@ -26,10 +26,12 @@ commonOptions =
 		"allow actions that may lose annexed data"
 	, Option ['F'] ["fast"] (NoArg (setfast True))
 		"avoid slow operations"
-	, Option ['q'] ["quiet"] (NoArg (setquiet True))
+	, Option ['q'] ["quiet"] (NoArg (setoutput Annex.QuietOutput))
 		"avoid verbose output"
-	, Option ['v'] ["verbose"] (NoArg (setquiet False))
+	, Option ['v'] ["verbose"] (NoArg (setoutput Annex.NormalOutput))
 		"allow verbose output (default)"
+	, Option ['j'] ["json"] (NoArg (setoutput Annex.JSONOutput))
+		"enable JSON output"
 	, Option ['d'] ["debug"] (NoArg (setdebug))
 		"show debug messages"
 	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
@@ -38,7 +40,7 @@ commonOptions =
 	where
 		setforce v = Annex.changeState $ \s -> s { Annex.force = v }
 		setfast v = Annex.changeState $ \s -> s { Annex.fast = v }
-		setquiet v = Annex.changeState $ \s -> s { Annex.quiet = v }
+		setoutput v = Annex.changeState $ \s -> s { Annex.output = v }
 		setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
 		setdebug = liftIO $ updateGlobalLogger rootLoggerName $
 			setLevel DEBUG

PresenceLog.hs

@@ -15,10 +15,12 @@ module PresenceLog (
 	LogStatus(..),
 	addLog,
 	readLog,
+	parseLog,
 	writeLog,
 	logNow,
 	compactLog,
-	currentLog
+	currentLog,
+	LogLine
 ) where
 
 import Data.Time.Clock.POSIX
@@ -26,6 +28,7 @@ import Data.Time
 import System.Locale
 import qualified Data.Map as Map
 import Control.Monad.State (liftIO)
+import Control.Applicative
 
 import qualified Branch
 import Types
@@ -79,7 +82,7 @@ addLog file line = do
 {- Reads a log file.
  - Note that the LogLines returned may be in any order. -}
 readLog :: FilePath -> Annex [LogLine]
-readLog file = return . parseLog =<< Branch.get file
+readLog file = parseLog <$> Branch.get file
 
 parseLog :: String -> [LogLine]
 parseLog s = filter parsable $ map read $ lines s

Remote.hs

@@ -29,11 +29,14 @@ module Remote (
 	forceTrust
 ) where
 
-import Control.Monad (filterM, liftM2)
+import Control.Monad (filterM)
 import Data.List
 import qualified Data.Map as M
 import Data.String.Utils
 import Data.Maybe
+import Control.Applicative
+import Text.JSON
+import Text.JSON.Generic
 
 import Types
 import Types.Remote
@@ -111,30 +114,40 @@ nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
 nameToUUID n = do
 	res <- byName' n
 	case res of
-		Left e -> return . fromMaybe (error e) =<< byDescription
+		Left e -> fromMaybe (error e) <$> byDescription
 		Right r -> return $ uuid r
 	where
-		byDescription = return . M.lookup n . invertMap =<< uuidMap
+		byDescription = M.lookup n . invertMap <$> uuidMap
 		invertMap = M.fromList . map swap . M.toList
 		swap (a, b) = (b, a)
 
-{- Pretty-prints a list of UUIDs of remotes. -}
+{- Pretty-prints a list of UUIDs of remotes, for human display.
-prettyPrintUUIDs :: [UUID] -> Annex String
+ -
-prettyPrintUUIDs uuids = do
+ - Shows descriptions from the uuid log, falling back to remote names,
+ - as some remotes may not be in the uuid log.
+ -
+ - When JSON is enabled, also generates a machine-readable description
+ - of the UUIDs. -}
+prettyPrintUUIDs :: String -> [UUID] -> Annex String
+prettyPrintUUIDs desc uuids = do
 	here <- getUUID =<< Annex.gitRepo
-	-- Show descriptions from the uuid log, falling back to remote names,
+	m <- M.union <$> uuidMap <*> availMap
-	-- as some remotes may not be in the uuid log
+	maybeShowJSON [(desc, map (jsonify m here) uuids)]
-	m <- liftM2 M.union uuidMap $
+	return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") uuids
-		return . M.fromList . map (\r -> (uuid r, name r)) =<< genList
-	return $ unwords $ map (\u -> "\t" ++ prettify m u here ++ "\n") uuids
 	where
-		prettify m u here = base ++ ishere
+		availMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList
+		findlog m u = M.findWithDefault "" u m
+		prettify m here u = base ++ ishere
 			where
 				base = if not $ null $ findlog m u
 					then u ++ "  -- " ++ findlog m u
 					else u
 				ishere = if here == u then " <-- here" else ""
-		findlog m u = M.findWithDefault "" u m
+		jsonify m here u = toJSObject
+			[ ("uuid", toJSON u)
+			, ("description", toJSON $ findlog m u)
+			, ("here", toJSON $ here == u)
+			]
 
 {- Filters a list of remotes to ones that have the listed uuids. -}
 remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
@@ -147,7 +160,7 @@ remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
 {- Cost ordered lists of remotes that the LocationLog indicate may have a key.
  -}
 keyPossibilities :: Key -> Annex [Remote Annex]
-keyPossibilities key = return . fst =<< keyPossibilities' False key
+keyPossibilities key = fst <$> keyPossibilities' False key
 
 {- Cost ordered lists of remotes that the LocationLog indicate may have a key.
  -
@@ -185,8 +198,8 @@ showLocations key exclude = do
 	untrusteduuids <- trustGet UnTrusted
 	let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids) 
 	let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted)
-	ppuuidswanted <- Remote.prettyPrintUUIDs uuidswanted
+	ppuuidswanted <- Remote.prettyPrintUUIDs "wanted" uuidswanted
-	ppuuidsskipped <- Remote.prettyPrintUUIDs uuidsskipped
+	ppuuidsskipped <- Remote.prettyPrintUUIDs "skipped" uuidsskipped
 	showLongNote $ message ppuuidswanted ppuuidsskipped
 	where
 		filteruuids l x = filter (`notElem` x) l

Remote/Bup.hs

@@ -29,10 +29,12 @@ import UUID
 import Locations
 import Config
 import Utility
+import Utility.Conditional
+import Utility.SafeCommand
 import Messages
-import Remote.Ssh
+import Utility.Ssh
-import Remote.Special
+import Remote.Helper.Special
-import Remote.Encryptable
+import Remote.Helper.Encryptable
 import Crypto
 
 type BupRepo = String

Remote/Directory.hs

@@ -27,8 +27,10 @@ import Utility.CopyFile
 import Config
 import Content
 import Utility
-import Remote.Special
+import Utility.Conditional
-import Remote.Encryptable
+import Utility.Path
+import Remote.Helper.Special
+import Remote.Helper.Encryptable
 import Crypto
 
 remote :: RemoteType Annex

Remote/Git.hs

@@ -12,6 +12,7 @@ import Control.Monad.State (liftIO)
 import qualified Data.Map as M
 import System.Cmd.Utils
 import System.Posix.Files
+import System.IO
 
 import Types
 import Types.Remote
@@ -24,8 +25,12 @@ import qualified Content
 import Messages
 import Utility.CopyFile
 import Utility.RsyncFile
-import Remote.Ssh
+import Utility.Ssh
+import Utility.SafeCommand
+import Utility.Path
+import qualified Utility.Url as Url
 import Config
+import Init
 
 remote :: RemoteType Annex
 remote = RemoteType {
@@ -75,8 +80,11 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo
 tryGitConfigRead r 
 	| not $ M.null $ Git.configMap r = return r -- already read
 	| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
+	| Git.repoIsHttp r = store $ safely $ geturlconfig
 	| Git.repoIsUrl r = return r
-	| otherwise = store $ safely $ Git.configRead r
+	| otherwise = store $ safely $ do
+		onLocal r ensureInitialized
+		Git.configRead r
 	where
 		-- Reading config can fail due to IO error or
 		-- for other reasons; catch all possible exceptions.
@@ -85,9 +93,19 @@ tryGitConfigRead r
 			case result of
 				Left _ -> return r
 				Right r' -> return r'
+
 		pipedconfig cmd params = safely $
 			pOpen ReadFromPipe cmd (toCommand params) $
 				Git.hConfigRead r
+
+		geturlconfig = do
+			s <- Url.get (Git.repoLocation r ++ "/config")
+			withTempFile "git-annex.tmp" $ \tmpfile -> \h -> do
+				hPutStr h s
+				hClose h
+				pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $
+					Git.hConfigRead r
+
 		store a = do
 			r' <- a
 			g <- Annex.gitRepo
@@ -95,6 +113,7 @@ tryGitConfigRead r
 			let g' = Git.remotesAdd g $ exchange l r'
 			Annex.changeState $ \s -> s { Annex.repo = g' }
 			return r'
+
 		exchange [] _ = []
 		exchange (old:ls) new =
 			if Git.repoRemoteName old == Git.repoRemoteName new
@@ -105,24 +124,34 @@ tryGitConfigRead r
  - If the remote cannot be accessed, returns a Left error.
  -}
 inAnnex :: Git.Repo -> Key -> Annex (Either IOException Bool)
-inAnnex r key = if Git.repoIsUrl r
+inAnnex r key
-		then checkremote
+	| Git.repoIsHttp r = safely checkhttp
-		else liftIO (try checklocal ::IO (Either IOException Bool))
+	| Git.repoIsUrl r = checkremote
+	| otherwise = safely checklocal
 	where
-		checklocal = do
+		checklocal = onLocal r (Content.inAnnex key)
-			-- run a local check inexpensively,
-			-- by making an Annex monad using the remote
-			a <- Annex.new r
-			Annex.eval a (Content.inAnnex key)
 		checkremote = do
 			showAction $ "checking " ++ Git.repoDescribe r
 			inannex <- onRemote r (boolSystem, False) "inannex" 
 				[Param (show key)]
 			return $ Right inannex
+		checkhttp = Url.exists $ keyUrl r key
+		safely a = liftIO (try a ::IO (Either IOException Bool))
+
+{- 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
+	annex <- Annex.new r
+	Annex.eval annex a
+
+keyUrl :: Git.Repo -> Key -> String
+keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key
 
 dropKey :: Git.Repo -> Key -> Annex Bool
-dropKey r key = 
+dropKey r key
-	onRemote r (boolSystem, False) "dropkey"
+	| Git.repoIsHttp r = error "dropping from http repo not supported"
+	| otherwise = onRemote r (boolSystem, False) "dropkey"
 		[ Params "--quiet --force"
 		, Param $ show key
 		]
@@ -132,7 +161,8 @@ copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
 copyFromRemote r key file
 	| not $ Git.repoIsUrl r = rsyncOrCopyFile r (gitAnnexLocation r key) file
 	| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
-	| otherwise = error "copying from non-ssh repo not supported"
+	| Git.repoIsHttp r = Url.download (keyUrl r key) file
+	| otherwise = error "copying from non-ssh, non-http repo not supported"
 
 {- Tries to copy a key's content to a remote's annex. -}
 copyToRemote :: Git.Repo -> Key -> Annex Bool
@@ -141,9 +171,7 @@ copyToRemote r key
 		g <- Annex.gitRepo
 		let keysrc = gitAnnexLocation g key
 		-- run copy from perspective of remote
-		liftIO $ do
+		liftIO $ onLocal r $ do
-			a <- Annex.new r
-			Annex.eval a $ do
 			ok <- Content.getViaTmp key $
 				rsyncOrCopyFile r keysrc
 			Content.saveState

Remote/Helper/Encryptable.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Remote.Encryptable where
+module Remote.Helper.Encryptable where
 
 import qualified Data.Map as M
 import Control.Monad.State (liftIO)

Remote/Helper/Special.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Remote.Special where
+module Remote.Helper.Special where
 
 import qualified Data.Map as M
 import Data.Maybe
@@ -17,7 +17,7 @@ import Types.Remote
 import qualified Git
 import qualified Annex
 import UUID
-import Utility
+import Utility.SafeCommand
 
 {- Special remotes don't have a configured url, so Git.Repo does not
  - automatically generate remotes for them. This looks for a different

Remote/Hook.hs

@@ -28,8 +28,9 @@ import Locations
 import Config
 import Content
 import Utility
-import Remote.Special
+import Utility.SafeCommand
-import Remote.Encryptable
+import Remote.Helper.Special
+import Remote.Helper.Encryptable
 import Crypto
 import Messages
 

Remote/Rsync.hs

@@ -26,11 +26,14 @@ import Locations
 import Config
 import Content
 import Utility
-import Remote.Special
+import Utility.Conditional
-import Remote.Encryptable
+import Remote.Helper.Special
+import Remote.Helper.Encryptable
 import Crypto
 import Messages
 import Utility.RsyncFile
+import Utility.SafeCommand
+import Utility.Path
 
 type RsyncUrl = String
 
@@ -93,10 +96,13 @@ rsyncSetup u c = do
 	return c'
 
 rsyncKey :: RsyncOpts -> Key -> String
-rsyncKey o k = rsyncUrl o </> hashDirMixed k </> f </> f
+rsyncKey o k = rsyncUrl o </> hashDirMixed k </> shellEscape (f </> f)
         where
                 f = keyFile k
 
+rsyncKeyDir :: RsyncOpts -> Key -> String
+rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> shellEscape (keyFile k)
+
 store :: RsyncOpts -> Key -> Annex Bool
 store o k = do
 	g <- Annex.gitRepo
@@ -136,7 +142,7 @@ remove o k = withRsyncScratchDir $ \tmp -> do
 		[ Params "--delete --recursive"
 		, partialParams
 		, Param $ addTrailingPathSeparator dummy
-		, Param $ parentDir $ rsyncKey o k
+		, Param $ rsyncKeyDir o k
 		]
 
 checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either IOException Bool)
@@ -147,8 +153,7 @@ checkPresent r o k = do
 	res <- liftIO $ boolSystem "sh" [Param "-c", Param cmd]
 	return $ Right res
 	where
-		cmd = "rsync --quiet " ++ testfile ++ " 2>/dev/null"
+		cmd = "rsync --quiet " ++ shellEscape (rsyncKey o k) ++ " 2>/dev/null"
-		testfile = shellEscape $ rsyncKey o k
 
 {- Rsync params to enable resumes of sending files safely,
  - ensure that files are only moved into place once complete

Remote/S3real.hs

@@ -33,8 +33,8 @@ import UUID
 import Messages
 import Locations
 import Config
-import Remote.Special
+import Remote.Helper.Special
-import Remote.Encryptable
+import Remote.Helper.Encryptable
 import Crypto
 import Content
 import Utility.Base64

Remote/Web.hs

@@ -7,28 +7,25 @@
 
 module Remote.Web (
 	remote,
-	setUrl,
+	setUrl
-	download
 ) where
 
 import Control.Monad.State (liftIO)
 import Control.Exception
 import System.FilePath
-import Network.Browser
-import Network.HTTP
-import Network.URI
 
 import Types
 import Types.Remote
 import qualified Git
 import qualified Annex
 import Messages
-import Utility
 import UUID
 import Config
 import PresenceLog
 import LocationLog
 import Locations
+import Utility
+import qualified Utility.Url as Url
 
 type URLString = String
 
@@ -67,10 +64,17 @@ gen r _ _ =
 {- The urls for a key are stored in remote/web/hash/key.log 
  - in the git-annex branch. -}
 urlLog :: Key -> FilePath
-urlLog key = "remote/web" </> hashDirLower key </> show key ++ ".log"
+urlLog key = "remote/web" </> hashDirLower key </> keyFile key ++ ".log"
+oldurlLog :: Key -> FilePath
+{- A bug used to store the urls elsewhere. -}
+oldurlLog key = "remote/web" </> hashDirLower key </> show key ++ ".log"
 
 getUrls :: Key -> Annex [URLString]
-getUrls key = currentLog (urlLog key)
+getUrls key = do
+	us <- currentLog (urlLog key)
+	if null us
+		then currentLog (oldurlLog key)
+		else return us
 
 {- Records a change in an url for a key. -}
 setUrl :: Key -> URLString -> LogStatus -> Annex ()
@@ -83,9 +87,12 @@ setUrl key url status = do
 	logChange g key webUUID (if null us then InfoMissing else InfoPresent)
 
 downloadKey :: Key -> FilePath -> Annex Bool
-downloadKey key file = do
+downloadKey key file = get =<< getUrls key
-	us <- getUrls key
+	where
-	download us file
+		get [] = do
+			warning "no known url"
+			return False
+		get urls = anyM (`Url.download` file) urls
 
 uploadKey :: Key -> Annex Bool
 uploadKey _ = do
@@ -107,28 +114,5 @@ checkKey' :: [URLString] -> Annex Bool
 checkKey' [] = return False
 checkKey' (u:us) = do
 	showAction $ "checking " ++ u
-	e <- liftIO $ urlexists u
+	e <- liftIO $ Url.exists u
 	if e then return e else checkKey' us
-
-urlexists :: URLString -> IO Bool
-urlexists url =
-	case parseURI url of
-		Nothing -> return False
-		Just u -> do
-			(_, r) <- Network.Browser.browse $ do
-				setErrHandler ignore
-				setOutHandler ignore
-				setAllowRedirects True
-				request (mkRequest HEAD u :: Request_String)
-			case rspCode r of
-				(2,_,_) -> return True
-				_ -> return False
-	where
-		ignore = const $ return ()
-
-download :: [URLString] -> FilePath -> Annex Bool
-download [] _ = return False
-download (url:us) file = do
-	showOutput -- make way for curl progress bar
-	ok <- liftIO $ boolSystem "curl" [Params "-L -C - -# -o", File file, File url]
-	if ok then return ok else download us file

RemoteLog.hs

@@ -19,6 +19,7 @@ import Data.List
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Char
+import Control.Applicative
 
 import qualified Branch
 import Types
@@ -40,7 +41,7 @@ configSet u c = do
 
 {- Map of remotes by uuid containing key/value config maps. -}
 readRemoteLog :: Annex (M.Map UUID RemoteConfig)
-readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog
+readRemoteLog = remoteLogParse <$> Branch.get remoteLog
 
 remoteLogParse :: String -> M.Map UUID RemoteConfig
 remoteLogParse s =

UUID.hs

@@ -33,7 +33,7 @@ import qualified Branch
 import Types
 import Types.UUID
 import qualified Annex
-import qualified SysConfig
+import qualified Build.SysConfig as SysConfig
 import Config
 
 configkey :: String

Upgrade/V1.hs

@@ -11,6 +11,7 @@ import System.IO.Error (try)
 import System.Directory
 import Control.Monad.State (liftIO)
 import Control.Monad (filterM, forM_, unless)
+import Control.Applicative
 import System.Posix.Files
 import System.FilePath
 import Data.String.Utils
@@ -22,7 +23,7 @@ import Types.Key
 import Content
 import Types
 import Locations
-import LocationLog
+import PresenceLog
 import qualified Annex
 import qualified AnnexQueue
 import qualified Git
@@ -31,6 +32,8 @@ import Backend
 import Messages
 import Version
 import Utility
+import Utility.SafeCommand
+import Utility.Path
 import qualified Upgrade.V2
 
 -- v2 adds hashing of filenames of content and location log files.
@@ -123,7 +126,7 @@ moveLocationLogs = do
 					else return []
 			move (l, k) = do
 				g <- Annex.gitRepo
-				let dest = logFile k
+				let dest = logFile2 g k
 				let dir = Upgrade.V2.gitStateDir g
 				let f = dir </> l
 				liftIO $ createDirectoryIfMissing True (parentDir dest)
@@ -131,9 +134,9 @@ moveLocationLogs = do
 				-- log files that are not checked into git,
 				-- as well as merging with already upgraded
 				-- logs that have been pulled from elsewhere
-				old <- readLog f
+				old <- liftIO $ readLog1 f
-				new <- readLog dest
+				new <- liftIO $ readLog1 dest
-				writeLog dest (old++new)
+				liftIO $ writeLog1 dest (old++new)
 				AnnexQueue.add "add" [Param "--"] [dest]
 				AnnexQueue.add "add" [Param "--"] [f]
 				AnnexQueue.add "rm" [Param "--quiet", Param "-f", Param "--"] [f]
@@ -186,8 +189,11 @@ fileKey1 :: FilePath -> Key
 fileKey1 file = readKey1 $
 	replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
 
-logFile1 :: Git.Repo -> Key -> String
+writeLog1 :: FilePath -> [LogLine] -> IO ()
-logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log"
+writeLog1 file ls = viaTmp writeFile file (unlines $ map show ls)
+
+readLog1 :: FilePath -> IO [LogLine]
+readLog1 file = catch (parseLog <$> readFileStrict file) (const $ return [])
 
 lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend Annex))
 lookupFile1 file = do
@@ -196,7 +202,7 @@ lookupFile1 file = do
 		Left _ -> return Nothing
 		Right l -> makekey l
 	where
-		getsymlink = return . takeFileName =<< readSymbolicLink file
+		getsymlink = takeFileName <$> readSymbolicLink file
 		makekey l = case maybeLookupBackendName bname of
 			Nothing -> do
 				unless (null kname || null bname ||
@@ -230,3 +236,19 @@ getKeyFilesPresent1' dir = do
 			case result of
 				Right s -> return $ isRegularFile s
 				Left _ -> return False
+
+logFile1 :: Git.Repo -> Key -> String
+logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log"
+
+logFile2 :: Git.Repo -> Key -> String
+logFile2 = logFile' hashDirLower
+
+logFile' :: (Key -> FilePath) -> Git.Repo -> Key -> String
+logFile' hasher repo key =
+	gitStateDir repo ++ hasher key ++ keyFile key ++ ".log"
+
+stateDir :: FilePath
+stateDir = addTrailingPathSeparator $ ".git-annex"
+
+gitStateDir :: Git.Repo -> FilePath
+gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir

Upgrade/V2.hs

@@ -20,6 +20,8 @@ import qualified Git
 import qualified Branch
 import Messages
 import Utility
+import Utility.Conditional
+import Utility.SafeCommand
 import LocationLog
 import Content
 

Utility.hs

@@ -6,144 +6,33 @@
  -}
 
 module Utility (
-	CommandParam(..),
-	toCommand,
 	hGetContentsStrict,
 	readFileStrict,
-	parentDir,
-	absPath,
-	absPathFrom,
-	relPathCwdToFile,
-	relPathDirToFile,
-	boolSystem,
-	boolSystemEnv,
-	executeFile,
-	shellEscape,
-	shellUnEscape,
 	unsetFileMode,
 	readMaybe,
 	viaTmp,
+	withTempFile,
 	dirContains,
 	dirContents,
 	myHomeDir,
 	catchBool,
-	whenM,
+	inPath,
-	(>>?),
+	firstM,
-	unlessM,
+	anyM
-	(>>!),
-	
-	prop_idempotent_shellEscape,
-	prop_idempotent_shellEscape_multiword,
-	prop_parentDir_basics,
-	prop_relPathDirToFile_basics
 ) where
 
+import IO (bracket)
 import System.IO
-import System.Exit
-import qualified System.Posix.Process
 import System.Posix.Process hiding (executeFile)
-import System.Posix.Signals
 import System.Posix.Files
 import System.Posix.Types
 import System.Posix.User
-import Data.String.Utils
-import System.Path
 import System.FilePath
 import System.Directory
 import Foreign (complement)
-import Data.List
+import Utility.Path
 import Data.Maybe
-import Control.Monad (liftM2, when, unless)
+import Control.Monad (liftM)
-import System.Log.Logger
-
-{- A type for parameters passed to a shell command. A command can
- - be passed either some Params (multiple parameters can be included,
- - whitespace-separated, or a single Param (for when parameters contain
- - whitespace), or a File.
- -}
-data CommandParam = Params String | Param String | File FilePath
-	deriving (Eq, Show, Ord)
-
-{- Used to pass a list of CommandParams to a function that runs
- - a command and expects Strings. -}
-toCommand :: [CommandParam] -> [String]
-toCommand = (>>= unwrap)
-	where
-		unwrap (Param s) = [s]
-		unwrap (Params s) = filter (not . null) (split " " s)
-		-- Files that start with a dash are modified to avoid
-		-- the command interpreting them as options.
-		unwrap (File ('-':s)) = ["./-" ++ s]
-		unwrap (File s) = [s]
-
-{- Run a system command, and returns True or False
- - if it succeeded or failed.
- -
- - SIGINT(ctrl-c) is allowed to propigate and will terminate the program.
- -}
-boolSystem :: FilePath -> [CommandParam] -> IO Bool
-boolSystem command params = boolSystemEnv command params Nothing
-
-boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
-boolSystemEnv command params env = do
-	-- Going low-level because all the high-level system functions
-	-- block SIGINT etc. We need to block SIGCHLD, but allow
-	-- SIGINT to do its default program termination.
-	let sigset = addSignal sigCHLD emptySignalSet
-	oldint <- installHandler sigINT Default Nothing
-	oldset <- getSignalMask
-	blockSignals sigset
-	childpid <- forkProcess $ childaction oldint oldset
-	mps <- getProcessStatus True False childpid
-	restoresignals oldint oldset
-	case mps of
-		Just (Exited ExitSuccess) -> return True
-		_ -> return False
-	where
-		restoresignals oldint oldset = do
-			_ <- installHandler sigINT oldint Nothing
-			setSignalMask oldset
-		childaction oldint oldset = do
-			restoresignals oldint oldset
-			executeFile command True (toCommand params) env
-
-{- executeFile with debug logging -}
-executeFile :: FilePath -> Bool -> [String] -> Maybe [(String, String)] -> IO ()
-executeFile c path p e = do
-	debugM "Utility.executeFile" $
-		"Running: " ++ c ++ " " ++ show p ++ " " ++ maybe "" show e
-	System.Posix.Process.executeFile c path p e
-
-{- Escapes a filename or other parameter to be safely able to be exposed to
- - the shell. -}
-shellEscape :: String -> String
-shellEscape f = "'" ++ escaped ++ "'"
-	where
-		-- replace ' with '"'"'
-		escaped = join "'\"'\"'" $ split "'" f
-
-{- Unescapes a set of shellEscaped words or filenames. -}
-shellUnEscape :: String -> [String]
-shellUnEscape [] = []
-shellUnEscape s = word : shellUnEscape rest
-	where
-		(word, rest) = findword "" s
-		findword w [] = (w, "")
-		findword w (c:cs)
-			| c == ' ' = (w, cs)
-			| c == '\'' = inquote c w cs
-			| c == '"' = inquote c w cs
-			| otherwise = findword (w++[c]) cs
-		inquote _ w [] = (w, "")
-		inquote q w (c:cs)
-			| c == q = findword w cs
-			| otherwise = inquote q (w++[c]) cs
-
-{- For quickcheck. -}
-prop_idempotent_shellEscape :: String -> Bool
-prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s
-prop_idempotent_shellEscape_multiword :: [String] -> Bool
-prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
@@ -154,82 +43,6 @@ hGetContentsStrict h  = hGetContents h >>= \s -> length s `seq` return s
 readFileStrict :: FilePath -> IO String
 readFileStrict f = readFile f >>= \s -> length s `seq` return s
 
-{- Returns the parent directory of a path. Parent of / is "" -}
-parentDir :: FilePath -> FilePath
-parentDir dir =
-	if not $ null dirs
-	then slash ++ join s (take (length dirs - 1) dirs)
-	else ""
-		where
-			dirs = filter (not . null) $ split s dir
-			slash = if isAbsolute dir then s else ""
-			s = [pathSeparator]
-
-prop_parentDir_basics :: FilePath -> Bool
-prop_parentDir_basics dir
-	| null dir = True
-	| dir == "/" = parentDir dir == ""
-	| otherwise = p /= dir
-	where
-		p = parentDir dir
-
-{- Checks if the first FilePath is, or could be said to contain the second.
- - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
- - are all equivilant.
- -}
-dirContains :: FilePath -> FilePath -> Bool
-dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
-	where
-		norm p = fromMaybe "" $ absNormPath p "."
-		a' = norm a
-		b' = norm b
-
-{- Converts a filename into a normalized, absolute path. -}
-absPath :: FilePath -> IO FilePath
-absPath file = do
-	cwd <- getCurrentDirectory
-	return $ absPathFrom cwd file
-
-{- Converts a filename into a normalized, absolute path
- - from the specified cwd. -}
-absPathFrom :: FilePath -> FilePath -> FilePath
-absPathFrom cwd file = fromMaybe bad $ absNormPath cwd file
-	where
-		bad = error $ "unable to normalize " ++ file
-
-{- Constructs a relative path from the CWD to a file.
- -
- - For example, assuming CWD is /tmp/foo/bar:
- -    relPathCwdToFile "/tmp/foo" == ".."
- -    relPathCwdToFile "/tmp/foo/bar" == "" 
- -}
-relPathCwdToFile :: FilePath -> IO FilePath
-relPathCwdToFile f = liftM2 relPathDirToFile getCurrentDirectory (absPath f)
-
-{- Constructs a relative path from a directory to a file.
- -
- - Both must be absolute, and normalized (eg with absNormpath).
- -}
-relPathDirToFile :: FilePath -> FilePath -> FilePath
-relPathDirToFile from to = path
-	where
-		s = [pathSeparator]
-		pfrom = split s from
-		pto = split s to
-		common = map fst $ filter same $ zip pfrom pto
-		same (c,d) = c == d
-		uncommon = drop numcommon pto
-		dotdots = replicate (length pfrom - numcommon) ".."
-		numcommon = length common
-		path = join s $ dotdots ++ uncommon
-
-prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
-prop_relPathDirToFile_basics from to
-	| from == to = null r
-	| otherwise = not (null r)
-	where
-		r = relPathDirToFile from to 
-
 {- Removes a FileMode from a file.
  - For example, call with otherWriteMode to chmod o-w -}
 unsetFileMode :: FilePath -> FileMode -> IO ()
@@ -253,6 +66,18 @@ viaTmp a file content = do
 	a tmpfile content
 	renameFile tmpfile file
 
+{- Runs an action with a temp file, then removes the file. -}
+withTempFile :: String -> (FilePath -> Handle -> IO a) -> IO a
+withTempFile template a = bracket create remove use
+	where
+		create = do
+			tmpdir <- catch getTemporaryDirectory (const $ return ".")
+			openTempFile tmpdir template
+		remove (name, handle) = do
+			hClose handle
+			catchBool (removeFile name >> return True)
+		use (name, handle) = a name handle
+
 {- Lists the contents of a directory.
  - Unlike getDirectoryContents, paths are not relative to the directory. -}
 dirContents :: FilePath -> IO [FilePath]
@@ -275,19 +100,23 @@ myHomeDir = do
 catchBool :: IO Bool -> IO Bool
 catchBool = flip catch (const $ return False)
 
-{- when with a monadic conditional -}
+{- Return the first value from a list, if any, satisfying the given
-whenM :: Monad m => m Bool -> m () -> m ()
+ - predicate -}
-whenM c a = c >>= flip when a
+firstM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
+firstM _ [] = return Nothing
+firstM p (x:xs) = do
+	q <- p x
+	if q
+		then return (Just x)
+		else firstM p xs
 
-unlessM :: Monad m => m Bool -> m () -> m ()
+{- Returns true if any value in the list satisfies the preducate,
-unlessM c a = c >>= flip unless a
+ - stopping once one is found. -}
+anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
+anyM p = liftM isJust . firstM p
 
-(>>?) :: Monad m => m Bool -> m () -> m ()
+{- Checks if a command is available in PATH. -}
-(>>?) = whenM
+inPath :: String -> IO Bool
-
+inPath command = getSearchPath >>= anyM indir
-(>>!) :: Monad m => m Bool -> m () -> m ()
+	where
-(>>!) = unlessM
+		indir d = doesFileExist $ d </> command
-
--- low fixity allows eg, foo bar >>! error $ "failed " ++ meep
-infixr 0 >>?
-infixr 0 >>!

Utility/Conditional.hs

@@ -0,0 +1,26 @@
+{- monadic conditional operators
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Conditional where
+
+import Control.Monad (when, unless)
+
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM c a = c >>= flip when a
+
+unlessM :: Monad m => m Bool -> m () -> m ()
+unlessM c a = c >>= flip unless a
+
+(>>?) :: Monad m => m Bool -> m () -> m ()
+(>>?) = whenM
+
+(>>!) :: Monad m => m Bool -> m () -> m ()
+(>>!) = unlessM
+
+-- low fixity allows eg, foo bar >>! error $ "failed " ++ meep
+infixr 0 >>?
+infixr 0 >>!

Utility/CopyFile.hs

@@ -9,8 +9,9 @@ module Utility.CopyFile (copyFile) where
 
 import System.Directory (doesFileExist, removeFile)
 
-import Utility
+import Utility.Conditional
-import qualified SysConfig
+import Utility.SafeCommand
+import qualified Build.SysConfig as SysConfig
 
 {- The cp command is used, because I hate reinventing the wheel,
  - and because this allows easy access to features like cp --reflink. -}

Utility/DataUnits.hs

@@ -137,8 +137,7 @@ compareSizes units abbrev old new
 {- Parses strings like "10 kilobytes" or "0.5tb". -}
 readSize :: [Unit] -> String -> Maybe ByteSize
 readSize units input
-	| null parsednum = Nothing
+	| null parsednum || null parsedunit = Nothing
-	| null parsedunit = Nothing
 	| otherwise = Just $ round $ number * fromIntegral multiplier
 	where
 		(number, rest) = head parsednum

Utility/JSONStream.hs

@@ -0,0 +1,44 @@
+{- Streaming JSON output.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.JSONStream (
+	start,
+	add,
+	end
+) where
+
+import Text.JSON
+
+{- Text.JSON does not support building up a larger JSON document piece by
+   piece as a stream. To support streaming, a hack. The JSObject is converted
+   to a string with its final "}" is left off, allowing it to be added to
+   later. -}
+start :: JSON a => [(String, a)] -> String
+start l
+	| last s == endchar = take (length s - 1)  s
+	| otherwise = bad s
+	where
+		s = encodeStrict $ toJSObject l
+
+add :: JSON a => [(String, a)] -> String
+add l
+	| head s == startchar = ',' : drop 1 s
+	| otherwise = bad s
+	where
+		s = start l
+
+end :: String
+end = [endchar, '\n']
+
+startchar :: Char
+startchar = '{'
+
+endchar :: Char
+endchar = '}'
+
+bad :: String -> a
+bad s = error $ "Text.JSON returned unexpected string: " ++ s

Utility/Path.hs

@@ -0,0 +1,92 @@
+{- path manipulation
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Path where
+
+import Data.String.Utils
+import System.Path
+import System.FilePath
+import System.Directory
+import Data.List
+import Data.Maybe
+import Control.Applicative
+
+{- Returns the parent directory of a path. Parent of / is "" -}
+parentDir :: FilePath -> FilePath
+parentDir dir =
+	if not $ null dirs
+	then slash ++ join s (take (length dirs - 1) dirs)
+	else ""
+		where
+			dirs = filter (not . null) $ split s dir
+			slash = if isAbsolute dir then s else ""
+			s = [pathSeparator]
+
+prop_parentDir_basics :: FilePath -> Bool
+prop_parentDir_basics dir
+	| null dir = True
+	| dir == "/" = parentDir dir == ""
+	| otherwise = p /= dir
+	where
+		p = parentDir dir
+
+{- Checks if the first FilePath is, or could be said to contain the second.
+ - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
+ - are all equivilant.
+ -}
+dirContains :: FilePath -> FilePath -> Bool
+dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
+	where
+		norm p = fromMaybe "" $ absNormPath p "."
+		a' = norm a
+		b' = norm b
+
+{- Converts a filename into a normalized, absolute path. -}
+absPath :: FilePath -> IO FilePath
+absPath file = do
+	cwd <- getCurrentDirectory
+	return $ absPathFrom cwd file
+
+{- Converts a filename into a normalized, absolute path
+ - from the specified cwd. -}
+absPathFrom :: FilePath -> FilePath -> FilePath
+absPathFrom cwd file = fromMaybe bad $ absNormPath cwd file
+	where
+		bad = error $ "unable to normalize " ++ file
+
+{- Constructs a relative path from the CWD to a file.
+ -
+ - For example, assuming CWD is /tmp/foo/bar:
+ -    relPathCwdToFile "/tmp/foo" == ".."
+ -    relPathCwdToFile "/tmp/foo/bar" == "" 
+ -}
+relPathCwdToFile :: FilePath -> IO FilePath
+relPathCwdToFile f = relPathDirToFile <$> getCurrentDirectory <*> absPath f
+
+{- Constructs a relative path from a directory to a file.
+ -
+ - Both must be absolute, and normalized (eg with absNormpath).
+ -}
+relPathDirToFile :: FilePath -> FilePath -> FilePath
+relPathDirToFile from to = path
+	where
+		s = [pathSeparator]
+		pfrom = split s from
+		pto = split s to
+		common = map fst $ filter same $ zip pfrom pto
+		same (c,d) = c == d
+		uncommon = drop numcommon pto
+		dotdots = replicate (length pfrom - numcommon) ".."
+		numcommon = length common
+		path = join s $ dotdots ++ uncommon
+
+prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
+prop_relPathDirToFile_basics from to
+	| from == to = null r
+	| otherwise = not (null r)
+	where
+		r = relPathDirToFile from to 

Utility/RsyncFile.hs

@@ -9,7 +9,7 @@ module Utility.RsyncFile where
 
 import Data.String.Utils
 
-import Utility
+import Utility.SafeCommand
 
 {- Generates parameters to make rsync use a specified command as its remote
  - shell. -}

Utility/SafeCommand.hs

@@ -0,0 +1,104 @@
+{- safely running shell commands
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.SafeCommand where
+
+import System.Exit
+import qualified System.Posix.Process
+import System.Posix.Process hiding (executeFile)
+import System.Posix.Signals
+import Data.String.Utils
+import System.Log.Logger
+
+{- A type for parameters passed to a shell command. A command can
+ - be passed either some Params (multiple parameters can be included,
+ - whitespace-separated, or a single Param (for when parameters contain
+ - whitespace), or a File.
+ -}
+data CommandParam = Params String | Param String | File FilePath
+	deriving (Eq, Show, Ord)
+
+{- Used to pass a list of CommandParams to a function that runs
+ - a command and expects Strings. -}
+toCommand :: [CommandParam] -> [String]
+toCommand = (>>= unwrap)
+	where
+		unwrap (Param s) = [s]
+		unwrap (Params s) = filter (not . null) (split " " s)
+		-- Files that start with a dash are modified to avoid
+		-- the command interpreting them as options.
+		unwrap (File s@('-':_)) = ["./" ++ s]
+		unwrap (File s) = [s]
+
+{- Run a system command, and returns True or False
+ - if it succeeded or failed.
+ -
+ - SIGINT(ctrl-c) is allowed to propigate and will terminate the program.
+ -}
+boolSystem :: FilePath -> [CommandParam] -> IO Bool
+boolSystem command params = boolSystemEnv command params Nothing
+
+boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
+boolSystemEnv command params env = do
+	-- Going low-level because all the high-level system functions
+	-- block SIGINT etc. We need to block SIGCHLD, but allow
+	-- SIGINT to do its default program termination.
+	let sigset = addSignal sigCHLD emptySignalSet
+	oldint <- installHandler sigINT Default Nothing
+	oldset <- getSignalMask
+	blockSignals sigset
+	childpid <- forkProcess $ childaction oldint oldset
+	mps <- getProcessStatus True False childpid
+	restoresignals oldint oldset
+	case mps of
+		Just (Exited ExitSuccess) -> return True
+		_ -> return False
+	where
+		restoresignals oldint oldset = do
+			_ <- installHandler sigINT oldint Nothing
+			setSignalMask oldset
+		childaction oldint oldset = do
+			restoresignals oldint oldset
+			executeFile command True (toCommand params) env
+
+{- executeFile with debug logging -}
+executeFile :: FilePath -> Bool -> [String] -> Maybe [(String, String)] -> IO ()
+executeFile c path p e = do
+	debugM "Utility.SafeCommand.executeFile" $
+		"Running: " ++ c ++ " " ++ show p ++ " " ++ maybe "" show e
+	System.Posix.Process.executeFile c path p e
+
+{- Escapes a filename or other parameter to be safely able to be exposed to
+ - the shell. -}
+shellEscape :: String -> String
+shellEscape f = "'" ++ escaped ++ "'"
+	where
+		-- replace ' with '"'"'
+		escaped = join "'\"'\"'" $ split "'" f
+
+{- Unescapes a set of shellEscaped words or filenames. -}
+shellUnEscape :: String -> [String]
+shellUnEscape [] = []
+shellUnEscape s = word : shellUnEscape rest
+	where
+		(word, rest) = findword "" s
+		findword w [] = (w, "")
+		findword w (c:cs)
+			| c == ' ' = (w, cs)
+			| c == '\'' = inquote c w cs
+			| c == '"' = inquote c w cs
+			| otherwise = findword (w++[c]) cs
+		inquote _ w [] = (w, "")
+		inquote q w (c:cs)
+			| c == q = findword w cs
+			| otherwise = inquote q (w++[c]) cs
+
+{- For quickcheck. -}
+prop_idempotent_shellEscape :: String -> Bool
+prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s
+prop_idempotent_shellEscape_multiword :: [String] -> Bool
+prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s

Utility/Ssh.hs

@@ -5,12 +5,12 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Remote.Ssh where
+module Utility.Ssh where
 
 import Control.Monad.State (liftIO)
 
 import qualified Git
-import Utility
+import Utility.SafeCommand
 import Types
 import Config
 

Utility/StatFS.hsc

@@ -45,7 +45,7 @@
 {-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}
 
 
-module StatFS ( FileSystemStats(..), getFileSystemStats ) where
+module Utility.StatFS ( FileSystemStats(..), getFileSystemStats ) where
 
 import Foreign
 import Foreign.C.Types

Utility/Touch.hsc

@@ -7,7 +7,7 @@
 
 {-# LANGUAGE ForeignFunctionInterface #-}
 
-module Touch (
+module Utility.Touch (
 	TimeSpec(..),
 	touchBoth,
 	touch

Utility/Url.hs

@@ -0,0 +1,79 @@
+{- Url downloading.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Url (
+	exists,
+	download,
+	get
+) where
+
+import Control.Applicative
+import Control.Monad.State (liftIO)
+import qualified Network.Browser as Browser
+import Network.HTTP
+import Network.URI
+
+import Types
+import Messages
+import Utility.SafeCommand
+import Utility
+
+type URLString = String
+
+{- Checks that an url exists and could be successfully downloaded. -}
+exists :: URLString -> IO Bool
+exists url =
+	case parseURI url of
+		Nothing -> return False
+		Just u -> do
+			r <- request u HEAD
+			case rspCode r of
+				(2,_,_) -> return True
+				_ -> return False
+
+{- Used to download large files, such as the contents of keys.
+ - Uses wget or curl program for its progress bar. (Wget has a better one,
+ - so is preferred.) -}
+download :: URLString -> FilePath -> Annex Bool
+download url file = do
+	showOutput -- make way for program's progress bar
+	e <- liftIO $ inPath "wget"
+	if e
+		then
+			liftIO $ boolSystem "wget"
+				[Params "-c -O", File file, File url]
+		else
+			-- Uses the -# progress display, because the normal
+			-- one is very confusing when resuming, showing
+			-- the remainder to download as the whole file,
+			-- and not indicating how much percent was
+			-- downloaded before the resume.
+			liftIO $ boolSystem "curl" 
+				[Params "-L -C - -# -o", File file, File url]
+
+{- Downloads a small file. -}
+get :: URLString -> IO String
+get url =
+	case parseURI url of
+		Nothing -> error "url parse error"
+		Just u -> do
+			r <- request u GET
+			case rspCode r of
+				(2,_,_) -> return $ rspBody r
+				_ -> error $ rspReason r
+
+{- Makes a http request of an url. For example, HEAD can be used to
+ - check if the url exists, or GET used to get the url content (best for
+ - small urls). -}
+request :: URI -> RequestMethod -> IO (Response String)
+request url requesttype = Browser.browse $ do
+	Browser.setErrHandler ignore
+	Browser.setOutHandler ignore
+	Browser.setAllowRedirects True
+	snd <$> Browser.request (mkRequest requesttype url :: Request_String)
+	where
+		ignore = const $ return ()

Version.hs

@@ -7,8 +7,6 @@
 
 module Version where
 
-import Control.Monad (unless)
-
 import Types
 import qualified Annex
 import qualified Git
@@ -39,14 +37,11 @@ getVersion = do
 setVersion :: Annex ()
 setVersion = setConfig versionField defaultVersion
 
-checkVersion :: Annex ()
+checkVersion :: Version -> Annex ()
-checkVersion = getVersion >>= handle
+checkVersion v
+	| v `elem` supportedVersions = return ()
+	| v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade"
+	| otherwise = err "Upgrade git-annex."
 	where
-		handle Nothing = error "First run: git-annex init"
+		err msg = error $ "Repository version " ++ v ++
-		handle (Just v) = unless (v `elem` supportedVersions) $
+			" is not supported. " ++ msg
-			error $ "Repository version " ++ v ++ 
-				" is not supported. " ++
-				msg v
-		msg v
-			| v `elem` upgradableVersions = "Upgrade this repository: git-annex upgrade"
-			| otherwise = "Upgrade git-annex."

configure.hs

@@ -3,7 +3,7 @@
 import System.Directory
 import Data.List
 
-import TestConfig
+import Build.TestConfig
 
 tests :: [TestCase]
 tests =

debian/changelog

@@ -1,3 +1,43 @@
+git-annex (3.20110906) unstable; urgency=low
+
+  * Improve display of newlines around error and warning messages.
+  * Fix Makefile to work with cabal again.
+
+ -- Joey Hess <joeyh@debian.org>  Tue, 06 Sep 2011 13:45:16 -0400
+
+git-annex (3.20110902) unstable; urgency=low
+
+  * Set EMAIL when running test suite so that git does not need to be
+    configured first. Closes: #638998
+  * The wget command will now be used in preference to curl, if available.
+  * init: Make description an optional parameter.
+  * unused, status: Sped up by avoiding unnecessary stats of annexed files.
+  * unused --remote: Reduced memory use to 1/4th what was used before.
+  * Add --json switch, to produce machine-consumable output.
+
+ -- Joey Hess <joeyh@debian.org>  Fri, 02 Sep 2011 21:20:37 -0400
+
+git-annex (3.20110819) unstable; urgency=low
+
+  * Now "git annex init" only has to be run once, when a git repository
+    is first being created. Clones will automatically notice that git-annex
+    is in use and automatically perform a basic initalization. It's
+    still recommended to run "git annex init" in any clones, to describe them.
+  * Added annex-cost-command configuration, which can be used to vary the
+    cost of a remote based on the output of a shell command.
+  * Fix broken upgrade from V1 repository. Closes: #638584
+
+ -- Joey Hess <joeyh@debian.org>  Fri, 19 Aug 2011 20:34:09 -0400
+
+git-annex (3.20110817) unstable; urgency=low
+
+  * Fix shell escaping in rsync special remote.
+  * addurl: --fast can be used to avoid immediately downloading the url.
+  * Added support for getting content from git remotes using http (and https).
+  * Added curl to Debian package dependencies.
+
+ -- Joey Hess <joeyh@debian.org>  Wed, 17 Aug 2011 01:29:02 -0400
+
 git-annex (3.20110719~bpo60+1) squeeze-backports; urgency=low
 
   * Bugfix: Make add ../ work.

debian/control

@@ -12,6 +12,7 @@ Build-Depends:
 	libghc6-http-dev,
 	libghc6-utf8-string-dev,
 	libghc6-testpack-dev [any-i386 any-amd64],
+	libghc6-json-dev,
 	ikiwiki,
 	perlmagick,
 	git | git-core,
@@ -29,6 +30,7 @@ Depends: ${misc:Depends}, ${shlibs:Depends},
 	git | git-core,
 	uuid,
 	rsync,
+	wget | curl,
 	openssh-client
 Suggests: graphviz, bup, gnupg
 Description: manage files with git, without checking their contents into git

debian/copyright

@@ -8,7 +8,7 @@ License: GPL-3+
  this package's source, or in /usr/share/common-licenses/GPL-3 on
  Debian systems.
 
-Files: StatFS.hsc
+Files: Utility/StatFS.hsc
 Copyright: Jose A Ortega Ruiz <jao@gnu.org>
 License: BSD-3-clause
  -- All rights reserved.

doc/backends.mdwn

@@ -1,24 +1,16 @@
-git-annex uses a key-value abstraction layer to allow file contents to be
-stored in different ways. In theory, any key-value storage system could be
-used to store file contents.
-
 When a file is annexed, a key is generated from its content and/or metadata.
 The file checked into git symlinks to the key. This key can later be used
 to retrieve the file's content (its value).
 
-Multiple pluggable backends are supported, and a single repository
+Multiple pluggable key-value backends are supported, and a single repository
-can use different backends for different files.
+can use different ones for different files.
 
-These backends can transfer file contents between configured git remotes.
+* `WORM` ("Write Once, Read Many") This assumes that any file with
-It's also possible to use [[special_remotes]], such as Amazon S3 with
+  the same basename, size, and modification time has the same content.
-these backends.
+  This is the default, and the least expensive backend.
-
+* `SHA1` -- This uses a key based on a sha1 checksum. This allows
-* `WORM` ("Write Once, Read Many") This backend assumes that any file with
+  verifying that the file content is right, and can avoid duplicates of
-  the same basename, size, and modification time has the same content. So with
+  files with the same content. Its need to generate checksums
-  this backend, files can be moved around, but should never be added to
-  or changed. This is the default, and the least expensive backend.
-* `SHA1` -- This backend uses a key based on a sha1 checksum. This backend
-  allows modifications of files to be tracked. Its need to generate checksums
   can make it slower for large files.
 * `SHA512`, `SHA384`, `SHA256`, `SHA224` -- Like SHA1, but larger
   checksums. Mostly useful for the very paranoid, or anyone who is
@@ -36,7 +28,7 @@ files, the `.gitattributes` file can be used. The `annex.backend`
 attribute can be set to the name of the backend to use for matching files.
 
 For example, to use the SHA1 backend for sound files, which tend to be
-smallish and might be modified over time, you could set in
+smallish and might be modified or copied over time, you could set in
 `.gitattributes`:
 
 	*.mp3 annex.backend=SHA1

doc/bugs/--git-dir_and_--work-tree_options.mdwn

@@ -0,0 +1,29 @@
+git-annex does not take into account the --git-dir and --work-tree command line options (while they can be useful when scripting).
+
+    > mkdir /tmp/test
+    > cd /tmp/test
+    > git init
+    Initialized empty Git repository in /tmp/test/.git/
+    > git annex init test
+    init test ok
+    > touch foo
+    > cd
+    > git --git-dir=/tmp/test/.git --work-tree=/tmp/test annex add foo
+    git-annex: Not in a git repository.
+
+regular git add works:
+
+    > git --git-dir=/tmp/test/.git --work-tree=/tmp/test add foo
+    > git --git-dir=/tmp/test/.git --work-tree=/tmp/test status 
+    # On branch master
+    #
+    # Initial commit
+    #
+    # Changes to be committed:
+    #   (use "git rm --cached <file>..." to unstage)
+    #
+    #       new file:   foo
+    #
+
+git-annex version: 3.20110702
+

doc/bugs/Build_error_on_Mac_OSX_10.6.mdwn

@@ -0,0 +1,11 @@
+While following the instructions given at the OSX build page , I get this error:
+
+$ make
+ghc -O2 -Wall -ignore-package monads-fd -fspec-constr-count=5 --make git-annex
+
+Utility/JSONStream.hs:14:8:
+    Could not find module `Text.JSON':
+      Use -v to see a list of the files searched for.
+make: *** [git-annex] Error 1
+
+> Updated the instructions. [[done]] --[[Joey]] 

doc/bugs/Cabal_dependency_monadIO_missing.mdwn

@@ -0,0 +1,14 @@
+Just issuing the command `cabal install` results in the following error message.
+
+    Command/Add.hs:54:3:
+        No instance for (Control.Monad.IO.Control.MonadControlIO
+                           (Control.Monad.State.Lazy.StateT Annex.AnnexState IO))
+          arising from a use of `handle' at Command/Add.hs:54:3-24
+
+Adding the dependency for `monadIO` to `git-annex.cabal` should fix this?  
+-- Thomas
+
+> No, it's already satisfied by `monad-control` being listed as a
+> dependency in the cabal file. Your system might be old/new/or broken,
+> perhaps it's time to provide some details about the version of haskell
+> and of `monad-control` you have installed? --[[Joey]] 

doc/bugs/Cabal_dependency_monadIO_missing/comment_1_14be660aa57fadec0d81b32a8b52c66f._comment

@@ -0,0 +1,75 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmFgsNxmnGznb5bbmcoWhoQOoxZZ-io61s"
+ nickname="Thomas"
+ subject="comment 1"
+ date="2011-08-08T09:04:20Z"
+ content="""
+I use Debian Squeeze, I have the Debian package cabal-install 0.8.0-1 installed.
+
+    $ git clone git://git-annex.branchable.com/
+    $ cd git-annex.branchable.com
+    $ cabal update
+    $ cabal install cabal-install
+
+This installed: Cabal-1.10.2.0, zlib-0.5.3.1, cabal-install 0.10.2.
+No version of monad-control or monadIO installed.
+
+    $ ~/.cabal/bin/cabal install
+    Registering QuickCheck-2.4.1.1...
+    Registering Crypto-4.2.3...
+    Registering base-unicode-symbols-0.2.2.1...
+    Registering deepseq-1.1.0.2...
+    Registering hxt-charproperties-9.1.0...
+    Registering hxt-regex-xmlschema-9.0.0...
+    Registering hxt-unicode-9.0.1...
+    Registering hxt-9.1.2...
+    Registering stm-2.2.0.1...
+    Registering hS3-0.5.6...
+    Registering transformers-0.2.2.0...
+    Registering monad-control-0.2.0.1...
+    [1 of 1] Compiling Main             ( Setup.hs, dist/setup/Main.o )
+    Linking ./dist/setup/setup ...
+    ghc -O2 -Wall -ignore-package monads-fd -fspec-constr-count=5 --make configure
+    [1 of 2] Compiling TestConfig       ( TestConfig.hs, TestConfig.o )
+    [2 of 2] Compiling Main             ( configure.hs, configure.o )
+    Linking configure ...
+    ./configure
+      checking version... 3.20110720
+      checking cp -a... yes
+      checking cp -p... yes
+      checking cp --reflink=auto... yes
+      checking uuid generator... uuid
+      checking xargs -0... yes
+      checking rsync... yes
+      checking curl... yes
+      checking bup... yes
+      checking gpg... yes
+      checking sha1... sha1sum
+      checking sha256... sha256sum
+      checking sha512... sha512sum
+      checking sha224... sha224sum
+      checking sha384... sha384sum
+
+    ...
+
+    Command/Add.hs:54:3:
+        No instance for (Control.Monad.IO.Control.MonadControlIO
+                           (Control.Monad.State.Lazy.StateT Annex.AnnexState IO))
+          arising from a use of `handle' at Command/Add.hs:54:3-24
+        Possible fix:
+          add an instance declaration for
+          (Control.Monad.IO.Control.MonadControlIO
+             (Control.Monad.State.Lazy.StateT Annex.AnnexState IO))
+        In the first argument of `($)', namely `handle (undo file key)'
+        In a stmt of a 'do' expression:
+              handle (undo file key) $ moveAnnex key file
+        In the expression:
+            do { handle (undo file key) $ moveAnnex key file;
+                 next $ cleanup file key }
+    cabal: Error: some packages failed to install:
+    git-annex-3.20110719 failed during the building phase. The exception was:
+    ExitFailure 1
+
+After I added a depencency for monadIO to the git-annex.cabal file, it installed correctly.  
+-- Thomas
+"""]]

doc/bugs/Cabal_dependency_monadIO_missing/comment_2_4f4d8e1e00a2a4f7e8a8ab082e16adac._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joey.kitenet.net/"
+ nickname="joey"
+ subject="comment 2"
+ date="2011-08-17T04:56:30Z"
+ content="""
+Finally got a chance to try to reproduce this. I followed your recipe exactly in a clean squeeze chroot. monadIO was not installed, but git-annex built ok, using monad-control.
+"""]]

doc/bugs/Prevent_accidental_merges.mdwn

@@ -0,0 +1,14 @@
+With the storage layout v3, pulling the git-annex branch into the master branch is... less than ideal.
+
+The fact that the two branches contain totally different data make an accidental merge worse, arguably.
+
+Adding a tiny binary file called .gitnomerge to both branches would solve that without any noticeable overhead.
+
+Yes, there is an argument to be made that this is too much hand-holding, but I still think it's worth it.
+
+-- Richard
+
+> It should be as easy to undo such an accidential merge
+> as it is to undo any other git commit, right? I quite like that git-annex 
+> no longer adds any clutter to the master branch, and would be reluctant
+> to change that. --[[Joey]]

doc/bugs/add_script-friendly_output_options.mdwn

@@ -0,0 +1,19 @@
+I have a need to use git-annex from a larger program. It'd be great if the information output by some of the commands that is descriptive (for example, whereis) could be sent to stdout in a machine-readable format like (preferably) JSON, or XML. That way I can simply read in the output of the command and use the data directly instead of having to parse it via regexes or other such string manipulation.
+
+This could perhaps be triggered by a --json or --xml flag to the relevant commands.
+
+> This is [[done]], --json is supported by all commands, more or less.
+> 
+> Caveats: 
+> 
+>  * the version, status, and find commands produce custom output and so
+>    no json. This could change for version and status; find needs to just
+>    be a simple list of files, I think 
+>  * The "note" fields may repeat multiple times per object with different
+>    notes and are of course not machine readable, and subject to change.
+>  * Output of helper commands like rsync is not diverted away, and
+>    could clutter up the json output badly. Should only affect commands
+>    that transfer data. And AFAICS, wget and rsync both output their
+>    progress displays to stderr, so shouldn't be a problem.
+> 
+> --[[Joey]] 

doc/bugs/fsck_output.mdwn

@@ -34,3 +34,13 @@ The newline is in the wrong place and confuses the user. It should be printed _a
 > failed
 > 
 > --[[Joey]] 
+
+>> Well, I fixed this in all cases except a thrown non-IO error (last
+>> example aboce), which output is printed by haskell's runtime. I'd
+>> have to add a second error handler to handle those, and it's not
+>> clear what it would do. Often an error will occur before anything
+>> else is printed, and then the current behavior is right; if something
+>> has been printed it would be nice to have a newline before the error,
+>> but by the time the error is caught we'd be out of the annex monad
+>> and not really have any way to know if something has been printed.
+>> I think my fix is good enough [[done]] --[[Joey]] 

doc/bugs/rsync_special_remote_fails_to___96__get__96___files_which_have_names_containing_spaces.mdwn

@@ -0,0 +1,50 @@
+    ~$ mkdir test annex
+    ~$ cd test
+    ~$ git init
+    Initialized empty Git repository in /home/user/test/.git/
+    ~$ git annex init test
+    init test ok
+    ~$ git annex initremote localrsync encryption=none type=rsync rsyncurl=localhost:annex/
+    initremote localrsync ok
+    ~$ cp /home/user/Music/Charming\ Hostess/Eat/03\ Mi\ Nuera.ogg ./
+    ~$ git annex add 03\ Mi\ Nuera.ogg
+    add 03 Mi Nuera.ogg ok
+    (Recording state in git...)
+    ~$ git commit -m "add ogg"
+    fatal: No HEAD commit to compare with (yet)
+    fatal: No HEAD commit to compare with (yet)
+    [master (root-commit) 12608af] add ogg
+     1 files changed, 1 insertions(+), 0 deletions(-)
+     create mode 120000 03 Mi Nuera.ogg
+    ~$ git annex move 03\ Mi\ Nuera.ogg --to localrsync
+    move 03 Mi Nuera.ogg (checking localrsync...) (to localrsync...) 
+    sending incremental file list
+    1X/
+    1X/39/
+    1X/39/WORM-s6296772-m1311874383--03 Mi Nuera.ogg/
+    1X/39/WORM-s6296772-m1311874383--03 Mi Nuera.ogg/WORM-s6296772-m1311874383--03 Mi Nuera.ogg
+         6296772 100%   42.98MB/s    0:00:00 (xfer#1, to-check=0/5)
+    
+    sent 6297754 bytes  received 43 bytes  4198531.33 bytes/sec
+    total size is 6296772  speedup is 1.00
+    ok
+    ~$ git annex get 03\ Mi\ Nuera.ogg
+    get 03 Mi Nuera.ogg (from localrsync...) 
+    rsync: link_stat "/home/user/annex/1X/39/WORM-s6296772-m1311874383--03" failed: No such file or directory (2)
+    rsync: link_stat "/home/user/Mi" failed: No such file or directory (2)
+    rsync: change_dir "/home/user/Nuera.ogg" failed: No such file or directory (2)
+    rsync: link_stat "/home/user/Mi" failed: No such file or directory (2)
+    rsync: link_stat "/home/user/Nuera.ogg" failed: No such file or directory (2)
+    
+    sent 8 bytes  received 12 bytes  13.33 bytes/sec
+    total size is 0  speedup is 0.00
+    rsync error: some files/attrs were not transferred (see previous errors) (code 23) at main.c(1526) [Receiver=3.0.7]
+    
+      rsync failed -- run git annex again to resume file transfer
+      Unable to access these remotes: localrsync
+      Try making some of these repositories available:
+            b8b1ea7a-b93f-11e0-b712-d7bffb6e61e6  -- localrsync
+    failed
+    git-annex: 1 failed
+
+> [[fixed|done]] --[[Joey]] 

doc/bugs/support_bare_git_repo__44___with_the_annex_directory_exposed_to_http.mdwn

@@ -0,0 +1,20 @@
+Let's say that http://people.collabora.com/~alsuren/git/fate-suite.git/ is a bare git repo. It has been 'git update-server-info'd so that it can be served on a dumb http server.
+
+The repo is also a git annex remote, created using the following commands:
+
+* git remote add alsuren git+ssh://people.collabora.co.uk/user/alsuren/public_html/fate-suite.git
+* git push alsuren --all
+* git annex copy --to=alsuren
+
+so http://people.collabora.com/~alsuren/git/fate-suite.git/annex is a valid git annex (though listing dirs is forbidden, so you need to know the filenames ahead of time).
+
+I would like to be able to use the following commands to get a clone of the repo:
+
+* git clone http://people.collabora.com/~alsuren/git/fate-suite.git/
+* cd fate-suite
+* git annex get
+
+This would allow contributors to quickly get a copy of our upstream repo and start contributing with minimal bandwidth/effort.
+
+> This is now supported.. I look forward to seeing your project using it!
+> --[[Joey]] [[!tag done]]

doc/bugs/test_suite_shouldn__39__t_fail_silently.mdwn

@@ -0,0 +1,3 @@
+When the test suite cannot be compiled, the build just fails silenty. This means that in automated builds there is no easy way to ensure that the generated binaries have passed the test suite, because it may not even have been run! IMHO, "make test" should fail (i.e. return a non-zero exit code) when it can't succeeed.
+
+> Ok, fixed. --[[Joey]] [[done]]

doc/bugs/wishlist:_more_descriptive_commit_messages_in_git-annex_branch.mdwn

@@ -0,0 +1,36 @@
+as of git-annex version 3.20110719, all git-annex commits only contain the word "update" as a commit message. given that the contents of the commit are pretty non-descriptive (SHA1 hashes for file names, uuids for repository names), i suggest to have more descriptive commit messages, as shown here:
+
+    /mnt/usb_disk/photos/2011$ git annex get
+    /mnt/usb_disk/photos/2011$ git show git-annex
+    [...]
+    usb-disk-photos: get 2011
+    
+    * 10 files retrieved from 2 sources (9 from local-harddisk, 1 from my-server)
+    * 120 files were already present
+    * 2 files could not be retrieved
+    /mnt/usb_disk/photos/2011$ cd ~/photos/2011/07
+    ~/photos/2011/07$ git copy --to my-server
+    ~/photos/2011/07$ git show git-annex
+    [...]
+    local-harddisk: copy 2011/07 to my-server
+    
+    * 20 files pushed
+    ~/photos/2011/07$
+
+in my opinion, the messages should at least contain
+
+* what command was used
+* in which repository they were executed
+* which files or directories they affected (not necessarily all files, but what was given on command line or implicitly from the working directory)
+
+--[[chrysn]]
+
+> The implementation of the git-annex branch precludes more descriptive
+> commit messages, since a single commit can include changes that were
+> previously staged to the branch's index file, or spooled to its journal
+> by other git-annex commands (either concurrently running or
+> interrupted commands, or even changes needed to automatically merge
+> other git-annex branches).
+> 
+> It would be possible to make it *less* verbose, with an empty commit
+> message. :) --[[Joey]] 

doc/cheatsheet.mdwn

@@ -1,4 +1,4 @@
-A suppliment to the [[walkthrough]].
+A supplement to the [[walkthrough]].
 
 [[!toc]]
 

doc/copies.mdwn

@@ -1,8 +1,8 @@
-The WORM and SHA1 key-value [[backends]] store data inside
+Annexed data is stored inside  your git repository's `.git/annex` directory.
-your git repository's `.git` directory, not in some external data store.
+Some [[special_remotes]] can store annexed data elsewhere.
 
 It's important that data not get lost by an ill-considered `git annex drop`
-command.  So, then using those backends, git-annex can be configured to try
+command.  So, git-annex can be configured to try
 to keep N copies of a file's content available across all repositories. 
 (Although [[untrusted_repositories|trust]] don't count toward this total.)
 

doc/forum/Wishlist:_Is_it_possible_to___34__unlock__34___files_without_copying_the_file_data__63__/comment_2_f5ebb7f43dcef861ecc13373fb1e263f._comment

@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmL8pteP2jbYJUn1M3CbeLDvz2SWAA1wtg"
+ nickname="Kristian"
+ subject="Solution"
+ date="2011-07-31T15:24:25Z"
+ content="""
+Yes, it can read id3-tags and guess titles from movie filenames but it sometimes gets confused by the filename metadata provided by the WORM-backend.
+
+I think I have a good enough solution to this problem. It's not efficient when it comes to renames but handles adding and deletion just fine
+
+    rsync -vaL --delete source dest
+
+The -L flag looks at symbolic links and copies the actual data they are pointing to. Of course \"source\" must have all data locally for this to work.
+
+"""]]

doc/forum/advantages_of_SHA__42___over_WORM.mdwn

@@ -0,0 +1,5 @@
+Thanks for creating git-annex.
+
+I am confused about the advantages of the SHA* backends over WORM.  The "backends" page in this wiki says that with WORM, files "can be moved around, but should never be added to or changed".  But I don't see any difference to SHA* files as long as the premise of WORM that "any file with the same basename, size, and modification time has the same content" is true.  Using "git annex unlock", WORM files can be modified in the same way as SHA* files.
+
+If the storage I use is dependable (i.e. I don't need SHA checksums for detection of corruption), and I don't need to optimize for the case that the modification date of a file is changed but the contents stay the same, and if it is unlikely that several files will be identical, is there actually any advantage in using SHA*?

doc/forum/advantages_of_SHA__42___over_WORM/comment_1_96c354cac4b5ce5cf6664943bc84db1d._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joey.kitenet.net/"
+ nickname="joey"
+ subject="comment 1"
+ date="2011-08-29T16:10:38Z"
+ content="""
+You're right -- as long as nothing changes a file without letting the modification time update, editing WORM files is safe.
+"""]]

doc/forum/version_3_upgrade.mdwn

@@ -0,0 +1,9 @@
+after upgrading to git-annex 3, i'm stuck with diverging git-annex branches -- i didn't manage to follow this line in the directions:
+
+> After this upgrade, you should make sure you include the git-annex branch when git pushing and pulling.
+
+could you explain how to do that in a littel more detail? git pull seems to only merge master, although i have these ``.git/config`` settings:
+
+    [branch "git-annex"]
+    	remote = origin
+    	merge = git-annex

doc/forum/version_3_upgrade/comment_1_05fc9c9cad26c520bebb98c852c71e35._comment

@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="http://joey.kitenet.net/"
+ nickname="joey"
+ subject="comment 1"
+ date="2011-08-17T01:33:08Z"
+ content="""
+It's ok that `git pull` does not merge the git-annex branch. You can merge it with `git annex merge`, or it will be done
+automatically when you use other git-annex commands.
+
+If you use `git pull` and `git push` without any options, the defaults will make git pull and push the git-annex branch automatically.
+
+But if you're in the habit of doing `git push origin master`, that won't cause the git-annex branch to be pushed (use `git push origin git-annex` to manually push it then). Similarly, `git pull origin master` won't pull it. And also, the `remote.origin.fetch` setting in `.git/config` can be modified in ways that make `git pull` not automatically pull the git-annex branch. So those are the things to avoid after upgrade to v3, basically.
+"""]]

doc/git-annex.mdwn

@@ -72,15 +72,15 @@ Many git-annex commands will stage changes for later `git commit` by you.
 
 * get [path ...]
 
-  Makes the content of annexed files available in this repository. Depending
+  Makes the content of annexed files available in this repository. This
-  on the backend used, this will involve copying them from another repository,
+  will involve copying them from another repository, or downloading them,
-  or downloading them, or transferring them from some kind of key-value store.
+  or transferring them from some kind of key-value store.
 
 * drop [path ...]
 
   Drops the content of annexed files from this repository. 
 
-  git-annex may refuse to drop content if the backend does not think
+  git-annex may refuse to drop content if it does not think
   it is safe to do so, typically because of the setting of annex.numcopies.
 
 * move [path ...]
@@ -119,10 +119,14 @@ Many git-annex commands will stage changes for later `git commit` by you.
   Use this to undo an unlock command if you don't want to modify
   the files, or have made modifications you want to discard.
 
-* init description
+* init [description]
 
-  Initializes git-annex with a description of the git repository,
+  Until a repository (or one of its remotes) has been initialized,
-  and sets up `.gitattributes` and the pre-commit hook.
+  git-annex will refuse to operate on it, to avoid accidentially
+  using it in a repository that was not intended to have an annex.
+
+  It's useful, but not mandatory, to initialize each new clone
+  of a repository with its own description.
 
 * describe repository description
 
@@ -201,14 +205,14 @@ Many git-annex commands will stage changes for later `git commit` by you.
 
 * migrate [path ...]
 
-  Changes the specified annexed files to store their content in the
+  Changes the specified annexed files to use the default key-value backend
-  default backend (or the one specified with --backend). Only files whose
+  (or the one specified with --backend). Only files whose content
-  content is currently available are migrated.
+  is currently available are migrated.
 
-  Note that the content is not removed from the backend it was previously in.
+  Note that the content is also still available using the old key after
-  Use `git annex unused` to find and remove such content.
+  migration. Use `git annex unused` to find and remove the old key.
 
-  Normally, nothing will be done to files already in the backend.
+  Normally, nothing will be done to files already using the new backend.
   However, if a backend changes the information it uses to construct a key,
   this can also be used to migrate files to use the new key format.
 
@@ -282,10 +286,12 @@ Many git-annex commands will stage changes for later `git commit` by you.
 
   Downloads each url to a file, which is added to the annex.
 
+  To avoid immediately downloading the url, specify --fast
+
 * fromkey file
 
   This plumbing-level command can be used to manually set up a file
-  to link to a specified key in the key-value backend.
+  in the git repository to link to a specified key.
 
 * dropkey [key ...]
 
@@ -331,12 +337,18 @@ Many git-annex commands will stage changes for later `git commit` by you.
 
 * --quiet
 
-  Avoid the default verbose logging of what is done; only show errors
+  Avoid the default verbose display of what is done; only show errors
   and progress displays.
 
 * --verbose
 
-  Enable verbose logging.
+  Enable verbose display.
+
+* --json
+
+  Rather than the normal output, generate JSON. This is intended to be
+  parsed by programs that use git-annex. Each line of output is a JSON
+  object.
 
 * --debug
 
@@ -416,6 +428,12 @@ Here are all the supported configuration settings.
   The default cost is 100 for local repositories, and 200 for remote
   repositories.
 
+* `remote.<name>.annex-cost-command`
+
+  If set, the command is run, and the number it outputs is used as the cost.
+  This allows varying the cost based on eg, the current network. The
+  cost-command can be any shell command line.
+
 * `remote.<name>.annex-ignore`
 
   If set to `true`, prevents git-annex
@@ -486,8 +504,8 @@ Here are all the supported configuration settings.
 
 # CONFIGURATION VIA .gitattributes
 
-The backend used when adding a new file to the annex can be configured
+The key-value backend used when adding a new file to the annex can be
-on a per-file-type basis via `.gitattributes` files. In the file,
+configured on a per-file-type basis via `.gitattributes` files. In the file,
 the `annex.backend` attribute can be set to the name of the backend to
 use. For example, this here's how to use the WORM backend by default,
 but the SHA1 backend for ogg files:

doc/index.mdwn

@@ -12,7 +12,7 @@ To get a feel for it, see the [[walkthrough]].
 * [[forum]]
 * [[comments]]
 * [[contact]]
-* <a href="http://flattr.com/thing/84843/git-annex"><img src="http://api.flattr.com/button/button-compact-static-100x17.png" alt="Flattr this" title="Flattr this" /></a>
+* <a href="http://flattr.com/thing/84843/git-annex"><img src="https://api.flattr.com/button/flattr-badge-large.png" alt="Flattr this" title="Flattr this" /></a>
 
 [[News]]: