1d1054faa6
Added -z option to git-annex commands that use --batch, useful for supporting filenames containing newlines. It only controls input to --batch, the output will still be line delimited unless --json or etc is used to get some other output. While git often makes -z affect both input and output, I don't like trying them together, and making it affect output would have been a significant complication, and also git-annex output is generally not intended to be machine parsed, unless using --json or a format option. Commands that take pairs like "file key" still separate them with a space in --batch mode. All such commands take care to support filenames with spaces when parsing that, so there was no need to change it, and it would have needed significant changes to the batch machinery to separate tose with a null. To make fromkey and registerurl support -z, I had to give them a --batch option. The implicit batch mode they enter when not provided with input parameters does not support -z as that would have complicated option parsing. Seemed better to move these toward using the same --batch as everything else, though the implicit batch mode can still be used. This commit was sponsored by Ole-Morten Duesund on Patreon.
76 lines
2.1 KiB
Haskell
76 lines
2.1 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2015-2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.CheckPresentKey where
|
|
|
|
import Command
|
|
import qualified Remote
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $ noMessages $
|
|
command "checkpresentkey" SectionPlumbing
|
|
"check if key is present in remote"
|
|
(paramPair paramKey (paramOptional paramRemote))
|
|
(seek <$$> optParser)
|
|
|
|
data CheckPresentKeyOptions = CheckPresentKeyOptions
|
|
{ params :: CmdParams
|
|
, batchOption :: BatchMode
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser CheckPresentKeyOptions
|
|
optParser desc = CheckPresentKeyOptions
|
|
<$> cmdParams desc
|
|
<*> parseBatchOption
|
|
|
|
seek :: CheckPresentKeyOptions -> CommandSeek
|
|
seek o = case batchOption o of
|
|
NoBatch -> case params o of
|
|
(ks:rn:[]) -> toRemote rn >>= (check ks . Just) >>= exitResult
|
|
(ks:[]) -> check ks Nothing >>= exitResult
|
|
_ -> wrongnumparams
|
|
Batch fmt -> do
|
|
checker <- case params o of
|
|
(rn:[]) -> toRemote rn >>= \r -> return (flip check (Just r))
|
|
[] -> return (flip check Nothing)
|
|
_ -> wrongnumparams
|
|
batchInput fmt Right $ checker >=> batchResult
|
|
where
|
|
wrongnumparams = giveup "Wrong number of parameters"
|
|
|
|
data Result = Present | NotPresent | CheckFailure String
|
|
|
|
check :: String -> Maybe Remote -> Annex Result
|
|
check ks mr = case mr of
|
|
Nothing -> go Nothing =<< Remote.keyPossibilities k
|
|
Just r -> go Nothing [r]
|
|
where
|
|
k = toKey ks
|
|
go Nothing [] = return NotPresent
|
|
go (Just e) [] = return $ CheckFailure e
|
|
go olderr (r:rs) = Remote.hasKey r k >>= \case
|
|
Right True -> return Present
|
|
Right False -> go olderr rs
|
|
Left e -> go (Just e) rs
|
|
|
|
exitResult :: Result -> Annex a
|
|
exitResult Present = liftIO exitSuccess
|
|
exitResult NotPresent = liftIO exitFailure
|
|
exitResult (CheckFailure msg) = liftIO $ do
|
|
hPutStrLn stderr msg
|
|
exitWith $ ExitFailure 100
|
|
|
|
batchResult :: Result -> Annex ()
|
|
batchResult Present = liftIO $ putStrLn "1"
|
|
batchResult _ = liftIO $ putStrLn "0"
|
|
|
|
toKey :: String -> Key
|
|
toKey = fromMaybe (giveup "Bad key") . file2key
|
|
|
|
toRemote :: String -> Annex Remote
|
|
toRemote rn = maybe (giveup "Unknown remote") return
|
|
=<< Remote.byNameWithUUID (Just rn)
|