From 367d1352daadebc3fa5ec402484f6c1ad7a877fd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Aug 2015 14:09:25 -0400 Subject: [PATCH] git-annex-shell: Don't let configlist auto-init repository when in readonly mode. This was potentially a hole in the readonly mode armor even before my last commit. If the user could push a git-annex branch to a repo, they could get git-annex-shell to initialize the repo. After my last commit, the user didn't even need to be allowed to push a branch to init the repo, so this hole certianly needs to be closed now. --- CmdLine/GitAnnexShell.hs | 63 ++----------------------------- CmdLine/GitAnnexShell/Checks.hs | 67 +++++++++++++++++++++++++++++++++ Command/ConfigList.hs | 2 + debian/changelog | 2 + 4 files changed, 74 insertions(+), 60 deletions(-) create mode 100644 CmdLine/GitAnnexShell/Checks.hs diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index 170548d1c3..59c861582d 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." diff --git a/CmdLine/GitAnnexShell/Checks.hs b/CmdLine/GitAnnexShell/Checks.hs new file mode 100644 index 0000000000..5513d69cd1 --- /dev/null +++ b/CmdLine/GitAnnexShell/Checks.hs @@ -0,0 +1,67 @@ +{- git-annex-shell checks + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module CmdLine.GitAnnexShell.Checks where + +import Common.Annex +import Command +import qualified Annex +import Annex.Init +import Utility.UserInfo +import Utility.Env + +checkNotLimited :: IO () +checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED" + +checkNotReadOnly :: IO () +checkNotReadOnly = checkEnv "GIT_ANNEX_SHELL_READONLY" + +checkEnv :: String -> IO () +checkEnv var = do + v <- getEnv var + case v of + Nothing -> noop + Just "" -> noop + Just _ -> error $ "Action blocked by " ++ var + +checkDirectory :: Maybe FilePath -> IO () +checkDirectory mdir = do + v <- 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 + +{- 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." diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index e65d0f0338..46c909107b 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -15,6 +15,7 @@ import qualified Annex.Branch import qualified Git.Config import Remote.GCrypt (coreGCryptId) import qualified CmdLine.GitAnnexShell.Fields as Fields +import CmdLine.GitAnnexShell.Checks cmd :: Command cmd = noCommit $ dontCheck repoExists $ @@ -44,6 +45,7 @@ findOrGenUUID = do then return u else ifM (Annex.Branch.hasSibling <||> (isJust <$> Fields.getField Fields.autoInit)) ( do + liftIO checkNotReadOnly initialize Nothing getUUID , return NoUUID diff --git a/debian/changelog b/debian/changelog index 1943e39745..dc02ede0ed 100644 --- a/debian/changelog +++ b/debian/changelog @@ -28,6 +28,8 @@ git-annex (5.20150732) UNRELEASED; urgency=medium to manually be pushed before using git-annex sync. Note that this involved changes to git-annex-shell, so if the remote is using an old version, the manual push is still needed. + * git-annex-shell: Don't let configlist auto-init repository when in + readonly mode. -- Joey Hess Fri, 31 Jul 2015 12:31:39 -0400