fix p2p --pair

p2p --pair: Fix interception of the magic-wormhole pairing code, which
since 0.8.2 it has sent to stderr rather than stdout.

This is highly annoying because I had asked the magic wormhole developers
for a machine-readable way to get the data, and instead they changed how
the data was output, and didn't even mention this in my issue, or in the
changelog.

Seems this needs to be tested periodically to make sure it's still working.

This commit was sponsored by Ethan Aubin.

CHANGELOG

@@ -10,6 +10,8 @@ git-annex (6.20180627) UNRELEASED; urgency=medium
   * git-annex.cabal: Fix network version.
   * Fix reversion introduced in version 6.20180316 that caused git-annex to
     stop processing files when unable to contact a ssh remote.
+  * p2p --pair: Fix interception of the magic-wormhole pairing code,
+    which since 0.8.2 it has sent to stderr rather than stdout.
 
  -- Joey Hess <id@joeyh.name>  Fri, 22 Jun 2018 10:36:22 -0400
 

Utility/MagicWormhole.hs

@@ -34,6 +34,7 @@ import Utility.Path
 import System.IO
 import System.Exit
 import Control.Concurrent
+import Control.Concurrent.Async
 import Control.Exception
 import Data.Char
 import Data.List
@@ -112,21 +113,23 @@ sendFile f (CodeObserver observer) ps = do
 	-- Work around stupid stdout buffering behavior of python.
 	-- See https://github.com/warner/magic-wormhole/issues/108
 	environ <- addEntry "PYTHONUNBUFFERED" "1" <$> getEnvironment
-	runWormHoleProcess p { env = Just environ} $ \_hin hout ->
+	runWormHoleProcess p { env = Just environ} $ \_hin hout herr -> do
-		findcode =<< words <$> hGetContents hout
+		(inout, inerr) <- findcode hout `concurrently` findcode herr
+		return (inout || inerr)
   where
 	p = wormHoleProcess (Param "send" : ps ++ [File f])
-	findcode [] = return False
+	findcode h = findcode' =<< words <$> hGetContents h
-	findcode (w:ws) = case mkCode w of
+	findcode' [] = return False
+	findcode' (w:ws) = case mkCode w of
 		Just code -> do
-			putMVar observer code
+			_ <- tryPutMVar observer code
 			return True
-		Nothing -> findcode ws
+		Nothing -> findcode' ws
 
 -- | Receives a file. Once the receive is under way, the Code will be
 -- read from the CodeProducer, and fed to wormhole on stdin.
 receiveFile :: FilePath -> CodeProducer -> WormHoleParams -> IO Bool
-receiveFile f (CodeProducer producer) ps = runWormHoleProcess p $ \hin _hout -> do
+receiveFile f (CodeProducer producer) ps = runWormHoleProcess p $ \hin _hout _herr -> do
 	Code c <- readMVar producer
 	hPutStrLn hin c
 	hFlush hin
@@ -142,25 +145,27 @@ receiveFile f (CodeProducer producer) ps = runWormHoleProcess p $ \hin _hout ->
 wormHoleProcess :: WormHoleParams -> CreateProcess
 wormHoleProcess = proc "wormhole" . toCommand
 
-runWormHoleProcess :: CreateProcess -> (Handle -> Handle -> IO Bool) ->  IO Bool
+runWormHoleProcess :: CreateProcess -> (Handle -> Handle -> Handle -> IO Bool) ->  IO Bool
 runWormHoleProcess p consumer = 
 	bracketOnError setup (\v -> cleanup v <&&> return False) go
   where
 	setup = do
-		(Just hin, Just hout, Nothing, pid)
+		(Just hin, Just hout, Just herr, pid)
 			<- createProcess p
 				{ std_in = CreatePipe
 				, std_out = CreatePipe
+				, std_err = CreatePipe
 				}
-		return (hin, hout, pid)
+		return (hin, hout, herr, pid)
-	cleanup (hin, hout, pid) = do
+	cleanup (hin, hout, herr, pid) = do
 		r <- waitForProcess pid
 		hClose hin
 		hClose hout
+		hClose herr
 		return $ case r of
 			ExitSuccess -> True
 			ExitFailure _ -> False
-	go h@(hin, hout, _) = consumer hin hout <&&> cleanup h
+	go h@(hin, hout, herr, _) = consumer hin hout herr <&&> cleanup h
 
 isInstalled :: IO Bool
 isInstalled = inPath "wormhole"