use ShellParam type

So, I have a type checked safe handling of filenames starting with dashes,
throughout the code.
This commit is contained in:
Joey Hess 2011-02-28 16:10:16 -04:00
parent 7e5678bcf7
commit fcdc4797a9
24 changed files with 151 additions and 124 deletions

View file

@ -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

View file

@ -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

View file

@ -47,5 +47,5 @@ perform file = do
cleanup :: FilePath -> CommandCleanup
cleanup file = do
Annex.queue "add" ["--"] file
Annex.queue "add" [Param "--"] file
return True

View file

@ -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"

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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