webapp: Display any error message from git init if it fails to create a repository.

Assistant/Pairing/MakeRemote.hs

@@ -41,7 +41,7 @@ finishedLocalPairing msg keypair = do
 			, genSshHost (sshHostName sshdata) (sshUserName sshdata)
 			, "git-annex-shell -c configlist " ++ T.unpack (sshDirectory sshdata)
 			]
-			""
+			Nothing
 	void $ makeSshRemote False sshdata
 
 {- Mostly a straightforward conversion.  Except:

Assistant/Ssh.hs

@@ -61,36 +61,8 @@ genSshRepoName host dir
 	| otherwise = makeLegalName $ host ++ "_" ++ dir
 
 {- The output of ssh, including both stdout and stderr. -}
-sshTranscript :: [String] -> String -> IO (String, Bool)
-sshTranscript opts input = do
-	(readf, writef) <- createPipe
-	readh <- fdToHandle readf
-	writeh <- fdToHandle writef
-	(Just inh, _, _, pid) <- createProcess $
-		(proc "ssh" opts)
-			{ std_in = CreatePipe
-			, std_out = UseHandle writeh
-			, std_err = UseHandle writeh
-			}
-	hClose writeh
-
-	-- fork off a thread to start consuming the output
-	transcript <- hGetContents readh
-	outMVar <- newEmptyMVar
-	_ <- forkIO $ E.evaluate (length transcript) >> putMVar outMVar ()
-
-	-- now write and flush any input
-	unless (null input) $ do
-		hPutStr inh input
-		hFlush inh
-	hClose inh -- done with stdin
-
-	-- wait on the output
-	takeMVar outMVar
-	hClose readh
-
-	ok <- checkSuccessProcess pid
-	return (transcript, ok)
+sshTranscript :: [String] -> (Maybe String) -> IO (String, Bool)
+sshTranscript opts input = processTranscript "ssh" opts input
 
 {- Ensure that the ssh public key doesn't include any ssh options, like
  - command=foo, or other weirdness -}

Assistant/WebApp/Configurators/Local.hs

@@ -276,8 +276,9 @@ startFullAssistant path = do
 {- Makes a new git repository. -}
 makeRepo :: FilePath -> Bool -> IO ()
 makeRepo path bare = do
-	unlessM (boolSystem "git" params) $
-		error "git init failed!"
+	(transcript, ok) <- processTranscript "git" (toCommand params) Nothing
+	unless ok $
+		error $ "git init failed!\nOutput:\n" ++ transcript
   where
 	baseparams = [Param "init", Param "--quiet"]
 	params

Assistant/WebApp/Configurators/Ssh.hs

@@ -210,7 +210,7 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do
 				(inputUsername sshinput)
 			, remotecommand
 			]
-		parsetranscript . fst <$> sshTranscript sshopts ""
+		parsetranscript . fst <$> sshTranscript sshopts Nothing
 	parsetranscript s
 		| reported "git-annex-shell" = UsableSshInput
 		| reported shim = UsableSshInput
@@ -230,7 +230,7 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do
  - and if it succeeds, runs an action. -}
 sshSetup :: [String] -> String -> Handler RepHtml -> Handler RepHtml
 sshSetup opts input a = do
-	(transcript, ok) <- liftIO $ sshTranscript opts input
+	(transcript, ok) <- liftIO $ sshTranscript opts (Just input)
 	if ok
 		then a
 		else showSshErr transcript