mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

git-annex-shell: Don't let configlist auto-init repository when in readonly mode.

Browse source 
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.
This commit is contained in:
Joey Hess 2015-08-05 14:09:25 -04:00
commit 367d1352da
4 changed files with 74 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

63
CmdLine/GitAnnexShell.hs
View file

@ -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."