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

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