[darcs-devel] 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-devel/attachments/20071021/989d0133/attachment.pgp
More information about the darcs-devel
mailing list