packages feed

git-annex 3.20110928 → 3.20111011

raw patch · 111 files changed

+1734/−1673 lines, 111 files

Files

Annex.hs view
@@ -19,10 +19,10 @@ 	gitRepo ) where -import Control.Monad.State import Control.Monad.IO.Control-import Control.Applicative hiding (empty)+import Control.Monad.State +import Common import qualified Git import Git.CatFile import Git.Queue@@ -75,7 +75,7 @@ 	{ repo = gitrepo 	, backends = [] 	, remotes = []-	, repoqueue = empty+	, repoqueue = Git.Queue.empty 	, output = NormalOutput 	, force = False 	, fast = False
+ Annex/Branch.hs view
@@ -0,0 +1,340 @@+{- management of the git-annex branch+ -+ - Copyright 2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.Branch (+	create,+	update,+	get,+	change,+	commit,+	files,+	refExists,+	hasOrigin,+	hasSomeBranch,+	name	+) where++import System.IO.Binary+import System.Exit+import qualified Data.ByteString.Lazy.Char8 as L++import Common.Annex+import Annex.Exception+import Types.BranchState+import qualified Git+import qualified Git.UnionMerge+import qualified Annex+import Annex.CatFile++type GitRef = String++{- Name of the branch that is used to store git-annex's information. -}+name :: GitRef+name = "git-annex"++{- Fully qualified name of the branch. -}+fullname :: GitRef+fullname = "refs/heads/" ++ name++{- Branch's name in origin. -}+originname :: GitRef+originname = "origin/" ++ name++{- A separate index file for the branch. -}+index :: Git.Repo -> FilePath+index g = gitAnnexDir g </> "index"++{- Populates the branch's index file with the current branch contents.+ - + - Usually, this is only done when the index doesn't yet exist, and+ - the index is used to build up changes to be commited to the branch,+ - and merge in changes from other branches.+ -}+genIndex :: Git.Repo -> IO ()+genIndex g = Git.UnionMerge.ls_tree g fullname >>= Git.UnionMerge.update_index g++{- Runs an action using the branch's index file. -}+withIndex :: Annex a -> Annex a+withIndex = withIndex' False+withIndex' :: Bool -> Annex a -> Annex a+withIndex' bootstrapping a = do+	g <- gitRepo+	let f = index g++	bracketIO (Git.useIndex f) id $ do+		unlessM (liftIO $ doesFileExist f) $ do+			unless bootstrapping create+			liftIO $ createDirectoryIfMissing True $ takeDirectory f+			unless bootstrapping $ liftIO $ genIndex g+		a++withIndexUpdate :: Annex a -> Annex a+withIndexUpdate a = update >> withIndex a++getState :: Annex BranchState+getState = Annex.getState Annex.branchstate++setState :: BranchState -> Annex ()+setState state = Annex.changeState $ \s -> s { Annex.branchstate = state }++setCache :: FilePath -> String -> Annex ()+setCache file content = do+	state <- getState+	setState state { cachedFile = Just file, cachedContent = content }++invalidateCache :: Annex ()+invalidateCache = do+	state <- getState+	setState state { cachedFile = Nothing, cachedContent = "" }++getCache :: FilePath -> Annex (Maybe String)+getCache file = getState >>= go+	where+		go state+			| cachedFile state == Just file =+				return $ Just $ cachedContent state+			| otherwise = return Nothing++{- Creates the branch, if it does not already exist. -}+create :: Annex ()+create = unlessM hasBranch $ do+	g <- gitRepo+	e <- hasOrigin+	if e+		then liftIO $ Git.run g "branch" [Param name, Param originname]+		else withIndex' True $+			liftIO $ Git.commit g "branch created" fullname []++{- Stages the journal, and commits staged changes to the branch. -}+commit :: String -> Annex ()+commit message = whenM journalDirty $ lockJournal $ do+	stageJournalFiles+	g <- gitRepo+	withIndex $ liftIO $ Git.commit g message fullname [fullname]++{- Ensures that the branch is up-to-date; should be called before+ - data is read from it. Runs only once per git-annex run.+ -+ - Before refs are merged into the index, it's+ - important to first stage the journal into the+ - index. Otherwise, any changes in the journal+ - would later get staged, and might overwrite+ - changes made during the merge.+ -+ - It would be cleaner to handle the merge by+ - updating the journal, not the index, with changes+ - from the branches.+ -}+update :: Annex ()+update = onceonly $ do+	-- check what needs updating before taking the lock+	dirty <- journalDirty+	c <- filterM changedbranch =<< siblingBranches+	let (refs, branches) = unzip c+	unless (not dirty && null refs) $ withIndex $ lockJournal $ do+		when dirty $ stageJournalFiles+		g <- gitRepo+		unless (null branches) $ do+			showSideAction $ "merging " +++				(unwords $ map Git.refDescribe branches) +++				" into " ++ name+			{- Note: This merges the branches into the index.+			 - Any unstaged changes in the git-annex branch+			 - (if it's checked out) will be removed. So,+			 - documentation advises users not to directly+			 - modify the branch.+			 -}+			liftIO $ Git.UnionMerge.merge_index g branches+		liftIO $ Git.commit g "update" fullname (nub $ fullname:refs)+		invalidateCache+	where+		changedbranch (_, branch) = do+			g <- gitRepo+			-- checking with log to see if there have been changes+			-- is less expensive than always merging+			diffs <- liftIO $ Git.pipeRead g [+				Param "log",+				Param (name ++ ".." ++ branch),+				Params "--oneline -n1"+				]+			return $ not $ L.null diffs+		onceonly a = unlessM (branchUpdated <$> getState) $ do+			r <- a+			Annex.changeState setupdated+			return r+		setupdated s = s { Annex.branchstate = new }+			where+				new = old { branchUpdated = True }+				old = Annex.branchstate s++{- Checks if a git ref exists. -}+refExists :: GitRef -> Annex Bool+refExists ref = do+	g <- gitRepo+	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 (refs, branches), including the main one and any+ - from remotes. -}+siblingBranches :: Annex [(String, String)]+siblingBranches = do+	g <- gitRepo+	r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name]+	return $ map (pair . words . L.unpack) (L.lines r)+	where+		pair l = (head l, last l)++{- Applies a function to modifiy the content of a file. -}+change :: FilePath -> (String -> String) -> Annex ()+change file a = lockJournal $ get file >>= return . a >>= set file++{- Records new content of a file into the journal. -}+set :: FilePath -> String -> Annex ()+set file content = do+	setJournalFile file content+	setCache file content++{- Gets the content of a file on the branch, or content from the journal, or+ - staged in the index.+ -+ - Returns an empty string if the file doesn't exist yet. -}+get :: FilePath -> Annex String+get file = fromcache =<< getCache file+	where+		fromcache (Just content) = return content+		fromcache Nothing = fromjournal =<< getJournalFile file+		fromjournal (Just content) = cache content+		fromjournal Nothing = withIndexUpdate $+			cache =<< catFile fullname file+		cache content = do+			setCache file content+			return content++{- Lists all files on the branch. There may be duplicates in the list. -}+files :: Annex [FilePath]+files = withIndexUpdate $ do+	g <- gitRepo+	bfiles <- liftIO $ Git.pipeNullSplit g+		[Params "ls-tree --name-only -r -z", Param fullname]+	jfiles <- getJournalledFiles+	return $ jfiles ++ bfiles++{- Records content for a file in the branch to the journal.+ -+ - Using the journal, rather than immediatly staging content to the index+ - avoids git needing to rewrite the index after every change. -}+setJournalFile :: FilePath -> String -> Annex ()+setJournalFile file content = do+	g <- gitRepo+	liftIO $ catch (write g) $ const $ do+		createDirectoryIfMissing True $ gitAnnexJournalDir g+		createDirectoryIfMissing True $ gitAnnexTmpDir g+		write g+	where+		-- journal file is written atomically+		write g = do+			let jfile = journalFile g file+			let tmpfile = gitAnnexTmpDir g </> takeFileName jfile+			writeBinaryFile tmpfile content+			renameFile tmpfile jfile++{- Gets any journalled content for a file in the branch. -}+getJournalFile :: FilePath -> Annex (Maybe String)+getJournalFile file = do+	g <- gitRepo+	liftIO $ catch (liftM Just . readFileStrict $ journalFile g file)+		(const $ return Nothing)++{- List of files that have updated content in the journal. -}+getJournalledFiles :: Annex [FilePath]+getJournalledFiles = map fileJournal <$> getJournalFiles++{- List of existing journal files. -}+getJournalFiles :: Annex [FilePath]+getJournalFiles = do+	g <- gitRepo+	fs <- liftIO $ catch (getDirectoryContents $ gitAnnexJournalDir g)+		(const $ return [])+	return $ filter (`notElem` [".", ".."]) fs++{- Stages the specified journalfiles. -}+stageJournalFiles :: Annex ()+stageJournalFiles = do+	fs <- getJournalFiles+	g <- gitRepo+	withIndex $ liftIO $ do+		let dir = gitAnnexJournalDir g+		let paths = map (dir </>) fs+		-- inject all the journal files directly into git+		-- in one quick command+		(pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object g+		_ <- forkProcess $ do+			hPutStr toh $ unlines paths+			hClose toh+			exitSuccess+		hClose toh+		s <- hGetContents fromh+		-- update the index, also in just one command+		Git.UnionMerge.update_index g $+			index_lines (lines s) $ map fileJournal fs+		hClose fromh+		forceSuccess pid+		mapM_ removeFile paths+	where+		index_lines shas = map genline . zip shas+		genline (sha, file) = Git.UnionMerge.update_index_line sha file+		git_hash_object g = Git.gitCommandLine g+			[Param "hash-object", Param "-w", Param "--stdin-paths"]+++{- Checks if there are changes in the journal. -}+journalDirty :: Annex Bool+journalDirty = not . null <$> getJournalFiles++{- Produces a filename to use in the journal for a file on the branch.+ -+ - The journal typically won't have a lot of files in it, so the hashing+ - used in the branch is not necessary, and all the files are put directly+ - in the journal directory.+ -}+journalFile :: Git.Repo -> FilePath -> FilePath+journalFile repo file = gitAnnexJournalDir repo </> concatMap mangle file+	where+		mangle '/' = "_"+		mangle '_' = "__"+		mangle c = [c]++{- Converts a journal file (relative to the journal dir) back to the+ - filename on the branch. -}+fileJournal :: FilePath -> FilePath+fileJournal = replace "//" "_" . replace "_" "/"++{- Runs an action that modifies the journal, using locking to avoid+ - contention with other git-annex processes. -}+lockJournal :: Annex a -> Annex a+lockJournal a = do+	g <- gitRepo+	let file = gitAnnexJournalLock g+	bracketIO (lock file) unlock a+	where+		lock file = do+			l <- createFile file stdFileMode+			waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)+			return l+		unlock = closeFd
+ Annex/CatFile.hs view
@@ -0,0 +1,24 @@+{- git cat-file interface, with handle automatically stored in the Annex monad+ -+ - Copyright 2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.CatFile (+	catFile+) where++import Common.Annex+import qualified Git.CatFile+import qualified Annex++catFile :: String -> FilePath -> Annex String+catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle+	where+		startup = do+			g <- gitRepo+			h <- liftIO $ Git.CatFile.catFileStart g+			Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }+			go h+		go h = liftIO $ Git.CatFile.catFile h branch file
+ Annex/Content.hs view
@@ -0,0 +1,237 @@+{- git-annex file content managing+ -+ - Copyright 2010 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.Content (+	inAnnex,+	calcGitLink,+	logStatus,+	getViaTmp,+	getViaTmpUnchecked,+	withTmp,+	checkDiskSpace,+	moveAnnex,+	removeAnnex,+	fromAnnex,+	moveBad,+	getKeysPresent,+	saveState+) where++import Common.Annex+import LocationLog+import UUID+import qualified Git+import qualified Annex+import qualified Annex.Queue+import qualified Annex.Branch+import Utility.StatFS+import Utility.FileMode+import Types.Key+import Utility.DataUnits+import Config++{- Checks if a given key is currently present in the gitAnnexLocation. -}+inAnnex :: Key -> Annex Bool+inAnnex key = do+	g <- gitRepo+	when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"+	liftIO $ doesFileExist $ gitAnnexLocation g key++{- Calculates the relative path to use to link a file to a key. -}+calcGitLink :: FilePath -> Key -> Annex FilePath+calcGitLink file key = do+	g <- gitRepo+	cwd <- liftIO getCurrentDirectory+	let absfile = fromMaybe whoops $ absNormPath cwd file+	return $ relPathDirToFile (parentDir absfile) +			(Git.workTree g) </> ".git" </> annexLocation key+	where+		whoops = error $ "unable to normalize " ++ file++{- Updates the LocationLog when a key's presence changes in the current+ - repository. -}+logStatus :: Key -> LogStatus -> Annex ()+logStatus key status = do+	g <- gitRepo+	u <- getUUID+	logChange g key u status++{- Runs an action, passing it a temporary filename to download,+ - and if the action succeeds, moves the temp file into + - the annex as a key's content. -}+getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool+getViaTmp key action = do+	g <- gitRepo+	let tmp = gitAnnexTmpLocation g key++	-- Check that there is enough free disk space.+	-- When the temp file already exists, count the space+	-- it is using as free.+	e <- liftIO $ doesFileExist tmp+	if e+		then do+			stat <- liftIO $ getFileStatus tmp+			checkDiskSpace' (fromIntegral $ fileSize stat) key+		else checkDiskSpace key++	when e $ liftIO $ allowWrite tmp++	getViaTmpUnchecked key action++prepTmp :: Key -> Annex FilePath+prepTmp key = do+	g <- gitRepo+	let tmp = gitAnnexTmpLocation g key+	liftIO $ createDirectoryIfMissing True (parentDir tmp)+	return tmp++{- Like getViaTmp, but does not check that there is enough disk space+ - for the incoming key. For use when the key content is already on disk+ - and not being copied into place. -}+getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool+getViaTmpUnchecked key action = do+	tmp <- prepTmp key+	success <- action tmp+	if success+		then do+			moveAnnex key tmp+			logStatus key InfoPresent+			return True+		else do+			-- the tmp file is left behind, in case caller wants+			-- to resume its transfer+			return False++{- Creates a temp file, runs an action on it, and cleans up the temp file. -}+withTmp :: Key -> (FilePath -> Annex a) -> Annex a+withTmp key action = do+	tmp <- prepTmp key+	res <- action tmp+	liftIO $ whenM (doesFileExist tmp) $ liftIO $ removeFile tmp+	return res++{- Checks that there is disk space available to store a given key,+ - throwing an error if not. -}+checkDiskSpace :: Key -> Annex ()+checkDiskSpace = checkDiskSpace' 0++checkDiskSpace' :: Integer -> Key -> Annex ()+checkDiskSpace' adjustment key = do+	g <- gitRepo+	r <- getConfig g "diskreserve" ""+	let reserve = fromMaybe megabyte $ readSize dataUnits r+	stats <- liftIO $ getFileSystemStats (gitAnnexDir g)+	case (stats, keySize key) of+		(Nothing, _) -> return ()+		(_, Nothing) -> return ()+		(Just (FileSystemStats { fsStatBytesAvailable = have }), Just need) ->+			when (need + reserve > have + adjustment) $+				needmorespace (need + reserve - have - adjustment)+	where+		megabyte :: Integer+		megabyte = 1000000+		needmorespace n = unlessM (Annex.getState Annex.force) $+			error $ "not enough free space, need " ++ +				roughSize storageUnits True n +++				" more (use --force to override this check or adjust annex.diskreserve)"++{- Moves a file into .git/annex/objects/+ -+ - What if the key there already has content? This could happen for+ - various reasons; perhaps the same content is being annexed again.+ - Perhaps there has been a hash collision generating the keys.+ -+ - The current strategy is to assume that in this case it's safe to delete+ - one of the two copies of the content; and the one already in the annex+ - is left there, assuming it's the original, canonical copy.+ -+ - I considered being more paranoid, and checking that both files had+ - the same content. Decided against it because A) users explicitly choose+ - a backend based on its hashing properties and so if they're dealing+ - with colliding files it's their own fault and B) adding such a check+ - would not catch all cases of colliding keys. For example, perhaps + - a remote has a key; if it's then added again with different content then+ - the overall system now has two different peices of content for that+ - key, and one of them will probably get deleted later. So, adding the+ - check here would only raise expectations that git-annex cannot truely+ - meet.+ -}+moveAnnex :: Key -> FilePath -> Annex ()+moveAnnex key src = do+	g <- gitRepo+	let dest = gitAnnexLocation g key+	let dir = parentDir dest+	e <- liftIO $ doesFileExist dest+	if e+		then liftIO $ removeFile src+		else liftIO $ do+			createDirectoryIfMissing True dir+			allowWrite dir -- in case the directory already exists+			renameFile src dest+			preventWrite dest+			preventWrite dir++withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a+withObjectLoc key a = do+	g <- gitRepo+	let file = gitAnnexLocation g key+	let dir = parentDir file+	a (dir, file)++{- Removes a key's file from .git/annex/objects/ -}+removeAnnex :: Key -> Annex ()+removeAnnex key = withObjectLoc key $ \(dir, file) -> liftIO $ do+	allowWrite dir+	removeFile file+	removeDirectory dir++{- Moves a key's file out of .git/annex/objects/ -}+fromAnnex :: Key -> FilePath -> Annex ()+fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do+	allowWrite dir+	allowWrite file+	renameFile file dest+	removeDirectory dir++{- Moves a key out of .git/annex/objects/ into .git/annex/bad, and+ - returns the file it was moved to. -}+moveBad :: Key -> Annex FilePath+moveBad key = do+	g <- gitRepo+	let src = gitAnnexLocation g key+	let dest = gitAnnexBadDir g </> takeFileName src+	liftIO $ do+		createDirectoryIfMissing True (parentDir dest)+		allowWrite (parentDir src)+		renameFile src dest+		removeDirectory (parentDir src)+	logStatus key InfoMissing+	return dest++{- List of keys whose content exists in .git/annex/objects/ -}+getKeysPresent :: Annex [Key]+getKeysPresent = do+	g <- gitRepo+	getKeysPresent' $ gitAnnexObjectDir g+getKeysPresent' :: FilePath -> Annex [Key]+getKeysPresent' dir = do+	exists <- liftIO $ doesDirectoryExist dir+	if not exists+		then return []+		else liftIO $ do+			-- 2 levels of hashing+			levela <- dirContents dir+			levelb <- mapM dirContents levela+			contents <- mapM dirContents (concat levelb)+			let files = concat contents+			return $ mapMaybe (fileKey . takeFileName) files++{- Things to do to record changes to content. -}+saveState :: Annex ()+saveState = do+	Annex.Queue.flush False+	Annex.Branch.commit "update"
+ Annex/Exception.hs view
@@ -0,0 +1,27 @@+{- exception handling in the git-annex monad+ -+ - Copyright 2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.Exception (+	bracketIO,+	handle,+	throw,+) where++import Control.Exception.Control (handle)+import Control.Monad.IO.Control (liftIOOp)+import Control.Exception hiding (handle, throw)++import Common.Annex++{- Runs an Annex action, with setup and cleanup both in the IO monad. -}+bracketIO :: IO c -> (c -> IO b) -> Annex a -> Annex a+bracketIO setup cleanup go =+	liftIOOp (Control.Exception.bracket setup cleanup) (const go)++{- Throws an exception in the Annex monad. -}+throw :: Control.Exception.Exception e => e -> Annex a+throw = liftIO . throwIO
+ Annex/Queue.hs view
@@ -0,0 +1,42 @@+{- git-annex command queue+ -+ - Copyright 2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.Queue (+	add,+	flush,+	flushWhenFull+) where++import Common.Annex+import Annex+import qualified Git.Queue++{- Adds a git command to the queue. -}+add :: String -> [CommandParam] -> [FilePath] -> Annex ()+add command params files = do+	q <- getState repoqueue+	store $ Git.Queue.add q command params files++{- Runs the queue if it is full. Should be called periodically. -}+flushWhenFull :: Annex ()+flushWhenFull = do+	q <- getState repoqueue+	when (Git.Queue.full q) $ flush False++{- Runs (and empties) the queue. -}+flush :: Bool -> Annex ()+flush silent = do+	q <- getState repoqueue+	unless (0 == Git.Queue.size q) $ do+		unless silent $+			showSideAction "Recording state in git"+		g <- gitRepo+		q' <- liftIO $ Git.Queue.flush g q+		store q'++store :: Git.Queue.Queue -> Annex ()+store q = changeState $ \s -> s { repoqueue = q }
+ Annex/Version.hs view
@@ -0,0 +1,46 @@+{- git-annex repository versioning+ -+ - Copyright 2010 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.Version where++import Common.Annex+import qualified Git+import Config++type Version = String++defaultVersion :: Version+defaultVersion = "3"++supportedVersions :: [Version]+supportedVersions = [defaultVersion]++upgradableVersions :: [Version]+upgradableVersions = ["0", "1", "2"]++versionField :: String+versionField = "annex.version"++getVersion :: Annex (Maybe Version)+getVersion = do+	g <- gitRepo+	let v = Git.configGet g versionField ""+	if not $ null v+		then return $ Just v+		else return Nothing++setVersion :: Annex ()+setVersion = setConfig versionField defaultVersion++checkVersion :: Version -> Annex ()+checkVersion v+	| v `elem` supportedVersions = return ()+	| v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade"+	| otherwise = err "Upgrade git-annex."+	where+		err msg = error $ "Repository version " ++ v +++			" is not supported. " ++ msg
− AnnexQueue.hs
@@ -1,46 +0,0 @@-{- git-annex command queue- -- - Copyright 2011 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module AnnexQueue (-	add,-	flush,-	flushWhenFull-) where--import Control.Monad.State (liftIO)-import Control.Monad (when, unless)--import Annex-import Messages-import qualified Git.Queue-import Utility.SafeCommand--{- Adds a git command to the queue. -}-add :: String -> [CommandParam] -> [FilePath] -> Annex ()-add command params files = do-	q <- getState repoqueue-	store $ Git.Queue.add q command params files--{- Runs the queue if it is full. Should be called periodically. -}-flushWhenFull :: Annex ()-flushWhenFull = do-	q <- getState repoqueue-	when (Git.Queue.full q) $ flush False--{- Runs (and empties) the queue. -}-flush :: Bool -> Annex ()-flush silent = do-	q <- getState repoqueue-	unless (0 == Git.Queue.size q) $ do-		unless silent $-			showSideAction "Recording state in git"-		g <- gitRepo-		q' <- liftIO $ Git.Queue.flush g q-		store q'--store :: Git.Queue.Queue -> Annex ()-store q = changeState $ \s -> s { repoqueue = q }
Backend.hs view
@@ -16,20 +16,14 @@ 	maybeLookupBackendName ) where -import Control.Monad.State (liftIO, when)-import Control.Applicative import System.IO.Error (try)-import System.FilePath import System.Posix.Files-import Data.Maybe -import Locations+import Common.Annex import qualified Git import qualified Annex-import Types import Types.Key import qualified Types.Backend as B-import Messages  -- When adding a new backend, import it here and add it to the list. import qualified Backend.WORM@@ -45,23 +39,20 @@ 	l <- Annex.getState Annex.backends -- list is cached here 	if not $ null l 		then return l-		else do-			s <- getstandard-			d <- Annex.getState Annex.forcebackend-			handle d s+		else handle =<< Annex.getState Annex.forcebackend 	where-		parseBackendList [] = list-		parseBackendList s = map lookupBackendName $ words s-		handle Nothing s = return s-		handle (Just "") s = return s-		handle (Just name) s = do-			let l' = lookupBackendName name : s-			Annex.changeState $ \state -> state { Annex.backends = l' }+		handle Nothing = standard+		handle (Just "") = standard+		handle (Just name) = do+			l' <- (lookupBackendName name :) <$> standard+			Annex.changeState $ \s -> s { Annex.backends = l' } 			return l'-		getstandard = do-			g <- Annex.gitRepo+		standard = do+			g <- gitRepo 			return $ parseBackendList $ 				Git.configGet g "annex.backends" ""+		parseBackendList [] = list+		parseBackendList s = map lookupBackendName $ words s  {- Generates a key for a file, trying each backend in turn until one  - accepts it. -}@@ -89,17 +80,15 @@ 	where 		getsymlink = takeFileName <$> readSymbolicLink file 		makekey l = maybe (return Nothing) (makeret l) (fileKey l)-		makeret l k =+		makeret l k = let bname = keyBackendName k in 			case maybeLookupBackendName bname of-					Just backend -> return $ Just (k, backend)-					Nothing -> do-						when (isLinkToAnnex l) $-							warning skip-						return Nothing-			where-				bname = keyBackendName k-				skip = "skipping " ++ file ++ -					" (unknown backend " ++ bname ++ ")"+				Just backend -> return $ Just (k, backend)+				Nothing -> do+					when (isLinkToAnnex l) $ warning $+						"skipping " ++ file +++						" (unknown backend " +++						bname ++ ")"+					return Nothing  type BackendFile = (Maybe (Backend Annex), FilePath) @@ -108,7 +97,7 @@  -} chooseBackends :: [FilePath] -> Annex [BackendFile] chooseBackends fs = do-	g <- Annex.gitRepo+	g <- gitRepo 	forced <- Annex.getState Annex.forcebackend 	if isJust forced 		then do@@ -127,4 +116,5 @@ maybeLookupBackendName s 	| length matches == 1 = Just $ head matches 	| otherwise = Nothing-	where matches = filter (\b -> s == B.name b) list+	where+		matches = filter (\b -> s == B.name b) list
Backend/SHA.hs view
@@ -7,23 +7,11 @@  module Backend.SHA (backends) where -import Control.Monad.State-import Data.String.Utils-import System.Cmd.Utils-import System.IO-import System.Directory-import Data.Maybe-import System.Posix.Files-import System.FilePath--import Messages+import Common.Annex import qualified Annex-import Locations-import Content-import Types+import Annex.Content import Types.Backend import Types.Key-import Utility.SafeCommand import qualified Build.SysConfig as SysConfig  type SHASize = Int@@ -110,17 +98,17 @@ {- A key's checksum is checked during fsck. -} checkKeyChecksum :: SHASize -> Key -> Annex Bool checkKeyChecksum size key = do-	g <- Annex.gitRepo+	g <- gitRepo 	fast <- Annex.getState Annex.fast 	let file = gitAnnexLocation g key 	present <- liftIO $ doesFileExist file 	if not present || fast 		then return True-		else do-			s <- shaN size file-			if s == dropExtension (keyName key)-				then return True-				else do-					dest <- moveBad key-					warning $ "Bad file content; moved to " ++ dest-					return False+		else check =<< shaN size file+	where+		check s+			| s == dropExtension (keyName key) = return True+			| otherwise = do+				dest <- moveBad key+				warning $ "Bad file content; moved to " ++ dest+				return False
Backend/URL.hs view
@@ -10,9 +10,9 @@ 	fromUrl ) where +import Common.Annex import Types.Backend import Types.Key-import Types  backends :: [Backend Annex] backends = [backend]
Backend/WORM.hs view
@@ -7,12 +7,8 @@  module Backend.WORM (backends) where -import Control.Monad.State-import System.FilePath-import System.Posix.Files-+import Common.Annex import Types.Backend-import Types import Types.Key  backends :: [Backend Annex]
− Branch.hs
@@ -1,337 +0,0 @@-{- management of the git-annex branch- -- - Copyright 2011 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module Branch (-	create,-	update,-	get,-	change,-	commit,-	files,-	refExists,-	hasOrigin,-	hasSomeBranch,-	name	-) where--import Control.Monad (unless, liftM)-import Control.Monad.State (liftIO)-import Control.Applicative ((<$>))-import System.FilePath-import System.Directory-import Data.String.Utils-import System.Cmd.Utils-import Data.Maybe-import System.IO-import System.IO.Binary-import System.Posix.Process-import System.Exit--import Types.BranchState-import qualified Git-import qualified Git.UnionMerge-import qualified Annex-import Utility-import Utility.Conditional-import Utility.SafeCommand-import Types-import Messages-import Locations-import CatFile--type GitRef = String--{- Name of the branch that is used to store git-annex's information. -}-name :: GitRef-name = "git-annex"--{- Fully qualified name of the branch. -}-fullname :: GitRef-fullname = "refs/heads/" ++ name--{- Branch's name in origin. -}-originname :: GitRef-originname = "origin/" ++ name--{- A separate index file for the branch. -}-index :: Git.Repo -> FilePath-index g = gitAnnexDir g </> "index"--{- Populates the branch's index file with the current branch contents.- - - - Usually, this is only done when the index doesn't yet exist, and- - the index is used to build up changes to be commited to the branch,- - and merge in changes from other branches.- -}-genIndex :: Git.Repo -> IO ()-genIndex g = Git.UnionMerge.ls_tree g fullname >>= Git.UnionMerge.update_index g--{- Runs an action using the branch's index file. -}-withIndex :: Annex a -> Annex a-withIndex = withIndex' False-withIndex' :: Bool -> Annex a -> Annex a-withIndex' bootstrapping a = do-	g <- Annex.gitRepo-	let f = index g-	reset <- liftIO $ Git.useIndex f--	e <- liftIO $ doesFileExist f-	unless e $ do-		unless bootstrapping create-		liftIO $ createDirectoryIfMissing True $ takeDirectory f-		liftIO $ unless bootstrapping $ genIndex g--	r <- a-	liftIO reset-	return r--withIndexUpdate :: Annex a -> Annex a-withIndexUpdate a = update >> withIndex a--getState :: Annex BranchState-getState = Annex.getState Annex.branchstate--setState :: BranchState -> Annex ()-setState state = Annex.changeState $ \s -> s { Annex.branchstate = state }--setCache :: FilePath -> String -> Annex ()-setCache file content = do-	state <- getState-	setState state { cachedFile = Just file, cachedContent = content }--invalidateCache :: Annex ()-invalidateCache = do-	state <- getState-	setState state { cachedFile = Nothing, cachedContent = "" }--getCache :: FilePath -> Annex (Maybe String)-getCache file = getState >>= handle-	where-		handle state-			| cachedFile state == Just file =-				return $ Just $ cachedContent state-			| otherwise = return Nothing--{- Creates the branch, if it does not already exist. -}-create :: Annex ()-create = unlessM hasBranch $ do-	g <- Annex.gitRepo-	e <- hasOrigin-	if e-		then liftIO $ Git.run g "branch" [Param name, Param originname]-		else withIndex' True $-			liftIO $ Git.commit g "branch created" fullname []--{- Stages the journal, and commits staged changes to the branch. -}-commit :: String -> Annex ()-commit message = whenM stageJournalFiles $ do-	g <- Annex.gitRepo-	withIndex $ liftIO $ Git.commit g message fullname [fullname]--{- Ensures that the branch is up-to-date; should be called before- - data is read from it. Runs only once per git-annex run. -}-update :: Annex ()-update = do-	state <- getState-	unless (branchUpdated state) $ withIndex $ do-		{- Since branches get merged into the index, it's important to-		 - first stage the journal into the index. Otherwise, any-		 - changes in the journal would later get staged, and might-		 - overwrite changes made during the merge.-		 --		 - It would be cleaner to handle the merge by updating the-		 - journal, not the index, with changes from the branches.-		 -}-		staged <- stageJournalFiles--		refs <- siblingBranches-		updated <- catMaybes <$> mapM updateRef refs-		g <- Annex.gitRepo-		unless (null updated && not staged) $ liftIO $-			Git.commit g "update" fullname (fullname:updated)-		Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } }-		invalidateCache--{- Checks if a git ref exists. -}-refExists :: GitRef -> Annex Bool-refExists ref = do-	g <- Annex.gitRepo-	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-	| ref == fullname = return Nothing-	| otherwise = do-		g <- Annex.gitRepo-		-- checking with log to see if there have been changes-		-- is less expensive than always merging-		diffs <- liftIO $ Git.pipeRead g [-			Param "log",-			Param (name++".."++ref),-			Params "--oneline -n1"-			]-		if null diffs-			then return Nothing-			else do-				showSideAction $ "merging " ++ Git.refDescribe ref ++ " into " ++ name-				-- By passing only one ref, it is actually-				-- merged into the index, preserving any-				-- changes that may already be staged.-				---				-- However, any changes in the git-annex-				-- branch that are *not* reflected in the-				-- index will be removed. So, documentation-				-- advises users not to directly modify the-				-- branch.-				liftIO $ Git.UnionMerge.merge g [ref]-				return $ Just ref--{- Records changed content of a file into the journal. -}-change :: FilePath -> String -> Annex ()-change file content = do-	setJournalFile file content-	setCache file content--{- Gets the content of a file on the branch, or content from the journal, or- - staged in the index.- -- - Returns an empty string if the file doesn't exist yet. -}-get :: FilePath -> Annex String-get file = do-	cached <- getCache file-	case cached of-		Just content -> return content-		Nothing -> do-			j <- getJournalFile file-			case j of-				Just content -> do-					setCache file content-					return content-				Nothing -> withIndexUpdate $ do-					content <- catFile fullname file-					setCache file content-					return content--{- Lists all files on the branch. There may be duplicates in the list. -}-files :: Annex [FilePath]-files = withIndexUpdate $ do-	g <- Annex.gitRepo-	bfiles <- liftIO $ Git.pipeNullSplit g-		[Params "ls-tree --name-only -r -z", Param fullname]-	jfiles <- getJournalFiles-	return $ jfiles ++ bfiles--{- Records content for a file in the branch to the journal.- -- - Using the journal, rather than immediatly staging content to the index- - avoids git needing to rewrite the index after every change. -}-setJournalFile :: FilePath -> String -> Annex ()-setJournalFile file content = do-	g <- Annex.gitRepo-	liftIO $ catch (write g) $ const $ do-		createDirectoryIfMissing True $ gitAnnexJournalDir g-		createDirectoryIfMissing True $ gitAnnexTmpDir g-		write g-	where-		-- journal file is written atomically-		write g = do-			let jfile = journalFile g file-			let tmpfile = gitAnnexTmpDir g </> takeFileName jfile-			writeBinaryFile tmpfile content-			renameFile tmpfile jfile--{- Gets journalled content for a file in the branch. -}-getJournalFile :: FilePath -> Annex (Maybe String)-getJournalFile file = do-	g <- Annex.gitRepo-	liftIO $ catch (liftM Just . readFileStrict $ journalFile g file)-		(const $ return Nothing)--{- List of journal files. -}-getJournalFiles :: Annex [FilePath]-getJournalFiles = map fileJournal <$> getJournalFilesRaw--getJournalFilesRaw :: Annex [FilePath]-getJournalFilesRaw = do-	g <- Annex.gitRepo-	fs <- liftIO $ catch (getDirectoryContents $ gitAnnexJournalDir g)-		(const $ return [])-	return $ filter (`notElem` [".", ".."]) fs--{- Stages all journal files into the index, and returns True if the index- - was modified. -}-stageJournalFiles :: Annex Bool-stageJournalFiles = do-	l <- getJournalFilesRaw-	if null l-		then return False-		else do-			g <- Annex.gitRepo-			withIndex $ liftIO $ stage g l-			return True-	where-		stage g fs = do-			let dir = gitAnnexJournalDir g-			let paths = map (dir </>) fs-			-- inject all the journal files directly into git-			-- in one quick command-			(pid, fromh, toh) <- hPipeBoth "git" $ toCommand $-				Git.gitCommandLine g [Param "hash-object", Param "-w", Param "--stdin-paths"]-			_ <- forkProcess $ do-				hPutStr toh $ unlines paths-				hClose toh-				exitSuccess-			hClose toh-			s <- hGetContents fromh-			-- update the index, also in just one command-			Git.UnionMerge.update_index g $-				index_lines (lines s) $ map fileJournal fs-			hClose fromh-			forceSuccess pid-			mapM_ removeFile paths-		index_lines shas fs = map genline $ zip shas fs-		genline (sha, file) = Git.UnionMerge.update_index_line sha file--{- Produces a filename to use in the journal for a file on the branch.- -- - The journal typically won't have a lot of files in it, so the hashing- - used in the branch is not necessary, and all the files are put directly- - in the journal directory.- -}-journalFile :: Git.Repo -> FilePath -> FilePath-journalFile repo file = gitAnnexJournalDir repo </> concatMap mangle file-	where-		mangle '/' = "_"-		mangle '_' = "__"-		mangle c = [c]--{- Converts a journal file (relative to the journal dir) back to the- - filename on the branch. -}-fileJournal :: FilePath -> FilePath-fileJournal = replace "//" "_" . replace "_" "/"
CHANGELOG view
@@ -1,3 +1,36 @@+git-annex (3.20111011) unstable; urgency=low++  * This version of git-annex only works with git 1.7.7 and newer.+    The breakage with old versions is subtle, and affects the+    annex.numcopies settings in .gitattributes, so be sure to upgrade git+    to 1.7.7. (Debian package now depends on that version.)+  * Don't pass absolute paths to git show-attr, as it started following+    symlinks when that's done in 1.7.7. Instead, use relative paths,+    which show-attr only handles 100% correctly in 1.7.7. Closes: #645046+  * Fix referring to remotes by uuid.+  * New or changed repository descriptions in uuid.log now have a timestamp,+    which is used to ensure the newest description is used when the uuid.log+    has been merged.+  * Note that older versions of git-annex will display the timestamp as part+    of the repository description, which is ugly but otherwise harmless.+  * Add timestamps to trust.log and remote.log too.+  * git-annex-shell: Added the --uuid option.+  * git-annex now asks git-annex-shell to verify that it's operating in +    the expected repository.+  * Note that this git-annex will not interoperate with remotes using +    older versions of git-annex-shell.+  * Now supports git's insteadOf configuration, to modify the url+    used to access a remote. Note that pushInsteadOf is not used;+    that and pushurl are reserved for actual git pushes. Closes: #644278+  * status: List all known repositories.+  * When displaying a list of repositories, show git remote names+    in addition to their descriptions.+  * Add locking to avoid races when changing the git-annex branch.+  * Various speed improvements gained by using ByteStrings.+  * Contain the zombie hordes.++ -- Joey Hess <joeyh@debian.org>  Tue, 11 Oct 2011 23:00:02 -0400+ git-annex (3.20110928) unstable; urgency=low    * --in can be used to make git-annex only operate on files
− CatFile.hs
@@ -1,26 +0,0 @@-{- git cat-file interface, with handle automatically stored in the Annex monad- -- - Copyright 2011 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module CatFile (-	catFile-) where--import Control.Monad.State--import qualified Git.CatFile-import Types-import qualified Annex--catFile :: String -> FilePath -> Annex String-catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle-	where-		startup = do-			g <- Annex.gitRepo-			h <- liftIO $ Git.CatFile.catFileStart g-			Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }-			go h-		go h = liftIO $ Git.CatFile.catFile h branch file
CmdLine.hs view
@@ -13,17 +13,14 @@  import System.IO.Error (try) import System.Console.GetOpt-import Control.Monad.State (liftIO)-import Control.Monad (when) +import Common.Annex import qualified Annex-import qualified AnnexQueue+import qualified Annex.Queue import qualified Git-import Content-import Types+import Annex.Content import Command import Options-import Messages import Init  {- Runs the passed command line. -}@@ -84,7 +81,7 @@ tryRun' :: Integer -> Annex.AnnexState -> [Annex Bool] -> IO () tryRun' errnum state (a:as) = do 	result <- try $ Annex.run state $ do-		AnnexQueue.flushWhenFull+		Annex.Queue.flushWhenFull 		a 	case result of 		Left err -> do@@ -104,5 +101,5 @@ shutdown :: Annex Bool shutdown = do 	saveState-	liftIO Git.reap+	liftIO Git.reap -- zombies from long-running git processes 	return True
Command.hs view
@@ -7,22 +7,11 @@  module Command where -import Control.Monad.State (liftIO)-import System.Directory-import System.Posix.Files-import Control.Monad (filterM, liftM)-import Control.Applicative-import Data.Maybe--import Types+import Common.Annex import qualified Backend-import Messages import qualified Annex import qualified Git import qualified Git.LsFiles as LsFiles-import Utility-import Utility.Conditional-import Utility.Path import Types.Key import Trust import LocationLog@@ -98,7 +87,7 @@  notBareRepo :: Annex a -> Annex a notBareRepo a = do-	whenM (Git.repoIsLocalBare <$> Annex.gitRepo) $+	whenM (Git.repoIsLocalBare <$> gitRepo) $ 		error "You cannot run this subcommand in a bare repository." 	a @@ -106,11 +95,11 @@    user's parameters, and prepare actions operating on them. -} withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek withFilesInGit a params = do-	repo <- Annex.gitRepo+	repo <- gitRepo 	runFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek withAttrFilesInGit attr a params = do-	repo <- Annex.gitRepo+	repo <- gitRepo 	files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params 	runFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek@@ -119,7 +108,7 @@ 		go (file, v) = a file (readMaybe v) withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek withBackendFilesInGit a params = do-	repo <- Annex.gitRepo+	repo <- gitRepo 	files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params 	backendPairs a files withFilesMissing :: (String -> CommandStart) -> CommandSeek@@ -128,7 +117,7 @@ 		missing = liftM not . doesFileExist withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek withFilesNotInGit a params = do-	repo <- Annex.gitRepo+	repo <- gitRepo 	force <- Annex.getState Annex.force 	newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params 	backendPairs a newfiles@@ -138,7 +127,7 @@ withStrings a params = return $ map a params withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek withFilesToBeCommitted a params = do-	repo <- Annex.gitRepo+	repo <- gitRepo 	runFiltered a $ 		liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek@@ -148,7 +137,7 @@ withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek withFilesUnlocked' typechanged a params = do 	-- unlocked files have changed type from a symlink to a regular file-	repo <- Annex.gitRepo+	repo <- gitRepo 	typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params 	unlockedfiles <- liftIO $ filterM notSymlink $ 		map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles@@ -200,6 +189,8 @@ paramGlob = "GLOB" paramName :: String paramName = "NAME"+paramUUID :: String+paramUUID = "UUID" paramType :: String paramType = "TYPE" paramKeyValue :: String
Command/Add.hs view
@@ -7,26 +7,15 @@  module Command.Add where -import Control.Monad.State (liftIO)-import Control.Monad (when)-import System.Posix.Files-import System.Directory-import Control.Exception.Control (handle)-import Control.Exception.Base (throwIO)-import Control.Exception.Extensible (IOException)-+import Common.Annex+import Annex.Exception import Command import qualified Annex-import qualified AnnexQueue+import qualified Annex.Queue import qualified Backend import LocationLog-import Types-import Content-import Messages-import Utility.Conditional+import Annex.Content import Utility.Touch-import Utility.SafeCommand-import Locations import Backend  command :: [Command]@@ -67,12 +56,12 @@ 	logStatus key InfoMissing 	rethrow 	where-		rethrow = liftIO $ throwIO e+		rethrow = throw e  		-- fromAnnex could fail if the file ownership is weird 		tryharder :: IOException -> Annex () 		tryharder _ = do-			g <- Annex.gitRepo+			g <- gitRepo 			liftIO $ renameFile (gitAnnexLocation g key) file  cleanup :: FilePath -> Key -> Bool -> CommandCleanup@@ -92,6 +81,6 @@  	force <- Annex.getState Annex.force 	if force-		then AnnexQueue.add "add" [Param "-f", Param "--"] [file]-		else AnnexQueue.add "add" [Param "--"] [file]+		then Annex.Queue.add "add" [Param "-f", Param "--"] [file]+		else Annex.Queue.add "add" [Param "--"] [file] 	return True
Command/AddUrl.hs view
@@ -7,12 +7,9 @@  module Command.AddUrl where -import Control.Monad.State import Network.URI-import Data.String.Utils-import Data.Maybe-import System.Directory +import Common.Annex import Command import qualified Backend import qualified Utility.Url as Url@@ -20,12 +17,8 @@ import qualified Command.Add import qualified Annex import qualified Backend.URL-import Messages-import Content+import Annex.Content import PresenceLog-import Locations-import Utility.Path-import Utility.Conditional  command :: [Command] command = [repoCommand "addurl" (paramRepeating paramUrl) seek@@ -51,7 +44,7 @@  download :: String -> FilePath -> CommandPerform download url file = do-	g <- Annex.gitRepo+	g <- gitRepo 	showAction $ "downloading " ++ url ++ " " 	let dummykey = Backend.URL.fromUrl url 	let tmp = gitAnnexTmpLocation g dummykey
Command/ConfigList.hs view
@@ -7,9 +7,7 @@  module Command.ConfigList where -import Control.Monad.State (liftIO)--import Annex+import Common.Annex import Command import UUID @@ -22,7 +20,6 @@  start :: CommandStart start = do-	g <- Annex.gitRepo-	u <- getUUID g+	u <- getUUID 	liftIO $ putStrLn $ "annex.uuid=" ++ u 	stop
Command/Describe.hs view
@@ -7,10 +7,10 @@  module Command.Describe where +import Common.Annex import Command import qualified Remote import UUID-import Messages  command :: [Command] command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek
Command/Drop.hs view
@@ -7,14 +7,12 @@  module Command.Drop where +import Common.Annex import Command import qualified Remote import qualified Annex import LocationLog-import Types-import Content-import Messages-import Utility.Conditional+import Annex.Content import Trust import Config @@ -71,9 +69,9 @@ 			| length have >= need = return True 			| otherwise = do 				let u = Remote.uuid r-				let dup = u `elem` have+				let duplicate = u `elem` have 				haskey <- Remote.hasKey r key-				case (dup, haskey) of+				case (duplicate, haskey) of 					(False, Right True)	-> findcopies need (u:have) rs bad 					(False, Left _)		-> findcopies need have rs (r:bad) 					_			-> findcopies need have rs bad
Command/DropKey.hs view
@@ -7,12 +7,11 @@  module Command.DropKey where +import Common.Annex import Command import qualified Annex import LocationLog-import Types-import Content-import Messages+import Annex.Content  command :: [Command] command = [repoCommand "dropkey" (paramRepeating paramKey) seek
Command/DropUnused.hs view
@@ -7,22 +7,16 @@  module Command.DropUnused where -import Control.Monad.State (liftIO) import qualified Data.Map as M-import System.Directory-import Data.Maybe +import Common.Annex import Command-import Types-import Messages-import Locations import qualified Annex import qualified Command.Drop import qualified Command.Move import qualified Remote import qualified Git import Types.Key-import Utility.Conditional  type UnusedMap = M.Map String Key @@ -67,14 +61,14 @@  performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform performOther filespec key = do-	g <- Annex.gitRepo+	g <- gitRepo 	let f = filespec g key 	liftIO $ whenM (doesFileExist f) $ removeFile f 	next $ return True  readUnusedLog :: FilePath -> Annex UnusedMap readUnusedLog prefix = do-	g <- Annex.gitRepo+	g <- gitRepo 	let f = gitAnnexUnusedLog prefix g 	e <- liftIO $ doesFileExist f 	if e
Command/Find.hs view
@@ -7,11 +7,9 @@  module Command.Find where -import Control.Monad.State-+import Common.Annex import Command-import Content-import Utility.Conditional+import Annex.Content import Limit  command :: [Command]
Command/Fix.hs view
@@ -7,16 +7,10 @@  module Command.Fix where -import Control.Monad.State (liftIO)-import System.Posix.Files-import System.Directory-+import Common.Annex import Command-import qualified AnnexQueue-import Utility.Path-import Utility.SafeCommand-import Content-import Messages+import qualified Annex.Queue+import Annex.Content  command :: [Command] command = [repoCommand "fix" paramPaths seek@@ -45,5 +39,5 @@  cleanup :: FilePath -> CommandCleanup cleanup file = do-	AnnexQueue.add "add" [Param "--"] [file]+	Annex.Queue.add "add" [Param "--"] [file] 	return True
Command/FromKey.hs view
@@ -7,18 +7,11 @@  module Command.FromKey where -import Control.Monad.State (liftIO)-import System.Posix.Files-import System.Directory-import Control.Monad (unless)-+import Common.Annex import Command-import qualified AnnexQueue-import Utility.SafeCommand-import Content-import Messages+import qualified Annex.Queue+import Annex.Content import Types.Key-import Utility.Path  command :: [Command] command = [repoCommand "fromkey" paramPath seek@@ -46,5 +39,5 @@  cleanup :: FilePath -> CommandCleanup cleanup file = do-	AnnexQueue.add "add" [Param "--"] [file]+	Annex.Queue.add "add" [Param "--"] [file] 	return True
Command/Fsck.hs view
@@ -7,25 +7,16 @@  module Command.Fsck where -import Control.Monad (when)-import Control.Monad.State (liftIO)-import System.Directory-import System.Posix.Files-+import Common.Annex import Command-import qualified Annex import qualified Remote import qualified Types.Backend import qualified Types.Key import UUID-import Types-import Messages-import Content+import Annex.Content import LocationLog-import Locations import Trust import Utility.DataUnits-import Utility.Path import Utility.FileMode import Config @@ -54,7 +45,7 @@    in this repository only. -} verifyLocationLog :: Key -> FilePath -> Annex Bool verifyLocationLog key file = do-	g <- Annex.gitRepo+	g <- gitRepo 	present <- inAnnex key 	 	-- Since we're checking that a key's file is present, throw@@ -64,7 +55,7 @@ 		preventWrite f 		preventWrite (parentDir f) -	u <- getUUID g+	u <- getUUID         uuids <- keyLocations key  	case (present, u `elem` uuids) of@@ -98,7 +89,7 @@  - the key's metadata, if available. -} checkKeySize :: Key -> Annex Bool checkKeySize key = do-	g <- Annex.gitRepo+	g <- gitRepo 	let file = gitAnnexLocation g key 	present <- liftIO $ doesFileExist file 	case (present, Types.Key.keySize key) of
Command/Get.hs view
@@ -7,12 +7,11 @@  module Command.Get where +import Common.Annex import Command import qualified Annex import qualified Remote-import Types-import Content-import Messages+import Annex.Content import qualified Command.Move  command :: [Command]
Command/InAnnex.hs view
@@ -7,12 +7,9 @@  module Command.InAnnex where -import Control.Monad.State (liftIO)-import System.Exit-+import Common.Annex import Command-import Content-import Types+import Annex.Content  command :: [Command] command = [repoCommand "inannex" (paramRepeating paramKey) seek
Command/Init.hs view
@@ -7,10 +7,9 @@  module Command.Init where +import Common.Annex import Command-import qualified Annex import UUID-import Messages import Init 	 command :: [Command]@@ -30,7 +29,6 @@ perform :: String -> CommandPerform perform description = do 	initialize-	g <- Annex.gitRepo-	u <- getUUID g+	u <- getUUID 	describeUUID u description 	next $ return True
Command/InitRemote.hs view
@@ -8,18 +8,13 @@ module Command.InitRemote where  import qualified Data.Map as M-import Control.Monad (when)-import Control.Monad.State (liftIO)-import Data.Maybe-import Data.String.Utils +import Common.Annex import Command import qualified Remote import qualified RemoteLog import qualified Types.Remote as R-import Types import UUID-import Messages  command :: [Command] command = [repoCommand "initremote"
Command/Lock.hs view
@@ -7,13 +7,9 @@  module Command.Lock where -import Control.Monad.State (liftIO)-import System.Directory-+import Common.Annex import Command-import Messages-import qualified AnnexQueue-import Utility.SafeCommand+import qualified Annex.Queue import Backend 	 command :: [Command]@@ -34,5 +30,5 @@ 	-- Checkout from HEAD to get rid of any changes that might be  	-- staged in the index, and get back to the previous symlink to 	-- the content.-	AnnexQueue.add "checkout" [Param "HEAD", Param "--"] [file]+	Annex.Queue.add "checkout" [Param "HEAD", Param "--"] [file] 	next $ return True -- no cleanup needed
Command/Map.hs view
@@ -7,19 +7,12 @@  module Command.Map where -import Control.Monad.State (liftIO) import Control.Exception.Extensible-import System.Cmd.Utils import qualified Data.Map as M-import Data.List.Utils-import Data.Maybe +import Common.Annex import Command-import qualified Annex import qualified Git-import Messages-import Types-import Utility.SafeCommand import UUID import Trust import Utility.Ssh@@ -36,7 +29,7 @@  start :: CommandStart start = do-	g <- Annex.gitRepo+	g <- gitRepo 	rs <- spider g  	umap <- uuidMap
Command/Merge.hs view
@@ -7,9 +7,9 @@  module Command.Merge where +import Common.Annex import Command-import qualified Branch-import Messages+import qualified Annex.Branch  command :: [Command] command = [repoCommand "merge" paramNothing seek@@ -25,5 +25,5 @@  perform :: CommandPerform perform = do-	Branch.update+	Annex.Branch.update 	next $ return True
Command/Migrate.hs view
@@ -7,22 +7,11 @@  module Command.Migrate where -import Control.Monad.State (liftIO)-import Control.Applicative-import System.Posix.Files-import System.Directory-import System.FilePath-import Data.Maybe-+import Common.Annex import Command-import qualified Annex import qualified Backend import qualified Types.Key-import Locations-import Types-import Content-import Messages-import Utility.Conditional+import Annex.Content import qualified Command.Add import Backend @@ -53,7 +42,7 @@  perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform file oldkey newbackend = do-	g <- Annex.gitRepo+	g <- gitRepo  	-- Store the old backend's cached key in the new backend 	-- (the file can't be stored as usual, because it's already a symlink).
Command/Move.hs view
@@ -7,18 +7,14 @@  module Command.Move where -import Control.Monad (when)-+import Common.Annex import Command import qualified Command.Drop import qualified Annex import LocationLog-import Types-import Content+import Annex.Content import qualified Remote import UUID-import Messages-import Utility.Conditional  command :: [Command] command = [repoCommand "move" paramPaths seek@@ -60,7 +56,7 @@ remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex () remoteHasKey remote key present	= do 	let remoteuuid = Remote.uuid remote-	g <- Annex.gitRepo+	g <- gitRepo 	logChange g key remoteuuid status 	where 		status = if present then InfoPresent else InfoMissing@@ -76,8 +72,7 @@  -} toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart toStart dest move file = isAnnexed file $ \(key, _) -> do-	g <- Annex.gitRepo-	u <- getUUID g+	u <- getUUID 	ishere <- inAnnex key 	if not ishere || u == Remote.uuid dest 		then stop -- not here, so nothing to do@@ -126,8 +121,7 @@  -} fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart fromStart src move file = isAnnexed file $ \(key, _) -> do-	g <- Annex.gitRepo-	u <- getUUID g+	u <- getUUID 	remotes <- Remote.keyPossibilities key 	if u == Remote.uuid src || not (any (== src) remotes) 		then stop
Command/RecvKey.hs view
@@ -7,15 +7,11 @@  module Command.RecvKey where -import Control.Monad.State (liftIO)-import System.Exit-+import Common.Annex import Command import CmdLine-import Content+import Annex.Content import Utility.RsyncFile-import Utility.Conditional-import Types  command :: [Command] command = [repoCommand "recvkey" paramKey seek
Command/Semitrust.hs view
@@ -7,11 +7,11 @@  module Command.Semitrust where +import Common.Annex import Command import qualified Remote import UUID import Trust-import Messages  command :: [Command] command = [repoCommand "semitrust" (paramRepeating paramRemote) seek
Command/SendKey.hs view
@@ -7,17 +7,10 @@  module Command.SendKey where -import Control.Monad.State (liftIO)-import System.Exit--import Locations-import qualified Annex+import Common.Annex import Command-import Content+import Annex.Content import Utility.RsyncFile-import Utility.Conditional-import Messages-import Types  command :: [Command] command = [repoCommand "sendkey" paramKey seek@@ -28,7 +21,7 @@  start :: Key -> CommandStart start key = do-	g <- Annex.gitRepo+	g <- gitRepo 	let file = gitAnnexLocation g key 	whenM (inAnnex key) $ 		liftIO $ rsyncServerSend file -- does not return
Command/SetKey.hs view
@@ -7,13 +7,10 @@  module Command.SetKey where -import Control.Monad.State (liftIO)-+import Common.Annex import Command-import Utility.SafeCommand import LocationLog-import Content-import Messages+import Annex.Content  command :: [Command] command = [repoCommand "setkey" paramPath seek
Command/Status.hs view
@@ -8,26 +8,23 @@ module Command.Status where  import Control.Monad.State-import Control.Applicative-import Data.Maybe-import System.IO-import Data.List import qualified Data.Map as M import qualified Data.Set as S import Data.Set (Set) +import Common.Annex import qualified Types.Backend as B import qualified Types.Remote as R import qualified Remote import qualified Command.Unused import qualified Git import Command-import Types import Utility.DataUnits-import Content+import Annex.Content import Types.Key-import Locations import Backend+import UUID+import Remote  -- a named computation that produces a statistic type Stat = StatState (Maybe (String, StatState String))@@ -55,6 +52,7 @@ stats =  	[ supported_backends 	, supported_remote_types+	, remote_list 	, tmp_size 	, bad_data_size 	, local_annex_keys@@ -92,6 +90,11 @@ supported_remote_types = stat "supported remote types" $ 	return $ unwords $ map R.typename Remote.remoteTypes +remote_list :: Stat+remote_list = stat "known repositories" $ lift $ do+	s <- prettyPrintUUIDs "repos" =<< M.keys <$> uuidMap+	return $ '\n':init s+ local_annex_size :: Stat local_annex_size = stat "local annex size" $ 	keySizeSum <$> cachedKeysPresent@@ -117,7 +120,7 @@ backend_usage :: Stat backend_usage = stat "backend usage" $ usage <$> cachedKeysReferenced 	where-		usage ks = pp "" $ sort $ map swap $ splits $ S.toList ks+		usage ks = pp "" $ reverse . sort $ map swap $ splits $ S.toList ks 		splits :: [Key] -> [(String, Integer)] 		splits ks = M.toList $ M.fromListWith (+) $ map tcount ks 		tcount k = (keyBackendName k, 1)@@ -154,8 +157,8 @@ 		missingnote 			| missing == 0 = "" 			| otherwise = aside $-				"but " ++ show missing ++-				" keys have unknown size"+				"+ " ++ show missing +++				" keys of unknown size"  staleSize :: String -> (Git.Repo -> FilePath) -> Stat staleSize label dirspec = do@@ -167,4 +170,4 @@ 			return $ s ++ aside "clean up with git-annex unused"  aside :: String -> String-aside s = "\t(" ++ s ++ ")"+aside s = " (" ++ s ++ ")"
Command/Trust.hs view
@@ -7,11 +7,11 @@  module Command.Trust where +import Common.Annex import Command import qualified Remote import Trust import UUID-import Messages  command :: [Command] command = [repoCommand "trust" (paramRepeating paramRemote) seek
Command/Unannex.hs view
@@ -7,25 +7,16 @@  module Command.Unannex where -import Control.Monad.State (liftIO)-import Control.Monad (unless)-import System.Directory-import System.Posix.Files-+import Common.Annex import Command import qualified Command.Drop import qualified Annex-import qualified AnnexQueue-import Utility.SafeCommand-import Utility.Path+import qualified Annex.Queue import Utility.FileMode import LocationLog-import Types-import Content+import Annex.Content import qualified Git import qualified Git.LsFiles as LsFiles-import Messages-import Locations  command :: [Command] command = [repoCommand "unannex" paramPaths seek "undo accidential add command"]@@ -41,7 +32,7 @@ 		then do 			force <- Annex.getState Annex.force 			unless force $ do-				g <- Annex.gitRepo+				g <- gitRepo 				staged <- liftIO $ LsFiles.staged g [Git.workTree g] 				unless (null staged) $ 					error "This command cannot be run when there are already files staged for commit."@@ -60,7 +51,7 @@  cleanup :: FilePath -> Key -> CommandCleanup cleanup file key = do-	g <- Annex.gitRepo+	g <- gitRepo  	liftIO $ removeFile file 	liftIO $ Git.run g "rm" [Params "--quiet --", File file]@@ -80,6 +71,6 @@ 	-- Commit staged changes at end to avoid confusing the 	-- pre-commit hook if this file is later added back to 	-- git as a normal, non-annexed file.-	AnnexQueue.add "commit" [Param "-m", Param "content removed from git annex"] []+	Annex.Queue.add "commit" [Param "-m", Param "content removed from git annex"] [] 	 	return True
Command/Uninit.hs view
@@ -7,19 +7,14 @@  module Command.Uninit where -import Control.Monad.State (liftIO)-import System.Directory-import System.Exit-+import Common.Annex import Command-import Utility.SafeCommand import qualified Git import qualified Annex import qualified Command.Unannex import Init-import qualified Branch-import Content-import Locations+import qualified Annex.Branch+import Annex.Content  command :: [Command] command = [repoCommand "uninit" paramPaths seek @@ -44,12 +39,12 @@  cleanup :: CommandCleanup cleanup = do-	g <- Annex.gitRepo+	g <- gitRepo 	uninitialize 	mapM_ removeAnnex =<< getKeysPresent 	liftIO $ removeDirectoryRecursive (gitAnnexDir g) 	-- avoid normal shutdown 	saveState 	liftIO $ do-		Git.run g "branch" [Param "-D", Param Branch.name]+		Git.run g "branch" [Param "-D", Param Annex.Branch.name] 		exitSuccess
Command/Unlock.hs view
@@ -7,18 +7,10 @@  module Command.Unlock where -import Control.Monad.State (liftIO)-import System.Directory hiding (copyFile)-+import Common.Annex import Command-import qualified Annex-import Types-import Messages-import Locations-import Content-import Utility.Conditional+import Annex.Content import Utility.CopyFile-import Utility.Path import Utility.FileMode  command :: [Command]@@ -43,12 +35,12 @@ 	 	checkDiskSpace key -	g <- Annex.gitRepo+	g <- gitRepo 	let src = gitAnnexLocation g key 	let tmpdest = gitAnnexTmpLocation g key 	liftIO $ createDirectoryIfMissing True (parentDir tmpdest) 	showAction "copying"-	ok <- liftIO $ copyFile src tmpdest+	ok <- liftIO $ copyFileExternal src tmpdest         if ok                 then do 			liftIO $ do
Command/Untrust.hs view
@@ -7,11 +7,11 @@  module Command.Untrust where +import Common.Annex import Command import qualified Remote import UUID import Trust-import Messages  command :: [Command] command = [repoCommand "untrust" (paramRepeating paramRemote) seek
Command/Unused.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010 Joey Hess <joey@kitenet.net>+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -9,22 +9,13 @@  module Command.Unused where -import Control.Monad (filterM, unless, forM_)-import Control.Monad.State (liftIO) import qualified Data.Set as S-import Data.Maybe-import System.FilePath-import System.Directory-import Data.List+import qualified Data.ByteString.Lazy.Char8 as L +import Common.Annex import Command-import Types-import Content-import Messages-import Locations-import Utility+import Annex.Content import Utility.FileMode-import Utility.SafeCommand import LocationLog import qualified Annex import qualified Git@@ -32,8 +23,8 @@ import qualified Git.LsTree as LsTree import qualified Backend import qualified Remote-import qualified Branch-import CatFile+import qualified Annex.Branch+import Annex.CatFile  command :: [Command] command = [repoCommand "unused" paramNothing seek@@ -91,7 +82,7 @@  writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex () writeUnusedFile prefix l = do-	g <- Annex.gitRepo+	g <- gitRepo 	liftIO $ viaTmp writeFile (gitAnnexUnusedLog prefix g) $ 		unlines $ map (\(n, k) -> show n ++ " " ++ show k) l @@ -163,30 +154,26 @@ excludeReferenced :: [Key] -> Annex [Key] excludeReferenced [] = return [] -- optimisation excludeReferenced l = do-	g <- Annex.gitRepo+	g <- gitRepo 	c <- liftIO $ Git.pipeRead g [Param "show-ref"]-	excludeReferenced'-		(getKeysReferenced : (map getKeysReferencedInGit $ refs c))+	removewith (getKeysReferenced : map getKeysReferencedInGit (refs c)) 		(S.fromList l) 	where 		-- Skip the git-annex branches, and get all other unique refs. 		refs = map last . 			nubBy cmpheads . 			filter ourbranches .-			map words . lines+			map words . lines . L.unpack 		cmpheads a b = head a == head b-		ourbranchend = "/" ++ Branch.name+		ourbranchend = '/' : Annex.Branch.name 		ourbranches ws = not $ ourbranchend `isSuffixOf` last ws-excludeReferenced' :: ([Annex [Key]]) -> S.Set Key -> Annex [Key]-excludeReferenced' [] s = return $ S.toList s-excludeReferenced' (a:as) s-	| s == S.empty = return [] -- optimisation-	| otherwise = do-		referenced <- a-		let !s' = remove referenced-		excludeReferenced' as s'-	where-		remove l = s `S.difference` S.fromList l+		removewith [] s = return $ S.toList s+		removewith (a:as) s+			| s == S.empty = return [] -- optimisation+			| otherwise = do+				referenced <- a+				let !s' = s `S.difference` S.fromList referenced+				removewith as s'  {- Finds items in the first, smaller list, that are not  - present in the second, larger list.@@ -203,7 +190,7 @@ {- List of keys referenced by symlinks in the git repo. -} getKeysReferenced :: Annex [Key] getKeysReferenced = do-	g <- Annex.gitRepo+	g <- gitRepo 	files <- liftIO $ LsFiles.inRepo g [Git.workTree g] 	keypairs <- mapM Backend.lookupFile files 	return $ map fst $ catMaybes keypairs@@ -212,18 +199,17 @@ getKeysReferencedInGit :: String -> Annex [Key] getKeysReferencedInGit ref = do 	showAction $ "checking " ++ Git.refDescribe ref-	g <- Annex.gitRepo+	g <- gitRepo 	findkeys [] =<< liftIO (LsTree.lsTree g ref) 	where 		findkeys c [] = return c-		findkeys c (l:ls) = do-			if isSymLink (LsTree.mode l)-				then do-					content <- catFile ref $ LsTree.file l-					case fileKey (takeFileName content) of-						Nothing -> findkeys c ls-						Just k -> findkeys (k:c) ls-				else findkeys c ls+		findkeys c (l:ls)+			| isSymLink (LsTree.mode l) = do+				content <- catFile ref $ LsTree.file l+				case fileKey (takeFileName content) of+					Nothing -> findkeys c ls+					Just k -> findkeys (k:c) ls+			| otherwise = findkeys c ls  {- Looks in the specified directory for bad/tmp keys, and returns a list  - of those that might still have value, or might be stale and removable. @@ -236,17 +222,17 @@ 	contents <- staleKeys dirspec 	 	let stale = contents `exclude` present-	let dup = contents `exclude` stale+	let dups = contents `exclude` stale -	g <- Annex.gitRepo+	g <- gitRepo 	let dir = dirspec g-	liftIO $ forM_ dup $ \t -> removeFile $ dir </> keyFile t+	liftIO $ forM_ dups $ \t -> removeFile $ dir </> keyFile t  	return stale  staleKeys :: (Git.Repo -> FilePath) -> Annex [Key] staleKeys dirspec = do-	g <- Annex.gitRepo+	g <- gitRepo 	let dir = dirspec g 	exists <- liftIO $ doesDirectoryExist dir 	if not exists
Command/Upgrade.hs view
@@ -7,10 +7,10 @@  module Command.Upgrade where +import Common.Annex import Command import Upgrade-import Version-import Messages+import Annex.Version  command :: [Command] command = [standaloneCommand "upgrade" paramNothing seek
Command/Version.hs view
@@ -7,13 +7,10 @@  module Command.Version where -import Control.Monad.State (liftIO)-import Data.String.Utils-import Data.Maybe-+import Common.Annex import Command import qualified Build.SysConfig as SysConfig-import Version+import Annex.Version  command :: [Command] command = [standaloneCommand "version" paramNothing seek "show version info"]
Command/Whereis.hs view
@@ -7,13 +7,10 @@  module Command.Whereis where -import Control.Monad-+import Common.Annex import LocationLog import Command-import Messages import Remote-import Types import Trust  command :: [Command]
+ Common.hs view
@@ -0,0 +1,46 @@+module Common (+	module Control.Monad,+	module Control.Applicative,+	module Control.Monad.State,+	module Control.Exception.Extensible,+	module Data.Maybe,+	module Data.List,+	module Data.String.Utils,+	module System.Path,+	module System.FilePath,+	module System.Directory,+	module System.Cmd.Utils,+	module System.IO,+	module System.Posix.Files,+	module System.Posix.IO,+	module System.Posix.Process,+	module System.Exit,+	module Utility,+	module Utility.Conditional,+	module Utility.SafeCommand,+	module Utility.Path,+) where++import Control.Monad hiding (join)+import Control.Applicative+import Control.Monad.State (liftIO)+import Control.Exception.Extensible (IOException)++import Data.Maybe+import Data.List+import Data.String.Utils++import System.Path+import System.FilePath+import System.Directory+import System.Cmd.Utils+import System.IO hiding (FilePath)+import System.Posix.Files+import System.Posix.IO+import System.Posix.Process hiding (executeFile)+import System.Exit++import Utility+import Utility.Conditional+import Utility.SafeCommand+import Utility.Path
+ Common/Annex.hs view
@@ -0,0 +1,13 @@+module Common.Annex (+	module Common,+	module Types,+	module Annex,+	module Locations,+	module Messages,+) where++import Common+import Types+import Annex (gitRepo)+import Locations+import Messages
Config.hs view
@@ -7,23 +7,16 @@  module Config where -import Data.Maybe-import Control.Monad.State (liftIO)-import Control.Applicative-import System.Cmd.Utils-+import Common.Annex import qualified Git import qualified Annex-import Types-import Utility-import Utility.SafeCommand  type ConfigKey = String  {- Changes a git config setting in both internal state and .git/config -} setConfig :: ConfigKey -> String -> Annex () setConfig k value = do-	g <- Annex.gitRepo+	g <- gitRepo 	liftIO $ Git.run g "config" [Param k, Param value] 	-- re-read git config and update the repo's state 	g' <- liftIO $ Git.configRead g@@ -33,7 +26,7 @@  - Failing that, tries looking for a global config option. -} getConfig :: Git.Repo -> ConfigKey -> String -> Annex String getConfig r key def = do-	g <- Annex.gitRepo+	g <- gitRepo 	let def' = Git.configGet g ("annex." ++ key) def 	return $ Git.configGet g (remoteConfig r key) def' @@ -95,7 +88,7 @@ 	where 		use (Just n) = return n 		use Nothing = do-			g <- Annex.gitRepo+			g <- gitRepo 			return $ read $ Git.configGet g config "1" 		config = "annex.numcopies" 
− Content.hs
@@ -1,249 +0,0 @@-{- git-annex file content managing- -- - Copyright 2010 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module Content (-	inAnnex,-	calcGitLink,-	logStatus,-	getViaTmp,-	getViaTmpUnchecked,-	withTmp,-	checkDiskSpace,-	moveAnnex,-	removeAnnex,-	fromAnnex,-	moveBad,-	getKeysPresent,-	saveState-) where--import System.Directory-import Control.Monad.State (liftIO)-import System.Path-import Control.Monad-import System.Posix.Files-import System.FilePath-import Data.Maybe--import Types-import Locations-import LocationLog-import UUID-import qualified Git-import qualified Annex-import qualified AnnexQueue-import qualified Branch-import Utility-import Utility.Conditional-import Utility.StatFS-import Utility.Path-import Utility.FileMode-import Types.Key-import Utility.DataUnits-import Config--{- Checks if a given key is currently present in the gitAnnexLocation. -}-inAnnex :: Key -> Annex Bool-inAnnex key = do-	g <- Annex.gitRepo-	when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"-	liftIO $ doesFileExist $ gitAnnexLocation g key--{- Calculates the relative path to use to link a file to a key. -}-calcGitLink :: FilePath -> Key -> Annex FilePath-calcGitLink file key = do-	g <- Annex.gitRepo-	cwd <- liftIO getCurrentDirectory-	let absfile = fromMaybe whoops $ absNormPath cwd file-	return $ relPathDirToFile (parentDir absfile) -			(Git.workTree g) </> ".git" </> annexLocation key-	where-		whoops = error $ "unable to normalize " ++ file--{- Updates the LocationLog when a key's presence changes in the current- - repository. -}-logStatus :: Key -> LogStatus -> Annex ()-logStatus key status = do-	g <- Annex.gitRepo-	u <- getUUID g-	logChange g key u status--{- Runs an action, passing it a temporary filename to download,- - and if the action succeeds, moves the temp file into - - the annex as a key's content. -}-getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool-getViaTmp key action = do-	g <- Annex.gitRepo-	let tmp = gitAnnexTmpLocation g key--	-- Check that there is enough free disk space.-	-- When the temp file already exists, count the space-	-- it is using as free.-	e <- liftIO $ doesFileExist tmp-	if e-		then do-			stat <- liftIO $ getFileStatus tmp-			checkDiskSpace' (fromIntegral $ fileSize stat) key-		else checkDiskSpace key--	when e $ liftIO $ allowWrite tmp--	getViaTmpUnchecked key action--prepTmp :: Key -> Annex FilePath-prepTmp key = do-	g <- Annex.gitRepo-	let tmp = gitAnnexTmpLocation g key-	liftIO $ createDirectoryIfMissing True (parentDir tmp)-	return tmp--{- Like getViaTmp, but does not check that there is enough disk space- - for the incoming key. For use when the key content is already on disk- - and not being copied into place. -}-getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool-getViaTmpUnchecked key action = do-	tmp <- prepTmp key-	success <- action tmp-	if success-		then do-			moveAnnex key tmp-			logStatus key InfoPresent-			return True-		else do-			-- the tmp file is left behind, in case caller wants-			-- to resume its transfer-			return False--{- Creates a temp file, runs an action on it, and cleans up the temp file. -}-withTmp :: Key -> (FilePath -> Annex a) -> Annex a-withTmp key action = do-	tmp <- prepTmp key-	res <- action tmp-	liftIO $ whenM (doesFileExist tmp) $ liftIO $ removeFile tmp-	return res--{- Checks that there is disk space available to store a given key,- - throwing an error if not. -}-checkDiskSpace :: Key -> Annex ()-checkDiskSpace = checkDiskSpace' 0--checkDiskSpace' :: Integer -> Key -> Annex ()-checkDiskSpace' adjustment key = do-	g <- Annex.gitRepo-	r <- getConfig g "diskreserve" ""-	let reserve = fromMaybe megabyte $ readSize dataUnits r-	stats <- liftIO $ getFileSystemStats (gitAnnexDir g)-	case (stats, keySize key) of-		(Nothing, _) -> return ()-		(_, Nothing) -> return ()-		(Just (FileSystemStats { fsStatBytesAvailable = have }), Just need) ->-			when (need + reserve > have + adjustment) $-				needmorespace (need + reserve - have - adjustment)-	where-		megabyte :: Integer-		megabyte = 1000000-		needmorespace n = unlessM (Annex.getState Annex.force) $-			error $ "not enough free space, need " ++ -				roughSize storageUnits True n ++-				" more (use --force to override this check or adjust annex.diskreserve)"--{- Moves a file into .git/annex/objects/- -- - What if the key there already has content? This could happen for- - various reasons; perhaps the same content is being annexed again.- - Perhaps there has been a hash collision generating the keys.- -- - The current strategy is to assume that in this case it's safe to delete- - one of the two copies of the content; and the one already in the annex- - is left there, assuming it's the original, canonical copy.- -- - I considered being more paranoid, and checking that both files had- - the same content. Decided against it because A) users explicitly choose- - a backend based on its hashing properties and so if they're dealing- - with colliding files it's their own fault and B) adding such a check- - would not catch all cases of colliding keys. For example, perhaps - - a remote has a key; if it's then added again with different content then- - the overall system now has two different peices of content for that- - key, and one of them will probably get deleted later. So, adding the- - check here would only raise expectations that git-annex cannot truely- - meet.- -}-moveAnnex :: Key -> FilePath -> Annex ()-moveAnnex key src = do-	g <- Annex.gitRepo-	let dest = gitAnnexLocation g key-	let dir = parentDir dest-	e <- liftIO $ doesFileExist dest-	if e-		then liftIO $ removeFile src-		else liftIO $ do-			createDirectoryIfMissing True dir-			allowWrite dir -- in case the directory already exists-			renameFile src dest-			preventWrite dest-			preventWrite dir--withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a-withObjectLoc key a = do-	g <- Annex.gitRepo-	let file = gitAnnexLocation g key-	let dir = parentDir file-	a (dir, file)--{- Removes a key's file from .git/annex/objects/ -}-removeAnnex :: Key -> Annex ()-removeAnnex key = withObjectLoc key $ \(dir, file) -> liftIO $ do-	allowWrite dir-	removeFile file-	removeDirectory dir--{- Moves a key's file out of .git/annex/objects/ -}-fromAnnex :: Key -> FilePath -> Annex ()-fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do-	allowWrite dir-	allowWrite file-	renameFile file dest-	removeDirectory dir--{- Moves a key out of .git/annex/objects/ into .git/annex/bad, and- - returns the file it was moved to. -}-moveBad :: Key -> Annex FilePath-moveBad key = do-	g <- Annex.gitRepo-	let src = gitAnnexLocation g key-	let dest = gitAnnexBadDir g </> takeFileName src-	liftIO $ do-		createDirectoryIfMissing True (parentDir dest)-		allowWrite (parentDir src)-		renameFile src dest-		removeDirectory (parentDir src)-	logStatus key InfoMissing-	return dest--{- List of keys whose content exists in .git/annex/objects/ -}-getKeysPresent :: Annex [Key]-getKeysPresent = do-	g <- Annex.gitRepo-	getKeysPresent' $ gitAnnexObjectDir g-getKeysPresent' :: FilePath -> Annex [Key]-getKeysPresent' dir = do-	exists <- liftIO $ doesDirectoryExist dir-	if not exists-		then return []-		else liftIO $ do-			-- 2 levels of hashing-			levela <- dirContents dir-			levelb <- mapM dirContents levela-			contents <- mapM dirContents (concat levelb)-			let files = concat contents-			return $ mapMaybe (fileKey . takeFileName) files--{- Things to do to record changes to content. -}-saveState :: Annex ()-saveState = do-	AnnexQueue.flush False-	Branch.commit "update"
Crypto.hs view
@@ -30,26 +30,17 @@ import qualified Data.Map as M import Data.ByteString.Lazy.UTF8 (fromString) import Data.Digest.Pure.SHA-import System.Cmd.Utils-import Data.String.Utils-import Data.List-import Data.Maybe-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 import System.Environment -import Types+import Common.Annex 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@@ -97,9 +88,9 @@ updateCipher c encipher@(EncryptedCipher _ ks) = do 	ks' <- configKeyIds c 	cipher <- decryptCipher c encipher-	encryptCipher cipher (combine ks ks')+	encryptCipher cipher (merge ks ks') 	where-		combine (KeyIds a) (KeyIds b) = KeyIds $ a ++ b+		merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b  describeCipher :: EncryptedCipher -> String describeCipher (EncryptedCipher _ (KeyIds ks)) =@@ -144,13 +135,12 @@ {- Generates an encrypted form of a Key. The encryption does not need to be  - reversable, nor does it need to be the same type of encryption used  - on content. It does need to be repeatable. -}-encryptKey :: Cipher -> Key -> IO Key-encryptKey c k =-	return Key {-		keyName = hmacWithCipher c (show k),-		keyBackendName = "GPGHMACSHA1",-		keySize = Nothing, -- size and mtime omitted-		keyMtime = Nothing -- to avoid leaking data+encryptKey :: Cipher -> Key -> Key+encryptKey c k = Key+	{ keyName = hmacWithCipher c (show k)+	, keyBackendName = "GPGHMACSHA1"+	, keySize = Nothing -- size and mtime omitted+	, keyMtime = Nothing -- to avoid leaking data 	}  {- Runs an action, passing it a handle from which it can @@ -218,7 +208,7 @@  	params' <- gpgParams $ passphrase ++ params 	(pid, fromh, toh) <- hPipeBoth "gpg" params'-	_ <- forkProcess $ do+	pid2 <- forkProcess $ do 		L.hPut toh =<< a 		hClose toh 		exitSuccess@@ -227,22 +217,23 @@  	-- cleanup 	forceSuccess pid+	_ <- getProcessStatus True False pid2 	closeFd frompipe 	return ret  configKeyIds :: RemoteConfig -> IO KeyIds-configKeyIds c = do-	let k = configGet c "encryption"-	s <- gpgRead [Params "--with-colons --list-public-keys", Param k]-	return $ KeyIds $ parseWithColons s+configKeyIds c = parse <$> gpgRead params 	where-		parseWithColons s = map keyIdField $ filter pubKey $ lines s+		params = [Params "--with-colons --list-public-keys",+			Param $ configGet c "encryption"]+		parse = KeyIds . map keyIdField . filter pubKey . lines 		pubKey = isPrefixOf "pub:" 		keyIdField s = split ":" s !! 4  configGet :: RemoteConfig -> String -> String configGet c key = fromMaybe missing $ M.lookup key c-	where missing = error $ "missing " ++ key ++ " in remote config"+	where+		missing = error $ "missing " ++ key ++ " in remote config"  hmacWithCipher :: Cipher -> String -> String hmacWithCipher c = hmacWithCipher' (cipherHmac c) 
Git.hs view
@@ -44,6 +44,7 @@ 	pipeWrite, 	pipeWriteRead, 	pipeNullSplit,+	pipeNullSplitB, 	attributes, 	remotes, 	remotesAdd,@@ -55,41 +56,28 @@ 	repoAbsPath, 	reap, 	useIndex,-	hashObject, 	getSha, 	shaSize, 	commit,+	assertLocal,  	prop_idempotent_deencode ) where -import Control.Monad (unless, when, liftM2)-import Control.Applicative-import System.Directory-import System.FilePath import System.Posix.Directory import System.Posix.User-import System.Posix.Process-import System.Path-import System.Cmd.Utils import IO (bracket_, try)-import Data.String.Utils-import System.IO import qualified Data.Map as M hiding (map, split) import Network.URI-import Data.Maybe import Data.Char import Data.Word (Word8) import Codec.Binary.UTF8.String (encode) import Text.Printf-import Data.List (isInfixOf, isPrefixOf, isSuffixOf) import System.Exit import System.Posix.Env (setEnv, unsetEnv, getEnv)+import qualified Data.ByteString.Lazy.Char8 as L -import Utility-import Utility.Path-import Utility.Conditional-import Utility.SafeCommand+import Common  {- There are two types of repositories; those on local disk and those  - accessed via an URL. -}@@ -379,23 +367,42 @@  - Note that this leaves the git process running, and so zombies will  - result unless reap is called.  -}-pipeRead :: Repo -> [CommandParam] -> IO String+pipeRead :: Repo -> [CommandParam] -> IO L.ByteString pipeRead repo params = assertLocal repo $ do-	(_, s) <- pipeFrom "git" $ toCommand $ gitCommandLine repo params-	return s+	(_, h) <- hPipeFrom "git" $ toCommand $ gitCommandLine repo params+	hSetBinaryMode h True+	L.hGetContents h  {- Runs a git subcommand, feeding it input.  - You should call either getProcessStatus or forceSuccess on the PipeHandle. -}-pipeWrite :: Repo -> [CommandParam] -> String -> IO PipeHandle-pipeWrite repo params s = assertLocal repo $-	pipeTo "git" (toCommand $ gitCommandLine repo params) s+pipeWrite :: Repo -> [CommandParam] -> L.ByteString -> IO PipeHandle+pipeWrite repo params s = assertLocal repo $ do+	(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine repo params)+	L.hPut h s+	hClose h+	return p  {- Runs a git subcommand, feeding it input, and returning its output.  - You should call either getProcessStatus or forceSuccess on the PipeHandle. -}-pipeWriteRead :: Repo -> [CommandParam] -> String -> IO (PipeHandle, String)-pipeWriteRead repo params s = assertLocal repo $-	pipeBoth "git" (toCommand $ gitCommandLine repo params) s+pipeWriteRead :: Repo -> [CommandParam] -> L.ByteString -> IO (PipeHandle, L.ByteString)+pipeWriteRead repo params s = assertLocal repo $ do+	(p, from, to) <- hPipeBoth "git" (toCommand $ gitCommandLine repo params)+	hSetBinaryMode from True+	L.hPut to s+	hClose to+	c <- L.hGetContents from+	return (p, c) +{- Reads null terminated output of a git command (as enabled by the -z + - parameter), and splits it. -}+pipeNullSplit :: Repo -> [CommandParam] -> IO [String]+pipeNullSplit repo params = map L.unpack <$> pipeNullSplitB repo params++{- For when Strings are not needed. -}+pipeNullSplitB :: Repo -> [CommandParam] -> IO [L.ByteString]+pipeNullSplitB repo params = filter (not . L.null) . L.split '\0' <$>+	pipeRead repo params+ {- Reaps any zombie git processes. -} reap :: IO () reap = do@@ -416,18 +423,6 @@ 		reset (Right (Just v)) = setEnv var v True 		reset _ = unsetEnv var -{- Injects some content into git, returning its hash. -}-hashObject :: Repo -> String -> IO String-hashObject repo content = getSha subcmd $ do-	(h, s) <- pipeWriteRead repo (map Param params) content-	length s `seq` do-		forceSuccess h-		reap -- XXX unsure why this is needed-		return s-	where-		subcmd = "hash-object"-		params = [subcmd, "-w", "--stdin"]- {- Runs an action that causes a git subcommand to emit a sha, and strips    any trailing newline, returning the sha. -} getSha :: String -> IO String -> IO String@@ -448,21 +443,18 @@  - with the specified parent refs. -} commit :: Repo -> String -> String -> [String] -> IO () commit g message newref parentrefs = do-	tree <- getSha "write-tree" $+	tree <- getSha "write-tree" $ asString $ 		pipeRead g [Param "write-tree"]-	sha <- getSha "commit-tree" $ ignorehandle $-		pipeWriteRead g (map Param $ ["commit-tree", tree] ++ ps) message+	sha <- getSha "commit-tree" $ asString $+		ignorehandle $ pipeWriteRead g+			(map Param $ ["commit-tree", tree] ++ ps)+			(L.pack message) 	run g "update-ref" [Param newref, Param sha] 	where 		ignorehandle a = snd <$> a+		asString a = L.unpack <$> a 		ps = concatMap (\r -> ["-p", r]) parentrefs -{- Reads null terminated output of a git command (as enabled by the -z - - parameter), and splits it into a list of files/lines/whatever. -}-pipeNullSplit :: Repo -> [CommandParam] -> IO [FilePath]-pipeNullSplit repo params = filter (not . null) . split "\0" <$>-	pipeRead repo params- {- Runs git config and populates a repo with its config. -} configRead :: Repo -> IO Repo configRead repo@(Repo { location = Dir d }) = do@@ -504,15 +496,29 @@ configRemotes :: Repo -> IO [Repo] configRemotes repo = mapM construct remotepairs 	where-		remotepairs = M.toList $ filterremotes $ config repo-		filterremotes = M.filterWithKey (\k _ -> isremote k)+		filterconfig f = filter f $ M.toList $ config repo+		filterkeys f = filterconfig (\(k,_) -> f k)+		remotepairs = filterkeys isremote 		isremote k = startswith "remote." k && endswith ".url" k 		construct (k,v) = do-			r <- gen v+			r <- gen $ calcloc v 			return $ repoRemoteNameSet r k-		gen v	| scpstyle v = repoFromUrl $ scptourl v+		gen v+			| scpstyle v = repoFromUrl $ scptourl v 			| isURI v = repoFromUrl v 			| otherwise = repoFromRemotePath v repo+		-- insteadof config can rewrite remote location+		calcloc l+			| null insteadofs = l+			| otherwise = replacement ++ drop (length replacement) l+			where+				replacement = take (length bestkey - length prefix) bestkey+				bestkey = fst $ maximumBy longestvalue insteadofs+				longestvalue (_, a) (_, b) = compare b a+				insteadofs = filterconfig $ \(k, v) -> +					endswith prefix k &&+					startswith v l+				prefix = ".insteadof" 		-- git remotes can be written scp style -- [user@]host:dir 		scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v) 		scptourl v = "ssh://" ++ host ++ slash dir@@ -541,36 +547,25 @@ {- Efficiently looks up a gitattributes value for each file in a list. -} checkAttr :: Repo -> String -> [FilePath] -> IO [(FilePath, String)] checkAttr repo attr files = do-	-- git check-attr wants files that are absolute (or relative to the-	-- top of the repo). But we're passed files relative to the current-	-- directory. Convert to absolute, and then convert the filenames-	-- in its output back to relative. 	cwd <- getCurrentDirectory-	let top = workTree repo-	let absfiles = map (absPathFrom cwd) files+	let relfiles = map (relPathDirToFile cwd . absPathFrom cwd) files 	(_, fromh, toh) <- hPipeBoth "git" (toCommand params)         _ <- forkProcess $ do 		hClose fromh-                hPutStr toh $ join "\0" absfiles+                hPutStr toh $ join "\0" relfiles                 hClose toh                 exitSuccess         hClose toh-	s <- hGetContents fromh-	return $ map (topair cwd top) $ lines s+	(map topair . lines) <$> hGetContents fromh 	where 		params = gitCommandLine repo [Param "check-attr", Param attr, Params "-z --stdin"]-		topair cwd top l = (relfile, value)+		topair l = (file, value) 			where -				relfile-					| startswith cwd' file = drop (length cwd') file-					| otherwise = relPathDirToFile top' file 				file = decodeGitFile $ join sep $ take end bits 				value = bits !! end 				end = length bits - 1 				bits = split sep l 				sep = ": " ++ attr ++ ": "-				cwd' = cwd ++ "/"-				top' = top ++ "/"  {- Some git commands output encoded filenames. Decode that (annoyingly  - complex) encoding. -}
Git/LsFiles.hs view
@@ -20,13 +20,11 @@  {- Scans for files that are checked into git at the specified locations. -} inRepo :: Repo -> [FilePath] -> IO [FilePath]-inRepo repo l = pipeNullSplit repo $-	Params "ls-files --cached -z --" : map File l+inRepo repo l = pipeNullSplit repo $ Params "ls-files --cached -z --" : map File l  {- Scans for files at the specified locations that are not checked into git. -} notInRepo :: Repo -> Bool -> [FilePath] -> IO [FilePath]-notInRepo repo include_ignored l =-	pipeNullSplit repo $+notInRepo repo include_ignored l = pipeNullSplit repo $ 		[Params "ls-files --others"] ++ exclude ++ 		[Params "-z --"] ++ map File l 	where
Git/LsTree.hs view
@@ -7,13 +7,14 @@  module Git.LsTree ( 	TreeItem(..),-	lsTree+	lsTree,+	parseLsTree ) where  import Numeric import Control.Applicative-import Data.Char import System.Posix.Types+import qualified Data.ByteString.Lazy.Char8 as L  import Git import Utility.SafeCommand@@ -22,7 +23,7 @@  data TreeItem = TreeItem 	{ mode :: FileMode-	, objtype :: String+	, typeobj :: String 	, sha :: String 	, file :: FilePath 	} deriving Show@@ -30,22 +31,22 @@ {- Lists the contents of a Treeish -} lsTree :: Repo -> Treeish -> IO [TreeItem] lsTree repo t = map parseLsTree <$>-	pipeNullSplit repo [Params "ls-tree --full-tree -z -r --", File t]+	pipeNullSplitB repo [Params "ls-tree --full-tree -z -r --", File t]  {- Parses a line of ls-tree output.  - (The --long format is not currently supported.) -}-parseLsTree :: String -> TreeItem-parseLsTree l = TreeItem m o s f+parseLsTree :: L.ByteString -> TreeItem+parseLsTree l = TreeItem +	{ mode = fst $ head $ readOct $ L.unpack m+	, typeobj = L.unpack t+	, sha = L.unpack s+	, file = decodeGitFile $ L.unpack f+	} 	where 		-- l = <mode> SP <type> SP <sha> TAB <file>-		-- Since everything until the file is fixed-width,-		-- do not need to split on words.-		(m, past_m) = head $ readOct l-		(o, past_o) = splitAt 4 $ space past_m-		(s, past_s) = splitAt shaSize $ space past_o-		f = decodeGitFile $ space past_s-		space (sp:rest)-			| isSpace sp = rest-			| otherwise = parseerr-		space [] = parseerr-		parseerr = "ls-tree parse error: " ++ l+		-- All fields are fixed, so we can pull them out of+		-- specific positions in the line.+		(m, past_m) = L.splitAt 7 l+		(t, past_t) = L.splitAt 4 past_m+		(s, past_s) = L.splitAt 40 $ L.tail past_t+		f = L.tail past_s
Git/UnionMerge.hs view
@@ -7,6 +7,7 @@  module Git.UnionMerge ( 	merge,+	merge_index, 	update_index, 	update_index_line, 	ls_tree@@ -16,33 +17,34 @@ import Data.List import Data.Maybe import Data.String.Utils+import qualified Data.ByteString.Lazy.Char8 as L +import Common import Git-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.  -- - When only one branch is specified, it is merged into the index.- - In this case, previously staged changes in the index are preserved.- -  - Should be run with a temporary index file configured by Git.useIndex.  -}-merge :: Repo -> [String] -> IO ()-merge g (x:y:[]) = do+merge :: Repo -> String -> String -> IO ()+merge g x y = do 	a <- ls_tree g x 	b <- merge_trees g x y 	update_index g (a++b)-merge g [x] = merge_tree_index g x >>= update_index g-merge _ _ = error "wrong number of branches to merge" +{- Merges a list of branches into the index. Previously staged changed in+ - the index are preserved (and participate in the merge). -}+merge_index :: Repo -> [String] -> IO ()+merge_index g bs = update_index g =<< concat <$> mapM (merge_tree_index g) bs+ {- Feeds a list into update-index. Later items in the list can override  - earlier ones, so the list can be generated from any combination of  - ls_tree, merge_trees, and merge_tree_index. -} update_index :: Repo -> [String] -> IO () update_index g l = togit ["update-index", "-z", "--index-info"] (join "\0" l) 	where-		togit ps content = pipeWrite g (map Param ps) content+		togit ps content = pipeWrite g (map Param ps) (L.pack content) 			>>= forceSuccess  {- Generates a line suitable to be fed into update-index, to add@@ -78,6 +80,18 @@ 		pairs (_:[]) = error "calc_merge parse error" 		pairs (a:b:rest) = (a,b):pairs rest +{- Injects some content into git, returning its hash. -}+hashObject :: Repo -> L.ByteString -> IO String+hashObject repo content = getSha subcmd $ do+	(h, s) <- pipeWriteRead repo (map Param params) content+	L.length s `seq` do+		forceSuccess h+		reap -- XXX unsure why this is needed+		return $ L.unpack s+	where+		subcmd = "hash-object"+		params = [subcmd, "-w", "--stdin"]+ {- Given an info line from a git raw diff, and the filename, generates  - a line suitable for update_index that union merges the two sides of the  - diff. -}@@ -92,4 +106,4 @@ 	where 		[_colonamode, _bmode, asha, bsha, _status] = words info 		nullsha = replicate shaSize '0'-		unionmerge = unlines . nub . lines+		unionmerge = L.unlines . nub . L.lines
GitAnnex.hs view
@@ -8,14 +8,12 @@ module GitAnnex where  import System.Console.GetOpt-import Control.Monad.State (liftIO) +import Common.Annex import qualified Git import CmdLine import Command import Options-import Utility-import Types import Types.TrustLevel import qualified Annex import qualified Remote@@ -122,7 +120,7 @@ 		setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v } 		setgitconfig :: String -> Annex () 		setgitconfig v = do-			g <- Annex.gitRepo+			g <- gitRepo 			g' <- liftIO $ Git.configStore g v 			Annex.changeState $ \s -> s { Annex.repo = g' } 
Init.hs view
@@ -11,24 +11,16 @@ 	uninitialize ) where -import Control.Monad.State (liftIO)-import Control.Monad (unless)-import System.Directory--import qualified Annex+import Common.Annex import qualified Git-import qualified Branch-import Version-import Messages-import Types-import Utility-import Utility.Conditional+import qualified Annex.Branch+import Annex.Version import UUID  initialize :: Annex () initialize = do 	prepUUID-	Branch.create+	Annex.Branch.create 	setVersion 	gitPreCommitHookWrite @@ -43,7 +35,7 @@ ensureInitialized = getVersion >>= maybe needsinit checkVersion 	where 		needsinit = do-			annexed <- Branch.hasSomeBranch+			annexed <- Annex.Branch.hasSomeBranch 			if annexed 				then initialize 				else error "First run: git-annex init"@@ -73,16 +65,16 @@  unlessBare :: Annex () -> Annex () unlessBare a = do-	g <- Annex.gitRepo+	g <- gitRepo 	unless (Git.repoIsLocalBare g) a  preCommitHook :: Annex FilePath preCommitHook = do-	g <- Annex.gitRepo+	g <- 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"+	"#!/bin/sh\n" +++	"# automatically configured by git-annex\n" ++ +	"git annex pre-commit .\n"
Limit.hs view
@@ -9,16 +9,14 @@  import Text.Regex.PCRE.Light.Char8 import System.Path.WildMatch-import Control.Applicative-import Data.Maybe -import Annex+import Common.Annex+import qualified Annex import qualified Utility.Matcher import qualified Remote import qualified Backend import LocationLog-import Utility-import Content+import Annex.Content  type Limit = Utility.Matcher.Token (FilePath -> Annex Bool) @@ -67,14 +65,13 @@ {- Adds a limit to skip files not believed to be present  - in a specfied repository. -} addIn :: String -> Annex ()-addIn name = do-	u <- Remote.nameToUUID name-	addLimit $ if name == "." then check inAnnex else check (remote u)+addIn name = addLimit $ check $ if name == "." then inAnnex else inremote 	where 		check a f = Backend.lookupFile f >>= handle a 		handle _ Nothing = return False 		handle a (Just (key, _)) = a key-		remote u key = do+		inremote key = do+			u <- Remote.nameToUUID name 			us <- keyLocations key 			return $ u `elem` us 
LocationLog.hs view
@@ -15,22 +15,16 @@ 	LogStatus(..), 	logChange, 	readLog,-	writeLog, 	keyLocations, 	loggedKeys, 	logFile, 	logFileKey ) where -import System.FilePath-import Control.Applicative-import Data.Maybe-+import Common.Annex import qualified Git-import qualified Branch+import qualified Annex.Branch import UUID-import Types-import Locations import PresenceLog  {- Log a change in the presence of a key's value in a repository. -}@@ -49,7 +43,7 @@ {- Finds all keys that have location log information.  - (There may be duplicate keys in the list.) -} loggedKeys :: Annex [Key]-loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Branch.files+loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Annex.Branch.files  {- The filename of the log file for a given key. -} logFile :: Key -> String
Locations.hs view
@@ -18,6 +18,7 @@ 	gitAnnexBadLocation, 	gitAnnexUnusedLog, 	gitAnnexJournalDir,+	gitAnnexJournalLock, 	isLinkToAnnex, 	hashDirMixed, 	hashDirLower,@@ -25,13 +26,11 @@ 	prop_idempotent_fileKey ) where -import System.FilePath-import Data.String.Utils-import Data.List import Bits import Word import Data.Hash.MD5 +import Common import Types import Types.Key import qualified Git@@ -108,6 +107,10 @@  - branch -} gitAnnexJournalDir :: Git.Repo -> FilePath gitAnnexJournalDir r = addTrailingPathSeparator $ gitAnnexDir r </> "journal"++{- Lock file for the journal. -}+gitAnnexJournalLock :: Git.Repo -> FilePath+gitAnnexJournalLock r = gitAnnexDir r </> "journal.lck"  {- Checks a symlink target to see if it appears to point to annexed content. -} isLinkToAnnex :: FilePath -> Bool
Makefile view
@@ -57,6 +57,7 @@ 	else \ 		if ! ./test; then \ 			echo "** test suite failed!" >&2; \+			exit 1; \ 		fi; \ 	fi 
Messages.hs view
@@ -23,41 +23,39 @@ 	setupConsole ) where -import Control.Monad.State (liftIO)-import System.IO-import Data.String.Utils import Text.JSON +import Common import Types import qualified Annex import qualified Messages.JSON as JSON  showStart :: String -> String -> Annex ()-showStart command file = handle (JSON.start command file) $ do-	putStr $ command ++ " " ++ file ++ " "-	hFlush stdout+showStart command file = handle (JSON.start command file) $+	flushed $ putStr $ command ++ " " ++ file ++ " "  showNote :: String -> Annex ()-showNote s = handle (JSON.note s) $ do-	putStr $ "(" ++ s ++ ") "-	hFlush stdout+showNote s = handle (JSON.note s) $+	flushed $ putStr $ "(" ++ s ++ ") "  showAction :: String -> Annex () showAction s = showNote $ s ++ "..."  showProgress :: Annex ()-showProgress = handle q $ do-	putStr "."-	hFlush stdout+showProgress = handle q $+	flushed $ putStr "."  showSideAction :: String -> Annex ()-showSideAction s = handle q $ putStrLn $ "(" ++ s ++ "...)"+showSideAction s = handle q $+	putStrLn $ "(" ++ s ++ "...)"  showOutput :: Annex ()-showOutput = handle q $ putStr "\n"+showOutput = handle q $+	putStr "\n"  showLongNote :: String -> Annex ()-showLongNote s = handle (JSON.note s) $ putStrLn $ '\n' : indent s+showLongNote s = handle (JSON.note s) $+	putStrLn $ '\n' : indent s  showEndOk :: Annex () showEndOk = showEndResult True@@ -115,3 +113,6 @@  q :: Monad m => m () q = return ()++flushed :: IO () -> IO ()+flushed a = a >> hFlush stdout
Options.hs view
@@ -9,10 +9,9 @@  import System.Console.GetOpt import System.Log.Logger-import Control.Monad.State (liftIO) +import Common.Annex import qualified Annex-import Types import Command import Limit 
PresenceLog.hs view
@@ -16,7 +16,6 @@ 	addLog, 	readLog, 	parseLog,-	writeLog, 	logNow, 	compactLog, 	currentLog,@@ -27,11 +26,9 @@ import Data.Time import System.Locale import qualified Data.Map as M-import Control.Monad.State (liftIO)-import Control.Applicative -import qualified Branch-import Types+import Common.Annex+import qualified Annex.Branch  data LogLine = LogLine { 	date :: POSIXTime,@@ -75,14 +72,13 @@ 			ret v = [(v, "")]  addLog :: FilePath -> LogLine -> Annex ()-addLog file line = do-	ls <- readLog file-	writeLog file (compactLog $ line:ls)+addLog file line = Annex.Branch.change file $ \s -> +	showLog $ compactLog (line : parseLog s)  {- Reads a log file.  - Note that the LogLines returned may be in any order. -} readLog :: FilePath -> Annex [LogLine]-readLog file = parseLog <$> Branch.get file+readLog file = parseLog <$> Annex.Branch.get file  parseLog :: String -> [LogLine] parseLog = filter parsable . map read . lines@@ -90,9 +86,9 @@ 		-- some lines may be unparseable, avoid them 		parsable l = status l /= Undefined -{- Stores a set of lines in a log file -}-writeLog :: FilePath -> [LogLine] -> Annex ()-writeLog file ls = Branch.change file (unlines $ map show ls)+{- Generates a log file. -}+showLog :: [LogLine] -> String+showLog = unlines . map show  {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> Annex LogLine
Remote.hs view
@@ -28,23 +28,17 @@ 	forceTrust ) where -import Control.Monad.State (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 Common.Annex import Types.Remote import UUID import qualified Annex import Config import Trust import LocationLog-import Messages import RemoteLog  import qualified Remote.Git@@ -84,10 +78,11 @@ 			enumerate t >>= 			mapM (gen m t) 		gen m t r = do-			u <- getUUID r+			u <- getRepoUUID r 			generate t r u (M.lookup u m) -{- Looks up a remote by name. (Or by UUID.) -}+{- Looks up a remote by name. (Or by UUID.) Only finds currently configured+ - git remotes. -} byName :: String -> Annex (Remote Annex) byName n = do 	res <- byName' n@@ -106,18 +101,24 @@ 		matching r = n == name r || n == uuid r  {- Looks up a remote by name (or by UUID, or even by description),- - and returns its UUID. -}+ - and returns its UUID. Finds even remotes that are not configured in+ - .git/config. -} nameToUUID :: String -> Annex UUID-nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo+nameToUUID "." = getUUID -- special case for current repo nameToUUID n = do 	res <- byName' n 	case res of 		Left e -> fromMaybe (error e) <$> byDescription 		Right r -> return $ uuid r 	where-		byDescription = M.lookup n . invertMap <$> uuidMap-		invertMap = M.fromList . map swap . M.toList+		byDescription = do+			m <- uuidMap+			case M.lookup n $ transform swap m of+				Just u -> return $ Just u+				Nothing -> return $ M.lookup n $ transform double m+		transform a = M.fromList . map a . M.toList 		swap (a, b) = (b, a)+		double (a, _) = (a, a)  {- Pretty-prints a list of UUIDs of remotes, for human display.  -@@ -128,19 +129,26 @@  - of the UUIDs. -} prettyPrintUUIDs :: String -> [UUID] -> Annex String prettyPrintUUIDs desc uuids = do-	here <- getUUID =<< Annex.gitRepo-	m <- M.union <$> uuidMap <*> availMap+	here <- getUUID+	m <- M.unionWith addname <$> uuidMap <*> remoteMap 	maybeShowJSON [(desc, map (jsonify m here) uuids)] 	return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") uuids 	where-		availMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList+		addname d n+			| d == n = d+			| otherwise = n ++ " (" ++ d ++ ")"+		remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList 		findlog m u = M.findWithDefault "" u m-		prettify m here u = base ++ ishere+		prettify m here u+			| not (null d) = u ++ " -- " ++ d+			| otherwise = u 			where-				base = if not $ null $ findlog m u-					then u ++ "  -- " ++ findlog m u-					else u-				ishere = if here == u then " <-- here" else ""+				ishere = here == u+				n = findlog m u+				d+					| null n && ishere = "here"+					| ishere = addname n "here"+					| otherwise = n 		jsonify m here u = toJSObject 			[ ("uuid", toJSON u) 			, ("description", toJSON $ findlog m u)@@ -170,8 +178,7 @@  keyPossibilities' :: Bool -> Key -> Annex ([Remote Annex], [UUID]) keyPossibilities' withtrusted key = do-	g <- Annex.gitRepo-	u <- getUUID g+	u <- getUUID 	trusted <- if withtrusted then trustGet Trusted else return []  	-- get uuids of all remotes that are recorded to have the key@@ -190,8 +197,7 @@ {- Displays known locations of a key. -} showLocations :: Key -> [UUID] -> Annex () showLocations key exclude = do-	g <- Annex.gitRepo-	u <- getUUID g+	u <- getUUID 	uuids <- keyLocations key 	untrusteduuids <- trustGet UnTrusted 	let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids) 
Remote/Bup.hs view
@@ -8,30 +8,15 @@ module Remote.Bup (remote) where  import qualified Data.ByteString.Lazy.Char8 as L-import System.IO import System.IO.Error-import Control.Exception.Extensible (IOException) import qualified Data.Map as M-import Control.Monad (when)-import Control.Monad.State (liftIO) import System.Process-import System.Exit-import System.FilePath-import Data.Maybe-import Data.List.Utils-import System.Cmd.Utils -import Types+import Common.Annex import Types.Remote import qualified Git-import qualified Annex import UUID-import Locations import Config-import Utility-import Utility.Conditional-import Utility.SafeCommand-import Messages import Utility.Ssh import Remote.Helper.Special import Remote.Helper.Encryptable@@ -118,14 +103,14 @@  store :: Git.Repo -> BupRepo -> Key -> Annex Bool store r buprepo k = do-	g <- Annex.gitRepo+	g <- gitRepo 	let src = gitAnnexLocation g k 	params <- bupSplitParams r buprepo k (File src) 	liftIO $ boolSystem "bup" params  storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted r buprepo (cipher, enck) k = do-	g <- Annex.gitRepo+	g <- gitRepo 	let src = gitAnnexLocation g k 	params <- bupSplitParams r buprepo enck (Param "-") 	liftIO $ catchBool $
Remote/Directory.hs view
@@ -9,25 +9,14 @@  import qualified Data.ByteString.Lazy.Char8 as L import System.IO.Error-import Control.Exception.Extensible (IOException) import qualified Data.Map as M-import Control.Monad (when)-import Control.Monad.State (liftIO)-import System.Directory hiding (copyFile)-import System.FilePath-import Data.Maybe -import Types+import Common.Annex+import Utility.CopyFile import Types.Remote import qualified Git-import qualified Annex import UUID-import Locations-import Utility.CopyFile import Config-import Utility-import Utility.Conditional-import Utility.Path import Utility.FileMode import Remote.Helper.Special import Remote.Helper.Encryptable@@ -82,14 +71,14 @@  store :: FilePath -> Key -> Annex Bool store d k = do-	g <- Annex.gitRepo+	g <- gitRepo 	let src = gitAnnexLocation g k 	let dest = dirKey d k-	liftIO $ catchBool $ storeHelper dest $ copyFile src dest+	liftIO $ catchBool $ storeHelper dest $ copyFileExternal src dest  storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted d (cipher, enck) k = do-	g <- Annex.gitRepo+	g <- gitRepo 	let src = gitAnnexLocation g k 	let dest = dirKey d enck 	liftIO $ catchBool $ storeHelper dest $ encrypt src dest@@ -110,7 +99,7 @@ 	return ok  retrieve :: FilePath -> Key -> FilePath -> Annex Bool-retrieve d k f = liftIO $ copyFile (dirKey d k) f+retrieve d k f = liftIO $ copyFileExternal (dirKey d k) f  retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool retrieveEncrypted d (cipher, enck) f =
Remote/Git.hs view
@@ -8,26 +8,17 @@ module Remote.Git (remote) where  import Control.Exception.Extensible-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 Common.Annex+import Utility.CopyFile+import Utility.RsyncFile+import Utility.Ssh import Types.Remote import qualified Git import qualified Annex-import Locations import UUID-import Utility-import qualified Content-import Messages-import Utility.CopyFile-import Utility.RsyncFile-import Utility.Ssh-import Utility.SafeCommand-import Utility.Path+import qualified Annex.Content import qualified Utility.Url as Url import Config import Init@@ -42,7 +33,7 @@  list :: Annex [Git.Repo] list = do-	g <- Annex.gitRepo+	g <- gitRepo 	return $ Git.remotes g  gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)@@ -57,7 +48,7 @@ 		(False, "") -> tryGitConfigRead r 		_ -> return r -	u' <- getUUID r'+	u' <- getRepoUUID r'  	let defcst = if cheap then cheapRemoteCost else expensiveRemoteCost 	cst <- remoteCost r' defcst@@ -109,7 +100,7 @@  		store a = do 			r' <- a-			g <- Annex.gitRepo+			g <- gitRepo 			let l = Git.remotes g 			let g' = Git.remotesAdd g $ exchange l r' 			Annex.changeState $ \s -> s { Annex.repo = g' }@@ -130,7 +121,7 @@ 	| Git.repoIsUrl r = checkremote 	| otherwise = safely checklocal 	where-		checklocal = onLocal r (Content.inAnnex key)+		checklocal = onLocal r (Annex.Content.inAnnex key) 		checkremote = do 			showAction $ "checking " ++ Git.repoDescribe r 			inannex <- onRemote r (boolSystem, False) "inannex" @@ -169,16 +160,16 @@ copyToRemote :: Git.Repo -> Key -> Annex Bool copyToRemote r key 	| not $ Git.repoIsUrl r = do-		g <- Annex.gitRepo+		g <- gitRepo 		let keysrc = gitAnnexLocation g key 		-- run copy from perspective of remote 		liftIO $ onLocal r $ do-			ok <- Content.getViaTmp key $+			ok <- Annex.Content.getViaTmp key $ 				rsyncOrCopyFile r keysrc-			Content.saveState+			Annex.Content.saveState 			return ok 	| Git.repoIsSsh r = do-		g <- Annex.gitRepo+		g <- gitRepo 		let keysrc = gitAnnexLocation g key 		rsyncHelper =<< rsyncParamsRemote r False key keysrc 	| otherwise = error "copying to non-ssh repo not supported"@@ -200,7 +191,7 @@ 	ss <- liftIO $ getFileStatus $ parentDir src 	ds <- liftIO $ getFileStatus $ parentDir dest 	if deviceID ss == deviceID ds-		then liftIO $ copyFile src dest+		then liftIO $ copyFileExternal src dest 		else do 			params <- rsyncParams r 			rsyncHelper $ params ++ [Param src, Param dest]
Remote/Helper/Encryptable.hs view
@@ -8,13 +8,11 @@ module Remote.Helper.Encryptable where  import qualified Data.Map as M-import Control.Monad.State (liftIO) -import Types+import Common.Annex import Types.Remote import Crypto import qualified Annex-import Messages import Config  {- Encryption setup for a remote. The user must specify whether to use@@ -80,8 +78,6 @@ {- Gets encryption Cipher, and encrypted version of Key. -} cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key)) cipherKey Nothing _ = return Nothing-cipherKey (Just c) k = remoteCipher c >>= maybe (return Nothing) encrypt+cipherKey (Just c) k = maybe Nothing encrypt <$> remoteCipher c 	where-		encrypt ciphertext = do-			k' <- liftIO $ encryptKey ciphertext k-			return $ Just (ciphertext, k')+		encrypt ciphertext = Just (ciphertext, encryptKey ciphertext k)
Remote/Helper/Special.hs view
@@ -8,16 +8,11 @@ module Remote.Helper.Special where  import qualified Data.Map as M-import Data.Maybe-import Data.String.Utils-import Control.Monad.State (liftIO) -import Types+import Common.Annex import Types.Remote import qualified Git-import qualified Annex import UUID-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@@ -25,7 +20,7 @@  -} findSpecialRemotes :: String -> Annex [Git.Repo] findSpecialRemotes s = do-	g <- Annex.gitRepo+	g <- gitRepo 	return $ map construct $ remotepairs g 	where 		remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r@@ -35,7 +30,7 @@ {- Sets up configuration for a special remote in .git/config. -} gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex () gitConfigSpecialRemote u c k v = do-	g <- Annex.gitRepo+	g <- gitRepo 	liftIO $ do 		Git.run g "config" [Param (configsetting $ "annex-"++k), Param v] 		Git.run g "config" [Param (configsetting "annex-uuid"), Param u]
Remote/Hook.hs view
@@ -8,31 +8,19 @@ module Remote.Hook (remote) where  import qualified Data.ByteString.Lazy.Char8 as L-import Control.Exception.Extensible (IOException) import qualified Data.Map as M-import Control.Monad.State (liftIO)-import System.FilePath-import System.Posix.Process hiding (executeFile)-import System.Posix.IO-import System.IO import System.IO.Error (try) import System.Exit-import Data.Maybe -import Types+import Common.Annex import Types.Remote import qualified Git-import qualified Annex import UUID-import Locations import Config-import Content-import Utility-import Utility.SafeCommand+import Annex.Content import Remote.Helper.Special import Remote.Helper.Encryptable import Crypto-import Messages  remote :: RemoteType Annex remote = RemoteType {@@ -86,7 +74,7 @@  lookupHook :: String -> String -> Annex (Maybe String) lookupHook hooktype hook =do-	g <- Annex.gitRepo+	g <- gitRepo 	command <- getConfig g hookname "" 	if null command 		then do@@ -111,12 +99,12 @@  store :: String -> Key -> Annex Bool store h k = do-	g <- Annex.gitRepo+	g <- gitRepo 	runHook h "store" k (Just $ gitAnnexLocation g k) $ return True  storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do-	g <- Annex.gitRepo+	g <- gitRepo 	let f = gitAnnexLocation g k 	liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s 	runHook h "store" enck (Just tmp) $ return True
Remote/Rsync.hs view
@@ -8,32 +8,18 @@ module Remote.Rsync (remote) where  import qualified Data.ByteString.Lazy.Char8 as L-import Control.Exception.Extensible (IOException) import qualified Data.Map as M-import Control.Monad.State (liftIO)-import System.FilePath-import System.Directory-import System.Posix.Files-import System.Posix.Process-import Data.Maybe -import Types+import Common.Annex import Types.Remote import qualified Git-import qualified Annex import UUID-import Locations import Config-import Content-import Utility-import Utility.Conditional+import Annex.Content import Remote.Helper.Special import Remote.Helper.Encryptable import Crypto-import Messages import Utility.RsyncFile-import Utility.SafeCommand-import Utility.Path  type RsyncUrl = String @@ -106,12 +92,12 @@  store :: RsyncOpts -> Key -> Annex Bool store o k = do-	g <- Annex.gitRepo+	g <- gitRepo 	rsyncSend o k (gitAnnexLocation g k)  storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do-	g <- Annex.gitRepo+	g <- gitRepo 	let f = gitAnnexLocation g k 	liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s 	rsyncSend o enck tmp@@ -166,7 +152,7 @@  - up trees for rsync. -} withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool withRsyncScratchDir a = do-	g <- Annex.gitRepo+	g <- gitRepo 	pid <- liftIO getProcessID 	let tmp = gitAnnexTmpDir g </> "rsynctmp" </> show pid 	nuke tmp
Remote/S3real.hs view
@@ -7,36 +7,26 @@  module Remote.S3 (remote) where -import Control.Exception.Extensible (IOException) import Network.AWS.AWSConnection import Network.AWS.S3Object import Network.AWS.S3Bucket hiding (size) import Network.AWS.AWSResult import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M-import Data.Maybe-import Data.List import Data.Char-import Data.String.Utils-import Control.Monad (when)-import Control.Monad.State (liftIO) import System.Environment-import System.Posix.Files import System.Posix.Env (setEnv) -import Types+import Common.Annex import Types.Remote import Types.Key import qualified Git-import qualified Annex import UUID-import Messages-import Locations import Config import Remote.Helper.Special import Remote.Helper.Encryptable import Crypto-import Content+import Annex.Content import Utility.Base64  remote :: RemoteType Annex@@ -123,7 +113,7 @@  store :: Remote Annex -> Key -> Annex Bool store r k = s3Action r False $ \(conn, bucket) -> do-	g <- Annex.gitRepo+	g <- gitRepo 	res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k 	s3Bool res @@ -132,7 +122,7 @@ 	-- To get file size of the encrypted content, have to use a temp file. 	-- (An alternative would be chunking to to a constant size.) 	withTmp enck $ \tmp -> do-		g <- Annex.gitRepo+		g <- gitRepo 		let f = gitAnnexLocation g k 		liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s 		res <- liftIO $ storeHelper (conn, bucket) r enck tmp
Remote/Web.hs view
@@ -10,21 +10,13 @@ 	setUrl ) where -import Control.Monad.State (liftIO)-import Control.Exception-import System.FilePath--import Types+import Common.Annex import Types.Remote import qualified Git-import qualified Annex-import Messages import UUID import Config import PresenceLog import LocationLog-import Locations-import Utility import qualified Utility.Url as Url  type URLString = String@@ -80,7 +72,7 @@ {- Records a change in an url for a key. -} setUrl :: Key -> URLString -> LogStatus -> Annex () setUrl key url status = do-	g <- Annex.gitRepo+	g <- gitRepo 	addLog (urlLog key) =<< logNow status url  	-- update location log to indicate that the web has the key, or not
RemoteLog.hs view
@@ -6,7 +6,6 @@  -}  module RemoteLog (-	remoteLog, 	readRemoteLog, 	configSet, 	keyValToConfig,@@ -15,16 +14,15 @@ 	prop_idempotent_configEscape ) where -import Data.List import qualified Data.Map as M-import Data.Maybe+import Data.Time.Clock.POSIX import Data.Char-import Control.Applicative -import qualified Branch-import Types+import Common.Annex+import qualified Annex.Branch import Types.Remote import UUID+import UUIDLog  {- Filename of remote.log. -} remoteLog :: FilePath@@ -33,27 +31,19 @@ {- Adds or updates a remote's config in the log. -} configSet :: UUID -> RemoteConfig -> Annex () configSet u c = do-	m <- readRemoteLog-	Branch.change remoteLog $ unlines $ sort $-		map toline $ M.toList $ M.insert u c m-	where-		toline (u', c') = u' ++ " " ++ unwords (configToKeyVal c')+	ts <- liftIO $ getPOSIXTime+	Annex.Branch.change remoteLog $+		showLog showConfig . changeLog ts u c . parseLog parseConfig  {- Map of remotes by uuid containing key/value config maps. -} readRemoteLog :: Annex (M.Map UUID RemoteConfig)-readRemoteLog = remoteLogParse <$> Branch.get remoteLog+readRemoteLog = (simpleMap . parseLog parseConfig) <$> Annex.Branch.get remoteLog -remoteLogParse :: String -> M.Map UUID RemoteConfig-remoteLogParse s =-	M.fromList $ mapMaybe parseline $ filter (not . null) $ lines s-	where-		parseline l-			| length w > 2 = Just (u, c)-			| otherwise = Nothing-			where-				w = words l-				u = head w-				c = keyValToConfig $ tail w+parseConfig :: String -> Maybe RemoteConfig+parseConfig = Just . keyValToConfig . words++showConfig :: RemoteConfig -> String+showConfig = unwords . configToKeyVal  {- Given Strings like "key=value", generates a RemoteConfig. -} keyValToConfig :: [String] -> RemoteConfig
Trust.hs view
@@ -7,31 +7,29 @@  module Trust ( 	TrustLevel(..),-	trustLog, 	trustGet, 	trustSet, 	trustPartition ) where -import Control.Monad.State import qualified Data.Map as M-import Data.List+import Data.Time.Clock.POSIX +import Common.Annex import Types.TrustLevel-import qualified Branch-import Types-import UUID+import qualified Annex.Branch import qualified Annex +import UUID+import UUIDLog+ {- Filename of trust.log. -} trustLog :: FilePath trustLog = "trust.log"  {- Returns a list of UUIDs at the specified trust level. -} trustGet :: TrustLevel -> Annex [UUID]-trustGet level = do-	m <- trustMap-	return $ M.keys $ M.filter (== level) m+trustGet level = M.keys . M.filter (== level) <$> trustMap  {- Read the trustLog into a map, overriding with any  - values from forcetrust. The map is cached for speed. -}@@ -41,37 +39,29 @@ 	case cached of 		Just m -> return m 		Nothing -> do-			overrides <- Annex.getState Annex.forcetrust-			l <- Branch.get trustLog-			let m = M.fromList $ trustMapParse l ++ overrides+			overrides <- M.fromList <$> Annex.getState Annex.forcetrust+			m <- (M.union overrides . simpleMap . parseLog parseTrust) <$>+				Annex.Branch.get trustLog 			Annex.changeState $ \s -> s { Annex.trustmap = Just m } 			return m -{- Trust map parser. -}-trustMapParse :: String -> [(UUID, TrustLevel)]-trustMapParse s = map pair $ filter (not . null) $ lines s+parseTrust :: String -> Maybe TrustLevel+parseTrust s+	| length w > 0 = readMaybe $ head w+	-- back-compat; the trust.log used to only list trusted repos+	| otherwise = Just Trusted 	where-		pair l-			| length w > 1 = (w !! 0, read (w !! 1) :: TrustLevel)-			-- for back-compat; the trust log used to only-			-- list trusted uuids-			| otherwise = (w !! 0, Trusted)-			where-				w = words l+		w = words s  {- Changes the trust level for a uuid in the trustLog. -} trustSet :: UUID -> TrustLevel -> Annex () trustSet uuid level = do 	when (null uuid) $ 		error "unknown UUID; cannot modify trust level"-        m <- trustMap-	when (M.lookup uuid m /= Just level) $ do-		let m' = M.insert uuid level m-		Branch.change trustLog (serialize m')-		Annex.changeState $ \s -> s { Annex.trustmap = Just m' }-        where-                serialize m = unlines $ map showpair $ M.toList m-		showpair (u, t) = u ++ " " ++ show t+	ts <- liftIO $ getPOSIXTime+	Annex.Branch.change trustLog $+		showLog show . changeLog ts uuid level . parseLog parseTrust+	Annex.changeState $ \s -> s { Annex.trustmap = Nothing }  {- Partitions a list of UUIDs to those matching a TrustLevel and not. -} trustPartition :: TrustLevel -> [UUID] -> Annex ([UUID], [UUID])
Types/Backend.hs view
@@ -1,6 +1,6 @@ {- git-annex key/value backend data type  -- - Most things should not need this, using Types instead+ - Most things should not need this, using Remotes instead  -  - Copyright 2010 Joey Hess <joey@kitenet.net>  -
Types/Key.hs view
@@ -15,8 +15,9 @@ 	prop_idempotent_key_read_show ) where -import Utility import System.Posix.Types++import Common  {- A Key has a unique name, is associated with a key/value backend,  - and may contain other optional metadata. -}
UUID.hs view
@@ -6,47 +6,46 @@  - UUIDs of remotes are cached in git config, using keys named  - remote.<name>.annex-uuid  -- - Copyright 2010 Joey Hess <joey@kitenet.net>+ - uuid.log stores a list of known uuids, and their descriptions.  -+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>+ -  - Licensed under the GNU GPL version 3 or higher.  -}  module UUID ( 	UUID, 	getUUID,+	getRepoUUID, 	getUncachedUUID, 	prepUUID, 	genUUID, 	describeUUID,-	uuidMap,-	uuidLog+	uuidMap ) where -import Control.Monad.State-import System.Cmd.Utils-import System.IO import qualified Data.Map as M-import Data.Maybe+import Data.Time.Clock.POSIX +import Common.Annex import qualified Git-import qualified Branch-import Types+import qualified Annex.Branch import Types.UUID-import qualified Annex import qualified Build.SysConfig as SysConfig import Config+import UUIDLog  configkey :: String configkey = "annex.uuid"  {- Filename of uuid.log. -}-uuidLog :: FilePath-uuidLog = "uuid.log"+logfile :: FilePath+logfile = "uuid.log"  {- Generates a UUID. There is a library for this, but it's not packaged,  - so use the command line tool. -} genUUID :: IO UUID-genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h+genUUID = pOpen ReadFromPipe command params hGetLine 	where 		command = SysConfig.uuid 		params = if command == "uuid"@@ -55,12 +54,14 @@ 			-- uuidgen generates random uuid by default 			else [] -{- Looks up a repo's UUID. May return "" if none is known.- -}-getUUID :: Git.Repo -> Annex UUID-getUUID r = do-	g <- Annex.gitRepo+getUUID :: Annex UUID+getUUID = getRepoUUID =<< gitRepo +{- Looks up a repo's UUID. May return "" if none is known. -}+getRepoUUID :: Git.Repo -> Annex UUID+getRepoUUID r = do+	g <- gitRepo+ 	let c = cached g 	let u = getUncachedUUID r 	@@ -79,28 +80,16 @@  {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: Annex ()-prepUUID = do-	u <- getUUID =<< Annex.gitRepo-	when ("" == u) $ do-		uuid <- liftIO genUUID-		setConfig configkey uuid+prepUUID = whenM (null <$> getUUID) $+	setConfig configkey =<< liftIO genUUID -{- Records a description for a uuid in the uuidLog. -}+{- Records a description for a uuid in the log. -} describeUUID :: UUID -> String -> Annex () describeUUID uuid desc = do-	m <- uuidMap-	let m' = M.insert uuid desc m-	Branch.change uuidLog (serialize m')-	where-		serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m+	ts <- liftIO $ getPOSIXTime+	Annex.Branch.change logfile $+		showLog id . changeLog ts uuid desc . parseLog Just -{- Read and parse the uuidLog into a Map -}+{- Read the uuidLog into a simple Map -} uuidMap :: Annex (M.Map UUID String)-uuidMap = do-	s <- Branch.get uuidLog-	return $ M.fromList $ map pair $ lines s-	where-		pair l =-			if 1 < length (words l)-				then (head $ words l, unwords $ drop 1 $ words l)-				else ("", "")+uuidMap = (simpleMap . parseLog Just) <$> Annex.Branch.get logfile
+ UUIDLog.hs view
@@ -0,0 +1,110 @@+{- git-annex uuid-based logs+ -+ - This is used to store information about a UUID in a way that can+ - be union merged.+ -+ - A line of the log will look like: "UUID[ INFO[ timestamp=foo]]"+ - The timestamp is last for backwards compatability reasons,+ - and may not be present on old log lines.+ - + - Copyright 2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module UUIDLog (+	Log,+	LogEntry(..),+	parseLog,+	showLog,+	changeLog,+	addLog,+	simpleMap,++	prop_TimeStamp_sane,+	prop_addLog_sane,+) where++import qualified Data.Map as M+import Data.Time.Clock.POSIX+import Data.Time+import System.Locale++import Common+import Types.UUID++data TimeStamp = Unknown | Date POSIXTime+	deriving (Eq, Ord, Show)++data LogEntry a = LogEntry+	{ changed :: TimeStamp+	, value :: a+	} deriving (Eq, Show)++type Log a = M.Map UUID (LogEntry a)++tskey :: String+tskey = "timestamp="++showLog :: (a -> String) -> Log a -> String+showLog shower = unlines . map showpair . M.toList+	where+		showpair (k, LogEntry (Date p) v) =+			unwords [k, shower v, tskey ++ show p]+		showpair (k, LogEntry Unknown v) =+			unwords [k, shower v]++parseLog :: (String -> Maybe a) -> String -> Log a+parseLog parser = M.fromListWith best . catMaybes . map pair . lines+	where+		pair line+			| null ws = Nothing+			| otherwise = case parser $ unwords info of+				Nothing -> Nothing+				Just v -> Just (u, LogEntry c v)+			where+				ws = words line+				u = head ws+				end = last ws+				c+					| tskey `isPrefixOf` end =+						pdate $ tail $ dropWhile (/= '=') end+					| otherwise = Unknown+				info+					| c == Unknown = drop 1 ws+					| otherwise = drop 1 $ init ws+				pdate s = case parseTime defaultTimeLocale "%s%Qs" s of+					Nothing -> Unknown+					Just d -> Date $ utcTimeToPOSIXSeconds d++changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a+changeLog t u v = M.insert u $ LogEntry (Date t) v++{- Only add an LogEntry if it's newer (or at least as new as) than any+ - existing LogEntry for a UUID. -}+addLog :: UUID -> LogEntry a -> Log a -> Log a+addLog = M.insertWith best++{- Converts a Log into a simple Map without the timestamp information.+ - This is a one-way trip, but useful for code that never needs to change+ - the log. -}+simpleMap :: Log a -> M.Map UUID a+simpleMap = M.map value++best :: LogEntry a -> LogEntry a -> LogEntry a+best new old+	| changed old > changed new = old+	| otherwise = new++-- Unknown is oldest.+prop_TimeStamp_sane :: Bool+prop_TimeStamp_sane = Unknown < Date 1++prop_addLog_sane :: Bool+prop_addLog_sane = newWins && newestWins+	where+		newWins = addLog "foo" (LogEntry (Date 1) "new") l == l2+		newestWins = addLog "foo" (LogEntry (Date 1) "newest") l2 /= l2++		l = M.fromList [("foo", LogEntry (Date 0) "old")]+		l2 = M.fromList [("foo", LogEntry (Date 1) "new")]
Upgrade.hs view
@@ -7,8 +7,8 @@  module Upgrade where -import Types-import Version+import Common.Annex+import Annex.Version import qualified Upgrade.V0 import qualified Upgrade.V1 import qualified Upgrade.V2
Upgrade/V0.hs view
@@ -8,23 +8,15 @@ module Upgrade.V0 where  import System.IO.Error (try)-import System.Directory-import Control.Monad.State (liftIO)-import Control.Monad (filterM, forM_)-import System.Posix.Files-import System.FilePath -import Content-import Types-import Locations-import qualified Annex-import Messages+import Common.Annex+import Annex.Content import qualified Upgrade.V1  upgrade :: Annex Bool upgrade = do 	showAction "v0 to v1"-	g <- Annex.gitRepo+	g <- gitRepo  	-- do the reorganisation of the key files 	let olddir = gitAnnexDir g
Upgrade/V1.hs view
@@ -8,33 +8,19 @@ module Upgrade.V1 where  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 import System.Posix.Types-import Data.Maybe import Data.Char +import Common.Annex import Types.Key-import Content-import Types-import Locations+import Annex.Content import PresenceLog-import qualified Annex-import qualified AnnexQueue+import qualified Annex.Queue import qualified Git import qualified Git.LsFiles as LsFiles import Backend-import Messages-import Version-import Utility+import Annex.Version import Utility.FileMode-import Utility.SafeCommand-import Utility.Path import qualified Upgrade.V2  -- v2 adds hashing of filenames of content and location log files.@@ -64,7 +50,7 @@ upgrade = do 	showAction "v1 to v2" -	g <- Annex.gitRepo+	g <- gitRepo 	if Git.repoIsLocalBare g 		then do 			moveContent@@ -74,7 +60,7 @@ 			updateSymlinks 			moveLocationLogs 	-			AnnexQueue.flush True+			Annex.Queue.flush True 			setVersion 	 	Upgrade.V2.upgrade@@ -96,7 +82,7 @@ updateSymlinks :: Annex () updateSymlinks = do 	showAction "updating symlinks"-	g <- Annex.gitRepo+	g <- gitRepo 	files <- liftIO $ LsFiles.inRepo g [Git.workTree g] 	forM_ files fixlink 	where@@ -108,7 +94,7 @@ 					link <- calcGitLink f k 					liftIO $ removeFile f 					liftIO $ createSymbolicLink link f-					AnnexQueue.add "add" [Param "--"] [f]+					Annex.Queue.add "add" [Param "--"] [f]  moveLocationLogs :: Annex () moveLocationLogs = do@@ -117,7 +103,7 @@ 	forM_ logkeys move 		where 			oldlocationlogs = do-				g <- Annex.gitRepo+				g <- gitRepo 				let dir = Upgrade.V2.gitStateDir g 				exists <- liftIO $ doesDirectoryExist dir 				if exists@@ -126,7 +112,7 @@ 						return $ mapMaybe oldlog2key contents 					else return [] 			move (l, k) = do-				g <- Annex.gitRepo+				g <- gitRepo 				let dest = logFile2 g k 				let dir = Upgrade.V2.gitStateDir g 				let f = dir </> l@@ -138,9 +124,9 @@ 				old <- liftIO $ readLog1 f 				new <- liftIO $ readLog1 dest 				liftIO $ writeLog1 dest (old++new)-				AnnexQueue.add "add" [Param "--"] [dest]-				AnnexQueue.add "add" [Param "--"] [f]-				AnnexQueue.add "rm" [Param "--quiet", Param "-f", Param "--"] [f]+				Annex.Queue.add "add" [Param "--"] [dest]+				Annex.Queue.add "add" [Param "--"] [f]+				Annex.Queue.add "rm" [Param "--quiet", Param "-f", Param "--"] [f] 		 oldlog2key :: FilePath -> Maybe (FilePath, Key) oldlog2key l = @@ -220,7 +206,7 @@  getKeyFilesPresent1 :: Annex [FilePath] getKeyFilesPresent1  = do-	g <- Annex.gitRepo+	g <- gitRepo 	getKeyFilesPresent1' $ gitAnnexObjectDir g getKeyFilesPresent1' :: FilePath -> Annex [FilePath] getKeyFilesPresent1' dir = do
Upgrade/V2.hs view
@@ -7,23 +7,11 @@  module Upgrade.V2 where -import System.Directory-import System.FilePath-import Control.Monad.State (unless, when, liftIO)-import Data.List-import Data.Maybe--import Types.Key-import Types-import qualified Annex+import Common.Annex import qualified Git-import qualified Branch-import Messages-import Utility-import Utility.Conditional-import Utility.SafeCommand+import qualified Annex.Branch import LocationLog-import Content+import Annex.Content  olddir :: Git.Repo -> FilePath olddir g@@ -48,10 +36,10 @@ upgrade :: Annex Bool upgrade = do 	showAction "v2 to v3"-	g <- Annex.gitRepo+	g <- gitRepo 	let bare = Git.repoIsLocalBare g -	Branch.create+	Annex.Branch.create 	showProgress  	e <- liftIO $ doesDirectoryExist (olddir g)@@ -85,10 +73,10 @@  inject :: FilePath -> FilePath -> Annex () inject source dest = do-	g <- Annex.gitRepo+	g <- gitRepo 	new <- liftIO (readFile $ olddir g </> source)-	prev <- Branch.get dest-	Branch.change dest $ unlines $ nub $ lines prev ++ lines new+	Annex.Branch.change dest $ \prev -> +		unlines $ nub $ lines prev ++ lines new 	showProgress  logFiles :: FilePath -> Annex [FilePath]@@ -97,8 +85,8 @@  push :: Annex () push = do-	origin_master <- Branch.refExists "origin/master"-	origin_gitannex <- Branch.hasOrigin+	origin_master <- Annex.Branch.refExists "origin/master"+	origin_gitannex <- Annex.Branch.hasOrigin 	case (origin_master, origin_gitannex) of 		(_, True) -> do 			-- Merge in the origin's git-annex branch,@@ -106,20 +94,20 @@ 			-- will immediately work. Not pushed here, 			-- because it's less obnoxious to let the user 			-- push.-			Branch.update+			Annex.Branch.update 		(True, False) -> do 			-- push git-annex to origin, so that 			-- "git push" will from then on 			-- automatically push it-			Branch.update -- just in case+			Annex.Branch.update -- just in case 			showAction "pushing new git-annex branch to origin" 			showOutput-			g <- Annex.gitRepo-			liftIO $ Git.run g "push" [Param "origin", Param Branch.name]+			g <- gitRepo+			liftIO $ Git.run g "push" [Param "origin", Param Annex.Branch.name] 		_ -> do 			-- no origin exists, so just let the user 			-- know about the new branch-			Branch.update+			Annex.Branch.update 			showLongNote $ 				"git-annex branch created\n" ++ 				"Be sure to push this branch when pushing to remotes.\n"
Utility.hs view
@@ -11,7 +11,6 @@ 	readMaybe, 	viaTmp, 	withTempFile,-	dirContains, 	dirContents, 	myHomeDir, 	catchBool,@@ -20,6 +19,7 @@ 	anyM ) where +import Control.Applicative import IO (bracket) import System.IO import System.Posix.Process hiding (executeFile)@@ -70,9 +70,7 @@ {- Lists the contents of a directory.  - Unlike getDirectoryContents, paths are not relative to the directory. -} dirContents :: FilePath -> IO [FilePath]-dirContents d = do-	c <- getDirectoryContents d-	return $ map (d </>) $ filter notcruft c+dirContents d = map (d </>) . filter notcruft <$> getDirectoryContents d 	where 		notcruft "." = False 		notcruft ".." = False@@ -80,10 +78,7 @@  {- Current user's home directory. -} myHomeDir :: IO FilePath-myHomeDir = do-	uid <- getEffectiveUserID-	u <- getUserEntryForID uid-	return $ homeDirectory u+myHomeDir = homeDirectory <$> (getUserEntryForID =<< getEffectiveUserID)  {- Catches IO errors and returns a Bool -} catchBool :: IO Bool -> IO Bool
Utility/CopyFile.hs view
@@ -5,7 +5,7 @@  - Licensed under the GNU GPL version 3 or higher.  -} -module Utility.CopyFile (copyFile) where+module Utility.CopyFile (copyFileExternal) where  import System.Directory (doesFileExist, removeFile) @@ -15,8 +15,8 @@  {- The cp command is used, because I hate reinventing the wheel,  - and because this allows easy access to features like cp --reflink. -}-copyFile :: FilePath -> FilePath -> IO Bool-copyFile src dest = do+copyFileExternal :: FilePath -> FilePath -> IO Bool+copyFileExternal src dest = do 	whenM (doesFileExist dest) $ 		removeFile dest 	boolSystem "cp" [params, File src, File dest]
Utility/Path.hs view
@@ -17,10 +17,9 @@  {- Returns the parent directory of a path. Parent of / is "" -} parentDir :: FilePath -> FilePath-parentDir dir =-	if not $ null dirs-	then slash ++ join s (init dirs)-	else ""+parentDir dir+	| not $ null dirs = slash ++ join s (init dirs)+	| otherwise = "" 		where 			dirs = filter (not . null) $ split s dir 			slash = if isAbsolute dir then s else ""@@ -72,7 +71,7 @@  - Both must be absolute, and normalized (eg with absNormpath).  -} relPathDirToFile :: FilePath -> FilePath -> FilePath-relPathDirToFile from to = path+relPathDirToFile from to = join s $ dotdots ++ uncommon 	where 		s = [pathSeparator] 		pfrom = split s from@@ -82,7 +81,6 @@ 		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@@ -99,14 +97,11 @@  - appear at the same position as it did in the input list.  -} preserveOrder :: [FilePath] -> [FilePath] -> [FilePath]--- optimisation, only one item in original list, so no reordering needed-preserveOrder [_] new = new-preserveOrder orig new = collect orig new+preserveOrder [] new = new+preserveOrder [_] new = new -- optimisation+preserveOrder (l:ls) new = found ++ preserveOrder ls rest 	where-		collect [] n = n-		collect [_] n = n -- optimisation-		collect (l:ls) n = found ++ collect ls rest-			where (found, rest)=partition (l `dirContains`) n+		(found, rest)=partition (l `dirContains`) new  {- Runs an action that takes a list of FilePaths, and ensures that   - its return list preserves order.
Utility/Ssh.hs view
@@ -13,6 +13,7 @@ import Utility.SafeCommand import Types import Config+import UUID  {- Generates parameters to ssh to a repository's host and run a command.  - Caller is responsible for doing any neccessary shellEscaping of the@@ -33,15 +34,20 @@ git_annex_shell r command params 	| not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts) 	| Git.repoIsSsh r = do-		sshparams <- sshToRepo r [Param sshcmd]+		uuid <- getRepoUUID r+		sshparams <- sshToRepo r [Param $ sshcmd uuid ] 		return $ Just ("ssh", sshparams) 	| otherwise = return Nothing 	where 		dir = Git.workTree r 		shellcmd = "git-annex-shell" 		shellopts = Param command : File dir : params-		sshcmd = shellcmd ++ " " ++ -			unwords (map shellEscape $ toCommand shellopts)+		sshcmd uuid = unwords $+			shellcmd : (map shellEscape $ toCommand shellopts) +++			uuidcheck uuid+		uuidcheck uuid+			| null uuid = []+			| otherwise = ["--uuid", uuid]  {- Uses a supplied function (such as boolSystem) to run a git-annex-shell  - command on a remote.
− Version.hs
@@ -1,47 +0,0 @@-{- git-annex repository versioning- -- - Copyright 2010 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--module Version where--import Types-import qualified Annex-import qualified Git-import Config--type Version = String--defaultVersion :: Version-defaultVersion = "3"--supportedVersions :: [Version]-supportedVersions = [defaultVersion]--upgradableVersions :: [Version]-upgradableVersions = ["0", "1", "2"]--versionField :: String-versionField = "annex.version"--getVersion :: Annex (Maybe Version)-getVersion = do-	g <- Annex.gitRepo-	let v = Git.configGet g versionField ""-	if not $ null v-		then return $ Just v-		else return Nothing--setVersion :: Annex ()-setVersion = setConfig versionField defaultVersion--checkVersion :: Version -> Annex ()-checkVersion v-	| v `elem` supportedVersions = return ()-	| v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade"-	| otherwise = err "Upgrade git-annex."-	where-		err msg = error $ "Repository version " ++ v ++-			" is not supported. " ++ msg
debian/changelog view
@@ -1,3 +1,36 @@+git-annex (3.20111011) unstable; urgency=low++  * This version of git-annex only works with git 1.7.7 and newer.+    The breakage with old versions is subtle, and affects the+    annex.numcopies settings in .gitattributes, so be sure to upgrade git+    to 1.7.7. (Debian package now depends on that version.)+  * Don't pass absolute paths to git show-attr, as it started following+    symlinks when that's done in 1.7.7. Instead, use relative paths,+    which show-attr only handles 100% correctly in 1.7.7. Closes: #645046+  * Fix referring to remotes by uuid.+  * New or changed repository descriptions in uuid.log now have a timestamp,+    which is used to ensure the newest description is used when the uuid.log+    has been merged.+  * Note that older versions of git-annex will display the timestamp as part+    of the repository description, which is ugly but otherwise harmless.+  * Add timestamps to trust.log and remote.log too.+  * git-annex-shell: Added the --uuid option.+  * git-annex now asks git-annex-shell to verify that it's operating in +    the expected repository.+  * Note that this git-annex will not interoperate with remotes using +    older versions of git-annex-shell.+  * Now supports git's insteadOf configuration, to modify the url+    used to access a remote. Note that pushInsteadOf is not used;+    that and pushurl are reserved for actual git pushes. Closes: #644278+  * status: List all known repositories.+  * When displaying a list of repositories, show git remote names+    in addition to their descriptions.+  * Add locking to avoid races when changing the git-annex branch.+  * Various speed improvements gained by using ByteStrings.+  * Contain the zombie hordes.++ -- Joey Hess <joeyh@debian.org>  Tue, 11 Oct 2011 23:00:02 -0400+ git-annex (3.20110928) unstable; urgency=low    * --in can be used to make git-annex only operate on files
debian/control view
@@ -17,7 +17,7 @@ 	libghc-json-dev, 	ikiwiki, 	perlmagick,-	git | git-core,+	git, 	uuid, 	rsync, Maintainer: Joey Hess <joeyh@debian.org>@@ -29,7 +29,7 @@ Architecture: any Section: utils Depends: ${misc:Depends}, ${shlibs:Depends},-	git | git-core,+	git (>= 1:1.7.7), 	uuid, 	rsync, 	wget | curl,
+ doc/bugs/concurrent_git-annex_processes_can_lead_to_locking_issues.mdwn view
@@ -0,0 +1,53 @@+When two git-annex processes are running and both modifying the git-annex+branch, it's possible one will fail due to git's locking. When this+happens, git-annex has already recorded its state in the journal (so no+data is lost), but git-annex does crash, which can be surprising.++I feel that, in general, multiple git-annex processes should be able to run+concurrently. A big lock around all commands, or even all+repository-modifying commands is a bad idea. Also, it's probably best to+only worry about locking conflicts editing the git-annex branch. While `git+annex add` and a few other commands make changes to the main git repo,+and can have similar locking issues, so can any git commands that stage+changes (I think.. check).++Probably should KISS. Just add a lock file that is taken before changes to+the git-annex branch, and if it's locked, wait. Changes to the git-annex+branch tend to happen quickly (unless it's committing an enormous set of+changes, and even that is relatively fast), so waiting seems ok. --[[Joey]] ++----++Commit 7981eb4cb512fbe3c49a3dd165c31be14ae4bc49 is more pessimistic, +describes some other potential issues. ++* The journal needs to be emptied (done) and kept locked (not done) during+  a merge, since a merge operates at a level below the journal, and any+  changes that are journaled during a merge can overwrite changes merged+  in from another branch.++* Two git-annex processes can be doing conflicting things and inconsistent+  information be written to the journal.++  - One example would be concurrent get and drop of the same key.+    But could this really race? If the key was already present, the get+    would do nothing, so record no changes. If the key was not yet present,+    the drop would do nothing, and record no changes.++  - Instead, consider two copys of a key to different locations. If the+    slower copy starts first and ends last, it could cache the location +    info, add the  new location, and lose the other location it was copied to.+    Tested it and the location is not cached during the whole copy (logChange+    reads the current log immediatly before writing), so this+    race's window is very small -- but does exist.++---- ++## Updated plan++Make Branch.change transactional, so it takes a lock, reads a file,+applies a function to it, and writes the changed file.++Make Branch.update hold the same lock.++> [[Done]].
+ doc/bugs/uuid.log_trust.log_and_remote.log_merge_wackiness.mdwn view
@@ -0,0 +1,36 @@+Since uuid.log, trust.log and remote.log are union merged, it's possible+for any given item in them to have multiple values after a merge.+This would happen, for example, if the value was changed in different ways+in two repos which were then merged. git-annex will use an arbitrary+one of the multiple values.++A workaround if this should happen to you is to use `git annex describe`+or other commands to re-set the value you want. The process of setting+the value will remove the multiple lines.++To fix this the file format needs to be changed to include a timestamp+as is done with the other log files, then git-annex can consistently+pick the newest value -- which is as close to the "right" value as can be+determined in this situation.++----++File format backwards-compatability is the issue. Ideally, old git-annex+would keep working, ignoring the timestamp.++- uuid.log: "uuid description timestamp" would work; old git-annex +  would just treat the timestamp as part of the description which would be+  ok+  > update: converted! --[[Joey]] +- trust.log: "uuid trustlevel timestamp" would work; old git-annex+  ignores trailing words+  > update: converted! --[[Joey]] +- remote.log: "uuid key=value ... timestamp" is on the edge but does work+  (old git-annex will include the timestamp in the key/value map it builds,+  but that should not break anything really)+  > update: converted! --[[Joey]] ++Appending "timestamp=xxxxx" would be good for clarity, and make+it easier to parse the timestamp out from lines that have it.++> [[done]] --[[Joey]] 
+ doc/forum/location_tracking_cleanup.mdwn view
@@ -0,0 +1,24 @@+I recently started experimenting with git annex, adding files that I've had+floating across several computers to repositories. During the testing I had+a few occasions where I wrecked a repository somehow, and decided to wipe it+and start anew (at this point there was no important files in them so I thought+this is the easiest way). Well, as it turns out this interacts badly with location+tracking, since now `git annex whereis` shows files residing in all those destroyed+repositories, all having same names as some existing repositories. This makes it hard+to follow whether a repo actually has a file, or was the file only seen in some dead+repo with the same name.++I planned on cleaning this up by looking up the UUIDs of the now stable, existing+repos and untrusting all the dead copies (they should effectively disappear from+git annex´s output then, right?), but I didn't find an easy way to look up the UUID+of the current repository (maybe this could be included in `git annex status`?)+I also noticed that untrust cannot remove the trust based on the UUID -- if I try+it I simply get "there is no git remote named "11908472-...", so I guess untrust+works with git remote names, which I find a bit confusing, since trust.log logs the+trust levels based on the UUID. I could just write into trust.log manually, but I'm+unsure how the changes would get propagated.++What should I do? As a related wishlist item I would ask for some additional mechanisms+for purging known-dead repositories from the location tracking database. And the ability+to look up the UUID of the current repo, and to use the UUID to specify repositories when+applicable (untrust and describe maybe).
+ doc/forum/location_tracking_cleanup/comment_1_7d6319e8c94dfe998af9cfcbf170efb2._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="http://joey.kitenet.net/"+ nickname="joey"+ subject="comment 1"+ date="2011-09-30T06:55:34Z"+ content="""+Specifying the UUID was supposed to work, I think I broke it a while ago. Fixed now in git.++I'm not sure why you need to look up the UUID of the current repository. You can always refer to the current repository as \".\". Anyway, the UUID of the current repository is in `.git/config`, or use `git config annex.uuid`.+"""]]
+ doc/forum/location_tracking_cleanup/comment_2_e7395cb6e01f42da72adf71ea3ebcde4._comment view
@@ -0,0 +1,15 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawncBlzaDI248OZGjKQMXrLVQIx4XrZrzFo"+ nickname="Perttu"+ subject="comment 2"+ date="2011-09-30T11:55:35Z"+ content="""+Thanks for the quick reply :)++I wanted to look up the UUID of the current repo so that I can find out which repo is alive from the collection of repos with the same name.+I could have looked for it in .git/config though, since it's pretty obvious. I just looked into the git-annex branch and didn't find it there.+Thanks for the tip about using \".\". By the way, could there be some kind of warning about using non-unique names for repos? That would make this+scenario less likely. Or maybe that is a bad idea given the decentralized nature of git.++By the way, do the trust settings propagate to other repos? If I mark some UUID as untrusted on one computer does it become globally untrusted?+"""]]
+ doc/forum/location_tracking_cleanup/comment_3_c15428cec90e969284a5e690fb4b2fde._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="http://joey.kitenet.net/"+ nickname="joey"+ subject="comment 3"+ date="2011-09-30T16:47:27Z"+ content="""+`git annex status` now includes a list of all known repositories.++Yes, trust setting propigate on git push/pull like any other git-annex information.+"""]]
doc/forum/tips:_special__95__remotes__47__hook_with_tahoe-lafs.mdwn view
@@ -12,7 +12,7 @@ <pre> $ git annex whereis . whereis frink.jar (2 copies) -  	084603a8-7243-11e0-b1f5-83102bcd7953  -- testtest <-- here+  	084603a8-7243-11e0-b1f5-83102bcd7953  -- here (testtest)    	1d1bc312-7243-11e0-a9ce-5f10c0ce9b0a ok </pre>
doc/internals.mdwn view
@@ -42,10 +42,10 @@ a configured git remote pointing at it.  The file format is simply one line per repository, with the uuid followed by a-space and then the description through to the end of the line. Example:+space and then the description, followed by a timestamp. Example: -	e605dca6-446a-11e0-8b2a-002170d25c55 laptop-	26339d22-446b-11e0-9101-002170d25c55 usb disk+	e605dca6-446a-11e0-8b2a-002170d25c55 laptop timestamp=1317929189.157237s+	26339d22-446b-11e0-9101-002170d25c55 usb disk timestamp=1317929330.769997s  ## `remotes.log` @@ -54,7 +54,7 @@  The file format is one line per remote, starting with the uuid of the remote, followed by a space, and then a series of key=value pairs,-each separated by whitespace.+each separated by whitespace, and finally a timestamp.  ## `trust.log` @@ -62,13 +62,15 @@ [[trust]] values are configured.  The file format is one line per repository, with the uuid followed by a-space, and then either 1 (trusted), 0 (untrusted), or ? (semi-trusted).-Repositories not listed are semi-trusted.+space, and then either 1 (trusted), 0 (untrusted), or ? (semi-trusted),+and finally a timestamp.  Example: -	e605dca6-446a-11e0-8b2a-002170d25c55 1-	26339d22-446b-11e0-9101-002170d25c55 ?+	e605dca6-446a-11e0-8b2a-002170d25c55 1 timestamp=1317929189.157237s+	26339d22-446b-11e0-9101-002170d25c55 ? timestamp=1317929330.769997s++Repositories not listed are semi-trusted.  ## `aaa/bbb/*.log` 
− doc/news/version_3.20110819.mdwn
@@ -1,9 +0,0 @@-git-annex 3.20110819 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * 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](http://bugs.debian.org/638584)"""]]
+ doc/news/version_3.20111011.mdwn view
@@ -0,0 +1,30 @@+git-annex 3.20111011 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * This version of git-annex only works with git 1.7.7 and newer.+     The breakage with old versions is subtle, and affects the+     annex.numcopies settings in .gitattributes, so be sure to upgrade git+     to 1.7.7. (Debian package now depends on that version.)+   * Don't pass absolute paths to git show-attr, as it started following+     symlinks when that's done in 1.7.7. Instead, use relative paths,+     which show-attr only handles 100% correctly in 1.7.7. Closes: #[645046](http://bugs.debian.org/645046)+   * Fix referring to remotes by uuid.+   * New or changed repository descriptions in uuid.log now have a timestamp,+     which is used to ensure the newest description is used when the uuid.log+     has been merged.+   * Note that older versions of git-annex will display the timestamp as part+     of the repository description, which is ugly but otherwise harmless.+   * Add timestamps to trust.log and remote.log too.+   * git-annex-shell: Added the --uuid option.+   * git-annex now asks git-annex-shell to verify that it's operating in+     the expected repository.+   * Note that this git-annex will not interoperate with remotes using+     older versions of git-annex-shell.+   * Now supports git's insteadOf configuration, to modify the url+     used to access a remote. Note that pushInsteadOf is not used;+     that and pushurl are reserved for actual git pushes. Closes: #[644278](http://bugs.debian.org/644278)+   * status: List all known repositories.+   * When displaying a list of repositories, show git remote names+     in addition to their descriptions.+   * Add locking to avoid races when changing the git-annex branch.+   * Various speed improvements gained by using ByteStrings.+   * Contain the zombie hordes."""]]
doc/walkthrough/automatically_managing_content.mdwn view
@@ -13,7 +13,7 @@ 		0c443de8-e644-11df-acbf-f7cd7ca6210d  -- laptop 	whereis other_file (3 copies) 		0c443de8-e644-11df-acbf-f7cd7ca6210d  -- laptop-		62b39bbe-4149-11e0-af01-bb89245a1e61  -- usb drive <-- here+		62b39bbe-4149-11e0-af01-bb89245a1e61  -- here (usb drive) 		7570b02e-15e9-11e0-adf0-9f3f94cb2eaa  -- backup drive  What would be handy is some automated versions of get and drop, that only@@ -31,7 +31,7 @@ 	# git annex whereis 	whereis my_cool_big_file (2 copies) 		0c443de8-e644-11df-acbf-f7cd7ca6210d  -- laptop-		62b39bbe-4149-11e0-af01-bb89245a1e61  -- usb drive <-- here+		62b39bbe-4149-11e0-af01-bb89245a1e61  -- here (usb drive) 	whereis other_file (2 copies) 		0c443de8-e644-11df-acbf-f7cd7ca6210d  -- laptop 		7570b02e-15e9-11e0-adf0-9f3f94cb2eaa  -- backup drive
git-annex-shell.hs view
@@ -6,14 +6,14 @@  -}  import System.Environment-import Data.List+import System.Console.GetOpt +import Common.Annex import qualified Git import CmdLine import Command-import Utility.Conditional-import Utility.SafeCommand import Options+import UUID  import qualified Command.ConfigList import qualified Command.InAnnex@@ -32,6 +32,16 @@ 	where 		adddirparam c = c { cmdparams = "DIRECTORY " ++ cmdparams c } +options :: [OptDescr (Annex ())]+options = uuid : commonOptions+	where+		uuid = Option [] ["uuid"] (ReqArg check paramUUID) "repository uuid"+		check expected = do+			u <- getUUID+			when (u /= expected) $ error $+				"expected repository UUID " ++ expected+					++ " but found UUID " ++ u+ header :: String header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]" @@ -59,7 +69,7 @@ builtin :: String -> String -> [String] -> IO () builtin cmd dir params = 	Git.repoAbsPath dir >>= Git.repoFromAbsPath >>=-		dispatch (cmd : filterparams params) cmds commonOptions header+		dispatch (cmd : filterparams params) cmds options header  external :: [String] -> IO () external params =@@ -74,4 +84,4 @@ filterparams (a:as) = a:filterparams as  failure :: IO ()-failure = error $ "bad parameters\n\n" ++ usage header cmds commonOptions+failure = error $ "bad parameters\n\n" ++ usage header cmds options
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 3.20110928+Version: 3.20111011 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net>@@ -7,7 +7,7 @@ Stability: Stable Copyright: 2010-2011 Joey Hess License-File: GPL-Extra-Source-Files: ./debian/NEWS ./debian/control ./debian/rules ./debian/manpages ./debian/changelog ./debian/doc-base ./debian/copyright ./debian/compat ./Messages/JSON.hs ./AnnexQueue.hs ./configure.hs ./Annex.hs ./PresenceLog.hs ./Version.hs ./Crypto.hs ./RemoteLog.hs ./README ./Command/Merge.hs ./Command/AddUrl.hs ./Command/Whereis.hs ./Command/Unlock.hs ./Command/Version.hs ./Command/FromKey.hs ./Command/PreCommit.hs ./Command/Map.hs ./Command/Unused.hs ./Command/Uninit.hs ./Command/Migrate.hs ./Command/Init.hs ./Command/ConfigList.hs ./Command/Trust.hs ./Command/Lock.hs ./Command/SendKey.hs ./Command/RecvKey.hs ./Command/Add.hs ./Command/Fix.hs ./Command/Untrust.hs ./Command/InitRemote.hs ./Command/Semitrust.hs ./Command/Fsck.hs ./Command/Move.hs ./Command/DropUnused.hs ./Command/Get.hs ./Command/Upgrade.hs ./Command/Describe.hs ./Command/Drop.hs ./Command/DropKey.hs ./Command/InAnnex.hs ./Command/Find.hs ./Command/Unannex.hs ./Command/Status.hs ./Command/Copy.hs ./Command/SetKey.hs ./Init.hs ./Types.hs ./Trust.hs ./Makefile ./CatFile.hs ./git-annex.cabal ./Upgrade/V1.hs ./Upgrade/V2.hs ./Upgrade/V0.hs ./LocationLog.hs ./CHANGELOG ./Git/LsFiles.hs ./Git/UnionMerge.hs ./Git/CatFile.hs ./Git/Queue.hs ./Git/LsTree.hs ./Branch.hs ./doc/upgrades.mdwn ./doc/forum/wishlist:_define_remotes_that_must_have_all_files.mdwn ./doc/forum/Will_git_annex_work_on_a_FAT32_formatted_key__63__.mdwn ./doc/forum/wishlist:_command_options_changes/comment_2_f6a637c78c989382e3c22d41b7fb4cc2._comment ./doc/forum/wishlist:_command_options_changes/comment_3_bf1114533d2895804e531e76eb6b8095._comment ./doc/forum/wishlist:_command_options_changes/comment_1_bfba72a696789bf21b2435dea15f967a._comment ./doc/forum/wishlist:_git-annex_replicate/comment_3_c13f4f9c3d5884fc6255fd04feadc2b1._comment ./doc/forum/wishlist:_git-annex_replicate/comment_1_9926132ec6052760cdf28518a24e2358._comment ./doc/forum/wishlist:_git-annex_replicate/comment_2_c43932f4194aba8fb2470b18e0817599._comment ./doc/forum/wishlist:_git-annex_replicate/comment_4_63f24abf086d644dced8b01e1a9948c9._comment ./doc/forum/Behaviour_of_fsck/comment_4_e4911dc6793f98fb81151daacbe49968._comment ./doc/forum/Behaviour_of_fsck/comment_3_97848f9a3db89c0427cfb671ba13300e._comment ./doc/forum/Behaviour_of_fsck/comment_2_ead36a23c3e6efa1c41e4555f93e014e._comment ./doc/forum/Behaviour_of_fsck/comment_1_0e40f158b3f4ccdcaab1408d858b68b8._comment ./doc/forum/incompatible_versions__63__/comment_1_629f28258746d413e452cbd42a1a43f4._comment ./doc/forum/migration_to_git-annex_and_rsync.mdwn ./doc/forum/hashing_objects_directories.mdwn ./doc/forum/hashing_objects_directories/comment_5_ef6cfd49d24c180c2d0a062e5bd3a0be._comment ./doc/forum/hashing_objects_directories/comment_1_c55c56076be4f54251b0b7f79f28a607._comment ./doc/forum/hashing_objects_directories/comment_2_504c96959c779176f991f4125ea22009._comment ./doc/forum/hashing_objects_directories/comment_3_9134bde0a13aac0b6a4e5ebabd7f22e8._comment ./doc/forum/hashing_objects_directories/comment_4_0de9170e429cbfea66f5afa8980d45ac._comment ./doc/forum/wishlist:_support_for_more_ssh_urls_.mdwn ./doc/forum/Wishlist:_Ways_of_selecting_files_based_on_meta-information.mdwn ./doc/forum/git-annex_on_OSX.mdwn ./doc/forum/version_3_upgrade/comment_1_05fc9c9cad26c520bebb98c852c71e35._comment ./doc/forum/example_of_massively_disconnected_operation.mdwn ./doc/forum/git-annex_communication_channels/comment_2_c7aeefa6ef9a2e75d8667b479ade1b7f._comment ./doc/forum/git-annex_communication_channels/comment_5_404b723a681eb93fee015cea8024b6bc._comment ./doc/forum/git-annex_communication_channels/comment_1_198325d2e9337c90f026396de89eec0e._comment ./doc/forum/git-annex_communication_channels/comment_4_1ba6ddf54843c17c7d19a9996f2ab712._comment ./doc/forum/git-annex_communication_channels/comment_6_0d87d0e26461494b1d7f8a701a924729._comment ./doc/forum/git-annex_communication_channels/comment_3_1ff08a3e0e63fa0e560cbc9602245caa._comment ./doc/forum/git-annex_communication_channels/comment_7_2c87c7a0648fe87c2bf6b4391f1cc468._comment ./doc/forum/wishlist:_git-annex_replicate.mdwn ./doc/forum/advantages_of_SHA__42___over_WORM/comment_1_96c354cac4b5ce5cf6664943bc84db1d._comment ./doc/forum/performance_improvement:_git_on_ssd__44___annex_on_spindle_disk.mdwn ./doc/forum/Behaviour_of_fsck.mdwn ./doc/forum/working_without_git-annex_commits.mdwn ./doc/forum/migrate_existing_git_repository_to_git-annex.mdwn ./doc/forum/__34__git_annex_lock__34___very_slow_for_big_repo.mdwn ./doc/forum/wishlist:_traffic_accounting_for_git-annex.mdwn ./doc/forum/rsync_over_ssh__63__.mdwn ./doc/forum/unannex_alternatives/comment_3_b1687fc8f9e7744327bbeb6f0635d1cd._comment ./doc/forum/unannex_alternatives/comment_1_dcd4cd41280b41512bbdffafaf307993._comment ./doc/forum/unannex_alternatives/comment_2_58a72a9fe0f58c7af0b4d7927a2dd21d._comment ./doc/forum/wishlist:_git_annex_status/comment_4_9aeeb83d202dc8fb33ff364b0705ad94._comment ./doc/forum/wishlist:_git_annex_status/comment_3_d1fd70c67243971c96d59e1ffb7ef6e7._comment ./doc/forum/wishlist:_git_annex_status/comment_2_c2b0ce025805b774dc77ce264a222824._comment ./doc/forum/wishlist:_git_annex_status/comment_1_994bfd12c5d82e08040d6116915c5090._comment ./doc/forum/wishlist:_command_options_changes.mdwn ./doc/forum/new_microfeatures/comment_2_41ad904c68e89c85e1fc49c9e9106969._comment ./doc/forum/new_microfeatures/comment_1_058bd517c6fffaf3446b1f5d5be63623._comment ./doc/forum/new_microfeatures/comment_3_a1a9347b5bc517f2a89a8b292c3f8517._comment ./doc/forum/new_microfeatures/comment_7_94045b9078b1fff877933b012d1b49e2._comment ./doc/forum/new_microfeatures/comment_5_3c627d275586ff499d928a8f8136babf._comment ./doc/forum/new_microfeatures/comment_4_5a6786dc52382fff5cc42fdb05770196._comment ./doc/forum/new_microfeatures/comment_6_31ea08c008500560c0b96c6601bc6362._comment ./doc/forum/Error_while_adding_a_file___34__createSymbolicLink:_already_exists__34__.mdwn ./doc/forum/advantages_of_SHA__42___over_WORM.mdwn ./doc/forum/wishlist:_git_annex_put_--_same_as_get__44___but_for_defaults.mdwn ./doc/forum/OSX__39__s_default_sshd_behaviour_has_limited_paths_set.mdwn ./doc/forum/bainstorming:_git_annex_push___38___pull.mdwn ./doc/forum/sparse_git_checkouts_with_annex.mdwn ./doc/forum/Need_new_build_instructions_for_Debian_stable.mdwn ./doc/forum/batch_check_on_remote_when_using_copy.mdwn ./doc/forum/tips:_special__95__remotes__47__hook_with_tahoe-lafs.mdwn ./doc/forum/wishlist:alias_system.mdwn ./doc/forum/incompatible_versions__63__.mdwn ./doc/forum/wishlist:_git_backend_for_git-annex.mdwn ./doc/forum/seems_to_build_fine_on_haskell_platform_2011.mdwn ./doc/forum/rsync_over_ssh__63__/comment_1_ee21f32e90303e20339e0a568321bbbe._comment ./doc/forum/rsync_over_ssh__63__/comment_2_aa690da6ecfb2b30fc5080ad76dc77b1._comment ./doc/forum/wishlist:_special_remote_for_sftp_or_rsync.mdwn ./doc/forum/OSX__39__s_haskell-platform_statically_links_things.mdwn ./doc/forum/unannex_alternatives.mdwn ./doc/forum/can_git-annex_replace_ddm__63__.mdwn ./doc/forum/sparse_git_checkouts_with_annex/comment_2_e357db3ccc4079f07a291843975535eb._comment ./doc/forum/sparse_git_checkouts_with_annex/comment_1_c7dc199c5740a0e7ba606dfb5e3e579a._comment ./doc/forum/sparse_git_checkouts_with_annex/comment_3_fcfafca994194d57dccf5319c7c9e646._comment ./doc/forum/sparse_git_checkouts_with_annex/comment_4_04dc14880f31eee2b6d767d4d4258c5a._comment ./doc/forum/git-annex_communication_channels.mdwn ./doc/forum/can_git-annex_replace_ddm__63__/comment_3_4c69097fe2ee81359655e59a03a9bb8d._comment ./doc/forum/can_git-annex_replace_ddm__63__/comment_2_008554306dd082d7f543baf283510e92._comment ./doc/forum/can_git-annex_replace_ddm__63__/comment_1_aa05008dfe800474ff76678a400099e1._comment ./doc/forum/version_3_upgrade.mdwn ./doc/forum/relying_on_git_for_numcopies/comment_3_43d8e1513eb9947f8a503f094c03f307._comment ./doc/forum/relying_on_git_for_numcopies/comment_2_be6acbc26008a9cb54e7b8f498f2c2a2._comment ./doc/forum/relying_on_git_for_numcopies/comment_1_8ad3cccd7f66f6423341d71241ba89fc._comment ./doc/forum/relying_on_git_for_numcopies.mdwn ./doc/forum/wishlist:_do_round_robin_downloading_of_data.mdwn ./doc/forum/wishlist:_git_annex_status.mdwn ./doc/forum/getting_git_annex_to_do_a_force_copy_to_a_remote.mdwn ./doc/forum/Problems_with_large_numbers_of_files.mdwn ./doc/forum/Can_I_store_normal_files_in_the_git-annex_git_repository__63__.mdwn ./doc/forum/Is_an_automagic_upgrade_of_the_object_directory_safe__63__.mdwn ./doc/forum/wishlist:_push_to_cia.vc_from_the_website__39__s_repo__44___not_your_personal_one.mdwn ./doc/forum/new_microfeatures.mdwn ./doc/backends.mdwn ./doc/bugs/__39__annex_add__39___fails_to___39__git_add__39___for_parent_relative_path.mdwn ./doc/bugs/softlink_mtime.mdwn ./doc/bugs/ordering.mdwn ./doc/bugs/dropping_files_with_a_URL_backend_fails.mdwn ./doc/bugs/fsck__47__fix_should_check__47__fix_the_permissions_of_.git__47__annex.mdwn ./doc/bugs/add_script-friendly_output_options.mdwn ./doc/bugs/git_annex_get_choke_when_remote_is_an_ssh_url_with_a_port.mdwn ./doc/bugs/unannex_and_uninit_do_not_work_when_git_index_is_broken.mdwn ./doc/bugs/git_annex_migrate_leaves_old_backend_versions_around.mdwn ./doc/bugs/git_annex_unused_failes_on_empty_repository.mdwn ./doc/bugs/git_annex_add_eats_files_when_filename_is_too_long.mdwn ./doc/bugs/S3_bucket_uses_the_same_key_for_encryption_and_hashing.mdwn ./doc/bugs/problem_with_upgrade_v2_-__62___v3.mdwn ./doc/bugs/git_annex_copy_--fast_does_not_copy_files.mdwn ./doc/bugs/Cabal_dependency_monadIO_missing.mdwn ./doc/bugs/dotdot_problem.mdwn ./doc/bugs/Problems_running_make_on_osx.mdwn ./doc/bugs/free_space_checking/comment_2_8a65f6d3dcf5baa3f7f2dbe1346e2615._comment ./doc/bugs/free_space_checking/comment_3_0fc6ff79a357b1619d13018ccacc7c10._comment ./doc/bugs/free_space_checking/comment_1_a868e805be43c5a7c19c41f1af8e41e6._comment ./doc/bugs/done.mdwn ./doc/bugs/git_annex_copy_-f_REMOTE_._doesn__39__t_work_as_expected.mdwn ./doc/bugs/Displayed_copy_speed_is_wrong/comment_2_8b240de1d5ae9229fa2d77d1cc15a552._comment ./doc/bugs/Displayed_copy_speed_is_wrong/comment_1_74de3091e8bfd7acd6795e61f39f07c6._comment ./doc/bugs/Build_error_on_Mac_OSX_10.6.mdwn ./doc/bugs/bare_git_repos.mdwn ./doc/bugs/fat_support.mdwn ./doc/bugs/problems_with_utf8_names.mdwn ./doc/bugs/error_with_file_names_starting_with_dash.mdwn ./doc/bugs/unhappy_without_UTF8_locale.mdwn ./doc/bugs/S3_memory_leaks.mdwn ./doc/bugs/upgrade_left_untracked_.git-annex__47____42___directories.mdwn ./doc/bugs/--git-dir_and_--work-tree_options.mdwn ./doc/bugs/Problems_running_make_on_osx/comment_9_cc283b485b3c95ba7eebc8f0c96969b3._comment ./doc/bugs/Problems_running_make_on_osx/comment_4_c52be386f79f14c8570a8f1397c68581._comment ./doc/bugs/Problems_running_make_on_osx/comment_18_64fab50d95de619eb2e8f08f90237de1._comment ./doc/bugs/Problems_running_make_on_osx/comment_16_5c2dd6002aadaab30841b77a5f5aed34._comment ./doc/bugs/Problems_running_make_on_osx/comment_10_94e4ac430140042a2d0fb5a16d86b4e5._comment ./doc/bugs/Problems_running_make_on_osx/comment_15_6b8867b8e48bf807c955779c9f8f0909._comment ./doc/bugs/Problems_running_make_on_osx/comment_11_56f1143fa191361d63b441741699e17f._comment ./doc/bugs/Problems_running_make_on_osx/comment_20_7db27d1a22666c831848bc6c06d66a84._comment ./doc/bugs/Problems_running_make_on_osx/comment_12_ec5131624d0d2285d3b6880e47033f97._comment ./doc/bugs/Problems_running_make_on_osx/comment_3_68f0f8ae953589ae26d57310b40c878d._comment ./doc/bugs/Problems_running_make_on_osx/comment_14_89a960b6706ed703b390a81a8bc4e311._comment ./doc/bugs/Problems_running_make_on_osx/comment_17_62fccb04b0e4b695312f7a3f32fb96ee._comment ./doc/bugs/Problems_running_make_on_osx/comment_19_4253988ed178054c8b6400beeed68a29._comment ./doc/bugs/Problems_running_make_on_osx/comment_6_0c46f5165ceb5a7b9ea9689c33b3a4f8._comment ./doc/bugs/Problems_running_make_on_osx/comment_1_34120e82331ace01a6a4960862d38f2d._comment ./doc/bugs/Problems_running_make_on_osx/comment_7_237a137cce58a28abcc736cbf2c420b0._comment ./doc/bugs/Problems_running_make_on_osx/comment_5_7f1330a1e541b0f3e2192e596d7f7bee._comment ./doc/bugs/Problems_running_make_on_osx/comment_2_cc53d1681d576186dbc868dd9801d551._comment ./doc/bugs/Problems_running_make_on_osx/comment_13_88ed095a448096bf8a69015a04e64df1._comment ./doc/bugs/Problems_running_make_on_osx/comment_8_efafa203addf8fa79e33e21a87fb5a2b._comment ./doc/bugs/git-annex_directory_hashing_problems_on_osx.mdwn ./doc/bugs/No_easy_way_to_re-inject_a_file_into_an_annex.mdwn ./doc/bugs/git_annex_unlock_is_not_atomic.mdwn ./doc/bugs/free_space_checking.mdwn ./doc/bugs/wishlist:_more_descriptive_commit_messages_in_git-annex_branch.mdwn ./doc/bugs/Displayed_copy_speed_is_wrong.mdwn ./doc/bugs/git_annex_should_use___39__git_add_-f__39___internally.mdwn ./doc/bugs/minor_bug:_errors_are_not_verbose_enough.mdwn ./doc/bugs/No_version_information_from_cli.mdwn ./doc/bugs/Error_while_adding_a_file___34__createSymbolicLink:_already_exists__34__.mdwn ./doc/bugs/tests_fail_when_there_is_no_global_.gitconfig_for_the_user.mdwn ./doc/bugs/git_annex_initremote_walks_.git-annex.mdwn ./doc/bugs/git-annex_incorrectly_parses_bare_IPv6_addresses.mdwn ./doc/bugs/conflicting_haskell_packages/comment_1_e552a6cc6d7d1882e14130edfc2d6b3b._comment ./doc/bugs/tmp_file_handling.mdwn ./doc/bugs/annex_add_in_annex.mdwn ./doc/bugs/making_annex-merge_try_a_fast-forward.mdwn ./doc/bugs/Makefile_is_missing_dependancies.mdwn ./doc/bugs/test_suite_shouldn__39__t_fail_silently.mdwn ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_4_91439d4dbbf1461e281b276eb0003691._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_6_f360f0006bc9115bc5a3e2eb9fe58abd._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_3_86d9e7244ae492bcbe62720b8c4fc4a9._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_2_cd0123392b16d89db41b45464165c247._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_1_5f60006c9bb095167d817f234a14d20b._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_5_ca33a9ca0df33f7c1b58353d7ffb943d._comment ./doc/bugs/git_rename_detection_on_file_move/comment_3_57010bcaca42089b451ad8659a1e018e._comment ./doc/bugs/git_rename_detection_on_file_move/comment_4_79d96599f757757f34d7b784e6c0e81c._comment ./doc/bugs/git_rename_detection_on_file_move/comment_5_d61f5693d947b9736b29fca1dbc7ad76._comment ./doc/bugs/git_rename_detection_on_file_move/comment_2_7101d07400ad5935f880dc00d89bf90e._comment ./doc/bugs/git_rename_detection_on_file_move/comment_1_0531dcfa833b0321a7009526efe3df33._comment ./doc/bugs/add_range_argument_to___34__git_annex_dropunused__34___.mdwn ./doc/bugs/git_rename_detection_on_file_move.mdwn ./doc/bugs/problem_commit_normal_links.mdwn ./doc/bugs/git_annex_unused_seems_to_check_for_current_path.mdwn ./doc/bugs/Makefile_is_missing_dependancies/comment_6_24119fc5d5963ce9dd669f7dcf006859._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_3_c38b6f4abc9b9ad413c3b83ca04386c3._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_8_a3555e3286cdc2bfeb9cde0ff727ba74._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_2_416f12dbd0c2b841fac8164645b81df5._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_5_0a1c52e2c96d19b9c3eb7e99b8c2434f._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_7_96fd4725df4b54e670077a18d3ac4943._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_1_5a3da5f79c8563c7a450aa29728abe7c._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_4_cc13873175edf191047282700315beee._comment ./doc/bugs/touch.hsc_has_problems_on_non-linux_based_systems.mdwn ./doc/bugs/build_issue_with_latest_release_0.20110522-1-gde817ba.mdwn ./doc/bugs/weird_local_clone_confuses.mdwn ./doc/bugs/fsck_output.mdwn ./doc/bugs/git-annex_has_issues_with_git_when_staging__47__commiting_logs.mdwn ./doc/bugs/git_annex_gets_confused_about_remotes_with_dots_in_their_names.mdwn ./doc/bugs/unannex_vs_unlock_hook_confusion.mdwn ./doc/bugs/Cabal_dependency_monadIO_missing/comment_2_4f4d8e1e00a2a4f7e8a8ab082e16adac._comment ./doc/bugs/Cabal_dependency_monadIO_missing/comment_1_14be660aa57fadec0d81b32a8b52c66f._comment ./doc/bugs/conflicting_haskell_packages.mdwn ./doc/bugs/git_command_line_constructed_by_unannex_command_has_tons_of_redundant_-a_paramters.mdwn ./doc/bugs/backend_version_upgrade_leaves_repo_unusable.mdwn ./doc/bugs/fat_support/comment_3_df3b943bc1081a8f3f7434ae0c8e061e._comment ./doc/bugs/fat_support/comment_4_90a8a15bedd94480945a374f9d706b86._comment ./doc/bugs/fat_support/comment_5_64bbf89de0836673224b83fdefa0407b._comment ./doc/bugs/fat_support/comment_1_04bcc4795d431e8cb32293aab29bbfe2._comment ./doc/bugs/fat_support/comment_2_bb4a97ebadb5c53809fc78431eabd7c8._comment ./doc/bugs/unannex_command_doesn__39__t_all_files.mdwn ./doc/bugs/annex_unannex__47__uninit_should_handle_copies.mdwn ./doc/bugs/git_annex_fsck_is_a_no-op_in_bare_repos.mdwn ./doc/bugs/Unfortunate_interaction_with_Calibre.mdwn ./doc/bugs/error_propigation.mdwn ./doc/bugs/scp_interrupt_to_background.mdwn ./doc/bugs/copy_fast_confusing_with_broken_locationlog.mdwn ./doc/bugs/configure_script_should_detect_uuidgen_instead_of_just_uuid.mdwn ./doc/bugs/check_for_curl_in_configure.hs.mdwn ./doc/bugs/Name_scheme_does_not_follow_git__39__s_rules.mdwn ./doc/bugs/Prevent_accidental_merges.mdwn ./doc/bugs/building_on_lenny.mdwn ./doc/bugs/encrypted_S3_stalls.mdwn ./doc/bugs/support_bare_git_repo__44___with_the_annex_directory_exposed_to_http.mdwn ./doc/bugs/WORM:_Handle_long_filenames_correctly.mdwn ./doc/logo_small.png ./doc/cheatsheet.mdwn ./doc/use_case/Bob.mdwn ./doc/use_case/Alice.mdwn ./doc/upgrades/SHA_size.mdwn ./doc/news/sharebox_a_FUSE_filesystem_for_git-annex.mdwn ./doc/news/version_3.20110902.mdwn ./doc/news/version_3.20110906.mdwn ./doc/news/LWN_article.mdwn ./doc/news/version_3.20110928.mdwn ./doc/news/version_3.20110915.mdwn ./doc/news/version_3.20110819.mdwn ./doc/git-union-merge.mdwn ./doc/special_remotes/S3.mdwn ./doc/special_remotes/web.mdwn ./doc/special_remotes/bup.mdwn ./doc/special_remotes/directory.mdwn ./doc/special_remotes/hook.mdwn ./doc/special_remotes/rsync.mdwn ./doc/users/joey.mdwn ./doc/users/fmarier.mdwn ./doc/users/chrysn.mdwn ./doc/templates/walkthrough.tmpl ./doc/templates/bare.tmpl ./doc/index.mdwn ./doc/summary.mdwn ./doc/forum.mdwn ./doc/encryption/comment_1_1afca8d7182075d46db41f6ad3dd5911._comment ./doc/transferring_data.mdwn ./doc/download.mdwn ./doc/future_proofing.mdwn ./doc/todo/auto_remotes/discussion.mdwn ./doc/todo/file_copy_progress_bar.mdwn ./doc/todo/use_cp_reflink.mdwn ./doc/todo/gitrm.mdwn ./doc/todo/exclude_files_on_a_given_remote.mdwn ./doc/todo/git-annex_unused_eats_memory.mdwn ./doc/todo/add_--exclude_option_to_git_annex_find.mdwn ./doc/todo/tahoe_lfs_for_reals/comment_2_80b9e848edfdc7be21baab7d0cef0e3a._comment ./doc/todo/tahoe_lfs_for_reals/comment_1_0a4793ce6a867638f6e510e71dd4bb44._comment ./doc/todo/object_dir_reorg_v2.mdwn ./doc/todo/S3.mdwn ./doc/todo/auto_remotes.mdwn ./doc/todo/wishlist:_support_for_more_ssh_urls_.mdwn ./doc/todo/support-non-utf8-locales.mdwn ./doc/todo/done.mdwn ./doc/todo/fsck.mdwn ./doc/todo/support_S3_multipart_uploads.mdwn ./doc/todo/wishlist:_Provide_a___34__git_annex__34___command_that_will_skip_duplicates.mdwn ./doc/todo/pushpull.mdwn ./doc/todo/smudge.mdwn ./doc/todo/cache_key_info/comment_1_578df1b3b2cbfdc4aa1805378f35dc48._comment ./doc/todo/object_dir_reorg_v2/comment_3_79bdf9c51dec9f52372ce95b53233bb2._comment ./doc/todo/object_dir_reorg_v2/comment_7_42501404c82ca07147e2cce0cff59474._comment ./doc/todo/object_dir_reorg_v2/comment_5_821c382987f105da72a50e0a5ce61fdc._comment ./doc/todo/object_dir_reorg_v2/comment_1_ba03333dc76ff49eccaba375e68cb525._comment ./doc/todo/object_dir_reorg_v2/comment_2_81276ac309959dc741bc90101c213ab7._comment ./doc/todo/object_dir_reorg_v2/comment_6_8834c3a3f1258c4349d23aff8549bf35._comment ./doc/todo/object_dir_reorg_v2/comment_4_93aada9b1680fed56cc6f0f7c3aca5e5._comment ./doc/todo/union_mounting.mdwn ./doc/todo/wishlist:_swift_backend.mdwn ./doc/todo/wishlist:_swift_backend/comment_1_e6efbb35f61ee521b473a92674036788._comment ./doc/todo/wishlist:_swift_backend/comment_2_5d8c83b0485112e98367b7abaab3f4e3._comment ./doc/todo/git_annex_init_:_include_repo_description_and__47__or_UUID_in_commit_message.mdwn ./doc/todo/wishlist:___34__git_annex_add__34___multiple_processes.mdwn ./doc/todo/hidden_files.mdwn ./doc/todo/smudge/comment_1_4ea616bcdbc9e9a6fae9f2e2795c31c9._comment ./doc/todo/smudge/comment_2_e04b32caa0d2b4c577cdaf382a3ff7f6._comment ./doc/todo/network_remotes.mdwn ./doc/todo/add_a_git_backend.mdwn ./doc/todo/parallel_possibilities/comment_1_d8e34fc2bc4e5cf761574608f970d496._comment ./doc/todo/parallel_possibilities/comment_2_adb76f06a7997abe4559d3169a3181c3._comment ./doc/todo/checkout.mdwn ./doc/todo/immutable_annexed_files.mdwn ./doc/todo/wishlist:_Prevent_repeated_password_prompts_for_one_command.mdwn ./doc/todo/git-annex-shell.mdwn ./doc/todo/speed_up_fsck.mdwn ./doc/todo/tahoe_lfs_for_reals.mdwn ./doc/todo/using_url_backend.mdwn ./doc/todo/branching.mdwn ./doc/todo/rsync.mdwn ./doc/todo/backendSHA1.mdwn ./doc/todo/cache_key_info.mdwn ./doc/todo/parallel_possibilities.mdwn ./doc/todo/symlink_farming_commit_hook.mdwn ./doc/feeds.mdwn ./doc/copies.mdwn ./doc/repomap.png ./doc/special_remotes.mdwn ./doc/todo.mdwn ./doc/walkthrough/using_ssh_remotes.mdwn ./doc/walkthrough/untrusted_repositories.mdwn ./doc/walkthrough/automatically_managing_content.mdwn ./doc/walkthrough/removing_files/comment_1_cb65e7c510b75be1c51f655b058667c6._comment ./doc/walkthrough/removing_files/comment_2_64709ea4558915edd5c8ca4486965b07._comment ./doc/walkthrough/moving_file_content_between_repositories.mdwn ./doc/walkthrough/modifying_annexed_files.mdwn ./doc/walkthrough/Internet_Archive_via_S3.mdwn ./doc/walkthrough/more.mdwn ./doc/walkthrough/removing_files.mdwn ./doc/walkthrough/creating_a_repository.mdwn ./doc/walkthrough/what_to_do_when_you_lose_a_repository.mdwn ./doc/walkthrough/using_Amazon_S3.mdwn ./doc/walkthrough/adding_a_remote.mdwn ./doc/walkthrough/adding_a_remote/comment_1_0a59355bd33a796aec97173607e6adc9._comment ./doc/walkthrough/adding_a_remote/comment_2_f8cd79ef1593a8181a7f1086a87713e8._comment ./doc/walkthrough/adding_a_remote/comment_3_60691af4400521b5a8c8d75efe3b44cb._comment ./doc/walkthrough/adding_a_remote/comment_4_6f7cf5c330272c96b3abeb6612075c9d._comment ./doc/walkthrough/powerful_file_matching.mdwn ./doc/walkthrough/removing_files:_When_things_go_wrong.mdwn ./doc/walkthrough/renaming_files.mdwn ./doc/walkthrough/using_bup.mdwn ./doc/walkthrough/fsck:_when_things_go_wrong.mdwn ./doc/walkthrough/adding_files.mdwn ./doc/walkthrough/unused_data.mdwn ./doc/walkthrough/fsck:_verifying_your_data.mdwn ./doc/walkthrough/getting_file_content.mdwn ./doc/walkthrough/using_the_web.mdwn ./doc/walkthrough/recover_data_from_lost+found.mdwn ./doc/walkthrough/backups.mdwn ./doc/walkthrough/transferring_files:_When_things_go_wrong.mdwn ./doc/walkthrough/using_the_SHA1_backend.mdwn ./doc/walkthrough/migrating_data_to_a_new_backend.mdwn ./doc/GPL ./doc/logo.png ./doc/location_tracking.mdwn ./doc/design.mdwn ./doc/news.mdwn ./doc/encryption.mdwn ./doc/not.mdwn ./doc/download/comment_7_a5eebd214b135f34b18274a682211943._comment ./doc/download/comment_3_cf6044ebe99f71158034e21197228abd._comment ./doc/download/comment_5_c6b1bc40226fc2c8ba3e558150856992._comment ./doc/download/comment_6_3a52993d3553deb9a413debec9a5f92d._comment ./doc/download/comment_2_f85f72b33aedc3425f0c0c47867d02f3._comment ./doc/download/comment_8_59a976de6c7d333709b92f7cd5830850._comment ./doc/download/comment_4_10fc013865c7542c2ed9d6c0963bb391._comment ./doc/download/comment_1_fbd8b6d39e9d3c71791551358c863966._comment ./doc/contact.mdwn ./doc/trust.mdwn ./doc/bare_repositories.mdwn ./doc/distributed_version_control.mdwn ./doc/install.mdwn ./doc/git-annex-shell.mdwn ./doc/bugs.mdwn ./doc/design/encryption/comment_2_a610b3d056a059899178859a3a821ea5._comment ./doc/design/encryption/comment_3_cca186a9536cd3f6e86994631b14231c._comment ./doc/design/encryption/comment_1_4715ffafb3c4a9915bc33f2b26aaa9c1._comment ./doc/design/encryption/comment_4_8f3ba3e504b058791fc6e6f9c38154cf._comment ./doc/design/encryption.mdwn ./doc/comments.mdwn ./doc/git-annex.mdwn ./doc/internals.mdwn ./doc/users.mdwn ./doc/install/Ubuntu.mdwn ./doc/install/Debian.mdwn ./doc/install/OSX.mdwn ./doc/install/FreeBSD.mdwn ./doc/install/OSX/comment_1_0a1760bf0db1f1ba89bdb4c62032f631._comment ./doc/install/comment_3_cff163ea3e7cad926f4ed9e78b896598._comment ./doc/install/Debian/comment_2_648e3467e260cdf233acdb0b53313ce0._comment ./doc/install/Debian/comment_1_029486088d098c2d4f1099f2f0e701a9._comment ./doc/install/Fedora.mdwn ./doc/install/comment_4_82a17eee4a076c6c79fddeda347e0c9a._comment ./doc/walkthrough.mdwn ./CmdLine.hs ./UUID.hs ./Messages.hs ./Setup.hs ./GPL ./mdwn2man ./Remote.hs ./git-annex.hs ./Locations.hs ./Backend/WORM.hs ./Backend/URL.hs ./Backend/SHA.hs ./Options.hs ./git-annex-shell.hs ./test.hs ./INSTALL ./Remote/Web.hs ./Remote/S3stub.hs ./Remote/Helper/Encryptable.hs ./Remote/Helper/Special.hs ./Remote/Directory.hs ./Remote/S3real.hs ./Remote/Bup.hs ./Remote/Hook.hs ./Remote/Rsync.hs ./Remote/Git.hs ./Utility.hs ./Build/TestConfig.hs ./Upgrade.hs ./git-union-merge.hs ./Utility/Path.hs ./Utility/Matcher.hs ./Utility/Url.hs ./Utility/DataUnits.hs ./Utility/StatFS.hsc ./Utility/Conditional.hs ./Utility/Ssh.hs ./Utility/RsyncFile.hs ./Utility/CopyFile.hs ./Utility/SafeCommand.hs ./Utility/FileMode.hs ./Utility/JSONStream.hs ./Utility/Dot.hs ./Utility/Touch.hsc ./Utility/Base64.hs ./Types/Crypto.hs ./Types/UUID.hs ./Types/TrustLevel.hs ./Types/Remote.hs ./Types/BranchState.hs ./Types/Backend.hs ./Types/Key.hs ./Config.hs ./Command.hs ./.gitignore ./Backend.hs ./Content.hs ./.gitattributes ./Git.hs ./Limit.hs ./GitAnnex.hs+Extra-Source-Files: ./Git/UnionMerge.hs ./Git/LsTree.hs ./Git/LsFiles.hs ./Git/CatFile.hs ./Git/Queue.hs ./PresenceLog.hs ./Common/Annex.hs ./.gitignore ./Upgrade/V2.hs ./Upgrade/V1.hs ./Upgrade/V0.hs ./Command.hs ./test.hs ./configure.hs ./LocationLog.hs ./Limit.hs ./RemoteLog.hs ./Annex.hs ./Remote/S3real.hs ./Remote/Web.hs ./Remote/Rsync.hs ./Remote/Helper/Special.hs ./Remote/Helper/Encryptable.hs ./Remote/Hook.hs ./Remote/Git.hs ./Remote/Bup.hs ./Remote/Directory.hs ./Remote/S3stub.hs ./mdwn2man ./Makefile ./Backend/URL.hs ./Backend/SHA.hs ./Backend/WORM.hs ./CHANGELOG ./INSTALL ./Backend.hs ./git-annex.hs ./Command/Fsck.hs ./Command/PreCommit.hs ./Command/AddUrl.hs ./Command/Fix.hs ./Command/Copy.hs ./Command/Unlock.hs ./Command/InitRemote.hs ./Command/Get.hs ./Command/Map.hs ./Command/Unused.hs ./Command/FromKey.hs ./Command/Unannex.hs ./Command/Add.hs ./Command/SetKey.hs ./Command/Uninit.hs ./Command/RecvKey.hs ./Command/DropUnused.hs ./Command/Semitrust.hs ./Command/Untrust.hs ./Command/Version.hs ./Command/SendKey.hs ./Command/Whereis.hs ./Command/DropKey.hs ./Command/Find.hs ./Command/Lock.hs ./Command/InAnnex.hs ./Command/Status.hs ./Command/ConfigList.hs ./Command/Trust.hs ./Command/Move.hs ./Command/Init.hs ./Command/Migrate.hs ./Command/Merge.hs ./Command/Upgrade.hs ./Command/Drop.hs ./Command/Describe.hs ./git-annex-shell.hs ./Utility/FileMode.hs ./Utility/Ssh.hs ./Utility/RsyncFile.hs ./Utility/StatFS.hsc ./Utility/Base64.hs ./Utility/CopyFile.hs ./Utility/Path.hs ./Utility/Touch.hsc ./Utility/JSONStream.hs ./Utility/SafeCommand.hs ./Utility/Url.hs ./Utility/Dot.hs ./Utility/Matcher.hs ./Utility/Conditional.hs ./Utility/DataUnits.hs ./Git.hs ./CmdLine.hs ./Trust.hs ./debian/rules ./debian/NEWS ./debian/compat ./debian/manpages ./debian/control ./debian/doc-base ./debian/changelog ./debian/copyright ./doc/trust.mdwn ./doc/use_case/Alice.mdwn ./doc/use_case/Bob.mdwn ./doc/install/comment_4_82a17eee4a076c6c79fddeda347e0c9a._comment ./doc/install/FreeBSD.mdwn ./doc/install/Debian.mdwn ./doc/install/comment_3_cff163ea3e7cad926f4ed9e78b896598._comment ./doc/install/Ubuntu.mdwn ./doc/install/Fedora.mdwn ./doc/install/OSX/comment_1_0a1760bf0db1f1ba89bdb4c62032f631._comment ./doc/install/Debian/comment_2_648e3467e260cdf233acdb0b53313ce0._comment ./doc/install/Debian/comment_1_029486088d098c2d4f1099f2f0e701a9._comment ./doc/install/OSX.mdwn ./doc/todo/symlink_farming_commit_hook.mdwn ./doc/todo/backendSHA1.mdwn ./doc/todo/using_url_backend.mdwn ./doc/todo/smudge.mdwn ./doc/todo/wishlist:_swift_backend/comment_1_e6efbb35f61ee521b473a92674036788._comment ./doc/todo/wishlist:_swift_backend/comment_2_5d8c83b0485112e98367b7abaab3f4e3._comment ./doc/todo/branching.mdwn ./doc/todo/cache_key_info/comment_1_578df1b3b2cbfdc4aa1805378f35dc48._comment ./doc/todo/git_annex_init_:_include_repo_description_and__47__or_UUID_in_commit_message.mdwn ./doc/todo/wishlist:_swift_backend.mdwn ./doc/todo/parallel_possibilities.mdwn ./doc/todo/parallel_possibilities/comment_2_adb76f06a7997abe4559d3169a3181c3._comment ./doc/todo/parallel_possibilities/comment_1_d8e34fc2bc4e5cf761574608f970d496._comment ./doc/todo/smudge/comment_1_4ea616bcdbc9e9a6fae9f2e2795c31c9._comment ./doc/todo/smudge/comment_2_e04b32caa0d2b4c577cdaf382a3ff7f6._comment ./doc/todo/wishlist:_support_for_more_ssh_urls_.mdwn ./doc/todo/auto_remotes.mdwn ./doc/todo/support_S3_multipart_uploads.mdwn ./doc/todo/add_a_git_backend.mdwn ./doc/todo/wishlist:___34__git_annex_add__34___multiple_processes.mdwn ./doc/todo/pushpull.mdwn ./doc/todo/cache_key_info.mdwn ./doc/todo/done.mdwn ./doc/todo/exclude_files_on_a_given_remote.mdwn ./doc/todo/speed_up_fsck.mdwn ./doc/todo/network_remotes.mdwn ./doc/todo/support-non-utf8-locales.mdwn ./doc/todo/tahoe_lfs_for_reals.mdwn ./doc/todo/immutable_annexed_files.mdwn ./doc/todo/file_copy_progress_bar.mdwn ./doc/todo/use_cp_reflink.mdwn ./doc/todo/fsck.mdwn ./doc/todo/object_dir_reorg_v2.mdwn ./doc/todo/hidden_files.mdwn ./doc/todo/add_--exclude_option_to_git_annex_find.mdwn ./doc/todo/git-annex-shell.mdwn ./doc/todo/checkout.mdwn ./doc/todo/git-annex_unused_eats_memory.mdwn ./doc/todo/object_dir_reorg_v2/comment_6_8834c3a3f1258c4349d23aff8549bf35._comment ./doc/todo/object_dir_reorg_v2/comment_3_79bdf9c51dec9f52372ce95b53233bb2._comment ./doc/todo/object_dir_reorg_v2/comment_7_42501404c82ca07147e2cce0cff59474._comment ./doc/todo/object_dir_reorg_v2/comment_5_821c382987f105da72a50e0a5ce61fdc._comment ./doc/todo/object_dir_reorg_v2/comment_4_93aada9b1680fed56cc6f0f7c3aca5e5._comment ./doc/todo/object_dir_reorg_v2/comment_1_ba03333dc76ff49eccaba375e68cb525._comment ./doc/todo/object_dir_reorg_v2/comment_2_81276ac309959dc741bc90101c213ab7._comment ./doc/todo/wishlist:_Prevent_repeated_password_prompts_for_one_command.mdwn ./doc/todo/gitrm.mdwn ./doc/todo/rsync.mdwn ./doc/todo/S3.mdwn ./doc/todo/tahoe_lfs_for_reals/comment_1_0a4793ce6a867638f6e510e71dd4bb44._comment ./doc/todo/tahoe_lfs_for_reals/comment_2_80b9e848edfdc7be21baab7d0cef0e3a._comment ./doc/todo/wishlist:_Provide_a___34__git_annex__34___command_that_will_skip_duplicates.mdwn ./doc/todo/union_mounting.mdwn ./doc/todo/auto_remotes/discussion.mdwn ./doc/repomap.png ./doc/users/joey.mdwn ./doc/users/chrysn.mdwn ./doc/users/fmarier.mdwn ./doc/encryption.mdwn ./doc/cheatsheet.mdwn ./doc/upgrades/SHA_size.mdwn ./doc/news/version_3.20110928.mdwn ./doc/news/sharebox_a_FUSE_filesystem_for_git-annex.mdwn ./doc/news/version_3.20110906.mdwn ./doc/news/version_3.20111011.mdwn ./doc/news/version_3.20110902.mdwn ./doc/news/LWN_article.mdwn ./doc/news/version_3.20110915.mdwn ./doc/download.mdwn ./doc/distributed_version_control.mdwn ./doc/special_remotes.mdwn ./doc/design.mdwn ./doc/users.mdwn ./doc/internals.mdwn ./doc/download/comment_2_f85f72b33aedc3425f0c0c47867d02f3._comment ./doc/download/comment_4_10fc013865c7542c2ed9d6c0963bb391._comment ./doc/download/comment_5_c6b1bc40226fc2c8ba3e558150856992._comment ./doc/download/comment_8_59a976de6c7d333709b92f7cd5830850._comment ./doc/download/comment_7_a5eebd214b135f34b18274a682211943._comment ./doc/download/comment_6_3a52993d3553deb9a413debec9a5f92d._comment ./doc/download/comment_3_cf6044ebe99f71158034e21197228abd._comment ./doc/download/comment_1_fbd8b6d39e9d3c71791551358c863966._comment ./doc/special_remotes/bup.mdwn ./doc/special_remotes/directory.mdwn ./doc/special_remotes/web.mdwn ./doc/special_remotes/hook.mdwn ./doc/special_remotes/rsync.mdwn ./doc/special_remotes/S3.mdwn ./doc/forum/Behaviour_of_fsck/comment_2_ead36a23c3e6efa1c41e4555f93e014e._comment ./doc/forum/Behaviour_of_fsck/comment_3_97848f9a3db89c0427cfb671ba13300e._comment ./doc/forum/Behaviour_of_fsck/comment_4_e4911dc6793f98fb81151daacbe49968._comment ./doc/forum/Behaviour_of_fsck/comment_1_0e40f158b3f4ccdcaab1408d858b68b8._comment ./doc/forum/wishlist:_command_options_changes/comment_1_bfba72a696789bf21b2435dea15f967a._comment ./doc/forum/wishlist:_command_options_changes/comment_3_bf1114533d2895804e531e76eb6b8095._comment ./doc/forum/wishlist:_command_options_changes/comment_2_f6a637c78c989382e3c22d41b7fb4cc2._comment ./doc/forum/wishlist:alias_system.mdwn ./doc/forum/sparse_git_checkouts_with_annex/comment_4_04dc14880f31eee2b6d767d4d4258c5a._comment ./doc/forum/sparse_git_checkouts_with_annex/comment_2_e357db3ccc4079f07a291843975535eb._comment ./doc/forum/sparse_git_checkouts_with_annex/comment_1_c7dc199c5740a0e7ba606dfb5e3e579a._comment ./doc/forum/sparse_git_checkouts_with_annex/comment_3_fcfafca994194d57dccf5319c7c9e646._comment ./doc/forum/Is_an_automagic_upgrade_of_the_object_directory_safe__63__.mdwn ./doc/forum/hashing_objects_directories/comment_1_c55c56076be4f54251b0b7f79f28a607._comment ./doc/forum/hashing_objects_directories/comment_4_0de9170e429cbfea66f5afa8980d45ac._comment ./doc/forum/hashing_objects_directories/comment_2_504c96959c779176f991f4125ea22009._comment ./doc/forum/hashing_objects_directories/comment_3_9134bde0a13aac0b6a4e5ebabd7f22e8._comment ./doc/forum/hashing_objects_directories/comment_5_ef6cfd49d24c180c2d0a062e5bd3a0be._comment ./doc/forum/batch_check_on_remote_when_using_copy.mdwn ./doc/forum/advantages_of_SHA__42___over_WORM/comment_1_96c354cac4b5ce5cf6664943bc84db1d._comment ./doc/forum/relying_on_git_for_numcopies.mdwn ./doc/forum/unannex_alternatives.mdwn ./doc/forum/advantages_of_SHA__42___over_WORM.mdwn ./doc/forum/OSX__39__s_default_sshd_behaviour_has_limited_paths_set.mdwn ./doc/forum/seems_to_build_fine_on_haskell_platform_2011.mdwn ./doc/forum/getting_git_annex_to_do_a_force_copy_to_a_remote.mdwn ./doc/forum/tips:_special__95__remotes__47__hook_with_tahoe-lafs.mdwn ./doc/forum/performance_improvement:_git_on_ssd__44___annex_on_spindle_disk.mdwn ./doc/forum/working_without_git-annex_commits.mdwn ./doc/forum/bainstorming:_git_annex_push___38___pull.mdwn ./doc/forum/Error_while_adding_a_file___34__createSymbolicLink:_already_exists__34__.mdwn ./doc/forum/Will_git_annex_work_on_a_FAT32_formatted_key__63__.mdwn ./doc/forum/wishlist:_support_for_more_ssh_urls_.mdwn ./doc/forum/wishlist:_git_annex_put_--_same_as_get__44___but_for_defaults.mdwn ./doc/forum/migrate_existing_git_repository_to_git-annex.mdwn ./doc/forum/Behaviour_of_fsck.mdwn ./doc/forum/wishlist:_git-annex_replicate.mdwn ./doc/forum/location_tracking_cleanup/comment_2_e7395cb6e01f42da72adf71ea3ebcde4._comment ./doc/forum/location_tracking_cleanup/comment_3_c15428cec90e969284a5e690fb4b2fde._comment ./doc/forum/location_tracking_cleanup/comment_1_7d6319e8c94dfe998af9cfcbf170efb2._comment ./doc/forum/migration_to_git-annex_and_rsync.mdwn ./doc/forum/wishlist:_push_to_cia.vc_from_the_website__39__s_repo__44___not_your_personal_one.mdwn ./doc/forum/Problems_with_large_numbers_of_files.mdwn ./doc/forum/OSX__39__s_haskell-platform_statically_links_things.mdwn ./doc/forum/can_git-annex_replace_ddm__63__.mdwn ./doc/forum/relying_on_git_for_numcopies/comment_1_8ad3cccd7f66f6423341d71241ba89fc._comment ./doc/forum/relying_on_git_for_numcopies/comment_3_43d8e1513eb9947f8a503f094c03f307._comment ./doc/forum/relying_on_git_for_numcopies/comment_2_be6acbc26008a9cb54e7b8f498f2c2a2._comment ./doc/forum/__34__git_annex_lock__34___very_slow_for_big_repo.mdwn ./doc/forum/wishlist:_git_annex_status/comment_4_9aeeb83d202dc8fb33ff364b0705ad94._comment ./doc/forum/wishlist:_git_annex_status/comment_3_d1fd70c67243971c96d59e1ffb7ef6e7._comment ./doc/forum/wishlist:_git_annex_status/comment_1_994bfd12c5d82e08040d6116915c5090._comment ./doc/forum/wishlist:_git_annex_status/comment_2_c2b0ce025805b774dc77ce264a222824._comment ./doc/forum/git-annex_communication_channels/comment_4_1ba6ddf54843c17c7d19a9996f2ab712._comment ./doc/forum/git-annex_communication_channels/comment_1_198325d2e9337c90f026396de89eec0e._comment ./doc/forum/git-annex_communication_channels/comment_5_404b723a681eb93fee015cea8024b6bc._comment ./doc/forum/git-annex_communication_channels/comment_2_c7aeefa6ef9a2e75d8667b479ade1b7f._comment ./doc/forum/git-annex_communication_channels/comment_6_0d87d0e26461494b1d7f8a701a924729._comment ./doc/forum/git-annex_communication_channels/comment_7_2c87c7a0648fe87c2bf6b4391f1cc468._comment ./doc/forum/git-annex_communication_channels/comment_3_1ff08a3e0e63fa0e560cbc9602245caa._comment ./doc/forum/wishlist:_special_remote_for_sftp_or_rsync.mdwn ./doc/forum/unannex_alternatives/comment_2_58a72a9fe0f58c7af0b4d7927a2dd21d._comment ./doc/forum/unannex_alternatives/comment_3_b1687fc8f9e7744327bbeb6f0635d1cd._comment ./doc/forum/unannex_alternatives/comment_1_dcd4cd41280b41512bbdffafaf307993._comment ./doc/forum/new_microfeatures.mdwn ./doc/forum/git-annex_on_OSX.mdwn ./doc/forum/Can_I_store_normal_files_in_the_git-annex_git_repository__63__.mdwn ./doc/forum/sparse_git_checkouts_with_annex.mdwn ./doc/forum/wishlist:_git_annex_status.mdwn ./doc/forum/rsync_over_ssh__63__.mdwn ./doc/forum/can_git-annex_replace_ddm__63__/comment_2_008554306dd082d7f543baf283510e92._comment ./doc/forum/can_git-annex_replace_ddm__63__/comment_1_aa05008dfe800474ff76678a400099e1._comment ./doc/forum/can_git-annex_replace_ddm__63__/comment_3_4c69097fe2ee81359655e59a03a9bb8d._comment ./doc/forum/location_tracking_cleanup.mdwn ./doc/forum/version_3_upgrade.mdwn ./doc/forum/git-annex_communication_channels.mdwn ./doc/forum/version_3_upgrade/comment_1_05fc9c9cad26c520bebb98c852c71e35._comment ./doc/forum/wishlist:_git_backend_for_git-annex.mdwn ./doc/forum/wishlist:_do_round_robin_downloading_of_data.mdwn ./doc/forum/wishlist:_git-annex_replicate/comment_3_c13f4f9c3d5884fc6255fd04feadc2b1._comment ./doc/forum/wishlist:_git-annex_replicate/comment_1_9926132ec6052760cdf28518a24e2358._comment ./doc/forum/wishlist:_git-annex_replicate/comment_2_c43932f4194aba8fb2470b18e0817599._comment ./doc/forum/wishlist:_git-annex_replicate/comment_4_63f24abf086d644dced8b01e1a9948c9._comment ./doc/forum/new_microfeatures/comment_7_94045b9078b1fff877933b012d1b49e2._comment ./doc/forum/new_microfeatures/comment_1_058bd517c6fffaf3446b1f5d5be63623._comment ./doc/forum/new_microfeatures/comment_6_31ea08c008500560c0b96c6601bc6362._comment ./doc/forum/new_microfeatures/comment_3_a1a9347b5bc517f2a89a8b292c3f8517._comment ./doc/forum/new_microfeatures/comment_5_3c627d275586ff499d928a8f8136babf._comment ./doc/forum/new_microfeatures/comment_2_41ad904c68e89c85e1fc49c9e9106969._comment ./doc/forum/new_microfeatures/comment_4_5a6786dc52382fff5cc42fdb05770196._comment ./doc/forum/wishlist:_traffic_accounting_for_git-annex.mdwn ./doc/forum/Wishlist:_Ways_of_selecting_files_based_on_meta-information.mdwn ./doc/forum/incompatible_versions__63__.mdwn ./doc/forum/rsync_over_ssh__63__/comment_2_aa690da6ecfb2b30fc5080ad76dc77b1._comment ./doc/forum/rsync_over_ssh__63__/comment_1_ee21f32e90303e20339e0a568321bbbe._comment ./doc/forum/hashing_objects_directories.mdwn ./doc/forum/wishlist:_command_options_changes.mdwn ./doc/forum/example_of_massively_disconnected_operation.mdwn ./doc/forum/wishlist:_define_remotes_that_must_have_all_files.mdwn ./doc/forum/incompatible_versions__63__/comment_1_629f28258746d413e452cbd42a1a43f4._comment ./doc/forum/Need_new_build_instructions_for_Debian_stable.mdwn ./doc/todo.mdwn ./doc/git-annex.mdwn ./doc/templates/bare.tmpl ./doc/templates/walkthrough.tmpl ./doc/bare_repositories.mdwn ./doc/feeds.mdwn ./doc/future_proofing.mdwn ./doc/bugs.mdwn ./doc/comments.mdwn ./doc/design/encryption.mdwn ./doc/design/encryption/comment_3_cca186a9536cd3f6e86994631b14231c._comment ./doc/design/encryption/comment_4_8f3ba3e504b058791fc6e6f9c38154cf._comment ./doc/design/encryption/comment_2_a610b3d056a059899178859a3a821ea5._comment ./doc/design/encryption/comment_1_4715ffafb3c4a9915bc33f2b26aaa9c1._comment ./doc/copies.mdwn ./doc/encryption/comment_1_1afca8d7182075d46db41f6ad3dd5911._comment ./doc/logo.png ./doc/git-annex-shell.mdwn ./doc/logo_small.png ./doc/install.mdwn ./doc/news.mdwn ./doc/forum.mdwn ./doc/transferring_data.mdwn ./doc/GPL ./doc/walkthrough.mdwn ./doc/location_tracking.mdwn ./doc/summary.mdwn ./doc/bugs/git_annex_unused_seems_to_check_for_current_path.mdwn ./doc/bugs/Name_scheme_does_not_follow_git__39__s_rules.mdwn ./doc/bugs/unhappy_without_UTF8_locale.mdwn ./doc/bugs/git_annex_unused_failes_on_empty_repository.mdwn ./doc/bugs/free_space_checking/comment_1_a868e805be43c5a7c19c41f1af8e41e6._comment ./doc/bugs/free_space_checking/comment_2_8a65f6d3dcf5baa3f7f2dbe1346e2615._comment ./doc/bugs/free_space_checking/comment_3_0fc6ff79a357b1619d13018ccacc7c10._comment ./doc/bugs/making_annex-merge_try_a_fast-forward.mdwn ./doc/bugs/git_annex_initremote_walks_.git-annex.mdwn ./doc/bugs/WORM:_Handle_long_filenames_correctly.mdwn ./doc/bugs/annex_add_in_annex.mdwn ./doc/bugs/git_annex_should_use___39__git_add_-f__39___internally.mdwn ./doc/bugs/configure_script_should_detect_uuidgen_instead_of_just_uuid.mdwn ./doc/bugs/support_bare_git_repo__44___with_the_annex_directory_exposed_to_http.mdwn ./doc/bugs/fat_support.mdwn ./doc/bugs/annex_unannex__47__uninit_should_handle_copies.mdwn ./doc/bugs/git_rename_detection_on_file_move/comment_1_0531dcfa833b0321a7009526efe3df33._comment ./doc/bugs/git_rename_detection_on_file_move/comment_2_7101d07400ad5935f880dc00d89bf90e._comment ./doc/bugs/git_rename_detection_on_file_move/comment_3_57010bcaca42089b451ad8659a1e018e._comment ./doc/bugs/git_rename_detection_on_file_move/comment_5_d61f5693d947b9736b29fca1dbc7ad76._comment ./doc/bugs/git_rename_detection_on_file_move/comment_4_79d96599f757757f34d7b784e6c0e81c._comment ./doc/bugs/wishlist:_more_descriptive_commit_messages_in_git-annex_branch.mdwn ./doc/bugs/git_annex_unlock_is_not_atomic.mdwn ./doc/bugs/building_on_lenny.mdwn ./doc/bugs/uuid.log_trust.log_and_remote.log_merge_wackiness.mdwn ./doc/bugs/Error_while_adding_a_file___34__createSymbolicLink:_already_exists__34__.mdwn ./doc/bugs/build_issue_with_latest_release_0.20110522-1-gde817ba.mdwn ./doc/bugs/git_annex_copy_-f_REMOTE_._doesn__39__t_work_as_expected.mdwn ./doc/bugs/Cabal_dependency_monadIO_missing.mdwn ./doc/bugs/git_command_line_constructed_by_unannex_command_has_tons_of_redundant_-a_paramters.mdwn ./doc/bugs/copy_fast_confusing_with_broken_locationlog.mdwn ./doc/bugs/Unfortunate_interaction_with_Calibre.mdwn ./doc/bugs/softlink_mtime.mdwn ./doc/bugs/problem_commit_normal_links.mdwn ./doc/bugs/unannex_vs_unlock_hook_confusion.mdwn ./doc/bugs/check_for_curl_in_configure.hs.mdwn ./doc/bugs/add_range_argument_to___34__git_annex_dropunused__34___.mdwn ./doc/bugs/git_annex_add_eats_files_when_filename_is_too_long.mdwn ./doc/bugs/touch.hsc_has_problems_on_non-linux_based_systems.mdwn ./doc/bugs/encrypted_S3_stalls.mdwn ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_1_5f60006c9bb095167d817f234a14d20b._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_2_cd0123392b16d89db41b45464165c247._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_4_91439d4dbbf1461e281b276eb0003691._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_3_86d9e7244ae492bcbe62720b8c4fc4a9._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_6_f360f0006bc9115bc5a3e2eb9fe58abd._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3/comment_5_ca33a9ca0df33f7c1b58353d7ffb943d._comment ./doc/bugs/minor_bug:_errors_are_not_verbose_enough.mdwn ./doc/bugs/error_propigation.mdwn ./doc/bugs/test_suite_shouldn__39__t_fail_silently.mdwn ./doc/bugs/bare_git_repos.mdwn ./doc/bugs/unannex_and_uninit_do_not_work_when_git_index_is_broken.mdwn ./doc/bugs/done.mdwn ./doc/bugs/Makefile_is_missing_dependancies.mdwn ./doc/bugs/S3_memory_leaks.mdwn ./doc/bugs/Displayed_copy_speed_is_wrong/comment_2_8b240de1d5ae9229fa2d77d1cc15a552._comment ./doc/bugs/Displayed_copy_speed_is_wrong/comment_1_74de3091e8bfd7acd6795e61f39f07c6._comment ./doc/bugs/problems_with_utf8_names.mdwn ./doc/bugs/Problems_running_make_on_osx.mdwn ./doc/bugs/__39__annex_add__39___fails_to___39__git_add__39___for_parent_relative_path.mdwn ./doc/bugs/Problems_running_make_on_osx/comment_16_5c2dd6002aadaab30841b77a5f5aed34._comment ./doc/bugs/Problems_running_make_on_osx/comment_15_6b8867b8e48bf807c955779c9f8f0909._comment ./doc/bugs/Problems_running_make_on_osx/comment_20_7db27d1a22666c831848bc6c06d66a84._comment ./doc/bugs/Problems_running_make_on_osx/comment_10_94e4ac430140042a2d0fb5a16d86b4e5._comment ./doc/bugs/Problems_running_make_on_osx/comment_5_7f1330a1e541b0f3e2192e596d7f7bee._comment ./doc/bugs/Problems_running_make_on_osx/comment_9_cc283b485b3c95ba7eebc8f0c96969b3._comment ./doc/bugs/Problems_running_make_on_osx/comment_1_34120e82331ace01a6a4960862d38f2d._comment ./doc/bugs/Problems_running_make_on_osx/comment_13_88ed095a448096bf8a69015a04e64df1._comment ./doc/bugs/Problems_running_make_on_osx/comment_2_cc53d1681d576186dbc868dd9801d551._comment ./doc/bugs/Problems_running_make_on_osx/comment_11_56f1143fa191361d63b441741699e17f._comment ./doc/bugs/Problems_running_make_on_osx/comment_18_64fab50d95de619eb2e8f08f90237de1._comment ./doc/bugs/Problems_running_make_on_osx/comment_17_62fccb04b0e4b695312f7a3f32fb96ee._comment ./doc/bugs/Problems_running_make_on_osx/comment_8_efafa203addf8fa79e33e21a87fb5a2b._comment ./doc/bugs/Problems_running_make_on_osx/comment_7_237a137cce58a28abcc736cbf2c420b0._comment ./doc/bugs/Problems_running_make_on_osx/comment_3_68f0f8ae953589ae26d57310b40c878d._comment ./doc/bugs/Problems_running_make_on_osx/comment_6_0c46f5165ceb5a7b9ea9689c33b3a4f8._comment ./doc/bugs/Problems_running_make_on_osx/comment_4_c52be386f79f14c8570a8f1397c68581._comment ./doc/bugs/Problems_running_make_on_osx/comment_19_4253988ed178054c8b6400beeed68a29._comment ./doc/bugs/Problems_running_make_on_osx/comment_14_89a960b6706ed703b390a81a8bc4e311._comment ./doc/bugs/Problems_running_make_on_osx/comment_12_ec5131624d0d2285d3b6880e47033f97._comment ./doc/bugs/problem_with_upgrade_v2_-__62___v3.mdwn ./doc/bugs/backend_version_upgrade_leaves_repo_unusable.mdwn ./doc/bugs/fsck_output.mdwn ./doc/bugs/Displayed_copy_speed_is_wrong.mdwn ./doc/bugs/add_script-friendly_output_options.mdwn ./doc/bugs/fsck__47__fix_should_check__47__fix_the_permissions_of_.git__47__annex.mdwn ./doc/bugs/No_version_information_from_cli.mdwn ./doc/bugs/S3_bucket_uses_the_same_key_for_encryption_and_hashing.mdwn ./doc/bugs/dotdot_problem.mdwn ./doc/bugs/git-annex_directory_hashing_problems_on_osx.mdwn ./doc/bugs/git_annex_copy_--fast_does_not_copy_files.mdwn ./doc/bugs/git_annex_get_choke_when_remote_is_an_ssh_url_with_a_port.mdwn ./doc/bugs/--git-dir_and_--work-tree_options.mdwn ./doc/bugs/free_space_checking.mdwn ./doc/bugs/git_annex_gets_confused_about_remotes_with_dots_in_their_names.mdwn ./doc/bugs/ordering.mdwn ./doc/bugs/Makefile_is_missing_dependancies/comment_1_5a3da5f79c8563c7a450aa29728abe7c._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_2_416f12dbd0c2b841fac8164645b81df5._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_7_96fd4725df4b54e670077a18d3ac4943._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_8_a3555e3286cdc2bfeb9cde0ff727ba74._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_3_c38b6f4abc9b9ad413c3b83ca04386c3._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_6_24119fc5d5963ce9dd669f7dcf006859._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_5_0a1c52e2c96d19b9c3eb7e99b8c2434f._comment ./doc/bugs/Makefile_is_missing_dependancies/comment_4_cc13873175edf191047282700315beee._comment ./doc/bugs/No_easy_way_to_re-inject_a_file_into_an_annex.mdwn ./doc/bugs/dropping_files_with_a_URL_backend_fails.mdwn ./doc/bugs/git_annex_migrate_leaves_old_backend_versions_around.mdwn ./doc/bugs/weird_local_clone_confuses.mdwn ./doc/bugs/Cabal_dependency_monadIO_missing/comment_1_14be660aa57fadec0d81b32a8b52c66f._comment ./doc/bugs/Cabal_dependency_monadIO_missing/comment_2_4f4d8e1e00a2a4f7e8a8ab082e16adac._comment ./doc/bugs/git_rename_detection_on_file_move.mdwn ./doc/bugs/concurrent_git-annex_processes_can_lead_to_locking_issues.mdwn ./doc/bugs/upgrade_left_untracked_.git-annex__47____42___directories.mdwn ./doc/bugs/scp_interrupt_to_background.mdwn ./doc/bugs/tests_fail_when_there_is_no_global_.gitconfig_for_the_user.mdwn ./doc/bugs/git-annex_incorrectly_parses_bare_IPv6_addresses.mdwn ./doc/bugs/fat_support/comment_3_df3b943bc1081a8f3f7434ae0c8e061e._comment ./doc/bugs/fat_support/comment_4_90a8a15bedd94480945a374f9d706b86._comment ./doc/bugs/fat_support/comment_5_64bbf89de0836673224b83fdefa0407b._comment ./doc/bugs/fat_support/comment_1_04bcc4795d431e8cb32293aab29bbfe2._comment ./doc/bugs/fat_support/comment_2_bb4a97ebadb5c53809fc78431eabd7c8._comment ./doc/bugs/error_with_file_names_starting_with_dash.mdwn ./doc/bugs/tmp_file_handling.mdwn ./doc/bugs/conflicting_haskell_packages/comment_1_e552a6cc6d7d1882e14130edfc2d6b3b._comment ./doc/bugs/git-annex_has_issues_with_git_when_staging__47__commiting_logs.mdwn ./doc/bugs/Build_error_on_Mac_OSX_10.6.mdwn ./doc/bugs/Prevent_accidental_merges.mdwn ./doc/bugs/git_annex_fsck_is_a_no-op_in_bare_repos.mdwn ./doc/bugs/conflicting_haskell_packages.mdwn ./doc/bugs/unannex_command_doesn__39__t_all_files.mdwn ./doc/index.mdwn ./doc/backends.mdwn ./doc/walkthrough/more.mdwn ./doc/walkthrough/renaming_files.mdwn ./doc/walkthrough/getting_file_content.mdwn ./doc/walkthrough/unused_data.mdwn ./doc/walkthrough/backups.mdwn ./doc/walkthrough/using_the_web.mdwn ./doc/walkthrough/adding_files.mdwn ./doc/walkthrough/using_Amazon_S3.mdwn ./doc/walkthrough/using_the_SHA1_backend.mdwn ./doc/walkthrough/removing_files/comment_2_64709ea4558915edd5c8ca4486965b07._comment ./doc/walkthrough/removing_files/comment_1_cb65e7c510b75be1c51f655b058667c6._comment ./doc/walkthrough/powerful_file_matching.mdwn ./doc/walkthrough/creating_a_repository.mdwn ./doc/walkthrough/using_ssh_remotes.mdwn ./doc/walkthrough/adding_a_remote/comment_3_60691af4400521b5a8c8d75efe3b44cb._comment ./doc/walkthrough/adding_a_remote/comment_2_f8cd79ef1593a8181a7f1086a87713e8._comment ./doc/walkthrough/adding_a_remote/comment_4_6f7cf5c330272c96b3abeb6612075c9d._comment ./doc/walkthrough/adding_a_remote/comment_1_0a59355bd33a796aec97173607e6adc9._comment ./doc/walkthrough/fsck:_when_things_go_wrong.mdwn ./doc/walkthrough/Internet_Archive_via_S3.mdwn ./doc/walkthrough/modifying_annexed_files.mdwn ./doc/walkthrough/migrating_data_to_a_new_backend.mdwn ./doc/walkthrough/untrusted_repositories.mdwn ./doc/walkthrough/transferring_files:_When_things_go_wrong.mdwn ./doc/walkthrough/removing_files:_When_things_go_wrong.mdwn ./doc/walkthrough/what_to_do_when_you_lose_a_repository.mdwn ./doc/walkthrough/fsck:_verifying_your_data.mdwn ./doc/walkthrough/adding_a_remote.mdwn ./doc/walkthrough/automatically_managing_content.mdwn ./doc/walkthrough/recover_data_from_lost+found.mdwn ./doc/walkthrough/using_bup.mdwn ./doc/walkthrough/moving_file_content_between_repositories.mdwn ./doc/walkthrough/removing_files.mdwn ./doc/not.mdwn ./doc/git-union-merge.mdwn ./doc/contact.mdwn ./doc/upgrades.mdwn ./Options.hs ./Locations.hs ./Init.hs ./Messages.hs ./Upgrade.hs ./GPL ./Remote.hs ./git-annex.cabal ./GitAnnex.hs ./Build/TestConfig.hs ./Messages/JSON.hs ./git-union-merge.hs ./Annex/Branch.hs ./Annex/Exception.hs ./Annex/Version.hs ./Annex/Content.hs ./Annex/CatFile.hs ./Annex/Queue.hs ./Utility.hs ./.gitattributes ./Common.hs ./Types.hs ./UUIDLog.hs ./Types/TrustLevel.hs ./Types/Backend.hs ./Types/BranchState.hs ./Types/Key.hs ./Types/Remote.hs ./Types/UUID.hs ./Types/Crypto.hs ./UUID.hs ./Config.hs ./Crypto.hs ./README ./Setup.hs Homepage: http://git-annex.branchable.com/ Build-type: Custom Category: Utility
git-union-merge.hs view
@@ -6,10 +6,8 @@  -}  import System.Environment-import System.FilePath-import System.Directory-import Control.Monad (when) +import Common import qualified Git.UnionMerge import qualified Git @@ -43,6 +41,6 @@ 	g <- Git.configRead =<< Git.repoFromCwd 	_ <- Git.useIndex (tmpIndex g) 	setup g-	Git.UnionMerge.merge g [aref, bref]+	Git.UnionMerge.merge g aref bref 	Git.commit g "union merge" newref [aref, bref] 	cleanup g
test.hs view
@@ -9,23 +9,19 @@ import Test.HUnit.Tools import Test.QuickCheck -import System.Directory import System.Posix.Directory (changeWorkingDirectory) import System.Posix.Files import IO (bracket_, bracket)-import Control.Monad (unless, when, filterM)-import Data.List import System.IO.Error import System.Posix.Env import qualified Control.Exception.Extensible as E import Control.Exception (throw)-import Data.Maybe import qualified Data.Map as M-import System.Path (recurseDir) import System.IO.HVFS (SystemFS(..)) -import Utility.SafeCommand+import Common +import qualified Utility.SafeCommand import qualified Annex import qualified Backend import qualified Git@@ -35,6 +31,7 @@ import qualified GitAnnex import qualified LocationLog import qualified UUID+import qualified UUIDLog import qualified Trust import qualified Remote import qualified RemoteLog@@ -82,6 +79,8 @@ 	, qctest "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics 	, qctest "prop_cost_sane" Config.prop_cost_sane 	, qctest "prop_hmacWithCipher_sane" Crypto.prop_hmacWithCipher_sane+	, qctest "prop_TimeStamp_sane" UUIDLog.prop_TimeStamp_sane+	, qctest "prop_addLog_sane" UUIDLog.prop_addLog_sane 	]  blackbox :: Test@@ -453,13 +452,13 @@ 	checkunused [] 	boolSystem "git" [Params "rm -q", File annexedfile] @? "git rm failed" 	checkunused []-	boolSystem "git" [Params "commit -m foo"] @? "git commit failed"+	boolSystem "git" [Params "commit -q -m foo"] @? "git commit failed" 	checkunused [] 	-- unused checks origin/master; once it's gone it is really unused 	boolSystem "git" [Params "remote rm origin"] @? "git remote rm origin failed" 	checkunused [annexedfilekey] 	boolSystem "git" [Params "rm -q", File sha1annexedfile] @? "git rm failed"-	boolSystem "git" [Params "commit -m foo"] @? "git commit failed"+	boolSystem "git" [Params "commit -q -m foo"] @? "git commit failed" 	checkunused [annexedfilekey, sha1annexedfilekey]  	-- good opportunity to test dropkey also@@ -610,9 +609,7 @@  checklocationlog :: FilePath -> Bool -> Assertion checklocationlog f expected = do-	thisuuid <- annexeval $ do-		g <- Annex.gitRepo-		UUID.getUUID g+	thisuuid <- annexeval UUID.getUUID 	r <- annexeval $ Backend.lookupFile f 	case r of 		Just (k, _) -> do