module Network.SSH.Client.LibSSH2
(
Session, Channel, KnownHosts,
withSSH2,
withSession,
withChannel,
withChannelBy,
checkHost,
readAllChannel,
writeAllChannel,
scpSendFile,
scpReceiveFile,
runShellCommands,
execCommands,
socketConnect
) where
import Control.Monad
import Control.Exception as E
import Network
import Network.BSD
import Network.Socket
import System.IO
import qualified Data.ByteString as BSS
import qualified Data.ByteString.Char8 as BSSC
import qualified Data.ByteString.Lazy as BSL
import Network.SSH.Client.LibSSH2.Types
import Network.SSH.Client.LibSSH2.Foreign
socketConnect :: String -> Int -> IO Socket
socketConnect hostname port = do
proto <- getProtocolNumber "tcp"
bracketOnError (socket AF_INET Stream proto) (sClose)
(\sock -> do
he <- getHostByName hostname
connect sock (SockAddrInet (fromIntegral port) (hostAddress he))
return sock)
withSSH2 :: FilePath
-> FilePath
-> FilePath
-> String
-> String
-> String
-> Int
-> (Session -> IO a)
-> IO a
withSSH2 known_hosts public private passphrase login hostname port fn =
withSession hostname port $ \s -> do
r <- checkHost s hostname port known_hosts
when (r == MISMATCH) $
error $ "Host key mismatch for host " ++ hostname
publicKeyAuthFile s login public private passphrase
fn s
withSession :: String
-> Int
-> (Session -> IO a)
-> IO a
withSession hostname port fn = do
sock <- socketConnect hostname port
session <- initSession
setBlocking session False
handshake session sock
result <- fn session
disconnectSession session "Done."
freeSession session
return result
checkHost :: Session
-> String
-> Int
-> FilePath
-> IO KnownHostResult
checkHost s host port path = do
kh <- initKnownHosts s
_numKnownHosts <- knownHostsReadFile kh path
(hostkey, _keylen, _keytype) <- getHostKey s
result <- checkKnownHost kh host port hostkey [TYPE_PLAIN, KEYENC_RAW]
freeKnownHosts kh
return result
withChannel :: Session -> (Channel -> IO a) -> IO (Int, a)
withChannel s = withChannelBy (openChannelSession s) id
readAllChannel :: Channel -> IO BSL.ByteString
readAllChannel ch = go []
where
go :: [BSS.ByteString] -> IO BSL.ByteString
go acc = do
bs <- readChannel ch 0x400
if BSS.length bs > 0
then go (bs : acc)
else return (BSL.fromChunks $ reverse acc)
writeAllChannel :: Channel -> BSL.ByteString -> IO ()
writeAllChannel ch = mapM_ (writeChannel ch) . BSL.toChunks
runShellCommands :: Session -> [String] -> IO (Int, [BSL.ByteString])
runShellCommands s commands = withChannel s $ \ch -> do
requestPTY ch "linux"
channelShell ch
_hello <- readAllChannel ch
out <- forM commands $ \cmd -> do
writeChannel ch (BSSC.pack $ cmd ++ "\n")
r <- readAllChannel ch
return r
channelSendEOF ch
return out
execCommands :: Session -> [String] -> IO (Int, [BSL.ByteString])
execCommands s commands = withChannel s $ \ch ->
forM commands $ \cmd -> do
channelExecute ch cmd
readAllChannel ch
scpSendFile :: Session
-> Int
-> FilePath
-> FilePath
-> IO Integer
scpSendFile s mode local remote = do
h <- openFile local ReadMode
size <- hFileSize h
(_, result) <- withChannelBy (scpSendChannel s remote mode (fromIntegral size) 0 0) id $ \ch -> do
written <- writeChannelFromHandle ch h
channelSendEOF ch
channelWaitEOF ch
return written
hClose h
return result
scpReceiveFile :: Session
-> FilePath
-> FilePath
-> IO Integer
scpReceiveFile s remote local = do
h <- openFile local WriteMode
(_, result) <- withChannelBy (scpReceiveChannel s remote) fst $ \(ch, fileSize) -> do
readChannelToHandle ch h fileSize
hClose h
return result
withChannelBy :: IO a
-> (a -> Channel)
-> (a -> IO b)
-> IO (Int, b)
withChannelBy createChannel extractChannel actions = do
stuff <- createChannel
let ch = extractChannel stuff
result <- actions stuff
closeChannel ch
exitStatus <- channelExitStatus ch
freeChannel ch
return (exitStatus, result)