summaryrefslogtreecommitdiff
path: root/CmdLine/GitAnnexShell.hs
diff options
context:
space:
mode:
Diffstat (limited to 'CmdLine/GitAnnexShell.hs')
-rw-r--r--CmdLine/GitAnnexShell.hs63
1 files changed, 3 insertions, 60 deletions
diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs
index 170548d1c..59c861582 100644
--- a/CmdLine/GitAnnexShell.hs
+++ b/CmdLine/GitAnnexShell.hs
@@ -7,8 +7,6 @@
module CmdLine.GitAnnexShell where
-import System.Environment
-
import Common.Annex
import qualified Git.Construct
import qualified Git.Config
@@ -16,11 +14,9 @@ import CmdLine
import CmdLine.GlobalSetter
import Command
import Annex.UUID
+import CmdLine.GitAnnexShell.Checks
import CmdLine.GitAnnexShell.Fields
-import Utility.UserInfo
import Remote.GCrypt (getGCryptUUID)
-import qualified Annex
-import Annex.Init
import qualified Command.ConfigList
import qualified Command.InAnnex
@@ -96,7 +92,8 @@ builtins = map cmdname cmds
builtin :: String -> String -> [String] -> IO ()
builtin cmd dir params = do
- checkNotReadOnly cmd
+ unless (cmd `elem` map cmdname cmds_readonly)
+ checkNotReadOnly
checkDirectory $ Just dir
let (params', fieldparams, opts) = partitionParams params
rsyncopts = ("RsyncOptions", unwords opts)
@@ -153,57 +150,3 @@ failure :: IO ()
failure = error $ "bad parameters\n\n" ++ usage h cmds
where
h = "git-annex-shell [-c] command [parameters ...] [option ...]"
-
-checkNotLimited :: IO ()
-checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"
-
-checkNotReadOnly :: String -> IO ()
-checkNotReadOnly cmd
- | cmd `elem` map cmdname cmds_readonly = noop
- | otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"
-
-checkDirectory :: Maybe FilePath -> IO ()
-checkDirectory mdir = do
- v <- catchMaybeIO $ getEnv "GIT_ANNEX_SHELL_DIRECTORY"
- case (v, mdir) of
- (Nothing, _) -> noop
- (Just d, Nothing) -> req d Nothing
- (Just d, Just dir)
- | d `equalFilePath` dir -> noop
- | otherwise -> do
- home <- myHomeDir
- d' <- canondir home d
- dir' <- canondir home dir
- if d' `equalFilePath` dir'
- then noop
- else req d' (Just dir')
- where
- req d mdir' = error $ unwords
- [ "Only allowed to access"
- , d
- , maybe "and could not determine directory from command line" ("not " ++) mdir'
- ]
-
- {- A directory may start with ~/ or in some cases, even /~/,
- - or could just be relative to home, or of course could
- - be absolute. -}
- canondir home d
- | "~/" `isPrefixOf` d = return d
- | "/~/" `isPrefixOf` d = return $ drop 1 d
- | otherwise = relHome $ absPathFrom home d
-
-checkEnv :: String -> IO ()
-checkEnv var = do
- v <- catchMaybeIO $ getEnv var
- case v of
- Nothing -> noop
- Just "" -> noop
- Just _ -> error $ "Action blocked by " ++ var
-
-{- Modifies a Command to check that it is run in either a git-annex
- - repository, or a repository with a gcrypt-id set. -}
-gitAnnexShellCheck :: Command -> Command
-gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists
- where
- okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
- error "Not a git-annex or gcrypt repository."