packages feed

git-annex 5.20151218 → 6.20160114

raw patch · 197 files changed

+4840/−1527 lines, 197 filesdep +criteriondep +deepseqdep ~dbus

Dependencies added: criterion, deepseq

Dependency ranges changed: dbus

Files

.gitignore view
@@ -25,6 +25,7 @@ .cabal-sandbox cabal.sandbox.config cabal.config+.stack-work # Project-local emacs configuration .dir-locals.el # OSX related
Annex.hs view
@@ -60,6 +60,7 @@ import Types.LockCache import Types.DesktopNotify import Types.CleanupActions+import qualified Database.Keys.Handle as Keys #ifdef WITH_QUVI import Utility.Quvi (QuviVersion) #endif@@ -134,6 +135,7 @@ 	, desktopnotify :: DesktopNotify 	, workers :: [Either AnnexState (Async AnnexState)] 	, concurrentjobs :: Maybe Int+	, keysdbhandle :: Maybe Keys.DbHandle 	}  newState :: GitConfig -> Git.Repo -> AnnexState@@ -179,6 +181,7 @@ 	, desktopnotify = mempty 	, workers = [] 	, concurrentjobs = Nothing+	, keysdbhandle = Nothing 	}  {- Makes an Annex state object for the specified git repo.@@ -193,25 +196,32 @@ {- Performs an action in the Annex monad from a starting state,  - returning a new state. -} run :: AnnexState -> Annex a -> IO (a, AnnexState)-run s a = do-	mvar <- newMVar s+run s a = flip run' a =<< newMVar s++run' :: MVar AnnexState -> Annex a -> IO (a, AnnexState)+run' mvar a = do 	r <- runReaderT (runAnnex a) mvar+		`onException` (flush =<< readMVar mvar) 	s' <- takeMVar mvar+	flush s' 	return (r, s')+  where+	flush = maybe noop Keys.flushDbQueue . keysdbhandle  {- Performs an action in the Annex monad from a starting state,   - and throws away the new state. -} eval :: AnnexState -> Annex a -> IO a-eval s a = do-	mvar <- newMVar s-	runReaderT (runAnnex a) mvar+eval s a = fst <$> run s a  {- Makes a runner action, that allows diving into IO and from inside  - the IO action, running an Annex action. -} makeRunner :: Annex (Annex a -> IO a) makeRunner = do 	mvar <- ask-	return $ \a -> runReaderT (runAnnex a) mvar+	return $ \a -> do+		(r, s) <- run' mvar a+		putMVar mvar s+		return r  getState :: (AnnexState -> v) -> Annex v getState selector = do
Annex/AutoMerge.hs view
@@ -1,6 +1,6 @@ {- git-annex automatic merge conflict resolution  -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>+ - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -16,6 +16,7 @@ import Annex.Direct import Annex.CatFile import Annex.Link+import Annex.Content import qualified Git.LsFiles as LsFiles import qualified Git.UpdateIndex as UpdateIndex import qualified Git.Merge@@ -23,19 +24,23 @@ import qualified Git import qualified Git.Branch import Git.Types (BlobType(..))+import Git.FilePath import Config import Annex.ReplaceFile-import Git.FileMode import Annex.VariantFile+import qualified Database.Keys+import Annex.InodeSentinal+import Utility.InodeCache  import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.ByteString.Lazy as L -{- Merges from a branch into the current branch- - (which may not exist yet),+{- Merges from a branch into the current branch (which may not exist yet),  - with automatic merge conflict resolution.  -  - Callers should use Git.Branch.changed first, to make sure that- - there are changed from the current branch to the branch being merged in.+ - there are changes from the current branch to the branch being merged in.  -} autoMergeFrom :: Git.Ref -> Maybe Git.Ref -> Git.Branch.CommitMode -> Annex Bool autoMergeFrom branch currbranch commitmode = do@@ -78,6 +83,12 @@  - the index, and written to the gitAnnexMergeDir, for later handling by  - the direct mode merge code.  -+ - Unlocked files remain unlocked after merging, and locked files+ - remain locked. When the merge conflict is between a locked and unlocked+ - file, that otherwise point to the same content, the unlocked mode wins.+ - This is done because only unlocked files work in filesystems that don't+ - support symlinks.+ -  - Returns false when there are no merge conflicts to resolve.  - A git merge can fail for other reasons, and this allows detecting  - such failures.@@ -86,8 +97,11 @@ resolveMerge us them = do 	top <- fromRepo Git.repoPath 	(fs, cleanup) <- inRepo (LsFiles.unmerged [top])-	mergedfs <- catMaybes <$> mapM (resolveMerge' us them) fs-	let merged = not (null mergedfs)+	srcmap <- inodeMap $ pure (map LsFiles.unmergedFile fs, return True)+	(mergedks, mergedfs) <- unzip <$> mapM (resolveMerge' srcmap us them) fs+	let mergedks' = concat mergedks+	let mergedfs' = catMaybes mergedfs+	let merged = not (null mergedfs') 	void $ liftIO cleanup  	unlessM isDirect $ do@@ -99,111 +113,183 @@ 		void $ liftIO cleanup2  	when merged $ do-		unlessM isDirect $-			cleanConflictCruft mergedfs top 		Annex.Queue.flush+		unlessM isDirect $ do+			unstagedmap <- inodeMap $ inRepo $ LsFiles.notInRepo False [top]+			cleanConflictCruft mergedks' mergedfs' unstagedmap 		showLongNote "Merge conflict was automatically resolved; you may want to examine the result." 	return merged -resolveMerge' :: Maybe Git.Ref -> Git.Ref -> LsFiles.Unmerged -> Annex (Maybe FilePath)-resolveMerge' Nothing _ _ = return Nothing-resolveMerge' (Just us) them u = do-	kus <- getkey LsFiles.valUs LsFiles.valUs -	kthem <- getkey LsFiles.valThem LsFiles.valThem+resolveMerge' :: InodeMap -> Maybe Git.Ref -> Git.Ref -> LsFiles.Unmerged -> Annex ([Key], Maybe FilePath)+resolveMerge' _ Nothing _ _ = return ([], Nothing)+resolveMerge' unstagedmap (Just us) them u = do+	kus <- getkey LsFiles.valUs+	kthem <- getkey LsFiles.valThem 	case (kus, kthem) of 		-- Both sides of conflict are annexed files 		(Just keyUs, Just keyThem)-			| keyUs /= keyThem -> resolveby $ do-				makelink keyUs-				makelink keyThem-			| otherwise -> resolveby $-				makelink keyUs+			| keyUs /= keyThem -> resolveby [keyUs, keyThem] $ do+				makeannexlink keyUs LsFiles.valUs+				makeannexlink keyThem LsFiles.valThem+				-- cleanConflictCruft can't handle unlocked+				-- files, so delete here.+				unless (islocked LsFiles.valUs) $+					liftIO $ nukeFile file+			| otherwise -> do+				-- Only resolve using symlink when both+				-- were locked, otherwise use unlocked+				-- pointer.+				-- In either case, keep original filename.+				if islocked LsFiles.valUs && islocked LsFiles.valThem+					then makesymlink keyUs file+					else makepointer keyUs file+				return ([keyUs, keyThem], Just file) 		-- Our side is annexed file, other side is not.-		(Just keyUs, Nothing) -> resolveby $ do-			graftin them file LsFiles.valThem LsFiles.valThem-			makelink keyUs+		(Just keyUs, Nothing) -> resolveby [keyUs] $ do+			graftin them file LsFiles.valThem LsFiles.valThem LsFiles.valUs+			makeannexlink keyUs LsFiles.valUs 		-- Our side is not annexed file, other side is.-		(Nothing, Just keyThem) -> resolveby $ do-			graftin us file LsFiles.valUs LsFiles.valUs-			makelink keyThem+		(Nothing, Just keyThem) -> resolveby [keyThem] $ do+			graftin us file LsFiles.valUs LsFiles.valUs LsFiles.valThem+			makeannexlink keyThem LsFiles.valThem 		-- Neither side is annexed file; cannot resolve.-		(Nothing, Nothing) -> return Nothing+		(Nothing, Nothing) -> return ([], Nothing)   where 	file = LsFiles.unmergedFile u -	getkey select select'-		| select (LsFiles.unmergedBlobType u) == Just SymlinkBlob =-			case select' (LsFiles.unmergedSha u) of-				Nothing -> return Nothing-				Just sha -> catKey sha symLinkMode-		| otherwise = return Nothing+	getkey select = +		case select (LsFiles.unmergedSha u) of+			Just sha -> catKey sha+			Nothing -> return Nothing 	-	makelink key = do-		let dest = variantFile file key+	islocked select = select (LsFiles.unmergedBlobType u) == Just SymlinkBlob++	makeannexlink key select+		| islocked select = makesymlink key dest+		| otherwise = makepointer key dest+	  where+		dest = variantFile file key++	makesymlink key dest = do 		l <- calcRepo $ gitAnnexLink dest key-		replacewithlink dest l+		replacewithsymlink dest l 		stageSymlink dest =<< hashSymlink l -	replacewithlink dest link = ifM isDirect+	replacewithsymlink dest link = withworktree dest $ \f ->+		replaceFile f $ makeGitLink link++	makepointer key dest = do+		unlessM (reuseOldFile unstagedmap key file dest) $ do+			r <- linkFromAnnex key dest+			case r of+				LinkAnnexFailed -> liftIO $+					writeFile dest (formatPointer key)+				_ -> noop+		stagePointerFile dest =<< hashPointerFile key+		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest)++	withworktree f a = ifM isDirect 		( do 			d <- fromRepo gitAnnexMergeDir-			replaceFile (d </> dest) $ makeGitLink link-		, replaceFile dest $ makeGitLink link+			a (d </> f)+		, a f 		) -	{- Stage a graft of a directory or file from a branch.-	 --	 - When there is a conflicted merge where one side is a directory-	 - or file, and the other side is a symlink, git merge always-	 - updates the work tree to contain the non-symlink. So, the-	 - directory or file will already be in the work tree correctly,-	 - and they just need to be staged into place. Do so by copying the-	 - index. (Note that this is also better than calling git-add-	 - because on a crippled filesystem, it preserves any symlink-	 - bits.)-	 --	 - It's also possible for the branch to have a symlink in it,-	 - which is not a git-annex symlink. In this special case,-	 - git merge does not update the work tree to contain the symlink-	 - from the branch, so we have to do so manually.-	 -}-	graftin b item select select' = do+	{- Stage a graft of a directory or file from a branch+	 - and update the work tree. -}+	graftin b item selectwant selectwant' selectunwant = do 		Annex.Queue.addUpdateIndex 			=<< fromRepo (UpdateIndex.lsSubTree b item)-		when (select (LsFiles.unmergedBlobType u) == Just SymlinkBlob) $-			case select' (LsFiles.unmergedSha u) of-				Nothing -> noop-				Just sha -> do-					link <- catLink True sha-					replacewithlink item link-		-	resolveby a = do++		-- Update the work tree to reflect the graft.+		case (selectwant (LsFiles.unmergedBlobType u), selectunwant (LsFiles.unmergedBlobType u)) of+			-- Symlinks are never left in work tree when+			-- there's a conflict with anything else.+			-- So, when grafting in a symlink, we must create it:+			(Just SymlinkBlob, _) -> do+				case selectwant' (LsFiles.unmergedSha u) of+					Nothing -> noop+					Just sha -> do+						link <- catSymLinkTarget sha+						replacewithsymlink item link+			-- And when grafting in anything else vs a symlink,+			-- the work tree already contains what we want.+			(_, Just SymlinkBlob) -> noop+			_ -> ifM (withworktree item (liftIO . doesDirectoryExist))+				-- a conflict between a file and a directory+				-- leaves the directory, so since a directory+				-- is there, it must be what was wanted+				( noop+				-- probably a file with conflict markers is+				-- in the work tree; replace with grafted+				-- file content+				, case selectwant' (LsFiles.unmergedSha u) of+					Nothing -> noop+					Just sha -> withworktree item $ \f -> +						replaceFile f $ \tmp -> do+							c <- catObject sha+							liftIO $ L.writeFile tmp c+				)+	+	resolveby ks a = do 		{- Remove conflicted file from index so merge can be resolved. -} 		Annex.Queue.addCommand "rm" 			[Param "--quiet", Param "-f", Param "--cached", Param "--"] [file] 		void a-		return (Just file)+		return (ks, Just file)  {- git-merge moves conflicting files away to files  - named something like f~HEAD or f~branch or just f, but the  - exact name chosen can vary. Once the conflict is resolved,  - this cruft can be deleted. To avoid deleting legitimate  - files that look like this, only delete files that are- - A) not staged in git and B) look like git-annex symlinks.+ - A) not staged in git and+ - B) have a name related to the merged files and+ - C) are pointers to or have the content of keys that were involved+ - in the merge.  -}-cleanConflictCruft :: [FilePath] -> FilePath -> Annex ()-cleanConflictCruft resolvedfs top = do-	(fs, cleanup) <- inRepo $ LsFiles.notInRepo False [top]-	mapM_ clean fs-	void $ liftIO cleanup-  where-	clean f-		| matchesresolved f = whenM (isJust <$> isAnnexLink f) $+cleanConflictCruft :: [Key] -> [FilePath] -> InodeMap -> Annex ()+cleanConflictCruft resolvedks resolvedfs unstagedmap = do+	is <- S.fromList . map (inodeCacheToKey Strongly) . concat +		<$> mapM Database.Keys.getInodeCaches resolvedks+	forM_ (M.toList unstagedmap) $ \(i, f) ->+		whenM (matchesresolved is i f) $ 			liftIO $ nukeFile f-		| otherwise = noop-	s = S.fromList resolvedfs-	matchesresolved f = S.member f s || S.member (base f) s-	base f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f+  where+	fs = S.fromList resolvedfs+	ks = S.fromList resolvedks+	inks = maybe False (flip S.member ks)+	matchesresolved is i f+		| S.member f fs || S.member (conflictCruftBase f) fs = anyM id+			[ pure (S.member i is)+			, inks <$> isAnnexLink f+			, inks <$> liftIO (isPointerFile f)+			]+		| otherwise = return False++conflictCruftBase :: FilePath -> FilePath+conflictCruftBase f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f++{- When possible, reuse an existing file from the srcmap as the+ - content of a worktree file in the resolved merge. It must have the+ - same name as the origfile, or a name that git would use for conflict+ - cruft. And, its inode cache must be a known one for the key. -}+reuseOldFile :: InodeMap -> Key -> FilePath -> FilePath -> Annex Bool+reuseOldFile srcmap key origfile destfile = do+	is <- map (inodeCacheToKey Strongly)+		<$> Database.Keys.getInodeCaches key+	liftIO $ go $ mapMaybe (\i -> M.lookup i srcmap) is+  where+	go [] = return False+	go (f:fs)+		| f == origfile || conflictCruftBase f == origfile = +			ifM (doesFileExist f)+				( do+					renameFile f destfile+					return True+				, go fs+				)+		| otherwise = go fs 	 commitResolvedMerge :: Git.Branch.CommitMode -> Annex Bool commitResolvedMerge commitmode = inRepo $ Git.Branch.commitCommand commitmode@@ -211,3 +297,16 @@ 	, Param "-m" 	, Param "git-annex automatic merge conflict fix" 	]++type InodeMap = M.Map InodeCacheKey FilePath++inodeMap :: Annex ([FilePath], IO Bool) -> Annex InodeMap+inodeMap getfiles = do+	(fs, cleanup) <- getfiles+	fsis <- forM fs $ \f -> do+		mi <- withTSDelta (liftIO . genInodeCache f)+		return $ case mi of+			Nothing -> Nothing+			Just i -> Just (inodeCacheToKey Strongly i, f)+	void $ liftIO cleanup+	return $ M.fromList $ catMaybes fsis
Annex/CatFile.hs view
@@ -1,6 +1,6 @@ {- git cat-file interface, with handle automatically stored in the Annex monad  -- - Copyright 2011-2013 Joey Hess <id@joeyh.name>+ - Copyright 2011-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -16,7 +16,7 @@ 	catKey, 	catKeyFile, 	catKeyFileHEAD,-	catLink,+	catSymLinkTarget, ) where  import qualified Data.ByteString.Lazy as L@@ -29,8 +29,8 @@ import qualified Annex import Git.Types import Git.FilePath-import Git.FileMode import qualified Git.Ref+import Annex.Link  catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile branch file = do@@ -80,52 +80,17 @@ 		(s { Annex.catfilehandles = M.empty }, Annex.catfilehandles s) 	liftIO $ mapM_ Git.CatFile.catFileStop (M.elems m) -{- From the Sha or Ref of a symlink back to the key.- -- - Requires a mode witness, to guarantee that the file is a symlink.- -}-catKey :: Ref -> FileMode -> Annex (Maybe Key)-catKey = catKey' True--catKey' :: Bool -> Sha -> FileMode -> Annex (Maybe Key)-catKey' modeguaranteed sha mode-	| isSymLink mode = do-		l <- catLink modeguaranteed sha-		return $ if isLinkToAnnex l-			then fileKey $ takeFileName l-			else Nothing-	| otherwise = return Nothing+{- From ref to a symlink or a pointer file, get the key. -}+catKey :: Ref -> Annex (Maybe Key)+catKey ref = parseLinkOrPointer <$> catObject ref  {- Gets a symlink target. -}-catLink :: Bool -> Sha -> Annex String-catLink modeguaranteed sha = fromInternalGitPath . decodeBS <$> get+catSymLinkTarget :: Sha -> Annex String+catSymLinkTarget sha = fromInternalGitPath . decodeBS <$> get   where-	-- If the mode is not guaranteed to be correct, avoid-	-- buffering the whole file content, which might be large.+	-- Avoid buffering the whole file content, which might be large. 	-- 8192 is enough if it really is a symlink.-	get-		| modeguaranteed = catObject sha-		| otherwise = L.take 8192 <$> catObject sha--{- Looks up the key corresponding to the Ref using the running cat-file.- -- - Currently this always has to look in HEAD, because cat-file --batch- - does not offer a way to specify that we want to look up a tree object- - in the index. So if the index has a file staged not as a symlink,- - and it is a symlink in head, the wrong mode is gotten.- - Also, we have to assume the file is a symlink if it's not yet committed- - to HEAD. For these reasons, modeguaranteed is not set.- -}-catKeyChecked :: Bool -> Ref -> Annex (Maybe Key)-catKeyChecked needhead ref@(Ref r) =-	catKey' False ref =<< findmode <$> catTree treeref-  where-	pathparts = split "/" r-	dir = intercalate "/" $ take (length pathparts - 1) pathparts-	file = fromMaybe "" $ lastMaybe pathparts-	treeref = Ref $ if needhead then "HEAD" ++ dir ++ "/" else dir ++ "/"-	findmode = fromMaybe symLinkMode . headMaybe .-		 map snd . filter (\p -> fst p == file)+	get = L.take 8192 <$> catObject sha  {- From a file in the repository back to the key.  -@@ -151,8 +116,8 @@ catKeyFile :: FilePath -> Annex (Maybe Key) catKeyFile f = ifM (Annex.getState Annex.daemon) 	( catKeyFileHEAD f-	, catKeyChecked True $ Git.Ref.fileRef f+	, catKey $ Git.Ref.fileRef f 	)  catKeyFileHEAD :: FilePath -> Annex (Maybe Key)-catKeyFileHEAD f = catKeyChecked False $ Git.Ref.fileFromRef Git.Ref.headRef f+catKeyFileHEAD f = catKey $ Git.Ref.fileFromRef Git.Ref.headRef f
Annex/Content.hs view
@@ -1,6 +1,6 @@ {- git-annex file content managing  -- - Copyright 2010-2014 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -24,6 +24,14 @@ 	withTmp, 	checkDiskSpace, 	moveAnnex,+	populatePointerFile,+	linkToAnnex,+	linkFromAnnex,+	LinkAnnexResult(..),+	unlinkAnnex,+	checkedCopyFile,+	linkOrCopy,+	linkOrCopy', 	sendAnnex, 	prepSendAnnex, 	removeAnnex,@@ -38,6 +46,7 @@ 	dirKeys, 	withObjectLoc, 	staleKeysPrune,+	isUnmodified, ) where  import System.IO.Unsafe (unsafeInterleaveIO)@@ -58,18 +67,23 @@ import Utility.CopyFile import Utility.Metered import Config+import Git.FilePath import Git.SharedRepository import Annex.Perms import Annex.Link-import Annex.Content.Direct+import qualified Annex.Content.Direct as Direct import Annex.ReplaceFile import Annex.LockPool import Messages.Progress import qualified Types.Remote import qualified Types.Backend import qualified Backend+import qualified Database.Keys import Types.NumCopies import Annex.UUID+import Annex.InodeSentinal+import Utility.InodeCache+import Utility.PosixFiles  {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool@@ -79,8 +93,11 @@ inAnnexCheck :: Key -> (FilePath -> Annex Bool) -> Annex Bool inAnnexCheck key check = inAnnex' id False check key -{- Generic inAnnex, handling both indirect and direct mode.+{- inAnnex that performs an arbitrary check of the key's content.  -+ - When the content is unlocked, it must also be unmodified, or the bad+ - value will be returned.+ -  - In direct mode, at least one of the associated files must pass the  - check. Additionally, the file must be unmodified.  -}@@ -88,14 +105,22 @@ inAnnex' isgood bad check key = withObjectLoc key checkindirect checkdirect   where 	checkindirect loc = do-		whenM (fromRepo Git.repoIsUrl) $-			error "inAnnex cannot check remote repo"-		check loc+		r <- check loc+		if isgood r+			then do+				cache <- Database.Keys.getInodeCaches key+				if null cache+					then return r+					else ifM (sameInodeCache loc cache)+						( return r+						, return bad+						)+			else return bad 	checkdirect [] = return bad 	checkdirect (loc:locs) = do 		r <- check loc 		if isgood r-			then ifM (goodContent key loc)+			then ifM (Direct.goodContent key loc) 				( return r 				, checkdirect locs 				)@@ -371,7 +396,7 @@ 	return res  {- Checks that there is disk space available to store a given key,- - in a destination (or the annex) printing a warning if not. + - in a destination directory (or the annex) printing a warning if not.   -  - If the destination is on the same filesystem as the annex,  - checks for any other running downloads, removing the amount of data still@@ -379,7 +404,12 @@  - when doing concurrent downloads.  -} checkDiskSpace :: Maybe FilePath -> Key -> Integer -> Bool -> Annex Bool-checkDiskSpace destdir key alreadythere samefilesystem = ifM (Annex.getState Annex.force)+checkDiskSpace destdir key = checkDiskSpace' (fromMaybe 1 (keySize key)) destdir key++{- Allows specifying the size of the key, if it's known, which is useful+ - as not all keys know their size. -}+checkDiskSpace' :: Integer -> Maybe FilePath -> Key -> Integer -> Bool -> Annex Bool+checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getState Annex.force) 	( return True 	, do 		-- We can't get inprogress and free at the same@@ -392,8 +422,8 @@ 			then sizeOfDownloadsInProgress (/= key) 			else pure 0 		free <- liftIO . getDiskFree =<< dir-		case (free, fromMaybe 1 (keySize key)) of-			(Just have, need) -> do+		case free of+			Just have -> do 				reserve <- annexDiskReserve <$> Annex.getGitConfig 				let delta = need + reserve - have - alreadythere + inprogress 				let ok = delta <= 0@@ -412,7 +442,10 @@  {- Moves a key's content into .git/annex/objects/  -- - In direct mode, moves it to the associated file, or files.+ - When a key has associated pointer files, the object is hard+ - linked (or copied) to the files, and the object file is left thawed.+ + - In direct mode, moves the object file to the associated file, or files.  -  - What if the key there already has content? This could happen for  - various reasons; perhaps the same content is being annexed again.@@ -439,8 +472,14 @@ 	storeobject dest = ifM (liftIO $ doesFileExist dest) 		( alreadyhave 		, modifyContent dest $ do+			freezeContent src 			liftIO $ moveFile src dest-			freezeContent dest+			g <- Annex.gitRepo +			fs <- map (`fromTopFilePath` g)+				<$> Database.Keys.getAssociatedFiles key+			unless (null fs) $ do+				mapM_ (populatePointerFile key dest) fs+				Database.Keys.storeInodeCaches key (dest:fs) 		) 	storeindirect = storeobject =<< calcRepo (gitAnnexLocation key) @@ -458,21 +497,142 @@ 		v <- isAnnexLink f 		if Just key == v 			then do-				updateInodeCache key src+				Direct.updateInodeCache key src 				replaceFile f $ liftIO . moveFile src 				chmodContent f 				forM_ fs $-					addContentWhenNotPresent key f-			else ifM (goodContent key f)+					Direct.addContentWhenNotPresent key f+			else ifM (Direct.goodContent key f) 				( storedirect' alreadyhave fs 				, storedirect' fallback fs 				) 	 	alreadyhave = liftIO $ removeFile src +populatePointerFile :: Key -> FilePath -> FilePath -> Annex ()+populatePointerFile k obj f = go =<< liftIO (isPointerFile f)+  where+	go (Just k') | k == k' = do+		liftIO $ nukeFile f+		ifM (linkOrCopy k obj f)+			( thawContent f+			, liftIO $ writeFile f (formatPointer k)+			)+	go _ = return ()++data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop++{- Populates the annex object file by hard linking or copying a source+ - file to it. -}+linkToAnnex :: Key -> FilePath -> Maybe InodeCache -> Annex LinkAnnexResult+linkToAnnex key src srcic = do+	dest <- calcRepo (gitAnnexLocation key)+	modifyContent dest $ linkAnnex To key src srcic dest++{- Makes a destination file be a link or copy from the annex object. -}+linkFromAnnex :: Key -> FilePath -> Annex LinkAnnexResult+linkFromAnnex key dest = do+	src <- calcRepo (gitAnnexLocation key)+	srcic <- withTSDelta (liftIO . genInodeCache src)+	linkAnnex From key src srcic dest++data FromTo = From | To++{- Hard links or copies from or to the annex object location. + - Updates inode cache.+ -+ - Thaws the file that is not the annex object.+ - When a hard link was made, this necessarily thaws+ - the annex object too. So, adding an object to the annex this+ - way can prevent losing the content if the source file+ - is deleted, but does not guard against modifications.+ -}+linkAnnex :: FromTo -> Key -> FilePath -> Maybe InodeCache -> FilePath -> Annex LinkAnnexResult+linkAnnex _ _ _ Nothing _ = return LinkAnnexFailed+linkAnnex fromto key src (Just srcic) dest = do+	mdestic <- withTSDelta (liftIO . genInodeCache dest)+	case mdestic of+		Just destic -> do+			cs <- Database.Keys.getInodeCaches key+			if null cs+				then Database.Keys.addInodeCaches key [srcic, destic]+				else Database.Keys.addInodeCaches key [srcic]+			return LinkAnnexNoop+		Nothing -> ifM (linkOrCopy key src dest)+			( do+				thawContent $ case fromto of+					From -> dest+					To -> src+				checksrcunchanged+			, failed+			)+  where+	failed = do+		Database.Keys.addInodeCaches key [srcic]+		return LinkAnnexFailed+	checksrcunchanged = do+		mcache <- withTSDelta (liftIO . genInodeCache src)+		case mcache of+			Just srcic' | compareStrong srcic srcic' -> do+				destic <- withTSDelta (liftIO . genInodeCache dest)+				Database.Keys.addInodeCaches key $+					catMaybes [destic, Just srcic]+				return LinkAnnexOk+			_ -> do+				liftIO $ nukeFile dest+				failed++{- Hard links or copies src to dest. Only uses a hard link when annex.thin+ - is enabled and when src is not already hardlinked to elsewhere.+ - Checks disk reserve before copying against the size of the key,+ - and will fail if not enough space, or if the dest file already exists. -}+linkOrCopy :: Key -> FilePath -> FilePath -> Annex Bool+linkOrCopy = linkOrCopy' (annexThin <$> Annex.getGitConfig)++linkOrCopy' :: Annex Bool -> Key -> FilePath -> FilePath -> Annex Bool+linkOrCopy' canhardlink key src dest = catchBoolIO $+	ifM canhardlink+		( hardlink+		, copy =<< getstat+		)+  where+	hardlink = do+		s <- getstat+#ifndef mingw32_HOST_OS+		if linkCount s > 1+			then copy s+			else liftIO (createLink src dest >> return True)+				`catchIO` const (copy s)+#else+		copy s+#endif+	copy = checkedCopyFile' key src dest+	getstat = liftIO $ getFileStatus src++{- Removes the annex object file for a key. Lowlevel. -}+unlinkAnnex :: Key -> Annex ()+unlinkAnnex key = do+	obj <- calcRepo $ gitAnnexLocation key+	modifyContent obj $ do+		secureErase obj+		liftIO $ nukeFile obj++{- Checks disk space before copying. -}+checkedCopyFile :: Key -> FilePath -> FilePath -> Annex Bool+checkedCopyFile key src dest = catchBoolIO $+	checkedCopyFile' key src dest+		=<< liftIO (getFileStatus src)++checkedCopyFile' :: Key -> FilePath -> FilePath -> FileStatus -> Annex Bool+checkedCopyFile' key src dest s = catchBoolIO $+	ifM (checkDiskSpace' (fromIntegral $ fileSize s) (Just $ takeDirectory dest) key 0 True)+		( liftIO $ copyFileExternal CopyAllMetaData src dest+		, return False+		)+ {- Runs an action to transfer an object's content.  -- - In direct mode, it's possible for the file to change as it's being sent.+ - In some cases, it's possible for the file to change as it's being sent.  - If this happens, runs the rollback action and returns False. The  - rollback action should remove the data that was transferred.  -}@@ -492,8 +652,9 @@ {- Returns a file that contains an object's content,  - and a check to run after the transfer is complete.  -- - In direct mode, it's possible for the file to change as it's being sent,- - and the check detects this case and returns False.+ - When a file is unlocked (or in direct mode), it's possble for its+ - content to change as it's being sent. The check detects this case+ - and returns False.  -  - Note that the returned check action is, in some cases, run in the  - Annex monad of the remote that is receiving the object, rather than@@ -502,10 +663,23 @@ prepSendAnnex :: Key -> Annex (Maybe (FilePath, Annex Bool)) prepSendAnnex key = withObjectLoc key indirect direct   where-	indirect f = return $ Just (f, return True)+	indirect f = do+		cache <- Database.Keys.getInodeCaches key+		cache' <- if null cache+			-- Since no inode cache is in the database, this+			-- object is not currently unlocked. But that could+			-- change while the transfer is in progress, so+			-- generate an inode cache for the starting+			-- content.+			then maybeToList <$>+				withTSDelta (liftIO . genInodeCache f)+			else pure cache+		return $ if null cache'+			then Nothing+			else Just (f, sameInodeCache f cache') 	direct [] = return Nothing 	direct (f:fs) = do-		cache <- recordedInodeCache key+		cache <- Direct.recordedInodeCache key 		-- check that we have a good file 		ifM (sameInodeCache f cache) 			( return $ Just (f, sameInodeCache f cache)@@ -520,7 +694,7 @@ withObjectLoc :: Key -> (FilePath -> Annex a) -> ([FilePath] -> Annex a) -> Annex a withObjectLoc key indirect direct = ifM isDirect 	( do-		fs <- associatedFiles key+		fs <- Direct.associatedFiles key 		if null fs 			then goindirect 			else direct fs@@ -544,6 +718,9 @@  {- Removes a key's file from .git/annex/objects/  -+ - When a key has associated pointer files, they are checked for+ - modifications, and if unmodified, are reset.+ -  - In direct mode, deletes the associated files or files, and replaces  - them with symlinks.  -}@@ -553,16 +730,51 @@ 	remove file = cleanObjectLoc key $ do 		secureErase file 		liftIO $ nukeFile file-		removeInodeCache key+		g <- Annex.gitRepo +		mapM_ (\f -> void $ tryIO $ resetpointer $ fromTopFilePath f g)+			=<< Database.Keys.getAssociatedFiles key+		Database.Keys.removeInodeCaches key+		Direct.removeInodeCache key+	resetpointer file = ifM (isUnmodified key file)+		( do+			secureErase file+			liftIO $ nukeFile file+			liftIO $ writeFile file (formatPointer key)	+		-- Can't delete the pointer file.+		-- If it was a hard link to the annex object,+		-- that object might have been frozen as part of the+		-- removal process, so thaw it.+		, void $ tryIO $ thawContent file+		) 	removedirect fs = do-		cache <- recordedInodeCache key-		removeInodeCache key+		cache <- Direct.recordedInodeCache key+		Direct.removeInodeCache key 		mapM_ (resetfile cache) fs-	resetfile cache f = whenM (sameInodeCache f cache) $ do+	resetfile cache f = whenM (Direct.sameInodeCache f cache) $ do 		l <- calcRepo $ gitAnnexLink f key 		secureErase f 		replaceFile f $ makeAnnexLink l +{- Check if a file contains the unmodified content of the key.+ -+ - The expensive way to tell is to do a verification of its content.+ - The cheaper way is to see if the InodeCache for the key matches the+ - file. -}+isUnmodified :: Key -> FilePath -> Annex Bool+isUnmodified key f = go =<< geti+  where+	go Nothing = return False+	go (Just fc) = cheapcheck fc <||> expensivecheck fc+	cheapcheck fc = anyM (compareInodeCaches fc)+		=<< Database.Keys.getInodeCaches key+	expensivecheck fc = ifM (verifyKeyContent AlwaysVerify Types.Remote.UnVerified key f)+		-- The file could have been modified while it was+		-- being verified. Detect that.+		( geti >>= maybe (return False) (compareInodeCaches fc)+		, return False+		)+	geti = withTSDelta (liftIO . genInodeCache f)+ {- Runs the secure erase command if set, otherwise does nothing.  - File may or may not be deleted at the end; caller is responsible for  - making sure it's deleted. -}@@ -586,13 +798,14 @@ 	logStatus key InfoMissing 	return dest -data KeyLocation = InAnnex | InRepository+data KeyLocation = InAnnex | InRepository | InAnywhere  {- List of keys whose content exists in the specified location.  - - InAnnex only lists keys under .git/annex/objects,- - while InRepository, in direct mode, also finds keys located in the- - work tree.+ - InAnnex only lists keys with content in .git/annex/objects,+ - while InRepository, in direct mode, also finds keys with content+ - in the work tree. InAnywhere lists all keys that have directories+ - in .git/annex/objects, whether or not the content is present.  -  - Note that InRepository has to check whether direct mode files  - have goodContent.@@ -621,6 +834,11 @@ 		morekeys <- unsafeInterleaveIO a 		continue (morekeys++keys) as +	inanywhere = case keyloc of+		InAnywhere -> True+		_ -> False++	present _ _ _ | inanywhere = pure True 	present _ False d = presentInAnnex d 	present s True d = presentDirect s d <||> presentInAnnex d @@ -632,7 +850,8 @@ 		InRepository -> case fileKey (takeFileName d) of 			Nothing -> return False 			Just k -> Annex.eval s $ -				anyM (goodContent k) =<< associatedFiles k+				anyM (Direct.goodContent k) =<< Direct.associatedFiles k+		InAnywhere -> return True  	{- In order to run Annex monad actions within unsafeInterleaveIO, 	 - the current state is taken and reused. No changes made to this
Annex/Content/Direct.hs view
@@ -1,12 +1,13 @@ {- git-annex file content managing for direct mode  -+ - This is deprecated, and will be removed when direct mode gets removed+ - from git-annex.+ -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Annex.Content.Direct ( 	associatedFiles, 	associatedFilesRelative,@@ -20,21 +21,15 @@ 	addInodeCache, 	writeInodeCache, 	compareInodeCaches,-	compareInodeCachesWith, 	sameInodeCache, 	elemInodeCaches, 	sameFileStatus, 	removeInodeCache, 	toInodeCache,-	inodesChanged,-	createInodeSentinalFile, 	addContentWhenNotPresent,-	withTSDelta,-	getTSDelta, ) where  import Common.Annex-import qualified Annex import Annex.Perms import qualified Git import Utility.Tmp@@ -43,6 +38,7 @@ import Utility.CopyFile import Annex.ReplaceFile import Annex.Link+import Annex.InodeSentinal  {- Absolute FilePaths of Files in the tree that are associated with a key. -} associatedFiles :: Key -> Annex [FilePath]@@ -165,14 +161,6 @@ withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key) -{- Checks if a InodeCache matches the current version of a file. -}-sameInodeCache :: FilePath -> [InodeCache] -> Annex Bool-sameInodeCache _ [] = return False-sameInodeCache file old = go =<< withTSDelta (liftIO . genInodeCache file)-  where-	go Nothing = return False-	go (Just curr) = elemInodeCaches curr old- {- Checks if a FileStatus matches the recorded InodeCache of a file. -} sameFileStatus :: Key -> FilePath -> FileStatus -> Annex Bool sameFileStatus key f status = do@@ -183,25 +171,6 @@ 		([], Nothing) -> return True 		_ -> return False -{- If the inodes have changed, only the size and mtime are compared. -}-compareInodeCaches :: InodeCache -> InodeCache -> Annex Bool-compareInodeCaches x y-	| compareStrong x y = return True-	| otherwise = ifM inodesChanged-		( return $ compareWeak x y-		, return False-		)--elemInodeCaches :: InodeCache -> [InodeCache] -> Annex Bool-elemInodeCaches _ [] = return False-elemInodeCaches c (l:ls) = ifM (compareInodeCaches c l)-	( return True-	, elemInodeCaches c ls-	)--compareInodeCachesWith :: Annex InodeComparisonType-compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly )- {- Copies the contentfile to the associated file, if the associated  - file has no content. If the associated file does have content,  - even if the content differs, it's left unchanged. -}@@ -212,52 +181,3 @@ 		replaceFile associatedfile $ 			liftIO . void . copyFileExternal CopyAllMetaData contentfile 	updateInodeCache key associatedfile	--{- Some filesystems get new inodes each time they are mounted.- - In order to work on such a filesystem, a sentinal file is used to detect- - when the inodes have changed.- -- - If the sentinal file does not exist, we have to assume that the- - inodes have changed.- -}-inodesChanged :: Annex Bool-inodesChanged = sentinalInodesChanged <$> sentinalStatus--withTSDelta :: (TSDelta -> Annex a) -> Annex a-withTSDelta a = a =<< getTSDelta--getTSDelta :: Annex TSDelta-#ifdef mingw32_HOST_OS-getTSDelta = sentinalTSDelta <$> sentinalStatus-#else-getTSDelta = pure noTSDelta -- optimisation-#endif--sentinalStatus :: Annex SentinalStatus-sentinalStatus = maybe check return =<< Annex.getState Annex.sentinalstatus-  where-	check = do-		sc <- liftIO . checkSentinalFile =<< annexSentinalFile-		Annex.changeState $ \s -> s { Annex.sentinalstatus = Just sc }-		return sc--{- The sentinal file is only created when first initializing a repository.- - If there are any annexed objects in the repository already, creating- - the file would invalidate their inode caches. -}-createInodeSentinalFile :: Annex ()-createInodeSentinalFile = unlessM (alreadyexists <||> hasobjects) $ do-	s <- annexSentinalFile-	createAnnexDirectory (parentDir (sentinalFile s))-	liftIO $ writeSentinalFile s-  where-	alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile-	hasobjects = liftIO . doesDirectoryExist =<< fromRepo gitAnnexObjectDir--annexSentinalFile :: Annex SentinalFile-annexSentinalFile = do-	sentinalfile <- fromRepo gitAnnexInodeSentinal-	sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache-	return SentinalFile-		{ sentinalFile = sentinalfile-		, sentinalCacheFile = sentinalcachefile-		}
Annex/Direct.hs view
@@ -1,5 +1,8 @@ {- git-annex direct mode  -+ - This is deprecated, and will be removed when direct mode gets removed+ - from git-annex.+ -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.@@ -36,6 +39,7 @@ import Git.Index import Annex.Index import Annex.LockFile+import Annex.InodeSentinal  {- Uses git ls-files to find files that need to be committed, and stages  - them into the index. Returns True if some changes were staged. -}@@ -53,8 +57,8 @@ 	{- Determine what kind of modified or deleted file this is, as 	 - efficiently as we can, by getting any key that's associated 	 - with it in git, as well as its stat info. -}-	go (file, Just sha, Just mode) = withTSDelta $ \delta -> do-		shakey <- catKey sha mode+	go (file, Just sha, Just _mode) = withTSDelta $ \delta -> do+		shakey <- catKey sha 		mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file 		mcache <- liftIO $ maybe (pure Nothing) (toInodeCache delta file) mstat 		filekey <- isAnnexLink file@@ -107,8 +111,8 @@ 		withkey (DiffTree.srcsha diff) (DiffTree.srcmode diff) removeAssociatedFile 		withkey (DiffTree.dstsha diff) (DiffTree.dstmode diff) addAssociatedFile 	  where-		withkey sha mode a = when (sha /= nullSha) $ do-			k <- catKey sha mode+		withkey sha _mode a = when (sha /= nullSha) $ do+			k <- catKey sha 			case k of 				Nothing -> noop 				Just key -> void $ a key $@@ -256,16 +260,16 @@ 	makeabs <- flip fromTopFilePath <$> gitRepo 	let fsitems = zip (map (makeabs . DiffTree.file) items) items 	forM_ fsitems $-		go makeabs DiffTree.srcsha DiffTree.srcmode moveout moveout_raw+		go makeabs DiffTree.srcsha moveout moveout_raw 	forM_ fsitems $-		go makeabs DiffTree.dstsha DiffTree.dstmode movein movein_raw+		go makeabs DiffTree.dstsha movein movein_raw 	void $ liftIO cleanup   where-	go makeabs getsha getmode a araw (f, item)+	go makeabs getsha a araw (f, item) 		| getsha item == nullSha = noop 		| otherwise = void $ 			tryNonAsync . maybe (araw item makeabs f) (\k -> void $ a item makeabs k f)-				=<< catKey (getsha item) (getmode item)+				=<< catKey (getsha item)  	moveout _ _ = removeDirect @@ -395,7 +399,7 @@ 	whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ 		logStatus oldk InfoMissing -{- Enable/disable direct mode. -}+{- Git config settings to enable/disable direct mode. -} setDirect :: Bool -> Annex () setDirect wantdirect = do 	if wantdirect
Annex/Drop.hs view
@@ -18,6 +18,8 @@ import Annex.Wanted import Config import Annex.Content.Direct+import qualified Database.Keys+import Git.FilePath  import qualified Data.Set as S import System.Log.Logger (debugM)@@ -46,14 +48,11 @@  -} handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> [VerifiedCopy] -> (CommandStart -> CommandCleanup) -> Annex () handleDropsFrom locs rs reason fromhere key afile preverified runner = do-	fs <- ifM isDirect-		( do-			l <- associatedFilesRelative key-			return $ if null l-				then maybeToList afile-				else l-		, return $ maybeToList afile+	l <- ifM isDirect+		( associatedFilesRelative key+		, mapM getTopFilePath <$> Database.Keys.getAssociatedFiles key 		)+	let fs = if null l then maybeToList afile else l 	n <- getcopies fs 	void $ if fromhere && checkcopies n Nothing 		then go fs rs n >>= dropl fs
Annex/FileMatcher.hs view
@@ -14,7 +14,6 @@ import Utility.Matcher import Types.Group import Logs.Group-import Logs.Remote import Annex.UUID import qualified Annex import Types.FileMatcher@@ -53,8 +52,8 @@ 	([], vs) -> Right $ generate vs 	(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es -exprParser :: FileMatcher Annex -> FileMatcher Annex -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token (MatchFiles Annex))]-exprParser matchstandard matchgroupwanted groupmap configmap mu expr =+exprParser :: FileMatcher Annex -> FileMatcher Annex -> Annex GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token (MatchFiles Annex))]+exprParser matchstandard matchgroupwanted getgroupmap configmap mu expr = 	map parse $ tokenizeMatcher expr   where 	parse = parseToken@@ -62,12 +61,12 @@ 		matchgroupwanted 		(limitPresent mu) 		(limitInDir preferreddir)-		groupmap+		getgroupmap 	preferreddir = fromMaybe "public" $ 		M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu -parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> GroupMap -> String -> Either String (Token (MatchFiles Annex))-parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupmap t+parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> Annex GroupMap -> String -> Either String (Token (MatchFiles Annex))+parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir getgroupmap t 	| t `elem` tokens = Right $ token t 	| t == "standard" = call matchstandard 	| t == "groupwanted" = call matchgroupwanted@@ -86,7 +85,7 @@ 			, ("largerthan", limitSize (>)) 			, ("smallerthan", limitSize (<)) 			, ("metadata", limitMetaData)-			, ("inallgroup", limitInAllGroup groupmap)+			, ("inallgroup", limitInAllGroup getgroupmap) 			]   where 	(k, v) = separate (== '=') t@@ -109,9 +108,12 @@   where 	go Nothing = return matchAll 	go (Just expr) = do-		gm <- groupMap-		rc <- readRemoteLog 		u <- getUUID+		-- No need to read remote configs, that's only needed for+		-- inpreferreddir, which is used in preferred content+		-- expressions but does not make sense in the +		-- annex.largefiles expression.+		let emptyconfig = M.empty 		either badexpr return $-			parsedToMatcher $ exprParser matchAll matchAll gm rc (Just u) expr+			parsedToMatcher $ exprParser matchAll matchAll groupMap emptyconfig (Just u) expr 	badexpr e = error $ "bad annex.largefiles configuration: " ++ e
+ Annex/Ingest.hs view
@@ -0,0 +1,297 @@+{- git-annex content ingestion+ -+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Annex.Ingest (+	LockedDown(..),+	LockDownConfig(..),+	lockDown,+	ingest,+	finishIngestDirect,+	finishIngestUnlocked,+	cleanOldKeys,+	addLink,+	makeLink,+	restoreFile,+	forceParams,+) where++import Common.Annex+import Types.KeySource+import Backend+import Annex.Content+import Annex.Content.Direct+import Annex.Perms+import Annex.Link+import Annex.MetaData+import Logs.Location+import qualified Annex+import qualified Annex.Queue+import qualified Database.Keys+import Config+import Utility.InodeCache+import Annex.ReplaceFile+import Utility.Tmp+import Utility.CopyFile+import Git.FilePath+import Annex.InodeSentinal+#ifdef WITH_CLIBS+#ifndef __ANDROID__+import Utility.Touch+#endif+#endif++import Control.Exception (IOException)++data LockedDown = LockedDown+	{ lockDownConfig :: LockDownConfig+	, keySource :: KeySource+	}+	deriving (Show)++data LockDownConfig = LockDownConfig+	{ lockingFile :: Bool -- ^ write bit removed during lock down+	, hardlinkFileTmp :: Bool -- ^ hard link to temp directory+	}+	deriving (Show)++{- The file that's being ingested is locked down before a key is generated,+ - to prevent it from being modified in between. This lock down is not+ - perfect at best (and pretty weak at worst). For example, it does not+ - guard against files that are already opened for write by another process.+ - So, the InodeCache can be used to detect any changes that might be made+ - to the file after it was locked down.+ -+ - When possible, the file is hard linked to a temp directory. This guards+ - against some changes, like deletion or overwrite of the file, and+ - allows lsof checks to be done more efficiently when adding a lot of files.+ -+ - Lockdown can fail if a file gets deleted, and Nothing will be returned.+ -}+lockDown :: LockDownConfig -> FilePath -> Annex (Maybe LockedDown)+lockDown cfg file = either +		(\e -> warning (show e) >> return Nothing)+		(return . Just)+	=<< lockDown' cfg file++lockDown' :: LockDownConfig -> FilePath -> Annex (Either IOException LockedDown)+lockDown' cfg file = ifM (pure (not (hardlinkFileTmp cfg)) <||> crippledFileSystem)+	( withTSDelta $ liftIO . tryIO . nohardlink+	, tryIO $ do+		tmp <- fromRepo gitAnnexTmpMiscDir+		createAnnexDirectory tmp+		when (lockingFile cfg) $+			freezeContent file+		withTSDelta $ \delta -> liftIO $ do+			(tmpfile, h) <- openTempFile tmp $+				relatedTemplate $ takeFileName file+			hClose h+			nukeFile tmpfile+			withhardlink delta tmpfile `catchIO` const (nohardlink delta)+	)+  where+	nohardlink delta = do+		cache <- genInodeCache file delta+		return $ LockedDown cfg $ KeySource+			{ keyFilename = file+			, contentLocation = file+			, inodeCache = cache+			}+	withhardlink delta tmpfile = do+		createLink file tmpfile+		cache <- genInodeCache tmpfile delta+		return $ LockedDown cfg $ KeySource+			{ keyFilename = file+			, contentLocation = tmpfile+			, inodeCache = cache+			}++{- Ingests a locked down file into the annex.+ -+ - The file may be added to the git repository as a locked or an unlocked+ - file. When unlocked, the work tree file is left alone. When locked, + - the work tree file is deleted, in preparation for adding the symlink.+ -}+ingest :: Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache)+ingest Nothing = return (Nothing, Nothing)+ingest (Just (LockedDown cfg source)) = withTSDelta $ \delta -> do+	backend <- chooseBackend $ keyFilename source+	k <- genKey source backend+	let src = contentLocation source+	ms <- liftIO $ catchMaybeIO $ getFileStatus src+	mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta src) ms+	case (mcache, inodeCache source) of+		(_, Nothing) -> go k mcache ms+		(Just newc, Just c) | compareStrong c newc -> go k mcache ms+		_ -> failure "changed while it was being added"+  where+	go (Just (key, _)) mcache (Just s)+		| lockingFile cfg = golocked key mcache s+		| otherwise = ifM isDirect+			( godirect key mcache s+			, gounlocked key mcache s+			)+	go _ _ _ = failure "failed to generate a key"++	golocked key mcache s = do+		catchNonAsync (moveAnnex key $ contentLocation source)+			(restoreFile (keyFilename source) key)+		liftIO $ nukeFile $ keyFilename source+		populateAssociatedFiles key source+		success key mcache s++	gounlocked key (Just cache) s = do+		-- Remove temp directory hard link first because+		-- linkToAnnex falls back to copying if a file+		-- already has a hard link.+		cleanCruft source+		cleanOldKeys (keyFilename source) key+		r <- linkToAnnex key (keyFilename source) (Just cache)+		case r of+			LinkAnnexFailed -> failure "failed to link to annex"+			_ -> do+				finishIngestUnlocked' key source+				success key (Just cache) s+	gounlocked _ _ _ = failure "failed statting file"++	godirect key (Just cache) s = do+		addInodeCache key cache+		finishIngestDirect key source+		success key (Just cache) s+	godirect _ _ _ = failure "failed statting file"++	success k mcache s = do+		genMetaData k (keyFilename source) s+		return (Just k, mcache)++	failure msg = do+		warning $ keyFilename source ++ " " ++ msg+		cleanCruft source+		return (Nothing, Nothing)++finishIngestDirect :: Key -> KeySource -> Annex ()+finishIngestDirect key source = do+	void $ addAssociatedFile key $ keyFilename source+	cleanCruft source++	{- Copy to any other locations using the same key. -}+	otherfs <- filter (/= keyFilename source) <$> associatedFiles key+	forM_ otherfs $+		addContentWhenNotPresent key (keyFilename source)++finishIngestUnlocked :: Key -> KeySource -> Annex ()+finishIngestUnlocked key source = do+	cleanCruft source+	finishIngestUnlocked' key source++finishIngestUnlocked' :: Key -> KeySource -> Annex ()+finishIngestUnlocked' key source = do+	Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath (keyFilename source))+	populateAssociatedFiles key source++{- Copy to any other locations using the same key. -}+populateAssociatedFiles :: Key -> KeySource -> Annex ()+populateAssociatedFiles key source = do+	obj <- calcRepo (gitAnnexLocation key)+	g <- Annex.gitRepo+	ingestedf <- flip fromTopFilePath g+		<$> inRepo (toTopFilePath (keyFilename source))+	afs <- map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key+	forM_ (filter (/= ingestedf) afs) $+		populatePointerFile key obj++cleanCruft :: KeySource -> Annex ()+cleanCruft source = when (contentLocation source /= keyFilename source) $+	liftIO $ nukeFile $ contentLocation source++-- If a worktree file was was hard linked to an annex object before,+-- modifying the file would have caused the object to have the wrong+-- content. Clean up from that.+cleanOldKeys :: FilePath -> Key -> Annex ()+cleanOldKeys file newkey = do+	g <- Annex.gitRepo+	ingestedf <- flip fromTopFilePath g <$> inRepo (toTopFilePath file)+	topf <- inRepo (toTopFilePath file)+	oldkeys <- filter (/= newkey)+		<$> Database.Keys.getAssociatedKey topf+	forM_ oldkeys $ \key -> do+		obj <- calcRepo (gitAnnexLocation key)+		caches <- Database.Keys.getInodeCaches key+		unlessM (sameInodeCache obj caches) $ do+			unlinkAnnex key+			fs <- filter (/= ingestedf)+				. map (`fromTopFilePath` g)+				<$> Database.Keys.getAssociatedFiles key+			fs' <- filterM (`sameInodeCache` caches) fs+			case fs' of+				-- If linkToAnnex fails, the associated +				-- file with the content is still present,+				-- so no need for any recovery.+				(f:_) -> do+					ic <- withTSDelta (liftIO . genInodeCache f)+					void $ linkToAnnex key f ic+				_ -> logStatus key InfoMissing++{- On error, put the file back so it doesn't seem to have vanished.+ - This can be called before or after the symlink is in place. -}+restoreFile :: FilePath -> Key -> SomeException -> Annex a+restoreFile file key e = do+	whenM (inAnnex key) $ do+		liftIO $ nukeFile file+		-- The key could be used by other files too, so leave the+		-- content in the annex, and make a copy back to the file.+		obj <- calcRepo $ gitAnnexLocation key+		unlessM (liftIO $ copyFileExternal CopyTimeStamps obj file) $+			warning $ "Unable to restore content of " ++ file ++ "; it should be located in " ++ obj+		thawContent file+	throwM e++{- Creates the symlink to the annexed content, returns the link target. -}+makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex String+makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do+	l <- calcRepo $ gitAnnexLink file key+	replaceFile file $ makeAnnexLink l++	-- touch symlink to have same time as the original file,+	-- as provided in the InodeCache+	case mcache of+#if defined(WITH_CLIBS) && ! defined(__ANDROID__)+		Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False+#else+		Just _ -> noop+#endif+		Nothing -> noop++	return l++{- Creates the symlink to the annexed content, and stages it in git.+ -+ - As long as the filesystem supports symlinks, we use+ - git add, rather than directly staging the symlink to git.+ - Using git add is best because it allows the queuing to work+ - and is faster (staging the symlink runs hash-object commands each time).+ - Also, using git add allows it to skip gitignored files, unless forced+ - to include them.+ -}+addLink :: FilePath -> Key -> Maybe InodeCache -> Annex ()+addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)+	( do+		_ <- makeLink file key mcache+		ps <- forceParams+		Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]+	, do+		l <- makeLink file key mcache+		addAnnexLink l file+	)++{- Parameters to pass to git add, forcing addition of ignored files. -}+forceParams :: Annex [CommandParam]+forceParams = ifM (Annex.getState Annex.force)+	( return [Param "-f"]+	, return []+	)
Annex/Init.hs view
@@ -1,6 +1,6 @@ {- git-annex repository initialization  -- - Copyright 2011 Joey Hess <id@joeyh.name>+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -29,13 +29,14 @@ import Annex.Version import Annex.Difference import Annex.UUID+import Annex.Link import Config import Annex.Direct-import Annex.Content.Direct import Annex.Environment-import Backend import Annex.Hook+import Annex.InodeSentinal import Upgrade+import qualified Database.Keys #ifndef mingw32_HOST_OS import Utility.UserInfo import Utility.FileMode@@ -57,8 +58,8 @@ 	return $ concat [hostname, ":", reldir] #endif -initialize :: Maybe String -> Annex ()-initialize mdescription = do+initialize :: Maybe String -> Maybe Version -> Annex ()+initialize mdescription mversion = do 	{- Has to come before any commits are made as the shared 	 - clone heuristic expects no local objects. -} 	sharedclone <- checkSharedClone@@ -68,7 +69,7 @@ 	ensureCommit $ Annex.Branch.create  	prepUUID-	initialize'+	initialize' mversion 	 	initSharedClone sharedclone @@ -77,15 +78,19 @@  -- Everything except for uuid setup, shared clone setup, and initial -- description.-initialize' :: Annex ()-initialize' = do+initialize' :: Maybe Version -> Annex ()+initialize' mversion = do 	checkLockSupport 	checkFifoSupport 	checkCrippledFileSystem 	unlessM isBare $ 		hookWrite preCommitHook 	setDifferences-	setVersion supportedVersion+	unlessM (isJust <$> getVersion) $+		setVersion (fromMaybe defaultVersion mversion)+	whenM versionSupportsUnlockedPointers $ do+		configureSmudgeFilter+		Database.Keys.scanAssociatedFiles 	ifM (crippledFileSystem <&&> not <$> isBare) 		( do 			enableDirectMode@@ -95,7 +100,7 @@ 		, unlessM isBare 			switchHEADBack 		)-	createInodeSentinalFile+	createInodeSentinalFile False  uninitialize :: Annex () uninitialize = do@@ -114,7 +119,7 @@ ensureInitialized = getVersion >>= maybe needsinit checkUpgrade   where 	needsinit = ifM Annex.Branch.hasSibling-			( initialize Nothing+			( initialize Nothing Nothing 			, error "First run: git-annex init" 			)
+ Annex/InodeSentinal.hs view
@@ -0,0 +1,96 @@+{- git-annex inode sentinal file+ -+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Annex.InodeSentinal where++import Common.Annex+import qualified Annex+import Utility.InodeCache+import Annex.Perms++{- If the sendinal shows the inodes have changed, only the size and mtime+ - are compared. -}+compareInodeCaches :: InodeCache -> InodeCache -> Annex Bool+compareInodeCaches x y+	| compareStrong x y = return True+	| otherwise = ifM inodesChanged+		( return $ compareWeak x y+		, return False+		)++compareInodeCachesWith :: Annex InodeComparisonType+compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly )++{- Checks if one of the provided old InodeCache matches the current+ - version of a file. -}+sameInodeCache :: FilePath -> [InodeCache] -> Annex Bool+sameInodeCache _ [] = return False+sameInodeCache file old = go =<< withTSDelta (liftIO . genInodeCache file)+  where+	go Nothing = return False+	go (Just curr) = elemInodeCaches curr old++elemInodeCaches :: InodeCache -> [InodeCache] -> Annex Bool+elemInodeCaches _ [] = return False+elemInodeCaches c (l:ls) = ifM (compareInodeCaches c l)+	( return True+	, elemInodeCaches c ls+	)++{- Some filesystems get new inodes each time they are mounted.+ - In order to work on such a filesystem, a sentinal file is used to detect+ - when the inodes have changed.+ -+ - If the sentinal file does not exist, we have to assume that the+ - inodes have changed.+ -}+inodesChanged :: Annex Bool+inodesChanged = sentinalInodesChanged <$> sentinalStatus++withTSDelta :: (TSDelta -> Annex a) -> Annex a+withTSDelta a = a =<< getTSDelta++getTSDelta :: Annex TSDelta+#ifdef mingw32_HOST_OS+getTSDelta = sentinalTSDelta <$> sentinalStatus+#else+getTSDelta = pure noTSDelta -- optimisation+#endif++sentinalStatus :: Annex SentinalStatus+sentinalStatus = maybe check return =<< Annex.getState Annex.sentinalstatus+  where+	check = do+		sc <- liftIO . checkSentinalFile =<< annexSentinalFile+		Annex.changeState $ \s -> s { Annex.sentinalstatus = Just sc }+		return sc++{- The sentinal file is only created when first initializing a repository.+ - If there are any annexed objects in the repository already, creating+ - the file would invalidate their inode caches. -}+createInodeSentinalFile :: Bool -> Annex ()+createInodeSentinalFile evenwithobjects = +	unlessM (alreadyexists <||> hasobjects) $ do+		s <- annexSentinalFile+		createAnnexDirectory (parentDir (sentinalFile s))+		liftIO $ writeSentinalFile s+  where+	alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile+	hasobjects+		| evenwithobjects = pure False+		| otherwise = liftIO . doesDirectoryExist =<< fromRepo gitAnnexObjectDir++annexSentinalFile :: Annex SentinalFile+annexSentinalFile = do+	sentinalfile <- fromRepo gitAnnexInodeSentinal+	sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache+	return SentinalFile+		{ sentinalFile = sentinalfile+		, sentinalCacheFile = sentinalcachefile+		}
Annex/Link.hs view
@@ -5,8 +5,10 @@  - On other filesystems, git instead stores the symlink target in a regular  - file.  -- - Copyright 2013 Joey Hess <id@joeyh.name>+ - Pointer files are used instead of symlinks for unlocked files.  -+ - Copyright 2013-2015 Joey Hess <id@joeyh.name>+ -  - Licensed under the GNU GPL version 3 or higher.  -} @@ -19,7 +21,10 @@ import qualified Annex.Queue import Git.Types import Git.FilePath+import Types.Key +import qualified Data.ByteString.Lazy as L+ type LinkTarget = String  {- Checks if a file is a link to a key. -}@@ -105,8 +110,49 @@ hashSymlink' h linktarget = liftIO $ Git.HashObject.hashBlob h $ 	toInternalGitPath linktarget -{- Stages a symlink to the annex, using a Sha of its target. -}+{- Stages a symlink to an annexed object, using a Sha of its target. -} stageSymlink :: FilePath -> Sha -> Annex () stageSymlink file sha = 	Annex.Queue.addUpdateIndex =<< 		inRepo (Git.UpdateIndex.stageSymlink file sha)++{- Injects a pointer file content into git, returning its Sha. -}+hashPointerFile :: Key -> Annex Sha+hashPointerFile key = inRepo $ Git.HashObject.hashObject BlobObject $+	formatPointer key++{- Stages a pointer file, using a Sha of its content -}+stagePointerFile :: FilePath -> Sha -> Annex ()+stagePointerFile file sha =+	Annex.Queue.addUpdateIndex =<<+		inRepo (Git.UpdateIndex.stageFile sha FileBlob file)++{- Parses a symlink target or a pointer file to a Key.+ - Only looks at the first line, as pointer files can have subsequent+ - lines. -}+parseLinkOrPointer :: L.ByteString -> Maybe Key+parseLinkOrPointer = parseLinkOrPointer' . decodeBS . L.take maxsz+  where+	{- Want to avoid buffering really big files in git into+	 - memory when reading files that may be pointers.+	 -+	 - 8192 bytes is plenty for a pointer to a key.+	 - Pad some more to allow for any pointer files that might have+	 - lines after the key explaining what the file is used for. -}+	maxsz = 81920++parseLinkOrPointer' :: String -> Maybe Key+parseLinkOrPointer' s = headMaybe (lines (fromInternalGitPath s)) >>= go+  where+	go l+		| isLinkToAnnex l = file2key $ takeFileName l+		| otherwise = Nothing++formatPointer :: Key -> String+formatPointer k = +	toInternalGitPath (pathSeparator:objectDir </> key2file k) ++ "\n"++{- Checks if a file is a pointer to a key. -}+isPointerFile :: FilePath -> IO (Maybe Key)+isPointerFile f = catchDefaultIO Nothing $ +	parseLinkOrPointer <$> L.readFile f
Annex/MakeRepo.hs view
@@ -75,7 +75,7 @@  initRepo' :: Maybe String -> Maybe StandardGroup -> Annex () initRepo' desc mgroup = unlessM isInitialized $ do-	initialize desc+	initialize desc Nothing 	u <- getUUID 	maybe noop (defaultStandardGroup u) mgroup 	{- Ensure branch gets committed right away so it is
Annex/MetaData.hs view
@@ -30,7 +30,7 @@  - When the file has been modified, the metadata is copied over  - from the old key to the new key. Note that it looks at the old key as  - committed to HEAD -- the new key may or may not have already been staged- - in th annex.+ - in the index.  -  - Also, can generate new metadata, if configured to do so.  -}
Annex/Queue.hs view
@@ -25,29 +25,34 @@ addCommand :: String -> [CommandParam] -> [FilePath] -> Annex () addCommand command params files = do 	q <- get-	store <=< inRepo $ Git.Queue.addCommand command params files q+	store <=< flushWhenFull <=< inRepo $+		Git.Queue.addCommand command params files q  {- Adds an update-index stream to the queue. -} addUpdateIndex :: Git.UpdateIndex.Streamer -> Annex () addUpdateIndex streamer = do 	q <- get-	store <=< inRepo $ Git.Queue.addUpdateIndex streamer q+	store <=< flushWhenFull <=< inRepo $+		Git.Queue.addUpdateIndex streamer q -{- Runs the queue if it is full. Should be called periodically. -}-flushWhenFull :: Annex ()-flushWhenFull = do-	q <- get-	when (Git.Queue.full q) flush+{- Runs the queue if it is full. -}+flushWhenFull :: Git.Queue.Queue -> Annex Git.Queue.Queue+flushWhenFull q+	| Git.Queue.full q = flush' q+	| otherwise = return q  {- Runs (and empties) the queue. -} flush :: Annex () flush = do 	q <- get 	unless (0 == Git.Queue.size q) $ do-		showStoringStateAction-		q' <- inRepo $ Git.Queue.flush q-		store q'+		store =<< flush' q +flush' :: Git.Queue.Queue -> Annex Git.Queue.Queue+flush' q = do+	showStoringStateAction+	inRepo $ Git.Queue.flush q+ {- Gets the size of the queue. -} size :: Annex Int size = Git.Queue.size <$> get@@ -70,5 +75,4 @@ 	Just newq -> do 		q <- get 		let !q' = Git.Queue.merge q newq-		store q'-		flushWhenFull+		store =<< flushWhenFull q'
Annex/ReplaceFile.hs view
@@ -18,7 +18,7 @@  - which it can write to, and once done the temp file is moved into place  - and anything else in the temp directory is deleted.  -- - The action can throw an IO exception, in which case the temp directory+ - The action can throw an exception, in which case the temp directory  - will be deleted, and the existing file will be preserved.  -  - Throws an IO exception when it was unable to replace the file.
Annex/Version.hs view
@@ -15,14 +15,20 @@  type Version = String -supportedVersion :: Version-supportedVersion = "5"+defaultVersion :: Version+defaultVersion = "5" +latestVersion :: Version+latestVersion = "6"++supportedVersions :: [Version]+supportedVersions = ["5", "6"]+ upgradableVersions :: [Version] #ifndef mingw32_HOST_OS-upgradableVersions = ["0", "1", "2", "4"]+upgradableVersions = ["0", "1", "2", "4", "5"] #else-upgradableVersions = ["2", "3", "4"]+upgradableVersions = ["2", "3", "4", "5"] #endif  autoUpgradeableVersions :: [Version]@@ -33,6 +39,18 @@  getVersion :: Annex (Maybe Version) getVersion = annexVersion <$> Annex.getGitConfig++versionSupportsDirectMode :: Annex Bool+versionSupportsDirectMode = go <$> getVersion+  where+	go (Just "6") = False+	go _ = True++versionSupportsUnlockedPointers :: Annex Bool+versionSupportsUnlockedPointers = go <$> getVersion+  where+	go (Just "6") = True+	go _ = False  setVersion :: Version -> Annex () setVersion = setConfig versionField
Annex/View.hs view
@@ -22,7 +22,7 @@ import Git.HashObject import Git.Types import Git.FilePath-import qualified Backend+import Annex.WorkTree import Annex.Index import Annex.Link import Annex.CatFile@@ -31,7 +31,6 @@ import Utility.Glob import Utility.FileMode import Types.Command-import Config import CmdLine.Action  import qualified Data.Set as S@@ -223,36 +222,40 @@ 		| S.null s = Nothing 		| otherwise = Just (S.toList s) +-- This is '∕', a unicode character that displays the same as '/' but is+-- not it. It is encoded using the filesystem encoding, which allows it+-- to be used even when not in a unicode capable locale.+pseudoSlash :: String+pseudoSlash = "\56546\56456\56469"++-- And this is '╲' similarly.+pseudoBackslash :: String+pseudoBackslash = "\56546\56469\56498"+ toViewPath :: MetaValue -> FilePath-toViewPath = concatMap escapeslash . fromMetaValue+toViewPath = escapeslash [] . fromMetaValue   where-	escapeslash c-		| c == '/' = [pseudoSlash]-		| c == '\\' = [pseudoBackslash]-		| c == pseudoSlash = [pseudoSlash, pseudoSlash]-		| c == pseudoBackslash = [pseudoBackslash, pseudoBackslash]-		| otherwise = [c]+	escapeslash s ('/':cs) = escapeslash (pseudoSlash:s) cs+	escapeslash s ('\\':cs) = escapeslash (pseudoBackslash:s) cs+	escapeslash s ('%':cs) = escapeslash ("%%":s) cs+	escapeslash s (c1:c2:c3:cs)+		| [c1,c2,c3] == pseudoSlash = escapeslash ("%":pseudoSlash:s) cs+		| [c1,c2,c3] == pseudoBackslash = escapeslash ("%":pseudoBackslash:s) cs+		| otherwise = escapeslash ([c1]:s) (c2:c3:cs)+	escapeslash s cs = concat (reverse (cs:s))  fromViewPath :: FilePath -> MetaValue fromViewPath = toMetaValue . deescapeslash []   where-	deescapeslash s [] = reverse s-	deescapeslash s (c:cs)-		| c == pseudoSlash = case cs of-			(c':cs')-				| c' == pseudoSlash -> deescapeslash (pseudoSlash:s) cs'-			_ -> deescapeslash ('/':s) cs-		| c == pseudoBackslash = case cs of-			(c':cs')-				| c' == pseudoBackslash -> deescapeslash (pseudoBackslash:s) cs'-			_ -> deescapeslash ('/':s) cs-		| otherwise = deescapeslash (c:s) cs--pseudoSlash :: Char-pseudoSlash = '\8725' -- '∕' /= '/'+	deescapeslash s ('%':escapedc:cs) = deescapeslash ([escapedc]:s) cs+	deescapeslash s (c1:c2:c3:cs)+		| [c1,c2,c3] == pseudoSlash = deescapeslash ("/":s) cs+		| [c1,c2,c3] == pseudoBackslash = deescapeslash ("\\":s) cs+		| otherwise = deescapeslash ([c1]:s) (c2:c3:cs)+	deescapeslash s cs = concat (reverse (cs:s)) -pseudoBackslash :: Char-pseudoBackslash = '\9586' -- '╲' /= '\'+prop_viewPath_roundtrips :: MetaValue -> Bool+prop_viewPath_roundtrips v = fromViewPath (toViewPath v) == v  pathProduct :: [[FilePath]] -> [FilePath] pathProduct [] = []@@ -329,24 +332,23 @@  - Look up the metadata of annexed files, and generate any ViewedFiles,  - and stage them.  -- - Currently only works in indirect mode. Must be run from top of- - repository.+ - Must be run from top of repository.  -} applyView' :: MkViewedFile -> (FilePath -> MetaData) -> View -> Annex Git.Branch applyView' mkviewedfile getfilemetadata view = do 	top <- fromRepo Git.repoPath 	(l, clean) <- inRepo $ Git.LsFiles.inRepo [top] 	liftIO . nukeFile =<< fromRepo gitAnnexViewIndex-	genViewBranch view $ do-		uh <- inRepo Git.UpdateIndex.startUpdateIndex-		hasher <- inRepo hashObjectStart-		forM_ l $ \f -> do-			relf <- getTopFilePath <$> inRepo (toTopFilePath f)-			go uh hasher relf =<< Backend.lookupFile f-		liftIO $ do-			hashObjectStop hasher-			void $ stopUpdateIndex uh-			void clean+	uh <- withViewIndex $ inRepo Git.UpdateIndex.startUpdateIndex+	hasher <- inRepo hashObjectStart+	forM_ l $ \f -> do+		relf <- getTopFilePath <$> inRepo (toTopFilePath f)+		go uh hasher relf =<< lookupFile f+	liftIO $ do+		hashObjectStop hasher+		void $ stopUpdateIndex uh+		void clean+	genViewBranch view   where 	genviewedfiles = viewedFiles view mkviewedfile -- enables memoization 	go uh hasher f (Just k) = do@@ -373,24 +375,6 @@ 		liftIO . Git.UpdateIndex.streamUpdateIndex' uh 			=<< inRepo (Git.UpdateIndex.stageSymlink f sha) -{- Applies a view to the reference branch, generating a new branch- - for the View.- -- - This needs to work incrementally, to quickly update the view branch- - when the reference branch is changed. So, it works based on an- - old version of the reference branch, uses diffTree to find the- - changes, and applies those changes to the view branch.- -}-updateView :: View -> Git.Ref -> Git.Ref -> Annex Git.Branch-updateView view ref oldref = genViewBranch view $ do-	(diffs, cleanup) <- inRepo $ DiffTree.diffTree oldref ref-	forM_ diffs go-	void $ liftIO cleanup-  where-	go diff-		| DiffTree.dstsha diff == nullSha = error "TODO delete file"-		| otherwise = error "TODO add file"- {- Diff between currently checked out branch and staged changes, and  - update metadata to reflect the changes that are being committed to the  - view.@@ -404,47 +388,40 @@  -} withViewChanges :: (ViewedFile -> Key -> CommandStart) -> (ViewedFile -> Key -> CommandStart) -> Annex () withViewChanges addmeta removemeta = do-	makeabs <- flip fromTopFilePath <$> gitRepo 	(diffs, cleanup) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef 	forM_ diffs handleremovals-	forM_ diffs (handleadds makeabs)+	forM_ diffs handleadds 	void $ liftIO cleanup   where 	handleremovals item 		| DiffTree.srcsha item /= nullSha = 			handlechange item removemeta-				=<< catKey (DiffTree.srcsha item) (DiffTree.srcmode item)+				=<< catKey (DiffTree.srcsha item) 		| otherwise = noop-	handleadds makeabs item+	handleadds item 		| DiffTree.dstsha item /= nullSha =  			handlechange item addmeta-				=<< ifM isDirect-					( catKey (DiffTree.dstsha item) (DiffTree.dstmode item)-					-- optimisation-					, isAnnexLink $ makeabs $ DiffTree.file item-					)+				=<< catKey (DiffTree.dstsha item) 		| otherwise = noop 	handlechange item a = maybe noop 		(void . commandAction . a (getTopFilePath $ DiffTree.file item)) -{- Generates a branch for a view. This is done using a different index- - file. An action is run to stage the files that will be in the branch.- - Then a commit is made, to the view branch. The view branch is not- - checked out, but entering it will display the view. -}-genViewBranch :: View -> Annex () -> Annex Git.Branch-genViewBranch view a = withIndex $ do-	a-	let branch = branchView view-	void $ inRepo $ Git.Branch.commit Git.Branch.AutomaticCommit True (fromRef branch) branch []-	return branch- {- Runs an action using the view index file.  - Note that the file does not necessarily exist, or can contain  - info staged for an old view. -}-withIndex :: Annex a -> Annex a-withIndex a = do+withViewIndex :: Annex a -> Annex a+withViewIndex a = do 	f <- fromRepo gitAnnexViewIndex 	withIndexFile f a++{- Generates a branch for a view, using the view index file+ - to make a commit to the view branch. The view branch is not+ - checked out, but entering it will display the view. -}+genViewBranch :: View -> Annex Git.Branch+genViewBranch view = withViewIndex $ do+	let branch = branchView view+	void $ inRepo $ Git.Branch.commit Git.Branch.AutomaticCommit True (fromRef branch) branch []+	return branch  withCurrentView :: (View -> Annex a) -> Annex a withCurrentView a = maybe (error "Not in a view.") a =<< currentView
+ Annex/WorkTree.hs view
@@ -0,0 +1,43 @@+{- git-annex worktree files+ -+ - Copyright 2013-2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.WorkTree where++import Common.Annex+import Annex.Link+import Annex.CatFile+import Annex.Version+import Config++{- Looks up the key corresponding to an annexed file in the work tree,+ - by examining what the file links to.+ -+ - An unlocked file will not have a link on disk, so fall back to+ - looking for a pointer to a key in git.+ -}+lookupFile :: FilePath -> Annex (Maybe Key)+lookupFile file = do+	mkey <- isAnnexLink file+	case mkey of+		Just key -> makeret key+		Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect)+			( ifM (liftIO $ doesFileExist file)+				( maybe (return Nothing) makeret =<< catKeyFile file+				, return Nothing+				)+			, return Nothing +			)+  where+	makeret = return . Just++{- Modifies an action to only act on files that are already annexed,+ - and passes the key on to it. -}+whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)+whenAnnexed a file = ifAnnexed file (a file) (return Nothing)++ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a+ifAnnexed file yes no = maybe no yes =<< lookupFile file
Assistant/Threads/Committer.hs view
@@ -21,18 +21,21 @@ import Logs.Location import qualified Annex.Queue import qualified Git.LsFiles-import qualified Command.Add import Utility.ThreadScheduler import qualified Utility.Lsof as Lsof import qualified Utility.DirWatcher as DirWatcher import Types.KeySource import Config import Annex.Content+import Annex.Ingest import Annex.Link import Annex.CatFile+import Annex.InodeSentinal+import Annex.Version import qualified Annex import Utility.InodeCache import Annex.Content.Direct+import qualified Database.Keys import qualified Command.Sync import qualified Git.Branch @@ -52,7 +55,8 @@ 			=<< annexDelayAdd <$> Annex.getGitConfig 	msg <- liftAnnex Command.Sync.commitMsg 	waitChangeTime $ \(changes, time) -> do-		readychanges <- handleAdds havelsof delayadd changes+		readychanges <- handleAdds havelsof delayadd $+			simplifyChanges changes 		if shouldCommit False time (length readychanges) readychanges 			then do 				debug@@ -227,12 +231,11 @@ 			return ok  {- OSX needs a short delay after a file is added before locking it down,- - when using a non-direct mode repository, as pasting a file seems to- - try to set file permissions or otherwise access the file after closing- - it. -}+ - as pasting a file seems to try to set file permissions or otherwise+ - access the file after closing it. -} delayaddDefault :: Annex (Maybe Seconds) #ifdef darwin_HOST_OS-delayaddDefault = ifM isDirect+delayaddDefault = ifM (isDirect <||> versionSupportsUnlockedPointers) 	( return Nothing 	, return $ Just $ Seconds 1 	)@@ -249,12 +252,11 @@  - for write by some other process, and faster checking with git-ls-files  - that the files are not already checked into git.  -- - When a file is added, Inotify will notice the new symlink. So this waits- - for additional Changes to arrive, so that the symlink has hopefully been- - staged before returning, and will be committed immediately.- -- - OTOH, for kqueue, eventsCoalesce, so instead the symlink is directly- - created and staged.+ - When a file is added in locked mode, Inotify will notice the new symlink.+ - So this waits for additional Changes to arrive, so that the symlink has+ - hopefully been staged before returning, and will be committed immediately.+ - (OTOH, for kqueue, eventsCoalesce, so instead the symlink is directly+ - created and staged.)  -  - Returns a list of all changes that are ready to be committed.  - Any pending adds that are not ready yet are put back into the ChangeChan,@@ -264,10 +266,17 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do 	let (pending, inprocess) = partition isPendingAddChange incomplete 	direct <- liftAnnex isDirect-	(pending', cleanup) <- if direct+	unlocked <- liftAnnex versionSupportsUnlockedPointers+	let lockingfiles = not (unlocked || direct)+	let lockdownconfig = LockDownConfig+		{ lockingFile = lockingfiles+		, hardlinkFileTmp = True+		}+	(pending', cleanup) <- if unlocked || direct 		then return (pending, noop) 		else findnew pending-	(postponed, toadd) <- partitionEithers <$> safeToAdd havelsof delayadd pending' inprocess+	(postponed, toadd) <- partitionEithers+		<$> safeToAdd lockdownconfig havelsof delayadd pending' inprocess 	cleanup  	unless (null postponed) $@@ -275,10 +284,11 @@  	returnWhen (null toadd) $ do 		added <- addaction toadd $-			catMaybes <$> if direct-				then adddirect toadd-				else forM toadd add-		if DirWatcher.eventsCoalesce || null added || direct+			catMaybes <$>+				if not lockingfiles+					then addunlocked direct toadd+					else forM toadd (add lockdownconfig)+		if DirWatcher.eventsCoalesce || null added || unlocked || direct 			then return $ added ++ otherchanges 			else do 				r <- handleAdds havelsof delayadd =<< getChanges@@ -304,52 +314,61 @@ 		| c = return otherchanges 		| otherwise = a -	add :: Change -> Assistant (Maybe Change)-	add change@(InProcessAddChange { keySource = ks }) = +	add :: LockDownConfig -> Change -> Assistant (Maybe Change)+	add lockdownconfig change@(InProcessAddChange { lockedDown = ld }) =  		catchDefaultIO Nothing <~> doadd 	  where+	  	ks = keySource ld 		doadd = sanitycheck ks $ do 			(mkey, mcache) <- liftAnnex $ do 				showStart "add" $ keyFilename ks-				Command.Add.ingest $ Just ks+				ingest $ Just $ LockedDown lockdownconfig ks 			maybe (failedingest change) (done change mcache $ keyFilename ks) mkey-	add _ = return Nothing+	add _ _ = return Nothing -	{- In direct mode, avoid overhead of re-injesting a renamed-	 - file, by examining the other Changes to see if a removed-	 - file has the same InodeCache as the new file. If so,-	 - we can just update bookkeeping, and stage the file in git.+	{- Avoid overhead of re-injesting a renamed unlocked file, by+	 - examining the other Changes to see if a removed file has the+	 - same InodeCache as the new file. If so, we can just update+	 - bookkeeping, and stage the file in git. 	 -}-	adddirect :: [Change] -> Assistant [Maybe Change]-	adddirect toadd = do+	addunlocked :: Bool -> [Change] -> Assistant [Maybe Change]+	addunlocked isdirect toadd = do 		ct <- liftAnnex compareInodeCachesWith-		m <- liftAnnex $ removedKeysMap ct cs+		m <- liftAnnex $ removedKeysMap isdirect ct cs 		delta <- liftAnnex getTSDelta+		let cfg = LockDownConfig+			{ lockingFile = False+			, hardlinkFileTmp = True+			} 		if M.null m-			then forM toadd add+			then forM toadd (add cfg) 			else forM toadd $ \c -> do 				mcache <- liftIO $ genInodeCache (changeFile c) delta 				case mcache of-					Nothing -> add c+					Nothing -> add cfg c 					Just cache -> 						case M.lookup (inodeCacheToKey ct cache) m of-							Nothing -> add c-							Just k -> fastadd c k+							Nothing -> add cfg c+							Just k -> fastadd isdirect c k -	fastadd :: Change -> Key -> Assistant (Maybe Change)-	fastadd change key = do-		let source = keySource change-		liftAnnex $ Command.Add.finishIngestDirect key source+	fastadd :: Bool -> Change -> Key -> Assistant (Maybe Change)+	fastadd isdirect change key = do+		let source = keySource $ lockedDown change+		liftAnnex $ if isdirect+			then finishIngestDirect key source+			else finishIngestUnlocked key source 		done change Nothing (keyFilename source) key -	removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)-	removedKeysMap ct l = do+	removedKeysMap :: Bool -> InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)+	removedKeysMap isdirect ct l = do 		mks <- forM (filter isRmChange l) $ \c -> 			catKeyFile $ changeFile c 		M.fromList . concat <$> mapM mkpairs (catMaybes mks) 	  where 		mkpairs k = map (\c -> (inodeCacheToKey ct c, k)) <$>-			recordedInodeCache k+			if isdirect+				then recordedInodeCache k+				else Database.Keys.getInodeCaches k  	failedingest change = do 		refill [retryChange change]@@ -358,12 +377,16 @@  	done change mcache file key = liftAnnex $ do 		logStatus key InfoPresent-		link <- ifM isDirect-			( calcRepo $ gitAnnexLink file key-			, Command.Add.link file key mcache+		ifM versionSupportsUnlockedPointers+			( stagePointerFile file =<< hashPointerFile key+			, do+				link <- ifM isDirect+					( calcRepo $ gitAnnexLink file key+					, makeLink file key mcache+					)+				whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $+					stageSymlink file =<< hashSymlink link 			)-		whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $-			stageSymlink file =<< hashSymlink link 		showEndOk 		return $ Just $ finishedChange change key @@ -401,16 +424,16 @@  -  - Check by running lsof on the repository.  -}-safeToAdd :: Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]-safeToAdd _ _ [] [] = return []-safeToAdd havelsof delayadd pending inprocess = do+safeToAdd :: LockDownConfig -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]+safeToAdd _ _ _ [] [] = return []+safeToAdd lockdownconfig havelsof delayadd pending inprocess = do 	maybe noop (liftIO . threadDelaySeconds) delayadd 	liftAnnex $ do-		keysources <- forM pending $ Command.Add.lockDown . changeFile-		let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending keysources)+		lockeddown <- forM pending $ lockDown lockdownconfig . changeFile+		let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending lockeddown) 		openfiles <- if havelsof 			then S.fromList . map fst3 . filter openwrite <$>-				findopenfiles (map keySource inprocess')+				findopenfiles (map (keySource . lockedDown) inprocess') 			else pure S.empty 		let checked = map (check openfiles) inprocess' @@ -423,17 +446,18 @@ 				allRight $ rights checked 			else return checked   where-	check openfiles change@(InProcessAddChange { keySource = ks })-		| S.member (contentLocation ks) openfiles = Left change+	check openfiles change@(InProcessAddChange { lockedDown = ld })+		| S.member (contentLocation (keySource ld)) openfiles = Left change 	check _ change = Right change -	mkinprocess (c, Just ks) = Just InProcessAddChange+	mkinprocess (c, Just ld) = Just InProcessAddChange 		{ changeTime = changeTime c-		, keySource = ks+		, lockedDown = ld 		} 	mkinprocess (_, Nothing) = Nothing -	canceladd (InProcessAddChange { keySource = ks }) = do+	canceladd (InProcessAddChange { lockedDown = ld }) = do+		let ks = keySource ld 		warning $ keyFilename ks 			++ " still has writers, not adding" 		-- remove the hard link
Assistant/Threads/ConfigMonitor.hs view
@@ -20,6 +20,7 @@ import Logs.NumCopies import Remote.List (remoteListRefresh) import qualified Git.LsTree as LsTree+import Git.Types import Git.FilePath import qualified Annex.Branch @@ -51,7 +52,7 @@ 		loop new  {- Config files, and their checksums. -}-type Configs = S.Set (FilePath, String)+type Configs = S.Set (FilePath, Sha)  {- All git-annex's config files, and actions to run when they change. -} configFilesActions :: [(FilePath, Assistant ())]
Assistant/Threads/TransferScanner.hs view
@@ -25,7 +25,7 @@ import Utility.NotificationBroadcaster import Utility.Batch import qualified Git.LsFiles as LsFiles-import qualified Backend+import Annex.WorkTree import Annex.Content import Annex.Wanted import CmdLine.Action@@ -142,7 +142,7 @@ 		(unwanted', ts) <- maybe 			(return (unwanted, [])) 			(findtransfers f unwanted)-				=<< liftAnnex (Backend.lookupFile f)+				=<< liftAnnex (lookupFile f) 		mapM_ (enqueue f) ts 		scan unwanted' fs
Assistant/Threads/Watcher.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant tree watcher  -- - Copyright 2012-2013 Joey Hess <id@joeyh.name>+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -28,7 +28,7 @@ import qualified Git import qualified Git.UpdateIndex import qualified Git.LsFiles as LsFiles-import qualified Backend+import Annex.WorkTree import Annex.Direct import Annex.Content.Direct import Annex.CatFile@@ -36,10 +36,16 @@ import Annex.Link import Annex.FileMatcher import Types.FileMatcher+import Annex.Content import Annex.ReplaceFile+import Annex.Version+import Annex.InodeSentinal import Git.Types+import Git.FilePath import Config import Utility.ThreadScheduler+import Logs.Location+import qualified Database.Keys #ifndef mingw32_HOST_OS import qualified Utility.Lsof as Lsof #endif@@ -88,10 +94,13 @@ 	startup <- asIO1 startupScan 	matcher <- liftAnnex largeFilesMatcher 	direct <- liftAnnex isDirect+	unlocked <- liftAnnex versionSupportsUnlockedPointers 	symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig-	addhook <- hook $ if direct-		then onAddDirect symlinkssupported matcher-		else onAdd matcher+	addhook <- hook $ if unlocked+		then onAddUnlocked symlinkssupported matcher+		else if direct+			then onAddDirect symlinkssupported matcher+			else onAdd matcher 	delhook <- hook onDel 	addsymlinkhook <- hook $ onAddSymlink direct 	deldirhook <- hook onDelDir@@ -186,11 +195,7 @@ 	case r of 		Left e -> liftIO $ warningIO $ show e 		Right Nothing -> noop-		Right (Just change) -> do-			-- Just in case the commit thread is not-			-- flushing the queue fast enough.-			liftAnnex Annex.Queue.flushWhenFull-			recordChange change+		Right (Just change) -> recordChange change   where 	normalize f 		| "./" `isPrefixOf` file = drop 2 f@@ -216,15 +221,37 @@ shouldRestage :: DaemonStatus -> Bool shouldRestage ds = scanComplete ds || forceRestage ds +onAddUnlocked :: Bool -> FileMatcher Annex -> Handler+onAddUnlocked = onAddUnlocked' False contentchanged addassociatedfile samefilestatus+  where+	addassociatedfile key file = +		Database.Keys.addAssociatedFile key+			=<< inRepo (toTopFilePath file)+	samefilestatus key file status = do+		cache <- Database.Keys.getInodeCaches key+		curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta file status+		case (cache, curr) of+			(_, Just c) -> elemInodeCaches c cache+			([], Nothing) -> return True+			_ -> return False+	contentchanged oldkey file = do+		Database.Keys.removeAssociatedFile oldkey+			=<< inRepo (toTopFilePath file)+		unlessM (inAnnex oldkey) $+			logStatus oldkey InfoMissing+ {- In direct mode, add events are received for both new files, and  - modified existing files.  -} onAddDirect :: Bool -> FileMatcher Annex -> Handler-onAddDirect symlinkssupported matcher file fs = do+onAddDirect = onAddUnlocked' True changedDirect (\k f -> void $ addAssociatedFile k f) sameFileStatus++onAddUnlocked' :: Bool -> (Key -> FilePath -> Annex ()) -> (Key -> FilePath -> Annex ()) -> (Key -> FilePath -> FileStatus -> Annex Bool) -> Bool -> FileMatcher Annex -> Handler+onAddUnlocked' isdirect contentchanged addassociatedfile samefilestatus symlinkssupported matcher file fs = do 	v <- liftAnnex $ catKeyFile file 	case (v, fs) of 		(Just key, Just filestatus) ->-			ifM (liftAnnex $ sameFileStatus key file filestatus)+			ifM (liftAnnex $ samefilestatus key file filestatus) 				{- It's possible to get an add event for 				 - an existing file that is not 				 - really modified, but it might have@@ -237,13 +264,13 @@ 					, noChange 					) 				, guardSymlinkStandin (Just key) $ do-					debug ["changed direct", file]-					liftAnnex $ changedDirect key file+					debug ["changed", file]+					liftAnnex $ contentchanged key file 					add matcher file 				) 		_ -> unlessIgnored file $ 			guardSymlinkStandin Nothing $ do-				debug ["add direct", file]+				debug ["add", file] 				add matcher file   where 	{- On a filesystem without symlinks, we'll get changes for regular@@ -259,9 +286,9 @@ 				Just lt -> do 					case fileKey $ takeFileName lt of 						Nothing -> noop-						Just key -> void $ liftAnnex $-							addAssociatedFile key file-					onAddSymlink' linktarget mk True file fs+						Just key -> liftAnnex $+							addassociatedfile key file+					onAddSymlink' linktarget mk isdirect file fs  {- A symlink might be an arbitrary symlink, which is just added.  - Or, if it is a git-annex symlink, ensure it points to the content@@ -270,7 +297,7 @@ onAddSymlink :: Bool -> Handler onAddSymlink isdirect file filestatus = unlessIgnored file $ do 	linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)-	kv <- liftAnnex (Backend.lookupFile file)+	kv <- liftAnnex (lookupFile file) 	onAddSymlink' linktarget kv isdirect file filestatus  onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler@@ -330,13 +357,16 @@  onDel' :: FilePath -> Annex () onDel' file = do-	whenM isDirect $ do-		mkey <- catKeyFile file-		case mkey of-			Nothing -> noop-			Just key -> void $ removeAssociatedFile key file+	topfile <- inRepo (toTopFilePath file)+	ifM versionSupportsUnlockedPointers+		( withkey $ flip Database.Keys.removeAssociatedFile topfile+		, whenM isDirect $+			withkey $ \key -> void $ removeAssociatedFile key file+		) 	Annex.Queue.addUpdateIndex =<< 		inRepo (Git.UpdateIndex.unstageFile file)+  where+	withkey a = maybe noop a =<< catKeyFile file  {- A directory has been deleted, or moved, so tell git to remove anything  - that was inside it from its cache. Since it could reappear at any time,@@ -357,7 +387,6 @@ 	recordChanges $ map (\f -> Change now f RmChange) fs  	void $ liftIO clean-	liftAnnex Annex.Queue.flushWhenFull 	noChange  {- Called when there's an error with inotify or kqueue. -}
Assistant/Types/Changes.hs view
@@ -1,18 +1,22 @@ {- git-annex assistant change tracking  -- - Copyright 2012-2013 Joey Hess <id@joeyh.name>+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE BangPatterns #-}+ module Assistant.Types.Changes where  import Types.KeySource import Types.Key import Utility.TList+import Annex.Ingest  import Control.Concurrent.STM import Data.Time.Clock+import qualified Data.Set as S  {- An un-ordered pool of Changes that have been noticed and should be  - staged and committed. Changes will typically be in order, but ordering@@ -38,7 +42,7 @@ 		} 	| InProcessAddChange 		{ changeTime ::UTCTime-		, keySource :: KeySource+		, lockedDown :: LockedDown 		} 	deriving (Show) @@ -53,7 +57,7 @@ changeFile :: Change -> FilePath changeFile (Change _ f _) = f changeFile (PendingAddChange _ f) = f-changeFile (InProcessAddChange _ ks) = keyFilename ks+changeFile (InProcessAddChange _ ld) = keyFilename $ keySource ld  isPendingAddChange :: Change -> Bool isPendingAddChange (PendingAddChange {}) = True@@ -64,14 +68,33 @@ isInProcessAddChange _ = False  retryChange :: Change -> Change-retryChange (InProcessAddChange time ks) =-	PendingAddChange time (keyFilename ks)+retryChange c@(InProcessAddChange time _) =+	PendingAddChange time $ changeFile c retryChange c = c  finishedChange :: Change -> Key -> Change-finishedChange c@(InProcessAddChange { keySource = ks }) k = Change+finishedChange c@(InProcessAddChange {}) k = Change 	{ changeTime = changeTime c-	, _changeFile = keyFilename ks+	, _changeFile = changeFile c 	, changeInfo = AddKeyChange k 	} finishedChange c _ = c++{- Combine PendingAddChanges that are for the same file.+ - Multiple such often get noticed when eg, a file is opened and then+ - closed in quick succession. -}+simplifyChanges :: [Change] -> [Change]+simplifyChanges [c] = [c]+simplifyChanges cl = go cl S.empty []+  where+ 	go [] _ l = reverse l+	go (c:cs) seen l+		| isPendingAddChange c =+			if S.member f seen +				then go cs seen l+				else +					let !seen' = S.insert f seen+					in go cs seen' (c:l)+		| otherwise = go cs seen (c:l)+	  where+		f = changeFile c
Backend.hs view
@@ -9,9 +9,7 @@ 	list, 	orderedList, 	genKey,-	lookupFile, 	getBackend,-	isAnnexLink, 	chooseBackend, 	lookupBackendName, 	maybeLookupBackendName,@@ -21,12 +19,9 @@ import Common.Annex import qualified Annex import Annex.CheckAttr-import Annex.CatFile-import Annex.Link import Types.Key import Types.KeySource import qualified Types.Backend as B-import Config  -- When adding a new backend, import it here and add it to the list. import qualified Backend.Hash@@ -77,26 +72,6 @@ 	fixbadchar c 		| c == '\n' = '_' 		| otherwise = c--{- Looks up the key corresponding to an annexed file,- - by examining what the file links to.- -- - In direct mode, there is often no link on disk, in which case- - the symlink is looked up in git instead. However, a real link- - on disk still takes precedence over what was committed to git in direct- - mode.- -}-lookupFile :: FilePath -> Annex (Maybe Key)-lookupFile file = do-	mkey <- isAnnexLink file-	case mkey of-		Just key -> makeret key-		Nothing -> ifM isDirect-			( maybe (return Nothing) makeret =<< catKeyFile file-			, return Nothing-			)-  where-	makeret k = return $ Just k  getBackend :: FilePath -> Key -> Annex (Maybe Backend) getBackend file k = let bname = keyBackendName k in
Backend/Hash.hs view
@@ -5,7 +5,7 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns, CPP #-}  module Backend.Hash ( 	backends,@@ -171,7 +171,9 @@ 	go (SHA3Hash hashsize) = use (sha3Hasher hashsize) 	go (SkeinHash hashsize) = use (skeinHasher hashsize) 	-	use hasher = liftIO $ hasher <$> L.readFile file+	use hasher = liftIO $ do+		!h <- hasher <$> L.readFile file+		return h 	 	usehasher hashsize = case shaHasher hashsize filesize of 		Left sha -> use sha
Build/DesktopFile.hs view
@@ -20,13 +20,14 @@ import Assistant.Install.AutoStart import Assistant.Install.Menu -import Control.Applicative import System.Directory import System.Environment #ifndef mingw32_HOST_OS import System.Posix.User #endif import Data.Maybe+import Control.Applicative+import Prelude  systemwideInstall :: IO Bool #ifndef mingw32_HOST_OS
Build/LinuxMkLibs.hs view
@@ -7,7 +7,6 @@  module Main where -import Control.Applicative import System.Environment import Data.Maybe import System.FilePath@@ -16,6 +15,8 @@ import Data.List import System.Posix.Files import Control.Monad.IfElse+import Control.Applicative+import Prelude  import Utility.LinuxMkLibs import Utility.Directory
Build/OSXMkLibs.hs view
@@ -7,7 +7,6 @@  module Main where -import Control.Applicative import System.Environment (getArgs) import Data.Maybe import System.FilePath@@ -15,6 +14,8 @@ import Control.Monad import Data.List import Data.String.Utils+import Control.Applicative+import Prelude  import Utility.PartialPrelude import Utility.Directory
BuildFlags.hs view
@@ -95,11 +95,6 @@ #ifdef WITH_TORRENTPARSER 	, "TorrentParser" #endif-#ifdef WITH_DATABASE-	, "Database"-#else-#warning Building without Database support-#endif #ifdef WITH_EKG 	, "EKG" #endif
CHANGELOG view
@@ -1,3 +1,67 @@+git-annex (6.20160114) unstable; urgency=medium++  "hexapodia as the key insight"++  * Added v6 repository mode, but v5 is still the default for now.+  * unlock, lock: In v6 mode, unlocking a file changes it from a symlink to a+    pointer file, and this change can be committed to the git repository.+    For details, see http://git-annex.branchable.com/tips/unlocked_files/+  * The upgrade to version 6 is not done fully automatically yet, because+    upgrading a direct mode repository to version 6 will prevent old+    versions of git-annex from working in other clones of that repository.+    For details, see http://git-annex.branchable.com/upgrades/+  * init: --version parameter added to control which supported repository+    version to use.+  * init, upgrade: Configure .git/info/attributes to use git-annex+    as a smudge filter. In v6 repository mode, this makes git add+    add files to the annex in unlocked mode, unless overridden by+    annex.largefiles configuration.+  * assistant: In v6 mode, adds files in unlocked mode, so they can+    continue to be modified.+  * Added annex.thin setting, which makes unlocked files in v6 repositories+    be hard linked to their content, instead of a copy. This saves disk+    space but means any modification of an unlocked file will lose the local+    (and possibly only) copy of the old version.+  * Enable annex.thin by default on upgrade from direct mode to v6, since+    direct mode made the same tradeoff.+  * fix: Adjusts unlocked files as configured by annex.thin.+  * persistent-sqlite is now a hard build dependency, since v6 repository+    mode needs it.+++  * status: On crippled filesystems, was displaying M for all annexed files+    that were present. Probably caused by a change to what git status+    displays in this situation. Fixed by treating files git thinks are+    modified the same as typechanged files.+  * addurl: Added --batch and --with-files options.+  * addurl: Support --json, particularly useful in --batch mode.+  * addurl: Refuse to overwrite any existing, non-annexed file.+  * Debian: Adjust build dependencies for webapp, DAV. Now available on+    mips, mipsel, but temporarily removed armel since build is failing+    there.+  * info: Fix "backend usage" numbers, which were counting present keys+    twice.+  * info --json: Improve json for "backend usage", using a nested object+    with fields for each backend instead of the previous weird nested lists.+    This may break existing parsers of this json output, if there were any.+  * whereis --json: Make url list be included in machine-parseable form.+  * test: Added --keep-failures option.+  * unused: Bug fix when a new file was added to the annex, and then+    removed (but not git rmed). git still has the add staged in this case,+    so the content should not be unused and was wrongly treated as such.+  * migrate: Copy over metadata to new key.+  * rekey: No longer copies over urls from the old to the new key.+    It makes sense for migrate to do that, but not for this low-level+    (and little used) plumbing command to.+  * view: Fix crash in non-unicode capable locale when entering a view+    of metadata containing a slash or backslash.+  * When annex.http-headers is used to set the User-Agent header, avoid+    sending User-Agent: git-annex+  * Windows: Fix rsync cross-drive hack to work with msys2 rsync.+    Thanks, Pieter Kitslaar.++ -- Joey Hess <id@joeyh.name>  Thu, 14 Jan 2016 10:14:19 -0400+ git-annex (5.20151218) unstable; urgency=medium    * Add S3 features to git-annex version output.
CmdLine/Action.hs view
@@ -13,7 +13,6 @@ import qualified Annex import Annex.Concurrent import Types.Command-import qualified Annex.Queue import Messages.Concurrent import Messages.Internal import Types.Messages@@ -119,11 +118,8 @@  {- Like commandAction, but without the concurrency. -} includeCommandAction :: CommandStart -> CommandCleanup-includeCommandAction a = account =<< tryIO go+includeCommandAction a = account =<< tryIO (callCommandAction a)   where-	go = do-		Annex.Queue.flushWhenFull-		callCommandAction a 	account (Right True) = return True 	account (Right False) = incerr 	account (Left err) = do
CmdLine/Batch.hs view
@@ -12,15 +12,13 @@  data BatchMode = Batch | NoBatch -batchOption :: Parser BatchMode-batchOption = flag NoBatch Batch+parseBatchOption :: Parser BatchMode+parseBatchOption = flag NoBatch Batch 	( long "batch" 	<> help "enable batch mode" 	) -type Batchable t = BatchMode -> t -> CommandStart---- A Batchable command can run in batch mode, or not.+-- A batchable command can run in batch mode, or not. -- In batch mode, one line at a time is read, parsed, and a reply output to -- stdout. In non batch mode, the command's parameters are parsed and -- a reply output for each.@@ -29,19 +27,11 @@   where 	batchparser = (,,) 		<$> parser-		<*> batchOption+		<*> parseBatchOption 		<*> cmdParams paramdesc 	 	batchseeker (opts, NoBatch, params) = mapM_ (go NoBatch opts) params-	batchseeker (opts, Batch, _) = batchloop opts--	batchloop opts = do-		mp <- liftIO $ catchMaybeIO getLine-		case mp of-			Nothing -> return ()-			Just p -> do-				go Batch opts p-				batchloop opts+	batchseeker (opts, Batch, _) = batchInput Right (go Batch opts)  	go batchmode opts p = 		unlessM (handler opts p) $@@ -52,3 +42,15 @@ batchBadInput :: BatchMode -> Annex () batchBadInput NoBatch = liftIO exitFailure batchBadInput Batch = liftIO $ putStrLn ""++-- Reads lines of batch mode input and passes to the action to handle.+batchInput :: (String -> Either String a) -> (a -> Annex ()) -> Annex ()+batchInput parser a = do+	mp <- liftIO $ catchMaybeIO getLine+	case mp of+		Nothing -> return ()+		Just v -> do+			either parseerr a (parser v)+			batchInput parser a+  where+	parseerr s = error $ "Batch input parse failure: " ++ s
CmdLine/GitAnnex.hs view
@@ -96,6 +96,7 @@ import qualified Command.Forget import qualified Command.Proxy import qualified Command.DiffDriver+import qualified Command.Smudge import qualified Command.Undo import qualified Command.Version #ifdef WITH_ASSISTANT@@ -114,6 +115,9 @@ import qualified Command.FuzzTest import qualified Command.TestRemote #endif+#ifdef WITH_BENCHMARK+import qualified Command.Benchmark+#endif #ifdef WITH_EKG import System.Remote.Monitoring #endif@@ -201,6 +205,7 @@ 	, Command.Forget.cmd 	, Command.Proxy.cmd 	, Command.DiffDriver.cmd+	, Command.Smudge.cmd 	, Command.Undo.cmd 	, Command.Version.cmd #ifdef WITH_ASSISTANT@@ -218,6 +223,9 @@ #ifdef WITH_TESTSUITE 	, Command.FuzzTest.cmd 	, Command.TestRemote.cmd+#endif+#ifdef WITH_BENCHMARK+	, Command.Benchmark.cmd #endif 	]
CmdLine/GitAnnexShell.hs view
@@ -144,6 +144,7 @@ checkField (field, val) 	| field == fieldName remoteUUID = fieldCheck remoteUUID val 	| field == fieldName associatedFile = fieldCheck associatedFile val+	| field == fieldName unlocked = fieldCheck unlocked val 	| field == fieldName direct = fieldCheck direct val 	| field == fieldName autoInit = fieldCheck autoInit val 	| otherwise = False
CmdLine/GitAnnexShell/Fields.hs view
@@ -35,5 +35,8 @@ direct :: Field direct = Field "direct" $ \f -> f == "1" +unlocked :: Field+unlocked = Field "unlocked" $ \f -> f == "1"+ autoInit :: Field autoInit = Field "autoinit" $ \f -> f == "1"
CmdLine/Seek.hs view
@@ -77,14 +77,15 @@   where 	go r = do	 		matcher <- Limit.getMatcher-		l <- inRepo $ LsTree.lsTree (Git.Ref r)+		(l, cleanup) <- inRepo $ LsTree.lsTree (Git.Ref r) 		forM_ l $ \i -> do 			let f = getTopFilePath $ LsTree.file i-			v <- catKey (Git.Ref $ LsTree.sha i) (LsTree.mode i)+			v <- catKey (LsTree.sha i) 			case v of 				Nothing -> noop 				Just k -> whenM (matcher $ MatchingKey k) $ 					commandAction $ a f k+		liftIO $ void cleanup  withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CmdParams -> CommandSeek withPathContents a params = do@@ -115,29 +116,29 @@ 	pairs c (x:y:xs) = pairs ((x,y):c) xs 	pairs _ _ = error "expected pairs" -withFilesToBeCommitted :: (String -> CommandStart) -> CmdParams -> CommandSeek+withFilesToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesToBeCommitted a params = seekActions $ prepFiltered a $ 	seekHelper LsFiles.stagedNotDeleted params -withFilesUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek-withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged+withFilesOldUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek+withFilesOldUnlocked = withFilesOldUnlocked' LsFiles.typeChanged -withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek-withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged+withFilesOldUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek+withFilesOldUnlockedToBeCommitted = withFilesOldUnlocked' LsFiles.typeChangedStaged -{- Unlocked files have changed type from a symlink to a regular file.+{- Unlocked files before v6 have changed type from a symlink to a regular file.  -  - Furthermore, unlocked files used to be a git-annex symlink,  - not some other sort of symlink.  -}-withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek-withFilesUnlocked' typechanged a params = seekActions $+withFilesOldUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek+withFilesOldUnlocked' typechanged a params = seekActions $ 	prepFiltered a unlockedfiles   where-	unlockedfiles = filterM isUnlocked =<< seekHelper typechanged params+	unlockedfiles = filterM isOldUnlocked =<< seekHelper typechanged params -isUnlocked :: FilePath -> Annex Bool-isUnlocked f = liftIO (notSymlink f) <&&> +isOldUnlocked :: FilePath -> Annex Bool+isOldUnlocked f = liftIO (notSymlink f) <&&>  	(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)  {- Finds files that may be modified. -}
Command.hs view
@@ -18,12 +18,13 @@ 	stopUnless, 	whenAnnexed, 	ifAnnexed,+	lookupFile, 	isBareRepo, 	module ReExported ) where  import Common.Annex-import qualified Backend+import Annex.WorkTree import qualified Git import Types.Command as ReExported import Types.Option as ReExported@@ -99,14 +100,6 @@ {- Stops unless a condition is met. -} stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a) stopUnless c a = ifM c ( a , stop )--{- Modifies an action to only act on files that are already annexed,- - and passes the key on to it. -}-whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)-whenAnnexed a file = ifAnnexed file (a file) (return Nothing)--ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a-ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file  isBareRepo :: Annex Bool isBareRepo = fromRepo Git.repoIsLocalBare
Command/Add.hs view
@@ -5,35 +5,22 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Command.Add where  import Common.Annex import Command-import Types.KeySource-import Backend+import Annex.Ingest import Logs.Location import Annex.Content import Annex.Content.Direct-import Annex.Perms import Annex.Link-import Annex.MetaData import qualified Annex import qualified Annex.Queue-#ifdef WITH_CLIBS-#ifndef __ANDROID__-import Utility.Touch-#endif-#endif import Config import Utility.InodeCache import Annex.FileMatcher-import Annex.ReplaceFile-import Utility.Tmp-import Utility.CopyFile--import Control.Exception (IOException)+import Annex.Version+import qualified Database.Keys  cmd :: Command cmd = notBareRepo $ withGlobalOptions (jobsOption : fileMatchingOptions) $@@ -64,9 +51,9 @@ 		, startSmall file 		) 	go $ withFilesNotInGit (not $ includeDotFiles o)-	ifM isDirect+	ifM (versionSupportsUnlockedPointers <||> isDirect) 		( go withFilesMaybeModified-		, go withFilesUnlocked+		, go withFilesOldUnlocked 		)  {- Pass file off to git-add. -}@@ -86,9 +73,6 @@ 	Annex.Queue.addCommand "add" (ps++[Param "--"]) [file] 	return True -{- The add subcommand annexes a file, generating a key for it using a- - backend, and then moving it into the annex directory and setting up- - the symlink pointing to its content. -} start :: FilePath -> CommandStart start file = ifAnnexed file addpresent add   where@@ -103,13 +87,22 @@ 					next $ if isSymbolicLink s 						then next $ addFile file 						else perform file-	addpresent key = ifM isDirect+	addpresent key = ifM versionSupportsUnlockedPointers 		( do 			ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file 			case ms of 				Just s | isSymbolicLink s -> fixup key-				_ -> ifM (goodContent key file) ( stop , add )-		, fixup key+				_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)+						( stop, add )+		, ifM isDirect+			( do+				ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file+				case ms of+					Just s | isSymbolicLink s -> fixup key+					_ -> ifM (goodContent key file)+						( stop , add )+			, fixup key+			) 		) 	fixup key = do 		-- the annexed symlink is present but not yet added to git@@ -119,187 +112,17 @@ 			void $ addAssociatedFile key file 		next $ next $ cleanup file key Nothing =<< inAnnex key -{- The file that's being added is locked down before a key is generated,- - to prevent it from being modified in between. This lock down is not- - perfect at best (and pretty weak at worst). For example, it does not- - guard against files that are already opened for write by another process.- - So a KeySource is returned. Its inodeCache can be used to detect any- - changes that might be made to the file after it was locked down.- -- - When possible, the file is hard linked to a temp directory. This guards- - against some changes, like deletion or overwrite of the file, and- - allows lsof checks to be done more efficiently when adding a lot of files.- -- - Lockdown can fail if a file gets deleted, and Nothing will be returned.- -}-lockDown :: FilePath -> Annex (Maybe KeySource)-lockDown = either -		(\e -> warning (show e) >> return Nothing)-		(return . Just)-	<=< lockDown'--lockDown' :: FilePath -> Annex (Either IOException KeySource)-lockDown' file = ifM crippledFileSystem-	( withTSDelta $ liftIO . tryIO . nohardlink-	, tryIO $ do-		tmp <- fromRepo gitAnnexTmpMiscDir-		createAnnexDirectory tmp-		go tmp-	)-  where-	{- In indirect mode, the write bit is removed from the file as part-	 - of lock down to guard against further writes, and because objects-	 - in the annex have their write bit disabled anyway.-	 --	 - Freezing the content early also lets us fail early when-	 - someone else owns the file.-	 --	 - This is not done in direct mode, because files there need to-	 - remain writable at all times.-	-}-	go tmp = do-		unlessM isDirect $-			freezeContent file-		withTSDelta $ \delta -> liftIO $ do-			(tmpfile, h) <- openTempFile tmp $-				relatedTemplate $ takeFileName file-			hClose h-			nukeFile tmpfile-			withhardlink delta tmpfile `catchIO` const (nohardlink delta)-	nohardlink delta = do-		cache <- genInodeCache file delta-		return KeySource-			{ keyFilename = file-			, contentLocation = file-			, inodeCache = cache-			}-	withhardlink delta tmpfile = do-		createLink file tmpfile-		cache <- genInodeCache tmpfile delta-		return KeySource-			{ keyFilename = file-			, contentLocation = tmpfile-			, inodeCache = cache-			}--{- Ingests a locked down file into the annex.- -- - In direct mode, leaves the file alone, and just updates bookkeeping- - information.- -}-ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache)-ingest Nothing = return (Nothing, Nothing)-ingest (Just source) = withTSDelta $ \delta -> do-	backend <- chooseBackend $ keyFilename source-	k <- genKey source backend-	let src = contentLocation source-	ms <- liftIO $ catchMaybeIO $ getFileStatus src-	mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta src) ms-	case (mcache, inodeCache source) of-		(_, Nothing) -> go k mcache ms-		(Just newc, Just c) | compareStrong c newc -> go k mcache ms-		_ -> failure "changed while it was being added"-  where-	go k mcache ms = ifM isDirect-		( godirect k mcache ms-		, goindirect k mcache ms-		)--	goindirect (Just (key, _)) mcache ms = do-		catchNonAsync (moveAnnex key $ contentLocation source)-			(undo (keyFilename source) key)-		maybe noop (genMetaData key (keyFilename source)) ms-		liftIO $ nukeFile $ keyFilename source-		return (Just key, mcache)-	goindirect _ _ _ = failure "failed to generate a key"--	godirect (Just (key, _)) (Just cache) ms = do-		addInodeCache key cache-		maybe noop (genMetaData key (keyFilename source)) ms-		finishIngestDirect key source-		return (Just key, Just cache)-	godirect _ _ _ = failure "failed to generate a key"--	failure msg = do-		warning $ keyFilename source ++ " " ++ msg-		when (contentLocation source /= keyFilename source) $-			liftIO $ nukeFile $ contentLocation source-		return (Nothing, Nothing)--finishIngestDirect :: Key -> KeySource -> Annex ()-finishIngestDirect key source = do-	void $ addAssociatedFile key $ keyFilename source-	when (contentLocation source /= keyFilename source) $-		liftIO $ nukeFile $ contentLocation source--	{- Copy to any other locations using the same key. -}-	otherfs <- filter (/= keyFilename source) <$> associatedFiles key-	forM_ otherfs $-		addContentWhenNotPresent key (keyFilename source)- perform :: FilePath -> CommandPerform-perform file = lockDown file >>= ingest >>= go+perform file = do+	lockingfile <- not <$> isDirect+	let cfg = LockDownConfig+		{ lockingFile = lockingfile+		, hardlinkFileTmp = True+		}+	lockDown cfg file >>= ingest >>= go   where 	go (Just key, cache) = next $ cleanup file key cache True 	go (Nothing, _) = stop--{- On error, put the file back so it doesn't seem to have vanished.- - This can be called before or after the symlink is in place. -}-undo :: FilePath -> Key -> SomeException -> Annex a-undo file key e = do-	whenM (inAnnex key) $ do-		liftIO $ nukeFile file-		-- The key could be used by other files too, so leave the-		-- content in the annex, and make a copy back to the file.-		obj <- calcRepo $ gitAnnexLocation key-		unlessM (liftIO $ copyFileExternal CopyTimeStamps obj file) $-			warning $ "Unable to restore content of " ++ file ++ "; it should be located in " ++ obj-		thawContent file-	throwM e--{- Creates the symlink to the annexed content, returns the link target. -}-link :: FilePath -> Key -> Maybe InodeCache -> Annex String-link file key mcache = flip catchNonAsync (undo file key) $ do-	l <- calcRepo $ gitAnnexLink file key-	replaceFile file $ makeAnnexLink l--	-- touch symlink to have same time as the original file,-	-- as provided in the InodeCache-	case mcache of-#if defined(WITH_CLIBS) && ! defined(__ANDROID__)-		Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False-#else-		Just _ -> noop-#endif-		Nothing -> noop--	return l--{- Creates the symlink to the annexed content, and stages it in git.- -- - As long as the filesystem supports symlinks, we use- - git add, rather than directly staging the symlink to git.- - Using git add is best because it allows the queuing to work- - and is faster (staging the symlink runs hash-object commands each time).- - Also, using git add allows it to skip gitignored files, unless forced- - to include them.- -}-addLink :: FilePath -> Key -> Maybe InodeCache -> Annex ()-addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)-	( do-		_ <- link file key mcache-		ps <- forceParams-		Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]-	, do-		l <- link file key mcache-		addAnnexLink l file-	)--forceParams :: Annex [CommandParam]-forceParams = ifM (Annex.getState Annex.force)-	( return [Param "-f"]-	, return []-	)  cleanup :: FilePath -> Key -> Maybe InodeCache -> Bool -> CommandCleanup cleanup file key mcache hascontent = do
Command/AddUnused.hs view
@@ -10,7 +10,7 @@ import Common.Annex import Logs.Location import Command-import qualified Command.Add+import Annex.Ingest import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Types.Key @@ -31,7 +31,7 @@ perform :: Key -> CommandPerform perform key = next $ do 	logStatus key InfoPresent-	Command.Add.addLink file key Nothing+	addLink file key Nothing 	return True   where 	file = "unused." ++ key2file key
Command/AddUrl.hs view
@@ -14,14 +14,15 @@ import Common.Annex import Command import Backend-import qualified Command.Add import qualified Annex import qualified Annex.Queue import qualified Annex.Url as Url import qualified Backend.URL import qualified Remote import qualified Types.Remote as Remote+import qualified Command.Add import Annex.Content+import Annex.Ingest import Annex.UUID import Logs.Web import Types.Key@@ -32,6 +33,7 @@ import Annex.FileMatcher import Logs.Location import Utility.Metered+import CmdLine.Batch import qualified Annex.Transfer as Transfer #ifdef WITH_QUVI import Annex.Quvi@@ -39,7 +41,7 @@ #endif  cmd :: Command-cmd = notBareRepo $ withGlobalOptions [jobsOption] $+cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOption] $ 	command "addurl" SectionCommon "add urls to annex" 		(paramRepeating paramUrl) (seek <$$> optParser) @@ -51,6 +53,8 @@ 	, suffixOption :: Maybe String 	, relaxedOption :: Bool 	, rawOption :: Bool+	, batchOption :: BatchMode+	, batchFilesOption :: Bool 	}  optParser :: CmdParamsDesc -> Parser AddUrlOptions@@ -74,6 +78,11 @@ 		)) 	<*> parseRelaxedOption 	<*> parseRawOption+	<*> parseBatchOption+	<*> switch+		( long "with-files"+		<> help "parse batch mode lines of the form \"$url $file\""+		)  parseRelaxedOption :: Parser Bool parseRelaxedOption = switch@@ -88,13 +97,27 @@ 	)  seek :: AddUrlOptions -> CommandSeek-seek o = allowConcurrentOutput $-	forM_ (addUrls o) $ \u -> do+seek o = allowConcurrentOutput $ do+	forM_ (addUrls o) (\u -> go (o, u))+	case batchOption o of+		Batch -> batchInput (parseBatchInput o) go+		NoBatch -> noop+  where+	go (o', u) = do 		r <- Remote.claimingUrl u-		if Remote.uuid r == webUUID || rawOption o-			then void $ commandAction $ startWeb o u-			else checkUrl r o u+		if Remote.uuid r == webUUID || rawOption o'+			then void $ commandAction $ startWeb o' u+			else checkUrl r o' u +parseBatchInput :: AddUrlOptions -> String -> Either String (AddUrlOptions, URLString)+parseBatchInput o s+	| batchFilesOption o =+		let (u, f) = separate (== ' ') s+		in if null u || null f+			then Left ("parsed empty url or filename in input: " ++ s)+			else Right (o { fileOption = Just f }, u)+	| otherwise = Right (o, s)+ checkUrl :: Remote -> AddUrlOptions -> URLString -> Annex () checkUrl r o u = do 	pathmax <- liftIO $ fileNameLengthLimit "."@@ -236,6 +259,7 @@ #ifdef WITH_QUVI addUrlFileQuvi :: Bool -> URLString -> URLString -> FilePath -> Annex (Maybe Key) addUrlFileQuvi relaxed quviurl videourl file = do+	checkDoesNotExist file 	let key = Backend.URL.fromUrl quviurl Nothing 	ifM (pure relaxed <||> Annex.getState Annex.fast) 		( do@@ -286,12 +310,19 @@  addUrlFile :: Bool -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) addUrlFile relaxed url urlinfo file = do+	checkDoesNotExist file 	liftIO $ createDirectoryIfMissing True (parentDir file) 	ifM (Annex.getState Annex.fast <||> pure relaxed) 		( nodownload url urlinfo file 		, downloadWeb url urlinfo file 		) +checkDoesNotExist :: FilePath -> Annex ()+checkDoesNotExist file = go =<< liftIO (catchMaybeIO $ getSymbolicLinkStatus file)+  where+	go Nothing = return ()+	go (Just _) = error $ file ++ " already exists and is not annexed; not overwriting"+ downloadWeb :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) downloadWeb url urlinfo file = do 	let dummykey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing@@ -351,7 +382,7 @@ 		when (isJust mtmp) $ 			logStatus key InfoPresent 		setUrlPresent u key url-		Command.Add.addLink file key Nothing+		addLink file key Nothing 		whenM isDirect $ do 			void $ addAssociatedFile key file 			{- For moveAnnex to work in direct mode, the symlink
+ Command/Benchmark.hs view
@@ -0,0 +1,123 @@+{- git-annex benchmark+ -+ - Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Command.Benchmark where++import Command+import Database.Types+import qualified Database.Keys.SQL as SQL+import qualified Database.Queue as H+import Utility.Tmp+import Git.FilePath++import Criterion.Main+import Criterion.Internal (runAndAnalyse)+import Criterion.Monad+import Control.Monad.IO.Class (liftIO)+import Control.Monad+import Control.DeepSeq+import System.FilePath+import System.Random++cmd :: Command+cmd = noRepo (withParams benchmark) $+	dontCheck repoExists $+		command "benchmark" SectionTesting+			"run benchmarks"+			paramNothing+			(withParams (liftIO . benchmark))++benchmark :: CmdParams -> IO ()+benchmark _ = withTmpDirIn "." "benchmark" $ \tmpdir -> do+	-- benchmark different sizes of databases+	dbs <- mapM (benchDb tmpdir)+		[ 1000+		, 10000+		-- , 100000+		]+	runCriterion $+		bgroup "keys database" $ flip concatMap dbs $ \db ->+			[ getAssociatedFilesHitBench db+			, getAssociatedFilesMissBench db+			, getAssociatedKeyHitBench db+			, getAssociatedKeyMissBench db+			, addAssociatedFileOldBench db+			, addAssociatedFileNewBench db+			]++getAssociatedFilesHitBench :: BenchDb -> Benchmark+getAssociatedFilesHitBench ( BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (hit)") $ nfIO $ do+	n <- getStdRandom (randomR (1,num))+	SQL.getAssociatedFiles (keyN n) (SQL.ReadHandle h)++getAssociatedFilesMissBench :: BenchDb -> Benchmark+getAssociatedFilesMissBench ( BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (miss)") $ nfIO $+	SQL.getAssociatedFiles keyMiss (SQL.ReadHandle h)++getAssociatedKeyHitBench :: BenchDb -> Benchmark+getAssociatedKeyHitBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (hit)") $ nfIO $ do+	n <- getStdRandom (randomR (1,num))+	SQL.getAssociatedKey (fileN n) (SQL.ReadHandle h)++getAssociatedKeyMissBench :: BenchDb -> Benchmark+getAssociatedKeyMissBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (miss)") $ nfIO $+	SQL.getAssociatedKey fileMiss (SQL.ReadHandle h)++addAssociatedFileOldBench :: BenchDb -> Benchmark+addAssociatedFileOldBench ( BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (old)") $ nfIO $ do+	n <- getStdRandom (randomR (1,num))+	SQL.addAssociatedFile (keyN n) (fileN n) (SQL.WriteHandle h)+	H.flushDbQueue h++addAssociatedFileNewBench :: BenchDb -> Benchmark+addAssociatedFileNewBench ( BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (new)") $ nfIO $ do+	n <- getStdRandom (randomR (1,num))+	SQL.addAssociatedFile (keyN n) (fileN (n+1)) (SQL.WriteHandle h)+	H.flushDbQueue h++populateAssociatedFiles :: H.DbQueue -> Int -> IO ()+populateAssociatedFiles h num = do+	forM_ [1..num] $ \n ->+		SQL.addAssociatedFile (keyN n) (fileN n) (SQL.WriteHandle h)+	H.flushDbQueue h++keyN :: Int -> IKey+keyN n = IKey ("key" ++ show n)++fileN :: Int -> TopFilePath+fileN n = asTopFilePath ("file" ++ show n)++keyMiss :: IKey+keyMiss = keyN 0 -- 0 is never stored++fileMiss :: TopFilePath+fileMiss = fileN 0 -- 0 is never stored++data BenchDb = BenchDb H.DbQueue Int++benchDb :: FilePath -> Int -> IO BenchDb+benchDb tmpdir num = do+	putStrLn $ "setting up database with " ++ show num+	H.initDb f SQL.createTables+	h <- H.openDbQueue f SQL.containedTable+	populateAssociatedFiles h num+	return (BenchDb h num)+  where+	f = tmpdir </> "db" ++ show num++instance NFData TopFilePath where+	rnf = rnf . getTopFilePath++instance NFData IKey where+	rnf (IKey s) = rnf s+	+-- can't use Criterion's defaultMain here because it looks at+-- command-line parameters+runCriterion :: Benchmark -> IO ()+runCriterion = withConfig defaultConfig . runAndAnalyse (const True)
Command/ConfigList.hs view
@@ -46,7 +46,7 @@ 		else ifM (Annex.Branch.hasSibling <||> (isJust <$> Fields.getField Fields.autoInit)) 			( do 				liftIO checkNotReadOnly-				initialize Nothing+				initialize Nothing Nothing 				getUUID 			, return NoUUID 			)
Command/Direct.hs view
@@ -14,6 +14,7 @@ import qualified Git.Branch import Config import Annex.Direct+import Annex.Version  cmd :: Command cmd = notBareRepo $ noDaemonRunning $@@ -24,7 +25,10 @@ seek = withNothing start  start :: CommandStart-start = ifM isDirect ( stop , next perform )+start = ifM versionSupportsDirectMode+	( ifM isDirect ( stop , next perform )+	, error "Direct mode is not suppported by this repository version. Use git-annex unlock instead."+	)  perform :: CommandPerform perform = do
Command/Fix.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -11,7 +11,14 @@  import Common.Annex import Command+import Config+import qualified Annex+import Annex.Version+import Annex.ReplaceFile+import Annex.Content+import Annex.Perms import qualified Annex.Queue+import qualified Database.Keys #ifdef WITH_CLIBS #ifndef __ANDROID__ import Utility.Touch@@ -21,22 +28,68 @@ cmd :: Command cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $ 	command "fix" SectionMaintenance-		"fix up symlinks to point to annexed content"+		"fix up links to annexed content" 		paramPaths (withParams seek)  seek :: CmdParams -> CommandSeek-seek = withFilesInGit $ whenAnnexed start+seek ps = unlessM crippledFileSystem $ do +	fixwhat <- ifM versionSupportsUnlockedPointers+		( return FixAll+		, return FixSymlinks+		)+	flip withFilesInGit ps $ whenAnnexed $ start fixwhat -{- Fixes the symlink to an annexed file. -}-start :: FilePath -> Key -> CommandStart-start file key = do-	link <- calcRepo $ gitAnnexLink file key-	stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do+data FixWhat = FixSymlinks | FixAll++start :: FixWhat -> FilePath -> Key -> CommandStart+start fixwhat file key = do+	currlink <- liftIO $ catchMaybeIO $ readSymbolicLink file+	wantlink <- calcRepo $ gitAnnexLink file key+	case currlink of+		Just l+			| l /= wantlink -> fixby $ fixSymlink file wantlink+			| otherwise -> stop+		Nothing -> case fixwhat of+			FixAll -> fixthin+			FixSymlinks -> stop+  where+	fixby a = do 		showStart "fix" file-		next $ perform file link+		next a+	fixthin = do+		obj <- calcRepo $ gitAnnexLocation key+		stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do+			thin <- annexThin <$> Annex.getGitConfig+			fs <- liftIO $ catchMaybeIO $ getFileStatus file+			os <- liftIO $ catchMaybeIO $ getFileStatus obj+			case (linkCount <$> fs, linkCount <$> os, thin) of+				(Just 1, Just 1, True) ->+					fixby $ makeHardLink file key+				(Just n, Just n', False) | n > 1 && n == n' ->+					fixby $ breakHardLink file key obj+				_ -> stop -perform :: FilePath -> FilePath -> CommandPerform-perform file link = do+breakHardLink :: FilePath -> Key -> FilePath -> CommandPerform+breakHardLink file key obj = do+	replaceFile file $ \tmp -> do+		unlessM (checkedCopyFile key obj tmp) $+			error "unable to break hard link"+		thawContent tmp+		modifyContent obj $ freezeContent obj+	Database.Keys.storeInodeCaches key [file]+	next $ return True++makeHardLink :: FilePath -> Key -> CommandPerform+makeHardLink file key = do+	replaceFile file $ \tmp -> do+		r <- linkFromAnnex key tmp+		case r of+			LinkAnnexFailed -> error "unable to make hard link"+			_ -> noop+	next $ return True++fixSymlink :: FilePath -> FilePath -> CommandPerform+fixSymlink file link = do 	liftIO $ do #ifdef WITH_CLIBS #ifndef __ANDROID__@@ -53,9 +106,9 @@ 		maybe noop (\t -> touch file t False) mtime #endif #endif-	next $ cleanup file+	next $ cleanupSymlink file -cleanup :: FilePath -> CommandCleanup-cleanup file = do+cleanupSymlink :: FilePath -> CommandCleanup+cleanupSymlink file = do 	Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file] 	return True
Command/Fsck.hs view
@@ -34,11 +34,9 @@ import Utility.CopyFile import Git.FilePath import Utility.PID--#ifdef WITH_DATABASE+import qualified Database.Keys import qualified Database.Fsck as FsckDb import Types.CleanupActions-#endif  import Data.Time.Clock.POSIX import System.Posix.Types (EpochTime)@@ -118,16 +116,18 @@ 	go = runFsck inc file key  perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool-perform key file backend numcopies = check-	-- order matters-	[ fixLink key file-	, verifyLocationLog key file-	, verifyDirectMapping key file-	, verifyDirectMode key file-	, checkKeySize key-	, checkBackend backend key (Just file)-	, checkKeyNumCopies key (Just file) numcopies-	]+perform key file backend numcopies = do+	keystatus <- getKeyStatus key+	check+		-- order matters+		[ fixLink key file+		, verifyLocationLog key keystatus file+		, verifyDirectMapping key file+		, verifyDirectMode key file+		, checkKeySize key keystatus+		, checkBackend backend key keystatus (Just file)+		, checkKeyNumCopies key (Just file) numcopies+		]  {- To fsck a remote, the content is retrieved to a tmp file,  - and checked locally. -}@@ -183,19 +183,19 @@ 			performKey key backend numcopies  performKey :: Key -> Backend -> NumCopies -> Annex Bool-performKey key backend numcopies = check-	[ verifyLocationLog key (key2file key)-	, checkKeySize key-	, checkBackend backend key Nothing-	, checkKeyNumCopies key Nothing numcopies-	]+performKey key backend numcopies = do+	keystatus <- getKeyStatus key+	check+		[ verifyLocationLog key keystatus (key2file key)+		, checkKeySize key keystatus+		, checkBackend backend key keystatus Nothing+		, checkKeyNumCopies key Nothing numcopies+		]  check :: [Annex Bool] -> Annex Bool check cs = and <$> sequence cs -{- Checks that the file's link points correctly to the content.- -- - In direct mode, there is only a link when the content is not present.+{- Checks that symlinks points correctly to the annexed content.  -} fixLink :: Key -> FilePath -> Annex Bool fixLink key file = do@@ -214,19 +214,23 @@  {- Checks that the location log reflects the current status of the key,  - in this repository only. -}-verifyLocationLog :: Key -> String -> Annex Bool-verifyLocationLog key desc = do-	present <- inAnnex key+verifyLocationLog :: Key -> KeyStatus -> String -> Annex Bool+verifyLocationLog key keystatus desc = do+	obj <- calcRepo $ gitAnnexLocation key+	present <- if isKeyUnlocked keystatus+		then liftIO (doesFileExist obj)+		else inAnnex key 	direct <- isDirect 	u <- getUUID 	-	{- Since we're checking that a key's file is present, throw+	{- Since we're checking that a key's object file is present, throw 	 - in a permission fixup here too. -}-	file <- calcRepo $ gitAnnexLocation key-	when (present && not direct) $-		freezeContent file-	whenM (liftIO $ doesDirectoryExist $ parentDir file) $-		freezeContentDir file+	when (present && not direct) $ void $ tryIO $+		if isKeyUnlocked keystatus+			then thawContent obj+			else freezeContent obj+	whenM (liftIO $ doesDirectoryExist $ parentDir obj) $+		freezeContentDir obj  	{- In direct mode, modified files will show up as not present, 	 - but that is expected and not something to do anything about. -}@@ -288,18 +292,16 @@ {- The size of the data for a key is checked against the size encoded in  - the key's metadata, if available.  -- - Not checked in direct mode, because files can be changed directly.+ - Not checked when a file is unlocked, or in direct mode.  -}-checkKeySize :: Key -> Annex Bool-checkKeySize key = ifM isDirect-	( return True-	, do-		file <- calcRepo $ gitAnnexLocation key-		ifM (liftIO $ doesFileExist file)-			( checkKeySizeOr badContent key file-			, return True-			)-	)+checkKeySize :: Key -> KeyStatus -> Annex Bool+checkKeySize _ KeyUnlocked = return True+checkKeySize key _ = do+	file <- calcRepo $ gitAnnexLocation key+	ifM (liftIO $ doesFileExist file)+		( checkKeySizeOr badContent key file+		, return True+		)  checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool checkKeySizeRemote _ _ Nothing = return True@@ -326,18 +328,26 @@ 			, msg 			] -{- Runs the backend specific check on a key's content.+{- Runs the backend specific check on a key's content object.  -+ - When a file is unlocked, it may be a hard link to the object,+ - thus when the user modifies the file, the object will be modified and+ - not pass the check, and we don't want to find an error in this case.+ - So, skip the check if the key is unlocked and modified.+ -  - In direct mode this is not done if the file has clearly been modified,  - because modification of direct mode files is allowed. It's still done  - if the file does not appear modified, to catch disk corruption, etc.  -}-checkBackend :: Backend -> Key -> Maybe FilePath -> Annex Bool-checkBackend backend key mfile = go =<< isDirect+checkBackend :: Backend -> Key -> KeyStatus -> Maybe FilePath -> Annex Bool+checkBackend backend key keystatus mfile = go =<< isDirect   where 	go False = do 		content <- calcRepo $ gitAnnexLocation key-		checkBackendOr badContent backend key content+		ifM (pure (isKeyUnlocked keystatus) <&&> (not <$> isUnmodified key content))+			( nocheck+			, checkBackendOr badContent backend key content+			) 	go True = maybe nocheck checkdirect mfile 	checkdirect file = ifM (goodContent key file) 		( checkBackendOr' (badContentDirect file) backend key file@@ -468,17 +478,11 @@ {- Check if a key needs to be fscked, with support for incremental fscks. -} needFsck :: Incremental -> Key -> Annex Bool needFsck (ScheduleIncremental _ _ i) k = needFsck i k-#ifdef WITH_DATABASE needFsck (ContIncremental h) key = liftIO $ not <$> FsckDb.inDb h key-#endif needFsck _ _ = return True  recordFsckTime :: Incremental -> Key -> Annex ()-#ifdef WITH_DATABASE recordFsckTime inc key = withFsckDb inc $ \h -> liftIO $ FsckDb.addDb h key-#else-recordFsckTime _ _ = return ()-#endif  {- Records the start time of an incremental fsck.  -@@ -530,14 +534,11 @@ data Incremental 	= NonIncremental 	| ScheduleIncremental Duration UUID Incremental-#ifdef WITH_DATABASE 	| StartIncremental FsckDb.FsckHandle  	| ContIncremental FsckDb.FsckHandle-#endif  prepIncremental :: UUID -> Maybe IncrementalOpt -> Annex Incremental prepIncremental _ Nothing = pure NonIncremental-#ifdef WITH_DATABASE prepIncremental u (Just StartIncrementalO) = do 	recordStartTime u 	ifM (FsckDb.newPass u)@@ -552,9 +553,6 @@ 		Nothing -> StartIncrementalO 		Just _ -> MoreIncrementalO 	return (ScheduleIncremental delta u i)-#else-prepIncremental _ _ = error "This git-annex was not built with database support; incremental fsck not supported"-#endif  cleanupIncremental :: Incremental -> Annex () cleanupIncremental (ScheduleIncremental delta u i) = do@@ -568,7 +566,6 @@ 	cleanupIncremental i cleanupIncremental _ = return () -#ifdef WITH_DATABASE openFsckDb :: UUID -> Annex FsckDb.FsckHandle openFsckDb u = do 	h <- FsckDb.openDb u@@ -581,4 +578,20 @@ withFsckDb (StartIncremental h) a = a h withFsckDb NonIncremental _ = noop withFsckDb (ScheduleIncremental _ _ i) a = withFsckDb i a-#endif++data KeyStatus = KeyLocked | KeyUnlocked | KeyMissing++isKeyUnlocked :: KeyStatus -> Bool+isKeyUnlocked KeyUnlocked = True+isKeyUnlocked KeyLocked = False+isKeyUnlocked KeyMissing = False++getKeyStatus :: Key -> Annex KeyStatus+getKeyStatus key = ifM isDirect+	( return KeyUnlocked+	, catchDefaultIO KeyMissing $ do+		obj <- calcRepo $ gitAnnexLocation key+		unlocked <- ((> 1) . linkCount <$> liftIO (getFileStatus obj))+			<&&> (not . null <$> Database.Keys.getAssociatedFiles key)+		return $ if unlocked then KeyUnlocked else KeyLocked+	)
Command/Indirect.hs view
@@ -20,7 +20,7 @@ import Annex.Content.Direct import Annex.CatFile import Annex.Init-import qualified Command.Add+import Annex.Ingest  cmd :: Command cmd = notBareRepo $ noDaemonRunning $@@ -76,7 +76,7 @@ 						return Nothing 				| otherwise ->  					maybe noop (fromdirect f)-						=<< catKey sha mode+						=<< catKey sha 			_ -> noop 	go _ = noop @@ -90,7 +90,7 @@ 				Right _ -> do  					l <- calcRepo $ gitAnnexLink f k 					liftIO $ createSymbolicLink l f-				Left e -> catchNonAsync (Command.Add.undo f k e)+				Left e -> catchNonAsync (restoreFile f k e) 					warnlocked 		showEndOk
Command/Info.hs view
@@ -12,7 +12,6 @@ import "mtl" Control.Monad.State.Strict import qualified Data.Map.Strict as M import Text.JSON-import Data.Tuple import Data.Ord  import Common.Annex@@ -403,12 +402,9 @@  backend_usage :: Stat backend_usage = stat "backend usage" $ json fmt $-	calc-		<$> (backendsKeys <$> cachedReferencedData)-		<*> (backendsKeys <$> cachedPresentData)+	toJSObject . sort . M.toList . backendsKeys <$> cachedReferencedData   where-	calc x y = sort $ M.toList $ M.unionWith (+) x y-	fmt = multiLine . map (\(n, b) -> b ++ ": " ++ show n) . map swap+	fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . fromJSObject  numcopies_stats :: Stat numcopies_stats = stat "numcopies stats" $ json fmt $
Command/Init.hs view
@@ -10,25 +10,44 @@ import Common.Annex import Command import Annex.Init+import Annex.Version import qualified Annex.SpecialRemote 	 cmd :: Command cmd = dontCheck repoExists $ 	command "init" SectionSetup "initialize git-annex"-		paramDesc (withParams seek)+		paramDesc (seek <$$> optParser) -seek :: CmdParams -> CommandSeek-seek = withWords start+data InitOptions = InitOptions+	{ initDesc :: String+	, initVersion :: Maybe Version+	} -start :: [String] -> CommandStart-start ws = do-	showStart "init" description-	next $ perform description-  where-	description = unwords ws+optParser :: CmdParamsDesc -> Parser InitOptions+optParser desc = InitOptions+	<$> (unwords <$> cmdParams desc)+	<*> optional (option (str >>= parseVersion)+		( long "version" <> metavar paramValue+		<> help "Override default annex.version"+		)) -perform :: String -> CommandPerform-perform description = do-	initialize $ if null description then Nothing else Just description+parseVersion :: Monad m => String -> m Version+parseVersion v+	| v `elem` supportedVersions = return v+	| otherwise = fail $ v ++ " is not a currently supported repository version"++seek :: InitOptions -> CommandSeek+seek = commandAction . start++start :: InitOptions -> CommandStart+start os = do+	showStart "init" (initDesc os)+	next $ perform os++perform :: InitOptions -> CommandPerform+perform os = do+	initialize +		(if null (initDesc os) then Nothing else Just (initDesc os))+		(initVersion os) 	Annex.SpecialRemote.autoEnable 	next $ return True
Command/Lock.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010 Joey Hess <id@joeyh.name>+ - Copyright 2010,2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -11,6 +11,17 @@ import Command import qualified Annex.Queue import qualified Annex+import Annex.Version+import Annex.Content+import Annex.Link+import Annex.InodeSentinal+import Annex.Perms+import Annex.ReplaceFile+import Utility.InodeCache+import qualified Database.Keys+import Annex.Ingest+import Logs.Location+import Git.FilePath 	 cmd :: Command cmd = notDirect $ withGlobalOptions annexedMatchingOptions $@@ -19,18 +30,92 @@ 		paramPaths (withParams seek)  seek :: CmdParams -> CommandSeek-seek ps = do-	withFilesUnlocked start ps-	withFilesUnlockedToBeCommitted start ps+seek ps = ifM versionSupportsUnlockedPointers+	( withFilesInGit (whenAnnexed startNew) ps+	, do+		withFilesOldUnlocked startOld ps+		withFilesOldUnlockedToBeCommitted startOld ps+	) -start :: FilePath -> CommandStart-start file = do+startNew :: FilePath -> Key -> CommandStart+startNew file key = ifM (isJust <$> isAnnexLink file)+	( stop+	, do+		showStart "lock" file+		go =<< liftIO (isPointerFile file)+	)+  where+	go (Just key')+		| key' == key = error "content not present; cannot lock"+		| otherwise = errorModified+	go Nothing = +		ifM (isUnmodified key file) +			( cont False+			, ifM (Annex.getState Annex.force)+				( cont True+				, errorModified+				)+			)+	cont = next . performNew file key++performNew :: FilePath -> Key -> Bool -> CommandPerform+performNew file key filemodified = do+	lockdown =<< calcRepo (gitAnnexLocation key)+	addLink file key+		=<< withTSDelta (liftIO . genInodeCache file)+	next $ cleanupNew file key+  where+	lockdown obj = do+		ifM (catchBoolIO $ sameInodeCache obj =<< Database.Keys.getInodeCaches key)+			( breakhardlink obj+			, repopulate obj+			)+		whenM (liftIO $ doesFileExist obj) $+			freezeContent obj++	-- It's ok if the file is hard linked to obj, but if some other+	-- associated file is, we need to break that link to lock down obj.+	breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (getFileStatus obj)) $ do+		mfc <- withTSDelta (liftIO . genInodeCache file)+		unlessM (sameInodeCache obj (maybeToList mfc)) $ do+			modifyContent obj $ replaceFile obj $ \tmp -> do+				unlessM (checkedCopyFile key obj tmp) $+					error "unable to lock file"+			Database.Keys.storeInodeCaches key [obj]++	-- Try to repopulate obj from an unmodified associated file.+	repopulate obj+		| filemodified = modifyContent obj $ do+			g <- Annex.gitRepo+			fs <- mapM (`fromTopFilePath` g)+				<$> Database.Keys.getAssociatedFiles key+			mfile <- firstM (isUnmodified key) fs+			liftIO $ nukeFile obj+			case mfile of+				Just unmodified ->+					unlessM (checkedCopyFile key unmodified obj)+						lostcontent+				Nothing -> lostcontent+		| otherwise = modifyContent obj $ +			liftIO $ renameFile file obj+	lostcontent = logStatus key InfoMissing++cleanupNew :: FilePath -> Key -> CommandCleanup+cleanupNew file key = do+	Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)+	return True++startOld :: FilePath -> CommandStart+startOld file = do 	showStart "lock" file-	unlessM (Annex.getState Annex.force) $-		error "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"-	next $ perform file+	unlessM (Annex.getState Annex.force)+		errorModified+	next $ performOld file -perform :: FilePath -> CommandPerform-perform file = do+performOld :: FilePath -> CommandPerform+performOld file = do 	Annex.Queue.addCommand "checkout" [Param "--"] [file]-	next $ return True -- no cleanup needed+	next $ return True++errorModified :: a+errorModified =  error "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"
Command/Migrate.hs view
@@ -17,6 +17,9 @@ import qualified Command.ReKey import qualified Command.Fsck import qualified Annex+import Logs.MetaData+import Logs.Web+import qualified Remote  cmd :: Command cmd = notDirect $ withGlobalOptions annexedMatchingOptions $@@ -72,9 +75,19 @@ 	go (Just (newkey, knowngoodcontent)) 		| knowngoodcontent = finish newkey 		| otherwise = stopUnless checkcontent $ finish newkey-	checkcontent = Command.Fsck.checkBackend oldbackend oldkey $ Just file-	finish newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $-		next $ Command.ReKey.cleanup file oldkey newkey+	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked $ Just file+	finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey)+		( do+			copyMetaData oldkey newkey+			-- If the old key had some associated urls, record them for+			-- the new key as well.+			urls <- getUrls oldkey+			forM_ urls $ \url -> do+				r <- Remote.claimingUrl url+				setUrlPresent (Remote.uuid r) newkey url+			next $ Command.ReKey.cleanup file oldkey newkey+		, error "failed"+		) 	genkey = case maybe Nothing (\fm -> fm oldkey newbackend (Just file)) (fastMigrate oldbackend) of 		Just newkey -> return $ Just (newkey, True) 		Nothing -> do
Command/PreCommit.hs view
@@ -16,7 +16,9 @@ import qualified Command.Fix import Annex.Direct import Annex.Hook+import Annex.Link import Annex.View+import Annex.Version import Annex.View.ViewedFile import Annex.LockFile import Logs.View@@ -41,17 +43,22 @@ 		withWords startDirect ps 		runAnnexHook preCommitAnnexHook 	, do-		ifM (liftIO Git.haveFalseIndex)+		ifM (not <$> versionSupportsUnlockedPointers <&&> liftIO Git.haveFalseIndex) 			( do 				(fs, cleanup) <- inRepo $ Git.typeChangedStaged ps-				whenM (anyM isUnlocked fs) $+				whenM (anyM isOldUnlocked fs) $ 					error "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit." 				void $ liftIO cleanup 			, do 				-- fix symlinks to files being committed-				withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps+				flip withFilesToBeCommitted ps $ \f -> +					maybe stop (Command.Fix.start Command.Fix.FixSymlinks f)+						=<< isAnnexLink f 				-- inject unlocked files into the annex-				withFilesUnlockedToBeCommitted startIndirect ps+				-- (not needed when repo version uses+				-- unlocked pointer files)+				unlessM versionSupportsUnlockedPointers $+					withFilesOldUnlockedToBeCommitted startInjectUnlocked ps 			) 		runAnnexHook preCommitAnnexHook 		-- committing changes to a view updates metadata@@ -64,8 +71,8 @@ 	) 	 -startIndirect :: FilePath -> CommandStart-startIndirect f = next $ do+startInjectUnlocked :: FilePath -> CommandStart+startInjectUnlocked f = next $ do 	unlessM (callCommandAction $ Command.Add.start f) $ 		error $ "failed to add " ++ f ++ "; canceling commit" 	next $ return True
Command/ReKey.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -12,11 +12,15 @@ import qualified Annex import Types.Key import Annex.Content-import qualified Command.Add-import Logs.Web+import Annex.Ingest+import Annex.Link+import Annex.Perms+import Annex.ReplaceFile import Logs.Location-import Utility.CopyFile-import qualified Remote+import Git.FilePath+import qualified Database.Keys+import Annex.InodeSentinal+import Utility.InodeCache  cmd :: Command cmd = notDirect $ @@ -40,36 +44,65 @@  perform :: FilePath -> Key -> Key -> CommandPerform perform file oldkey newkey = do-	present <- inAnnex oldkey-	_ <- if present-		then linkKey oldkey newkey-		else do-			unlessM (Annex.getState Annex.force) $-				error $ file ++ " is not available (use --force to override)"-			return True+	ifM (inAnnex oldkey) +		( unlessM (linkKey file oldkey newkey) $+			error "failed"+		, unlessM (Annex.getState Annex.force) $+			error $ file ++ " is not available (use --force to override)"+		) 	next $ cleanup file oldkey newkey  {- Make a hard link to the old key content (when supported),  - to avoid wasting disk space. -}-linkKey :: Key -> Key -> Annex Bool-linkKey oldkey newkey = getViaTmp' DefaultVerify newkey $ \tmp -> unVerified $ do-	src <- calcRepo $ gitAnnexLocation oldkey-	liftIO $ ifM (doesFileExist tmp)-		( return True-		, createLinkOrCopy src tmp-		)+linkKey :: FilePath -> Key -> Key -> Annex Bool+linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)+ 	{- If the object file is already hardlinked to elsewhere, a hard+	 - link won't be made by getViaTmp', but a copy instead.+	 - This avoids hard linking to content linked to an+	 - unlocked file, which would leave the new key unlocked+	 - and vulnerable to corruption. -}+	( getViaTmp' DefaultVerify newkey $ \tmp -> unVerified $ do+		oldobj <- calcRepo (gitAnnexLocation oldkey)+		linkOrCopy' (return True) newkey oldobj tmp+	, do+		ic <- withTSDelta (liftIO . genInodeCache file)+	 	{- The file being rekeyed is itself an unlocked file, so if+		 - it's linked to the old key, that link must be broken. -}+		oldobj <- calcRepo (gitAnnexLocation oldkey)+		v <- tryNonAsync $ modifyContent oldobj $ do+			replaceFile oldobj $ \tmp ->+				unlessM (checkedCopyFile oldkey file tmp) $+					error "can't lock old key"+			freezeContent oldobj+			oldic <- withTSDelta (liftIO . genInodeCache oldobj)+			whenM (isUnmodified oldkey oldobj) $+				Database.Keys.addInodeCaches oldkey (catMaybes [oldic])+		case v of+			Left e -> do+				warning (show e)+				return False+			Right () -> do+				r <- linkToAnnex newkey file ic+				return $ case r of+					LinkAnnexFailed -> False+					LinkAnnexOk -> True+					LinkAnnexNoop -> True+	)  cleanup :: FilePath -> Key -> Key -> CommandCleanup cleanup file oldkey newkey = do-	-- If the old key had some associated urls, record them for-	-- the new key as well.-	urls <- getUrls oldkey-	forM_ urls $ \url -> do-		r <- Remote.claimingUrl url-		setUrlPresent (Remote.uuid r) newkey url+	ifM (isJust <$> isAnnexLink file)+		( do+			-- Update symlink to use the new key.+			liftIO $ removeFile file+			addLink file newkey Nothing+		, do+			liftIO $ whenM (isJust <$> isPointerFile file) $+				writeFile file (formatPointer newkey)+			stagePointerFile file =<< hashPointerFile newkey+			Database.Keys.removeAssociatedFile oldkey +				=<< inRepo (toTopFilePath file)+		) -	-- Update symlink to use the new key.-	liftIO $ removeFile file-	Command.Add.addLink file newkey Nothing 	logStatus newkey InfoPresent 	return True
Command/RecvKey.hs view
@@ -27,10 +27,11 @@  start :: Key -> CommandStart start key = fieldTransfer Download key $ \_p -> do-	-- Always verify content when a direct mode repo is sending a file,+	-- Always verify content when a repo is sending an unlocked file, 	-- as the file could change while being transferred.-	fromdirect <- isJust <$> Fields.getField Fields.direct-	let verify = if fromdirect then AlwaysVerify else DefaultVerify+	fromunlocked <- (isJust <$> Fields.getField Fields.unlocked)+		<||> (isJust <$> Fields.getField Fields.direct)+	let verify = if fromunlocked then AlwaysVerify else DefaultVerify 	ifM (getViaTmp verify key go) 		( do 			-- forcibly quit after receiving one key,
Command/Reinit.hs view
@@ -38,6 +38,6 @@ 		then return $ toUUID s 		else Remote.nameToUUID s 	storeUUID u-	initialize'+	initialize' Nothing 	Annex.SpecialRemote.autoEnable 	next $ return True
+ Command/Smudge.hs view
@@ -0,0 +1,95 @@+{- git-annex command+ -+ - Copyright 2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.Smudge where++import Common.Annex+import Command+import Annex.Content+import Annex.Link+import Annex.FileMatcher+import Annex.Ingest+import Logs.Location+import qualified Database.Keys+import Git.FilePath++import qualified Data.ByteString.Lazy as B++cmd :: Command+cmd = noCommit $ noMessages $+	command "smudge" SectionPlumbing +		"git smudge filter"+		paramFile (seek <$$> optParser)++data SmudgeOptions = SmudgeOptions+	{ smudgeFile :: FilePath+	, cleanOption :: Bool+	}++optParser :: CmdParamsDesc -> Parser SmudgeOptions+optParser desc = SmudgeOptions+	<$> argument str ( metavar desc )+	<*> switch ( long "clean" <> help "clean filter" )++seek :: SmudgeOptions -> CommandSeek+seek o = commandAction $+	(if cleanOption o then clean else smudge) (smudgeFile o)++-- Smudge filter is fed git file content, and if it's a pointer to an+-- available annex object, should output its content.+smudge :: FilePath -> CommandStart+smudge file = do+	b <- liftIO $ B.hGetContents stdin+	case parseLinkOrPointer b of+		Nothing -> liftIO $ B.putStr b+		Just k -> do+			-- A previous unlocked checkout of the file may have+			-- led to the annex object getting modified;+			-- don't provide such modified content as it+			-- will be confusing. inAnnex will detect such+			-- modifications.+			ifM (inAnnex k)+				( do+					content <- calcRepo (gitAnnexLocation k)+					liftIO $ B.putStr . fromMaybe b+						=<< catchMaybeIO (B.readFile content)+				, liftIO $ B.putStr b+				)+			Database.Keys.addAssociatedFile k =<< inRepo (toTopFilePath file)+	stop++-- Clean filter is fed file content on stdin, decides if a file+-- should be stored in the annex, and outputs a pointer to its+-- injested content.+clean :: FilePath -> CommandStart+clean file = do+	b <- liftIO $ B.hGetContents stdin+	if isJust (parseLinkOrPointer b)+		then liftIO $ B.hPut stdout b+		else ifM (shouldAnnex file)+			( liftIO . emitPointer+				=<< go =<< ingest =<< lockDown cfg file+			, liftIO $ B.hPut stdout b+			)+	stop+  where+	go (Just k, _) = do+		logStatus k InfoPresent+		return k+	go _ = error "could not add file to the annex"+	cfg = LockDownConfig+		{ lockingFile = False+		, hardlinkFileTmp = False+		}++shouldAnnex :: FilePath -> Annex Bool+shouldAnnex file = do+	matcher <- largeFilesMatcher+	checkFileMatcher matcher file++emitPointer :: Key -> IO ()+emitPointer = putStr . formatPointer
Command/Status.hs view
@@ -46,10 +46,19 @@ 	unlessM (showFullJSON [("status", [c]), ("file", f)]) $ 		liftIO $ putStrLn $ [c] ++ " " ++ f --- Git thinks that present direct mode files are typechanged;--- check their content to see if they are modified or not.+-- Git thinks that present direct mode files are typechanged.+-- (On crippled filesystems, git instead thinks they're modified.)+-- Check their content to see if they are modified or not. statusDirect :: Status -> Annex (Maybe Status)-statusDirect (TypeChanged t) = do+statusDirect (TypeChanged t) = statusDirect' t+statusDirect s@(Modified t) = ifM crippledFileSystem+	( statusDirect' t+	, pure (Just s)+	)+statusDirect s = pure (Just s)++statusDirect' :: TopFilePath -> Annex (Maybe Status)+statusDirect' t = do 	absf <- fromRepo $ fromTopFilePath t 	f <- liftIO $ relPathCwdToFile absf 	v <- liftIO (catchMaybeIO $ getFileStatus f)@@ -65,7 +74,6 @@ 		, return $ Just $ Modified t 		) 	checkkey f _ Nothing = Just <$> checkNew f t-statusDirect s = pure (Just s)  checkNew :: FilePath -> TopFilePath -> Annex Status checkNew f t = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
Command/Unannex.hs view
@@ -15,12 +15,15 @@ import qualified Annex import Annex.Content import Annex.Content.Direct+import Annex.Version import qualified Git.Command import qualified Git.Branch import qualified Git.Ref import qualified Git.DiffTree as DiffTree import Utility.CopyFile import Command.PreCommit (lockPreCommitHook)+import qualified Database.Keys+import Git.FilePath  cmd :: Command cmd = withGlobalOptions annexedMatchingOptions $@@ -32,7 +35,7 @@ seek = wrapUnannex . (withFilesInGit $ whenAnnexed start)  wrapUnannex :: Annex a -> Annex a-wrapUnannex a = ifM isDirect+wrapUnannex a = ifM (versionSupportsUnlockedPointers <||> isDirect) 	( a 	{- Run with the pre-commit hook disabled, to avoid confusing 	 - behavior if an unannexed file is added back to git as@@ -85,6 +88,7 @@  cleanupIndirect :: FilePath -> Key -> CommandCleanup cleanupIndirect file key = do+	Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file) 	src <- calcRepo $ gitAnnexLocation key 	ifM (Annex.getState Annex.fast) 		( do
Command/Undo.hs view
@@ -72,7 +72,7 @@ 		f <- mkrel di 		whenM isDirect $ 			maybe noop (`removeDirect` f)-				=<< catKey (srcsha di) (srcmode di)+				=<< catKey (srcsha di) 		liftIO $ nukeFile f  	forM_ adds $ \di -> do@@ -80,6 +80,6 @@ 		inRepo $ Git.run [Param "checkout", Param "--", File f] 		whenM isDirect $ 			maybe noop (`toDirect` f)-				=<< catKey (dstsha di) (dstmode di)+				=<< catKey (dstsha di)  	next $ liftIO cleanup
Command/Unlock.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010 Joey Hess <id@joeyh.name>+ - Copyright 2010,2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -11,6 +11,9 @@ import Command import Annex.Content import Annex.CatFile+import Annex.Version+import Annex.Link+import Annex.ReplaceFile import Utility.CopyFile  cmd :: Command@@ -26,14 +29,44 @@ seek :: CmdParams -> CommandSeek seek = withFilesInGit $ whenAnnexed start -{- The unlock subcommand replaces the symlink with a copy of the file's- - content. -}+{- Before v6, the unlock subcommand replaces the symlink with a copy of+ - the file's content. In v6 and above, it converts the file from a symlink+ - to a pointer. -} start :: FilePath -> Key -> CommandStart-start file key = do-	showStart "unlock" file+start file key = ifM (isJust <$> isAnnexLink file)+	( do+		showStart "unlock" file+		ifM (inAnnex key)+			( ifM versionSupportsUnlockedPointers+				( next $ performNew file key+				, startOld file key +				)+			, do+				warning "content not present; cannot unlock"+				next $ next $ return False+			)+	, stop+	)++performNew :: FilePath -> Key -> CommandPerform+performNew dest key = do+	replaceFile dest $ \tmp -> do+		r <- linkFromAnnex key tmp+		case r of+			LinkAnnexOk -> return ()+			_ -> error "unlock failed"+	next $ cleanupNew dest key++cleanupNew ::  FilePath -> Key -> CommandCleanup+cleanupNew dest key = do+	stagePointerFile dest =<< hashPointerFile key+	return True++startOld :: FilePath -> Key -> CommandStart+startOld file key =  	ifM (inAnnex key) 		( ifM (isJust <$> catKeyFileHEAD file)-			( next $ perform file key+			( next $ performOld file key 			, do 				warning "this has not yet been committed to git; cannot unlock it" 				next $ next $ return False@@ -43,8 +76,8 @@ 			next $ next $ return False 		) -perform :: FilePath -> Key -> CommandPerform-perform dest key = ifM (checkDiskSpace Nothing key 0 True)+performOld :: FilePath -> Key -> CommandPerform+performOld dest key = ifM (checkDiskSpace Nothing key 0 True) 	( do 		src <- calcRepo $ gitAnnexLocation key 		tmpdest <- fromRepo $ gitAnnexTmpObjectLocation key
Command/Unused.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010-2015 Joey Hess <id@joeyh.name>+ - Copyright 2010-2016 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -24,22 +24,23 @@ import qualified Git.RefLog import qualified Git.LsFiles as LsFiles import qualified Git.DiffTree as DiffTree-import qualified Backend import qualified Remote import qualified Annex.Branch+import Annex.Link import Annex.CatFile import Types.Key import Types.RefSpec-import Git.FilePath import Git.Types+import Git.Sha+import Git.FilePath import Logs.View (is_branchView) import Annex.BloomFilter+import qualified Database.Keys+import Annex.InodeSentinal  cmd :: Command-cmd = -- withGlobalOptions [unusedFromOption, refSpecOption] $-	command "unused" SectionMaintenance -		"look for unused file content"-		paramNothing (seek <$$> optParser)+cmd = command "unused" SectionMaintenance "look for unused file content"+	paramNothing (seek <$$> optParser)  data UnusedOptions = UnusedOptions 	{ fromRemote :: Maybe RemoteName@@ -158,37 +159,38 @@  -  - Strategy:  -- - * Build a bloom filter of all keys referenced by symlinks. This - -   is the fastest one to build and will filter out most keys.- - * If keys remain, build a second bloom filter of keys referenced by- -   branches maching the RefSpec.- - * The list is streamed through these bloom filters lazily, so both will- -   exist at the same time. This means that twice the memory is used,- -   but they're relatively small, so the added complexity of using a- -   mutable bloom filter does not seem worthwhile.- - * Generating the second bloom filter can take quite a while, since- -   it needs enumerating all keys in all git branches. But, the common- -   case, if the second filter is needed, is for some keys to be globally- -   unused, and in that case, no short-circuit is possible.- -   Short-circuiting if the first filter filters all the keys handles the- -   other common case.+ - Pass keys through these filters in order, only creating each bloom+ - filter on demand if the previous one didn't filter out all keys.+ -+ - 1. Bloom filter containing all keys referenced by files in the work tree.+ -    This is the fastest one to build and will filter out most keys.+ - 2. Bloom filter containing all keys in the diff from the work tree to+ -    the index.+ - 3. Associated files filter. A v6 unlocked file may have had its content+ -    added to the annex (by eg, git diff running the smudge filter),+ -    but the new key is not yet staged in the index. But if so, it will + -    have an associated file.+ - 4. Bloom filter containing all keys in the diffs between the index and+ -    branches matching the RefSpec. (This can take quite a while to build).  -} excludeReferenced :: RefSpec -> [Key] -> Annex [Key]-excludeReferenced refspec ks = runfilter firstlevel ks >>= runfilter secondlevel+excludeReferenced refspec ks = runbloomfilter withKeysReferencedM ks+	>>= runbloomfilter withKeysReferencedDiffIndex+	>>= runfilter associatedFilesFilter+	>>= runbloomfilter (withKeysReferencedDiffGitRefs refspec)   where 	runfilter _ [] = return [] -- optimisation-	runfilter a l = bloomFilter l <$> genBloomFilter a-	firstlevel = withKeysReferencedM-	secondlevel = withKeysReferencedInGit refspec+	runfilter a l = a l+	runbloomfilter a = runfilter $ \l -> bloomFilter l <$> genBloomFilter a  {- Given an initial value, folds it with each key referenced by- - symlinks in the git repo. -}+ - files in the working tree. -} withKeysReferenced :: v -> (Key -> v -> v) -> Annex v withKeysReferenced initial a = withKeysReferenced' Nothing initial folda   where 	folda k _ v = return $ a k v -{- Runs an action on each referenced key in the git repo. -}+{- Runs an action on each referenced key in the working tree. -} withKeysReferencedM :: (Key -> Annex ()) -> Annex () withKeysReferencedM a = withKeysReferenced' Nothing () calla   where@@ -215,60 +217,84 @@ 		Just dir -> inRepo $ LsFiles.inRepo [dir] 	go v [] = return v 	go v (f:fs) = do-		x <- Backend.lookupFile f-		case x of+		mk <- getM id+			[ isAnnexLink f+			, liftIO (isPointerFile f)+			]+		case mk of 			Nothing -> go v fs 			Just k -> do 				!v' <- a k f v 				go v' fs -withKeysReferencedInGit :: RefSpec -> (Key -> Annex ()) -> Annex ()-withKeysReferencedInGit refspec a = do-	current <- inRepo Git.Branch.currentUnsafe-	shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha) current-	rs <- relevantrefs (shaHead, current)-		<$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"])-	usedrefs <- applyRefSpec refspec rs (getreflog rs)-	forM_ usedrefs $-		withKeysReferencedInGitRef a+withKeysReferencedDiffGitRefs :: RefSpec -> (Key -> Annex ()) -> Annex ()+withKeysReferencedDiffGitRefs refspec a = do+	rs <- relevantrefs <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"])+	shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha)+		=<< inRepo Git.Branch.currentUnsafe+	let haveHead = any (\(shaRef, _) -> Just shaRef == shaHead) rs+	let rs' = map snd (nubRefs rs)+	usedrefs <- applyRefSpec refspec rs' (getreflog rs')+	forM_ (if haveHead then usedrefs else Git.Ref.headRef : usedrefs) $+		withKeysReferencedDiffGitRef a   where-	relevantrefs headRef = addHead headRef .+	relevantrefs = map (\(r, h) -> (Git.Ref r, Git.Ref h)) . 		filter ourbranches . 		map (separate (== ' ')) . 		lines-	nubRefs = map (Git.Ref . snd) . nubBy (\(x, _) (y, _) -> x == y)+	nubRefs = nubBy (\(x, _) (y, _) -> x == y) 	ourbranchend = '/' : Git.fromRef Annex.Branch.name 	ourbranches (_, b) = not (ourbranchend `isSuffixOf` b) 		&& not ("refs/synced/" `isPrefixOf` b) 		&& not (is_branchView (Git.Ref b))-	addHead headRef refs = case headRef of-		-- if HEAD diverges from all branches (except the branch it-		-- points to), run the actions on staged keys (and keys-		-- that are only present in the work tree if the repo is-		-- non bare)-		(Just (Git.Ref x), Just (Git.Ref b))-			| all (\(x',b') -> x /= x' || b == b') refs ->-				Git.Ref.headRef-				: nubRefs (filter ((/= x) . fst) refs)-		_ -> nubRefs refs 	getreflog rs = inRepo $ Git.RefLog.getMulti rs  {- Runs an action on keys referenced in the given Git reference which- - differ from those referenced in the work tree. -}-withKeysReferencedInGitRef :: (Key -> Annex ()) -> Git.Ref -> Annex ()-withKeysReferencedInGitRef a ref = do+ - differ from those referenced in the index. -}+withKeysReferencedDiffGitRef :: (Key -> Annex ()) -> Git.Ref -> Annex ()+withKeysReferencedDiffGitRef a ref = do 	showAction $ "checking " ++ Git.Ref.describe ref-	bare <- isBareRepo-	(ts,clean) <- inRepo $ if bare-		then DiffTree.diffIndex ref-		else DiffTree.diffWorkTree ref-	let lookAtWorkingTree = not bare && ref == Git.Ref.headRef-	forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a+	withKeysReferencedDiff a+		(inRepo $ DiffTree.diffIndex ref)+		DiffTree.srcsha++{- Runs an action on keys referenced in the index which differ from the+ - work tree. -}+withKeysReferencedDiffIndex :: (Key -> Annex ()) -> Annex ()+withKeysReferencedDiffIndex a = unlessM (isBareRepo) $+	withKeysReferencedDiff a+		(inRepo $ DiffTree.diffFiles [])+		DiffTree.srcsha++withKeysReferencedDiff :: (Key -> Annex ()) -> (Annex ([DiffTree.DiffTreeItem], IO Bool)) -> (DiffTree.DiffTreeItem -> Sha) -> Annex ()+withKeysReferencedDiff a getdiff extractsha = do+	(ds, clean) <- getdiff+	forM_ ds go 	liftIO $ void clean   where-	tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file-	tKey False = fileKey . takeFileName . decodeBS <$$>-		catFile ref . getTopFilePath . DiffTree.file+	go d = do+		let sha = extractsha d+		unless (sha == nullSha) $+			(parseLinkOrPointer <$> catObject sha)+				>>= maybe noop a++{- Filters out keys that have an associated file that's not modified. -}+associatedFilesFilter :: [Key] -> Annex [Key]+associatedFilesFilter = filterM go+  where+	go k = do+		cs <- Database.Keys.getInodeCaches k+		if null cs+			then return True+			else checkunmodified cs+				=<< Database.Keys.getAssociatedFiles k+	checkunmodified _ [] = return True+	checkunmodified cs (f:fs) = do+		relf <- fromRepo $ fromTopFilePath f+		ifM (sameInodeCache relf cs)+			( return False+			, checkunmodified cs fs+			)  data UnusedMaps = UnusedMaps 	{ unusedMap :: UnusedMap
Command/Upgrade.hs view
@@ -13,6 +13,7 @@  cmd :: Command cmd = dontCheck repoExists $ -- because an old version may not seem to exist+	noDaemonRunning $ -- avoid upgrading repo out from under daemon 	command "upgrade" SectionMaintenance "upgrade repository layout" 		paramNothing (withParams seek)
Command/Version.hs view
@@ -50,7 +50,8 @@ 	liftIO $ do 		showPackageVersion 		vinfo "local repository version" $ fromMaybe "unknown" v-		vinfo "supported repository version" supportedVersion+		vinfo "supported repository versions" $+			unwords supportedVersions 		vinfo "upgrade supported from repository versions" $ 			unwords upgradableVersions
Command/Whereis.hs view
@@ -7,8 +7,6 @@  module Command.Whereis where -import qualified Data.Map as M- import Common.Annex import Command import Remote@@ -16,6 +14,8 @@ import Logs.Web import Remote.Web (getWebUrls) +import qualified Data.Map as M+ cmd :: Command cmd = noCommit $ withGlobalOptions (jsonOption : annexedMatchingOptions) $ 	command "whereis" SectionQuery@@ -65,21 +65,21 @@ 	-- Since other remotes than the web remote can set urls 	-- where a key can be downloaded, get and show all such urls 	-- as a special case.-	showRemote "web" =<< getWebUrls key+	showRemoteUrls "web" =<< getWebUrls key 	forM_ (mapMaybe (`M.lookup` remotemap) locations) $-		performRemote key+		performRemoteUrls key 	if null safelocations then stop else next $ return True   where 	copiesplural 1 = "copy" 	copiesplural _ = "copies" 	untrustedheader = "The following untrusted locations may also have copies:\n" -performRemote :: Key -> Remote -> Annex () -performRemote key remote = do+performRemoteUrls :: Key -> Remote -> Annex () +performRemoteUrls key remote = do 	ls <- (++) 		<$> askremote 		<*> claimedurls-	showRemote (name remote) ls+	showRemoteUrls (name remote) ls   where 	askremote = maybe (pure []) (flip id key) (whereisKey remote) 	claimedurls = do@@ -89,8 +89,10 @@ 			<$> getUrls key 		filterM (\u -> (==) <$> pure remote <*> claimingUrl u) us -showRemote :: String -> [String] -> Annex ()-showRemote n ls-	| null ls = return ()-	| otherwise = showLongNote $ unlines $-		map (\l -> n ++ ": " ++ l) ls+showRemoteUrls :: String -> [String] -> Annex ()+showRemoteUrls nm us+	| null us = return ()+	| otherwise = do+		let ls = unlines $ map (\u -> nm ++ ": " ++ u) us +		outputMessage noop ('\n' : indent ls ++ "\n")+		maybeShowJSON [("urls", us)]
Common.hs view
@@ -5,7 +5,7 @@ import Control.Monad as X import Control.Monad.IfElse as X import Control.Applicative as X-import "mtl" Control.Monad.State.Strict as X (liftIO)+import Control.Monad.IO.Class as X (liftIO)  import Data.Maybe as X import Data.List as X hiding (head, tail, init, last)
Config.hs view
@@ -90,3 +90,21 @@ setCrippledFileSystem b = do 	setConfig (annexConfig "crippledfilesystem") (Git.Config.boolConfig b) 	Annex.changeGitConfig $ \c -> c { annexCrippledFileSystem = b }++configureSmudgeFilter :: Annex ()+configureSmudgeFilter = do+	setConfig (ConfigKey "filter.annex.smudge") "git-annex smudge %f"+	setConfig (ConfigKey "filter.annex.clean") "git-annex smudge --clean %f"+	lf <- Annex.fromRepo Git.attributesLocal+	gf <- Annex.fromRepo Git.attributes+	lfs <- readattr lf+	gfs <- readattr gf+	liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do+		createDirectoryIfMissing True (takeDirectory lf)+		writeFile lf (lfs ++ "\n" ++ stdattr)+  where+	readattr = liftIO . catchDefaultIO "" . readFileStrictAnyEncoding+	stdattr = unlines+		[ "* filter=annex"+		, ".* !filter"+		]
Database/Fsck.hs view
@@ -21,7 +21,7 @@ ) where  import Database.Types-import qualified Database.Handle as H+import qualified Database.Queue as H import Locations import Utility.PosixFiles import Utility.Exception@@ -31,13 +31,12 @@ import Types.UUID import Annex.Perms import Annex.LockFile-import Messages  import Database.Persist.TH import Database.Esqueleto hiding (Key) import Data.Time.Clock -data FsckHandle = FsckHandle H.DbHandle UUID+data FsckHandle = FsckHandle H.DbQueue UUID  {- Each key stored in the database has already been fscked as part  - of the latest incremental fsck pass. -}@@ -59,7 +58,7 @@ 	go = liftIO . void . tryIO . removeDirectoryRecursive 		=<< fromRepo (gitAnnexFsckDbDir u) -{- Opens the database, creating it atomically if it doesn't exist yet. -}+{- Opens the database, creating it if it doesn't exist yet. -} openDb :: UUID -> Annex FsckHandle openDb u = do 	dbdir <- fromRepo (gitAnnexFsckDbDir u)@@ -77,16 +76,12 @@ 			void $ tryIO $ removeDirectoryRecursive dbdir 			rename tmpdbdir dbdir 	lockFileCached =<< fromRepo (gitAnnexFsckDbLock u)-	h <- liftIO $ H.openDb db "fscked"--	-- work around https://github.com/yesodweb/persistent/issues/474-	liftIO setConsoleEncoding-+	h <- liftIO $ H.openDbQueue db "fscked" 	return $ FsckHandle h u  closeDb :: FsckHandle -> Annex () closeDb (FsckHandle h u) = do-	liftIO $ H.closeDb h+	liftIO $ H.closeDbQueue h 	unlockFile =<< fromRepo (gitAnnexFsckDbLock u)  addDb :: FsckHandle -> Key -> IO ()@@ -102,8 +97,9 @@ 			now <- getCurrentTime 			return $ diffUTCTime lastcommittime now > 300 +{- Doesn't know about keys that were just added with addDb. -} inDb :: FsckHandle -> Key -> IO Bool-inDb (FsckHandle h _) = H.queryDb h . inDb' . toSKey+inDb (FsckHandle h _) = H.queryDbQueue h . inDb' . toSKey  inDb' :: SKey -> SqlPersistM Bool inDb' sk = do
Database/Handle.hs view
@@ -11,17 +11,15 @@ 	DbHandle, 	initDb, 	openDb,+	TableName, 	queryDb, 	closeDb,-	Size,-	queueDb,-	flushQueueDb, 	commitDb,+	commitDb', ) where  import Utility.Exception-import Utility.Monad-import Messages+import Utility.FileSystemEncoding  import Database.Persist.Sqlite import qualified Database.Sqlite as Sqlite@@ -29,22 +27,22 @@ import Control.Monad.IO.Class (liftIO) import Control.Concurrent import Control.Concurrent.Async-import Control.Exception (throwIO)+import Control.Exception (throwIO, BlockedIndefinitelyOnMVar(..)) import qualified Data.Text as T import Control.Monad.Trans.Resource (runResourceT) import Control.Monad.Logger (runNoLoggingT) import Data.List-import Data.Time.Clock+import System.IO  {- A DbHandle is a reference to a worker thread that communicates with  - the database. It has a MVar which Jobs are submitted to. -}-data DbHandle = DbHandle (Async ()) (MVar Job) (MVar DbQueue)+data DbHandle = DbHandle (Async ()) (MVar Job)  {- Ensures that the database is initialized. Pass the migration action for  - the database.  -- - The database is put into WAL mode, to prevent readers from blocking- - writers, and prevent a writer from blocking readers.+ - The database is initialized using WAL mode, to prevent readers+ - from blocking writers, and prevent a writer from blocking readers.  -} initDb :: FilePath -> SqlPersistM () -> IO () initDb f migration = do@@ -60,68 +58,28 @@ 	void $ Sqlite.finalize stmt 	Sqlite.close conn +{- Name of a table that should exist once the database is initialized. -}+type TableName = String+ {- Opens the database, but does not perform any migrations. Only use  - if the database is known to exist and have the right tables. -} openDb :: FilePath -> TableName -> IO DbHandle openDb db tablename = do 	jobs <- newEmptyMVar 	worker <- async (workerThread (T.pack db) tablename jobs)-	q <- newMVar =<< emptyDbQueue-	return $ DbHandle worker jobs q--data Job-	= QueryJob (SqlPersistM ())-	| ChangeJob ((SqlPersistM () -> IO ()) -> IO ())-	| CloseJob--type TableName = String--workerThread :: T.Text -> TableName -> MVar Job -> IO ()-workerThread db tablename jobs = catchNonAsync (run loop) showerr-  where-  	showerr e = liftIO $ warningIO $-		"sqlite worker thread crashed: " ++ show e 	-	loop = do-		job <- liftIO $ takeMVar jobs-		case job of-			QueryJob a -> a >> loop-			-- change is run in a separate database connection-			-- since sqlite only supports a single writer at a-			-- time, and it may crash the database connection-			ChangeJob a -> liftIO (a run) >> loop-			CloseJob -> return ()-	-	-- like runSqlite, but calls settle on the raw sql Connection.-	run a = do-		conn <- Sqlite.open db-		settle conn-		runResourceT $ runNoLoggingT $-			withSqlConn (wrapConnection conn) $-				runSqlConn a+	-- work around https://github.com/yesodweb/persistent/issues/474+	liftIO setConsoleEncoding -	-- Work around a bug in sqlite: New database connections can-	-- sometimes take a while to become usable; select statements will-	-- fail with ErrorBusy for some time. So, loop until a select-	-- succeeds; once one succeeds the connection will stay usable.-	-- <http://thread.gmane.org/gmane.comp.db.sqlite.general/93116>-	settle conn = do-		r <- tryNonAsync $ do-			stmt <- Sqlite.prepare conn nullselect-			void $ Sqlite.step stmt-			void $ Sqlite.finalize stmt-		case r of-			Right _ -> return ()-			Left e -> do-				if "ErrorBusy" `isInfixOf` show e-					then do-						threadDelay 1000 -- 1/1000th second-						settle conn-					else throwIO e-	-	-- This should succeed for any table.-	nullselect = T.pack $ "SELECT null from " ++ tablename ++ " limit 1"+	return $ DbHandle worker jobs +{- This is optional; when the DbHandle gets garbage collected it will+ - auto-close. -}+closeDb :: DbHandle -> IO ()+closeDb (DbHandle worker jobs) = do+	putMVar jobs CloseJob+	wait worker+ {- Makes a query using the DbHandle. This should not be used to make  - changes to the database!  -@@ -133,71 +91,21 @@  - it is able to run.  -} queryDb :: DbHandle -> SqlPersistM a -> IO a-queryDb (DbHandle _ jobs _) a = do+queryDb (DbHandle _ jobs) a = do 	res <- newEmptyMVar 	putMVar jobs $ QueryJob $ 		liftIO . putMVar res =<< tryNonAsync a 	(either throwIO return =<< takeMVar res) 		`catchNonAsync` (const $ error "sqlite query crashed") -closeDb :: DbHandle -> IO ()-closeDb h@(DbHandle worker jobs _) = do-	flushQueueDb h-	putMVar jobs CloseJob-	wait worker--type Size = Int--type LastCommitTime = UTCTime--{- A queue of actions to perform, with a count of the number of actions- - queued, and a last commit time. -}-data DbQueue = DbQueue Size LastCommitTime (SqlPersistM ())--emptyDbQueue :: IO DbQueue-emptyDbQueue = do-	now <- getCurrentTime-	return $ DbQueue 0 now (return ())--{- Queues a change to be made to the database. It will be buffered- - to be committed later, unless the commitchecker action returns true.- -- - (Be sure to call closeDb or flushQueueDb to ensure the change- - gets committed.)+{- Writes a change to the database.  -- - Transactions built up by queueDb are sent to sqlite all at once.- - If sqlite fails due to another change being made concurrently by another- - process, the transaction is put back in the queue. This solves- - the sqlite multiple writer problem.+ - If a database is opened multiple times and there's a concurrent writer,+ - the write could fail. Retries repeatedly for up to 10 seconds, + - which should avoid all but the most exceptional problems.  -}-queueDb -	:: DbHandle-	-> (Size -> LastCommitTime -> IO Bool) -	-> SqlPersistM ()-	-> IO ()-queueDb h@(DbHandle _ _ qvar) commitchecker a = do-	DbQueue sz lastcommittime qa <- takeMVar qvar-	let !sz' = sz + 1-	let qa' = qa >> a-	let enqueue = putMVar qvar-	ifM (commitchecker sz' lastcommittime)-		( do-			r <- commitDb h qa'-			case r of-				Left _ -> enqueue $ DbQueue sz' lastcommittime qa'-				Right _ -> do-					now <- getCurrentTime-					enqueue $ DbQueue 0 now (return ())-		, enqueue $ DbQueue sz' lastcommittime qa'-		)--{- If flushing the queue fails, this could be because there is another- - writer to the database. Retry repeatedly for up to 10 seconds. -}-flushQueueDb :: DbHandle -> IO ()-flushQueueDb h@(DbHandle _ _ qvar) = do-	DbQueue sz _ qa <- takeMVar qvar	-	when (sz > 0) $-		robustly Nothing 100 (commitDb h qa)+commitDb :: DbHandle -> SqlPersistM () -> IO ()+commitDb h wa = robustly Nothing 100 (commitDb' h wa)   where 	robustly :: Maybe SomeException -> Int -> IO (Either SomeException ()) -> IO () 	robustly e 0 _ = error $ "failed to commit changes to sqlite database: " ++ show e@@ -209,9 +117,69 @@ 				threadDelay 100000 -- 1/10th second 				robustly (Just e) (n-1) a -commitDb :: DbHandle -> SqlPersistM () -> IO (Either SomeException ())-commitDb (DbHandle _ jobs _) a = do+commitDb' :: DbHandle -> SqlPersistM () -> IO (Either SomeException ())+commitDb' (DbHandle _ jobs) a = do 	res <- newEmptyMVar 	putMVar jobs $ ChangeJob $ \runner -> 		liftIO $ putMVar res =<< tryNonAsync (runner a) 	takeMVar res++data Job+	= QueryJob (SqlPersistM ())+	| ChangeJob ((SqlPersistM () -> IO ()) -> IO ())+	| CloseJob++workerThread :: T.Text -> TableName -> MVar Job -> IO ()+workerThread db tablename jobs =+	catchNonAsync (runSqliteRobustly tablename db loop) showerr+  where+  	showerr e = hPutStrLn stderr $+		"sqlite worker thread crashed: " ++ show e+	+	getjob :: IO (Either BlockedIndefinitelyOnMVar Job)+	getjob = try $ takeMVar jobs++	loop = do+		job <- liftIO getjob+		case job of+			-- Exception is thrown when the MVar is garbage+			-- collected, which means the whole DbHandle+			-- is not used any longer. Shutdown cleanly.+			Left BlockedIndefinitelyOnMVar -> return ()+			Right CloseJob -> return ()+			Right (QueryJob a) -> a >> loop+			-- change is run in a separate database connection+			-- since sqlite only supports a single writer at a+			-- time, and it may crash the database connection+			Right (ChangeJob a) -> liftIO (a (runSqliteRobustly tablename db)) >> loop+	+-- like runSqlite, but calls settle on the raw sql Connection.+runSqliteRobustly :: TableName -> T.Text -> (SqlPersistM a) -> IO a+runSqliteRobustly tablename db a = do+	conn <- Sqlite.open db+	settle conn+	runResourceT $ runNoLoggingT $+		withSqlConn (wrapConnection conn) $+			runSqlConn a+  where+	-- Work around a bug in sqlite: New database connections can+	-- sometimes take a while to become usable; select statements will+	-- fail with ErrorBusy for some time. So, loop until a select+	-- succeeds; once one succeeds the connection will stay usable.+	-- <http://thread.gmane.org/gmane.comp.db.sqlite.general/93116>+	settle conn = do+		r <- tryNonAsync $ do+			stmt <- Sqlite.prepare conn nullselect+			void $ Sqlite.step stmt+			void $ Sqlite.finalize stmt+		case r of+			Right _ -> return ()+			Left e -> do+				if "ErrorBusy" `isInfixOf` show e+					then do+						threadDelay 1000 -- 1/1000th second+						settle conn+					else throwIO e+	+	-- This should succeed for any table.+	nullselect = T.pack $ "SELECT null from " ++ tablename ++ " limit 1"
+ Database/Keys.hs view
@@ -0,0 +1,188 @@+{- Sqlite database of information about Keys+ -+ - Copyright 2015-2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE ScopedTypeVariables #-}++module Database.Keys (+	DbHandle,+	addAssociatedFile,+	getAssociatedFiles,+	getAssociatedKey,+	removeAssociatedFile,+	scanAssociatedFiles,+	storeInodeCaches,+	addInodeCaches,+	getInodeCaches,+	removeInodeCaches,+) where++import qualified Database.Keys.SQL as SQL+import Database.Types+import Database.Keys.Handle+import qualified Database.Queue as H+import Locations+import Common.Annex hiding (delete)+import qualified Annex+import Annex.Perms+import Annex.LockFile+import Utility.InodeCache+import Annex.InodeSentinal+import qualified Git.Types+import qualified Git.LsTree+import qualified Git.Branch+import Git.Ref+import Git.FilePath+import Annex.CatFile++import Database.Esqueleto hiding (Key)++{- Runs an action that reads from the database.+ -+ - If the database doesn't already exist, it's not created; mempty is+ - returned instead. This way, when the keys database is not in use,+ - there's minimal overhead in checking it.+ -+ - If the database is already open, any writes are flushed to it, to ensure+ - consistency.+ -+ - Any queued writes will be flushed before the read.+ -}+runReader :: Monoid v => (SQL.ReadHandle -> Annex v) -> Annex v+runReader a = do+	h <- getDbHandle+	withDbState h go+  where+	go DbEmpty = return (mempty, DbEmpty)+	go st@(DbOpen qh) = do+		liftIO $ H.flushDbQueue qh+		v <- a (SQL.ReadHandle qh)+		return (v, st)+	go DbClosed = do+		st' <- openDb False DbClosed+		v <- case st' of+			(DbOpen qh) -> a (SQL.ReadHandle qh)+			_ -> return mempty+		return (v, st')++runReaderIO :: Monoid v => (SQL.ReadHandle -> IO v) -> Annex v+runReaderIO a = runReader (liftIO . a)++{- Runs an action that writes to the database. Typically this is used to+ - queue changes, which will be flushed at a later point.+ -+ - The database is created if it doesn't exist yet. -}+runWriter :: (SQL.WriteHandle -> Annex ()) -> Annex ()+runWriter a = do+	h <- getDbHandle+	withDbState h go+  where+	go st@(DbOpen qh) = do+		v <- a (SQL.WriteHandle qh)+		return (v, st)+	go st = do+		st' <- openDb True st+		v <- case st' of+			DbOpen qh -> a (SQL.WriteHandle qh)+			_ -> error "internal"+		return (v, st')++runWriterIO :: (SQL.WriteHandle -> IO ()) -> Annex ()+runWriterIO a = runWriter (liftIO . a)++{- Gets the handle cached in Annex state; creates a new one if it's not yet+ - available, but doesn't open the database. -}+getDbHandle :: Annex DbHandle+getDbHandle = go =<< Annex.getState Annex.keysdbhandle+  where+	go (Just h) = pure h+	go Nothing = do+		h <- liftIO newDbHandle+		Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }+		return h++{- Opens the database, perhaps creating it if it doesn't exist yet.+ -+ - Multiple readers and writers can have the database open at the same+ - time. Database.Handle deals with the concurrency issues.+ - The lock is held while opening the database, so that when+ - the database doesn't exist yet, one caller wins the lock and+ - can create it undisturbed.+ -}+openDb :: Bool -> DbState -> Annex DbState+openDb _ st@(DbOpen _) = return st+openDb False DbEmpty = return DbEmpty+openDb createdb _ = withExclusiveLock gitAnnexKeysDbLock $ do+	dbdir <- fromRepo gitAnnexKeysDb+	let db = dbdir </> "db"+	dbexists <- liftIO $ doesFileExist db+	case (dbexists, createdb) of+		(True, _) -> open db+		(False, True) -> do+			liftIO $ do+				createDirectoryIfMissing True dbdir+				H.initDb db SQL.createTables+			setAnnexDirPerm dbdir+			setAnnexFilePerm db+			open db+		(False, False) -> return DbEmpty+  where+	open db = liftIO $ DbOpen <$> H.openDbQueue db SQL.containedTable++addAssociatedFile :: Key -> TopFilePath -> Annex ()+addAssociatedFile k f = runWriterIO $ SQL.addAssociatedFile (toIKey k) f++{- Note that the files returned were once associated with the key, but+ - some of them may not be any longer. -}+getAssociatedFiles :: Key -> Annex [TopFilePath]+getAssociatedFiles = runReaderIO . SQL.getAssociatedFiles . toIKey++{- Gets any keys that are on record as having a particular associated file.+ - (Should be one or none but the database doesn't enforce that.) -}+getAssociatedKey :: TopFilePath -> Annex [Key]+getAssociatedKey = map fromIKey <$$> runReaderIO . SQL.getAssociatedKey++removeAssociatedFile :: Key -> TopFilePath -> Annex ()+removeAssociatedFile k = runWriterIO . SQL.removeAssociatedFile (toIKey k)++{- Find all unlocked associated files. This is expensive, and so normally+ - the associated files are updated incrementally when changes are noticed. -}+scanAssociatedFiles :: Annex ()+scanAssociatedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ +	runWriter $ \h -> do+		showSideAction "scanning for unlocked files"+		dropallassociated h+		(l, cleanup) <- inRepo $ Git.LsTree.lsTree headRef+		forM_ l $ \i -> +			when (isregfile i) $+				maybe noop (add h i)+					=<< catKey (Git.LsTree.sha i)+		liftIO $ void cleanup+  where+	dropallassociated h = liftIO $ flip SQL.queueDb h $+		delete $ from $ \(_r :: SqlExpr (Entity SQL.Associated)) ->+			return ()+	isregfile i = Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.FileBlob+	add h i k = liftIO $ flip SQL.queueDb h $ +		void $ insertUnique $ SQL.Associated+			(toIKey k)+			(getTopFilePath $ Git.LsTree.file i)++{- Stats the files, and stores their InodeCaches. -}+storeInodeCaches :: Key -> [FilePath] -> Annex ()+storeInodeCaches k fs = withTSDelta $ \d ->+	addInodeCaches k . catMaybes =<< liftIO (mapM (`genInodeCache` d) fs)++addInodeCaches :: Key -> [InodeCache] -> Annex ()+addInodeCaches k is = runWriterIO $ SQL.addInodeCaches (toIKey k) is++{- A key may have multiple InodeCaches; one for the annex object, and one+ - for each pointer file that is a copy of it. -}+getInodeCaches :: Key -> Annex [InodeCache]+getInodeCaches = runReaderIO . SQL.getInodeCaches . toIKey++removeInodeCaches :: Key -> Annex ()+removeInodeCaches = runWriterIO . SQL.removeInodeCaches . toIKey
+ Database/Keys/Handle.hs view
@@ -0,0 +1,57 @@+{- Handle for the Keys database.+ -+ - Copyright 2015 Joey Hess <id@joeyh.name>+ -:+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Database.Keys.Handle (+	DbHandle,+	newDbHandle,+	DbState(..),+	withDbState,+	flushDbQueue,+) where++import qualified Database.Queue as H+import Utility.Exception++import Control.Concurrent+import Control.Monad.IO.Class (liftIO, MonadIO)+import Control.Applicative+import Prelude++-- The MVar is always left full except when actions are run+-- that access the database.+newtype DbHandle = DbHandle (MVar DbState)++-- The database can be closed or open, but it also may have been+-- tried to open (for read) and didn't exist yet.+data DbState = DbClosed | DbOpen H.DbQueue | DbEmpty++newDbHandle :: IO DbHandle+newDbHandle = DbHandle <$> newMVar DbClosed++-- Runs an action on the state of the handle, which can change its state.+-- The MVar is empty while the action runs, which blocks other users+-- of the handle from running.+withDbState+	:: (MonadIO m, MonadCatch m)+	=> DbHandle+	-> (DbState+	-> m (v, DbState))+	-> m v+withDbState (DbHandle mvar) a = do+	st <- liftIO $ takeMVar mvar+	go st `onException` (liftIO $ putMVar mvar st)+  where+	go st = do+		(v, st') <- a st+		liftIO $ putMVar mvar st'+		return v++flushDbQueue :: DbHandle -> IO ()+flushDbQueue (DbHandle mvar) = go =<< readMVar mvar+  where+	go (DbOpen qh) = H.flushDbQueue qh+	go _ = return ()
+ Database/Keys/SQL.hs view
@@ -0,0 +1,108 @@+{- Sqlite database of information about Keys+ -+ - Copyright 2015-2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}++module Database.Keys.SQL where++import Database.Types+import Database.Handle+import qualified Database.Queue as H+import Utility.InodeCache+import Git.FilePath++import Database.Persist.TH+import Database.Esqueleto hiding (Key)+import Data.Time.Clock+import Control.Monad++share [mkPersist sqlSettings, mkMigrate "migrateKeysDb"] [persistLowerCase|+Associated+  key IKey+  file FilePath+  KeyFileIndex key file+  FileKeyIndex file key+Content+  key IKey+  cache SInodeCache+  KeyCacheIndex key cache+|]++containedTable :: TableName+containedTable = "content"++createTables :: SqlPersistM ()+createTables = void $ runMigrationSilent migrateKeysDb++newtype ReadHandle = ReadHandle H.DbQueue++readDb :: SqlPersistM a -> ReadHandle -> IO a+readDb a (ReadHandle h) = H.queryDbQueue h a++newtype WriteHandle = WriteHandle H.DbQueue++queueDb :: SqlPersistM () -> WriteHandle -> IO ()+queueDb a (WriteHandle h) = H.queueDb h checkcommit a+  where+	-- commit queue after 1000 changes or 5 minutes, whichever comes first+	checkcommit sz lastcommittime+		| sz > 1000 = return True+		| otherwise = do+			now <- getCurrentTime+			return $ diffUTCTime lastcommittime now > 300++addAssociatedFile :: IKey -> TopFilePath -> WriteHandle -> IO ()+addAssociatedFile ik f = queueDb $ do+	-- If the same file was associated with a different key before,+	-- remove that.+	delete $ from $ \r -> do+		where_ (r ^. AssociatedFile ==. val (getTopFilePath f) &&. not_ (r ^. AssociatedKey ==. val ik))+	void $ insertUnique $ Associated ik (getTopFilePath f)++{- Note that the files returned were once associated with the key, but+ - some of them may not be any longer. -}+getAssociatedFiles :: IKey -> ReadHandle -> IO [TopFilePath]+getAssociatedFiles ik = readDb $ do+	l <- select $ from $ \r -> do+		where_ (r ^. AssociatedKey ==. val ik)+		return (r ^. AssociatedFile)+	return $ map (asTopFilePath . unValue) l++{- Gets any keys that are on record as having a particular associated file.+ - (Should be one or none but the database doesn't enforce that.) -}+getAssociatedKey :: TopFilePath -> ReadHandle -> IO [IKey]+getAssociatedKey f = readDb $ do+	l <- select $ from $ \r -> do+		where_ (r ^. AssociatedFile ==. val (getTopFilePath f))+		return (r ^. AssociatedKey)+	return $ map unValue l++removeAssociatedFile :: IKey -> TopFilePath -> WriteHandle -> IO ()+removeAssociatedFile ik f = queueDb $ +	delete $ from $ \r -> do+		where_ (r ^. AssociatedKey ==. val ik &&. r ^. AssociatedFile ==. val (getTopFilePath f))++addInodeCaches :: IKey -> [InodeCache] -> WriteHandle -> IO ()+addInodeCaches ik is = queueDb $+	forM_ is $ \i -> insertUnique $ Content ik (toSInodeCache i)++{- A key may have multiple InodeCaches; one for the annex object, and one+ - for each pointer file that is a copy of it. -}+getInodeCaches :: IKey -> ReadHandle -> IO [InodeCache]+getInodeCaches ik = readDb $ do+	l <- select $ from $ \r -> do+		where_ (r ^. ContentKey ==. val ik)+		return (r ^. ContentCache)+	return $ map (fromSInodeCache . unValue) l++removeInodeCaches :: IKey -> WriteHandle -> IO ()+removeInodeCaches ik = queueDb $ +	delete $ from $ \r -> do+		where_ (r ^. ContentKey ==. val ik)
+ Database/Queue.hs view
@@ -0,0 +1,109 @@+{- Persistent sqlite database queues+ -+ - Copyright 2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE BangPatterns #-}++module Database.Queue (+	DbQueue,+	initDb,+	openDbQueue,+	queryDbQueue,+	closeDbQueue,+	flushDbQueue,+	QueueSize,+	queueDb,+) where++import Utility.Monad+import Database.Handle++import Database.Persist.Sqlite+import Control.Concurrent+import Data.Time.Clock+import Control.Applicative+import Prelude++{- A DbQueue wraps a DbHandle, adding a queue of writes to perform.+ -+ - This is efficient when there are frequent writes, but+ - reads will not immediately have access to queued writes. -}+data DbQueue = DQ DbHandle (MVar Queue)++{- Opens the database queue, but does not perform any migrations. Only use+ - if the database is known to exist and have the right tables; ie after+ - running initDb. -}+openDbQueue :: FilePath -> TableName -> IO DbQueue+openDbQueue db tablename = DQ+	<$> openDb db tablename+	<*> (newMVar =<< emptyQueue)++{- This or flushDbQueue must be called, eg at program exit to ensure+ - queued changes get written to the database. -}+closeDbQueue :: DbQueue -> IO ()+closeDbQueue h@(DQ hdl _) = do+	flushDbQueue h+	closeDb hdl++{- Blocks until all queued changes have been written to the database. -}+flushDbQueue :: DbQueue -> IO ()+flushDbQueue (DQ hdl qvar) = do+	q@(Queue sz _ qa) <- takeMVar qvar+	if sz > 0+		then do+			commitDb hdl qa+			putMVar qvar =<< emptyQueue+		else putMVar qvar q++{- Makes a query using the DbQueue's database connection.+ - This should not be used to make changes to the database!+ -+ - Queries will not return changes that have been recently queued,+ - so use with care.+ -}+queryDbQueue :: DbQueue -> SqlPersistM a -> IO a+queryDbQueue (DQ hdl _) = queryDb hdl++{- A queue of actions to perform, with a count of the number of actions+ - queued, and a last commit time. -}+data Queue = Queue QueueSize LastCommitTime (SqlPersistM ())++type QueueSize = Int++type LastCommitTime = UTCTime++emptyQueue :: IO Queue+emptyQueue = do+	now <- getCurrentTime+	return $ Queue 0 now (return ())++{- Queues a change to be made to the database. It will be queued+ - to be committed later, unless the commitchecker action returns true,+ - in which case any previously queued changes are also committed.+ -+ - Transactions built up by queueDb are sent to sqlite all at once.+ - If sqlite fails due to another change being made concurrently by another+ - process, the transaction is put back in the queue. This avoids+ - the sqlite multiple writer problem.+ -}+queueDb +	:: DbQueue+	-> (QueueSize -> LastCommitTime -> IO Bool) +	-> SqlPersistM ()+	-> IO ()+queueDb (DQ hdl qvar) commitchecker a = do+	Queue sz lastcommittime qa <- takeMVar qvar+	let !sz' = sz + 1+	let qa' = qa >> a+	let enqueue = putMVar qvar+	ifM (commitchecker sz' lastcommittime)+		( do+			r <- commitDb' hdl qa'+			case r of+				Left _ -> enqueue $ Queue sz' lastcommittime qa'+				Right _ -> enqueue =<< emptyQueue+		, enqueue $ Queue sz' lastcommittime qa'+		)
Database/Types.hs view
@@ -13,6 +13,7 @@ import Data.Maybe  import Types.Key+import Utility.InodeCache  -- A serialized Key newtype SKey = SKey String@@ -22,6 +23,36 @@ toSKey = SKey . key2file  fromSKey :: SKey -> Key-fromSKey (SKey s) = fromMaybe (error $ "bad serialied key " ++ s) (file2key s)+fromSKey (SKey s) = fromMaybe (error $ "bad serialied Key " ++ s) (file2key s)  derivePersistField "SKey"++-- A Key index. More efficient than SKey, but its Read instance does not+-- work when it's used in any kind of complex data structure.+newtype IKey = IKey String++instance Read IKey where+	readsPrec _ s = [(IKey s, "")]++instance Show IKey where+	show (IKey s) = s++toIKey :: Key -> IKey+toIKey = IKey . key2file++fromIKey :: IKey -> Key+fromIKey (IKey s) = fromMaybe (error $ "bad serialied Key " ++ s) (file2key s)++derivePersistField "IKey"++-- A serialized InodeCache+newtype SInodeCache = I String+	deriving (Show, Read)++toSInodeCache :: InodeCache -> SInodeCache+toSInodeCache = I . showInodeCache++fromSInodeCache :: SInodeCache -> InodeCache+fromSInodeCache (I s) = fromMaybe (error $ "bad serialied InodeCache " ++ s) (readInodeCache s)++derivePersistField "SInodeCache"
Git.hs view
@@ -28,6 +28,7 @@ 	repoPath, 	localGitDir, 	attributes,+	attributesLocal, 	hookPath, 	assertLocal, 	adjustPath,@@ -125,8 +126,11 @@ {- Path to a repository's gitattributes file. -} attributes :: Repo -> FilePath attributes repo-	| repoIsLocalBare repo = repoPath repo ++ "/info/.gitattributes"-	| otherwise = repoPath repo ++ "/.gitattributes"+	| repoIsLocalBare repo = attributesLocal repo+	| otherwise = repoPath repo </> ".gitattributes"++attributesLocal :: Repo -> FilePath+attributesLocal repo = localGitDir repo </> "info" </> "attributes"  {- Path to a given hook script in a repository, only if the hook exists  - and is executable. -}
Git/CatFile.hs view
@@ -104,7 +104,6 @@ 				(dropsha rest)  	-- these 20 bytes after the NUL hold the file's sha-	-- TODO: convert from raw form to regular sha 	dropsha = L.drop 21  	parsemodefile b =
Git/DiffTree.hs view
@@ -12,6 +12,7 @@ 	diffTreeRecursive, 	diffIndex, 	diffWorkTree,+	diffFiles, 	diffLog, ) where @@ -65,6 +66,10 @@ 			repo 		, return ([], return True) 		)++{- Diff between the index and work tree. -}+diffFiles :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)+diffFiles = getdiff (Param "diff-files")  {- Runs git log in --raw mode to get the changes that were made in  - a particular commit. The output format is adjusted to be the same
Git/FilePath.hs view
@@ -14,8 +14,8 @@  module Git.FilePath ( 	TopFilePath,-	fromTopFilePath, 	getTopFilePath,+	fromTopFilePath, 	toTopFilePath, 	asTopFilePath, 	InternalGitPath,@@ -33,9 +33,9 @@ newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath } 	deriving (Show) -{- Returns an absolute FilePath. -}+{- Path to a TopFilePath, within the provided git repo. -} fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath-fromTopFilePath p repo = absPathFrom (repoPath repo) (getTopFilePath p)+fromTopFilePath p repo = combine (repoPath repo) (getTopFilePath p)  {- The input FilePath can be absolute, or relative to the CWD. -} toTopFilePath :: FilePath -> Git.Repo -> IO TopFilePath
Git/LsTree.hs view
@@ -1,6 +1,6 @@ {- git ls-tree interface  -- - Copyright 2011 Joey Hess <id@joeyh.name>+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -26,15 +26,16 @@ data TreeItem = TreeItem 	{ mode :: FileMode 	, typeobj :: String-	, sha :: String+	, sha :: Ref 	, file :: TopFilePath 	} deriving Show  {- Lists the complete contents of a tree, recursing into sub-trees,  - with lazy output. -}-lsTree :: Ref -> Repo -> IO [TreeItem]-lsTree t repo = map parseLsTree-	<$> pipeNullSplitZombie (lsTreeParams t []) repo+lsTree :: Ref -> Repo -> IO ([TreeItem], IO Bool)+lsTree t repo = do+	(l, cleanup) <- pipeNullSplit (lsTreeParams t []) repo+	return (map parseLsTree l, cleanup)  lsTreeParams :: Ref -> [CommandParam] -> [CommandParam] lsTreeParams r ps =@@ -65,7 +66,7 @@ parseLsTree l = TreeItem  	{ mode = fst $ Prelude.head $ readOct m 	, typeobj = t-	, sha = s+	, sha = Ref s 	, file = asTopFilePath $ Git.Filename.decode f 	}   where
Git/Queue.hs view
@@ -137,7 +137,7 @@  {- Is a queue large enough that it should be flushed? -} full :: Queue -> Bool-full (Queue cur lim  _) = cur > lim+full (Queue cur lim  _) = cur >= lim  {- Runs a queue on a git repository. -} flush :: Queue -> Repo -> IO Queue
Git/Repair.hs view
@@ -342,8 +342,8 @@ 	| S.member treesha missing = return False 	| otherwise = do 		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams treesha []) r-		let objshas = map (extractSha . LsTree.sha . LsTree.parseLsTree) ls-		if any isNothing objshas || any (`S.member` missing) (catMaybes objshas)+		let objshas = map (LsTree.sha . LsTree.parseLsTree) ls+		if any (`S.member` missing) objshas 			then do 				void cleanup 				return False
INSTALL view
@@ -20,8 +20,6 @@ [[Windows]]                       | [download installer](https://downloads.kitenet.net/git-annex/windows/current/) **beta** """]] -Note: [[todo/git-annex_in_debian_sid]] is somewhat outdated, which makes the above Debian and Ubuntu release not quite up to date. The [NeuroDebian team](http://neuro.debian.net/) provides a [standalone build package](http://neuro.debian.net/pkgs/git-annex-standalone.html) that is regularly updated and that should work across all releases of Ubuntu and Debian. See [[todo/git-annex-standalone_Debian_package/]] for more information.- All the download links above use https for security. For added security, see [[verifying_downloads]].
Limit.hs view
@@ -11,8 +11,8 @@ import qualified Annex import qualified Utility.Matcher import qualified Remote-import qualified Backend import Annex.Content+import Annex.WorkTree import Annex.Action import Annex.UUID import Logs.Trust@@ -201,22 +201,22 @@ {- Adds a limit to skip files not believed to be present in all  - repositories in the specified group. -} addInAllGroup :: String -> Annex ()-addInAllGroup groupname = do-	m <- groupMap-	addLimit $ limitInAllGroup m groupname+addInAllGroup groupname = addLimit $ limitInAllGroup groupMap groupname -limitInAllGroup :: GroupMap -> MkLimit Annex-limitInAllGroup m groupname-	| S.null want = Right $ const $ const $ return True-	| otherwise = Right $ \notpresent -> checkKey $ check notpresent-  where-	want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m-	check notpresent key+limitInAllGroup :: Annex GroupMap -> MkLimit Annex+limitInAllGroup getgroupmap groupname = Right $ \notpresent mi -> do+	m <- getgroupmap+	let want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m+	if S.null want+		then return True 		-- optimisation: Check if a wanted uuid is notpresent.-		| not (S.null (S.intersection want notpresent))	= return False-		| otherwise = do-			present <- S.fromList <$> Remote.keyLocations key-			return $ S.null $ want `S.difference` present+		else if not (S.null (S.intersection want notpresent))+			then return False+			else checkKey (check want) mi+  where+	check want key = do+		present <- S.fromList <$> Remote.keyLocations key+		return $ S.null $ want `S.difference` present  {- Adds a limit to skip files not using a specified key-value backend. -} addInBackend :: String -> Annex ()@@ -277,7 +277,7 @@ 			else return True  lookupFileKey :: FileInfo -> Annex (Maybe Key)-lookupFileKey = Backend.lookupFile . currFile+lookupFileKey = lookupFile . currFile  checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a
Locations.hs view
@@ -29,6 +29,8 @@ 	gitAnnexBadDir, 	gitAnnexBadLocation, 	gitAnnexUnusedLog,+	gitAnnexKeysDb,+	gitAnnexKeysDbLock, 	gitAnnexFsckState, 	gitAnnexFsckDbDir, 	gitAnnexFsckDbLock,@@ -236,6 +238,14 @@ {- .git/annex/foounused is used to number possibly unused keys -} gitAnnexUnusedLog :: FilePath -> Git.Repo -> FilePath gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")++{- .git/annex/keys/ contains a database of information about keys. -}+gitAnnexKeysDb :: Git.Repo -> FilePath+gitAnnexKeysDb r = gitAnnexDir r </> "keys"++{- Lock file for the keys database. -}+gitAnnexKeysDbLock :: Git.Repo -> FilePath+gitAnnexKeysDbLock r = gitAnnexKeysDb r ++ ".lck"  {- .git/annex/fsck/uuid/ is used to store information about incremental  - fscks. -}
Logs/PreferredContent.hs view
@@ -102,7 +102,7 @@ 		| null (lefts tokens) = generate $ rights tokens 		| otherwise = unknownMatcher u 	  where-		tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr+		tokens = exprParser matchstandard matchgroupwanted (pure groupmap) configmap (Just u) expr 		matchstandard 			| expandstandard = maybe (unknownMatcher u) (go False False) 				(standardPreferredContent <$> getStandardGroup mygroups)@@ -133,7 +133,7 @@ 	Left e -> Just e 	Right _ -> Nothing   where-	tokens = exprParser matchAll matchAll emptyGroupMap M.empty Nothing expr+	tokens = exprParser matchAll matchAll (pure emptyGroupMap) M.empty Nothing expr  {- Puts a UUID in a standard group, and sets its preferred content to use  - the standard expression for that group (unless preferred content is
Makefile view
@@ -1,7 +1,8 @@ mans=$(shell find doc -maxdepth 1 -name git-annex*.mdwn | sed -e 's/^doc/man/' -e 's/\.mdwn/\.1/') all=git-annex mans docs -CABAL?=cabal # set to "./Setup" if you lack a cabal program+# set to "./Setup" if you lack a cabal program. Or can be set to "stack"+BUILDER?=cabal GHC?=ghc  PREFIX?=/usr@@ -15,13 +16,21 @@ build: $(all)  Build/SysConfig.hs: configure.hs Build/TestConfig.hs Build/Configure.hs-	if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi-	$(CABAL) configure --ghc-options="$(shell Build/collect-ghc-options.sh)"+	if [ "$(BUILDER)" = ./Setup ]; then ghc --make Setup; fi+	if [ "$(BUILDER)" = stack ]; then \+		$(BUILDER) build -j1; \+	else \+		$(BUILDER) configure --ghc-options="$(shell Build/collect-ghc-options.sh)"; \+	fi  # -j1 is used for reproducible build git-annex: Build/SysConfig.hs-	$(CABAL) build -j1-	ln -sf dist/build/git-annex/git-annex git-annex+	$(BUILDER) build -j1+	if [ "$(BUILDER)" = stack ]; then \+		ln -sf $$(find .stack-work/ -name git-annex -type f | grep build/git-annex/git-annex | tail -n 1) git-annex; \+	else \+		ln -sf dist/build/git-annex/git-annex git-annex; \+	fi  man/%.1: doc/%.mdwn 	./Build/mdwn2man $@ 1 $< > $@@@ -89,6 +98,7 @@ 		--exclude='users/*' --exclude='devblog/*' --exclude='thanks'  clean:+	$(BUILDER) clean 	rm -rf tmp dist git-annex $(mans) configure  *.tix .hpc \ 		doc/.ikiwiki html dist tags Build/SysConfig.hs \ 		Setup Build/InstallDesktopFile Build/EvilSplicer \@@ -206,9 +216,9 @@ # Uses https://github.com/neurocyte/ghc-android android: Build/EvilSplicer 	echo "Running native build, to get TH splices.."-	if [ ! -e dist/setup/setup ]; then $(CABAL) configure -O0 $(ANDROID_FLAGS) -fAndroidSplice;  fi+	if [ ! -e dist/setup/setup ]; then $(BUILDER) configure -O0 $(ANDROID_FLAGS) -fAndroidSplice;  fi 	mkdir -p tmp-	if ! $(CABAL) build --ghc-options=-ddump-splices 2> tmp/dump-splices; then tail tmp/dump-splices >&2; exit 1; fi+	if ! $(BUILDER) build --ghc-options=-ddump-splices 2> tmp/dump-splices; then tail tmp/dump-splices >&2; exit 1; fi 	echo "Setting up Android build tree.." 	./Build/EvilSplicer tmp/splices tmp/dump-splices standalone/no-th/evilsplicer-headers.hs 	rsync -az --exclude tmp --exclude dist . tmp/androidtree@@ -250,8 +260,8 @@ 	@$(MAKE) tags >/dev/null 2>&1 &  dist/caballog: git-annex.cabal-	$(CABAL) configure -f"-Production" -O0 --enable-executable-dynamic-	$(CABAL) build -v2 | tee $@+	$(BUILDER) configure -f"-Production" -O0 --enable-executable-dynamic+	$(BUILDER) build -v2 | tee $@  # Hardcoded command line to make hdevtools start up and work. # You will need some memory. It's worth it.
Messages.hs view
@@ -31,11 +31,11 @@ 	showHeader, 	showRaw, 	setupConsole,-	setConsoleEncoding, 	enableDebugOutput, 	disableDebugOutput, 	debugEnabled, 	commandProgressDisabled,+	outputMessage, ) where  import Text.JSON@@ -182,13 +182,6 @@ 		<*> pure preciseLogFormatter 	updateGlobalLogger rootLoggerName (setLevel NOTICE . setHandlers [s]) 	setConsoleEncoding--{- This avoids ghc's output layer crashing on invalid encoded characters in- - filenames when printing them out. -}-setConsoleEncoding :: IO ()-setConsoleEncoding = do-	fileEncoding stdout-	fileEncoding stderr  {- Log formatter with precision into fractions of a second. -} preciseLogFormatter :: LogFormatter a
Remote/Git.hs view
@@ -1,6 +1,6 @@ {- Standard git remotes.  -- - Copyright 2011-2012 Joey Hess <id@joeyh.name>+ - Copyright 2011-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -35,6 +35,7 @@ import Config import Config.Cost import Annex.Init+import Annex.Version import Types.Key import Types.CleanupActions import qualified CmdLine.GitAnnexShell.Fields as Fields@@ -442,9 +443,8 @@ 						file noRetry noObserver  						(\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess) 	| Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \p -> do-		direct <- isDirect 		Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p))-			=<< Ssh.rsyncParamsRemote direct r Download key dest file+			=<< Ssh.rsyncParamsRemote False r Download key dest file 	| Git.repoIsHttp (repo r) = unVerified $ 		Annex.Content.downloadUrl key meterupdate (keyUrls r key) dest 	| otherwise = error "copying from non-ssh, non-http remote not supported"@@ -545,15 +545,18 @@ 			copylocal =<< Annex.Content.prepSendAnnex key 	| Git.repoIsSsh (repo r) = commitOnCleanup r $ 		Annex.Content.sendAnnex key noop $ \object -> do-			direct <- isDirect+			-- This is too broad really, but recvkey normally+			-- verifies content anyway, so avoid complicating+			-- it with a local sendAnnex check and rollback.+			unlocked <- isDirect <||> versionSupportsUnlockedPointers 			Ssh.rsyncHelper (Just meterupdate)-				=<< Ssh.rsyncParamsRemote direct r Upload key object file+				=<< Ssh.rsyncParamsRemote unlocked r Upload key object file 	| otherwise = error "copying to non-ssh repo not supported"   where 	copylocal Nothing = return False 	copylocal (Just (object, checksuccess)) = do 		-- The checksuccess action is going to be run in-		-- the remote's Annex, but it needs access to the current+		-- the remote's Annex, but it needs access to the local 		-- Annex monad's state. 		checksuccessio <- Annex.withCurrentState checksuccess 		params <- Ssh.rsyncParams r Upload@@ -669,10 +672,15 @@ 						toCommand shellparams  wantHardLink :: Annex Bool-wantHardLink = (annexHardLink <$> Annex.getGitConfig) <&&> (not <$> isDirect)+wantHardLink = (annexHardLink <$> Annex.getGitConfig)+	-- Not direct mode files because they can be modified at any time.+	<&&> (not <$> isDirect)+	-- Not unlocked files that are hard linked in the work tree,+	-- because they can be modified at any time.+	<&&> (not <$> annexThin <$> Annex.getGitConfig)  -- Copies from src to dest, updating a meter. If the copy finishes--- successfully, calls a final check action, which must also success, or+-- successfully, calls a final check action, which must also succeed, or -- returns false. -- -- If either the remote or local repository wants to use hard links,
Remote/Helper/Ssh.hs view
@@ -126,10 +126,13 @@ {- Generates rsync parameters that ssh to the remote and asks it  - to either receive or send the key's content. -} rsyncParamsRemote :: Bool -> Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]-rsyncParamsRemote direct r direction key file afile = do+rsyncParamsRemote unlocked r direction key file afile = do 	u <- getUUID 	let fields = (Fields.remoteUUID, fromUUID u)-		: (Fields.direct, if direct then "1" else "")+		: (Fields.unlocked, if unlocked then "1" else "")+		-- Send direct field for unlocked content, for backwards+		-- compatability.+		: (Fields.direct, if unlocked then "1" else "") 		: maybe [] (\f -> [(Fields.associatedFile, f)]) afile 	Just (shellcmd, shellparams) <- git_annex_shell (repo r) 		(if direction == Download then "sendkey" else "recvkey")
Test.hs view
@@ -1,6 +1,6 @@ {- git-annex test suite  -- - Copyright 2010-2015 Joey Hess <id@joeyh.name>+ - Copyright 2010-2016 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -9,6 +9,7 @@  module Test where +import Types.Test import Options.Applicative.Types  #ifndef WITH_TESTSUITE@@ -24,11 +25,11 @@ #else  import Test.Tasty-import Test.Tasty.Options import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Test.Tasty.Ingredients.Rerun+import Options.Applicative (switch, long, help)  import qualified Data.Map as M import qualified Text.JSON@@ -38,6 +39,7 @@ import qualified Utility.SafeCommand import qualified Annex import qualified Annex.UUID+import qualified Annex.Version import qualified Backend import qualified Git.CurrentRepo import qualified Git.Filename@@ -65,6 +67,8 @@ import qualified Config import qualified Config.Cost import qualified Crypto+import qualified Annex.WorkTree+import qualified Annex.Link import qualified Annex.Init import qualified Annex.CatFile import qualified Annex.View@@ -96,11 +100,16 @@ import qualified Utility.Gpg #endif -optParser :: Parser OptionSet-optParser = suiteOptionParser ingredients tests+optParser :: Parser TestOptions+optParser = TestOptions+	<$> suiteOptionParser ingredients (tests mempty)+	<*> switch+		( long "keep-failures"+		<> help "preserve repositories on test failure"+		) -runner :: Maybe (OptionSet -> IO ())-runner = Just $ \opts -> case tryIngredients ingredients opts tests of+runner :: Maybe (TestOptions -> IO ())+runner = Just $ \opts -> case tryIngredients ingredients (tastyOptionSet opts) (tests opts) of 	Nothing -> error "No tests found!?" 	Just act -> ifM act 		( exitSuccess@@ -116,19 +125,19 @@ 	, rerunningTests [consoleTestReporter] 	] -tests :: TestTree-tests = testGroup "Tests"-	-- Test both direct and indirect mode.-	-- Windows is only going to use direct mode, so don't test twice.-	[ properties+tests :: TestOptions -> TestTree+tests opts = testGroup "Tests" $ properties :+	map (\(d, te) -> withTestMode te (unitTests d)) testmodes+  where+	testmodes =+		[ ("v6 unlocked", (testMode opts "6") { unlockedFiles = True })+		, ("v6 locked", testMode opts "6")+		, ("v5", testMode opts "5") #ifndef mingw32_HOST_OS-	, withTestEnv True $ unitTests "(direct)"-	, withTestEnv False $ unitTests "(indirect)"-#else-	, withTestEnv False $ unitTests ""+		-- Windows will only use direct mode, so don't test twice.+		, ("v5 direct", (testMode opts "5") { forceDirect = True }) #endif-	]-+		]  properties :: TestTree properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"@@ -164,6 +173,7 @@ 	, testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane 	, testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize 	, testProperty "prop_branchView_legal" Logs.View.prop_branchView_legal+	, testProperty "prop_viewPath_roundtrips" Annex.View.prop_viewPath_roundtrips 	, testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips 	, testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips 	, testProperty "prop_b64_roundtrips" Utility.Base64.prop_b64_roundtrips@@ -180,7 +190,7 @@  unitTests :: String -> TestTree unitTests note = testGroup ("Unit Tests " ++ note)-	[ testCase "add sha1dup" test_add_sha1dup+	[ testCase "add dup" test_add_dup 	, testCase "add extras" test_add_extras 	, testCase "shared clone" test_shared_clone 	, testCase "log" test_log@@ -224,6 +234,7 @@ 	, testCase "conflict resolution (removed file)" test_remove_conflict_resolution 	, testCase "conflict resolution (nonannexed file)" test_nonannexed_file_conflict_resolution 	, testCase "conflict resolution (nonannexed symlink)" test_nonannexed_symlink_conflict_resolution+	, testCase "conflict resolution (mixed locked and unlocked file)" test_mixed_lock_conflict_resolution 	, testCase "map" test_map 	, testCase "uninit" test_uninit 	, testCase "uninit (in git-annex branch)" test_uninit_inbranch@@ -242,8 +253,11 @@ -- this test case create the main repo test_init :: Assertion test_init = innewrepo $ do-	git_annex "init" [reponame] @? "init failed"-	handleforcedirect+	ver <- annexVersion <$> getTestMode+	if ver == Annex.Version.defaultVersion+		then git_annex "init" [reponame] @? "init failed"+		else git_annex "init" [reponame, "--version", ver] @? "init failed"+	setupTestMode   where 	reponame = "test repo" @@ -252,10 +266,12 @@ test_add :: Assertion test_add = inmainrepo $ do 	writeFile annexedfile $ content annexedfile-	git_annex "add" [annexedfile] @? "add failed"+	add_annex annexedfile @? "add failed" 	annexed_present annexedfile 	writeFile sha1annexedfile $ content sha1annexedfile 	git_annex "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed"+	whenM (unlockedFiles <$> getTestMode) $+		git_annex "unlock" [sha1annexedfile] @? "unlock failed" 	annexed_present sha1annexedfile 	checkbackend sha1annexedfile backendSHA1 	ifM (annexeval Config.isDirect)@@ -272,17 +288,19 @@ 			unannexed ingitfile 		) -test_add_sha1dup :: Assertion-test_add_sha1dup = intmpclonerepo $ do-	writeFile sha1annexedfiledup $ content sha1annexedfiledup-	git_annex "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed"-	annexed_present sha1annexedfiledup-	annexed_present sha1annexedfile+test_add_dup :: Assertion+test_add_dup = intmpclonerepo $ do+	writeFile annexedfiledup $ content annexedfiledup+	add_annex annexedfiledup @? "add of second file with same content failed"+	annexed_present annexedfiledup+	annexed_present annexedfile  test_add_extras :: Assertion test_add_extras = intmpclonerepo $ do 	writeFile wormannexedfile $ content wormannexedfile 	git_annex "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"+	whenM (unlockedFiles <$> getTestMode) $+		git_annex "unlock" [wormannexedfile] @? "unlock failed" 	annexed_present wormannexedfile 	checkbackend wormannexedfile backendWORM @@ -294,7 +312,6 @@ 		, "--get" 		, "annex.hardlink" 		]-	print v 	v == Just "true\n" 		@? "shared clone of repo did not get annex.hardlink set" @@ -306,12 +323,12 @@ test_import = intmpclonerepo $ Utility.Tmp.withTmpDir "importtest" $ \importdir -> do 	(toimport1, importf1, imported1) <- mktoimport importdir "import1" 	git_annex "import" [toimport1] @? "import failed"-	annexed_present imported1+	annexed_present_locked imported1 	checkdoesnotexist importf1  	(toimport2, importf2, imported2) <- mktoimport importdir "import2" 	git_annex "import" [toimport2] @? "import of duplicate failed"-	annexed_present imported2+	annexed_present_locked imported2 	checkdoesnotexist importf2  	(toimport3, importf3, imported3) <- mktoimport importdir "import3"@@ -331,11 +348,11 @@ 	 	(toimport5, importf5, imported5) <- mktoimport importdir "import5" 	git_annex "import" ["--duplicate", toimport5] @? "import --duplicate failed"-	annexed_present imported5+	annexed_present_locked imported5 	checkexists importf5 	 	git_annex "drop" ["--force", imported1, imported2, imported5] @? "drop failed"-	annexed_notpresent imported2+	annexed_notpresent_locked imported2 	(toimportdup, importfdup, importeddup) <- mktoimport importdir "importdup" 	git_annex "import" ["--clean-duplicates", toimportdup]  		@? "import of missing duplicate with --clean-duplicates failed"@@ -351,13 +368,13 @@ test_reinject :: Assertion test_reinject = intmpclonerepoInDirect $ do 	git_annex "drop" ["--force", sha1annexedfile] @? "drop failed"+	annexed_notpresent sha1annexedfile 	writeFile tmp $ content sha1annexedfile-	r <- annexeval $ Types.Backend.getKey backendSHA1-		Types.KeySource.KeySource { Types.KeySource.keyFilename = tmp, Types.KeySource.contentLocation = tmp, Types.KeySource.inodeCache = Nothing }-	let key = Types.Key.key2file $ fromJust r+	key <- Types.Key.key2file <$> getKey backendSHA1 tmp 	git_annex "reinject" [tmp, sha1annexedfile] @? "reinject failed"+	annexed_present sha1annexedfile 	git_annex "fromkey" [key, sha1annexedfiledup] @? "fromkey failed for dup"-	annexed_present sha1annexedfiledup+	annexed_present_locked sha1annexedfiledup   where 	tmp = "tmpfile" @@ -528,16 +545,21 @@  test_lock :: Assertion test_lock = intmpclonerepoInDirect $ do-	-- regression test: unlock of not present file should skip it 	annexed_notpresent annexedfile-	not <$> git_annex "unlock" [annexedfile] @? "unlock failed to fail with not present file"+	ifM (unlockedFiles <$> getTestMode)+		( not <$> git_annex "lock" [annexedfile] @? "lock failed to fail with not present file"+		, not <$> git_annex "unlock" [annexedfile] @? "unlock failed to fail with not present file"+		) 	annexed_notpresent annexedfile  	-- regression test: unlock of newly added, not committed file-	-- should fail+	-- should fail in v5 mode. In v6 mode, this is allowed. 	writeFile "newfile" "foo" 	git_annex "add" ["newfile"] @? "add new file failed"-	not <$> git_annex "unlock" ["newfile"] @? "unlock failed to fail on newly added, never committed file"+	ifM (annexeval Annex.Version.versionSupportsUnlockedPointers)+		( git_annex "unlock" ["newfile"] @? "unlock failed on newly added, never committed file in v6 repository"+		, not <$> git_annex "unlock" ["newfile"] @? "unlock failed to fail on newly added, never committed file in v5 repository"+		)  	git_annex "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile@@ -549,12 +571,21 @@ 	writeFile annexedfile $ content annexedfile ++ "foo" 	not <$> git_annex "lock" [annexedfile] @? "lock failed to fail without --force" 	git_annex "lock" ["--force", annexedfile] @? "lock --force failed"-	annexed_present annexedfile+	-- In v6 mode, the original content of the file is not always+	-- preserved after modification, so re-get it.+	git_annex "get" [annexedfile] @? "get of file failed after lock --force"+	annexed_present_locked annexedfile 	git_annex "unlock" [annexedfile] @? "unlock failed"		 	unannexed annexedfile 	changecontent annexedfile-	git_annex "add" [annexedfile] @? "add of modified file failed"-	runchecks [checklink, checkunwritable] annexedfile+	ifM (annexeval Annex.Version.versionSupportsUnlockedPointers)+		( do+			boolSystem "git" [Param "add", Param annexedfile] @? "add of modified file failed"+			runchecks [checkregularfile, checkwritable] annexedfile+		, do+			git_annex "add" [annexedfile] @? "add of modified file failed"+			runchecks [checklink, checkunwritable] annexedfile+		) 	c <- readFile annexedfile 	assertEqual "content of modified file" c (changedcontent annexedfile) 	r' <- git_annex "drop" [annexedfile]@@ -580,7 +611,10 @@ 			@? "pre-commit failed" 		else boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "contentchanged"] 			@? "git commit of edited file failed"-	runchecks [checklink, checkunwritable] annexedfile+	ifM (annexeval Annex.Version.versionSupportsUnlockedPointers)+		( runchecks [checkregularfile, checkwritable] annexedfile+		, runchecks [checklink, checkunwritable] annexedfile+		) 	c <- readFile annexedfile 	assertEqual "content of modified file" c (changedcontent annexedfile) 	not <$> git_annex "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file"@@ -590,11 +624,16 @@ 	git_annex "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile 	git_annex "unlock" [annexedfile] @? "unlock failed"-	not <$> boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile]-		@? "partial commit of unlocked file not blocked by pre-commit hook"+	changecontent annexedfile+	ifM (annexeval Annex.Version.versionSupportsUnlockedPointers)+		( boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile]+			@? "partial commit of unlocked file should be allowed in v6 repository"+		, not <$> boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile]+			@? "partial commit of unlocked file not blocked by pre-commit hook"+		)  test_fix :: Assertion-test_fix = intmpclonerepoInDirect $ do+test_fix = intmpclonerepoInDirect $ unlessM (unlockedFiles <$> getTestMode) $ do 	annexed_notpresent annexedfile 	git_annex "fix" [annexedfile] @? "fix of not present failed" 	annexed_notpresent annexedfile@@ -617,9 +656,13 @@ test_direct = intmpclonerepoInDirect $ do 	git_annex "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile-	git_annex "direct" [] @? "switch to direct mode failed"-	annexed_present annexedfile-	git_annex "indirect" [] @? "switch to indirect mode failed"+	ifM (annexeval Annex.Version.versionSupportsUnlockedPointers)+		( not <$> git_annex "direct" [] @? "switch to direct mode failed to fail in v6 repository"+		, do+			git_annex "direct" [] @? "switch to direct mode failed"+			annexed_present annexedfile+			git_annex "indirect" [] @? "switch to indirect mode failed"+		)  test_trust :: Assertion test_trust = intmpclonerepo $ do@@ -661,8 +704,8 @@ 		git_annex "get" [f] @? "get of file failed" 		Utility.FileMode.allowWrite f 		writeFile f (changedcontent f)-		ifM (annexeval Config.isDirect)-			( git_annex "fsck" [] @? "fsck failed in direct mode with changed file content"+		ifM (annexeval Config.isDirect <||> unlockedFiles <$> getTestMode)+			( git_annex "fsck" [] @? "fsck failed on unlocked file with changed file content" 			, not <$> git_annex "fsck" [] @? "fsck failed to fail with corrupted file content" 			) 		git_annex "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f@@ -744,11 +787,11 @@ test_unused :: Assertion -- This test is broken in direct mode test_unused = intmpclonerepoInDirect $ do-	-- keys have to be looked up before files are removed-	annexedfilekey <- annexeval $ findkey annexedfile-	sha1annexedfilekey <- annexeval $ findkey sha1annexedfile+	checkunused [] "in new clone" 	git_annex "get" [annexedfile] @? "get of file failed" 	git_annex "get" [sha1annexedfile] @? "get of file failed"+	annexedfilekey <- getKey backendSHA256E annexedfile+	sha1annexedfilekey <- getKey backendSHA1 sha1annexedfile 	checkunused [] "after get" 	boolSystem "git" [Param "rm", Param "-fq", File annexedfile] @? "git rm failed" 	checkunused [] "after rm"@@ -771,37 +814,50 @@ 	checkunused [] "after dropunused" 	not <$> git_annex "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers" -	-- unused used to miss symlinks that were not staged and pointed -	-- at annexed content, and think that content was unused+	-- unused used to miss renamed symlinks that were not staged+	-- and pointed at annexed content, and think that content was unused 	writeFile "unusedfile" "unusedcontent" 	git_annex "add" ["unusedfile"] @? "add of unusedfile failed"-	unusedfilekey <- annexeval $ findkey "unusedfile"+	unusedfilekey <- getKey backendSHA256E "unusedfile" 	renameFile "unusedfile" "unusedunstagedfile" 	boolSystem "git" [Param "rm", Param "-qf", File "unusedfile"] @? "git rm failed" 	checkunused [] "with unstaged link" 	removeFile "unusedunstagedfile"-	checkunused [unusedfilekey] "with unstaged link deleted"+	checkunused [unusedfilekey] "with renamed link deleted"  	-- unused used to miss symlinks that were deleted or modified-	-- manually, but commited as such.+	-- manually 	writeFile "unusedfile" "unusedcontent" 	git_annex "add" ["unusedfile"] @? "add of unusedfile failed" 	boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed"-	unusedfilekey' <- annexeval $ findkey "unusedfile"+	unusedfilekey' <- getKey backendSHA256E "unusedfile" 	checkunused [] "with staged deleted link" 	boolSystem "git" [Param "rm", Param "-qf", File "unusedfile"] @? "git rm failed" 	checkunused [unusedfilekey'] "with staged link deleted" -	-- unused used to miss symlinks that were deleted or modified-	-- manually, but not staged as such.+	-- unused used to false positive on symlinks that were+	-- deleted or modified manually, but not staged as such 	writeFile "unusedfile" "unusedcontent" 	git_annex "add" ["unusedfile"] @? "add of unusedfile failed" 	boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed"-	unusedfilekey'' <- annexeval $ findkey "unusedfile"-	checkunused [] "with unstaged deleted link"+	checkunused [] "with staged file" 	removeFile "unusedfile"-	checkunused [unusedfilekey''] "with unstaged link deleted"+	checkunused [] "with staged deleted file" +	-- When an unlocked file is modified, git diff will cause git-annex+	-- to add its content to the repository. Make sure that's not+	-- found as unused.+	whenM (unlockedFiles <$> getTestMode) $ do+		let f = "unlockedfile"+		writeFile f "unlockedcontent1"+		boolSystem "git" [Param "add", File "unlockedfile"] @? "git add failed"+		checkunused [] "with unlocked file before modification"+		writeFile f "unlockedcontent2"+		checkunused [] "with unlocked file after modification"+		not <$> boolSystem "git" [Param "diff", Param "--quiet", File f] @? "git diff did not show changes to unlocked file"+		-- still nothing unused because one version is in the index+		-- and the other is in the work tree+		checkunused [] "with unlocked file after git diff"   where 	checkunused expectedkeys desc = do 		git_annex "unused" [] @? "unused failed"@@ -809,9 +865,6 @@ 		let unusedkeys = M.elems unusedmap 		assertEqual ("unused keys differ " ++ desc) 			(sort expectedkeys) (sort unusedkeys)-	findkey f = do-		r <- Backend.lookupFile f-		return $ fromJust r  test_describe :: Assertion test_describe = intmpclonerepo $ do@@ -936,12 +989,12 @@ 			indir r1 $ do 				disconnectOrigin 				writeFile conflictor "conflictor1"-				git_annex "add" [conflictor] @? "add conflicter failed"+				add_annex conflictor @? "add conflicter failed" 				git_annex "sync" [] @? "sync failed in r1" 			indir r2 $ do 				disconnectOrigin 				writeFile conflictor "conflictor2"-				git_annex "add" [conflictor] @? "add conflicter failed"+				add_annex conflictor @? "add conflicter failed" 				git_annex "sync" [] @? "sync failed in r2" 			pair r1 r2 			forM_ [r1,r2,r1] $ \r -> indir r $@@ -974,13 +1027,13 @@ 			indir r1 $ do 				disconnectOrigin 				writeFile conflictor "conflictor"-				git_annex "add" [conflictor] @? "add conflicter failed"+				add_annex conflictor @? "add conflicter failed" 				git_annex "sync" [] @? "sync failed in r1" 			indir r2 $ do 				disconnectOrigin 				createDirectory conflictor 				writeFile subfile "subfile"-				git_annex "add" [conflictor] @? "add conflicter failed"+				add_annex conflictor @? "add conflicter failed" 				git_annex "sync" [] @? "sync failed in r2" 			pair r1 r2 			let l = if inr1 then [r1, r2] else [r2, r1]@@ -1016,7 +1069,7 @@ 			indir r1 $ do 				disconnectOrigin 				writeFile conflictor "conflictor"-				git_annex "add" [conflictor] @? "add conflicter failed"+				add_annex conflictor @? "add conflicter failed" 				git_annex "sync" [] @? "sync failed in r1" 			indir r2 $ 				disconnectOrigin@@ -1065,18 +1118,24 @@ 				indir r1 $ do 					disconnectOrigin 					writeFile conflictor "conflictor"-					git_annex "add" [conflictor] @? "add conflicter failed"+					add_annex conflictor @? "add conflicter failed" 					git_annex "sync" [] @? "sync failed in r1" 				indir r2 $ do 					disconnectOrigin 					writeFile conflictor nonannexed_content+					boolSystem "git"+						[ Param "config"+						, Param "annex.largefiles"+						, Param ("exclude=" ++ ingitfile ++ " and exclude=" ++ conflictor)+						] @? "git config annex.largefiles failed" 					boolSystem "git" [Param "add", File conflictor] @? "git add conflictor failed" 					git_annex "sync" [] @? "sync failed in r2" 				pair r1 r2 				let l = if inr1 then [r1, r2] else [r2, r1] 				forM_ l $ \r -> indir r $ do 					when switchdirect $-						git_annex "direct" [] @? "failed switching to direct mode"+						whenM (annexeval Annex.Version.versionSupportsDirectMode) $+							git_annex "direct" [] @? "failed switching to direct mode" 					git_annex "sync" [] @? "sync failed" 				checkmerge ("r1" ++ show switchdirect) r1 				checkmerge ("r2" ++ show switchdirect) r2@@ -1116,7 +1175,7 @@ 				indir r1 $ do 					disconnectOrigin 					writeFile conflictor "conflictor"-					git_annex "add" [conflictor] @? "add conflicter failed"+					add_annex conflictor @? "add conflicter failed" 					git_annex "sync" [] @? "sync failed in r1" 				indir r2 $ do 					disconnectOrigin@@ -1127,7 +1186,8 @@ 				let l = if inr1 then [r1, r2] else [r2, r1] 				forM_ l $ \r -> indir r $ do 					when switchdirect $-						git_annex "direct" [] @? "failed switching to direct mode"+						whenM (annexeval Annex.Version.versionSupportsDirectMode) $ do+							git_annex "direct" [] @? "failed switching to direct mode" 					git_annex "sync" [] @? "sync failed" 				checkmerge ("r1" ++ show switchdirect) r1 				checkmerge ("r2" ++ show switchdirect) r2@@ -1166,7 +1226,7 @@ 				disconnectOrigin 				createDirectoryIfMissing True (parentDir remoteconflictor) 				writeFile remoteconflictor annexedcontent-				git_annex "add" [conflictor] @? "add remoteconflicter failed"+				add_annex conflictor @? "add remoteconflicter failed" 				git_annex "sync" [] @? "sync failed in r1" 			indir r2 $ do 				disconnectOrigin@@ -1225,6 +1285,44 @@ 		all (\i -> Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.SymlinkBlob) l 			@? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) +{- A v6 unlocked file that conflicts with a locked file should be resolved+ - in favor of the unlocked file, with no variant files, as long as they+ - both point to the same key. -}+test_mixed_lock_conflict_resolution :: Assertion+test_mixed_lock_conflict_resolution = +	withtmpclonerepo $ \r1 ->+		withtmpclonerepo $ \r2 -> do+			indir r1 $ whenM shouldtest $ do+				disconnectOrigin+				writeFile conflictor "conflictor"+				git_annex "add" [conflictor] @? "add conflicter failed"+				git_annex "sync" [] @? "sync failed in r1"+			indir r2 $ whenM shouldtest $ do+				disconnectOrigin+				writeFile conflictor "conflictor"+				git_annex "add" [conflictor] @? "add conflicter failed"+				git_annex "unlock" [conflictor] @? "unlock conflicter failed"+				git_annex "sync" [] @? "sync failed in r2"+			pair r1 r2+			forM_ [r1,r2,r1] $ \r -> indir r $+				git_annex "sync" [] @? "sync failed"+			checkmerge "r1" r1+			checkmerge "r2" r2+  where+	shouldtest = annexeval Annex.Version.versionSupportsUnlockedPointers+	conflictor = "conflictor"+	variantprefix = conflictor ++ ".variant"+	checkmerge what d = indir d $ whenM shouldtest $ do+		l <- getDirectoryContents "."+		let v = filter (variantprefix `isPrefixOf`) l+		length v == 0+			@? (what ++ " not exactly 0 variant files in: " ++ show l)+		conflictor `elem` l @? ("conflictor not present after conflict resolution")+		git_annex "get" [conflictor] @? "get failed"+		git_annex_expectoutput "find" [conflictor] [conflictor]+		-- regular file because it's unlocked+		checkregularfile conflictor+ {- Set up repos as remotes of each other. -} pair :: FilePath -> FilePath -> Assertion pair r1 r2 = forM_ [r1, r2] $ \r -> indir r $ do@@ -1380,7 +1478,7 @@ 			(c,k) <- annexeval $ do 				uuid <- Remote.nameToUUID "foo" 				rs <- Logs.Remote.readRemoteLog-				Just k <- Backend.lookupFile annexedfile+				Just k <- Annex.WorkTree.lookupFile annexedfile 				return (fromJust $ M.lookup uuid rs, k) 			let key = if scheme `elem` ["hybrid","pubkey"] 					then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]@@ -1505,7 +1603,7 @@ 		)   where 	isdirect = annexeval $ do-		Annex.Init.initialize Nothing+		Annex.Init.initialize Nothing Nothing 		Config.isDirect  checkRepo :: Types.Annex a -> FilePath -> IO a@@ -1530,7 +1628,14 @@ withtmpclonerepo' :: CloneRepoConfig -> (FilePath -> Assertion) -> Assertion withtmpclonerepo' cfg a = do 	dir <- tmprepodir-	bracket (clonerepo mainrepodir dir cfg) cleanup a+	clone <- clonerepo mainrepodir dir cfg+	r <- tryNonAsync (a clone)+	case r of+		Right () -> return ()+		Left e -> do+			whenM (keepFailures <$> getTestMode) $+				putStrLn $ "** Preserving repo for failure analysis in " ++ clone+			throwM e  disconnectOrigin :: Assertion disconnectOrigin = boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "remote rm"@@ -1584,11 +1689,14 @@ 		] 	boolSystem "git" cloneparams @? "git clone failed" 	configrepo new-	indir new $-		git_annex "init" ["-q", new] @? "git annex init failed"+	indir new $ do+		ver <- annexVersion <$> getTestMode+		if ver == Annex.Version.defaultVersion+			then git_annex "init" ["-q", new] @? "git annex init failed"+			else git_annex "init" ["-q", new, "--version", ver] @? "git annex init failed" 	unless (bareClone cfg) $ 		indir new $-			handleforcedirect+			setupTestMode 	return new  configrepo :: FilePath -> IO ()@@ -1598,11 +1706,13 @@ 	boolSystem "git" [Param "config", Param "user.email", Param "test@example.com"] @? "git config failed" 	-- avoid signed commits by test suite 	boolSystem "git" [Param "config", Param "commit.gpgsign", Param "false"] @? "git config failed"+	-- tell git-annex to not annex the ingitfile+	boolSystem "git"+		[ Param "config"+		, Param "annex.largefiles"+		, Param ("exclude=" ++ ingitfile)+		] @? "git config annex.largefiles failed" -handleforcedirect :: IO ()-handleforcedirect = whenM ((==) "1" <$> Utility.Env.getEnvDefault "FORCEDIRECT" "") $-	git_annex "direct" ["-q"] @? "git annex direct failed"-	 ensuretmpdir :: IO () ensuretmpdir = do 	e <- doesDirectoryExist tmpdir@@ -1666,10 +1776,10 @@  checkwritable :: FilePath -> Assertion checkwritable f = do-	r <- tryIO $ writeFile f $ content f-	case r of-		Left _ -> assertFailure $ "unable to modify " ++ f-		Right _ -> return ()+	s <- getFileStatus f+	let mode = fileMode s+	unless (mode == mode `unionFileModes` ownerWriteMode) $+		assertFailure $ "unable to modify " ++ f  checkdangling :: FilePath -> Assertion checkdangling f = ifM (annexeval Config.crippledFileSystem)@@ -1684,7 +1794,7 @@ checklocationlog :: FilePath -> Bool -> Assertion checklocationlog f expected = do 	thisuuid <- annexeval Annex.UUID.getUUID-	r <- annexeval $ Backend.lookupFile f+	r <- annexeval $ Annex.WorkTree.lookupFile f 	case r of 		Just k -> do 			uuids <- annexeval $ Remote.keyLocations k@@ -1695,9 +1805,13 @@ checkbackend :: FilePath -> Types.Backend -> Assertion checkbackend file expected = do 	b <- annexeval $ maybe (return Nothing) (Backend.getBackend file) -		=<< Backend.lookupFile file+		=<< Annex.WorkTree.lookupFile file 	assertEqual ("backend for " ++ file) (Just expected) b +checkispointerfile :: FilePath -> Assertion+checkispointerfile f = unlessM (isJust <$> Annex.Link.isPointerFile f) $+	assertFailure $ f ++ " is not a pointer file"+ inlocationlog :: FilePath -> Assertion inlocationlog f = checklocationlog f True @@ -1711,33 +1825,73 @@ 	runchecks as f  annexed_notpresent :: FilePath -> Assertion-annexed_notpresent = runchecks-	[checklink, checkdangling, notinlocationlog]+annexed_notpresent f = ifM (unlockedFiles <$> getTestMode)+	( annexed_notpresent_unlocked f+	, annexed_notpresent_locked f+	) +annexed_notpresent_locked :: FilePath -> Assertion+annexed_notpresent_locked = runchecks [checklink, checkdangling, notinlocationlog]++annexed_notpresent_unlocked :: FilePath -> Assertion+annexed_notpresent_unlocked = runchecks [checkregularfile, checkispointerfile, notinlocationlog]+ annexed_present :: FilePath -> Assertion-annexed_present = runchecks+annexed_present f = ifM (unlockedFiles <$> getTestMode)+	( annexed_present_unlocked f+	, annexed_present_locked f+	)++annexed_present_locked :: FilePath -> Assertion+annexed_present_locked = runchecks 	[checklink, checkcontent, checkunwritable, inlocationlog] +annexed_present_unlocked :: FilePath -> Assertion+annexed_present_unlocked = runchecks+	[checkregularfile, checkcontent, checkwritable, inlocationlog]+ unannexed :: FilePath -> Assertion unannexed = runchecks [checkregularfile, checkcontent, checkwritable] -withTestEnv :: Bool -> TestTree -> TestTree-withTestEnv forcedirect = withResource prepare release . const+add_annex :: FilePath -> IO Bool+add_annex f = ifM (unlockedFiles <$> getTestMode)+	( boolSystem "git" [Param "add", File f]+	, git_annex "add" [f]+	)++data TestMode = TestMode+	{ forceDirect :: Bool+	, unlockedFiles :: Bool+	, annexVersion :: Annex.Version.Version+	, keepFailures :: Bool+	} deriving (Read, Show)++testMode :: TestOptions -> Annex.Version.Version -> TestMode+testMode opts v = TestMode+	{ forceDirect = False+	, unlockedFiles = False+	, annexVersion = v+	, keepFailures = keepFailuresOption opts+	}++withTestMode :: TestMode -> TestTree -> TestTree+withTestMode testmode = withResource prepare release . const   where 	prepare = do-		setTestEnv forcedirect+		setTestMode testmode 		case tryIngredients [consoleTestReporter] mempty initTests of 			Nothing -> error "No tests found!?" 			Just act -> unlessM act $ 				error "init tests failed! cannot continue" 		return ()-	release _ = cleanup' True tmpdir--setTestEnv :: Bool -> IO ()-setTestEnv forcedirect = do-	whenM (doesDirectoryExist tmpdir) $-		error $ "The temporary directory " ++ tmpdir ++ " already exists; cannot run test suite."+	release _+		| keepFailures testmode = void $ tryIO $ do+			cleanup' True mainrepodir+			removeDirectory tmpdir+		| otherwise = cleanup' True tmpdir +setTestMode :: TestMode -> IO ()+setTestMode testmode = do 	currdir <- getCurrentDirectory 	p <- Utility.Env.getEnvDefault "PATH" "" @@ -1754,9 +1908,18 @@ 		, ("GIT_COMMITTER_NAME", "git-annex test") 		-- force gpg into batch mode for the tests 		, ("GPG_BATCH", "1")-		, ("FORCEDIRECT", if forcedirect then "1" else "")+		, ("TESTMODE", show testmode) 		] +getTestMode :: IO TestMode+getTestMode = Prelude.read <$> Utility.Env.getEnvDefault "TESTMODE" ""++setupTestMode :: IO ()+setupTestMode = do+	testmode <- getTestMode+	when (forceDirect testmode) $+		git_annex "direct" ["-q"] @? "git annex direct failed"+ changeToTmpDir :: FilePath -> IO () changeToTmpDir t = do 	topdir <- Utility.Env.getEnvDefault "TOPDIR" (error "TOPDIR not set")@@ -1781,6 +1944,9 @@ annexedfile :: String annexedfile = "foo" +annexedfiledup :: String+annexedfiledup = "foodup"+ wormannexedfile :: String wormannexedfile = "apple" @@ -1791,13 +1957,14 @@ sha1annexedfiledup = "sha1foodup"  ingitfile :: String-ingitfile = "bar"+ingitfile = "bar.c"  content :: FilePath -> String		 content f 	| f == annexedfile = "annexed file content" 	| f == ingitfile = "normal file content" 	| f == sha1annexedfile ="sha1 annexed file content"+	| f == annexedfiledup = content annexedfile 	| f == sha1annexedfiledup = content sha1annexedfile 	| f == wormannexedfile = "worm annexed file content" 	| "import" `isPrefixOf` f = "imported content"@@ -1815,10 +1982,23 @@ backendSHA256 :: Types.Backend backendSHA256 = backend_ "SHA256" +backendSHA256E :: Types.Backend+backendSHA256E = backend_ "SHA256E"+ backendWORM :: Types.Backend backendWORM = backend_ "WORM"  backend_ :: String -> Types.Backend backend_ = Backend.lookupBackendName++getKey :: Types.Backend -> FilePath -> IO Types.Key+getKey b f = fromJust <$> annexeval go+  where+	go = Types.Backend.getKey b+		Types.KeySource.KeySource+			{ Types.KeySource.keyFilename = f+			, Types.KeySource.contentLocation = f+			, Types.KeySource.inodeCache = Nothing+			}  #endif
Types/DeferredParse.hs view
@@ -10,7 +10,6 @@ module Types.DeferredParse where  import Annex-import Common  import Options.Applicative
Types/GitConfig.hs view
@@ -60,6 +60,7 @@ 	, annexListen :: Maybe String 	, annexStartupScan :: Bool 	, annexHardLink :: Bool+	, annexThin :: Bool 	, annexDifferences :: Differences 	, annexUsedRefSpec :: Maybe RefSpec 	, annexVerify :: Bool@@ -104,6 +105,7 @@ 	, annexListen = getmaybe (annex "listen") 	, annexStartupScan = getbool (annex "startupscan") True 	, annexHardLink = getbool (annex "hardlink") False+	, annexThin = getbool (annex "thin") False 	, annexDifferences = getDifferences r 	, annexUsedRefSpec = either (const Nothing) Just . parseRefSpec  		=<< getmaybe (annex "used-refspec")
Types/KeySource.hs view
@@ -9,7 +9,7 @@  import Utility.InodeCache -{- When content is in the process of being added to the annex,+{- When content is in the process of being ingested into the annex,  - and a Key generated from it, this data type is used.   -  - The contentLocation may be different from the filename@@ -19,7 +19,7 @@  - of a different Key.  -  - The inodeCache can be used to detect some types of modifications to- - files that may be made while they're in the process of being added.+ - files that may be made while they're in the process of being ingested.  -} data KeySource = KeySource 	{ keyFilename :: FilePath
Types/Test.hs view
@@ -11,10 +11,22 @@  #ifdef WITH_TESTSUITE import Test.Tasty.Options+import Data.Monoid+import Prelude #endif  #ifdef WITH_TESTSUITE-type TestOptions = OptionSet+data TestOptions = TestOptions+	{ tastyOptionSet :: OptionSet+	, keepFailuresOption :: Bool+	}++instance Monoid TestOptions where+	mempty = TestOptions mempty False+	mappend a b = TestOptions+		(tastyOptionSet a <> tastyOptionSet b)+		(keepFailuresOption a || keepFailuresOption b)+ #else type TestOptions = () #endif
Upgrade.hs view
@@ -18,13 +18,14 @@ import qualified Upgrade.V2 import qualified Upgrade.V3 import qualified Upgrade.V4+import qualified Upgrade.V5  checkUpgrade :: Version -> Annex () checkUpgrade = maybe noop error <=< needsUpgrade  needsUpgrade :: Version -> Annex (Maybe String) needsUpgrade v-	| v == supportedVersion = ok+	| v `elem` supportedVersions = ok 	| v `elem` autoUpgradeableVersions = ifM (upgrade True) 		( ok 		, err "Automatic upgrade failed!"@@ -40,7 +41,7 @@ upgrade automatic = do 	upgraded <- go =<< getVersion 	when upgraded $-		setVersion supportedVersion+		setVersion latestVersion 	return upgraded   where #ifndef mingw32_HOST_OS@@ -53,4 +54,5 @@ 	go (Just "2") = Upgrade.V2.upgrade 	go (Just "3") = Upgrade.V3.upgrade automatic 	go (Just "4") = Upgrade.V4.upgrade automatic+	go (Just "5") = Upgrade.V5.upgrade automatic 	go _ = return True
Upgrade/V1.hs view
@@ -54,14 +54,14 @@ 	ifM (fromRepo Git.repoIsLocalBare) 		( do 			moveContent-			setVersion supportedVersion+			setVersion latestVersion 		, do 			moveContent 			updateSymlinks 			moveLocationLogs 	 			Annex.Queue.flush-			setVersion supportedVersion+			setVersion latestVersion 		) 	 	Upgrade.V2.upgrade
+ Upgrade/V5.hs view
@@ -0,0 +1,116 @@+{- git-annex v5 -> v6 upgrade support+ -+ - Copyright 2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Upgrade.V5 where++import Common.Annex+import qualified Annex+import Config+import Annex.InodeSentinal+import Annex.Link+import Annex.Direct+import Annex.Content+import Annex.CatFile+import qualified Database.Keys+import qualified Annex.Content.Direct as Direct+import qualified Git+import qualified Git.LsFiles+import qualified Git.Branch+import Git.FilePath+import Git.FileMode+import Git.Config+import Utility.InodeCache++upgrade :: Bool -> Annex Bool+upgrade automatic = do+	unless automatic $+		showAction "v5 to v6"+	Database.Keys.scanAssociatedFiles+	whenM isDirect $ do+		{- Direct mode makes the same tradeoff of using less disk+		 - space, with less preservation of old versions of files+		 - as does annex.thin. -}+		setConfig (annexConfig "thin") (boolConfig True)+		Annex.changeGitConfig $ \c -> c { annexThin = True }+		{- Since upgrade from direct mode changes how files+		 - are represented in git, commit any changes in the+		 - work tree first. -}+		whenM stageDirect $ do+			unless automatic $+				showAction "committing first"+			upgradeDirectCommit automatic+				"commit before upgrade to annex.version 6"+		setDirect False+		upgradeDirectWorkTree+		removeDirectCruft+		showLongNote "Upgraded repository out of direct mode."+		showLongNote "Changes have been staged for all annexed files in this repository; you should run `git commit` to commit these changes."+		showLongNote "Any other clones of this repository that use direct mode need to be upgraded now, too."+	configureSmudgeFilter+	-- Inode sentinal file was only used in direct mode and when+	-- locking down files as they were added. In v6, it's used more+	-- extensively, so make sure it exists, since old repos that didn't+	-- use direct mode may not have created it.+	unlessM (isDirect) $+		createInodeSentinalFile True+	return True++upgradeDirectCommit :: Bool -> String -> Annex ()+upgradeDirectCommit automatic msg = +	void $ inRepo $ Git.Branch.commitCommand commitmode+		[ Param "-m"+		, Param msg+		]+  where+	commitmode = if automatic then Git.Branch.AutomaticCommit else Git.Branch.ManualCommit++{- Walk work tree from top and convert all annex symlinks to pointer files,+ - staging them in the index, and updating the work tree files with+ - either the content of the object, or the pointer file content. -}+upgradeDirectWorkTree :: Annex ()+upgradeDirectWorkTree = do+	top <- fromRepo Git.repoPath+	(l, clean) <- inRepo $ Git.LsFiles.stagedDetails [top]+	forM_ l go+	void $ liftIO clean+  where+	go (f, Just _sha, Just mode) | isSymLink mode = do+		-- Cannot use lookupFile here, as we're in between direct+		-- mode and v6.+		mk <- catKeyFile f+		case mk of+			Nothing -> noop+			Just k -> do+				ifM (isJust <$> getAnnexLinkTarget f)+					( writepointer f k+					, fromdirect f k+					)+				stagePointerFile f =<< hashPointerFile k+				Database.Keys.addAssociatedFile k+					=<< inRepo (toTopFilePath f)+				return ()+	go _ = noop++	fromdirect f k = do+		-- If linkToAnnex fails for some reason, the work tree file+		-- still has the content; the annex object file is just+		-- not populated with it. Since the work tree file+		-- is recorded as an associated file, things will still+		-- work that way, it's just not ideal.+		ic <- withTSDelta (liftIO . genInodeCache f)+		void $ linkToAnnex k f ic+	writepointer f k = liftIO $ do+		nukeFile f+		writeFile f (formatPointer k)++{- Remove all direct mode bookkeeping files. -}+removeDirectCruft :: Annex ()+removeDirectCruft = mapM_ go =<< getKeysPresent InAnywhere+  where+	go k = do+		Direct.removeInodeCache k+		Direct.removeAssociatedFiles k
Utility/Directory.hs view
@@ -134,11 +134,13 @@ 				_ <- tryIO $ removeFile tmp 				throwM e' +#ifndef mingw32_HOST_OS	 	isdir f = do 		r <- tryIO $ getFileStatus f 		case r of 			(Left _) -> return False 			(Right s) -> return $ isDirectory s+#endif  {- Removes a file, which may or may not exist, and does not have to  - be a regular file.
Utility/FileMode.hs view
@@ -18,9 +18,10 @@ import Utility.PosixFiles #ifndef mingw32_HOST_OS import System.Posix.Files+import Control.Monad.IO.Class (liftIO) #endif+import Control.Monad.IO.Class (MonadIO) import Foreign (complement)-import Control.Monad.IO.Class (liftIO, MonadIO) import Control.Monad.Catch  import Utility.Exception
Utility/FileSystemEncoding.hs view
@@ -19,6 +19,7 @@ 	encodeW8NUL, 	decodeW8NUL, 	truncateFilePath,+	setConsoleEncoding, ) where  import qualified GHC.Foreign as GHC@@ -164,3 +165,10 @@ 					else go (c:coll) (cnt - x') (L8.drop 1 bs) 			_ -> coll #endif++{- This avoids ghc's output layer crashing on invalid encoded characters in+ - filenames when printing them out. -}+setConsoleEncoding :: IO ()+setConsoleEncoding = do+	fileEncoding stdout+	fileEncoding stderr
Utility/InodeCache.hs view
@@ -1,7 +1,7 @@ {- Caching a file's inode, size, and modification time  - to see when it's changed.  -- - Copyright 2013, 2014 Joey Hess <id@joeyh.name>+ - Copyright 2013-2014 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -54,7 +54,7 @@ {- Inode caches can be compared in two different ways, either weakly  - or strongly. -} data InodeComparisonType = Weakly | Strongly-	deriving (Eq, Ord)+	deriving (Eq, Ord, Show)  {- Strong comparison, including inodes. -} compareStrong :: InodeCache -> InodeCache -> Bool@@ -81,7 +81,7 @@ {- For use in a Map; it's determined at creation time whether this  - uses strong or weak comparison for Eq. -} data InodeCacheKey = InodeCacheKey InodeComparisonType InodeCachePrim-	deriving (Ord)+	deriving (Ord, Show)  instance Eq InodeCacheKey where 	(InodeCacheKey ctx x) == (InodeCacheKey cty y) =
Utility/LockFile/PidLock.hs view
@@ -31,11 +31,12 @@ import System.Posix import Data.Maybe import Data.List-import Control.Applicative import Network.BSD import System.FilePath import Data.Hash.MD5 import System.Directory+import Control.Applicative+import Prelude  type LockFile = FilePath
Utility/LockPool/LockHandle.hs view
@@ -10,7 +10,9 @@ module Utility.LockPool.LockHandle where  import qualified Utility.LockPool.STM as P+#ifndef mingw32_HOST_OS import Utility.LockPool.STM (LockFile)+#endif  import Control.Concurrent.STM import Control.Exception
Utility/Path.hs view
@@ -60,7 +60,7 @@ {- Makes a path absolute.  -  - The first parameter is a base directory (ie, the cwd) to use if the path- - is not already absolute.+ - is not already absolute, and should itsef be absolute.  -  - Does not attempt to deal with edge cases or ensure security with  - untrusted inputs.@@ -252,15 +252,21 @@   where 	f = takeFileName file -{- Converts a DOS style path to a Cygwin style path. Only on Windows.- - Any trailing '\' is preserved as a trailing '/' -}-toCygPath :: FilePath -> FilePath+{- Converts a DOS style path to a msys2 style path. Only on Windows.+ - Any trailing '\' is preserved as a trailing '/' + - + - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i+ -+ - The virtual filesystem contains:+ -  /c, /d, ...	mount points for Windows drives+ -}+toMSYS2Path :: FilePath -> FilePath #ifndef mingw32_HOST_OS-toCygPath = id+toMSYS2Path = id #else-toCygPath p+toMSYS2Path p 	| null drive = recombine parts-	| otherwise = recombine $ "/cygdrive" : driveletter drive : parts+	| otherwise = recombine $ "/" : driveletter drive : parts   where 	(drive, p') = splitDrive p 	parts = splitDirectories p'
Utility/Rsync.hs view
@@ -54,16 +54,16 @@ rsync :: [CommandParam] -> IO Bool rsync = boolSystem "rsync" . rsyncParamsFixup -{- On Windows, rsync is from Cygwin, and expects to get Cygwin formatted+{- On Windows, rsync is from msys2, and expects to get msys2 formatted  - paths to files. (It thinks that C:foo refers to a host named "C").  - Fix up the Params appropriately. -} rsyncParamsFixup :: [CommandParam] -> [CommandParam] #ifdef mingw32_HOST_OS rsyncParamsFixup = map fixup   where-	fixup (File f) = File (toCygPath f)+	fixup (File f) = File (toMSYS2Path f) 	fixup (Param s)-		| rsyncUrlIsPath s = Param (toCygPath s)+		| rsyncUrlIsPath s = Param (toMSYS2Path s) 	fixup p = p #else rsyncParamsFixup = id
Utility/Url.hs view
@@ -78,15 +78,18 @@ 	def = UrlOptions Nothing [] [] id  mkUrlOptions :: Maybe UserAgent -> Headers -> [CommandParam] -> UrlOptions-mkUrlOptions useragent reqheaders reqparams =+mkUrlOptions defuseragent reqheaders reqparams = 	UrlOptions useragent reqheaders reqparams applyrequest   where 	applyrequest = \r -> r { requestHeaders = requestHeaders r ++ addedheaders } 	addedheaders = uaheader ++ otherheaders+	useragent = maybe defuseragent (Just . B8.toString . snd)+		(headMaybe uafromheaders) 	uaheader = case useragent of 		Nothing -> [] 		Just ua -> [(hUserAgent, B8.fromString ua)]-	otherheaders = map toheader reqheaders+	(uafromheaders, otherheaders) = partition (\(h, _) -> h == hUserAgent)+		(map toheader reqheaders) 	toheader s = 		let (h, v) = separate (== ':') s 		    h' = CI.mk (B8.fromString h)
debian/cabal-wrapper view
@@ -1,11 +1,9 @@ #!/bin/sh # It would be more usual to use:-#   export CABAL=./Setup+#   export BUILDER=./Setup # But Setup currently has a very bad dependency resolver, and very bad # debugging output, and tends to eat all memory and die on small buildds.-#-# This should be revisited once Debian has a newer ghc than 7.6.3,-# and hopefully gets the improved dependency resolver from cabal.+# See https://github.com/haskell/cabal/issues/2777 set -e  # Avoid cabal writing to HOME, and avoid local cabal settings
debian/changelog view
@@ -1,3 +1,67 @@+git-annex (6.20160114) unstable; urgency=medium++  "hexapodia as the key insight"++  * Added v6 repository mode, but v5 is still the default for now.+  * unlock, lock: In v6 mode, unlocking a file changes it from a symlink to a+    pointer file, and this change can be committed to the git repository.+    For details, see http://git-annex.branchable.com/tips/unlocked_files/+  * The upgrade to version 6 is not done fully automatically yet, because+    upgrading a direct mode repository to version 6 will prevent old+    versions of git-annex from working in other clones of that repository.+    For details, see http://git-annex.branchable.com/upgrades/+  * init: --version parameter added to control which supported repository+    version to use.+  * init, upgrade: Configure .git/info/attributes to use git-annex+    as a smudge filter. In v6 repository mode, this makes git add+    add files to the annex in unlocked mode, unless overridden by+    annex.largefiles configuration.+  * assistant: In v6 mode, adds files in unlocked mode, so they can+    continue to be modified.+  * Added annex.thin setting, which makes unlocked files in v6 repositories+    be hard linked to their content, instead of a copy. This saves disk+    space but means any modification of an unlocked file will lose the local+    (and possibly only) copy of the old version.+  * Enable annex.thin by default on upgrade from direct mode to v6, since+    direct mode made the same tradeoff.+  * fix: Adjusts unlocked files as configured by annex.thin.+  * persistent-sqlite is now a hard build dependency, since v6 repository+    mode needs it.+++  * status: On crippled filesystems, was displaying M for all annexed files+    that were present. Probably caused by a change to what git status+    displays in this situation. Fixed by treating files git thinks are+    modified the same as typechanged files.+  * addurl: Added --batch and --with-files options.+  * addurl: Support --json, particularly useful in --batch mode.+  * addurl: Refuse to overwrite any existing, non-annexed file.+  * Debian: Adjust build dependencies for webapp, DAV. Now available on+    mips, mipsel, but temporarily removed armel since build is failing+    there.+  * info: Fix "backend usage" numbers, which were counting present keys+    twice.+  * info --json: Improve json for "backend usage", using a nested object+    with fields for each backend instead of the previous weird nested lists.+    This may break existing parsers of this json output, if there were any.+  * whereis --json: Make url list be included in machine-parseable form.+  * test: Added --keep-failures option.+  * unused: Bug fix when a new file was added to the annex, and then+    removed (but not git rmed). git still has the add staged in this case,+    so the content should not be unused and was wrongly treated as such.+  * migrate: Copy over metadata to new key.+  * rekey: No longer copies over urls from the old to the new key.+    It makes sense for migrate to do that, but not for this low-level+    (and little used) plumbing command to.+  * view: Fix crash in non-unicode capable locale when entering a view+    of metadata containing a slash or backslash.+  * When annex.http-headers is used to set the User-Agent header, avoid+    sending User-Agent: git-annex+  * Windows: Fix rsync cross-drive hack to work with msys2 rsync.+    Thanks, Pieter Kitslaar.++ -- Joey Hess <id@joeyh.name>  Thu, 14 Jan 2016 10:14:19 -0400+ git-annex (5.20151218) unstable; urgency=medium    * Add S3 features to git-annex version output.
debian/control view
@@ -31,22 +31,22 @@ 	libghc-stm-dev (>= 2.3), 	libghc-dbus-dev (>= 0.10.7) [linux-any], 	libghc-fdo-notify-dev (>= 0.3) [linux-any],-	libghc-yesod-dev (>= 1.2.6.1)       [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-yesod-core-dev (>= 1.2.19)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-yesod-form-dev (>= 1.3.15)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-yesod-static-dev (>= 1.2.4)  [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-yesod-default-dev (>= 1.2.0) [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-shakespeare-dev (>= 2.0.0)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-clientsession-dev            [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-warp-dev (>= 3.0.0.5)        [i386 amd64 armel armhf armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-warp-tls-dev                 [i386 amd64 armel armhf armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-wai-dev                      [i386 amd64 armel armhf armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-wai-extra-dev                [i386 amd64 armel armhf armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x],-	libghc-dav-dev (>= 1.0)             [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],-	libghc-persistent-dev               [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],-	libghc-persistent-template-dev      [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],-	libghc-persistent-sqlite-dev        [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],-	libghc-esqueleto-dev                [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-yesod-dev (>= 1.2.6.1)       [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-yesod-core-dev (>= 1.2.19)   [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-yesod-form-dev (>= 1.3.15)   [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-yesod-static-dev (>= 1.2.4)  [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-yesod-default-dev (>= 1.2.0) [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-shakespeare-dev (>= 2.0.0)   [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-clientsession-dev            [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-warp-dev (>= 3.0.0.5)        [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-warp-tls-dev                 [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-wai-dev                      [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-wai-extra-dev                [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc ppc64el s390x],+	libghc-dav-dev (>= 1.0)             [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x sparc64 hppa alpha hurd-i386],+	libghc-persistent-dev,+	libghc-persistent-template-dev,+	libghc-persistent-sqlite-dev,+	libghc-esqueleto-dev, 	libghc-securemem-dev, 	libghc-byteable-dev, 	libghc-dns-dev,
debian/rules view
@@ -1,6 +1,6 @@ #!/usr/bin/make -f -export CABAL=debian/cabal-wrapper+export BUILDER=debian/cabal-wrapper  STANDALONE_BUILD=$(shell grep -qe '^Package: git-annex-standalone' debian/control \                          && echo 1 || echo 0)
+ doc/Android/comment_7_725ec376b56f51afa37dfd750c744f73._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="joseph.rawson.works@85a210ab8c0e37a0b2d6bb235738b20e23e8878f"+ nickname="joseph.rawson.works"+ subject="ssh keys, github, xmpp"+ date="2015-12-28T22:09:24Z"+ content="""+I generated an rsa keypair and added them to /sd/ga-h/.ssh, yet they were overwritten.  I couldn't access my annexes located on github.  I couldn't login to google talk, as instructed by the web app.++Thanks for letting me know about gitlab supporting git-annex.+"""]]
+ doc/bugs/--json_issues.mdwn view
@@ -0,0 +1,49 @@+### Please describe the problem.+Duplicate "note" properties in JSON output of whereis command.  The JSON output is "[strictly speaking](http://stackoverflow.com/questions/21832701/does-json-syntax-allow-duplicate-keys-in-an-object)" valid, however, the duplicate property makes it difficult to use python-json, and possibly other implementations (I just checked node and chromium and they also keep the value of the last property after deserialization). ++I noticed the problem being mentioned [here](https://git-annex.branchable.com/forum/git_annex_whereis_--json_output_with_two_variables_with_same_name/), where the user desires to parse an entry in the machine parsable json output that is apparently not meant to be parsed by a machine, which makes a person wonder why it's there anyway.  Even so, obtaining the actual url in the web remote for an annexed object relies on one of the "note" properties in the json output.  Using [whereis](+http://git-annex.branchable.com/tips/using_the_web_as_a_special_remote/#comment-7878bde74289b42500e4fac3a122a535) to get the url(s) for a file is the recommended method.  A json implementation that sets the first property, then ignores remaining duplicates will only parse the "2 copies" note, and ignore the url.++If the "note" properties are meant to be comments, it might be a good idea to find another property for the url(s).  Please note that I haven't looked at multiple urls for an object, so I'm not sure that only the last listed url will appear in parsed json object.++> The note properties are any notes git-annex normally displays while+> running a command.++### What steps will reproduce the problem?++git-annex whereis --json++### What version of git-annex are you using? On what operating system?++git-annex version: 5.20151208-1 (sid chroot)++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+umeboshi@bard:~/tmp$ git init testweb+Initialized empty Git repository in /freespace/home/umeboshi/tmp/testweb/.git/+umeboshi@bard:~/tmp$ cd testweb/+umeboshi@bard:~/tmp/testweb$ git-annex init+init  ok+(recording state in git...)+umeboshi@bard:~/tmp/testweb$ git-annex addurl http://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf+addurl www.ecma_international.org_publications_files_ECMA_ST_ECMA_404.pdf (downloading http://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf ...) +/freespace/home/ume 100%[===================>]   1.08M   917KB/s    in 1.2s    +ok+(recording state in git...)+umeboshi@bard:~/tmp/testweb$ git-annex whereis www.ecma_international.org_publications_files_ECMA_ST_ECMA_404.pdf  --json+{"command":"whereis","file":"www.ecma_international.org_publications_files_ECMA_ST_ECMA_404.pdf","note":"2 copies","whereis":[{"uuid":"00000000-0000-0000-0000-000000000001","description":"web","here":false},{"uuid":"996522e8-a433-42ff-85f2-48e456fdb120","description":"umeboshi@bard:~/tmp/testweb","here":true}],"note":"\t00000000-0000-0000-0000-000000000001 -- web\n \t996522e8-a433-42ff-85f2-48e456fdb120 -- umeboshi@bard:~/tmp/testweb [here]\n","untrusted":[],"note":"web: http://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf\n","success":true}++umeboshi@bard:~/tmp/testweb$ +++# End of transcript or log.+"""]]++### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)++Lol!  Positive note!  I spend a couple of days making specially crafted rss files for importfeed, so I can have appropriate filenames, then look back and see that you are working on '--batch --with-files' options to addurl.  Have a Happy New Year!  :)++> [[fixed|done]] --[[Joey]]
+ doc/bugs/Android_6.0_compatibility.mdwn view
@@ -0,0 +1,33 @@+### Please describe the problem.+Git-annex appears to be incompatible with Android 6. I downloaded the APK for Android 5 and tried installing it on a Nexus 5X running Android 6.0.1. The biggest issue is that pushing and pulling to SSH remotes fails with a "Permission denied" error from muxserver_listen() in OpenSSH. There are some other warnings and errors, listed below, would you like me to file separate bugs for each or track everything here?++- The full error from ssh is "muxserver_listen: link mux listener /data/data/ga.androidterm/tmp/ssh/annex-user@192.168.0.3.Jg42jDbmIRBdbjDZ => /data/data/ga.androidterm/tmp/ssh/annex-user@192.168.0.3: Permission denied". Immediately after that there is an error message, presumably from git, that reads "fatal: Could not read from remote repository." I am able to SSH to the server from the app's command line, and get an interactive shell. I can successfully run 'git fetch `git remote`', but `git annex sync` runs into this issue.+- When switching between two repositories in the webapp, the page never loads after clicking on a repository. After trying the link a few times, I can see "git-annex: Daemon is already running." through the webapp's log viewer. However, if I stop the daemon through the webapp and start it again, then the webapp will indicate that I successfully switched to the other repository.+- There is a warning message in the console that reads, "WARNING: linker: git-annex has text relocations. This is wasting memory and prevents security hardening. Please fix." It appears that apps targeting SDK version 23 are not allowed to use text relocations, while apps targeting lower versions just get this warning. See http://developer.android.com/about/versions/marshmallow/android-6.0-changes.html#behavior-runtime+- There is a warning message at the top of every new terminal that says "Falling back to hardcoded app location; cannot find expected files in /data/app/ga.androidterm-1/lib". This issue doesn't appear to affect anything, but I thought I'd mention it for completeness.+- At various times during syncing, "\_\_bionic_open_tzdata_path: ANDROID_DATA not set!" and "\_\_bionic_open_tzdata_path: ANDROID_ROOT not set!" show up in the log.++### What steps will reproduce the problem?+1. Install Android 5.0 APK on Android 6.0 phone+2. Create a repository+3. Add an SSH remote++### What version of git-annex are you using? On what operating system?+5.20151217-g7b73f34 on Android 6.0.1++### Please provide any additional information below.+[[!format sh """+muxserver_listen: link mux listener /data/data/ga.androidterm/tmp/ssh/annex-user@192.168.0.3.ZUzI2MBl8k0qt2pg => /data/data/ga.androidterm/tmp/ssh/annex-user@192.168.0.3: Permission denied+"""]]++If I look in this temporary directory after the fact, I see the following.++[[!format sh """+> ls -l /data/data/ga.androidterm/tmp/ssh+-rw-------    1 u0_a108  u0_a108      0 Dec 24 10:06 annex-user@192.168.0.3.lock+"""]]++I suppose since the socket is a Unix domain socket, it gets destroyed when the process stops, so it shouldn't be surprising there's nothing else in that directory.++### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)+Not yet, but I'm excited to make it work!
+ doc/bugs/addurl_unittest_failing_under_windows.mdwn view
@@ -0,0 +1,54 @@+### Please describe the problem.+git annex works perfectly fine under windows now; awesome work! One of the tests in the suite still fails (which might affect some features, that I don't use (yet?)).++### What steps will reproduce the problem?+[[!format sh """+$ git annex test -p addurl+"""]]++### What version of git-annex are you using? On what operating system?++[[!format sh """+$ git --version+git version 2.6.4.windows.1++$ git annex version+git-annex version: 5.20151218-g5008846+build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3(multipartupload) WebDAV ConcurrentOutput DNS Feeds Quvi TDFA TorrentParser Database+key/value backends: SHA256E SHA256 SHA512E SHA512 SHA224E SHA224 SHA384E SHA384 SHA3_256E SHA3_256 SHA3_512E SHA3_512 SHA3_224E SHA3_224 SHA3_384E SHA3_384 SKEIN256E SKEIN256 SKEIN512E SKEIN512 SHA1E SHA1 MD5E MD5 WORM URL+remote types: git gcrypt S3 bup directory rsync web bittorrent webdav tahoe glacier ddar hook external+"""]]++Windows 10 (OS Build 10586.0)++### Please provide any additional information below.++[[!format sh """+$ git annex test -p addurl+Tests+  Unit Tests+Init Tests+    addurl:   init:   Detected a filesystem without fifo support.+  Disabling ssh connection caching.+  Detected a crippled filesystem.+  Enabling direct mode.+OK (2.74s)+  add:  fatal: This operation must be run in a work tree+OK (6.00s)++All 2 tests passed (8.79s)+  Detected a filesystem without fifo support.+  Disabling ssh connection caching.+  Detected a crippled filesystem.+  Enabling direct mode.+removeDirectoryRecursive: permission denied (The process cannot access the file because it is being used by another process.)+sleeping 10 seconds and will retry directory cleanup+FAIL (7.16s)+      addurl failed on file:///Users/born/.t/tmprepo0/myurl++1 out of 1 tests failed (28.13s)+  (This could be due to a bug in git-annex, or an incompatability+   with utilities, such as git, installed on this system.)+"""]]++
+ doc/bugs/cannot_add_a_files_with_an_accent_in_it.mdwn view
@@ -0,0 +1,43 @@+### Please describe the problem.++I cannot add a file that has an accent in its name. If I change the file name to not have accents, everything works.++### What steps will reproduce the problem?++- create a file with an accent in its name+- "git annex status" shows the file is not checked in+- "git annex add" the file+- nothing happens, and "git annex status" still shows the file as not checked in++### What version of git-annex are you using? On what operating system?++% brew info git-annex+git-annex: stable 5.20151218 (bottled), HEAD++OS X 10.11.2++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+[schmitta@charm-ecran:~/Documents/annex on master]+% git annex status+[schmitta@charm-ecran:~/Documents/annex on master]+% cat > é+foo+[schmitta@charm-ecran:~/Documents/annex on master]+% git annex status                                                            ✭+? é+[schmitta@charm-ecran:~/Documents/annex on master]+% git annex add é                                                             ✭+[schmitta@charm-ecran:~/Documents/annex on master]+% git annex status                                                            ✭+? é++# End of transcript or log.+"""]]++### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)++Yes, git annex is great and I use it to store videos I want to watch later but that are too big to all be stored on my laptop.
+ doc/bugs/drop_from_special_hybrid_encryption_remote_fails.mdwn view
@@ -0,0 +1,57 @@+### Please describe the problem.++I am trying to drop a file from a special, hybrid encryption remote. It says "failed", but I cannot figure out why, the commands in --debug all seem to exit with ExitSuccess.++### What steps will reproduce the problem?++Not sure how to reproduce from scratch, see log below for what happens when I do +git annex drop file -f specialremote ...++### What version of git-annex are you using? On what operating system?++[[!format sh """+$ git annex version+git-annex version: 5.20150916+gitg79661ef-1~ndall+1+build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA Database+key/value backends: SHA256E SHA256 SHA512E SHA512 SHA224E SHA224 SHA384E SHA384 SHA3_256E SHA3_256 SHA3_512E SHA3_512 SHA3_224E SHA3_224 SHA3_384E SHA3_384 SKEIN256E SKEIN256 SKEIN512E SKEIN512 SHA1E SHA1 MD5E MD5 WORM URL+remote types: git gcrypt S3 bup directory rsync web bittorrent webdav tahoe glacier ddar hook external+local repository version: 5+supported repository version: 5+upgrade supported from repository versions: 0 1 2 4+"""]]++### Please provide any additional information below.++[[!format sh """+[2015-12-27 00:15:58.093036] read: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","ls-files","--cached","-z","--","20150816_cccamp/DSC04537.ARW"]+[2015-12-27 00:15:58.147092] read: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","show-ref","git-annex"]+[2015-12-27 00:15:58.150596] process done ExitSuccess+[2015-12-27 00:15:58.150901] read: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","show-ref","--hash","refs/heads/git-annex"]+[2015-12-27 00:15:58.155607] process done ExitSuccess+[2015-12-27 00:15:58.157843] read: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","log","refs/heads/git-annex..85eb4dbbebcc100c2414f5a71f4fb9a22f0239fb","-n1","--pretty=%H"]+[2015-12-27 00:15:58.162227] process done ExitSuccess+[2015-12-27 00:15:58.162985] read: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","log","refs/heads/git-annex..c0747d4c69cf80aa0290f1385454eb76a4c21032","-n1","--pretty=%H"]+[2015-12-27 00:15:58.168515] process done ExitSuccess+[2015-12-27 00:15:58.168888] read: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","log","refs/heads/git-annex..0357da603dc61b28814125650def17fb0e3f82ca","-n1","--pretty=%H"]+[2015-12-27 00:15:58.174589] process done ExitSuccess+[2015-12-27 00:15:58.1749] read: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","log","refs/heads/git-annex..4673c36870f0a536b4bedc3f5826f2d6b39c9d6a","-n1","--pretty=%H"]+[2015-12-27 00:15:58.214221] process done ExitSuccess+[2015-12-27 00:15:58.215418] read: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","log","refs/heads/git-annex..75de80c0acf77e04e5b2b4c6f7947aec75603989","-n1","--pretty=%H"]+[2015-12-27 00:15:58.243546] process done ExitSuccess+[2015-12-27 00:15:58.244412] chat: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","cat-file","--batch"]+[2015-12-27 00:15:58.250349] read: git ["config","--null","--list"]+[2015-12-27 00:15:58.250859] read: git ["config","--null","--list"]+[2015-12-27 00:15:58.253927] process done ExitSuccess+[2015-12-27 00:15:58.254538] chat: git ["--git-dir=../../.git","--work-tree=../..","--literal-pathspecs","check-attr","-z","--stdin","annex.backend","annex.numcopies","--"]+[2015-12-27 00:15:58.255324] read: git ["--version"]+[2015-12-27 00:15:58.257803] process done ExitSuccess+drop stratohidrive 20150816_cccamp/DSC04537.ARW [2015-12-27 00:15:58.328068] chat: gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--decrypt"]+[2015-12-27 00:15:58.354229] process done ExitSuccess+failed+git-annex: drop: 1 failed+# End of transcript or log.+"""]]++### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)++As mentioned before, I am very, very happy with git-annex :-) Discovery of 2015 for me.
+ doc/bugs/info_--json_lists_backend_usage_stats_as_a_list_of_lists.mdwn view
@@ -0,0 +1,34 @@+### What version of git-annex are you using? On what operating system?++5.20151116+gitg5416a1a-1~ndall+1++### Please provide any additional information below.++[[!format sh """+    "backend usage": [+        [+            "MD5E",+            2+        ],+        [+            "SHA256E",+            2+        ]+    ],+"""]]++instead of more logical++[[!format sh """++    "backend usage": {+         "MD5E": 2,+         "SHA256E": 2+    }+"""]]++also it seems it just doubles them since I have only 2 files, 1 for each backend (as reported also by info "local annex keys": 2). ++[[!meta author=yoh]]++> [[fixed|done]] --[[Joey]]
+ doc/bugs/slash_in_metadata_breaks_field__61____42___view.mdwn view
@@ -0,0 +1,42 @@+### Please describe the problem.++When using the metadata driven view fields values that contain a slash break the view field=* functionality++### What steps will reproduce the problem?++    $ git annex metadata --set test=a/b file.tex+    $ git annex view test=*    +    view  (searching...) +    git-annex: fd:13: commitBuffer: invalid argument (invalid character)+    failed+    git-annex: view: 1 failed++    ++### What version of git-annex are you using? On what operating system?++git-annex version: 5.20151218-g5008846 on ArchLinux+++### Please provide any additional information below.++To me it seems like this is only occuring during a field=* view.+Everywhere else the field value behaves normally, For example its possible to directly address the field value in a view without issue.++    $ git annex view test=a/b+    view  (searching...) +    Switched to branch 'views/(test=a/b)'+    ok+++I dont have any issues with non latin characters so this doesnt seem related to the locale issues in [https://git-annex.branchable.com/bugs/view_fails_with___34__invalid_character__34__/](https://git-annex.branchable.com/bugs/view_fails_with___34__invalid_character__34__/)++I was trying out the metadata extraction via libextractor and for the mimetype there often are slashes involved.+++### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)++Apart from this git-annex is working very well for me. I mostly use it as an archive, distributing numerous copies on various hard drives and cloud providers and keeping track of what is where.Its an amazing tool for that.+++> [[done]] --[[Joey]]
doc/design/caching_database.mdwn view
@@ -27,7 +27,8 @@  1. Store incremental fsck info in db, on a branch, with sqlite. **done** 2. Make sure that builds on all platforms, and works reliably. **done**-3. Use sqlite db for associated files cache, and use in direct mode.+3. Use sqlite db for associated files cache. **done** (only for v6 unlocked+   files) 4. Also, use associated files db to construct views. 5. Use sqlite db for metadata cache. 6. Use sqlite db for list of keys present in local annex.
doc/design/metadata.mdwn view
@@ -103,9 +103,8 @@ * Could use filename metadata for the key, recorded by git-annex add (which   may not correspond to filenames being used in regular git branches like   master for the key).-* Could use the .map files to get a filename, but this is somewhat-  arbitrary (.map can contain multiple filenames), and is only-  currently supported in direct mode.+* Could use the Keys database's associated files. Currently only works for v6+  unlocked files, and not for locked files. * Current approach: Have a reference branch (eg master) and walk it to   find filenames and   keys. Fine as long as it can be done efficiently. Also allows including@@ -144,26 +143,13 @@  TODO -# direct mode issues--TODO (direct mode is currently not supported with view branches)--Checking out a view branch can result in any number of copies of a file-appearing in different directories. No problem in indirect mode, but-in direct mode these are real, expensive copies.--But, it's worth supporting direct mode!+# unlocked file issues -So, possible approaches:+View branches can't be used in direct mode repositories. -* Before checking out a view branch, calculate how much space will-  be used by duplicates and refuse if not enough is free.-* Only check out one file, and omit the copies. Keep track of which-  files were omitted, and make sure that when committing on the branch,-  that metadata is not removed. Has the downside that files can seem-  to randomly move around in the tree as their metadata changes.-* Disallow view branch checkouts that have duplicate files.-  This would cripple it some, but perhaps not too badly?+But, view branches do work with unlocked files in v6 repositories.+The resulting view branch has all its files locked, although you+can unlock them again after entering the branch.  # gotchas
+ doc/devblog/day_336__green.mdwn view
@@ -0,0 +1,15 @@+Test suite is 100% green! Fixed one remaining bug it found, and solved the+strange sqlite crash, which turned out to be caused by the test suite deleting+its temporary repository before sqlite was done with the database inside it.++The only remaining blocker for using v6 unlocked files is a bad interaction+with shared clones. That should be easy to fix, so release of git-annex+version 6 is now not far away!++While I've only talked about v6/[[todo/smudge]] stuff here lately, I have been+fixing various other bugs along the way, and have accumulated a dozen bug+fixes since the last release. Earlier this week I fixed a bug in `git annex+unused`. Yesterday I noticed that `git annex migrate` didn't copy over+metadata. Today, fixed a crash of `git annex view` in a non-unicode locale.+Etc. So it'll be good not to have the release blocked any longer by v6+stuff.
+ doc/devblog/day_348__v6_assistant.mdwn view
@@ -0,0 +1,8 @@+Today was mostly spent making the assistant support v6 repositories.+That was harder than expected, because I have not touched this part of the+assistant's code much in a long time, and there are lots of tricky races+and edge cases to deal with.++The smudge branch has a 4500 diff from master now. Not counting+documentation changes (Another 500 lines.) The todo list for it is+shrinking slowly now. May not get it done before the new year.
+ doc/devblog/day_349__v6_database_optimisation.mdwn view
@@ -0,0 +1,7 @@+Got unexpectedly far today on optimising the database that v6 repositories+use to keep track of unlocked files. The database schema may still need+optimization, but everything else to do with the database is optimised.+Writes to the database are queued together. And reads to the database+avoid creating the database if it doesn't exist yet. Which means v5+repos, and v6 repos with no unlocked files will avoid any database+overhead.
+ doc/devblog/day_350-351__it_landed_on_xmas_eve.mdwn view
@@ -0,0 +1,9 @@+If you've got some free holiday time, the v6 repository mode is now+available in many of the daily builds, and there's documentation at+[[tips/unlocked_files]]. It would be very useful now if you can give+it a try. Use a clone or new repository for safety.++Yesterday I checked all parts of the code that special case direct mode,+and found a few things that needed adjusting for v6 unlocked files. Today,+I added the annex.thin config. Around 4 other major todo items need to be+dealt with before this is ready for more than early adopters.
+ doc/devblog/day_352__had_to_be_done.mdwn view
@@ -0,0 +1,3 @@+Automatic merge conflict resolver updated to work with unlocked files in v6+repos. Fairly tricky and painful; thank goodness the test suite tests a lot+of edge cases in that code.
+ doc/devblog/day_353__one_step_forward_and_N_steps_back.mdwn view
@@ -0,0 +1,5 @@+Got the test suite passing 100%, but then added a pass that uses v6+unlocked files and 30-some more failures appeared. Fixed a couple of the+bugs today. After sprinting unexpectedly hard all December on v6, I need a+change of pace, so I started digging into the website message backlog+and fixed some bugs and posted some comments there.
+ doc/devblog/day_354-355__beating_on_the_test_suite.mdwn view
@@ -0,0 +1,8 @@+Been working hard on the last several test suite failures for v6 unlocked+files. Now I've solved almost all of them, which is a big improvement to+my confidence in its (almost) correctness.++Frustratingly, the test suite is still not green after all this work.+There's some kind of intermittent failure related to the sqlite database.+Only seems to happen when the test suite is running, and the error+message is simply "Error" which is making it hard to track down..
+ doc/devblog/day_356__benchmarking.mdwn view
@@ -0,0 +1,11 @@+Added `git annex benchmark` which uses the excellent Criterion to benchmark+parts of git-annex. What I'm interested in benchmarking right now is the+sqlite database that is used to manage v6 unlocked files, but having a+built-in benchmark will probably have other uses later.++The benchmark results were pretty good; queries from the database are+quite fast (60 microseconds warm cache) and scale well as the size increases.+I did find one scalability issue, which was fixed by adding another index+to the database. The kind of schema change that it's easy to make now, but+that would be a painful transition if it had to be done once this was in wide+use.
doc/direct_mode.mdwn view
@@ -9,6 +9,13 @@  [[!toc]] +## deprecated++Direct mode is deprecated! Intead, git-annex v6 repositories can simply+have files that are unlocked and thus can be directly accessed and+modified. See [[upgrades]] for details about the transition to v6+repositories.+ ## enabling (and disabling) direct mode  Normally, git-annex repositories start off in indirect mode. With some
+ doc/forum/How_to_revert_metadata_changes.mdwn view
@@ -0,0 +1,25 @@+Hi,++I accidentally changed some metadata tags for all annexed files in a directory (by omitting the filename to the git annex metadata call). How can I revert that change?++I tried a git reset --hard on the git-annex branch, but after checking out master and adding a new file the changes magically reappeared.++git-annex version: 5.20141125++To reproduce do:++    git init; git annex init+    echo Hi > a.txt; git annex add a.txt+    git commit -m 'Initial add'+    git annex metadata --set name=bla+    git annex metadata --set name=blu+    git checkout git-annex+    git reset --hard HEAD^+    git checkout master+    git annex metadata a.txt # name=bla+    echo Huch > b.txt; git annex add b.txt+    git annex metadata a.txt # name=blu again++Cheers,++Markus
+ doc/forum/Integrating_annex_get_into_git_checkout_with_hooks.mdwn view
@@ -0,0 +1,7 @@+I am considering using git annex for an existing work project that is getting bloated with compressed tarballs. We have a team of 7, so making the annex invisible to day to day use is important.++Are there any git hooks that will make the process of git checkout/merge etc automatically do a git annex get ..., our do I have to write these myself?++++
+ doc/forum/Massive_drop_in_performance_with_--jobs_option.mdwn view
@@ -0,0 +1,9 @@+Old version:  5.20150916-1+New version:  5.20151208-1+++I have noticed that with the addition of the progress display, the actual overall performance of the transfer drop very noticeably from these two versions.  I am very tempted to keep the old version around to just handle the transfers.++Also, I decided to build a newer version from git, using debuild.  I noticed that the libghc-persistant dependencies have no trailing commas.  I added the commas, built the package and had two errors in one of the tests.  I removed these dependencies from the control file and I am currently performing a rebuild (they were not present in 12/08 version).++Build complete.  Tests passed.  Parallel transfers seem to be back up to speed.  Thanks!
+ doc/forum/Purge_whereis.mdwn view
@@ -0,0 +1,9 @@+Hey there,++I am playing around with git-annex to handle my files and backup's. Sometimes, I wish to delete a file entirely from my local repo and any other repo that contains the file.++First, I drop the file from my local repo and run git-annex sync --content. Then I run git annex whereis and drop the file from other repo's. Subsequently, I run git annex whereis to ensure that the file has been dropped and does not exist in any repo.++However, git annex still tracks the file, but I just have 0 copies of it. How do I remove/delete/disable tracking of a single file or multiple files?++The reason why I have deleted the file is that I don't want it in any of my repo's any longer.
+ doc/forum/Purge_whereis/comment_1_89d2446e3c9a58ab7b2a85ff941f7c8d._comment view
@@ -0,0 +1,9 @@+[[!comment format=mdwn+ username="cbaines"+ subject="comment 1"+ date="2015-12-21T12:32:55Z"+ content="""+If you want to stop tracking a file, just delete it, and then run git annex sync.++There are some other commands (and settings in the assistant) for managing unused content. That is, files in the annex that are no longer referenced/used.+"""]]
+ doc/forum/Purge_whereis/comment_2_0307ce47de9b719adc2096600d94dff6._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="frost.kristian@75a6b6a25121f985cd8708f98c691d41716ac720"+ nickname="frost.kristian"+ subject="comment 2"+ date="2015-12-21T13:08:49Z"+ content="""+It seems I have to enable syncing from the webapp. I thought doing git annex sync would do the same?+"""]]
+ doc/forum/Purge_whereis/comment_3_e87b53ebbf8053bb17caeb2aed871212._comment view
@@ -0,0 +1,7 @@+[[!comment format=mdwn+ username="cbaines"+ subject="comment 3"+ date="2015-12-21T13:33:34Z"+ content="""+I just did a quick test, running git annex sync does commit the removal of files for me.+"""]]
+ doc/forum/Purge_whereis/comment_4_72b6c28d8a4865ad8c84b1f7dfefb78a._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="frost.kristian@75a6b6a25121f985cd8708f98c691d41716ac720"+ nickname="frost.kristian"+ subject="comment 4"+ date="2015-12-21T17:47:13Z"+ content="""+I did some digging. When creating a repo from the webapp, it is per default in direct mode. In direct mode, I am not able to run any git commands such as git commit. Subsequently, when running git annex sync. Files added when sync is disabled from the webapp are not committed.++Is git-annex behaving as expected here?+"""]]
+ doc/forum/Purge_whereis/comment_5_966e0285639a41ee9db3e9fb337e2699._comment view
@@ -0,0 +1,11 @@+[[!comment format=mdwn+ username="joey"+ subject="""comment 5"""+ date="2016-01-01T20:35:18Z"+ content="""+Described behavior sounds right to me. If you've clicked on "syncing+enabled" in the webapp for the local repository, so it's changed to+"syncing disabled" then the webapp won't automatically commit file+deletions/adds. Click on it again and it'll catch up with any changes you+made while it was disabled.+"""]]
+ doc/forum/Reusing_existing_annex.uuid.mdwn view
@@ -0,0 +1,27 @@+I recently replaced a disk that was failing with a new disk. Rather than just clone and create a new remote, I decided I'd reuse the existing anex.uuid, since I wanted to mount the replacement disk in the same spot/using the same name as before. The annex.uuid was the one I saw [here](http://git-annex.branchable.com/forum/Truly_purging_dead_repositories/#comment-b89d6a7ab50180c901f53761f8a1a99d). ++I have multiple disks that I store full copies of each of my repositories on; several are just regular git-annex remotes, and some are gcrypt remotes. All of them are local disks. ++When I ran a `git annex sync` in the repo with the reused UUID, the repo, and subsequently the other non-encrypted repos that I synced to, have lost knowledge of the encrypted repos, e.g. when I run `git-annex info`, I do not see the encrypted repos in that list. Even more strangely, this only happened in 2 out of 7 repos; 5 of the repos retained the knowledge of the gcrypt repos. ++The steps I used to recreate all of the repos was:++```+mkdir resued-uuid+cd reused-uuid+git init+git config annex.uuid xxxxxxxxxxx-xxxxxxxx-xxxxxxxxx+git annex init "My reused uuid repo"+git annex fsck (as directed to run in the linked comment, but this didn't do anything because there were no files in the repo and the repo did not have other repos' remotes added to it)+git remote add existing-repo ~/some/repo/path+git annex sync+git annex sync --content (all content copied over; subsequent fscks' don't reveal any damaged files)+```++I'm curious as to any insight as to why this might have happened and what went wrong.++How can I add existing gcrypt remotes to the repos that are missing them.++Does git annex copy some part of .git/config around to different repos?  ++Can I just copy part of a .git/config with the grcrypt remotes listed there and sync them up?
+ doc/forum/__34__git_annex_get__34___on_windows_fails_with_rsync_error.mdwn view
@@ -0,0 +1,20 @@+I tried cloning an annex repo between two drives "c:" and "d:". The part with "git clone" itself works, but when I try to execute "git annex get", rsync reports an error about a missing path starting with "/cygdrive".++    Sameer@DESKTOP-6CJGO0T MINGW32 /d/a (annex/direct/master)+    $ git annex get --not --in here+    get world.txt (from origin...)+    rsync: change_dir "/cygdrive/c/scratch/a" failed: No such file or directory (2)+    rsync error: some files/attrs were not transferred (see previous errors) (code 23) at main.c(1183) [sender=3.1.1]+    +      rsync failed -- run git annex again to resume file transfer+    +      Unable to access these remotes: origin+    +      Try making some of these repositories available:+            cda3a2c6-7ddc-4164-ad6d-fbb2720b24d7 -- DESKTOP-6CJGO0T:C:\scratch\a [origin]+    failed+    git-annex: get: 1 failed++I am running git annex that was installed in the same directory as a 32-bit git version 2.6.4 for windows (mingw32).++The question is, my windows drives are actually visible as "/c" and "/a" ... then why is rsync searching for "/cygdrive/c" etc? This is clearly not a Cygwin installation.
+ doc/forum/basic_usage_questions.mdwn view
@@ -0,0 +1,5 @@+Seeking some clarification:++ 1. I'm using direct mode. When I run `git annex sync --content` on repo A, all files get copied to repo B, but they remain hidden under `.git/annex/objects`. Is there a way to _automatically_ put them in repo B's working tree, without having to go to repo B and run `git annex sync` there as well? _(I'm sure I saw that happen earlier, but not anymore?)_++ 1. I have two PCs and a portable HD. There are git-annex repos on PC_1 and USB_HD, with each other listed under `git remote`. Now I want to set up git-annex on PC_2. Is it okay to use the same repo path (~/Videos/) on both PCs? I'm concerned that it would confuse the USB_HD repo greatly, as it would end up having two "remotes" with identical paths.
+ doc/forum/files_vanishing.mdwn view
@@ -0,0 +1,12 @@+Can anybody help me locate content that seems to have gone missing? ++Setup is two repos, connected via ssh, both direct mode, both debian machines, repo A with 5.20150731-1 (testing), repo B with 5.20141125 (stable).++Both repos where synchronising (in this case transfering files from A to B), when I was copying a few more hundred files (second set) into a folder in repo A. In the webapp I have seen the assistant pick them up and transfer them to repo B. This took an hour or so, after which I can still see the name of nine files from the second set (and "... and 626 more") in the status messages on the right as added and the same number of files as uploaded.++Unfortunately, from the second set of files only the first two files can be found in A and B, none of the other few hundred.++Running git-annex fsck in repo A did not return any errors.++I would appreciate any pointers,+Felix
+ doc/forum/pushing_to_android.mdwn view
@@ -0,0 +1,1 @@+Dear git-annex community, I've just installed git-annex on my CyanogenMod phone. What I'd like to do is to synchronize my music folder from my desktop to my phone. I.e. I'm using [sshelper](http://arachnoid.com/android/SSHelper/index.html) to start OpenSSH server on the phone. The question is, how can I make git and git-annex available to SSHelper's shell so that I can git push to the phone?
doc/future_proofing.mdwn view
@@ -36,3 +36,10 @@   files end up in `lost+found`, they can easily be lifted back out into   another clone of the repository. Even if the filenames are lost,   it's possible to [[tips/recover_data_from_lost+found]].++* What about encrypted special remotes? A +  [[fairly simple shell script using standard tools|Decrypting_files_in_special_remotes_without_git-annex]]+  (gpg and openssl) can decrypt files stored on such+  a remote, as long as you have access to the encryption keys (which+  are stored in the git-annex branch of the repository, sometimes+  encrypted with your gpg key).
doc/git-annex-add.mdwn view
@@ -11,12 +11,18 @@ Adds files in the path to the annex. If no path is specified, adds files from the current directory and below. -Normally, files that are already checked into git, or that git has been-configured to ignore will be silently skipped.+Files that are already checked into git and are unmodified, or that+git has been configured to ignore will be silently skipped. -If annex.largefiles is configured, and does not match a file that is being-added, `git annex add` will behave the same as `git add` and add the-non-large file directly to the git repository, instead of to the annex.+If annex.largefiles is configured, and does not match a file, `git annex+add` will behave the same as `git add` and add the non-large file directly+to the git repository, instead of to the annex.++Large files are added to the annex in locked form, which prevents further+modification of their content unless unlocked by [[git-annex-unlock]](1).+(This is not the case however when a repository is in direct mode.)+To add a file to the annex in unlocked form, `git add` can be used instead +(that only works when the repository has annex.version 6 or higher).  This command can also be used to add symbolic links, both symlinks to annexed content, and other symlinks.
doc/git-annex-addurl.mdwn view
@@ -70,6 +70,24 @@   Enables parallel downloads when multiple urls are being added.   For example: `-J4`   +* `--batch`++  Enables batch mode, in which lines containing urls to add are read from+  stdin.++* `--with-files`++  When batch mode is enabled, makes it parse lines of the form: "$url $file"++  That adds the specified url to the specified file, downloading its+  content if the file does not yet exist; the same as+  `git annex addurl $url --file $file`++* `--json`++  Enable JSON output. This is intended to be parsed by programs that use+  git-annex. Each line of output is a JSON object.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-direct.mdwn view
@@ -17,11 +17,17 @@ run in direct mode repositories. Use `git annex proxy` to safely run such commands. +Note that the direct mode/indirect mode distinction is removed in v6+git-annex repositories. In such a repository, you can+use [[git-annex-unlock]](1) to make a file's content be directly present.+ # SEE ALSO  [[git-annex]](1)  [[git-annex-indirect]](1)++[[git-annex-unlock]](1)  # AUTHOR
doc/git-annex-fix.mdwn view
@@ -1,6 +1,6 @@ # NAME -git-annex fix - fix up symlinks to point to annexed content+git-annex fix - fix up links to annexed content  # SYNOPSIS @@ -11,8 +11,11 @@ Fixes up symlinks that have become broken to again point to annexed content. -This is useful to run if you have been moving the symlinks around,-but is done automatically when committing a change with git too.+This is useful to run manually when you have been moving the symlinks+around, but is done automatically when committing a change with git too.++Also, adjusts unlocked files to be copies or hard links as+configured by annex.thin.  # OPTIONS
+ doc/git-annex-importfeed/comment_1_d0197108d07873040e46577df1faadbd._comment view
@@ -0,0 +1,16 @@+[[!comment format=mdwn+ username="joseph.rawson.works@85a210ab8c0e37a0b2d6bb235738b20e23e8878f"+ nickname="joseph.rawson.works"+ subject="Replacing dashes with underscores"+ date="2015-12-28T22:39:49Z"+ content="""+An example rss item entry:++    <item><title>00135929509939-04</title><guid isPermaLink=\"false\">http://40.media.tumblr.com/01a46c39dc0e0f3447fbed4f0807047f/tumblr_nyoj75VlaG1sgxjc6o3_1280.jpg</guid><enclosure url=\"http://40.media.tumblr.com/01a46c39dc0e0f3447fbed4f0807047f/tumblr_nyoj75VlaG1sgxjc6o3_1280.jpg\" length=\"0\" type=\"\"/></item>++Using --template '${itemtitle}${extension}'++The resulting filename is **00135929509939_04.jpg** (The dash was replaced with an underscore).++I decided to just change all the filenames in each blog repository to use underscores, however, I thought you might want to know about this.+"""]]
+ doc/git-annex-importfeed/comment_2_25d4ed016e98609066597a8d2b956f87._comment view
@@ -0,0 +1,15 @@+[[!comment format=mdwn+ username="joey"+ subject="""comment 2"""+ date="2016-01-01T20:04:02Z"+ content="""+All spaces and punctuation (other than '.') and other wacky stuff are replaced with+'_' when git-annex builds a filename from some untrusted source like a+feed.++I think it makes sense to do that even for '-', at least if it's at the+start of a filename. "--force" is not a filename you want to let a feed+inject into your work tree. I could perhaps be convinced to let '-'+elsewhere in the filename through unmunged, but simplicity and consistency+suggests it's just as good to always munge it.+"""]]
+ doc/git-annex-importfeed/comment_3_bce2b233e4d42fc87a2e17d51e2c2606._comment view
@@ -0,0 +1,11 @@+[[!comment format=mdwn+ username="umeboshi"+ subject="comment 3"+ date="2016-01-02T21:02:51Z"+ content="""+I just thought it was surprising behavior, especially when ```git-annex addurl --file 123-45.ext $url``` preserves the dash in the filename, yet the rss I constructed to add multiple urls, with files, didn't do this.++The new ```--batch --with-files``` options to addurl will eliminate the need to create specially crafted rss files.++Thanks! :)+"""]]
doc/git-annex-indirect.mdwn view
@@ -11,9 +11,8 @@ Switches a repository back from direct mode to the default, indirect mode. -Some systems cannot support git-annex in indirect mode, because they-do not support symbolic links. Repositories on such systems instead-default to using direct mode.+Note that the direct mode/indirect mode distinction is removed in v6+git-annex repositories.  # SEE ALSO
doc/git-annex-init.mdwn view
@@ -24,6 +24,13 @@ This command is entirely safe, although usually pointless, to run inside an already initialized git-annex repository. +# OPTIONS++* `--version=N`++  Force the repository to be initialized using a different annex.version+  than the current default.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-lock.mdwn view
@@ -9,7 +9,7 @@ # DESCRIPTION  Use this to undo an unlock command if you don't want to modify-the files, or have made modifications you want to discard.+the files any longer, or have made modifications you want to discard.  # OPTIONS
doc/git-annex-pre-commit.mdwn view
@@ -12,9 +12,13 @@ automatically creates a pre-commit hook using this.  Fixes up symlinks that are staged as part of a commit, to ensure they-point to annexed content. Also handles injecting changes to unlocked-files into the annex. When in a view, updates metadata to reflect changes+point to annexed content.++When in a view, updates metadata to reflect changes made to files in the view.++When in a repository that has not been upgraded to annex.version 6, +also handles injecting changes to unlocked files into the annex.   # SEE ALSO
doc/git-annex-shell.mdwn view
@@ -107,7 +107,7 @@   on new dashed options).    Currently used fields include remoteuuid=, associatedfile=,-  direct=, and autoinit=+  unlocked=, direct=, and autoinit=  # HOOK
+ doc/git-annex-smudge.mdwn view
@@ -0,0 +1,43 @@+# NAME++git-annex smudge - git filter driver for git-annex++# SYNOPSIS++git annex smudge [--clean] file++# DESCRIPTION++This command lets git-annex be used as a git filter driver which lets+annexed files in the git repository to be unlocked at all times, instead+of being symlinks.++When adding a file with `git add`, the annex.largefiles config is+consulted to decide if a given file should be added to git as-is,+or if its content are large enough to need to use git-annex.++The git configuration to use this command as a filter driver is as follows.+This is normally set up for you by git-annex init, so you should+not need to configure it manually.++	[filter "annex"]+	        smudge = git-annex smudge %f+	        clean = git-annex smudge --clean %f++To make git use that filter driver, it needs to be configured in+the .gitattributes file or in `.git/config/attributes`. The latter+is normally configured when a repository is initialized, with the following+contents:++	* filter=annex+	.* !filter++# SEE ALSO++[[git-annex]](1)++# AUTHOR++Joey Hess <id@joeyh.name>++Warning: Automatically converted into a man page by mdwn2man. Edit with care.
doc/git-annex-sync.mdwn view
@@ -42,7 +42,7 @@  * `--commit`, `--no-commit` -  A commit is done by default. Use --no-cmmit to avoid committing local changes.+  A commit is done by default. Use --no-commit to avoid committing local changes.  * `--message=msg`
doc/git-annex-test.mdwn view
@@ -10,8 +10,7 @@  This runs git-annex's built-in test suite. -The test suite runs in the `.t` subdirectory of the current directory-(it refuses to run if `.t` already exists).+The test suite runs in the `.t` subdirectory of the current directory.  It can be useful to run the test suite on different filesystems, or to verify your local installation of git-annex.@@ -19,7 +18,12 @@ # OPTIONS        There are several options, provided by Haskell's tasty test-framework. Pass --help for details.+framework. Pass --help for details about those.++* `--keep-failures`++  When there are test failures, leave the `.t` directory populated with+  repositories that demonstate the failures, for later analysis.  # SEE ALSO
doc/git-annex-unlock.mdwn view
@@ -10,9 +10,25 @@  Normally, the content of annexed files is protected from being changed. Unlocking an annexed file allows it to be modified. This replaces the-symlink for each specified file with a copy of the file's content.-You can then modify it and `git annex add` (or `git commit`) to inject-it back into the annex.+symlink for each specified file with the file's content.+You can then modify it and `git annex add` (or `git commit`) to save your+changes.++In repositories with annex.version 5 or earlier, unlocking a file is local+to the repository, and is temporary. With version 6, unlocking a file+changes how it is stored in the git repository (from a symlink to a pointer+file), so you can commit it like any other change. Also in version 6, you+can use `git add` to add a fie to the annex in unlocked form. This allows+workflows where a file starts out unlocked, is modified as necessary, and+is locked once it reaches its final version.++Normally, unlocking a file requires a copy to be made of its content,+so that its original content is preserved, while the copy can be modified.+To use less space, annex.thin can be set to true; this makes a hard link+to the content be made instead of a copy. (Only when supported by the file+system, and only in repository version 6.) While this can save considerable+disk space, any modification made to a file will cause the old version of the+file to be lost from the local repository. So, enable annex.thin with care.  # OPTIONS
+ doc/git-annex-unused/comment_1_029c4bee59e48806c9f3d83579fdbb90._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="mark@6b90344cdab3158eacb94a3944460d138afc9bef"+ nickname="mark"+ subject="Special remotes"+ date="2016-01-08T21:12:45Z"+ content="""+Does this work for special remotes? Or only remotes that are full repositories?+"""]]
doc/git-annex.mdwn view
@@ -626,6 +626,14 @@    See [[git-annex-diffdriver]](1) for details. +* `smudge`++  This command lets git-annex be used as a git filter driver, allowing+  annexed files in the git repository to be unlocked at all times, instead+  of being symlinks.++  See [[git-annex-smudge]](1) for details.+ * `remotedaemon`    Detects when network remotes have received git pushes and fetches from them.@@ -664,6 +672,11 @@      See [[git-annex-fuzztest]](1) for details. +* `benchmark`++  This runs git-annex's built-in benchmarks, if it was built with+  benchmarking support.+ # COMMON OPTIONS  These common options are accepted by all git-annex commands, and@@ -895,6 +908,14 @@   When a repository is set up using `git clone --shared`, git-annex init   will automatically set annex.hardlink and mark the repository as   untrusted.++* `annex.thin`++  Set this to `true` to make unlocked files be a hard link to their content+  in the annex, rather than a second copy. (Only when supported by the file+  system, and only in repository version 6.) This can save considerable+  disk space, but modification made to a file will lose the local (and+  possibly only) copy of the old version. So, enable with care.  * `annex.delayadd`
+ doc/how_it_works/comment_3_806c0fe325942a425e43afb9b78327ec._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="G.nius.ck@d885edcfde63422ee84e5ee501b7aa545e91298d"+ nickname="G.nius.ck"+ subject="What do you mean by &quot;git-annex&quot; branch?"+ date="2016-01-09T16:04:29Z"+ content="""+Branches usually mean different versions of your repo, not entirely different content! Why are branches being used for this?+"""]]
+ doc/how_it_works/comment_4_0ef6b8c9dbd5a7f9b9f274dc6f9988f0._comment view
@@ -0,0 +1,9 @@+[[!comment format=mdwn+ username="joey"+ subject="""comment 4"""+ date="2016-01-11T16:21:00Z"+ content="""+A git branch can be used to name any tree ref. In this case we're using+"git-annex" as the name of a branch that is not connected to the rest of+the content in the repository.+"""]]
doc/install.mdwn view
@@ -20,8 +20,6 @@ [[Windows]]                       | [download installer](https://downloads.kitenet.net/git-annex/windows/current/) **beta** """]] -Note: [[todo/git-annex_in_debian_sid]] is somewhat outdated, which makes the above Debian and Ubuntu release not quite up to date. The [NeuroDebian team](http://neuro.debian.net/) provides a [standalone build package](http://neuro.debian.net/pkgs/git-annex-standalone.html) that is regularly updated and that should work across all releases of Ubuntu and Debian. See [[todo/git-annex-standalone_Debian_package/]] for more information.- All the download links above use https for security. For added security, see [[verifying_downloads]].
doc/install/Debian.mdwn view
@@ -22,3 +22,11 @@ Follow the instructions to [enable backports](http://backports.debian.org/Instructions/).  	sudo apt-get -t squeeze-backports install git-annex++## backport++If the version shipped with Debian is too old, +the [NeuroDebian team](http://neuro.debian.net/) provides a+[standalone build package](http://neuro.debian.net/pkgs/git-annex-standalone.html)+that is regularly updated and that should work across all releases of+Debian.
doc/install/Ubuntu.mdwn view
@@ -42,3 +42,11 @@ Warning: The version of git-annex shipped in Ubuntu Oneiric had [a bug that prevents upgrades from v1 git-annex repositories](https://bugs.launchpad.net/ubuntu/+source/git-annex/+bug/875958). If you need to upgrade such a repository, get a newer version of git-annex.++## backport++If the version shipped with Ubuntu is too old, +the [NeuroDebian team](http://neuro.debian.net/) provides a+[standalone build package](http://neuro.debian.net/pkgs/git-annex-standalone.html)+that is regularly updated and that should work across all releases of+Ubuntu.
doc/internals.mdwn view
@@ -7,8 +7,8 @@ ### `.git/annex/objects/aa/bb/*/*`  This is where locally available file contents are actually stored.-Files added to the annex get a symlink checked into git that points-to the file content.+Files added to the annex get a symlink or pointer file checked into git,+that points to the file content.  First there are two levels of directories used for hashing, to prevent too many things ending up in any one directory.
− doc/news/version_5.20151102.mdwn 
@@ -1,14 +0,0 @@-git-annex 5.20151102 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * Use statvfs on OSX.-   * Symlink timestamp preservation code uses functions-     from unix-2.7.0 when available, which should be more portable.-   * enableremote: List uuids and descriptions of remotes that can be-     enabled, and accept either the uuid or the description in leu if the-     name.-   * Catch up with current git behavior when both repo and repo.git exist;-     it seems it now prefers repo in this case, although historically it may-     have preferred repo.git.-   * Fix failure to build with aws-0.13.0.-   * When built with aws-0.13.0, the S3 special remote can be used to create-     google nearline buckets, by setting storageclass=NEARLINE."""]]
+ doc/news/version_6.20160114.mdwn view
@@ -0,0 +1,58 @@+git-annex 6.20160114 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   "hexapodia as the key insight"+   * Added v6 repository mode, but v5 is still the default for now.+   * unlock, lock: In v6 mode, unlocking a file changes it from a symlink to a+     pointer file, and this change can be committed to the git repository.+     For details, see http://git-annex.branchable.com/tips/unlocked\_files/+   * The upgrade to version 6 is not done fully automatically yet, because+     upgrading a direct mode repository to version 6 will prevent old+     versions of git-annex from working in other clones of that repository.+     For details, see http://git-annex.branchable.com/upgrades/+   * init: --version parameter added to control which supported repository+     version to use.+   * init, upgrade: Configure .git/info/attributes to use git-annex+     as a smudge filter. In v6 repository mode, this makes git add+     add files to the annex in unlocked mode, unless overridden by+     annex.largefiles configuration.+   * assistant: In v6 mode, adds files in unlocked mode, so they can+     continue to be modified.+   * Added annex.thin setting, which makes unlocked files in v6 repositories+     be hard linked to their content, instead of a copy. This saves disk+     space but means any modification of an unlocked file will lose the local+     (and possibly only) copy of the old version.+   * Enable annex.thin by default on upgrade from direct mode to v6, since+     direct mode made the same tradeoff.+   * fix: Adjusts unlocked files as configured by annex.thin.+   * persistent-sqlite is now a hard build dependency, since v6 repository+     mode needs it.+   * status: On crippled filesystems, was displaying M for all annexed files+     that were present. Probably caused by a change to what git status+     displays in this situation. Fixed by treating files git thinks are+     modified the same as typechanged files.+   * addurl: Added --batch and --with-files options.+   * addurl: Support --json, particularly useful in --batch mode.+   * addurl: Refuse to overwrite any existing, non-annexed file.+   * Debian: Adjust build dependencies for webapp, DAV. Now available on+     mips, mipsel, but temporarily removed armel since build is failing+     there.+   * info: Fix "backend usage" numbers, which were counting present keys+     twice.+   * info --json: Improve json for "backend usage", using a nested object+     with fields for each backend instead of the previous weird nested lists.+     This may break existing parsers of this json output, if there were any.+   * whereis --json: Make url list be included in machine-parseable form.+   * test: Added --keep-failures option.+   * unused: Bug fix when a new file was added to the annex, and then+     removed (but not git rmed). git still has the add staged in this case,+     so the content should not be unused and was wrongly treated as such.+   * migrate: Copy over metadata to new key.+   * rekey: No longer copies over urls from the old to the new key.+     It makes sense for migrate to do that, but not for this low-level+     (and little used) plumbing command to.+   * view: Fix crash in non-unicode capable locale when entering a view+     of metadata containing a slash or backslash.+   * When annex.http-headers is used to set the User-Agent header, avoid+     sending User-Agent: git-annex+   * Windows: Fix rsync cross-drive hack to work with msys2 rsync.+     Thanks, Pieter Kitslaar."""]]
doc/publicrepos.mdwn view
@@ -33,5 +33,10 @@   git-annex repository using [the CDN](http://media.ccc.de/) of the German [CCC](http://www.ccc.de/).     Contains a lot of talks (mostly in German) held on events from the CCC as well as other stuff. +* [ifarchive](https://gitlab.com/umeboshi2/ifarchive.git)  +  A slightly outdated mirror of http://ifarchive.org.  Scripts should probably be written+  to update the archive regularly.++ This is a wiki -- add your own public repository to the list! See [[tips/centralized_git_repository_tutorial]].
+ doc/templates/note.mdwn view
@@ -0,0 +1,12 @@+[[!templatebody <<ENDBODY+<div class="notebox">+<TMPL_VAR text>+</div>+ENDBODY]]++Use this template to insert a note into a page. The note will be styled to+float to the right of other text on the page. This template has one+parameter:+<ul>+<li>`text` - the text to display in the note+</ul>
+ doc/tips/Accessing_files_in_bare_remotes_without_git-annex.mdwn view
@@ -0,0 +1,8 @@++git-annex is amazing for my large files backup necessities, but I am a bit scared for the long-term possibility of accessing data, without git-annex.++For this reason I have prepared a small Python tool that accesses the content of bare git-annex repositories. The tool retrieves the locations of a file, and the path to the file in the current annex. This works with the last v6 version of the git-annex format.++This is motivated by the fact that in the master branch the files are stores as links to .git/annex/objects/XX/YY/KEY/KEY (as it is correct for non-bare repos), while in the bare the files are stored in annex/objecst/ZZ/WW/KEY/KEY.++The source code is available here: <https://gist.github.com/eruffaldi/924f6b53a63dede6e59f>
+ doc/tips/Decrypting_files_in_special_remotes_without_git-annex.mdwn view
@@ -0,0 +1,123 @@+One of the selling points of `git-annex` is that it uses standard tools like `git` and `gpg` to deal with files, so that years from now it should be possible to explore and get useful data out of an old annex repository (this helps with [[future_proofing]]). If for whatever reason you need to decrypt files on [[special_remotes]] that use [[encryption]] without using `git-annex`, this can be done fairly easily using `gpg` (and `openssl` to compute the HMAC keys used to create the file names used on the special remote so you can look up the right file to decrypt). Here is an example script demonstrating how to compute the special remote file names and how to decrypt the special remote files.++    #!/usr/bin/env bash+    +    usage() {+    	echo "Usage: ga_decrypt.sh -r REMOTE [-k SYMLINK] [-d FILE]"+    	echo ""+    	echo "    Either lookups up key on REMOTE for annex file linked with SYMLINK"+    	echo "    or decrypts FILE encrypted for REMOTE."+    	echo ""+    	echo "    -r: REMOTE is special remote to use"+    	echo "    -k: SYMLINK is symlink in annex to print encrypted special remote key for"+    	echo "    -d: FILE is path to special remote file to decrypt to STDOUT"+    	echo ""+    	echo "NOTES: "+    	echo "    * Run in an indirect git annex repo."+    	echo "    * Must specify -k or -d."+    	echo "    * -k prints the key including the leading directory names used for a "+    	echo "       directory remote (even if REMOTE is not a directory remote)"+    	echo "    * -d works on a locally accessible file. It does not fetch a remote file"+    	echo "    * Must have gpg and openssl"+    }+    +    decrypt_cipher() {+    	cipher="$1"+    	echo "$(echo -n "$cipher" | base64 -d | gpg --decrypt --quiet)"+    }+    +    lookup_key() {+    	encryption="$1"+    	cipher="$2"+    	symlink="$3"+    +    	if [ "$encryption" == "hybrid" ] || [ "$encryption" == "pubkey" ]; then+    		cipher="$(decrypt_cipher "$cipher")"+    	fi+    +    	# Pull out MAC cipher from beginning of cipher+    	if [ "$encryption" = "hybrid" ] ; then+    		cipher="$(echo -n "$cipher" | head  -c 256 )"+    	elif [ "$encryption" = "shared" ] ; then+    		cipher="$(echo -n "$cipher" | base64 -d | tr -d '\n' | head  -c 256 )"+    	elif [ "$encryption" = "pubkey" ] ; then+    		# pubkey cipher includes a trailing newline which was stripped in+    		# decrypt_cipher process substitution step above+    		IFS= read -rd '' cipher < <( printf "$cipher\n" )+    	fi+    +    	annex_key="$(basename "$(readlink "$symlink")")"+    	hash="$(echo -n "$annex_key" | openssl dgst -sha1 -hmac "$cipher" | sed 's/(stdin)= //')"+    	key="GPGHMACSHA1--$hash"+    	checksum="$(echo -n $key | md5sum)"+    	echo "${checksum:0:3}/${checksum:3:3}/$key"+    }+    +    decrypt_file() {+    	encryption="$1"+    	cipher="$2"+    	file_path="$3"+    +    	if [ "$encryption" = "pubkey" ] ; then+    		gpg --quiet --decrypt "${file_path}"+    	else+    		if [ "$encryption" = "hybrid" ] ; then+    			cipher="$(decrypt_cipher "$cipher" | tail -c +257)"+    		elif [ "$encryption" = "shared" ] ; then+    			cipher="$(echo -n "$cipher" | base64 -d | tr -d '\n' | tail  -c +257 )"+    		fi+    		gpg --quiet --batch --passphrase "$cipher" --output - "${file_path}"+    	fi+    }+    +    main() {+    	OPTIND=1+    +    	mode=""+    	remote=""+    +    	while getopts "r:k:d:" opt; do+    		case "$opt" in+    			r)  remote="$OPTARG"+    				;;+    			k)  if [ -z "$mode" ] ; then+    					mode="lookup key"+    				else+    					usage+    					exit 2+    				fi+    				symlink="$OPTARG"+    				;;+    			d)  if [ -z "$mode" ] ; then+    					mode="decrypt file"+    				else+    					usage+    					exit 2+    				fi+    				file_path="$OPTARG"+    				;;+    		esac+    	done+    +    	if [ -z "$mode" ] || [ -z "$remote" ] ; then+    		usage+    		exit 2+    	fi+    +        shift $((OPTIND-1))+    +    	# Pull out config for desired remote name+    	remote_config="$(git show git-annex:remote.log | grep 'name='"$remote ")"+    +    	# Get encryption type and cipher from config+    	encryption="$(echo "$remote_config" | grep -oP 'encryption\=.*? ' | tr -d ' \n' | sed 's/encryption=//')"+    	cipher="$(echo "$remote_config" | grep -oP 'cipher\=.*? ' | tr -d ' \n' | sed 's/cipher=//')"+    +    	if [ "$mode" = "lookup key" ] ; then+    		lookup_key "$encryption" "$cipher" "$symlink"+    	elif [ "$mode" = "decrypt file" ] ; then+    		decrypt_file "$encryption" "$cipher" "${file_path}"+    	fi+    }++    main "$@"
+ doc/tips/unlocked_files.mdwn view
@@ -0,0 +1,147 @@+Normally, git-annex stores annexed files in the repository, locked down,+which prevents the content of the file from being modified.+That's a good thing, because it might be the only copy, you wouldn't+want to lose it in a fumblefingered mistake.++	# git annex add some_file+	add some_file+	# echo oops > some_file+	bash: some_file: Permission denied++Sometimes though you want to modify a file. Maybe once, or maybe+repeatedly. To modify a locked file, you have to first unlock it,+by running `git annex unlock`.++	# git annex unlock some_file+	# echo "new content" > some_file++Back before git-annex version 6, and its v6 repository mode, unlocking a file+like this was a transient thing. You'd modify it and then `git annex add` the+modified version to the annex, and finally `git commit`. The new version of+the file was then back to being locked.++	# git annex add some_file+	add some_file+	# git commit++But, that had some problems. The main one is that some users want to be able+to edit files repeatedly, without manually having to unlock them every time.+The [[direct_mode]] was made all files be unlocked all the time, but it+had many problems of its own.++## enter v6 mode++/!\ This is an experimental feature; see its [[todo_list|todo/smudge]]+for known issues.++This led to the v6 repository mode, which makes unlocked files remain+unlocked after they're committed, so you can keep changing them and+committing the changes whenever you'd like. It also lets you use more+normal git commands (or even interfaces on top of git) for handling+annexed files.++To get a repository into v6 mode, you can [[upgrade|upgrades]] it.+This will eventually happen automatically, but for now it's a manual process+(be sure to read [[upgrades]] before doing this):++	# git annex upgrade+	+Or, you can init a new repository in v6 mode.++	# git init+	# git annex init --version=6++## using it++Using a v6 repository is easy! Simply use regular git commands to add+and commit files. In a git-annex repository, git will use git-annex+to store the file contents, and the files will be left unlocked.++[[!template id=note text="""+Want `git add` to add some file contents to the annex, but store the contents of+smaller files in git itself? Configure annex.largefiles to match the former.++	git config annex.largefiles \+		"largerthan=100kb and not include=*.c"+"""]]++	# cp ~/my_cool_big_file .+	# git add my_cool_big_file+	# git commit -m "added my_cool_big_file to the annex"+	[master (root-commit) 92f2725] added my_cool_big_file to the annex+	 1 file changed, 1 insertion(+)+	  create mode 100644 my_cool_big_file+	# git annex find+	my_cool_big_file++You can make whatever modifications you want to unlocked files, and commit+your changes.++	# echo more stuff >> my_cool_big_file+	# git mv my_cool_big_file my_cool_bigger_file+	# git commit -a -m "some changes"+	[master 196c0e2] some changes+	 2 files changed, 1 insertion(+), 1 deletion(-)+	 delete mode 100644 my_cool_big_file+	 create mode 100644 my_cool_bigger_file++Under the hood, this uses git's [[todo/smudge]] filter interface, and+git-annex converts between the content of the big file and a pointer file,+which is what gets committed to git. ++A v6 repository can contain both locked and unlocked files. You can switch +a file back and forth using the `git annex lock` and `git annex unlock`+commands. This changes what's stored in git between a git-annex symlink+(locked) and a git-annex pointer file (unlocked). To add a file to+the repository in locked mode, use `git annex add`; to add a file in+unlocked mode, use `git add`.++## using less disk space++Unlocked files are handy, but they have one significant disadvantage+compared with locked files: They use more disk space.++While only one copy of a locked file has to be stored, often+two copies of an unlocked file are stored on disk. One copy is in+the git work tree, where you can use and modify it,+and the other is stashed away in `.git/annex/objects` (see [[internals]]).++The reason for that second copy is to preserve the old version of the file,+when you modify the unlocked file in the work tree. Being able to access+old versions of files is an important part of git after all!++That's a good safe default. But there are ways to use git-annex that+make the second copy not be worth keeping:++[[!template id=note text="""+When a [[direct_mode]] repository is upgraded, annex.thin is automatically+set, because direct mode made the same single-copy tradeoff.+"""]]++* When you're using git-annex to sync the current version of files acrosss+  devices, and don't care much about previous versions.+* When you have set up a backup repository, and use git-annex to copy+  your files to the backup.++In situations like these, you may want to avoid the overhead of the second+local copy of unlocked files. There's config setting for that.++	git config annex.thin true++After changing annex.thin, you'll want to fix up the work tree to+match the new setting:++	git annex fix++Note that setting annex.thin only has any effect on systems that support+hard links. Ie, not Windows, and not FAT filesystems.++## tradeoffs++Setting annex.thin can save a lot of disk space, but it's a tradeoff+between disk usage and safety. ++Keeping files locked is safer and also avoids using unnecessary+disk space, but trades off easy modification of files.++Pick the tradeoff that's right for you.
+ doc/todo/--batch_for_info.mdwn view
@@ -0,0 +1,3 @@+I guess as other commands which take separate files/keys as its argument(s), having --batch for info command would be of benefit++[[!meta author=yoh]]
doc/todo/ditch_yesod.mdwn view
@@ -3,7 +3,7 @@  * It's by far the largest use of TH in git-annex, and TH is of course very   painful for the android port, other builds like debian mips that don't-  currently support TH, etc.+  currently support TH, etc. (Update: mips does support it now, it seems!) * I think it's responsible for at least 50% of the executable size, and I   suspect a lot of that is unncessary bloat for parts of yesod that   git-annex doesn't really use.@@ -23,7 +23,7 @@  Game plan: -1. Uploadd a yesod-lucid to hackage. (done)+1. Upload a yesod-lucid to hackage. (done) 2. Get servant, lucid, maybe yesod-lucid, packaged in Debian 3. Start converting individual yesod Handler Html to Handler LucidHtml.    This will ditch the hamlet. This is by far the most work, but it can be
+ doc/todo/ditch_yesod/comment_1_976dcb99ebe30c02c9b223f19a67c875._comment view
@@ -0,0 +1,7 @@+[[!comment format=mdwn+ username="umeboshi"+ subject="Link to TH"+ date="2015-12-29T20:36:41Z"+ content="""+I had to google for [TH](https://wiki.haskell.org/Template_Haskell).  I'm posting this link for those who, like me, are less familiar with Haskell.+"""]]
doc/todo/smudge.mdwn view
@@ -1,8 +1,39 @@ git-annex should use smudge/clean filters. -----+### implementation todo list -Update: Currently, this does not look likely to work. In particular,+* Reconcile staged changes into the associated files database, whenever+  the database is queried. This is needed to handle eg:+  	git add largefile+	git mv largefile othername+	git annex move othername --to foo+	# fails to drop content from associated file othername,+	# because it doesn't know it has that name+	# git commit clears up this mess+* Dropping a smudged file causes git status (and git annex status)+  to show it as modified,  because the timestamp has changed. +  Getting a smudged file can also cause this.+  Upgrading a direct mode repo also leaves files in this state.+  User can use `git add` to clear it up, but better to avoid this,+  by updating stat info in the index.+  (May need to use libgit2 to do this efficiently, cannot find+  any plumbing except git-update-index, which is very inneficient for+  smudged files.)+* Crippled filesystem should cause all files to be transparently unlocked.+  Note that this presents problems when dealing with merge conflicts and+  when pushing changes committed in such a repo. Ideally, should avoid+  committing implicit unlocks, or should prevent such commits leaking out+  in pushes.++* Eventually (but not yet), make v6 the default for new repositories.+  Note that the assistant forces repos into direct mode; that will need to+  be changed then, and it should enable annex.thin instead.+* Later still, remove support for direct mode, and enable automatic+  v5 to v6 upgrades.++### historical notes++2013: Currently, this does not look likely to work. In particular, the clean filter needs to consume all stdin from git, which consists of the entire content of the file. It cannot optimise by directly accessing the file in the repository, because git may be cleaning a different@@ -19,7 +50,7 @@ >> that the index says are modified, so this is no longer a problem. >> --[[Joey]] -----+### background  The clean filter is run when files are staged for commit. So a user could copy any file into the annex, git add it, and git-annex's clean filter causes@@ -108,7 +139,7 @@ .. Are very important, otherwise a repo can't scale past the size of the smallest client's disk! -It would be nice if the smudge filter could hard link or symlink a work+It would be nice if the smudge filter could hard link a work tree file to the annex object.  But currently, the smudge filter can't modify the work tree file on its own@@ -134,7 +165,9 @@ file and asks the smudge filter to smudge the new filename.  So, copies need to be maintained in .git/annex/objects, though it's ok-to use hard links to the work tree files.+to use hard links to the work tree files. (Although somewhat unsafe+since modification of the file will lose the old version. annex.thin+setting can enable this.)  Even if hard links are used, smudge needs to output the content of an annexed file, which will result in duplication when merging in renames of@@ -158,7 +191,8 @@ Data:  * An annex pointer file has as its first line the git-annex key-  that it's standing in for. Subsequent lines of the file might+  that it's standing in for (prefixed with "annex/objects/", similar to+  an annex symlink target). Subsequent lines of the file might   be a message saying that the file's content is not currently available.   An annex pointer file is checked into the git repository the same way   that an annex symlink is checked in.@@ -177,8 +211,8 @@   the annex. Other files are passed through the smudge/clean as-is and   have their contents stored in git. -* annex.direct is repurposed to configure how the assistant adds files.-  When set to true, they're added unlocked.+* annex.direct is repurposed to configure how git-annex adds files.+  When set to false, it adds symlinks and when true it adds pointer files.  git-annex clean: @@ -190,21 +224,16 @@    Generate annex key from filename and content from stdin. -  Hard link .git/annex/objects to the file, if it doesn't already exist.-  (On platforms not supporting hardlinks, copy the file to-  .git/annex/objects.)+  Hard link (annex.thin) or copy .git/annex/objects to the file,+  if it doesn't already exist.    This is done to prevent losing the only copy of a file when eg   doing a git checkout of a different branch, or merging a commit that-  renames or deletes a file. But, no attempt is made to +  renames or deletes a file. But, with annex.thin no attempt is made to    protect the object from being modified. If a user wants to   protect object contents from modification, they should use-  `git annex add`, not `git add`, or they can `git annex lock` after adding,.--  There could be a configuration knob to cause a copy to be made to-  .git/annex/objects -- useful for those crippled filesystems. It might-  also drop that copy once the object gets uploaded to another repo ...-  But that gets complicated quickly.+  `git annex add`, not `git add`, or they can `git annex lock` after adding,+  or not enable annex.thin.    Update file map. @@ -232,15 +261,11 @@   transition repositories to using pointers, and a cleaner unlock/lock   for repos using symlinks. -  unlock will stage a pointer file, and will copy the content of the object-  out of .git/annex/objects to the work tree file. (Might want a --hardlink-  switch.)+  unlock will stage a pointer file, and will link the content of the object+  from .git/annex/objects to the work tree file.   -  lock will replace the current work tree file with the symlink, and stage it.-  Note that multiple work tree files could point to the same object.-  So, if the link count is > 1, replace the annex object with a copy of-  itself to break such a hard link. Always finish by locking down the-  permissions of the annex object.+  lock will replace the current work tree file with the symlink, and stage it,+  and lock down the permissions of the annex object.  #### file map @@ -248,7 +273,8 @@ seems useful to have, but in practice is not worthwhile.  Drop and get operations need to know what files in the work tree use a-given key in order to update the work tree.+given key in order to update the work tree. And, we don't want to+overwrite a work tree file if it's been modified when dropping or getting.  git-annex commands that look at annex symlinks to get keys to act on will need fall back to either consulting the file map, or looking at the staged@@ -275,13 +301,14 @@ * Is the smudge filter called at any other time? Seems unlikely but then   there could be situations with a detached work tree or such. * Does git call any useful hooks when removing a file from the work tree,-  or converting it to not be annexed?+  or converting it to not be annexed, or for `git mv` of an annexed file?   No!  From this analysis, any file map generated by the smudge/clean filters is necessary potentially innaccurate. It may list deleted files. It may or may not reflect current unstaged changes from the work tree. + Follows that any use of the file map needs to verify the info from it, and throw out bad cached info (updating the map to match reality).  @@ -306,17 +333,19 @@  annex.version changes to 6 -Upgrade should be handled automatically.+git config for filter.annex.smudge and filter.annex.clean is set up. -On upgrade, update .gitattributes with a stock configuration, unless-it already mentions "filter=annex".+.gitattributes is updated with a stock configuration,+unless it already mentions "filter=annex".  Upgrading a direct mode repo needs to switch it out of bare mode, and needs to run `git annex unlock` on all files (or reach the same result). So will need to stage changes to all annexed files.  When a repo has some clones indirect and some direct, the upgraded repo-will have all files unlocked, necessarily in all clones.+will have all files unlocked, necessarily in all clones. This happens+automatically, because when the direct repos are upgraded that causes the+files to be unlocked, while the indirect upgrades don't touch the files.  ----
doc/upgrades.mdwn view
@@ -43,6 +43,42 @@  The upgrade events, so far: +## v5 -> v6 (git-annex version 6.x)++The upgrade from v5 to v6 is handled manually. Run `git-annex upgrade`+perform the upgrade.++Warning: All places that a direct mode repository is cloned to should be +running git-annex version 6.x before you upgrade the repository.+This is necessary because the contents of the repository are changed+in the upgrade, and the old version of git-annex won't be able to+access files after the repo is upgraded.++This upgrade does away with the direct mode/indirect mode distinction.+A v6 git-annex repository can have some files locked and other files+unlocked, and all git and git-annex commands can be used on both locked and+unlocked files. (Although for locked files to work, the filesystem+must support symbolic links..)++The behavior of some commands changes in an upgraded repository:++* `git add` will add files to the annex, in unlocked mode, rather than+   adding them directly to the git repository. To cause some files to be+   added directly to git, you can configure `annex.largefiles`. For+   example:++   	git config annex.largefiles "largerthan=100kb and not (include=*.c or include=*.h)"++* `git annex unlock` and `git annex lock` change how the pointer to +  the annexed content is stored in git.++On upgrade, all files in a direct mode repository will be converted to+unlocked files. The upgrade will stage changes to all annexed files in+the git repository, which you can then commit.++If a repository has some clones using direct mode and some using indirect+mode, all the files will end up unlocked in all clones after the upgrade.+ ## v4 -> v5 (git-annex version 5.x)  The upgrade from v4 to v5 is handled
doc/walkthrough/modifying_annexed_files.mdwn view
@@ -19,10 +19,9 @@ (If you decide you don't need to modify the file after all, or want to discard modifications, just use `git annex lock`.) -When you `git commit`, git-annex's pre-commit hook will automatically-notice that you are committing an unlocked file, and add its new content-to the annex. The file will be replaced with a symlink to the new content,-and this symlink is what gets committed to git in the end.+When you `git commit` it will notice that you are committing an unlocked+file, add its new content to the annex, and a pointer to that content is+what gets committed to git.  	# echo "now smaller, but even cooler" > my_cool_big_file 	# git commit my_cool_big_file -m "changed an annexed file"@@ -30,15 +29,5 @@ 	[master 64cda67] changed an annexed file 	 1 files changed, 1 insertions(+), 1 deletions(-) -There is one problem with using `git commit` like this: Git wants to first-stage the entire contents of the file in its index. That can be slow for-big files (sorta why git-annex exists in the first place). So, the-automatic handling on commit is a nice safety feature, since it prevents-the file content being accidentally committed into git. But when working with-big files, it's faster to explicitly add them to the annex yourself-before committing.--	# echo "now smaller, but even cooler yet" > my_cool_big_file-	# git annex add my_cool_big_file-	add my_cool_big_file ok-	# git commit my_cool_big_file -m "changed an annexed file"+For more details on working with unlocked files vs the regular locked+files, see [[tips/unlocked_files]].
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20151218+Version: 6.20160114 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -37,12 +37,6 @@ Flag WebDAV   Description: Enable WebDAV support -Flag Inotify-  Description: Enable inotify support--Flag Dbus-  Description: Enable dbus support- Flag Assistant   Description: Enable git-annex assistant and watch command @@ -55,9 +49,6 @@ Flag Pairing   Description: Enable pairing -Flag XMPP-  Description: Enable notifications using XMPP- Flag DNS   Description: Enable the haskell DNS library for DNS lookup @@ -87,9 +78,6 @@ Flag Tahoe   Description: Enable the tahoe special remote -Flag DesktopNotify-  Description: Enable desktop environment notifications- Flag TorrentParser   Description: Use haskell torrent library to parse torrent files @@ -100,14 +88,14 @@   Description: Enable use of EKG to monitor git-annex as it runs (at http://localhost:4242/)   Default: False +Flag Benchmark+  Description: Enable benchmarking+  Default: False+ Flag network-uri   Description: Get Network.URI from the network-uri package   Default: True -Flag Database-  Description: Enable building with persistent for database use (disable to build on platforms not supporting TH)-  Default: True- Flag Cryptonite   Description: Use the cryptonite library, instead of the older cryptohash @@ -128,7 +116,8 @@    monad-control, transformers,    bloomfilter, edit-distance,    resourcet, http-conduit, http-client, http-types,-   time, old-locale+   time, old-locale,+   esqueleto, persistent-sqlite, persistent, persistent-template   CC-Options: -Wall   GHC-Options: -Wall -fno-warn-tabs   Extensions: PackageImports@@ -189,7 +178,7 @@     CPP-Options: -DWITH_ASSISTANT    if flag(Assistant)-    if os(linux) && flag(Inotify)+    if os(linux)       Build-Depends: hinotify       CPP-Options: -DWITH_INOTIFY     else@@ -210,14 +199,8 @@               C-Sources: Utility/libkqueue.c    if (os(linux))-    if flag(Dbus)-      Build-Depends: dbus (>= 0.10.7)-      CPP-Options: -DWITH_DBUS-  -    if flag(DesktopNotify)-      if flag(Dbus)-        Build-Depends: dbus (>= 0.10.3), fdo-notify (>= 0.3)-        CPP-Options: -DWITH_DESKTOP_NOTIFY -DWITH_DBUS_NOTIFICATIONS+    Build-Depends: dbus (>= 0.10.7), fdo-notify (>= 0.3)+    CPP-Options: -DWITH_DBUS -DWITH_DESKTOP_NOTIFY -DWITH_DBUS_NOTIFICATIONS    if flag(Android)     Build-Depends: data-endian@@ -249,7 +232,7 @@     Build-Depends: network-multicast, network-info     CPP-Options: -DWITH_PAIRING -  if flag(XMPP) && (! os(windows))+  if (! os(windows))     Build-Depends: network-protocol-xmpp, gnutls (>= 0.1.4), xml-types     CPP-Options: -DWITH_XMPP @@ -273,10 +256,6 @@     Build-Depends: torrent (>= 10000.0.0)     CPP-Options: -DWITH_TORRENTPARSER -  if flag(Database)-    Build-Depends: esqueleto, persistent-sqlite, persistent, persistent-template-    CPP-Options: -DWITH_DATABASE-   if flag(ConcurrentOutput)     Build-Depends: concurrent-output (>= 1.6)     CPP-Options: -DWITH_CONCURRENTOUTPUT@@ -285,6 +264,10 @@     Build-Depends: ekg     GHC-Options: -with-rtsopts=-T     CPP-Options: -DWITH_EKG+  +  if flag(Benchmark)+    Build-Depends: criterion, deepseq+    CPP-Options: -DWITH_BENCHMARK  source-repository head   type: git
man/git-annex-add.1 view
@@ -9,12 +9,18 @@ Adds files in the path to the annex. If no path is specified, adds files from the current directory and below. .PP-Normally, files that are already checked into git, or that git has been-configured to ignore will be silently skipped.+Files that are already checked into git and are unmodified, or that+git has been configured to ignore will be silently skipped. .PP-If annex.largefiles is configured, and does not match a file that is being-added, \fBgit annex add\fP will behave the same as \fBgit add\fP and add the-non\-large file directly to the git repository, instead of to the annex.+If annex.largefiles is configured, and does not match a file, git annex+add\fB will behave the same as \fPgit add and add the non\-large file directly+to the git repository, instead of to the annex.+.PP+Large files are added to the annex in locked form, which prevents further+modification of their content unless unlocked by git-annex\-unlock(1).+(This is not the case however when a repository is in direct mode.)+To add a file to the annex in unlocked form, \fBgit add\fP can be used instead +(that only works when the repository has annex.version 6 or higher). .PP This command can also be used to add symbolic links, both symlinks to annexed content, and other symlinks.
man/git-annex-addurl.1 view
@@ -61,6 +61,21 @@ Enables parallel downloads when multiple urls are being added. For example: \fB\-J4\fP   .IP+.IP "\fB\-\-batch\fP"+Enables batch mode, in which lines containing urls to add are read from+stdin.+.IP+.IP "\fB\-\-with\-files\fP"+When batch mode is enabled, makes it parse lines of the form: "$url $file"+.IP+That adds the specified url to the specified file, downloading its+content if the file does not yet exist; the same as+\fBgit annex addurl $url \-\-file $file\fP+.IP+.IP "\fB\-\-json\fP"+Enable JSON output. This is intended to be parsed by programs that use+git-annex. Each line of output is a JSON object.+.IP .SH SEE ALSO git-annex(1) .PP
man/git-annex-direct.1 view
@@ -15,10 +15,16 @@ run in direct mode repositories. Use \fBgit annex proxy\fP to safely run such commands. .PP+Note that the direct mode/indirect mode distinction is removed in v6+git-annex repositories. In such a repository, you can+use git-annex\-unlock(1) to make a file's content be directly present.+.PP .SH SEE ALSO git-annex(1) .PP git-annex\-indirect(1)+.PP+git-annex\-unlock(1) .PP .SH AUTHOR Joey Hess <id@joeyh.name>
man/git-annex-fix.1 view
@@ -1,6 +1,6 @@ .TH git-annex-fix 1 .SH NAME-git-annex-fix \- fix up symlinks to point to annexed content+git-annex-fix \- fix up links to annexed content .PP .SH SYNOPSIS git annex fix \fB[path ...]\fP@@ -9,8 +9,11 @@ Fixes up symlinks that have become broken to again point to annexed content. .PP-This is useful to run if you have been moving the symlinks around,-but is done automatically when committing a change with git too.+This is useful to run manually when you have been moving the symlinks+around, but is done automatically when committing a change with git too.+.PP+Also, adjusts unlocked files to be copies or hard links as+configured by annex.thin. .PP .SH OPTIONS .IP "file matching options"
man/git-annex-indirect.1 view
@@ -9,9 +9,8 @@ Switches a repository back from direct mode to the default, indirect mode. .PP-Some systems cannot support git-annex in indirect mode, because they-do not support symbolic links. Repositories on such systems instead-default to using direct mode.+Note that the direct mode/indirect mode distinction is removed in v6+git-annex repositories. .PP .SH SEE ALSO git-annex(1)
man/git-annex-init.1 view
@@ -22,6 +22,12 @@ This command is entirely safe, although usually pointless, to run inside an already initialized git-annex repository. .PP+.SH OPTIONS+.IP "\fB\-\-version=N\fP"+.IP+Force the repository to be initialized using a different annex.version+than the current default.+.IP .SH SEE ALSO git-annex(1) .PP
man/git-annex-lock.1 view
@@ -7,7 +7,7 @@ .PP .SH DESCRIPTION Use this to undo an unlock command if you don't want to modify-the files, or have made modifications you want to discard.+the files any longer, or have made modifications you want to discard. .PP .SH OPTIONS .IP "file matching options"
man/git-annex-pre-commit.1 view
@@ -10,9 +10,13 @@ automatically creates a pre\-commit hook using this. .PP Fixes up symlinks that are staged as part of a commit, to ensure they-point to annexed content. Also handles injecting changes to unlocked-files into the annex. When in a view, updates metadata to reflect changes+point to annexed content.+.PP+When in a view, updates metadata to reflect changes made to files in the view.+.PP+When in a repository that has not been upgraded to annex.version 6, +also handles injecting changes to unlocked files into the annex.  .PP .SH SEE ALSO git-annex(1)
man/git-annex-shell.1 view
@@ -91,7 +91,7 @@ on new dashed options). .IP Currently used fields include remoteuuid=, associatedfile=,-direct=, and autoinit=+unlocked=, direct=, and autoinit= .IP .SH HOOK After content is received or dropped from the repository by git-annex\-shell,
man/git-annex-sync.1 view
@@ -38,7 +38,7 @@ Only sync with the remotes with the lowest annex\-cost value configured. .IP .IP "\fB\-\-commit\fP, \fB\-\-no\-commit\fP"-A commit is done by default. Use \-\-no\-cmmit to avoid committing local changes.+A commit is done by default. Use \-\-no\-commit to avoid committing local changes. .IP .IP "\fB\-\-message=msg\fP" Use this option to specify a commit message.
man/git-annex-test.1 view
@@ -8,16 +8,19 @@ .SH DESCRIPTION This runs git-annex's built\-in test suite. .PP-The test suite runs in the \fB.t\fP subdirectory of the current directory-(it refuses to run if \fB.t\fP already exists).+The test suite runs in the \fB.t\fP subdirectory of the current directory. .PP It can be useful to run the test suite on different filesystems, or to verify your local installation of git-annex. .PP .SH OPTIONS There are several options, provided by Haskell's tasty test-framework. Pass \-\-help for details.+framework. Pass \-\-help for details about those. .PP+.IP "\fB\-\-keep\-failures\fP"+When there are test failures, leave the \fB.t\fP directory populated with+repositories that demonstate the failures, for later analysis.+.IP .SH SEE ALSO git-annex(1) .PP
man/git-annex-unlock.1 view
@@ -8,9 +8,25 @@ .SH DESCRIPTION Normally, the content of annexed files is protected from being changed. Unlocking an annexed file allows it to be modified. This replaces the-symlink for each specified file with a copy of the file's content.-You can then modify it and \fBgit annex add\fP (or \fBgit commit\fP) to inject-it back into the annex.+symlink for each specified file with the file's content.+You can then modify it and \fBgit annex add\fP (or \fBgit commit\fP) to save your+changes.+.PP+In repositories with annex.version 5 or earlier, unlocking a file is local+to the repository, and is temporary. With version 6, unlocking a file+changes how it is stored in the git repository (from a symlink to a pointer+file), so you can commit it like any other change. Also in version 6, you+can use \fBgit add\fP to add a fie to the annex in unlocked form. This allows+workflows where a file starts out unlocked, is modified as necessary, and+is locked once it reaches its final version.+.PP+Normally, unlocking a file requires a copy to be made of its content,+so that its original content is preserved, while the copy can be modified.+To use less space, annex.thin can be set to true; this makes a hard link+to the content be made instead of a copy. (Only when supported by the file+system, and only in repository version 6.) While this can save considerable+disk space, any modification made to a file will cause the old version of the+file to be lost from the local repository. So, enable annex.thin with care. .PP .SH OPTIONS .IP "file matching options"
man/git-annex.1 view
@@ -537,6 +537,13 @@ .IP See git-annex\-diffdriver(1) for details. .IP+.IP "\fBsmudge\fP"+This command lets git-annex be used as a git filter driver, allowing+annexed files in the git repository to be unlocked at all times, instead+of being symlinks.+.IP+See git-annex\-smudge(1) for details.+.IP .IP "\fBremotedaemon\fP" Detects when network remotes have received git pushes and fetches from them. .IP@@ -570,6 +577,10 @@ .IP See git-annex\-fuzztest(1) for details. .IP+.IP "\fBbenchmark\fP"+This runs git-annex's built\-in benchmarks, if it was built with+benchmarking support.+.IP .SH COMMON OPTIONS These common options are accepted by all git-annex commands, and may not be explicitly listed on their individual man pages.@@ -771,6 +782,13 @@ When a repository is set up using \fBgit clone \-\-shared\fP, git-annex init will automatically set annex.hardlink and mark the repository as untrusted.+.IP+.IP "\fBannex.thin\fP"+Set this to \fBtrue\fP to make unlocked files be a hard link to their content+in the annex, rather than a second copy. (Only when supported by the file+system, and only in repository version 6.) This can save considerable+disk space, but modification made to a file will lose the local (and+possibly only) copy of the old version. So, enable with care. .IP .IP "\fBannex.delayadd\fP" Makes the watch and assistant commands delay for the specified number of
stack.yaml view
@@ -3,30 +3,25 @@     concurrentoutput: true     tahoe: true     tdfa: true-    inotify: true     feed: true-    database: true     webapp-secure: true     production: true-    ekg: false     assistant: true     pairing: true     cryptonite: true-    xmpp: false     network-uri: true     s3: true-    dbus: false     testsuite: true     webdav: true     torrentparser: true-    android: false-    androidsplice: false     quvi: true     dns: true-    desktopnotify: true     webapp: true+    android: false+    androidsplice: false+    ekg: false packages: - '.' extra-deps:-- Win32-extras-0.2.0.1-resolver: lts-3.7+- concurrent-output-1.7.2+resolver: nightly-2015-12-28
standalone/no-th/evilsplicer-headers.hs view
@@ -6,6 +6,7 @@  - ** DO NOT COMMIT **   -} import qualified Data.Monoid+import qualified Control.Applicative import qualified Data.Set import qualified Data.Set as Data.Set.Base import qualified Data.Map