summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIlyaPortnov <>2017-05-19 18:22:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-05-19 18:22:00 (GMT)
commit74a9f859997ef6525d7fd6c45609e3a70f166916 (patch)
tree6bc27a48cb5ea2b2db6db4f92eda7cbb065ba5a7
parent399a214f9e93ac1d06bff65cac0afd1cbf2fe4c0 (diff)
version 0.2.0.4HEAD0.2.0.4master
-rw-r--r--libssh2.cabal2
-rw-r--r--src/Network/SSH/Client/LibSSH2.hs47
-rw-r--r--src/Network/SSH/Client/LibSSH2/Errors.chs11
-rw-r--r--src/Network/SSH/Client/LibSSH2/Foreign.chs16
-rw-r--r--src/Network/SSH/Client/LibSSH2/Foreign.hs693
5 files changed, 745 insertions, 24 deletions
diff --git a/libssh2.cabal b/libssh2.cabal
index 9587372..2e20e29 100644
--- a/libssh2.cabal
+++ b/libssh2.cabal
@@ -1,6 +1,6 @@
Name: libssh2
-Version: 0.2.0.3
+Version: 0.2.0.4
Synopsis: FFI bindings to libssh2 SSH2 client library (http://libssh2.org/)
diff --git a/src/Network/SSH/Client/LibSSH2.hs b/src/Network/SSH/Client/LibSSH2.hs
index bbabc20..d95065b 100644
--- a/src/Network/SSH/Client/LibSSH2.hs
+++ b/src/Network/SSH/Client/LibSSH2.hs
@@ -55,14 +55,14 @@ withSSH2 :: FilePath -- ^ Path to known_hosts file
-> String -- ^ Remote user name
-> String -- ^ Remote host name
-> Int -- ^ Remote port number (usually 22)
- -> (Session -> IO a) -- ^ Actions to perform on session
- -> IO a
+ -> (Session -> IO a) -- ^ Actions to perform on session
+ -> 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) $
+ when (r == MISMATCH) $
error $ "Host key mismatch for host " ++ hostname
- publicKeyAuthFile s login public private passphrase
+ publicKeyAuthFile s login public private passphrase
fn s
-- | Execute some actions within SSH2 connection.
@@ -122,21 +122,34 @@ checkHost s host port path = do
-- | Execute some actions withing SSH2 channel
withChannel :: Session -> (Channel -> IO a) -> IO (Int, a)
-withChannel s = withChannelBy (openChannelSession s) id
+withChannel s = withChannelBy (openChannelSession s) id
--- | Read all data from the channel
+-- | Read all data from the channel
--
-- Although this function returns a lazy bytestring, the data is /not/ read
-- lazily.
-readAllChannel :: Channel -> IO BSL.ByteString
+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)
+ then go (bs : acc)
+ else return (BSL.fromChunks $ reverse acc)
+
+readAllChannelNonBlocking :: Channel -> IO BSL.ByteString
+readAllChannelNonBlocking ch = go []
+ where
+ go :: [BSS.ByteString] -> IO BSL.ByteString
+ go acc = do
+ bs <- do i <- pollChannelRead_ ch
+ if i == 1
+ then readChannel ch 0x400
+ else return BSS.empty
+ if BSS.length bs > 0
+ then go (bs : acc)
+ else return (BSL.fromChunks $ reverse acc)
-- | Write a lazy bytestring to the channel
writeAllChannel :: Channel -> BSL.ByteString -> IO ()
@@ -146,23 +159,23 @@ runShellCommands :: Session -> [String] -> IO (Int, [BSL.ByteString])
runShellCommands s commands = withChannel s $ \ch -> do
requestPTY ch "linux"
channelShell ch
- _hello <- readAllChannel ch
+ _hello <- readAllChannelNonBlocking ch
out <- forM commands $ \cmd -> do
writeChannel ch (BSSC.pack $ cmd ++ "\n")
- r <- readAllChannel ch
+ r <- readAllChannelNonBlocking ch
return r
channelSendEOF ch
return out
execCommands :: Session -> [String] -> IO (Int, [BSL.ByteString])
-execCommands s commands = withChannel s $ \ch ->
+execCommands s commands = withChannel s $ \ch ->
forM commands $ \cmd -> do
channelExecute ch cmd
readAllChannel ch
-- | Send a file to remote host via SCP.
-- Returns size of sent data.
-scpSendFile :: Session
+scpSendFile :: Session
-> Int -- ^ File creation mode (0o777, for example)
-> FilePath -- ^ Path to local file
-> FilePath -- ^ Remote file path
@@ -176,7 +189,7 @@ scpSendFile s mode local remote = do
channelWaitEOF ch
return written
hClose h
- return result
+ return result
-- | Receive file from remote host via SCP.
-- Returns size of received data.
@@ -186,7 +199,7 @@ scpReceiveFile :: Session --
-> IO Integer
scpReceiveFile s remote local = do
h <- openFile local WriteMode
- (_, result) <- withChannelBy (scpReceiveChannel s remote) fst $ \(ch, fileSize) -> do
+ (_, result) <- withChannelBy (scpReceiveChannel s remote) fst $ \(ch, fileSize) -> do
readChannelToHandle ch h fileSize
hClose h
return result
@@ -194,12 +207,12 @@ scpReceiveFile s remote local = do
-- | Generalization of 'withChannel'
withChannelBy :: IO a -- ^ Create a channel (and possibly other stuff)
-> (a -> Channel) -- ^ Extract the channel from "other stuff"
- -> (a -> IO b) -- ^ Actions to execute on the channel
+ -> (a -> IO b) -- ^ Actions to execute on the channel
-> IO (Int, b) -- ^ Channel exit status and return value
withChannelBy createChannel extractChannel actions = do
stuff <- createChannel
let ch = extractChannel stuff
- result <- actions stuff
+ result <- actions stuff
closeChannel ch
exitStatus <- channelExitStatus ch
freeChannel ch
diff --git a/src/Network/SSH/Client/LibSSH2/Errors.chs b/src/Network/SSH/Client/LibSSH2/Errors.chs
index 3456347..26bcdaa 100644
--- a/src/Network/SSH/Client/LibSSH2/Errors.chs
+++ b/src/Network/SSH/Client/LibSSH2/Errors.chs
@@ -125,6 +125,9 @@ instance IntResult CInt where
instance IntResult CLong where
intResult = fromIntegral
+instance IntResult CLLong where
+ intResult = fromIntegral
+
{# fun session_last_error as getLastError_
{ toPointer `Session',
alloca- `String' peekCStringPtr*,
@@ -165,7 +168,7 @@ handleNullPtr s fromPointer io = do
(r, _) <- getLastError session
case int2error r of
EAGAIN -> threadWaitSession (Just session) >> handleNullPtr s fromPointer io
- _ -> throw NULL_POINTER -- TODO: should we throw the error instead?
+ err -> throw err
else fromPointer p
-- | Get currently blocked directions
@@ -180,5 +183,7 @@ threadWaitSession (Just s) = do
Nothing -> error "EAGAIN thrown on session without socket"
Just socket -> do
dirs <- blockedDirections s
- when (INBOUND `elem` dirs) $ threadWaitRead socket
- when (OUTBOUND `elem` dirs) $ threadWaitWrite socket
+ if (OUTBOUND `elem` dirs)
+ then threadWaitWrite socket
+ else threadWaitRead socket
+
diff --git a/src/Network/SSH/Client/LibSSH2/Foreign.chs b/src/Network/SSH/Client/LibSSH2/Foreign.chs
index e02b140..28dd179 100644
--- a/src/Network/SSH/Client/LibSSH2/Foreign.chs
+++ b/src/Network/SSH/Client/LibSSH2/Foreign.chs
@@ -38,7 +38,7 @@ module Network.SSH.Client.LibSSH2.Foreign
channelProcess, channelExecute, channelShell,
requestPTY, requestPTYEx,
channelExitStatus, channelExitSignal,
- scpSendChannel, scpReceiveChannel,
+ scpSendChannel, scpReceiveChannel, pollChannelRead_,
-- * Debug
TraceFlag (..), setTraceMode
@@ -117,7 +117,11 @@ init_crypto True = 0
ssh2socket :: Socket
#ifdef mingw32_HOST_OS
+ #ifdef x86_64_HOST_ARCH
+ -> CULLong
+ #else
-> CUInt
+ #endif
#else
-> CInt
#endif
@@ -282,7 +286,10 @@ channelExecute c command = channelProcess c "exec" command
-- | Execute shell command
channelShell :: Channel -> IO ()
-channelShell c = void . handleInt (Just $ channelSession c) $ channelProcessStartup_ c "shell" ""
+channelShell c = void . handleInt (Just $ channelSession c) $ do
+ withCStringLen "shell" $ \(s,l) -> do
+ res <- channelProcessStartup_'_ (toPointer c) s (fromIntegral l) nullPtr 0
+ return $ (res :: CInt)
{# fun channel_request_pty_ex as requestPTYEx
{ toPointer `Channel',
@@ -295,7 +302,7 @@ requestPTY :: Channel -> String -> IO ()
requestPTY ch term = void . handleInt (Just $ channelSession ch) $ requestPTYEx ch term "" 0 0 0 0
readChannelEx :: Channel -> Int -> Size -> IO BSS.ByteString
-readChannelEx ch i size =
+readChannelEx ch i size = do
allocaBytes (fromIntegral size) $ \buffer -> do
rc <- handleInt (Just $ channelSession ch) $ {# call channel_read_ex #} (toPointer ch) (fromIntegral i) buffer size
BSS.packCStringLen (buffer, fromIntegral rc)
@@ -488,3 +495,6 @@ scpReceiveChannel s path = do
channel <- handleNullPtr (Just s) (channelFromPointer s) $ {# call scp_recv #} (toPointer s) pathptr statptr
size <- {# get stat_t->st_size #} statptr
return (channel, size)
+
+{# fun poll_channel_read as pollChannelRead_
+ { toPointer `Channel' } -> `Int' #}
diff --git a/src/Network/SSH/Client/LibSSH2/Foreign.hs b/src/Network/SSH/Client/LibSSH2/Foreign.hs
new file mode 100644
index 0000000..96d054d
--- /dev/null
+++ b/src/Network/SSH/Client/LibSSH2/Foreign.hs
@@ -0,0 +1,693 @@
+-- GENERATED by C->Haskell Compiler, version 0.16.3 Crystal Seed, 24 Jan 2009 (Haskell)
+-- Edit the ORIGNAL .chs file instead!
+
+
+{-# LINE 1 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+
+
+{-# LINE 6 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+module Network.SSH.Client.LibSSH2.Foreign
+ (-- * Types
+ KnownHosts, KnownHostResult (..), KnownHostType (..), KnownHost (..),
+
+ -- * Session functions
+ initialize, exit,
+ initSession, freeSession, disconnectSession,
+ handshake,
+ setBlocking,
+
+ -- * Known hosts functions
+ initKnownHosts, freeKnownHosts, knownHostsReadFile,
+ getHostKey, checkKnownHost,
+
+ -- * Authentication
+ publicKeyAuthFile,
+ usernamePasswordAuth,
+
+ -- * Channel functions
+ openChannelSession, closeChannel, freeChannel,
+ channelSendEOF, channelWaitEOF, channelIsEOF,
+ readChannel, writeChannel,
+ writeChannelFromHandle, readChannelToHandle,
+ channelProcess, channelExecute, channelShell,
+ requestPTY, requestPTYEx,
+ channelExitStatus, channelExitSignal,
+ scpSendChannel, scpReceiveChannel,
+
+ -- * Debug
+ TraceFlag (..), setTraceMode
+ ) where
+
+import Foreign
+import Foreign.C.Types
+import Foreign.C.String
+import System.IO
+import Network.Socket (Socket(MkSocket))
+import Data.Time.Clock.POSIX
+import qualified Data.ByteString as BSS
+import qualified Data.ByteString.Unsafe as BSS
+
+import Network.SSH.Client.LibSSH2.Types
+import Network.SSH.Client.LibSSH2.Errors
+
+-- Known host flags. See libssh2 documentation.
+data KnownHostType =
+ TYPE_MASK
+ | TYPE_PLAIN
+ | TYPE_SHA1
+ | TYPE_CUSTOM
+ | KEYENC_MASK
+ | KEYENC_RAW
+ | KEYENC_BASE64
+ | KEY_MASK
+ | KEY_SHIFT
+ | KEY_RSA1
+ | KEY_SSHRSA
+ | KEY_SSHDSS
+ deriving (Eq, Show)
+
+kht2int :: KnownHostType -> CInt
+kht2int TYPE_MASK = 0xffff
+kht2int TYPE_PLAIN = 1
+kht2int TYPE_SHA1 = 2
+kht2int TYPE_CUSTOM = 3
+kht2int KEYENC_MASK = 3 `shiftL` 16
+kht2int KEYENC_RAW = 1 `shiftL` 16
+kht2int KEYENC_BASE64 = 2 `shiftL` 16
+kht2int KEY_MASK = 3 `shiftL` 18
+kht2int KEY_SHIFT = 18
+kht2int KEY_RSA1 = 1 `shiftL` 18
+kht2int KEY_SSHRSA = 2 `shiftL` 18
+kht2int KEY_SSHDSS = 3 `shiftL` 18
+
+typemask2int :: [KnownHostType] -> CInt
+typemask2int list = foldr (.|.) 0 (map kht2int list)
+
+-- Result of matching host against known_hosts.
+data KnownHostResult =
+ MATCH
+ | MISMATCH
+ | NOTFOUND
+ | FAILURE
+ deriving (Eq, Show, Ord, Enum)
+
+int2khresult :: CInt -> KnownHostResult
+int2khresult = toEnum . fromIntegral
+
+data KnownHost = KnownHost {
+ khMagic :: CUInt,
+ khNode :: Ptr (),
+ khName :: String,
+ khKey :: String,
+ khTypeMask :: [KnownHostType] }
+ deriving (Eq, Show)
+
+init_crypto :: Bool -> CInt
+init_crypto False = 1
+init_crypto True = 0
+
+ssh2socket :: Socket
+ -> CInt
+ssh2socket (MkSocket s _ _ _ _) =
+ s
+
+initialize_ :: Bool -> IO (Int)
+initialize_ a1 =
+ let {a1' = init_crypto a1} in
+ initialize_'_ a1' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 125 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Initialize libssh2. Pass True to enable encryption
+-- or False to disable it.
+initialize :: Bool -> IO ()
+initialize flags = void . handleInt Nothing $ initialize_ flags
+
+-- | Deinitialize libssh2.
+exit :: IO ()
+exit =
+ exit'_ >>= \res ->
+ return ()
+{-# LINE 142 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Create Session object
+initSession :: IO Session
+initSession = handleNullPtr Nothing sessionFromPointer $
+ libssh2_session_init_ex nullFunPtr nullFunPtr nullFunPtr nullPtr
+
+freeSession_ :: Session -> IO (Int)
+freeSession_ a1 =
+ let {a1' = toPointer a1} in
+ freeSession_'_ a1' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 150 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Free Session object's memory
+freeSession :: Session -> IO ()
+freeSession session = void . handleInt (Just session) $ freeSession_ session
+
+disconnectSessionEx :: Session -> Int -> String -> String -> IO (Int)
+disconnectSessionEx a1 a2 a3 a4 =
+ let {a1' = toPointer a1} in
+ let {a2' = fromIntegral a2} in
+ withCString a3 $ \a3' ->
+ withCString a4 $ \a4' ->
+ disconnectSessionEx'_ a1' a2' a3' a4' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 157 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Disconnect session (but do not free memory)
+disconnectSession :: Session
+ -> String -- ^ Goodbye message
+ -> IO ()
+disconnectSession s msg = void . handleInt (Just s) $ disconnectSessionEx s 11 msg ""
+
+setBlocking :: Session -> Bool -> IO ()
+setBlocking a1 a2 =
+ let {a1' = toPointer a1} in
+ let {a2' = bool2int a2} in
+ setBlocking'_ a1' a2' >>= \res ->
+ return ()
+{-# LINE 166 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+bool2int :: Bool -> CInt
+bool2int True = 1
+bool2int False = 0
+
+handshake_ :: Session -> Socket -> IO (Int)
+handshake_ a1 a2 =
+ let {a1' = toPointer a1} in
+ let {a2' = ssh2socket a2} in
+ handshake_'_ a1' a2' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 173 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Run SSH handshake on network socket.
+handshake :: Session -> Socket -> IO ()
+handshake session socket = do
+ sessionSetSocket session (Just socket)
+ void . handleInt (Just session) $ handshake_ session socket
+
+initKnownHosts_ :: Session -> IO (Ptr ())
+initKnownHosts_ a1 =
+ let {a1' = toPointer a1} in
+ initKnownHosts_'_ a1' >>= \res ->
+ let {res' = id res} in
+ return (res')
+{-# LINE 182 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Create KnownHosts object for given session.
+initKnownHosts :: Session -> IO KnownHosts
+initKnownHosts session = handleNullPtr Nothing knownHostsFromPointer $ initKnownHosts_ session
+
+-- | Free KnownHosts object's memory
+freeKnownHosts :: KnownHosts -> IO ()
+freeKnownHosts a1 =
+ let {a1' = toPointer a1} in
+ freeKnownHosts'_ a1' >>= \res ->
+ return ()
+{-# LINE 190 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+knownHostsReadFile_ :: KnownHosts -> String -> CInt -> IO (Int)
+knownHostsReadFile_ a1 a2 a3 =
+ let {a1' = toPointer a1} in
+ withCString a2 $ \a2' ->
+ let {a3' = id a3} in
+ knownHostsReadFile_'_ a1' a2' a3' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 193 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Read known hosts from file
+knownHostsReadFile :: KnownHosts
+ -> FilePath -- ^ Path to known_hosts file
+ -> IO Int
+knownHostsReadFile kh path = handleInt Nothing $ knownHostsReadFile_ kh path 1
+
+-- | Get remote host public key
+getHostKey :: Session -> IO (String, Size, CInt)
+getHostKey a1 =
+ let {a1' = toPointer a1} in
+ alloca $ \a2' ->
+ alloca $ \a3' ->
+ getHostKey'_ a1' a2' a3' >>= \res ->
+ peek a2'>>= \a2'' ->
+ peek a3'>>= \a3'' ->
+ peekCString res >>= \res' ->
+ return (res', a2'', a3'')
+{-# LINE 203 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+checkKnownHost_ :: KnownHosts -> String -> Int -> String -> Int -> [KnownHostType] -> Ptr () -> IO (KnownHostResult)
+checkKnownHost_ a1 a2 a3 a4 a5 a6 a7 =
+ let {a1' = toPointer a1} in
+ withCString a2 $ \a2' ->
+ let {a3' = fromIntegral a3} in
+ withCString a4 $ \a4' ->
+ let {a5' = fromIntegral a5} in
+ let {a6' = typemask2int a6} in
+ let {a7' = castPtr a7} in
+ checkKnownHost_'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
+ let {res' = int2khresult res} in
+ return (res')
+{-# LINE 212 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Check host data against known hosts.
+checkKnownHost :: KnownHosts --
+ -> String -- ^ Host name
+ -> Int -- ^ Port number (usually 22)
+ -> String -- ^ Host public key
+ -> [KnownHostType] -- ^ Host flags (see libssh2 documentation)
+ -> IO KnownHostResult
+checkKnownHost kh host port key flags = checkKnownHost_ kh host port key (length key) flags nullPtr
+
+-- TODO: I don't see the '&' in the libssh2 docs?
+publicKeyAuthFile_ :: Session -> String -> String -> String -> String -> IO (Int)
+publicKeyAuthFile_ a1 a2 a3 a4 a5 =
+ let {a1' = toPointer a1} in
+ withCStringLenIntConv a2 $ \(a2'1, a2'2) ->
+ withCString a3 $ \a3' ->
+ withCString a4 $ \a4' ->
+ withCString a5 $ \a5' ->
+ publicKeyAuthFile_'_ a1' a2'1 a2'2 a3' a4' a5' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 229 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Perform public key authentication.
+publicKeyAuthFile :: Session -- ^ Session
+ -> String -- ^ Username
+ -> String -- ^ Path to public key
+ -> String -- ^ Path to private key
+ -> String -- ^ Passphrase
+ -> IO ()
+publicKeyAuthFile session username public private passphrase = void . handleInt (Just session) $
+ publicKeyAuthFile_ session username public private passphrase
+
+-- | Perform username/password authentication.
+usernamePasswordAuth :: Session -- ^ Session
+ -> String -- ^ Username
+ -> String -- ^ Password
+ -> IO ()
+usernamePasswordAuth session username password =
+ withCString username $ \usernameptr -> do
+ withCString password $ \passwordptr -> do
+ void . handleInt (Just session) $
+ libssh2_userauth_password_ex (toPointer session) usernameptr (toEnum $ length username) passwordptr (toEnum $ length password) nullFunPtr
+
+openSessionChannelEx :: Session -> String -> Int -> Int -> String -> IO (Ptr ())
+openSessionChannelEx a1 a2 a3 a4 a5 =
+ let {a1' = toPointer a1} in
+ withCStringLenIntConv a2 $ \(a2'1, a2'2) ->
+ let {a3' = fromIntegral a3} in
+ let {a4' = fromIntegral a4} in
+ withCStringLenIntConv a5 $ \(a5'1, a5'2) ->
+ openSessionChannelEx'_ a1' a2'1 a2'2 a3' a4' a5'1 a5'2 >>= \res ->
+ let {res' = id res} in
+ return (res')
+{-# LINE 256 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Open a channel for session.
+openChannelSession :: Session -> IO Channel
+openChannelSession s = handleNullPtr (Just s) (channelFromPointer s) $
+ openSessionChannelEx s "session" 65536 32768 ""
+
+channelProcess :: Channel -> String -> String -> IO ()
+channelProcess ch kind command = void . handleInt (Just $ channelSession ch) $
+ channelProcessStartup_ ch kind command
+
+-- | Execute command
+channelExecute :: Channel -> String -> IO ()
+channelExecute c command = channelProcess c "exec" command
+
+channelProcessStartup_ :: Channel -> String -> String -> IO (Int)
+channelProcessStartup_ a1 a2 a3 =
+ let {a1' = toPointer a1} in
+ withCStringLenIntConv a2 $ \(a2'1, a2'2) ->
+ withCStringLenIntConv a3 $ \(a3'1, a3'2) ->
+ channelProcessStartup_'_ a1' a2'1 a2'2 a3'1 a3'2 >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 274 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Execute shell command
+channelShell :: Channel -> IO ()
+channelShell c = void . handleInt (Just $ channelSession c) $ channelProcessStartup_ c "shell" ""
+
+requestPTYEx :: Channel -> String -> String -> Int -> Int -> Int -> Int -> IO (Int)
+requestPTYEx a1 a2 a3 a4 a5 a6 a7 =
+ let {a1' = toPointer a1} in
+ withCStringLenIntConv a2 $ \(a2'1, a2'2) ->
+ withCStringLenIntConv a3 $ \(a3'1, a3'2) ->
+ let {a4' = fromIntegral a4} in
+ let {a5' = fromIntegral a5} in
+ let {a6' = fromIntegral a6} in
+ let {a7' = fromIntegral a7} in
+ requestPTYEx'_ a1' a2'1 a2'2 a3'1 a3'2 a4' a5' a6' a7' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 285 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+requestPTY :: Channel -> String -> IO ()
+requestPTY ch term = void . handleInt (Just $ channelSession ch) $ requestPTYEx ch term "" 0 0 0 0
+
+readChannelEx :: Channel -> Int -> Size -> IO BSS.ByteString
+readChannelEx ch i size =
+ allocaBytes (fromIntegral size) $ \buffer -> do
+ rc <- handleInt (Just $ channelSession ch) $ libssh2_channel_read_ex (toPointer ch) (fromIntegral i) buffer size
+ BSS.packCStringLen (buffer, fromIntegral rc)
+
+-- | Read data from channel.
+readChannel :: Channel --
+ -> Size -- ^ Amount of data to read
+ -> IO BSS.ByteString
+readChannel c sz = readChannelEx c 0 sz
+
+-- | Write data to channel.
+writeChannel :: Channel -> BSS.ByteString -> IO ()
+writeChannel ch bs =
+ BSS.unsafeUseAsCString bs $ go 0 (fromIntegral $ BSS.length bs)
+ where
+ go :: Int -> CULong -> CString -> IO ()
+ go offset len cstr = do
+ written <- handleInt (Just $ channelSession ch)
+ $ libssh2_channel_write_ex (toPointer ch)
+ 0
+ (cstr `plusPtr` offset)
+ (fromIntegral len)
+ if fromIntegral written < len
+ then go (offset + fromIntegral written) (len - fromIntegral written) cstr
+ else return ()
+
+channelSendEOF_ :: Channel -> IO (Int)
+channelSendEOF_ a1 =
+ let {a1' = toPointer a1} in
+ channelSendEOF_'_ a1' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 319 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+channelSendEOF :: Channel -> IO ()
+channelSendEOF channel = void . handleInt (Just $ channelSession channel) $ channelSendEOF_ channel
+
+channelWaitEOF_ :: Channel -> IO (Int)
+channelWaitEOF_ a1 =
+ let {a1' = toPointer a1} in
+ channelWaitEOF_'_ a1' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 325 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+channelWaitEOF :: Channel -> IO ()
+channelWaitEOF channel = void . handleInt (Just $ channelSession channel) $ channelWaitEOF_ channel
+
+data TraceFlag =
+ T_TRANS
+ | T_KEX
+ | T_AUTH
+ | T_CONN
+ | T_SCP
+ | T_SFTP
+ | T_ERROR
+ | T_PUBLICKEY
+ | T_SOCKET
+ deriving (Eq, Show)
+
+tf2int :: TraceFlag -> CInt
+tf2int T_TRANS = 1 `shiftL` 1
+tf2int T_KEX = 1 `shiftL` 2
+tf2int T_AUTH = 1 `shiftL` 3
+tf2int T_CONN = 1 `shiftL` 4
+tf2int T_SCP = 1 `shiftL` 5
+tf2int T_SFTP = 1 `shiftL` 6
+tf2int T_ERROR = 1 `shiftL` 7
+tf2int T_PUBLICKEY = 1 `shiftL` 8
+tf2int T_SOCKET = 1 `shiftL` 9
+
+trace2int :: [TraceFlag] -> CInt
+trace2int flags = foldr (.|.) 0 (map tf2int flags)
+
+setTraceMode :: Session -> [TraceFlag] -> IO ()
+setTraceMode a1 a2 =
+ let {a1' = toPointer a1} in
+ let {a2' = trace2int a2} in
+ setTraceMode'_ a1' a2' >>= \res ->
+ return ()
+{-# LINE 357 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Write all data to channel from handle.
+-- Returns amount of transferred data.
+writeChannelFromHandle :: Channel -> Handle -> IO Integer
+writeChannelFromHandle ch h =
+ let
+ go :: Integer -> Ptr a -> IO Integer
+ go done buffer = do
+ sz <- hGetBuf h buffer bufferSize
+ send 0 (fromIntegral sz) buffer
+ let newDone = done + fromIntegral sz
+ if sz < bufferSize
+ then return newDone
+ else go newDone buffer
+
+ send :: Int -> CLong -> Ptr a -> IO ()
+ send _ 0 _ = return ()
+ send written size buffer = do
+ sent <- handleInt (Just $ channelSession ch) $
+ libssh2_channel_write_ex
+{-# LINE 377 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+ (toPointer ch)
+ 0
+ (plusPtr buffer written)
+ (fromIntegral size)
+ send (written + fromIntegral sent) (size - fromIntegral sent) buffer
+
+ bufferSize = 0x100000
+
+ in allocaBytes bufferSize $ go 0
+
+-- | Read all data from channel to handle.
+-- Returns amount of transferred data.
+readChannelToHandle :: Channel -> Handle -> Offset -> IO Integer
+readChannelToHandle ch h fileSize = do
+ allocaBytes bufferSize $ \buffer ->
+ readChannelCB ch buffer bufferSize fileSize callback
+ where
+ callback buffer size = hPutBuf h buffer size
+
+ bufferSize :: Int
+ bufferSize = 0x100000
+
+readChannelCB :: Channel -> CString -> Int -> Offset -> (CString -> Int -> IO ()) -> IO Integer
+readChannelCB ch buffer bufferSize fileSize callback =
+ let go got = do
+ let toRead = min (fromIntegral fileSize - got) (fromIntegral bufferSize)
+ sz <- handleInt (Just $ channelSession ch) $
+ libssh2_channel_read_ex
+{-# LINE 405 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+ (toPointer ch)
+ 0
+ buffer
+ (fromIntegral toRead)
+ let isz :: Integer
+ isz = fromIntegral sz
+ callback buffer (fromIntegral sz)
+ eof <- libssh2_channel_eof (toPointer ch)
+ let newGot = got + fromIntegral sz
+ if (eof == 1) || (newGot == fromIntegral fileSize)
+ then do
+ return isz
+ else do
+ rest <- go newGot
+ return $ isz + rest
+ in go (0 :: Integer)
+
+channelIsEOF :: Channel -> IO (Bool)
+channelIsEOF a1 =
+ let {a1' = toPointer a1} in
+ channelIsEOF'_ a1' >>= \res ->
+ handleBool res >>= \res' ->
+ return (res')
+{-# LINE 424 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+closeChannel_ :: Channel -> IO (Int)
+closeChannel_ a1 =
+ let {a1' = toPointer a1} in
+ closeChannel_'_ a1' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 427 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Close channel (but do not free memory)
+closeChannel :: Channel -> IO ()
+closeChannel channel = void . handleInt (Just $ channelSession channel) $ closeChannel_ channel
+
+freeChannel_ :: Channel -> IO (Int)
+freeChannel_ a1 =
+ let {a1' = toPointer a1} in
+ freeChannel_'_ a1' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 434 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Free channel object's memory
+freeChannel :: Channel -> IO ()
+freeChannel channel = void . handleInt (Just $ channelSession channel) $ freeChannel_ channel
+
+-- | Get channel exit status
+channelExitStatus :: Channel -> IO (Int)
+channelExitStatus a1 =
+ let {a1' = toPointer a1} in
+ channelExitStatus'_ a1' >>= \res ->
+ let {res' = fromIntegral res} in
+ return (res')
+{-# LINE 442 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+channelExitSignal_ :: Channel -> Ptr Int -> Ptr Int -> Ptr Int -> IO (Int, String, Maybe String, Maybe String)
+channelExitSignal_ a1 a3 a5 a7 =
+ let {a1' = toPointer a1} in
+ alloca $ \a2' ->
+ let {a3' = castPtr a3} in
+ alloca $ \a4' ->
+ let {a5' = castPtr a5} in
+ alloca $ \a6' ->
+ let {a7' = castPtr a7} in
+ channelExitSignal_'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
+ peekCStringPtr a2'>>= \a2'' ->
+ peekMaybeCStringPtr a4'>>= \a4'' ->
+ peekMaybeCStringPtr a6'>>= \a6'' ->
+ let {res' = fromIntegral res} in
+ return (res', a2'', a4'', a6'')
+{-# LINE 451 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Get channel exit signal. Returns:
+-- (possibly error code, exit signal name, possibly error message, possibly language code).
+channelExitSignal :: Channel -> IO (Int, String, Maybe String, Maybe String)
+channelExitSignal ch = handleInt (Just $ channelSession ch) $ channelExitSignal_ ch nullPtr nullPtr nullPtr
+
+scpSendChannel_ :: Session -> String -> Int -> Int64 -> POSIXTime -> POSIXTime -> IO (Ptr ())
+scpSendChannel_ a1 a2 a3 a4 a5 a6 =
+ let {a1' = toPointer a1} in
+ withCString a2 $ \a2' ->
+ let {a3' = fromIntegral a3} in
+ let {a4' = fromIntegral a4} in
+ let {a5' = round a5} in
+ let {a6' = round a6} in
+ scpSendChannel_'_ a1' a2' a3' a4' a5' a6' >>= \res ->
+ let {res' = id res} in
+ return (res')
+{-# LINE 464 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- | Create SCP file send channel.
+scpSendChannel :: Session -> String -> Int -> Int64 -> POSIXTime -> POSIXTime -> IO Channel
+scpSendChannel session remotePath mode size mtime atime = handleNullPtr (Just session) (channelFromPointer session) $
+ scpSendChannel_ session remotePath mode size mtime atime
+
+type Offset = (CLong)
+{-# LINE 471 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
+
+-- {# pointer *stat_t as Stat newtype #}
+
+-- | Create SCP file receive channel.
+-- TODO: receive struct stat also.
+scpReceiveChannel :: Session -> FilePath -> IO (Channel, Offset)
+scpReceiveChannel s path = do
+ withCString path $ \pathptr ->
+ allocaBytes 144 $ \statptr -> do
+ channel <- handleNullPtr (Just s) (channelFromPointer s) $ libssh2_scp_recv (toPointer s) pathptr statptr
+ size <- (\ptr -> do {peekByteOff ptr 48 ::IO CLong}) statptr
+ return (channel, size)
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_init"
+ initialize_'_ :: (CInt -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_exit"
+ exit'_ :: (IO ())
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_init_ex"
+ libssh2_session_init_ex :: ((FunPtr (CULong -> ((Ptr (Ptr ())) -> (IO (Ptr ()))))) -> ((FunPtr ((Ptr ()) -> ((Ptr (Ptr ())) -> (IO ())))) -> ((FunPtr ((Ptr ()) -> (CULong -> ((Ptr (Ptr ())) -> (IO (Ptr ())))))) -> ((Ptr ()) -> (IO (Ptr ()))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_free"
+ freeSession_'_ :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_disconnect_ex"
+ disconnectSessionEx'_ :: ((Ptr ()) -> (CInt -> ((Ptr CChar) -> ((Ptr CChar) -> (IO CInt)))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_set_blocking"
+ setBlocking'_ :: ((Ptr ()) -> (CInt -> (IO ())))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_handshake"
+ handshake_'_ :: ((Ptr ()) -> (CInt -> (IO CInt)))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_init"
+ initKnownHosts_'_ :: ((Ptr ()) -> (IO (Ptr ())))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_free"
+ freeKnownHosts'_ :: ((Ptr ()) -> (IO ()))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_readfile"
+ knownHostsReadFile_'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (IO CInt))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_hostkey"
+ getHostKey'_ :: ((Ptr ()) -> ((Ptr CULong) -> ((Ptr CInt) -> (IO (Ptr CChar)))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_checkp"
+ checkKnownHost_'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> ((Ptr CChar) -> (CULong -> (CInt -> ((Ptr (Ptr ())) -> (IO CInt))))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_userauth_publickey_fromfile_ex"
+ publicKeyAuthFile_'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO CInt)))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_userauth_password_ex"
+ libssh2_userauth_password_ex :: ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> ((Ptr CChar) -> (CUInt -> ((FunPtr ((Ptr ()) -> ((Ptr (Ptr CChar)) -> ((Ptr CInt) -> ((Ptr (Ptr ())) -> (IO ())))))) -> (IO CInt)))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_open_ex"
+ openSessionChannelEx'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> (CUInt -> (CUInt -> ((Ptr CChar) -> (CUInt -> (IO (Ptr ())))))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_process_startup"
+ channelProcessStartup_'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> ((Ptr CChar) -> (CUInt -> (IO CInt))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_request_pty_ex"
+ requestPTYEx'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> ((Ptr CChar) -> (CUInt -> (CInt -> (CInt -> (CInt -> (CInt -> (IO CInt))))))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_read_ex"
+ libssh2_channel_read_ex :: ((Ptr ()) -> (CInt -> ((Ptr CChar) -> (CULong -> (IO CLong)))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_write_ex"
+ libssh2_channel_write_ex :: ((Ptr ()) -> (CInt -> ((Ptr CChar) -> (CULong -> (IO CLong)))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_send_eof"
+ channelSendEOF_'_ :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_wait_eof"
+ channelWaitEOF_'_ :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_trace"
+ setTraceMode'_ :: ((Ptr ()) -> (CInt -> (IO CInt)))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_eof"
+ libssh2_channel_eof :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_eof"
+ channelIsEOF'_ :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_close"
+ closeChannel_'_ :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_free"
+ freeChannel_'_ :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_get_exit_status"
+ channelExitStatus'_ :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_get_exit_signal"
+ channelExitSignal_'_ :: ((Ptr ()) -> ((Ptr (Ptr CChar)) -> ((Ptr CULong) -> ((Ptr (Ptr CChar)) -> ((Ptr CULong) -> ((Ptr (Ptr CChar)) -> ((Ptr CULong) -> (IO CInt))))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_scp_send64"
+ scpSendChannel_'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (CLLong -> (CLong -> (CLong -> (IO (Ptr ()))))))))
+
+foreign import ccall safe "src/Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_scp_recv"
+ libssh2_scp_recv :: ((Ptr ()) -> ((Ptr CChar) -> ((Ptr ()) -> (IO (Ptr ())))))