diff options
author | Joey Hess <joey@kitenet.net> | 2013-02-26 13:04:37 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-02-26 13:04:37 -0400 |
commit | 9816398fadebf9f1a70b51b21c2d8a6bd9e8caa4 (patch) | |
tree | 6cef77b5af56432294a2592f36be627ce18b60ed /Assistant | |
parent | c88f2afd3a7b811e7078c9e66d47431757d2b3df (diff) |
webapp: Display any error message from git init if it fails to create a repository.
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Pairing/MakeRemote.hs | 2 | ||||
-rw-r--r-- | Assistant/Ssh.hs | 32 |
2 files changed, 3 insertions, 31 deletions
diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs index f938bac93..24a83b43c 100644 --- a/Assistant/Pairing/MakeRemote.hs +++ b/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: diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 753babad4..93d567ce4 100644 --- a/Assistant/Ssh.hs +++ b/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 -} |