3334d3831b
retrieveExport is part of ongoing transition to make remote methods throw exceptions, rather than silently hide them. getKey very rarely fails, and when it does it's always for the same reason (user configured annex.backend to url for some reason). So, this will avoid dealing with Nothing everywhere it's used. This commit was sponsored by Ilya Shlyakhter on Patreon.
90 lines
2.2 KiB
Haskell
90 lines
2.2 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2011-2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Reinject where
|
|
|
|
import Command
|
|
import Logs.Location
|
|
import Annex.Content
|
|
import Backend
|
|
import Types.KeySource
|
|
import Utility.Metered
|
|
import qualified Git
|
|
|
|
cmd :: Command
|
|
cmd = command "reinject" SectionUtility
|
|
"inject content of file back into annex"
|
|
(paramRepeating (paramPair "SRC" "DEST"))
|
|
(seek <$$> optParser)
|
|
|
|
data ReinjectOptions = ReinjectOptions
|
|
{ params :: CmdParams
|
|
, knownOpt :: Bool
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser ReinjectOptions
|
|
optParser desc = ReinjectOptions
|
|
<$> cmdParams desc
|
|
<*> switch
|
|
( long "known"
|
|
<> help "inject all known files"
|
|
<> hidden
|
|
)
|
|
|
|
seek :: ReinjectOptions -> CommandSeek
|
|
seek os
|
|
| knownOpt os = withStrings (commandAction . startKnown) (params os)
|
|
| otherwise = withWords (commandAction . startSrcDest) (params os)
|
|
|
|
startSrcDest :: [FilePath] -> CommandStart
|
|
startSrcDest (src:dest:[])
|
|
| src == dest = stop
|
|
| otherwise = notAnnexed src $ ifAnnexed (toRawFilePath dest) go stop
|
|
where
|
|
go key = starting "reinject" (ActionItemOther (Just src)) $
|
|
ifM (verifyKeyContent RetrievalAllKeysSecure DefaultVerify UnVerified key src)
|
|
( perform src key
|
|
, giveup $ src ++ " does not have expected content of " ++ dest
|
|
)
|
|
startSrcDest _ = giveup "specify a src file and a dest file"
|
|
|
|
startKnown :: FilePath -> CommandStart
|
|
startKnown src = notAnnexed src $
|
|
starting "reinject" (ActionItemOther (Just src)) $ do
|
|
(key, _) <- genKey ks nullMeterUpdate Nothing
|
|
ifM (isKnownKey key)
|
|
( perform src key
|
|
, do
|
|
warning "Not known content; skipping"
|
|
next $ return True
|
|
)
|
|
where
|
|
ks = KeySource src' src' Nothing
|
|
src' = toRawFilePath src
|
|
|
|
notAnnexed :: FilePath -> CommandStart -> CommandStart
|
|
notAnnexed src a =
|
|
ifM (fromRepo Git.repoIsLocalBare)
|
|
( a
|
|
, ifAnnexed (toRawFilePath src)
|
|
(giveup $ "cannot used annexed file as src: " ++ src)
|
|
a
|
|
)
|
|
|
|
perform :: FilePath -> Key -> CommandPerform
|
|
perform src key = ifM move
|
|
( next $ cleanup key
|
|
, error "failed"
|
|
)
|
|
where
|
|
move = checkDiskSpaceToGet key False $
|
|
moveAnnex key src
|
|
|
|
cleanup :: Key -> CommandCleanup
|
|
cleanup key = do
|
|
logStatus key InfoPresent
|
|
return True
|