From 9f4771eb3c3f29ea38bbfc70eaf78198ca948840 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 7 Mar 2018 15:15:23 -0400 Subject: implemented git-annex-shell p2pstdio MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Not yet used by git-annex, but this will allow faster transfers etc than using individual ssh connections and rsync. Not called git-annex-shell p2p, because git-annex p2p does something else and I don't want two subcommands with the same name between the two for sanity reasons. This commit was sponsored by Øyvind Andersen Holm. --- CmdLine/GitAnnexShell.hs | 17 ++++++++++++++--- CmdLine/GitAnnexShell/Checks.hs | 23 +++++++++++++++++------ 2 files changed, 31 insertions(+), 9 deletions(-) (limited to 'CmdLine') diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index 154bfeb38..3dc31e602 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -1,6 +1,6 @@ {- git-annex-shell main program - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -28,6 +28,7 @@ import qualified Command.TransferInfo import qualified Command.Commit import qualified Command.NotifyChanges import qualified Command.GCryptSetup +import qualified Command.P2PStdIO cmds_readonly :: [Command] cmds_readonly = @@ -47,8 +48,18 @@ cmds_notreadonly = , Command.GCryptSetup.cmd ] +-- Commands that can operate readonly or not; they use checkNotReadOnly. +cmds_readonly_capable :: [Command] +cmds_readonly_capable = + [ gitAnnexShellCheck Command.P2PStdIO.cmd + ] + +cmds_readonly_safe :: [Command] +cmds_readonly_safe = cmds_readonly ++ cmds_readonly_capable + cmds :: [Command] -cmds = map (adddirparam . noMessages) (cmds_readonly ++ cmds_notreadonly) +cmds = map (adddirparam . noMessages) + (cmds_readonly ++ cmds_notreadonly ++ cmds_readonly_capable) where adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c } @@ -94,7 +105,7 @@ builtins = map cmdname cmds builtin :: String -> String -> [String] -> IO () builtin cmd dir params = do - unless (cmd `elem` map cmdname cmds_readonly) + unless (cmd `elem` map cmdname cmds_readonly_safe) checkNotReadOnly checkDirectory $ Just dir let (params', fieldparams, opts) = partitionParams params diff --git a/CmdLine/GitAnnexShell/Checks.hs b/CmdLine/GitAnnexShell/Checks.hs index fcbf14b24..3409884c0 100644 --- a/CmdLine/GitAnnexShell/Checks.hs +++ b/CmdLine/GitAnnexShell/Checks.hs @@ -14,17 +14,28 @@ import Annex.Init import Utility.UserInfo import Utility.Env +limitedEnv :: String +limitedEnv = "GIT_ANNEX_SHELL_LIMITED" + checkNotLimited :: IO () -checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED" +checkNotLimited = checkEnv limitedEnv + +readOnlyEnv :: String +readOnlyEnv = "GIT_ANNEX_SHELL_READONLY" checkNotReadOnly :: IO () -checkNotReadOnly = checkEnv "GIT_ANNEX_SHELL_READONLY" +checkNotReadOnly = checkEnv readOnlyEnv checkEnv :: String -> IO () -checkEnv var = getEnv var >>= \case - Nothing -> noop - Just "" -> noop - Just _ -> giveup $ "Action blocked by " ++ var +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 -- cgit v1.2.3