git-annex-shell can now be used as a login shell

This commit is contained in:
Joey Hess 2010-12-31 20:33:43 -04:00
parent e153a116bb
commit 5c29bb3b7c
3 changed files with 46 additions and 8 deletions

View file

@ -14,9 +14,13 @@ module Utility (
relPathDirToDir, relPathDirToDir,
boolSystem, boolSystem,
shellEscape, shellEscape,
shellUnEscape,
unsetFileMode, unsetFileMode,
readMaybe, readMaybe,
safeWriteFile safeWriteFile,
prop_idempotent_shellescape,
prop_idempotent_shellescape_multiword
) where ) where
import System.IO import System.IO
@ -128,6 +132,29 @@ shellEscape f = "'" ++ escaped ++ "'"
-- replace ' with '"'"' -- replace ' with '"'"'
escaped = join "'\"'\"'" $ split "'" f escaped = join "'\"'\"'" $ split "'" f
{- Unescapes a set of shellEscaped words or filenames. -}
shellUnEscape :: String -> [String]
shellUnEscape [] = []
shellUnEscape s = word:(shellUnEscape rest)
where
(word, rest) = findword "" s
findword w [] = (w, "")
findword w (c:cs)
| c == ' ' = (w, cs)
| c == '\'' = inquote c w cs
| c == '"' = inquote c w cs
| otherwise = findword (w++[c]) cs
inquote _ w [] = (w, "")
inquote q w (c:cs)
| c == q = findword w cs
| otherwise = inquote q (w++[c]) cs
{- For quickcheck. -}
prop_idempotent_shellescape :: String -> Bool
prop_idempotent_shellescape s = [s] == (shellUnEscape $ shellEscape s)
prop_idempotent_shellescape_multiword :: [String] -> Bool
prop_idempotent_shellescape_multiword s = s == (shellUnEscape $ unwords $ map shellEscape s)
{- Removes a FileMode from a file. {- Removes a FileMode from a file.
- For example, call with otherWriteMode to chmod o-w -} - For example, call with otherWriteMode to chmod o-w -}
unsetFileMode :: FilePath -> FileMode -> IO () unsetFileMode :: FilePath -> FileMode -> IO ()

View file

@ -7,6 +7,7 @@
import System.Environment import System.Environment
import Control.Monad (when) import Control.Monad (when)
import Data.List
import qualified GitRepo as Git import qualified GitRepo as Git
import CmdLine import CmdLine
@ -43,14 +44,14 @@ main' :: [String] -> IO ()
main' [] = failure main' [] = failure
-- skip leading -c options, passed by eg, ssh -- skip leading -c options, passed by eg, ssh
main' ("-c":p) = main' p main' ("-c":p) = main' p
-- Since git-annex explicitly runs git-annex-shell, we will be passed
-- a redundant "git-annex-shell" parameter when we're the user's login shell.
main' ("git-annex-shell":p) = main' p
-- a command can be either a builtin or something to pass to git-shell -- a command can be either a builtin or something to pass to git-shell
main' c@(cmd:dir:params) main' c@(cmd:dir:params)
| elem cmd builtins = builtin cmd dir params | elem cmd builtins = builtin cmd dir params
| otherwise = external c | otherwise = external c
main' c@(cmd:_) main' c@(cmd:_)
-- Handle the case of being the user's login shell. It will be passed
-- a single string containing all the real parameters.
| isPrefixOf "git-annex-shell " cmd = main' $ drop 1 $ shellUnEscape cmd
| elem cmd builtins = failure | elem cmd builtins = failure
| otherwise = external c | otherwise = external c
@ -60,13 +61,20 @@ builtins = map cmdname cmds
builtin :: String -> String -> [String] -> IO () builtin :: String -> String -> [String] -> IO ()
builtin cmd dir params = do builtin cmd dir params = do
let gitrepo = Git.repoFromPath dir let gitrepo = Git.repoFromPath dir
dispatch gitrepo (cmd:params) cmds commonOptions header dispatch gitrepo (cmd:(filterparams params)) cmds commonOptions header
external :: [String] -> IO () external :: [String] -> IO ()
external l = do external params = do
ret <- boolSystem "git-shell" ("-c":l) ret <- boolSystem "git-shell" ("-c":(filterparams params))
when (not ret) $ when (not ret) $
error "git-shell failed" error "git-shell failed"
-- Drop all args after "--".
-- These tend to be passed by rsync and not useful.
filterparams :: [String] -> [String]
filterparams [] = []
filterparams ("--":_) = []
filterparams (a:as) = a:filterparams as
failure :: IO () failure :: IO ()
failure = error $ "bad parameters\n\n" ++ usage header cmds commonOptions failure = error $ "bad parameters\n\n" ++ usage header cmds commonOptions

View file

@ -3,11 +3,14 @@ import Test.HUnit.Tools
import GitRepo import GitRepo
import Locations import Locations
import Utility
alltests :: [Test] alltests :: [Test]
alltests = [ alltests = [
qctest "prop_idempotent_deencode" prop_idempotent_deencode, qctest "prop_idempotent_deencode" prop_idempotent_deencode,
qctest "prop_idempotent_fileKey" prop_idempotent_fileKey qctest "prop_idempotent_fileKey" prop_idempotent_fileKey,
qctest "prop_idempotent_shellescape" prop_idempotent_shellescape,
qctest "prop_idempotent_shellescape_multiword" prop_idempotent_shellescape_multiword
] ]
main :: IO (Counts, Int) main :: IO (Counts, Int)