[darcs-users] [patch254] resolve issue1371: darcs assumes -p for SSH_PORT; but putty takes -P

gh bugs at darcs.net
Thu Jun 17 09:34:58 UTC 2010


gh <guillaumh at gmail.com> added the comment:

Hi Radoslav,

Here goes my humble review, I have to say I'm no ssh expert nor
Windows user (and my remarks are hlint-esque),so my confidence is
quite low:

>+import System.IO (hGetContents)
>+import Control.Monad (foldM)
>+import Data.Maybe (fromJust)
>+import System.Process (waitForProcess)
>+
> import qualified Data.ByteString as B (ByteString, hGet, writeFile, readFile)
> import qualified Data.ByteString.Char8 as BC (unpack)
>
>hunk ./src/Ssh.hs 224
> getSSHOnly :: SSHCmd -> IO (String, [String])
> getSSHOnly cmd =
>  do ssh_command <- getEnv (evar cmd) `catchall` return (show cmd)
>-    -- port
>-    port <- (portFlag cmd `fmap` getEnv "SSH_PORT") `catchall` return []
>     let (ssh, ssh_args) = breakCommand ssh_command
>hunk ./src/Ssh.hs 225
>+    opts <- getSSHVerOpts cmd ssh

This is the call to the most important function which given some
command, tests which version is runnable, and gets the port flag
accordingly. I would have called the returned variable "sshOpts"
instead of just "opts".

>+    -- port
>+    port <- ((sshPortOpt opts) `fmap` getEnv "SSH_PORT") `catchall` return []


>     --
>hunk ./src/Ssh.hs 229
>-    return (ssh, ssh_args ++ port)
>+    return (ssh, ssh_args ++ port ++ (sshBatchFlag opts))

You could remove these parentheses around sshBatchFlag opts.

>     where
>      evar SSH  = "DARCS_SSH"
>      evar SCP  = "DARCS_SCP"
>hunk ./src/Ssh.hs 234
>      evar SFTP = "DARCS_SFTP"
>-     portFlag SSH  x = ["-p", x]
>-     portFlag SCP  x = ["-P", x]
>-     portFlag SFTP x = ["-oPort="++x]
>
> environmentHelpSsh :: ([String], [String])
> environmentHelpSsh = (["DARCS_SSH"], [
>hunk ./src/Ssh.hs 330
>
> (///) :: FilePath -> FilePath -> FilePath
> d /// f = d ++ "/" ++ f
>+
>+-- | Challenge request and function for the matching of challenge response
>+type SSHVersionDetect = ([String], String -> Bool)
>+
>+-- | Contains specific values for SSH implementations
>+--   like ssh, plink
>+data SSHCmdOpt = SSHCmdOpt { sshVerName    :: String                -- Information purpose
>+                           , sshPortOpt    :: String -> [String]
>+                           , sshBatchFlag  :: [String]
>+                           , sshQuietFlag  :: [String] }
>+
>+-- | Various implementations for `ssh` command
>+sshVersions :: [ (SSHVersionDetect,SSHCmdOpt) ]
>+sshVersions =  [ (plinkMatch       , SSHCmdOpt "plink"   (\p -> ["-P", p]) ["-batch"] [])
>+               , (sshMatch         , SSHCmdOpt "openssh" (\p -> ["-p", p]) []         ["-q"])
>+               , (defaultMatchAll  , SSHCmdOpt "default" (\p -> ["-p", p]) []         ["-q"]) ] -- Fallback to default
>+    where
>+      sshMatch        = (["-V"], (\s -> "OpenSSH" `isPrefixOf` s))
>+      plinkMatch      = (["-V"], (\s -> "plink:"  `isPrefixOf` s))
>+      defaultMatchAll = (["-V"], (\_ -> True))
>+
>+sftpVersions :: [ (SSHVersionDetect,SSHCmdOpt) ]
>+sftpVersions =  [ (defaultMatchAll  , SSHCmdOpt "default" (\p -> ["-oPort="++p]) [] []) ] -- Fallback to default
>+    where
>+      defaultMatchAll = (["-V"], (\_ -> True))
>+
>+scpVersions :: [ (SSHVersionDetect,SSHCmdOpt) ]
>+scpVersions =  [ (defaultMatchAll  , SSHCmdOpt "default" (\p -> ["-P", p]) [] ["-q"]) ] -- Fallback to default
>+    where
>+      defaultMatchAll = (["-V"], (\_ -> True))
>+
>+-- | Detect the type of the ssh command (ssh,plink,etc)
>+getSSHVerOpts :: SSHCmd -> String -> IO SSHCmdOpt
>+getSSHVerOpts cmdType cmd = do
>+  v <- (foldM (tryVersion) Nothing (cmdVersions cmdType))

You can remove the outer parentheses.

>+  return (fromJust v)
>+    where
>+      cmdVersions SSH  = sshVersions
>+      cmdVersions SFTP = sftpVersions
>+      cmdVersions SCP  = scpVersions
>+      tryVersion (Just o) _     = return (Just o)
>+      tryVersion Nothing  (d,o) = do
>+                          ret <- challengeCMD cmd (fst d)
>+                          if (snd d) ret then return (Just o) else return Nothing

OK I see what it does, trying to match the version string/prefix until it works.

>+
>+-- | Private function which takes command and arguments, execute and provides the
>+--   output (stderr+stdout) as the string
>+challengeCMD :: String -> [String] -> IO String
>+challengeCMD cmd args = do
>+  (_,outp,errp,pid) <- runInteractiveProcess cmd args Nothing Nothing
>+  outstr <- hGetContents outp
>+  errstr <- hGetContents errp
>+  waitForProcess pid
>+  let resp = (errstr++outstr)
>+  return resp

Looks good overall.

sorry for the delay!

guillaume

__________________________________
Darcs bug tracker <bugs at darcs.net>
<http://bugs.darcs.net/patch254>
__________________________________


More information about the darcs-users mailing list