implemented git-annex-shell p2pstdio

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.
This commit is contained in:
Joey Hess 2018-03-07 15:15:23 -04:00
parent fa5b19f0ff
commit 6ddfa9807b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
10 changed files with 110 additions and 11 deletions

View file

@ -1,6 +1,6 @@
{- git-annex-shell main program
-
- Copyright 2010-2012 Joey Hess <id@joeyh.name>
- Copyright 2010-2018 Joey Hess <id@joeyh.name>
-
- 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

View file

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