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.

1 files changed, 17 insertions, 6 deletions

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