add, import, assistant: Better preserve the mtime of symlinks, when when adding content that gets deduplicated.

Note that this turned out to remove a syscall, not add any expense.
Otherwise, I would not have done it.

Assistant/Threads/Committer.hs

@@ -319,10 +319,10 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 	add change@(InProcessAddChange { keySource = ks }) = 
 		catchDefaultIO Nothing <~> do
 			sanitycheck ks $ do
-				key <- liftAnnex $ do
+				(mkey, mcache) <- liftAnnex $ do
 					showStart "add" $ keyFilename ks
 					Command.Add.ingest $ Just ks
-				maybe (failedingest change) (done change $ keyFilename ks) key
+				maybe (failedingest change) (done change mcache $ keyFilename ks) mkey
 	add _ = return Nothing
 
 	{- In direct mode, avoid overhead of re-injesting a renamed
@@ -349,7 +349,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 	fastadd change key = do
 		let source = keySource change
 		liftAnnex $ Command.Add.finishIngestDirect key source
-		done change (keyFilename source) key
+		done change Nothing (keyFilename source) key
 
 	removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
 	removedKeysMap ct l = do
@@ -365,11 +365,11 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 		liftAnnex showEndFail
 		return Nothing
 
-	done change file key = liftAnnex $ do
+	done change mcache file key = liftAnnex $ do
 		logStatus key InfoPresent
 		link <- ifM isDirect
 			( inRepo $ gitAnnexLink file key
-			, Command.Add.link file key True
+			, Command.Add.link file key mcache
 			)
 		whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do
 			stageSymlink file =<< hashSymlink link

Command/Add.hs

@@ -77,7 +77,7 @@ start file = ifAnnexed file addpresent add
 		-- is present but not yet added to git
 		showStart "add" file
 		liftIO $ removeFile file
-		next $ next $ cleanup file key =<< inAnnex key
+		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
@@ -134,8 +134,8 @@ lockDown file = ifM crippledFileSystem
  - In direct mode, leaves the file alone, and just updates bookkeeping
  - information.
  -}
-ingest :: Maybe KeySource -> Annex (Maybe Key)
+ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache)
-ingest Nothing = return Nothing
+ingest Nothing = return (Nothing, Nothing)
 ingest (Just source) = do
 	backend <- chooseBackend $ keyFilename source
 	k <- genKey source backend
@@ -147,24 +147,24 @@ ingest (Just source) = do
   where
 	go k cache = ifM isDirect ( godirect k cache , goindirect k cache )
 
-	goindirect (Just (key, _)) _ = do
+	goindirect (Just (key, _)) mcache = do
 		catchAnnex (moveAnnex key $ contentLocation source)
 			(undo (keyFilename source) key)
 		liftIO $ nukeFile $ keyFilename source
-		return $ Just key
+		return $ (Just key, mcache)
 	goindirect Nothing _ = failure "failed to generate a key"
 
 	godirect (Just (key, _)) (Just cache) = do
 		addInodeCache key cache
 		finishIngestDirect key source
-		return $ Just key
+		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		
+		return (Nothing, Nothing)
 
 finishIngestDirect :: Key -> KeySource -> Annex ()
 finishIngestDirect key source = do
@@ -178,9 +178,10 @@ finishIngestDirect key source = do
 		addContentWhenNotPresent key (keyFilename source)
 
 perform :: FilePath -> CommandPerform
-perform file = 
+perform file = lockDown file >>= ingest >>= go
-	maybe stop (\key -> next $ cleanup file key True)
+  where
-		=<< ingest =<< lockDown file
+  	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. -}
@@ -199,18 +200,17 @@ undo file key e = do
 		liftIO $ moveFile src file
 
 {- Creates the symlink to the annexed content, returns the link target. -}
-link :: FilePath -> Key -> Bool -> Annex String
+link :: FilePath -> Key -> Maybe InodeCache -> Annex String
-link file key hascontent = flip catchAnnex (undo file key) $ do
+link file key mcache = flip catchAnnex (undo file key) $ do
 	l <- inRepo $ gitAnnexLink file key
 	replaceFile file $ makeAnnexLink l
 
 #ifndef __ANDROID__
