diff options
| -rw-r--r-- | Assistant/Threads/Committer.hs | 10 | ||||
| -rw-r--r-- | Command/Add.hs | 50 | ||||
| -rw-r--r-- | Command/AddUnused.hs | 2 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 2 | ||||
| -rw-r--r-- | Command/ReKey.hs | 2 | ||||
| -rw-r--r-- | Utility/InodeCache.hs | 3 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn | 2 |
8 files changed, 40 insertions, 33 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index be3bc3c84..445f4753b 100644 --- a/Assistant/Threads/Committer.hs +++ b/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 diff --git a/Command/Add.hs b/Command/Add.hs index a320af63b..e0a8269aa 100644 --- a/Command/Add.hs +++ b/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 Nothing = return Nothing +ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache) +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 = - maybe stop (\key -> next $ cleanup file key True) - =<< ingest =<< lockDown file +perform file = lockDown 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. -} @@ -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 file key hascontent = flip catchAnnex (undo file key) $ do +link :: FilePath -> Key -> Maybe InodeCache -> Annex String +link file key mcache = flip catchAnnex (undo file key) $ do l <- inRepo $ gitAnnexLink file key replaceFile file $ makeAnnexLink l #ifndef __ANDROID__ - when hascontent $ - -- touch the symlink to have the same mtime as the - -- file it points to - liftIO $ do - mtime <- modificationTime <$> getFileStatus file - touch file (TimeSpec mtime) False + -- touch symlink to have same time as the original file, + -- as provided in the InodeCache + case mcache of + Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False + Nothing -> noop #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 file key hascontent = ifM (coreSymlinks <$> Annex.getGitConfig) +addLink :: FilePath -> Key -> Maybe InodeCache -> Annex () +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 file key hascontent = do +cleanup :: FilePath -> Key -> Maybe InodeCache -> Bool -> CommandCleanup +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 diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index 21a75137f..1a178e8d4 100644 --- a/Command/AddUnused.hs +++ b/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 diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 8ac0e342f..e767a45e0 100644 --- a/Command/AddUrl.hs +++ b/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 diff --git a/Command/ReKey.hs b/Command/ReKey.hs index d7b277fa6..7448ba97e 100644 --- a/Command/ReKey.hs +++ b/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 diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index 8037c61c8..46ca87bd9 100644 --- a/Utility/InodeCache.hs +++ b/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 diff --git a/debian/changelog b/debian/changelog index fad2d372e..5588923c2 100644 --- a/debian/changelog +++ b/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 diff --git a/doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn b/doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn index ce1c67fee..7edebe584 100644 --- a/doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn +++ b/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]] |