finish v6 support for assistant

Seems to basically work now!

Annex/Ingest.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE CPP #-}
 
 module Annex.Ingest (
+	LockedDown(..),
 	lockDown,
 	ingest,
 	finishIngestDirect,
@@ -33,7 +34,6 @@ import Annex.ReplaceFile
 import Utility.Tmp
 import Utility.CopyFile
 import Annex.InodeSentinal
-import Annex.Version
 #ifdef WITH_CLIBS
 #ifndef __ANDROID__
 import Utility.Touch
@@ -42,46 +42,42 @@ import Utility.Touch
 
 import Control.Exception (IOException)
 
+data LockedDown = LockedDown
+	{ lockingFile :: Bool
+	, keySource :: KeySource
+	}
+	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 a KeySource is returned. Its inodeCache can be used to detect any
+ - So, the InodeCache can be used to detect any changes that might be made
- - changes that might be made to the file after it was locked down.
+ - 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.
  -
+ - If the file is to be locked, lockingfile is True. Then the write
+ - bit is removed from the file as part of lock down to guard against
+ - further writes.
+ -
  - Lockdown can fail if a file gets deleted, and Nothing will be returned.
  -}
-lockDown :: FilePath -> Annex (Maybe KeySource)
+lockDown :: Bool -> FilePath -> Annex (Maybe LockedDown)
-lockDown = either 
+lockDown lockingfile file = either 
 		(\e -> warning (show e) >> return Nothing)
 		(return . Just)
-	<=< lockDown'
+	=<< lockDown' lockingfile file
 
-lockDown' :: FilePath -> Annex (Either IOException KeySource)
+lockDown' :: Bool -> FilePath -> Annex (Either IOException LockedDown)
-lockDown' file = ifM crippledFileSystem
+lockDown' lockingfile file = ifM crippledFileSystem
 	( withTSDelta $ liftIO . tryIO . nohardlink
 	, tryIO $ do
 		tmp <- fromRepo gitAnnexTmpMiscDir
 		createAnnexDirectory tmp
-		go tmp
+		when lockingfile $
-	)
-  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 $
@@ -89,9 +85,11 @@ lockDown' file = ifM crippledFileSystem
 			hClose h
 			nukeFile tmpfile
 			withhardlink delta tmpfile `catchIO` const (nohardlink delta)
+	)
+  where
 	nohardlink delta = do
 		cache <- genInodeCache file delta
