diff options
| -rw-r--r-- | Annex/Content.hs | 18 | ||||
| -rw-r--r-- | Command/Clean.hs | 39 |
2 files changed, 54 insertions, 3 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 289a4f1b3..74fae381b 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -24,6 +24,7 @@ module Annex.Content ( withTmp, checkDiskSpace, moveAnnex, + linkAnnex, sendAnnex, prepSendAnnex, removeAnnex, @@ -470,6 +471,23 @@ moveAnnex key src = withObjectLoc key storeobject storedirect alreadyhave = liftIO $ removeFile src +{- Hard links a file into .git/annex/objects/, falling back to a copy + - if necessary. + - + - Does not lock down the hard linked object, so that the user can modify + - the source file. 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 :: Key -> FilePath -> Annex Bool +linkAnnex key src = do + dest <- calcRepo (gitAnnexLocation key) + ifM (liftIO $ doesFileExist dest) + ( return True + , modifyContent dest $ + liftIO $ createLinkOrCopy src dest + ) + {- 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. diff --git a/Command/Clean.hs b/Command/Clean.hs index 9af862fb0..0a8e438d1 100644 --- a/Command/Clean.hs +++ b/Command/Clean.hs @@ -10,8 +10,12 @@ module Command.Clean where import Common.Annex import Command import Annex.Content -import Annex.Link -import Git.Types +import Annex.MetaData +import Types.KeySource +import Types.Key +import Backend + +import qualified Data.ByteString.Lazy as B cmd :: Command cmd = dontCheck repoExists $ @@ -24,6 +28,35 @@ seek = withWords start start :: [String] -> CommandStart start [file] = do - error ("clean " ++ file) + ifM (shouldAnnex file) + ( do + k <- ingest file + liftIO $ putStrLn (key2file k) + , liftIO $ B.hGetContents stdin >>= B.hPut stdout -- cat file + ) + stop start [] = error "clean filter run without filename; upgrade git" start _ = error "clean filter passed multiple filenames" + +shouldAnnex :: FilePath -> Annex Bool +shouldAnnex _ = return True +-- TODO check annex.largefiles + +ingest :: FilePath -> Annex Key +ingest file = do + backend <- chooseBackend file + let source = KeySource + { keyFilename = file + , contentLocation = file + , inodeCache = Nothing + } + k <- fst . fromMaybe (error "failed to generate a key") + <$> genKey source backend + -- Hard link (or copy) file content to annex + -- to prevent it from being lost when git checks out + -- a branch not contaning this file. + unlessM (linkAnnex k file) $ + error "Problem adding file to the annex" + genMetaData k file + =<< liftIO (getFileStatus file) + return k |