use ShellParam type
So, I have a type checked safe handling of filenames starting with dashes, throughout the code.
This commit is contained in:
parent
7e5678bcf7
commit
fcdc4797a9
24 changed files with 151 additions and 124 deletions
|
@ -17,6 +17,7 @@ import LocationLog
|
|||
import Types
|
||||
import Content
|
||||
import Messages
|
||||
import Utility
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "add" paramPath seek "add files to annex"]
|
||||
|
@ -52,5 +53,5 @@ cleanup file key = do
|
|||
|
||||
link <- calcGitLink file key
|
||||
liftIO $ createSymbolicLink link file
|
||||
Annex.queue "add" ["--"] file
|
||||
Annex.queue "add" [Param "--"] file
|
||||
return True
|
||||
|
|
|
@ -44,5 +44,5 @@ perform file link = do
|
|||
|
||||
cleanup :: FilePath -> CommandCleanup
|
||||
cleanup file = do
|
||||
Annex.queue "add" ["--"] file
|
||||
Annex.queue "add" [Param "--"] file
|
||||
return True
|
||||
|
|
|
@ -47,5 +47,5 @@ perform file = do
|
|||
|
||||
cleanup :: FilePath -> CommandCleanup
|
||||
cleanup file = do
|
||||
Annex.queue "add" ["--"] file
|
||||
Annex.queue "add" [Param "--"] file
|
||||
return True
|
||||
|
|
|
@ -51,8 +51,12 @@ cleanup :: CommandCleanup
|
|||
cleanup = do
|
||||
g <- Annex.gitRepo
|
||||
logfile <- uuidLog
|
||||
liftIO $ Git.run g ["add", logfile]
|
||||
liftIO $ Git.run g ["commit", "-q", "-m", "git annex init", logfile]
|
||||
liftIO $ Git.run g "add" [File logfile]
|
||||
liftIO $ Git.run g "commit"
|
||||
[ Params "-q -m"
|
||||
, Param "git annex init"
|
||||
, File logfile
|
||||
]
|
||||
return True
|
||||
|
||||
{- configure git to use union merge driver on state files, if it is not
|
||||
|
@ -72,9 +76,12 @@ gitAttributesWrite repo = do
|
|||
where
|
||||
attributes = Git.attributes repo
|
||||
commit = do
|
||||
Git.run repo ["add", attributes]
|
||||
Git.run repo ["commit", "-q", "-m", "git-annex setup",
|
||||
attributes]
|
||||
Git.run repo "add" [Param attributes]
|
||||
Git.run repo "commit"
|
||||
[ Params "-q -m"
|
||||
, Param "git-annex setup"
|
||||
, Param attributes
|
||||
]
|
||||
|
||||
attrLine :: String
|
||||
attrLine = stateDir </> "*.log merge=union"
|
||||
|
|
|
@ -14,6 +14,7 @@ import Command
|
|||
import Messages
|
||||
import qualified Annex
|
||||
import qualified GitRepo as Git
|
||||
import Utility
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "lock" paramPath seek "undo unlock command"]
|
||||
|
@ -32,7 +33,7 @@ perform file = do
|
|||
liftIO $ removeFile file
|
||||
g <- Annex.gitRepo
|
||||
-- first reset the file to drop any changes checked into the index
|
||||
liftIO $ Git.run g ["reset", "-q", "--", file]
|
||||
liftIO $ Git.run g "reset" [Params "-q --", File file]
|
||||
-- checkout the symlink
|
||||
liftIO $ Git.run g ["checkout", "--", file]
|
||||
liftIO $ Git.run g "checkout" [Param "--", File file]
|
||||
return $ Just $ return True -- no cleanup needed
|
||||
|
|
|
@ -44,7 +44,7 @@ start = do
|
|||
liftIO $ writeFile file (drawMap rs umap trusted)
|
||||
showLongNote $ "running: dot -Tx11 " ++ file
|
||||
showProgress
|
||||
r <- liftIO $ boolSystem "dot" ["-Tx11", file]
|
||||
r <- liftIO $ boolSystem "dot" [Param "-Tx11", File file]
|
||||
return $ Just $ return $ Just $ return r
|
||||
where
|
||||
file = "map.dot"
|
||||
|
@ -198,7 +198,7 @@ tryScan r
|
|||
Left _ -> return Nothing
|
||||
Right r' -> return $ Just r'
|
||||
pipedconfig cmd params = safely $
|
||||
pOpen ReadFromPipe cmd params $
|
||||
pOpen ReadFromPipe cmd (toShell params) $
|
||||
Git.hConfigRead r
|
||||
|
||||
configlist =
|
||||
|
@ -208,8 +208,9 @@ tryScan r
|
|||
let sshcmd =
|
||||
"cd " ++ shellEscape(Git.workTree r) ++ " && " ++
|
||||
"git config --list"
|
||||
liftIO $ pipedconfig "ssh" $
|
||||
words sshoptions ++ [Git.urlHostFull r, sshcmd]
|
||||
liftIO $ pipedconfig "ssh" $ map Param $
|
||||
words sshoptions ++
|
||||
[Git.urlHostFull r, sshcmd]
|
||||
|
||||
-- First, try sshing and running git config manually,
|
||||
-- only fall back to git-annex-shell configlist if that
|
||||
|
|
|
@ -56,7 +56,7 @@ remoteHasKey remote key present = do
|
|||
g <- Annex.gitRepo
|
||||
remoteuuid <- getUUID remote
|
||||
logfile <- liftIO $ logChange g key remoteuuid status
|
||||
Annex.queue "add" ["--"] logfile
|
||||
Annex.queue "add" [Param "--"] logfile
|
||||
where
|
||||
status = if present then ValuePresent else ValueMissing
|
||||
|
||||
|
@ -130,9 +130,10 @@ fromPerform src move key = do
|
|||
fromCleanup :: Git.Repo -> Bool -> Key -> CommandCleanup
|
||||
fromCleanup src True key = do
|
||||
ok <- Remotes.onRemote src (boolSystem, False) "dropkey"
|
||||
["--quiet", "--force",
|
||||
"--backend=" ++ backendName key,
|
||||
keyName key]
|
||||
[ Params "--quiet --force"
|
||||
, Param $ "--backend=" ++ backendName key
|
||||
, Param $ keyName key
|
||||
]
|
||||
-- better safe than sorry: assume the src dropped the key
|
||||
-- even if it seemed to fail; the failure could have occurred
|
||||
-- after it really dropped it
|
||||
|
|
|
@ -15,6 +15,7 @@ import qualified GitRepo as Git
|
|||
import qualified Command.Add
|
||||
import qualified Command.Fix
|
||||
import Messages
|
||||
import Utility
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "pre-commit" paramPath seek "run by git pre-commit hook"]
|
||||
|
@ -41,6 +42,6 @@ cleanup file = do
|
|||
-- drop that and run command queued by Add.state to
|
||||
-- stage the symlink
|
||||
g <- Annex.gitRepo
|
||||
liftIO $ Git.run g ["reset", "-q", "--", file]
|
||||
liftIO $ Git.run g "reset" [Params "-q --", File file]
|
||||
Annex.queueRun
|
||||
return True
|
||||
|
|
|
@ -36,7 +36,7 @@ perform file = do
|
|||
ok <- getViaTmp key $ \dest -> do
|
||||
if dest /= file
|
||||
then liftIO $
|
||||
boolSystem "mv" [utilityEscape file, utilityEscape dest]
|
||||
boolSystem "mv" [File file, File dest]
|
||||
else return True
|
||||
if ok
|
||||
then return $ Just $ cleanup
|
||||
|
|
|
@ -58,7 +58,7 @@ cleanup file key = do
|
|||
g <- Annex.gitRepo
|
||||
|
||||
liftIO $ removeFile file
|
||||
liftIO $ Git.run g ["rm", "--quiet", "--", file]
|
||||
liftIO $ Git.run g "rm" [Params "--quiet --", File file]
|
||||
-- git rm deletes empty directories; put them back
|
||||
liftIO $ createDirectoryIfMissing True (parentDir file)
|
||||
|
||||
|
@ -68,6 +68,6 @@ cleanup file key = do
|
|||
-- Commit staged changes at end to avoid confusing the
|
||||
-- pre-commit hook if this file is later added back to
|
||||
-- git as a normal, non-annexed file.
|
||||
Annex.queue "commit" ["-m", "content removed from git annex"] "-a"
|
||||
Annex.queue "commit" [Params "-a -m", Param "content removed from git annex"] "-a"
|
||||
|
||||
return True
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue