From 39c13f91004b41166b786785083e78b34df0c48f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 13:52:23 -0400 Subject: remove Params constructor from Utility.SafeCommand This removes a bit of complexity, and should make things faster (avoids tokenizing Params string), and probably involve less garbage collection. In a few places, it was useful to use Params to avoid needing a list, but that is easily avoided. Problems noticed while doing this conversion: * Some uses of Params "oneword" which was entirely unnecessary overhead. * A few places that built up a list of parameters with ++ and then used Params to split it! Test suite passes. --- Annex/AutoMerge.hs | 7 +++-- Annex/Branch.hs | 5 +++- Annex/Quvi.hs | 4 +-- Annex/Ssh.hs | 7 +++-- Assistant/Threads/Watcher.hs | 2 +- Build/DistributionUpdate.hs | 6 ++-- Command/Log.hs | 6 +++- Command/Unannex.hs | 18 ++++++++++-- Command/Uninit.hs | 2 +- Git/CheckAttr.hs | 3 +- Git/CheckIgnore.hs | 5 +++- Git/DiffTree.hs | 8 +++++- Git/LsFiles.hs | 66 ++++++++++++++++++++++++++++++++++++-------- Git/LsTree.hs | 17 ++++++++++-- Git/Repair.hs | 6 ++-- Remote/Bup.hs | 8 ++++-- Remote/GCrypt.hs | 4 +-- Remote/Helper/Ssh.hs | 2 +- Remote/Rsync.hs | 17 ++++++------ Test.hs | 52 +++++++++++++++++----------------- Utility/Gpg.hs | 40 +++++++++++++++------------ Utility/Quvi.hs | 19 +++++++------ Utility/Rsync.hs | 3 +- Utility/SafeCommand.hs | 14 ++++------ Utility/Url.hs | 12 ++++---- 25 files changed, 216 insertions(+), 117 deletions(-) diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index 5ffa7b073..825dde443 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -89,7 +89,9 @@ resolveMerge us them = do unlessM isDirect $ do (deleted, cleanup2) <- inRepo (LsFiles.deleted [top]) unless (null deleted) $ - Annex.Queue.addCommand "rm" [Params "--quiet -f --"] deleted + Annex.Queue.addCommand "rm" + [Param "--quiet", Param "-f", Param "--"] + deleted void $ liftIO cleanup2 when merged $ do @@ -173,7 +175,8 @@ resolveMerge' (Just us) them u = do resolveby a = do {- Remove conflicted file from index so merge can be resolved. -} - Annex.Queue.addCommand "rm" [Params "--quiet -f --cached --"] [file] + Annex.Queue.addCommand "rm" + [Param "--quiet", Param "-f", Param "--cached", Param "--"] [file] void a return (Just file) diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 4bd94bddb..1a57e2342 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -315,7 +315,10 @@ files = do - and without updating the branch. -} branchFiles :: Annex [FilePath] branchFiles = withIndex $ inRepo $ Git.Command.pipeNullSplitZombie - [ Params "ls-tree --name-only -r -z" + [ Param "ls-tree" + , Param "--name-only" + , Param "-r" + , Param "-z" , Param $ fromRef fullname ] diff --git a/Annex/Quvi.hs b/Annex/Quvi.hs index 8d4591b48..0355ecd9e 100644 --- a/Annex/Quvi.hs +++ b/Annex/Quvi.hs @@ -14,11 +14,11 @@ import qualified Annex import Utility.Quvi import Utility.Url -withQuviOptions :: forall a. Query a -> [QuviParam] -> URLString -> Annex a +withQuviOptions :: forall a. Query a -> [QuviParams] -> URLString -> Annex a withQuviOptions a ps url = do v <- quviVersion opts <- map Param . annexQuviOptions <$> Annex.getGitConfig - liftIO $ a v (map (\mkp -> mkp v) ps++opts) url + liftIO $ a v (concatMap (\mkp -> mkp v) ps ++ opts) url quviSupported :: URLString -> Annex Bool quviSupported u = liftIO . flip supported u =<< quviVersion diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 52959ef7b..4d54d728e 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -92,7 +92,8 @@ bestSocketPath abssocketfile = do sshConnectionCachingParams :: FilePath -> [CommandParam] sshConnectionCachingParams socketfile = [ Param "-S", Param socketfile - , Params "-o ControlMaster=auto -o ControlPersist=yes" + , Param "-o", Param "ControlMaster=auto" + , Param "-o", Param "ControlPersist=yes" ] {- ssh connection caching creates sockets, so will not work on a @@ -180,8 +181,8 @@ forceStopSsh socketfile = do void $ liftIO $ catchMaybeIO $ withQuietOutput createProcessSuccess $ (proc "ssh" $ toCommand $ - [ Params "-O stop" - ] ++ params ++ [Param "localhost"]) + [ Param "-O", Param "stop" ] ++ + params ++ [Param "localhost"]) { cwd = Just dir } liftIO $ nukeFile socketfile diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 6f3afa8ca..8c6ff378d 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -202,7 +202,7 @@ add bigfilematcher file = ifM (liftAnnex $ checkFileMatcher bigfilematcher file) ( pendingAddChange file , do liftAnnex $ Annex.Queue.addCommand "add" - [Params "--force --"] [file] + [Param "--force", Param "--"] [file] madeChange file AddFileChange ) diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs index da1202fe2..1afaec994 100644 --- a/Build/DistributionUpdate.hs +++ b/Build/DistributionUpdate.hs @@ -130,11 +130,13 @@ makeinfos updated version = do ] void $ inRepo $ runBool [ Param "annex" - , Params "move --to website" + , Param "move" + , Param "--to" + , Param "website" ] void $ inRepo $ runBool [ Param "annex" - , Params "sync" + , Param "sync" ] -- Check for out of date info files. diff --git a/Command/Log.hs b/Command/Log.hs index 671c9d674..9ee7f8543 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -148,7 +148,11 @@ getLog key os = do config <- Annex.getGitConfig let logfile = p locationLogFile config key inRepo $ pipeNullSplitZombie $ - [ Params "log -z --pretty=format:%ct --raw --abbrev=40" + [ Param "log" + , Param "-z" + , Param "--pretty=format:%ct" + , Param "-raw" + , Param "--abbrev=40" , Param "--remove-empty" ] ++ os ++ [ Param $ Git.fromRef Annex.Branch.fullname diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 4b803401e..0d88148c8 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -72,7 +72,14 @@ start file key = stopUnless (inAnnex key) $ do performIndirect :: FilePath -> Key -> CommandPerform performIndirect file key = do liftIO $ removeFile file - inRepo $ Git.Command.run [Params "rm --cached --force --quiet --", File file] + inRepo $ Git.Command.run + [ Param "rm" + , Param "--cached" + , Param "--force" + , Param "--quiet" + , Param "--" + , File file + ] next $ cleanupIndirect file key cleanupIndirect :: FilePath -> Key -> CommandCleanup @@ -108,7 +115,14 @@ cleanupIndirect file key = do performDirect :: FilePath -> Key -> CommandPerform performDirect file key = do -- --force is needed when the file is not committed - inRepo $ Git.Command.run [Params "rm --cached --force --quiet --", File file] + inRepo $ Git.Command.run + [ Param "rm" + , Param "--cached" + , Param "--force" + , Param "--quiet" + , Param "--" + , File file + ] next $ cleanupDirect file key {- The direct mode file is not touched during unannex, so the content diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 28c169919..4a918070c 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -37,7 +37,7 @@ check = do where current_branch = Git.Ref . Prelude.head . lines <$> revhead revhead = inRepo $ Git.Command.pipeReadStrict - [Params "rev-parse --abbrev-ref HEAD"] + [Param "rev-parse", Param "--abbrev-ref", Param "HEAD"] seek :: CommandSeek seek ps = do diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs index 21eeed493..23ed22621 100644 --- a/Git/CheckAttr.hs +++ b/Git/CheckAttr.hs @@ -30,7 +30,8 @@ checkAttrStart attrs repo = do where params = [ Param "check-attr" - , Params "-z --stdin" + , Param "-z" + , Param "--stdin" ] ++ map Param attrs ++ [ Param "--" ] diff --git a/Git/CheckIgnore.hs b/Git/CheckIgnore.hs index a03f45432..322088f89 100644 --- a/Git/CheckIgnore.hs +++ b/Git/CheckIgnore.hs @@ -43,7 +43,10 @@ checkIgnoreStart repo = ifM supportedGitVersion where params = [ Param "check-ignore" - , Params "-z --stdin --verbose --non-matching" + , Param "-z" + , Param "--stdin" + , Param "--verbose" + , Param "--non-matching" ] repo' = repo { gitGlobalOpts = filter (not . pathspecs) (gitGlobalOpts repo) } pathspecs (Param "--literal-pathspecs") = True diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs index 5dd4bde2d..fecc9307c 100644 --- a/Git/DiffTree.hs +++ b/Git/DiffTree.hs @@ -78,7 +78,13 @@ getdiff command params repo = do (diff, cleanup) <- pipeNullSplit ps repo return (parseDiffRaw diff, cleanup) where - ps = command : Params "-z --raw --no-renames -l0" : params + ps = + command : + Param "-z" : + Param "--raw" : + Param "--no-renames" : + Param "-l0" : + params {- Parses --raw output used by diff-tree and git-log. -} parseDiffRaw :: [String] -> [DiffTreeItem] diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index e80c1b288..f94583873 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -35,14 +35,23 @@ import System.Posix.Types {- Scans for files that are checked into git at the specified locations. -} inRepo :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) -inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l +inRepo l = pipeNullSplit $ + Param "ls-files" : + Param "--cached" : + Param "-z" : + Param "--" : + map File l {- Scans for files at the specified locations that are not checked into git. -} notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool) notInRepo include_ignored l repo = pipeNullSplit params repo where - params = [Params "ls-files --others"] ++ exclude ++ - [Params "-z --"] ++ map File l + params = concat + [ [ Param "ls-files", Param "--others"] + , exclude + , [ Param "-z", Param "--" ] + , map File l + ] exclude | include_ignored = [] | otherwise = [Param "--exclude-standard"] @@ -50,28 +59,51 @@ notInRepo include_ignored l repo = pipeNullSplit params repo {- Finds all files in the specified locations, whether checked into git or - not. -} allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) -allFiles l = pipeNullSplit $ Params "ls-files --cached --others -z --" : map File l +allFiles l = pipeNullSplit $ + Param "ls-files" : + Param "--cached" : + Param "--others" : + Param "-z" : + Param "--" : + map File l {- Returns a list of files in the specified locations that have been - deleted. -} deleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) deleted l repo = pipeNullSplit params repo where - params = [Params "ls-files --deleted -z --"] ++ map File l + params = + Param "ls-files" : + Param "--deleted" : + Param "-z" : + Param "--" : + map File l {- Returns a list of files in the specified locations that have been - modified. -} modified :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) modified l repo = pipeNullSplit params repo where - params = [Params "ls-files --modified -z --"] ++ map File l + params = + Param "ls-files" : + Param "--modified" : + Param "-z" : + Param "--" : + map File l {- Files that have been modified or are not checked into git (and are not - ignored). -} modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) modifiedOthers l repo = pipeNullSplit params repo where - params = [Params "ls-files --modified --others --exclude-standard -z --"] ++ map File l + params = + Param "ls-files" : + Param "--modified" : + Param "--others" : + Param "--exclude-standard" : + Param "-z" : + Param "--" : + map File l {- Returns a list of all files that are staged for commit. -} staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) @@ -85,7 +117,7 @@ stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"] staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool) staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix where - prefix = [Params "diff --cached --name-only -z"] + prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"] suffix = Param "--" : map File l type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode) @@ -93,7 +125,7 @@ type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode) {- Returns details about files that are staged in the index, - as well as files not yet in git. Skips ignored files. -} stagedOthersDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool) -stagedOthersDetails = stagedDetails' [Params "--others --exclude-standard"] +stagedOthersDetails = stagedDetails' [Param "--others", Param "--exclude-standard"] {- Returns details about all files that are staged in the index. -} stagedDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool) @@ -106,7 +138,7 @@ stagedDetails' ps l repo = do (ls, cleanup) <- pipeNullSplit params repo return (map parse ls, cleanup) where - params = Params "ls-files --stage -z" : ps ++ + params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ Param "--" : map File l parse s | null file = (s, Nothing, Nothing) @@ -135,7 +167,12 @@ typeChanged' ps l repo = do currdir <- getCurrentDirectory return (map (\f -> relPathDirToFileAbs currdir $ top f) fs, cleanup) where - prefix = [Params "diff --name-only --diff-filter=T -z"] + prefix = + [ Param "diff" + , Param "--name-only" + , Param "--diff-filter=T" + , Param "-z" + ] suffix = Param "--" : (if null l then [File "."] else map File l) {- A item in conflict has two possible values. @@ -166,7 +203,12 @@ unmerged l repo = do (fs, cleanup) <- pipeNullSplit params repo return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup) where - params = Params "ls-files --unmerged -z --" : map File l + params = + Param "ls-files" : + Param "--unmerged" : + Param "-z" : + Param "--" : + map File l data InternalUnmerged = InternalUnmerged { isus :: Bool diff --git a/Git/LsTree.hs b/Git/LsTree.hs index 8294f7b93..bce635096 100644 --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -37,13 +37,26 @@ lsTree t repo = map parseLsTree <$> pipeNullSplitZombie (lsTreeParams t) repo lsTreeParams :: Ref -> [CommandParam] -lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ fromRef t ] +lsTreeParams t = + [ Param "ls-tree" + , Param "--full-tree" + , Param "-z" + , Param "-r" + , Param "--" + , File $ fromRef t + ] {- Lists specified files in a tree. -} lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem] lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo where - ps = [Params "ls-tree --full-tree -z --", File $ fromRef t] ++ map File fs + ps = + [ Param "ls-tree" + , Param "--full-tree" + , Param "-z" + , Param "--" + , File $ fromRef t + ] ++ map File fs {- Parses a line of ls-tree output. - (The --long format is not currently supported.) -} diff --git a/Git/Repair.hs b/Git/Repair.hs index 2557e3b83..46cf22123 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -99,7 +99,7 @@ retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResult retrieveMissingObjects missing referencerepo r | not (foundBroken missing) = return missing | otherwise = withTmpDir "tmprepo" $ \tmpdir -> do - unlessM (boolSystem "git" [Params "init", File tmpdir]) $ + unlessM (boolSystem "git" [Param "init", File tmpdir]) $ error $ "failed to create temp repository in " ++ tmpdir tmpr <- Config.read =<< Construct.fromAbsPath tmpdir stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing @@ -140,7 +140,9 @@ retrieveMissingObjects missing referencerepo r ps' = [ Param "fetch" , Param fetchurl - , Params "--force --update-head-ok --quiet" + , Param "--force" + , Param "--update-head-ok" + , Param "--quiet" ] ++ ps fetchr' = fetchr { gitGlobalOpts = gitGlobalOpts fetchr ++ nogc } nogc = [ Param "-c", Param "gc.auto=0" ] diff --git a/Remote/Bup.hs b/Remote/Bup.hs index b3152afcf..0c156345e 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -167,7 +167,7 @@ remove buprepo k = do | otherwise = void $ liftIO $ catchMaybeIO $ do r' <- Git.Config.read r boolSystem "git" $ Git.Command.gitCommandLine params r' - params = [ Params "branch -q -D", Param (bupRef k) ] + params = [ Param "branch", Param "-q", Param "-D", Param (bupRef k) ] {- Bup does not provide a way to tell if a given dataset is present - in a bup repository. One way it to check if the git repository has @@ -182,7 +182,9 @@ checkKey r bupr k Git.Command.gitCommandLine params bupr where params = - [ Params "show-ref --quiet --verify" + [ Param "show-ref" + , Param "--quiet" + , Param "--verify" , Param $ "refs/heads/" ++ bupRef k ] @@ -194,7 +196,7 @@ storeBupUUID u buprepo = do then do showAction "storing uuid" unlessM (onBupRemote r boolSystem "git" - [Params $ "config annex.uuid " ++ v]) $ + [Param "config", Param "annex.uuid", Param v]) $ error "ssh failed" else liftIO $ do r' <- Git.Config.read r diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index fc0c27f37..8a1dcc41a 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -175,7 +175,7 @@ gCryptSetup mu _ c = go $ M.lookup "gitrepo" c go (Just gitrepo) = do (c', _encsetup) <- encryptionSetup c inRepo $ Git.Command.run - [ Params "remote add" + [ Param "remote", Param "add" , Param remotename , Param $ Git.GCrypt.urlPrefix ++ gitrepo ] @@ -251,7 +251,7 @@ setupRepo gcryptid r void $ Git.Config.changeFile tmpconfig coreGCryptId gcryptid void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig False) ok <- liftIO $ rsync $ rsynctransport ++ - [ Params "--recursive" + [ Param "--recursive" , Param $ tmp ++ "/" , Param rsyncurl ] diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 546e28048..1e4daa1ad 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -95,7 +95,7 @@ inAnnex r k = do {- Removes a key from a remote. -} dropKey :: Git.Repo -> Key -> Annex Bool dropKey r key = onRemote r (boolSystem, return False) "dropkey" - [ Params "--quiet --force" + [ Param "--quiet", Param "--force" , Param $ key2file key ] [] diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 2c8b17884..3986863b3 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -172,10 +172,9 @@ store o k src meterupdate = withRsyncScratchDir $ \tmp -> do ps <- sendParams if ok then showResumable $ rsyncRemote Upload o (Just meterupdate) $ ps ++ - [ Param "--recursive" - , partialParams + Param "--recursive" : partialParams ++ -- tmp/ to send contents of tmp dir - , File $ addTrailingPathSeparator tmp + [ File $ addTrailingPathSeparator tmp , Param $ rsyncUrl o ] else return False @@ -204,9 +203,9 @@ remove o k = do rsync $ rsyncOptions o ++ ps ++ map (\s -> Param $ "--include=" ++ s) includes ++ [ Param "--exclude=*" -- exclude everything else - , Params "--quiet --delete --recursive" - , partialParams - , Param $ addTrailingPathSeparator dummy + , Param "--quiet", Param "--delete", Param "--recursive" + ] ++ partialParams ++ + [ Param $ addTrailingPathSeparator dummy , Param $ rsyncUrl o ] where @@ -237,8 +236,8 @@ checkKey r o k = do {- Rsync params to enable resumes of sending files safely, - ensure that files are only moved into place once complete -} -partialParams :: CommandParam -partialParams = Params "--partial --partial-dir=.rsync-partial" +partialParams :: [CommandParam] +partialParams = [Param "--partial", Param "--partial-dir=.rsync-partial"] {- When sending files from crippled filesystems, the permissions can be all - messed up, and it's better to use the default permissions on the @@ -290,7 +289,7 @@ rsyncRemote direction o m params = do oh <- mkOutputHandler liftIO $ rsyncProgress oh meter ps where - ps = opts ++ [Params "--progress"] ++ params + ps = opts ++ Param "--progress" : params opts | direction == Download = rsyncDownloadOptions o | otherwise = rsyncUploadOptions o diff --git a/Test.hs b/Test.hs index e6a678f55..85c9de9a6 100644 --- a/Test.hs +++ b/Test.hs @@ -261,7 +261,7 @@ test_add = inmainrepo $ do , do writeFile ingitfile $ content ingitfile boolSystem "git" [Param "add", File ingitfile] @? "git add failed" - boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed" + boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "commit"] @? "git commit failed" git_annex "add" [ingitfile] @? "add ingitfile should be no-op" unannexed ingitfile ) @@ -314,7 +314,7 @@ test_unannex_withcopy = intmpclonerepo $ do test_drop_noremote :: Assertion test_drop_noremote = intmpclonerepo $ do git_annex "get" [annexedfile] @? "get failed" - boolSystem "git" [Params "remote rm origin"] + boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "git remote rm origin failed" not <$> git_annex "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file" annexed_present annexedfile @@ -503,7 +503,7 @@ test_edit' precommit = intmpclonerepoInDirect $ do if precommit then git_annex "pre-commit" [] @? "pre-commit failed" - else boolSystem "git" [Params "commit -q -m contentchanged"] + else boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "contentchanged"] @? "git commit of edited file failed" runchecks [checklink, checkunwritable] annexedfile c <- readFile annexedfile @@ -515,7 +515,7 @@ test_partial_commit = intmpclonerepoInDirect $ do git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile git_annex "unlock" [annexedfile] @? "unlock failed" - not <$> boolSystem "git" [Params "commit -q -m test", File annexedfile] + not <$> boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile] @? "partial commit of unlocked file not blocked by pre-commit hook" test_fix :: Assertion @@ -675,15 +675,15 @@ test_unused = intmpclonerepoInDirect $ do git_annex "get" [annexedfile] @? "get of file failed" git_annex "get" [sha1annexedfile] @? "get of file failed" checkunused [] "after get" - boolSystem "git" [Params "rm -fq", File annexedfile] @? "git rm failed" + boolSystem "git" [Param "rm", Param "-fq", File annexedfile] @? "git rm failed" checkunused [] "after rm" - boolSystem "git" [Params "commit -q -m foo"] @? "git commit failed" + boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "foo"] @? "git commit failed" checkunused [] "after commit" -- unused checks origin/master; once it's gone it is really unused - boolSystem "git" [Params "remote rm origin"] @? "git remote rm origin failed" + boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "git remote rm origin failed" checkunused [annexedfilekey] "after origin branches are gone" - boolSystem "git" [Params "rm -fq", File sha1annexedfile] @? "git rm failed" - boolSystem "git" [Params "commit -q -m foo"] @? "git commit failed" + boolSystem "git" [Param "rm", Param "-fq", File sha1annexedfile] @? "git rm failed" + boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "foo"] @? "git commit failed" checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile" -- good opportunity to test dropkey also @@ -702,7 +702,7 @@ test_unused = intmpclonerepoInDirect $ do git_annex "add" ["unusedfile"] @? "add of unusedfile failed" unusedfilekey <- annexeval $ findkey "unusedfile" renameFile "unusedfile" "unusedunstagedfile" - boolSystem "git" [Params "rm -qf", File "unusedfile"] @? "git rm failed" + boolSystem "git" [Param "rm", Param "-qf", File "unusedfile"] @? "git rm failed" checkunused [] "with unstaged link" removeFile "unusedunstagedfile" checkunused [unusedfilekey] "with unstaged link deleted" @@ -714,7 +714,7 @@ test_unused = intmpclonerepoInDirect $ do boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed" unusedfilekey' <- annexeval $ findkey "unusedfile" checkunused [] "with staged deleted link" - boolSystem "git" [Params "rm -qf", File "unusedfile"] @? "git rm failed" + boolSystem "git" [Param "rm", Param "-qf", File "unusedfile"] @? "git rm failed" checkunused [unusedfilekey'] "with staged link deleted" -- unused used to miss symlinks that were deleted or modified @@ -799,13 +799,13 @@ test_union_merge_regression = withtmpclonerepo False $ \r3 -> do forM_ [r1, r2, r3] $ \r -> indir r $ do when (r /= r1) $ - boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" + boolSystem "git" [Param "remote", Param "add", Param "r1", File ("../../" ++ r1)] @? "remote add" when (r /= r2) $ - boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add" + boolSystem "git" [Param "remote", Param "add", Param "r2", File ("../../" ++ r2)] @? "remote add" when (r /= r3) $ - boolSystem "git" [Params "remote add r3", File ("../../" ++ r3)] @? "remote add" + boolSystem "git" [Param "remote", Param "add", Param "r3", File ("../../" ++ r3)] @? "remote add" git_annex "get" [annexedfile] @? "get failed" - boolSystem "git" [Params "remote rm origin"] @? "remote rm" + boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "remote rm" forM_ [r3, r2, r1] $ \r -> indir r $ git_annex "sync" [] @? "sync failed" forM_ [r3, r2] $ \r -> indir r $ @@ -995,7 +995,7 @@ test_nonannexed_file_conflict_resolution = do indir r2 $ do disconnectOrigin writeFile conflictor nonannexed_content - boolSystem "git" [Params "add", File conflictor] @? "git add conflictor failed" + boolSystem "git" [Param "add", File conflictor] @? "git add conflictor failed" git_annex "sync" [] @? "sync failed in r2" pair r1 r2 let l = if inr1 then [r1, r2] else [r2, r1] @@ -1046,7 +1046,7 @@ test_nonannexed_symlink_conflict_resolution = do indir r2 $ do disconnectOrigin createSymbolicLink symlinktarget "conflictor" - boolSystem "git" [Params "add", File conflictor] @? "git add conflictor failed" + boolSystem "git" [Param "add", File conflictor] @? "git add conflictor failed" git_annex "sync" [] @? "sync failed in r2" pair r1 r2 let l = if inr1 then [r1, r2] else [r2, r1] @@ -1154,9 +1154,9 @@ test_conflict_resolution_symlink_bit = pair :: FilePath -> FilePath -> Assertion pair r1 r2 = forM_ [r1, r2] $ \r -> indir r $ do when (r /= r1) $ - boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" + boolSystem "git" [Param "remote", Param "add", Param "r1", File ("../../" ++ r1)] @? "remote add" when (r /= r2) $ - boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add" + boolSystem "git" [Param "remote", Param "add", Param "r2", File ("../../" ++ r2)] @? "remote add" test_map :: Assertion test_map = intmpclonerepo $ do @@ -1176,7 +1176,7 @@ test_uninit = intmpclonerepo $ do test_uninit_inbranch :: Assertion test_uninit_inbranch = intmpclonerepoInDirect $ do - boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex" + boolSystem "git" [Param "checkout", Param "git-annex"] @? "git checkout git-annex" not <$> git_annex "uninit" [] @? "uninit failed to fail when git-annex branch was checked out" test_upgrade :: Assertion @@ -1448,7 +1448,7 @@ withtmpclonerepo bare a = do bracket (clonerepo mainrepodir dir bare) cleanup a disconnectOrigin :: Assertion -disconnectOrigin = boolSystem "git" [Params "remote rm origin"] @? "remote rm" +disconnectOrigin = boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "remote rm" withgitrepo :: (FilePath -> Assertion) -> Assertion withgitrepo = bracket (setuprepo mainrepodir) return @@ -1469,7 +1469,7 @@ setuprepo :: FilePath -> IO FilePath setuprepo dir = do cleanup dir ensuretmpdir - boolSystem "git" [Params "init -q", File dir] @? "git init failed" + boolSystem "git" [Param "init", Param "-q", File dir] @? "git init failed" configrepo dir return dir @@ -1479,7 +1479,7 @@ clonerepo old new bare = do cleanup new ensuretmpdir let b = if bare then " --bare" else "" - boolSystem "git" [Params ("clone -q" ++ b), File old, File new] @? "git clone failed" + boolSystem "git" [Param "clone", Param "-q", Param b, File old, File new] @? "git clone failed" configrepo new indir new $ git_annex "init" ["-q", new] @? "git annex init failed" @@ -1491,10 +1491,10 @@ clonerepo old new bare = do configrepo :: FilePath -> IO () configrepo dir = indir dir $ do -- ensure git is set up to let commits happen - boolSystem "git" [Params "config user.name", Param "Test User"] @? "git config failed" - boolSystem "git" [Params "config user.email test@example.com"] @? "git config failed" + boolSystem "git" [Param "config", Param "user.name", Param "Test User"] @? "git config failed" + boolSystem "git" [Param "config", Param "user.email", Param "test@example.com"] @? "git config failed" -- avoid signed commits by test suite - boolSystem "git" [Params "config commit.gpgsign false"] @? "git config failed" + boolSystem "git" [Param "config", Param "commit.gpgsign", Param "false"] @? "git config failed" handleforcedirect :: IO () handleforcedirect = whenM ((==) "1" <$> Utility.Env.getEnvDefault "FORCEDIRECT" "") $ diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index a1b782d97..0a0b04a03 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -60,17 +60,20 @@ stdParams params = do {- Usual options for symmetric / public-key encryption. -} stdEncryptionParams :: Bool -> [CommandParam] -stdEncryptionParams symmetric = - [ enc symmetric - , Param "--force-mdc" +stdEncryptionParams symmetric = enc symmetric ++ + [ Param "--force-mdc" , Param "--no-textmode" ] where - enc True = Param "--symmetric" + enc True = [ Param "--symmetric" ] -- Force gpg to only encrypt to the specified recipients, not -- configured defaults. Recipients are assumed to be specified in -- elsewhere. - enc False = Params "--encrypt --no-encrypt-to --no-default-recipient" + enc False = + [ Param "--encrypt" + , Param "--no-encrypt-to" + , Param "--no-default-recipient" + ] {- Runs gpg with some params and returns its stdout, strictly. -} readStrict :: [CommandParam] -> IO String @@ -152,7 +155,7 @@ pipeLazy params feeder reader = do findPubKeys :: String -> IO KeyIds findPubKeys for = KeyIds . parse . lines <$> readStrict params where - params = [Params "--with-colons --list-public-keys", Param for] + params = [Param "--with-colons", Param "--list-public-keys", Param for] parse = mapMaybe (keyIdField . split ":") keyIdField ("pub":_:_:_:f:_) = Just f keyIdField _ = Nothing @@ -165,7 +168,7 @@ secretKeys :: IO (M.Map KeyId UserId) secretKeys = catchDefaultIO M.empty makemap where makemap = M.fromList . parse . lines <$> readStrict params - params = [Params "--with-colons --list-secret-keys --fixed-list-mode"] + params = [Param "--with-colons", Param "--list-secret-keys", Param "--fixed-list-mode"] parse = extract [] Nothing . map (split ":") extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) = extract ((keyid, decode_c userid):c) Nothing rest @@ -215,13 +218,14 @@ genSecretKey keytype passphrase userid keysize = - It is armored, to avoid newlines, since gpg only reads ciphers up to the - first newline. -} genRandom :: Bool -> Size -> IO String -genRandom highQuality size = checksize <$> readStrict - [ Params params - , Param $ show randomquality - , Param $ show size - ] +genRandom highQuality size = checksize <$> readStrict params where - params = "--gen-random --armor" + params = + [ Param "--gen-random" + , Param "--armor" + , Param $ show randomquality + , Param $ show size + ] -- See http://www.gnupg.org/documentation/manuals/gcrypt/Quality-of-random-numbers.html -- for the meaning of random quality levels. @@ -242,7 +246,7 @@ genRandom highQuality size = checksize <$> readStrict else shortread len shortread got = error $ unwords - [ "Not enough bytes returned from gpg", params + [ "Not enough bytes returned from gpg", show params , "(got", show got, "; expected", show expectedlength, ")" ] @@ -335,8 +339,8 @@ testHarness a = do dir <- mktmpdir $ base "gpgtmpXXXXXX" setEnv var dir True -- For some reason, recent gpg needs a trustdb to be set up. - _ <- pipeStrict [Params "--trust-model auto --update-trustdb"] [] - _ <- pipeStrict [Params "--import -q"] $ unlines + _ <- pipeStrict [Param "--trust-model auto", Param "--update-trustdb"] [] + _ <- pipeStrict [Param "--import", Param "-q"] $ unlines [testSecretKey, testKey] return dir @@ -356,13 +360,13 @@ checkEncryptionFile :: FilePath -> Maybe KeyIds -> IO Bool checkEncryptionFile filename keys = checkGpgPackets keys =<< readStrict params where - params = [Params "--list-packets --list-only", File filename] + params = [Param "--list-packets", Param "--list-only", File filename] checkEncryptionStream :: String -> Maybe KeyIds -> IO Bool checkEncryptionStream stream keys = checkGpgPackets keys =<< pipeStrict params stream where - params = [Params "--list-packets --list-only"] + params = [Param "--list-packets", Param "--list-only"] {- Parses an OpenPGP packet list, and checks whether data is - symmetrically encrypted (keys is Nothing), or encrypted to some diff --git a/Utility/Quvi.hs b/Utility/Quvi.hs index 0412116a1..8d37b1c8f 100644 --- a/Utility/Quvi.hs +++ b/Utility/Quvi.hs @@ -108,7 +108,8 @@ check v ps url = maybe False (not . null . pageLinks) <$> query v ps url supported :: QuviVersion -> URLString -> IO Bool supported NoQuvi _ = return False supported Quvi04 url = boolSystem "quvi" - [ Params "--verbosity mute --support" + [ Param "--verbosity mute" + , Param "--support" , Param url ] {- Use quvi-info to see if the url's domain is supported. @@ -134,18 +135,18 @@ listdomains Quvi09 = concatMap (split ",") (toCommand [Param "info", Param "-p", Param "domains"]) listdomains _ = return [] -type QuviParam = QuviVersion -> CommandParam +type QuviParams = QuviVersion -> [CommandParam] {- Disables progress, but not information output. -} -quiet :: QuviParam +quiet :: QuviParams -- Cannot use quiet as it now disables informational output. -- No way to disable progress. -quiet Quvi09 = Params "--verbosity verbose" -quiet Quvi04 = Params "--verbosity quiet" -quiet NoQuvi = Params "" +quiet Quvi09 = [Param "--verbosity", Param "verbose"] +quiet Quvi04 = [Param "--verbosity", Param "quiet"] +quiet NoQuvi = [] {- Only return http results, not streaming protocols. -} -httponly :: QuviParam +httponly :: QuviParams -- No way to do it with 0.9? -httponly Quvi04 = Params "-c http" -httponly _ = Params "" -- No way to do it with 0.9? +httponly Quvi04 = [Param "-c", Param "http"] +httponly _ = [] -- No way to do it with 0.9? diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index 4f4c4eb5d..3aaf9281b 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -44,7 +44,8 @@ rsyncServerParams = -- allow resuming of transfers of big files , Param "--inplace" -- other options rsync normally uses in server mode - , Params "-e.Lsf ." + , Param "-e.Lsf" + , Param "." ] rsyncUseDestinationPermissions :: CommandParam diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs index 82e35049a..9102b7267 100644 --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -19,25 +19,23 @@ import Prelude -- | Parameters that can be passed to a shell command. data CommandParam - = Params String -- ^ Contains multiple parameters, separated by whitespace - | Param String -- ^ A single parameter + = Param String -- ^ A parameter | File FilePath -- ^ The name of a file deriving (Eq, Show, Ord) -- | Used to pass a list of CommandParams to a function that runs -- a command and expects Strings. -} toCommand :: [CommandParam] -> [String] -toCommand = concatMap unwrap +toCommand = map unwrap where - unwrap (Param s) = [s] - unwrap (Params s) = filter (not . null) (split " " s) + unwrap (Param s) = s -- Files that start with a non-alphanumeric that is not a path -- separator are modified to avoid the command interpreting them as -- options or other special constructs. unwrap (File s@(h:_)) - | isAlphaNum h || h `elem` pathseps = [s] - | otherwise = ["./" ++ s] - unwrap (File s) = [s] + | isAlphaNum h || h `elem` pathseps = s + | otherwise = "./" ++ s + unwrap (File s) = s -- '/' is explicitly included because it's an alternative -- path separator on Windows. pathseps = pathSeparator:"./" diff --git a/Utility/Url.hs b/Utility/Url.hs index 2ef1167e5..81a9a1b05 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -228,14 +228,14 @@ download' quiet url file uo = do - a less cluttered download display. -} #ifndef __ANDROID__ - wgetparams = catMaybes + wgetparams = concat [ if Build.SysConfig.wgetquietprogress && not quiet - then Just $ Params "-q --show-progress" - else Nothing - , Just $ Params "--clobber -c -O" + then [Param "-q", Param "--show-progress"] + else [] + , [ Param "--clobber", Param "-c", Param "-O"] ] #else - wgetparams = [Params "-c -O"] + wgetparams = [Param "-c", Param "-O"] #endif {- Uses the -# progress display, because the normal - one is very confusing when resuming, showing @@ -247,7 +247,7 @@ download' quiet url file uo = do -- if the url happens to be empty, so pre-create. writeFile file "" go "curl" $ headerparams ++ quietopt "-s" ++ - [Params "-f -L -C - -# -o"] + [Param "-f", Param "-L", Param "-C", Param "-", Param "-#", Param "-o"] {- Run wget in a temp directory because it has been buggy - and overwritten files in the current directory, even though -- cgit v1.2.3