diff options
author | Joey Hess <joey@kitenet.net> | 2011-02-28 16:10:16 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-02-28 16:18:55 -0400 |
commit | fcdc4797a9ab2b792a9bb20f2ca9802b8f6d5a1e (patch) | |
tree | 0471848c11df7c1481d8c735eab1280d7684eddc /Remotes.hs | |
parent | 7e5678bcf7cd78bd04520117201be37dc9d4d544 (diff) |
use ShellParam type
So, I have a type checked safe handling of filenames starting with dashes,
throughout the code.
Diffstat (limited to 'Remotes.hs')
-rw-r--r-- | Remotes.hs | 50 |
1 files changed, 27 insertions, 23 deletions
diff --git a/Remotes.hs b/Remotes.hs index c7e69aad8..1523e6750 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -64,7 +64,7 @@ tryGitConfigRead r Left _ -> return r Right r' -> return r' pipedconfig cmd params = safely $ - pOpen ReadFromPipe cmd params $ + pOpen ReadFromPipe cmd (toShell params) $ Git.hConfigRead r store a = do r' <- a @@ -154,7 +154,7 @@ inAnnex r key = if Git.repoIsUrl r checkremote = do showNote ("checking " ++ Git.repoDescribe r ++ "...") inannex <- onRemote r (boolSystem, False) "inannex" - ["--backend=" ++ backendName key, keyName key] + [Param ("--backend=" ++ backendName key), Param (keyName key)] return $ Right inannex {- Cost Ordered list of remotes. -} @@ -263,28 +263,31 @@ rsynchelper r sending key file = do {- Generates rsync parameters that ssh to the remote and asks it - to either receive or send the key's content. -} -rsyncParams :: Git.Repo -> Bool -> Key -> FilePath -> Annex [String] +rsyncParams :: Git.Repo -> Bool -> Key -> FilePath -> Annex [ShellParam] rsyncParams r sending key file = do - -- Note that the command is terminated with "--", because - -- rsync will tack on its own options to this command, - -- and they need to be ignored. - shellcmd <- git_annex_shell r + Just (shellcmd, shellparams) <- git_annex_shell r (if sending then "sendkey" else "recvkey") - ["--backend=" ++ backendName key, keyName key, "--"] + [ Param $ "--backend=" ++ backendName key + , Param $ keyName key + -- Command is terminated with "--", because + -- rsync will tack on its own options afterwards, + -- and they need to be ignored. + , Param "--" + ] -- Convert the ssh command into rsync command line. - let eparam = rsyncShell $ fromJust shellcmd + let eparam = rsyncShell (Param shellcmd:shellparams) o <- repoConfig r "rsync-options" "" - let base = options ++ words o ++ eparam + let base = options ++ map Param (words o) ++ eparam if sending - then return $ base ++ [dummy, file] - else return $ base ++ [file, dummy] + then return $ base ++ [dummy, File file] + else return $ base ++ [File file, dummy] where -- inplace makes rsync resume partial files - options = ["-p", "--progress", "--inplace"] + options = [Params "-p --progress --inplace"] -- the rsync shell parameter controls where rsync -- goes, so the source/dest parameter can be a dummy value, -- that just enables remote rsync mode. - dummy = ":" + dummy = Param ":" {- Uses a supplied function to run a git-annex-shell command on a remote. - @@ -292,30 +295,31 @@ rsyncParams r sending key file = do - a specified error value. -} onRemote :: Git.Repo - -> (String -> [String] -> IO a, a) + -> (FilePath -> [ShellParam] -> IO a, a) -> String - -> [String] + -> [ShellParam] -> Annex a onRemote r (with, errorval) command params = do s <- git_annex_shell r command params case s of - Just shellcmd -> liftIO $ with (shellcmd !! 0) (tail shellcmd) + Just (c, ps) -> liftIO $ with c ps Nothing -> return errorval {- Generates parameters to run a git-annex-shell command on a remote. -} -git_annex_shell :: Git.Repo -> String -> [String] -> Annex (Maybe [String]) +git_annex_shell :: Git.Repo -> String -> [ShellParam] -> Annex (Maybe (FilePath, [ShellParam])) git_annex_shell r command params - | not $ Git.repoIsUrl r = return $ Just (shellcmd:shellopts) + | not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts) | Git.repoIsSsh r = do sshoptions <- repoConfig r "ssh-options" "" - return $ Just $ ["ssh"] ++ words sshoptions ++ - [Git.urlHostFull r, sshcmd] + return $ Just ("ssh", map Param (words sshoptions) ++ + [Param (Git.urlHostFull r), Param sshcmd]) | otherwise = return Nothing where dir = Git.workTree r shellcmd = "git-annex-shell" - shellopts = command:dir:params - sshcmd = shellcmd ++ " " ++ unwords (map shellEscape shellopts) + shellopts = (Param command):(File dir):params + sshcmd = shellcmd ++ " " ++ + unwords (map shellEscape $ toShell shellopts) {- Looks up a per-remote config option in git config. - Failing that, tries looking for a global config option. -} |