d2576e5f1a
For NotifyChanges and also for the fallthrough case where git-annex-shell passes a command off to git-shell, proxying is currently ignored. So every remote that is accessed via a proxy will be treated as the same git repository. Every other command listed in cmdsMap will need to check if Annex.proxyremote is set, and if so handle the proxying appropriately. Probably only P2PStdio will need to support proxying. For now, everything else refuses to work when proxying. The part of that I don't like is that there's the possibility a command later gets added to the list that doesn't check proxying. When proxying is not enabled, it's important that git-annex-shell not leak information that it would not have exposed before. Such as the names or uuids of remotes. I decided that, in the case where a repository used to have proxying enabled, but no longer supports any proxies, it's ok to give the user a clear error message indicating that proxying is not configured, rather than a confusing uuid mismatch message. Similarly, if a repository has proxying enabled, but not for the requested repository, give a clear error message. A tricky thing here is how to handle the case where there is more than one remote, with proxying enabled, with the specified uuid. One way to handle that would be to plumb the proxyRemoteName all the way through from the remote git-annex to git-annex-shell, eg as a field, and use only a remote with the same name. That would be very intrusive though. Instead, I decided to let the proxy pick which remote it uses to access a given Remote. And so it picks the least expensive one. The client after all doesn't necessarily know any details about the proxy's configuration. This does mean though, that if the least expensive remote is not accessible, but another remote would have worked, an access via the proxy will fail.
93 lines
2.5 KiB
Haskell
93 lines
2.5 KiB
Haskell
{- git-annex-shell checks
|
|
-
|
|
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module CmdLine.GitAnnexShell.Checks where
|
|
|
|
import Annex.Common
|
|
import Command
|
|
import qualified Annex
|
|
import Annex.Init
|
|
import Utility.UserInfo
|
|
import Utility.Env
|
|
|
|
limitedEnv :: String
|
|
limitedEnv = "GIT_ANNEX_SHELL_LIMITED"
|
|
|
|
checkNotLimited :: IO ()
|
|
checkNotLimited = checkEnv limitedEnv
|
|
|
|
readOnlyEnv :: String
|
|
readOnlyEnv = "GIT_ANNEX_SHELL_READONLY"
|
|
|
|
checkNotReadOnly :: IO ()
|
|
checkNotReadOnly = checkEnv readOnlyEnv
|
|
|
|
appendOnlyEnv :: String
|
|
appendOnlyEnv = "GIT_ANNEX_SHELL_APPENDONLY"
|
|
|
|
checkNotAppendOnly :: IO ()
|
|
checkNotAppendOnly = checkEnv appendOnlyEnv
|
|
|
|
checkEnv :: String -> IO ()
|
|
checkEnv var = checkEnvSet var >>= \case
|
|
False -> noop
|
|
True -> giveup $ "Action blocked by " ++ var
|
|
|
|
checkEnvSet :: String -> IO Bool
|
|
checkEnvSet var = getEnv var >>= return . \case
|
|
Nothing -> False
|
|
Just "" -> False
|
|
Just _ -> True
|
|
|
|
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' = giveup $ 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 $ fromRawFilePath $ absPathFrom
|
|
(toRawFilePath home)
|
|
(toRawFilePath 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 GitAnnexShellOk okforshell . dontCheck repoExists
|
|
where
|
|
okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
|
|
giveup "Not a git-annex or gcrypt repository."
|
|
|
|
{- Used for Commands that don't support proxying. -}
|
|
notProxyable :: Command -> Command
|
|
notProxyable c = addCheck GitAnnexShellNotProxyable checkok c
|
|
where
|
|
checkok = Annex.getState Annex.proxyremote >>= \case
|
|
Nothing -> return ()
|
|
Just _ -> giveup $ "Cannot proxy " ++ cmdname c ++ " command."
|
|
|