diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/LockContent.hs | 18 | ||||
| -rw-r--r-- | Command/P2PStdIO.hs | 44 |
2 files changed, 51 insertions, 11 deletions
diff --git a/Command/LockContent.hs b/Command/LockContent.hs index 202ba20d1..1ed8cdf0b 100644 --- a/Command/LockContent.hs +++ b/Command/LockContent.hs @@ -22,9 +22,8 @@ cmd = noCommit $ seek :: CmdParams -> CommandSeek seek = withWords start --- First, lock the content. Then, make sure the content is actually --- present, and print out "OK". Wait for the caller to send a line before --- dropping the lock. +-- First, lock the content, then print out "OK". +-- Wait for the caller to send a line before dropping the lock. start :: [String] -> CommandStart start [ks] = do ok <- lockContentShared k (const locksuccess) @@ -34,12 +33,9 @@ start [ks] = do else exitFailure where k = fromMaybe (giveup "bad key") (file2key ks) - locksuccess = ifM (inAnnex k) - ( liftIO $ do - putStrLn contentLockedMarker - hFlush stdout - _ <- getProtocolLine stdin - return True - , return False - ) + locksuccess = liftIO $ do + putStrLn contentLockedMarker + hFlush stdout + _ <- getProtocolLine stdin + return True start _ = giveup "Specify exactly 1 key." diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs new file mode 100644 index 000000000..f6e4ae0f0 --- /dev/null +++ b/Command/P2PStdIO.hs @@ -0,0 +1,44 @@ +{- git-annex command + - + - Copyright 2018 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.P2PStdIO where + +import Command +import P2P.IO +import P2P.Annex +import qualified P2P.Protocol as P2P +import Git.Types +import qualified Annex +import Annex.UUID +import qualified CmdLine.GitAnnexShell.Checks as Checks +import qualified CmdLine.GitAnnexShell.Fields as Fields +import Utility.AuthToken +import Utility.Tmp.Dir + +cmd :: Command +cmd = noMessages $ command "p2pstdio" SectionPlumbing + "communicate in P2P protocol over stdio" + paramNothing (withParams seek) + +seek :: CmdParams -> CommandSeek +seek = withNothing start + +start :: CommandStart +start = do + servermode <- liftIO $ + Checks.checkEnvSet Checks.readOnlyEnv >>= return . \case + True -> P2P.ServeReadOnly + False -> P2P.ServeReadWrite + theiruuid <- Fields.getField Fields.remoteUUID >>= \case + Nothing -> giveup "missing remoteuuid field" + Just u -> return (toUUID u) + myuuid <- getUUID + conn <- stdioP2PConnection <$> Annex.gitRepo + let server = P2P.serveAuthed servermode myuuid + runFullProto (Serving theiruuid Nothing) conn server >>= \case + Right () -> next $ next $ return True + Left e -> giveup e |