42caf42857
1. git add file 2. git commit 3. modify file 4. git commit 5. git reset HEAD^ Before this fix, that resulted in git saying the file was modified. And indeed, it didn't have the content it should in the just checked out ref, because step 3 modified the object file for the old key.
111 lines
2.9 KiB
Haskell
111 lines
2.9 KiB
Haskell
{- 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.MetaData
|
|
import Annex.FileMatcher
|
|
import Types.KeySource
|
|
import Backend
|
|
import Logs.Location
|
|
import qualified Database.Keys
|
|
|
|
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
|
|
-- 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 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)
|
|
( do
|
|
k <- ingest file
|
|
Database.Keys.addAssociatedFile k file
|
|
liftIO $ emitPointer k
|
|
, liftIO $ B.hPut stdout b
|
|
)
|
|
stop
|
|
|
|
shouldAnnex :: FilePath -> Annex Bool
|
|
shouldAnnex file = do
|
|
matcher <- largeFilesMatcher
|
|
checkFileMatcher matcher file
|
|
|
|
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 object
|
|
-- to prevent it from being lost when git checks out
|
|
-- a branch not containing this file.
|
|
r <- linkAnnex k file
|
|
case r of
|
|
LinkAnnexFailed -> error "Problem adding file to the annex"
|
|
LinkAnnexOk -> logStatus k InfoPresent
|
|
LinkAnnexNoop -> noop
|
|
genMetaData k file
|
|
=<< liftIO (getFileStatus file)
|
|
return k
|
|
|
|
emitPointer :: Key -> IO ()
|
|
emitPointer = putStr . formatPointer
|