[darcs-users] ssh ControlMaster debugging

Eric Y. Kow eric.kow at gmail.com
Sun Oct 21 21:51:49 UTC 2007


Alexander,

> It would make sense build an isolated test case for this, in Haskell.
> Something that set up ssh in control master mode and repeatedly
> invoked scp and/or sftp.

That is a very nice idea.  The tester is attached.  You'll have to put
it in the src directory of darcs and add the following to GNUmakefile

sshtester:  src/sshtester.hs $(DARCS_OBJS) $(C_OBJS)

It stops around 40 or so iterations on my end.

Thanks! This gives me a much better start in debugging.  I suggest all
future discussion on this issue be held on darcs-devel only.

-- 
Eric Kow                     http://www.loria.fr/~kow
PGP Key ID: 08AC04F9         Merci de corriger mon français.
-------------- next part --------------
module Main where
{-# OPTIONS -fffi #-}

import Control.Exception ( try )
import Control.Monad
import System.Directory
import System.Environment
import System.Exit
import System.IO.Unsafe ( unsafePerformIO )

import Darcs.Global
import Exec -- from darcs

-- ----------------------------------------------------------------------
-- tweak me
-- ----------------------------------------------------------------------

defaultServer :: String
defaultServer = "kowey at 192.168.0.2"

fileIn, fileOut :: FilePath
fileIn = "tmp/foo"
fileOut = "/tmp/dacrs-sshtester"

stop :: Int
stop = 150 

-- ----------------------------------------------------------------------

main :: IO ()
main = do mserver <- getArgs
          (server,iters) <- case mserver of 
              []    -> return (defaultServer, stop)
              [s]   -> return (s, stop)
              [s,i] -> return (s, read i)
              _     -> do putStrLn "usage: [server] [maxiters]"
                          exitWith $ ExitFailure 1
          with_atexit $ do
            forM_ [0..iters] $ \i -> do
               print i
               removeFile fileOut `catch` (\_ -> return ())  
               copySSH (server ++ ":" ++ fileIn) fileOut
               appendFile fileOut $ show i
            putStrLn $ "Called it " ++ show stop ++ " times without trouble"
            exitWith ExitSuccess

copySSH :: String -> FilePath -> IO ()
copySSH uRaw f = let u = escape_dollar uRaw in do
                 r <- runSSH SCP u [] [u,f] (AsIs,AsIs,Null)
                 when (r /= ExitSuccess) $
                      fail $ "(scp) failed to fetch: " ++ u
    where {- '$' in filenames is troublesome for scp, for some reason.. -}
          escape_dollar :: String -> String
          escape_dollar = concatMap tr
           where tr '$' = "\\$"
                 tr c = [c]

breakCommand :: String -> (String, [String])
breakCommand s = case words s of
                   (arg0:args) -> (arg0,args)
                   [] -> (s,[])


-- ---------------------------------------------------------------------
-- ssh helper functions
-- ---------------------------------------------------------------------

data SSHCmd = SSH | SCP | SFTP

instance Show SSHCmd where
  show SSH  = "ssh"
  show SCP  = "scp"
  show SFTP = "sftp"

runSSH :: SSHCmd -> String -> [String] -> [String] -> Redirects -> IO ExitCode
runSSH cmd remoteAddr preArgs postArgs redirs =
 do (ssh, args) <- getSSH cmd remoteAddr
    exec ssh (preArgs ++ args ++ postArgs) redirs

-- | Return the command and arguments needed to run an ssh command
--   along with any extra features like use of the control master.
--   See 'getSSHOnly'
getSSH :: SSHCmd -> String -- ^ remote path
       -> IO (String, [String])
getSSH cmd remoteAddr =
 do (ssh, ssh_args) <- getSSHOnly cmd
    -- control master
    cmPath <- controlMasterPath remoteAddr
    hasLaunchedCm <- doesFileExist cmPath
    when (not hasLaunchedCm) $ launchSSHControlMaster remoteAddr
    hasCmFeature <- doesFileExist cmPath
    let cm_args = if hasCmFeature then [ "-o ControlPath=" ++ cmPath ] else []
        verbosity = case cmd of
                    SCP  -> ["-q"] -- (p)scp is the only one that recognises -q
                                   -- sftp and (p)sftp do not, and plink neither
                    _    -> []
    --
    return (ssh, verbosity ++ ssh_args ++ cm_args)

-- | Return the command and arguments needed to run an ssh command.
--   First try the appropriate darcs environment variable and SSH_PORT
--   defaulting to "ssh" and no specified port.
getSSHOnly :: SSHCmd -> IO (String, [String])
getSSHOnly cmd =
 do ssh_command <- getEnv (evar cmd) `catch`
                      \_ -> return $ show cmd
    -- port
    p <- try $ getEnv "SSH_PORT" -- or DARCS_SSH_PORT ?
    let port = either (const []) (portFlag cmd) p
        (ssh, ssh_args) = breakCommand ssh_command
    --
    return (ssh, ssh_args ++ port)
    where
     evar SSH  = "DARCS_SSH"
     evar SCP  = "DARCS_SCP"
     evar SFTP = "DARCS_SFTP"
     portFlag SSH  x = ["-p", x]
     portFlag SCP  x = ["-P", x]
     portFlag SFTP x = ["-oPort="++x]

-- | Return True if this version of ssh has a ControlMaster feature
-- The ControlMaster functionality allows for ssh multiplexing
hasSSHControlMaster :: Bool
hasSSHControlMaster = unsafePerformIO hasSSHControlMasterIO

-- Because of the unsafePerformIO above, this can be called at any
-- point.  It cannot rely on any state, not even the current directory.
hasSSHControlMasterIO :: IO Bool
hasSSHControlMasterIO = do
  (ssh, _) <- getSSHOnly SSH
  -- If ssh has the ControlMaster feature, it will recognise the
  -- the -O flag, but exit with status 255 because of the nonsense
  -- command.  If it does not have the feature, it will simply dump
  -- a help message on the screen and exit with 1.
  sx <- exec ssh ["-O", "an_invalid_command"] (Null,Null,Null)
  case sx of
    ExitFailure 255 -> return True
    _ -> return False

-- | Launch an SSH control master in the background, if available.
--   We don't have to wait for it or anything.
--   Note also that this will cleanup after itself when darcs exits
launchSSHControlMaster :: String -> IO ()
launchSSHControlMaster rawAddr =
  when hasSSHControlMaster $ do
  let addr = takeWhile (/= ':') rawAddr
  (ssh, ssh_args) <- getSSHOnly SSH
  cmPath <- controlMasterPath addr
  -- -f : put ssh in the background once it succeeds in logging you in
  -- -M : launch as the control master for addr
  -- -N : don't run any commands
  -- -S : use cmPath as the ControlPath.  Equivalent to -oControlPath=
  exec ssh (ssh_args ++ [addr, "-S", cmPath, "-N", "-f", "-M"]) (Null,Null,AsIs)
  atexit $ exitSSHControlMaster addr
  return ()

-- | Tell the SSH control master for a given path to exit.
exitSSHControlMaster :: String -> IO ()
exitSSHControlMaster addr = do
  (ssh, ssh_args) <- getSSHOnly SSH
  cmPath <- controlMasterPath addr
  exec ssh (ssh_args ++ [addr, "-S", cmPath, "-O", "exit"]) (Null,Null,Null)
  return ()

-- | Create the directory ssh control master path for a given address
controlMasterPath :: String -- ^ remote path (foo at bar.com:file is ok; the file part with be stripped)
                  -> IO FilePath
controlMasterPath rawAddr = do
  let addr = takeWhile (/= ':') rawAddr
  let tmpDarcsSsh = "/tmp/darcs-ssh"
  createDirectoryIfMissing False tmpDarcsSsh
  return $ tmpDarcsSsh ++ "/" ++ addr
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 186 bytes
Desc: not available
Url : http://lists.osuosl.org/pipermail/darcs-users/attachments/20071021/989d0133/attachment-0001.pgp 


More information about the darcs-users mailing list