-	when hascontent $
+	-- touch symlink to have same time as the original file,
-		-- touch the symlink to have the same mtime as the
+	-- as provided in the InodeCache
-		-- file it points to
+	case mcache of
-		liftIO $ do
+		Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
-			mtime <- modificationTime <$> getFileStatus file
+		Nothing -> noop
-			touch file (TimeSpec mtime) False
 #endif
 
 	return l
@@ -224,28 +224,28 @@ link file key hascontent = flip catchAnnex (undo file key) $ do
  - Also, using git add allows it to skip gitignored files, unless forced
  - to include them.
  -}
-addLink :: FilePath -> Key -> Bool -> Annex ()
+addLink :: FilePath -> Key -> Maybe InodeCache -> Annex ()
-addLink file key hascontent = ifM (coreSymlinks <$> Annex.getGitConfig)
+addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)
 	( do
-		_ <- link file key hascontent
+		_ <- link file key mcache
 		params <- ifM (Annex.getState Annex.force)
 			( return [Param "-f"]
 			, return []
 			)
 		Annex.Queue.addCommand "add" (params++[Param "--"]) [file]
 	, do
-		l <- link file key hascontent
+		l <- link file key mcache
 		addAnnexLink l file
 	)
 
-cleanup :: FilePath -> Key -> Bool -> CommandCleanup
+cleanup :: FilePath -> Key -> Maybe InodeCache -> Bool -> CommandCleanup
-cleanup file key hascontent = do
+cleanup file key mcache hascontent = do
 	when hascontent $
 		logStatus key InfoPresent
 	ifM (isDirect <&&> pure hascontent)
 		( do
 			l <- inRepo $ gitAnnexLink file key
 			stageSymlink file =<< hashSymlink l
-		, addLink file key hascontent
+		, addLink file key mcache
 		)
 	return True

Command/AddUnused.hs

@@ -29,7 +29,7 @@ start = startUnused "addunused" perform
 perform :: Key -> CommandPerform
 perform key = next $ do
 	logStatus key InfoPresent
-	Command.Add.addLink file key False
+	Command.Add.addLink file key Nothing
 	return True
   where
 	file = "unused." ++ key2file key

Command/AddUrl.hs

@@ -189,7 +189,7 @@ cleanup url file key mtmp = do
 	when (isJust mtmp) $
 		logStatus key InfoPresent
 	setUrlPresent key url
-	Command.Add.addLink file key False
+	Command.Add.addLink file key Nothing
 	whenM isDirect $ do
 		void $ addAssociatedFile key file
 		{- For moveAnnex to work in direct mode, the symlink

Command/ReKey.hs

@@ -66,6 +66,6 @@ cleanup file oldkey newkey = do
 
 	-- Update symlink to use the new key.
 	liftIO $ removeFile file
-	Command.Add.addLink file newkey True
+	Command.Add.addLink file newkey Nothing
 	logStatus newkey InfoPresent
 	return True

Utility/InodeCache.hs

@@ -49,6 +49,9 @@ instance Eq InodeCacheKey where
 inodeCacheToKey :: InodeComparisonType -> InodeCache -> InodeCacheKey 
 inodeCacheToKey ct (InodeCache prim) = InodeCacheKey ct prim
 
+inodeCacheToMtime :: InodeCache -> EpochTime
+inodeCacheToMtime (InodeCache (InodeCachePrim _ _ mtime)) = mtime
+
 showInodeCache :: InodeCache -> String
 showInodeCache (InodeCache (InodeCachePrim inode size mtime)) = unwords
 	[ show inode

debian/changelog

@@ -15,6 +15,8 @@ git-annex (4.20130921) UNRELEASED; urgency=low
     available, or are not referenced by the current git tree.
   * indirect: Better behavior when a file in direct mode is not owned by
     the user running the conversion.
+  * add, import, assistant: Better preserve the mtime of symlinks,
+    when when adding content that gets deduplicated.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 22 Sep 2013 19:42:29 -0400
 

doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn

@@ -58,3 +58,5 @@ mtimes are clobbered with what I think is the time of the first time `git annex`
     upgrade supported from repository versions: 0 1 2
 
 Debian unstable amd64
+
+> [[fixed|done]] --[[Joey]]