fix absolute filenames fed into --batch and git-annex info
This commit is contained in:
parent
a14168a321
commit
957a87b437
14 changed files with 106 additions and 37 deletions
|
@ -11,6 +11,8 @@ git-annex (8.20200331) UNRELEASED; urgency=medium
|
||||||
setting with no value, eg "core.bare" is the same as "core.bare = true".
|
setting with no value, eg "core.bare" is the same as "core.bare = true".
|
||||||
* When parsing git configs, support all the documented ways to write
|
* When parsing git configs, support all the documented ways to write
|
||||||
true and false, including "yes", "on", "1", etc.
|
true and false, including "yes", "on", "1", etc.
|
||||||
|
* Fix --batch commands (and git-annex info) to accept absolute filenames
|
||||||
|
for unlocked files, which already worked for locked files.
|
||||||
|
|
||||||
-- Joey Hess <id@joeyh.name> Mon, 30 Mar 2020 15:58:34 -0400
|
-- Joey Hess <id@joeyh.name> Mon, 30 Mar 2020 15:58:34 -0400
|
||||||
|
|
||||||
|
|
|
@ -50,7 +50,7 @@ batchable handler parser paramdesc = batchseeker <$> batchparser
|
||||||
batchseeker (opts, NoBatch, params) =
|
batchseeker (opts, NoBatch, params) =
|
||||||
mapM_ (go NoBatch opts) params
|
mapM_ (go NoBatch opts) params
|
||||||
batchseeker (opts, batchmode@(Batch fmt), _) =
|
batchseeker (opts, batchmode@(Batch fmt), _) =
|
||||||
batchInput fmt Right (go batchmode opts)
|
batchInput fmt (pure . Right) (go batchmode opts)
|
||||||
|
|
||||||
go batchmode opts p =
|
go batchmode opts p =
|
||||||
unlessM (handler opts p) $
|
unlessM (handler opts p) $
|
||||||
|
@ -62,13 +62,19 @@ batchBadInput :: BatchMode -> Annex ()
|
||||||
batchBadInput NoBatch = liftIO exitFailure
|
batchBadInput NoBatch = liftIO exitFailure
|
||||||
batchBadInput (Batch _) = liftIO $ putStrLn ""
|
batchBadInput (Batch _) = liftIO $ putStrLn ""
|
||||||
|
|
||||||
-- Reads lines of batch mode input and passes to the action to handle.
|
-- Reads lines of batch mode input, runs a parser, and passes the result
|
||||||
batchInput :: BatchFormat -> (String -> Either String a) -> (a -> Annex ()) -> Annex ()
|
-- to the action.
|
||||||
|
--
|
||||||
|
-- Note that if the batch input includes a worktree filename, it should
|
||||||
|
-- be converted to relative. Normally, filename parameters are passed
|
||||||
|
-- through git ls-files, which makes them relative, but batch mode does
|
||||||
|
-- not use that, and absolute worktree files are likely to cause breakage.
|
||||||
|
batchInput :: BatchFormat -> (String -> Annex (Either String a)) -> (a -> Annex ()) -> Annex ()
|
||||||
batchInput fmt parser a = go =<< batchLines fmt
|
batchInput fmt parser a = go =<< batchLines fmt
|
||||||
where
|
where
|
||||||
go [] = return ()
|
go [] = return ()
|
||||||
go (l:rest) = do
|
go (l:rest) = do
|
||||||
either parseerr a (parser l)
|
either parseerr a =<< parser l
|
||||||
go rest
|
go rest
|
||||||
parseerr s = giveup $ "Batch input parse failure: " ++ s
|
parseerr s = giveup $ "Batch input parse failure: " ++ s
|
||||||
|
|
||||||
|
@ -95,9 +101,12 @@ batchCommandAction a = maybe (batchBadInput (Batch BatchLine)) (const noop)
|
||||||
-- Reads lines of batch input and passes the filepaths to a CommandStart
|
-- Reads lines of batch input and passes the filepaths to a CommandStart
|
||||||
-- to handle them.
|
-- to handle them.
|
||||||
--
|
--
|
||||||
|
-- Absolute filepaths are converted to relative.
|
||||||
|
--
|
||||||
-- File matching options are not checked.
|
-- File matching options are not checked.
|
||||||
batchStart :: BatchFormat -> (String -> CommandStart) -> Annex ()
|
batchStart :: BatchFormat -> (FilePath -> CommandStart) -> Annex ()
|
||||||
batchStart fmt a = batchInput fmt Right $ batchCommandAction . a
|
batchStart fmt a = batchInput fmt (Right <$$> liftIO . relPathCwdToFile) $
|
||||||
|
batchCommandAction . a
|
||||||
|
|
||||||
-- Like batchStart, but checks the file matching options
|
-- Like batchStart, but checks the file matching options
|
||||||
-- and skips non-matching files.
|
-- and skips non-matching files.
|
||||||
|
|
|
@ -103,7 +103,7 @@ seek o = startConcurrency commandStages $ do
|
||||||
else checkUrl addunlockedmatcher r o' u
|
else checkUrl addunlockedmatcher r o' u
|
||||||
forM_ (addUrls o) (\u -> go (o, u))
|
forM_ (addUrls o) (\u -> go (o, u))
|
||||||
case batchOption o of
|
case batchOption o of
|
||||||
Batch fmt -> batchInput fmt (parseBatchInput o) go
|
Batch fmt -> batchInput fmt (pure . parseBatchInput o) go
|
||||||
NoBatch -> noop
|
NoBatch -> noop
|
||||||
|
|
||||||
parseBatchInput :: AddUrlOptions -> String -> Either String (AddUrlOptions, URLString)
|
parseBatchInput :: AddUrlOptions -> String -> Either String (AddUrlOptions, URLString)
|
||||||
|
|
|
@ -38,7 +38,7 @@ seek o = case batchOption o of
|
||||||
(rn:[]) -> toRemote rn >>= \r -> return (flip check (Just r))
|
(rn:[]) -> toRemote rn >>= \r -> return (flip check (Just r))
|
||||||
[] -> return (flip check Nothing)
|
[] -> return (flip check Nothing)
|
||||||
_ -> wrongnumparams
|
_ -> wrongnumparams
|
||||||
batchInput fmt Right $ checker >=> batchResult
|
batchInput fmt (pure . Right) $ checker >=> batchResult
|
||||||
where
|
where
|
||||||
wrongnumparams = giveup "Wrong number of parameters"
|
wrongnumparams = giveup "Wrong number of parameters"
|
||||||
|
|
||||||
|
|
|
@ -35,7 +35,8 @@ seek o = do
|
||||||
giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
|
giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
|
||||||
withKeys (commandAction . start) (toDrop o)
|
withKeys (commandAction . start) (toDrop o)
|
||||||
case batchOption o of
|
case batchOption o of
|
||||||
Batch fmt -> batchInput fmt parsekey $ batchCommandAction . start
|
Batch fmt -> batchInput fmt (pure . parsekey) $
|
||||||
|
batchCommandAction . start
|
||||||
NoBatch -> noop
|
NoBatch -> noop
|
||||||
where
|
where
|
||||||
parsekey = maybe (Left "bad key") Right . deserializeKey
|
parsekey = maybe (Left "bad key") Right . deserializeKey
|
||||||
|
|
|
@ -47,11 +47,14 @@ seek o = case (batchOption o, keyFilePairs o) of
|
||||||
seekBatch :: BatchFormat -> CommandSeek
|
seekBatch :: BatchFormat -> CommandSeek
|
||||||
seekBatch fmt = batchInput fmt parse commandAction
|
seekBatch fmt = batchInput fmt parse commandAction
|
||||||
where
|
where
|
||||||
parse s =
|
parse s = do
|
||||||
let (keyname, file) = separate (== ' ') s
|
let (keyname, file) = separate (== ' ') s
|
||||||
in if not (null keyname) && not (null file)
|
if not (null keyname) && not (null file)
|
||||||
then Right $ go file (keyOpt keyname)
|
then do
|
||||||
else Left "Expected pairs of key and filename"
|
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)) $
|
go file key = starting "fromkey" (mkActionItem (key, toRawFilePath file)) $
|
||||||
perform key file
|
perform key file
|
||||||
|
|
||||||
|
|
|
@ -119,7 +119,7 @@ optParser desc = InfoOptions
|
||||||
seek :: InfoOptions -> CommandSeek
|
seek :: InfoOptions -> CommandSeek
|
||||||
seek o = case batchOption o of
|
seek o = case batchOption o of
|
||||||
NoBatch -> withWords (commandAction . start o) (infoFor o)
|
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 :: InfoOptions -> [String] -> CommandStart
|
||||||
start o [] = do
|
start o [] = do
|
||||||
|
@ -152,9 +152,11 @@ itemInfo o p = ifM (isdir p)
|
||||||
v' <- Remote.nameToUUID' p
|
v' <- Remote.nameToUUID' p
|
||||||
case v' of
|
case v' of
|
||||||
Right u -> uuidInfo o u
|
Right u -> uuidInfo o u
|
||||||
Left _ -> ifAnnexed (toRawFilePath p)
|
Left _ -> do
|
||||||
(fileInfo o p)
|
relp <- liftIO $ relPathCwdToFile p
|
||||||
(treeishInfo o p)
|
ifAnnexed (toRawFilePath relp)
|
||||||
|
(fileInfo o relp)
|
||||||
|
(treeishInfo o p)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)
|
isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)
|
||||||
|
|
|
@ -148,16 +148,21 @@ instance FromJSON MetaDataFields where
|
||||||
fieldsField :: T.Text
|
fieldsField :: T.Text
|
||||||
fieldsField = T.pack "fields"
|
fieldsField = T.pack "fields"
|
||||||
|
|
||||||
parseJSONInput :: String -> Either String (Either RawFilePath Key, MetaData)
|
parseJSONInput :: String -> Annex (Either String (Either RawFilePath Key, MetaData))
|
||||||
parseJSONInput i = do
|
parseJSONInput i = case eitherDecode (BU.fromString i) of
|
||||||
v <- eitherDecode (BU.fromString i)
|
Left e -> return (Left e)
|
||||||
let m = case itemAdded v of
|
Right v -> do
|
||||||
Nothing -> emptyMetaData
|
let m = case itemAdded v of
|
||||||
Just (MetaDataFields m') -> m'
|
Nothing -> emptyMetaData
|
||||||
case (itemKey v, itemFile v) of
|
Just (MetaDataFields m') -> m'
|
||||||
(Just k, _) -> Right (Right k, m)
|
case (itemKey v, itemFile v) of
|
||||||
(Nothing, Just f) -> Right (Left (toRawFilePath f), m)
|
(Just k, _) -> return $
|
||||||
(Nothing, Nothing) -> Left "JSON input is missing either file or key"
|
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 :: (Either RawFilePath Key, MetaData) -> CommandStart
|
||||||
startBatch (i, (MetaData m)) = case i of
|
startBatch (i, (MetaData m)) = case i of
|
||||||
|
|
|
@ -39,17 +39,21 @@ optParser desc = ReKeyOptions
|
||||||
|
|
||||||
-- Split on the last space, since a FilePath can contain whitespace,
|
-- Split on the last space, since a FilePath can contain whitespace,
|
||||||
-- but a Key very rarely does.
|
-- 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
|
batchParser s = case separate (== ' ') (reverse s) of
|
||||||
(rk, rf)
|
(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
|
| otherwise -> case deserializeKey (reverse rk) of
|
||||||
Nothing -> Left "bad key"
|
Nothing -> return $ Left "bad key"
|
||||||
Just k -> Right (toRawFilePath (reverse rf), k)
|
Just k -> do
|
||||||
|
let f = reverse rf
|
||||||
|
f' <- liftIO $ relPathCwdToFile f
|
||||||
|
return $ Right (toRawFilePath f', k)
|
||||||
|
|
||||||
seek :: ReKeyOptions -> CommandSeek
|
seek :: ReKeyOptions -> CommandSeek
|
||||||
seek o = case batchOption o of
|
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)
|
NoBatch -> withPairs (commandAction . start . parsekey) (reKeyThese o)
|
||||||
where
|
where
|
||||||
parsekey (file, skey) =
|
parsekey (file, skey) =
|
||||||
|
|
|
@ -30,16 +30,20 @@ optParser desc = RmUrlOptions
|
||||||
|
|
||||||
seek :: RmUrlOptions -> CommandSeek
|
seek :: RmUrlOptions -> CommandSeek
|
||||||
seek o = case batchOption o of
|
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)
|
NoBatch -> withPairs (commandAction . start) (rmThese o)
|
||||||
|
|
||||||
-- Split on the last space, since a FilePath can contain whitespace,
|
-- Split on the last space, since a FilePath can contain whitespace,
|
||||||
-- but a url should not.
|
-- 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
|
batchParser s = case separate (== ' ') (reverse s) of
|
||||||
(ru, rf)
|
(ru, rf)
|
||||||
| null ru || null rf -> Left "Expected: \"file url\""
|
| null ru || null rf -> return $ Left "Expected: \"file url\""
|
||||||
| otherwise -> Right (reverse rf, reverse ru)
|
| otherwise -> do
|
||||||
|
let f = reverse rf
|
||||||
|
f' <- liftIO $ relPathCwdToFile f
|
||||||
|
return $ Right (f', reverse ru)
|
||||||
|
|
||||||
start :: (FilePath, URLString) -> CommandStart
|
start :: (FilePath, URLString) -> CommandStart
|
||||||
start (file, url) = flip whenAnnexed file' $ \_ key ->
|
start (file, url) = flip whenAnnexed file' $ \_ key ->
|
||||||
|
|
|
@ -31,7 +31,7 @@ optParser desc = SetPresentKeyOptions
|
||||||
seek :: SetPresentKeyOptions -> CommandSeek
|
seek :: SetPresentKeyOptions -> CommandSeek
|
||||||
seek o = case batchOption o of
|
seek o = case batchOption o of
|
||||||
Batch fmt -> batchInput fmt
|
Batch fmt -> batchInput fmt
|
||||||
(parseKeyStatus . words)
|
(pure . parseKeyStatus . words)
|
||||||
(batchCommandAction . start)
|
(batchCommandAction . start)
|
||||||
NoBatch -> either giveup (commandAction . start)
|
NoBatch -> either giveup (commandAction . start)
|
||||||
(parseKeyStatus $ params o)
|
(parseKeyStatus $ params o)
|
||||||
|
|
|
@ -3,3 +3,5 @@
|
||||||
I tested `git annex lookupkey --batch` which does not have this problem.
|
I tested `git annex lookupkey --batch` which does not have this problem.
|
||||||
|
|
||||||
--spwhitton
|
--spwhitton
|
||||||
|
|
||||||
|
> [[fixed|done]] --[[Joey]]
|
||||||
|
|
|
@ -0,0 +1,14 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="joey"
|
||||||
|
subject="""comment 4"""
|
||||||
|
date="2020-04-15T19:13:39Z"
|
||||||
|
content="""
|
||||||
|
Other commands like whereis --batch also behave the same.
|
||||||
|
|
||||||
|
Looks like what's going on is, when an absolute path is passed
|
||||||
|
as a parameter, it feeds thru git ls-files, producing a relative file.
|
||||||
|
But with --batch, it stays absolute. This causes things that try to eg,
|
||||||
|
look up the file in the tree to not find it.
|
||||||
|
|
||||||
|
So, --batch needs to make filepaths relative too..
|
||||||
|
"""]]
|
|
@ -0,0 +1,23 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="joey"
|
||||||
|
subject="""comment 5"""
|
||||||
|
date="2020-04-15T19:22:12Z"
|
||||||
|
content="""
|
||||||
|
Most of it can be fixed by making batchStart make
|
||||||
|
files relative.
|
||||||
|
|
||||||
|
Other affected commands that do custom parsing of
|
||||||
|
batch input, so will need to make the file from it
|
||||||
|
relative themselves: fromkey metadata rekey rmurl
|
||||||
|
|
||||||
|
Also, `git annex info /path/to/file` fails for unlocked
|
||||||
|
files and works for locked files, because it does not pass
|
||||||
|
filenames through git ls-files. I think it's the only
|
||||||
|
command that does not, when not in batch mode.
|
||||||
|
|
||||||
|
(I suppose alternatively, lookupKey could make the filename relative,
|
||||||
|
but I don't know if that is the only thing that fails on absolute
|
||||||
|
filenames, so prefer to make them all relative on input.)
|
||||||
|
|
||||||
|
Ok, all done..
|
||||||
|
"""]]
|
Loading…
Reference in a new issue