-		return KeySource
+		return $ LockedDown lockingfile $ KeySource
 			{ keyFilename = file
 			, contentLocation = file
 			, inodeCache = cache
@@ -99,7 +97,7 @@ lockDown' file = ifM crippledFileSystem
 	withhardlink delta tmpfile = do
 		createLink file tmpfile
 		cache <- genInodeCache tmpfile delta
-		return KeySource
+		return $ LockedDown lockingfile $ KeySource
 			{ keyFilename = file
 			, contentLocation = tmpfile
 			, inodeCache = cache
@@ -107,12 +105,13 @@ lockDown' file = ifM crippledFileSystem
 
 {- Ingests a locked down file into the annex.
  -
- - In direct mode, leaves the file alone, and just updates bookkeeping
+ - The file may be added to the git repository as a locked or an unlocked
- - information.
+ - 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 KeySource -> Annex (Maybe Key, Maybe InodeCache)
+ingest :: Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache)
 ingest Nothing = return (Nothing, Nothing)
-ingest (Just source) = withTSDelta $ \delta -> do
+ingest (Just (LockedDown lockingfile source)) = withTSDelta $ \delta -> do
 	backend <- chooseBackend $ keyFilename source
 	k <- genKey source backend
 	let src = contentLocation source
@@ -123,43 +122,56 @@ ingest (Just source) = withTSDelta $ \delta -> do
 		(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
+	go (Just (key, _)) mcache (Just s)
-		( godirect k mcache ms
+		| lockingfile = golocked key mcache s
-		, goindirect k mcache ms
+		| otherwise = ifM isDirect
-		)
+			( godirect key mcache s
+			, gounlocked key mcache s
+			)
+	go _ _ _ = failure "failed to generate a key"
 
-	goindirect (Just (key, _)) mcache ms = do
+	golocked key mcache s = do
 		catchNonAsync (moveAnnex key $ contentLocation source)
 			(restoreFile (keyFilename source) key)
-		maybe noop (genMetaData key (keyFilename source)) ms
 		liftIO $ nukeFile $ keyFilename source
-		return (Just key, mcache)
+		success key mcache s
-	goindirect _ _ _ = failure "failed to generate a key"
 
-	godirect (Just (key, _)) (Just cache) ms = do
+	gounlocked key (Just cache) s = do
+		r <- linkAnnex key (keyFilename source) (Just cache)
+		case r of
+			LinkAnnexFailed -> failure "failed to link to annex"
+			_ -> success key (Just cache) s
+	gounlocked _ _ _ = failure "failed statting file"
+
+	godirect key (Just cache) s = do
 		addInodeCache key cache
-		maybe noop (genMetaData key (keyFilename source)) ms
 		finishIngestDirect key source
-		return (Just key, Just cache)
+		success key (Just cache) s
-	godirect _ _ _ = failure "failed to generate a key"
+	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
-		when (contentLocation source /= keyFilename source) $
+		cleanCruft 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) $
+	cleanCruft 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)
 
+cleanCruft :: KeySource -> Annex ()
+cleanCruft source = when (contentLocation source /= keyFilename source) $
+	liftIO $ nukeFile $ contentLocation source
+
 {- 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

Assistant/Threads/Committer.hs

@@ -266,10 +266,12 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 	let (pending, inprocess) = partition isPendingAddChange incomplete
 	direct <- liftAnnex isDirect
 	unlocked <- liftAnnex versionSupportsUnlockedPointers
+	let lockingfiles = not (unlocked || direct)
 	(pending', cleanup) <- if unlocked || direct
 		then return (pending, noop)
 		else findnew pending
-	(postponed, toadd) <- partitionEithers <$> safeToAdd havelsof delayadd pending' inprocess
+	(postponed, toadd) <- partitionEithers
+		<$> safeToAdd lockingfiles havelsof delayadd pending' inprocess
 	cleanup
 
 	unless (null postponed) $
@@ -278,9 +280,9 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 	returnWhen (null toadd) $ do
 		added <- addaction toadd $
 			catMaybes <$>
-				if unlocked || direct
+				if not lockingfiles
 					then addunlocked direct toadd
-					else forM toadd add
+					else forM toadd (add lockingfiles)
 		if DirWatcher.eventsCoalesce || null added || unlocked || direct
 			then return $ added ++ otherchanges
 			else do
@@ -307,16 +309,17 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 		| c = return otherchanges
 		| otherwise = a
 
-	add :: Change -> Assistant (Maybe Change)
+	add :: Bool -> Change -> Assistant (Maybe Change)
-	add change@(InProcessAddChange { keySource = ks }) = 
+	add lockingfile change@(InProcessAddChange { lockedDown = ld }) = 
 		catchDefaultIO Nothing <~> doadd
 	  where
+	  	ks = keySource ld
 		doadd = sanitycheck ks $ do
 			(mkey, mcache) <- liftAnnex $ do
 				showStart "add" $ keyFilename ks
-				ingest $ Just ks
+				ingest $ Just $ LockedDown lockingfile ks
 			maybe (failedingest change) (done change mcache $ keyFilename ks) mkey
-	add _ = return Nothing
+	add _ _ = return Nothing
 
 	{- Avoid overhead of re-injesting a renamed unlocked file, by
 	 - examining the other Changes to see if a removed file has the
@@ -329,29 +332,22 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 		m <- liftAnnex $ removedKeysMap isdirect ct cs
 		delta <- liftAnnex getTSDelta
 		if M.null m
-			then forM toadd add
+			then forM toadd (add False)
 			else forM toadd $ \c -> do
 				mcache <- liftIO $ genInodeCache (changeFile c) delta
 				case mcache of
-					Nothing -> add c
+					Nothing -> add False c
 					Just cache ->
 						case M.lookup (inodeCacheToKey ct cache) m of
-							Nothing -> add c
+							Nothing -> add False c
-							Just k -> if isdirect
+							Just k -> fastadd isdirect c k
-								then fastadddirect c k
-								else fastaddunlocked c k
 
-	fastadddirect :: Change -> Key -> Assistant (Maybe Change)
+	fastadd :: Bool -> Change -> Key -> Assistant (Maybe Change)
-	fastadddirect change key = do
+	fastadd isdirect change key = do
-		let source = keySource change
+		let source = keySource $ lockedDown change
-		liftAnnex $ finishIngestDirect key source
+		liftAnnex $ if isdirect
-		done change Nothing (keyFilename source) key
+			then finishIngestDirect key source
-	
+			else Database.Keys.addAssociatedFile key (keyFilename source)
-	fastaddunlocked :: Change -> Key -> Assistant (Maybe Change)
-	fastaddunlocked change key = do
-		let source = keySource change
-		liftAnnex $ do
-			Database.Keys.addAssociatedFile key (keyFilename source)
 		done change Nothing (keyFilename source) key
 
 	removedKeysMap :: Bool -> InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
@@ -419,16 +415,16 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
  -
  - Check by running lsof on the repository.
  -}
-safeToAdd :: Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
+safeToAdd :: Bool -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
-safeToAdd _ _ [] [] = return []
+safeToAdd _ _ _ [] [] = return []
-safeToAdd havelsof delayadd pending inprocess = do
+safeToAdd lockingfiles havelsof delayadd pending inprocess = do
 	maybe noop (liftIO . threadDelaySeconds) delayadd
 	liftAnnex $ do
-		keysources <- forM pending $ lockDown . changeFile
+		lockeddown <- forM pending $ lockDown lockingfiles . changeFile
-		let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending keysources)
+		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'
 
@@ -441,17 +437,18 @@ safeToAdd havelsof delayadd pending inprocess = do
 				allRight $ rights checked
 			else return checked
   where
-	check openfiles change@(InProcessAddChange { keySource = ks })
+	check openfiles change@(InProcessAddChange { lockedDown = ld })
-		| S.member (contentLocation ks) openfiles = Left change
+		| 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/Types/Changes.hs

@@ -10,6 +10,7 @@ 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
@@ -38,7 +39,7 @@ data Change
 		}
 	| InProcessAddChange
 		{ changeTime ::UTCTime
-		, keySource :: KeySource
+		, lockedDown :: LockedDown
 		}
 	deriving (Show)
 
@@ -53,7 +54,7 @@ changeInfoKey _ = Nothing
 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 +65,14 @@ isInProcessAddChange (InProcessAddChange {}) = True
 isInProcessAddChange _ = False
 
 retryChange :: Change -> Change
-retryChange (InProcessAddChange time ks) =
+retryChange c@(InProcessAddChange time _) =
-	PendingAddChange time (keyFilename ks)
+	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

Command/Add.hs

@@ -113,7 +113,9 @@ start file = ifAnnexed file addpresent add
 		next $ next $ cleanup file key Nothing =<< inAnnex key
 
 perform :: FilePath -> CommandPerform
-perform file = lockDown file >>= ingest >>= go
+perform file = do
+	lockingfile <- not <$> isDirect
+	lockDown lockingfile file >>= ingest >>= go
   where
 	go (Just key, cache) = next $ cleanup file key cache True
 	go (Nothing, _) = stop