module Darcs.Util.Ssh
(
SshSettings(..)
, defaultSsh
, windows
) where
import Control.Applicative ( (<$>), (<*>) )
import Control.Exception ( catch, catchJust, SomeException )
import Data.IORef ( IORef, newIORef, readIORef )
import Data.List ( isPrefixOf )
import System.Info ( os )
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Error ( ioeGetErrorType, isDoesNotExistErrorType )
import System.Process ( readProcessWithExitCode )
import System.Environment ( getEnv )
import Prelude hiding (catch)
import Darcs.Util.Global ( whenDebugMode )
windows :: Bool
windows = "mingw" `isPrefixOf` os
data SshSettings = SshSettings
{ ssh :: String
, scp :: String
, sftp :: String
} deriving (Show, Eq)
_defaultSsh :: IORef SshSettings
_defaultSsh = unsafePerformIO $ newIORef =<< detectSsh
detectSsh :: IO SshSettings
detectSsh = do
whenDebugMode (putStrLn "Detecting SSH settings")
vanilla <- if windows
then do
plinkStr <- (snd3 <$> readProcessWithExitCode "plink" [] "")
`catch` \(e :: SomeException) -> return (show e)
whenDebugMode $ putStrLn $
"SSH settings (plink): " ++
(concat . take 1 . lines $ plinkStr)
if "PuTTY" `isPrefixOf` plinkStr
then return (SshSettings "plink" "pscp -q" "psftp")
else return rawVanilla
else return rawVanilla
settings <- SshSettings <$> fromEnv (ssh vanilla) "DARCS_SSH"
<*> fromEnv (scp vanilla) "DARCS_SCP"
<*> fromEnv (sftp vanilla) "DARCS_SFTP"
whenDebugMode (putStrLn $ "SSH settings: " ++ show settings)
return settings
where
snd3 (_, x, _) = x
rawVanilla = SshSettings "ssh" "scp -q" "sftp"
fromEnv :: String -> String -> IO String
fromEnv d v = catchJust notFound
(getEnv v)
(const (return d))
notFound e = if isDoesNotExistErrorType (ioeGetErrorType e)
then Just ()
else Nothing
defaultSsh :: SshSettings
defaultSsh = unsafePerformIO $ readIORef _defaultSsh