fix absolute filenames fed into --batch and git-annex info

This commit is contained in:
Joey Hess 2020-04-15 16:04:05 -04:00
parent a14168a321
commit 957a87b437
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
14 changed files with 106 additions and 37 deletions

View file

@ -103,7 +103,7 @@ seek o = startConcurrency commandStages $ do
else checkUrl addunlockedmatcher r o' u
forM_ (addUrls o) (\u -> go (o, u))
case batchOption o of
Batch fmt -> batchInput fmt (parseBatchInput o) go
Batch fmt -> batchInput fmt (pure . parseBatchInput o) go
NoBatch -> noop
parseBatchInput :: AddUrlOptions -> String -> Either String (AddUrlOptions, URLString)

View file

@ -38,7 +38,7 @@ seek o = case batchOption o of
(rn:[]) -> toRemote rn >>= \r -> return (flip check (Just r))
[] -> return (flip check Nothing)
_ -> wrongnumparams
batchInput fmt Right $ checker >=> batchResult
batchInput fmt (pure . Right) $ checker >=> batchResult
where
wrongnumparams = giveup "Wrong number of parameters"

View file

@ -35,7 +35,8 @@ seek o = do
giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
withKeys (commandAction . start) (toDrop o)
case batchOption o of
Batch fmt -> batchInput fmt parsekey $ batchCommandAction . start
Batch fmt -> batchInput fmt (pure . parsekey) $
batchCommandAction . start
NoBatch -> noop
where
parsekey = maybe (Left "bad key") Right . deserializeKey

View file

@ -47,11 +47,14 @@ seek o = case (batchOption o, keyFilePairs o) of
seekBatch :: BatchFormat -> CommandSeek
seekBatch fmt = batchInput fmt parse commandAction
where
parse s =
parse s = do
let (keyname, file) = separate (== ' ') s
in if not (null keyname) && not (null file)
then Right $ go file (keyOpt keyname)
else Left "Expected pairs of key and filename"
if not (null keyname) && not (null file)
then do
file' <- liftIO $ relPathCwdToFile file
return $ Right $ go file' (keyOpt keyname)
else return $
Left "Expected pairs of key and filename"
go file key = starting "fromkey" (mkActionItem (key, toRawFilePath file)) $
perform key file

View file

@ -119,7 +119,7 @@ optParser desc = InfoOptions
seek :: InfoOptions -> CommandSeek
seek o = case batchOption o of
NoBatch -> withWords (commandAction . start o) (infoFor o)
Batch fmt -> batchInput fmt Right (itemInfo o)
Batch fmt -> batchInput fmt (pure . Right) (itemInfo o)
start :: InfoOptions -> [String] -> CommandStart
start o [] = do
@ -152,9 +152,11 @@ itemInfo o p = ifM (isdir p)
v' <- Remote.nameToUUID' p
case v' of
Right u -> uuidInfo o u
Left _ -> ifAnnexed (toRawFilePath p)
(fileInfo o p)
(treeishInfo o p)
Left _ -> do
relp <- liftIO $ relPathCwdToFile p
ifAnnexed (toRawFilePath relp)
(fileInfo o relp)
(treeishInfo o p)
)
where
isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)

View file

@ -148,16 +148,21 @@ instance FromJSON MetaDataFields where
fieldsField :: T.Text
fieldsField = T.pack "fields"
parseJSONInput :: String -> Either String (Either RawFilePath Key, MetaData)
parseJSONInput i = do
v <- eitherDecode (BU.fromString i)
let m = case itemAdded v of
Nothing -> emptyMetaData
Just (MetaDataFields m') -> m'
case (itemKey v, itemFile v) of
(Just k, _) -> Right (Right k, m)
(Nothing, Just f) -> Right (Left (toRawFilePath f), m)
(Nothing, Nothing) -> Left "JSON input is missing either file or key"
parseJSONInput :: String -> Annex (Either String (Either RawFilePath Key, MetaData))
parseJSONInput i = case eitherDecode (BU.fromString i) of
Left e -> return (Left e)
Right v -> do
let m = case itemAdded v of
Nothing -> emptyMetaData
Just (MetaDataFields m') -> m'
case (itemKey v, itemFile v) of
(Just k, _) -> return $
Right (Right k, m)
(Nothing, Just f) -> do
f' <- liftIO $ relPathCwdToFile f
return $ Right (Left (toRawFilePath f'), m)
(Nothing, Nothing) -> return $
Left "JSON input is missing either file or key"
startBatch :: (Either RawFilePath Key, MetaData) -> CommandStart
startBatch (i, (MetaData m)) = case i of

View file

@ -39,17 +39,21 @@ optParser desc = ReKeyOptions
-- Split on the last space, since a FilePath can contain whitespace,
-- but a Key very rarely does.
batchParser :: String -> Either String (RawFilePath, Key)
batchParser :: String -> Annex (Either String (RawFilePath, Key))
batchParser s = case separate (== ' ') (reverse s) of
(rk, rf)
| null rk || null rf -> Left "Expected: \"file key\""
| null rk || null rf -> return $ Left "Expected: \"file key\""
| otherwise -> case deserializeKey (reverse rk) of
Nothing -> Left "bad key"
Just k -> Right (toRawFilePath (reverse rf), k)
Nothing -> return $ Left "bad key"
Just k -> do
let f = reverse rf
f' <- liftIO $ relPathCwdToFile f
return $ Right (toRawFilePath f', k)
seek :: ReKeyOptions -> CommandSeek
seek o = case batchOption o of
Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)
Batch fmt -> batchInput fmt batchParser $
batchCommandAction . start
NoBatch -> withPairs (commandAction . start . parsekey) (reKeyThese o)
where
parsekey (file, skey) =

View file

@ -30,16 +30,20 @@ optParser desc = RmUrlOptions
seek :: RmUrlOptions -> CommandSeek
seek o = case batchOption o of
Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)
Batch fmt -> batchInput fmt batchParser
(batchCommandAction . start)
NoBatch -> withPairs (commandAction . start) (rmThese o)
-- Split on the last space, since a FilePath can contain whitespace,
-- but a url should not.
batchParser :: String -> Either String (FilePath, URLString)
batchParser :: String -> Annex (Either String (FilePath, URLString))
batchParser s = case separate (== ' ') (reverse s) of
(ru, rf)
| null ru || null rf -> Left "Expected: \"file url\""
| otherwise -> Right (reverse rf, reverse ru)
| null ru || null rf -> return $ Left "Expected: \"file url\""
| otherwise -> do
let f = reverse rf
f' <- liftIO $ relPathCwdToFile f
return $ Right (f', reverse ru)
start :: (FilePath, URLString) -> CommandStart
start (file, url) = flip whenAnnexed file' $ \_ key ->

View file

@ -31,7 +31,7 @@ optParser desc = SetPresentKeyOptions
seek :: SetPresentKeyOptions -> CommandSeek
seek o = case batchOption o of
Batch fmt -> batchInput fmt
(parseKeyStatus . words)
(pure . parseKeyStatus . words)
(batchCommandAction . start)
NoBatch -> either giveup (commandAction . start)
(parseKeyStatus $ params o)