packages feed

libssh2 (empty) → 0.1

raw patch · 10 files changed

+1067/−0 lines, 10 filesdep +basedep +networkdep +sybsetup-changed

Dependencies added: base, network, syb, time

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, IlyaPortnov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of IlyaPortnov nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Makefile view
@@ -0,0 +1,19 @@+LIBS=-lssh2+GHC=ghc $(LIBS) --make+C2HS=c2hs -C"-Iinclude/"+HSFILES=Network/SSH/Client/LibSSH2.hs Network/SSH/Client/LibSSH2/Types.hs Network/SSH/Client/LibSSH2/Errors.hs Network/SSH/Client/LibSSH2/Foreign.hs++all: ssh-client++ssh-client: ssh-client.hs $(HSFILES)+	$(GHC) $<++%.hs: %.chs+	$(C2HS) $<++clean:+	find . -name \*.hi -delete+	find . -name \*.chi -delete+	find . -name \*.o -delete+	find . -name \*.chs.h -delete+	rm -f ssh-client
+ Network/SSH/Client/LibSSH2.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Network.SSH.Client.LibSSH2+  (-- * Types+   Session, Channel, KnownHosts,++   -- * Functions+   withSSH2,+   withSession,+   withSessionBlocking,+   withChannel,+   checkHost,+   readAllChannel,+   retryIfNeeded,+   scpSendFile,+   scpReceiveFile,+   runShellCommands,+   execCommands,++   -- * Utilities+   socketConnect+  ) where++import Control.Monad+import Control.Exception as E+import Network+import Network.BSD+import Network.Socket+import System.IO++import Network.SSH.Client.LibSSH2.Types+import Network.SSH.Client.LibSSH2.Errors+import Network.SSH.Client.LibSSH2.Foreign++-- | Check if handle is ready for reading in 10 seconds.+waitSocket :: Handle -> Session -> IO Bool+waitSocket h s = do+  dirs <- blockedDirections s+  if INBOUND `elem` dirs+    then hWaitForInput h (10*1000)+    else return True++-- | Similar to Network.connectTo, but does not socketToHandle.+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)++-- | Execute some actions within SSH2 connection.+-- Uses public key authentication.+withSSH2 :: FilePath          -- ^ Path to known_hosts file+         -> FilePath          -- ^ Path to public key file+         -> FilePath          -- ^ Path to private key file+         -> String            -- ^ Remote user name+         -> String            -- ^ Remote host name+         -> Int               -- ^ Remote port number (usually 22)+         -> (Channel -> IO a) -- ^ Actions to perform on channel+         -> IO (Int, a)+withSSH2 known_hosts public private login hostname port fn =+  withSessionBlocking hostname port $ \s -> do+    r <- checkHost s hostname port known_hosts+    publicKeyAuthFile s login public private ""+    withChannel s $ fn++-- | Execute some actions within SSH2 session+withSession :: String                      -- ^ Remote host name+            -> Int                         -- ^ Remote port number (usually 22)+            -> (Handle -> Session -> IO a) -- ^ Actions to perform on handle and session+            -> IO a+withSession hostname port fn = do+  sock <- socketConnect hostname port+  handle <- socketToHandle sock ReadWriteMode +  session <- initSession+  handshake session sock+  result <- fn handle session+  disconnectSession session "Done."+  freeSession session+  hClose handle+  return result++-- | Execute some actions within SSH2 session+withSessionBlocking :: String                      -- ^ Remote host name+            -> Int                         -- ^ Remote port number (usually 22)+            -> (Session -> IO a) -- ^ Actions to perform on handle and session+            -> IO a+withSessionBlocking hostname port fn = do+  sock <- socketConnect hostname port+  session <- initSession+  handshake session sock+  result <- fn session+  disconnectSession session "Done."+  freeSession session+  return result++--  | Check remote host against known hosts list+checkHost :: Session+          -> String             -- ^ Remote host name+          -> Int                -- ^ Remote port number (usually 22)+          -> FilePath           -- ^ Path to known_hosts file+          -> IO KnownHostResult+checkHost s host port path = do+  kh <- initKnownHosts s+  knownHostsReadFile kh path+  (hostkey, keylen, keytype) <- getHostKey s+  result <- checkKnownHost kh host port hostkey [TYPE_PLAIN, KEYENC_RAW]+  freeKnownHosts kh+  return result++-- | Execute some actions withing SSH2 channel+withChannel :: Session -> (Channel -> IO a) -> IO (Int, a)+withChannel s fn = do+  ch <- openChannelSession s+  -- waitSocket sock s+  result <- fn ch+  closeChannel ch+  exitStatus <- channelExitStatus ch+  freeChannel ch+  return (exitStatus, result)++-- | Read all data from the channel+readAllChannel :: Channel -> IO String+readAllChannel ch = do+    (sz, res) <- readChannel ch 0x400+    if sz > 0+      then do+           rest <- readAllChannel ch+           return $ res ++ rest+      else return ""++runShellCommands :: Session -> [String] -> IO (Int, [String])+runShellCommands s commands = do+  ch <- openChannelSession s+  requestPTY ch "linux"+  channelShell ch+  hello <- readAllChannel ch+  out <- forM commands $ \cmd -> do+             writeChannel ch (cmd ++ "\n")+             r <- readAllChannel ch+             return r+  channelSendEOF ch+  closeChannel ch+  exitStatus <- channelExitStatus ch+  freeChannel ch+  return (exitStatus, out)++execCommands :: Session -> [String] -> IO (Int, [String])+execCommands s commands = do+  ch <- openChannelSession s+  out <- forM commands $ \cmd -> do+             channelExecute ch cmd+             readAllChannel ch+  closeChannel ch+  exitStatus <- channelExitStatus ch+  freeChannel ch+  return (exitStatus, out)+++-- | Send a file to remote host via SCP.+-- Returns size of sent data.+scpSendFile :: Session   +            -> Int       -- ^ File creation mode (0o777, for example)+            -> FilePath  -- ^ Path to local file+            -> FilePath  -- ^ Remote file path+            -> IO Integer+scpSendFile s mode local remote = do+  h <- openFile local ReadMode+  size <- hFileSize h+  ch <- scpSendChannel s remote mode (fromIntegral size) 0 0+  result <- writeChannelFromHandle s ch h+  hClose h+  closeChannel ch+  freeChannel ch+  return result++-- | Receive file from remote host via SCP.+-- Returns size of received data.+scpReceiveFile :: Session   --+               -> FilePath  -- ^ Remote file path+               -> FilePath  -- ^ Path to local file+               -> IO Integer+scpReceiveFile s remote local = do+  h <- openFile local WriteMode+  (ch, fileSize) <- scpReceiveChannel s remote+  result <- readChannelToHandle ch h fileSize+  hClose h+  closeChannel ch+  freeChannel ch+  return result++-- | Retry the action repeatedly, while it fails with EAGAIN.+-- This does matter if using nonblocking mode.+retryIfNeeded :: Handle -> Session -> IO a -> IO a+retryIfNeeded handle session action =+  action `E.catch` (\(e :: ErrorCode) ->+                      if e == EAGAIN+                        then do+                             waitSocket handle session+                             retryIfNeeded handle session action+                        else throw e )+
+ Network/SSH/Client/LibSSH2/Errors.chs view
@@ -0,0 +1,163 @@+{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, FlexibleInstances, TypeFamilies, MultiParamTypeClasses #-}++#include <libssh2.h>++{# context lib="ssh2" prefix="libssh2" #}++module Network.SSH.Client.LibSSH2.Errors+  (-- * Types+   ErrorCode (..),+   NULL_POINTER,++   -- * Utilities+   CIntResult (..),++   -- * Functions+   getLastError,+   handleInt,+   handleBool,+   handleNullPtr,+   int2error+  ) where++import Control.Exception+import Data.Generics+import Foreign+import Foreign.Ptr+import Foreign.C.Types++import Network.SSH.Client.LibSSH2.Types++-- | Error codes returned by libssh2.+data ErrorCode =+    NONE+  | SOCKET_NONE+  | BANNER_RECV+  | BANNER_SEND+  | INVALID_MAC+  | KEX_FALIURE+  | ALLOC+  | SOCKET_SEND+  | KEY_EXCHANGE_FAILURE+  | TIMEOUT+  | HOSTKEY_INIT+  | HOSTKEY_SIGN+  | DECRYPT+  | SOCKET_DISCONNECT+  | PROTO+  | PASSWORD_EXPIRED+  | FILE+  | METHOD_NONE+  | AUTHENTICATION_FAILED+  | PUBLICKEY_UNVERIFIED+  | CHANNEL_OUTOFORDER+  | CHANNEL_FAILURE+  | CHANNEL_REQUEST_DENIED+  | CHANNEL_UNKNOWN+  | CHANNEL_WINDOW_EXCEEDED+  | CHANNEL_PACKET_EXCEEDED+  | CHANNEL_CLOSED+  | CHANNEL_EOF_SENT+  | SCP_PROTOCOL+  | ZLIB+  | SOCKET_TIMEOUT+  | SFTP_PROTOCOL+  | REQUEST_DENIED+  | METHOD_NOT_SUPPORTED+  | INVAL+  | INVALID_POLL_TYPE+  | PUBLICKEY_PROTOCOL+  | EAGAIN+  | BUFFER_TOO_SMALL+  | BAD_USE+  | COMPRESS+  | OUT_OF_BOUNDARY+  | AGENT_PROTOCOL+  | SOCKET_RECV+  | ENCRYPT+  | BAD_SOCKET+  deriving (Eq, Show, Ord, Enum, Data, Typeable)++instance Exception ErrorCode++error2int :: (Num i) => ErrorCode -> i+error2int = fromIntegral . negate . fromEnum++int2error :: (Integral i) => i -> ErrorCode+int2error = toEnum . negate . fromIntegral++-- | Exception to throw when null pointer received+-- from libssh2.+data NULL_POINTER = NULL_POINTER+  deriving (Eq, Show, Data, Typeable)++instance Exception NULL_POINTER++class HasCInt a where+  intResult :: a -> CInt++class (HasCInt a) => CIntResult a b where+  fromCInt :: a -> b++instance HasCInt CInt where+  intResult = id++instance (Num b) => CIntResult CInt b where+  fromCInt = fromIntegral++instance HasCInt CLong where+  intResult = fromIntegral++instance (Num b) => CIntResult CLong b where+  fromCInt = fromIntegral++instance (Integral i) => HasCInt (i, a) where+  intResult (i, _) = fromIntegral i+  +instance (Integral i, Num b) => CIntResult (i, a) (b, a) where+  fromCInt (i, a) = (fromIntegral i, a)++instance HasCInt (CInt, a, b) where+  intResult (i, _, _) = i++instance (Num j) => CIntResult (CInt, a, b) (j, a, b) where+  fromCInt (i, a, b) = (fromIntegral i, a, b)++instance HasCInt (CInt, a, b, c) where+  intResult (i, _, _, _) = i++instance (Num j) => CIntResult (CInt, a, b, c) (j, a, b, c) where+  fromCInt (i, a, b, c) = (fromIntegral i, a, b, c)++{# fun session_last_error as getLastError_+  { toPointer `Session',+    alloca- `String' peekCStringPtr*,+    castPtr `Ptr Int',+    `Int' } -> `Int' #}++-- | Get last error information.+getLastError :: Session -> IO (Int, String)+getLastError s = getLastError_ s nullPtr 0++-- | Throw an exception if negative value passed,+-- or return unchanged value.+handleInt :: (CIntResult a b) => a -> IO b+handleInt x =+  let r = intResult x+  in if r < 0+       then throw (int2error r)+       else return (fromCInt x)++handleBool :: CInt -> IO Bool+handleBool x+  | x == 0 = return False+  | x > 0  = return True+  | otherwise = throw (int2error x)++-- | Throw an exception if null pointer passed,+-- or return it casted to right type.+handleNullPtr :: (IsPointer a) => Ptr () -> IO a+handleNullPtr p+  | p == nullPtr = throw NULL_POINTER+  | otherwise    = return (fromPointer p)+
+ Network/SSH/Client/LibSSH2/Foreign.chs view
@@ -0,0 +1,444 @@+{-# LANGUAGE ForeignFunctionInterface #-}++#include "libssh2_local.h"+#include <libssh2.h>++{# context lib="ssh2" prefix="libssh2" #}++module Network.SSH.Client.LibSSH2.Foreign+  (-- * Types+   KnownHosts, KnownHostResult (..), KnownHostType (..),+   Direction (..),++   -- * Session functions+   initialize, exit,+   initSession, freeSession, disconnectSession,+   handshake,+   blockedDirections,+   setBlocking,+   +   -- * Known hosts functions+   initKnownHosts, freeKnownHosts, knownHostsReadFile,+   getHostKey, checkKnownHost,++   -- * Authentication+   publicKeyAuthFile,++   -- * Channel functions+   openChannelSession, closeChannel, freeChannel,+   channelSendEOF,+   readChannel, writeChannel,+   writeChannelFromHandle, readChannelToHandle,+   channelProcess, channelExecute, channelShell,+   requestPTY, requestPTYEx,+   channelExitStatus, channelExitSignal,+   scpSendChannel, scpReceiveChannel,++   -- * Debug+   TraceFlag (..), setTraceMode+  ) where++import Control.Exception+import Control.Monad+import Foreign+import Foreign.Ptr+import Foreign.C.Types+import Foreign.C.String+import System.IO+import Network.Socket+import Data.Bits+import Data.Int+import Data.Time.Clock.POSIX+import Text.Printf++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)++-- | Session directions+data Direction = INBOUND | OUTBOUND+  deriving (Eq, Show)++int2dir 1 = [INBOUND]+int2dir 2 = [OUTBOUND]+int2dir 3 = [INBOUND, OUTBOUND]+int2dir x = error $ "Unknown direction: " ++ show x++init_crypto :: Bool -> CInt+init_crypto False = 1+init_crypto True  = 0++ssh2socket :: Socket -> CInt+ssh2socket (MkSocket s _ _ _ _) = s++-- | Initialize libssh2. Pass True to enable encryption+-- or False to disable it.+{# fun init as initialize+  { init_crypto `Bool' } -> `Int' handleInt* #}++-- | Deinitialize libssh2.+{# fun exit as exit { } -> `()' #}++-- | Create Session object+initSession :: IO Session+initSession = do+  ptr <- {# call session_init_ex #} nullFunPtr nullFunPtr nullFunPtr nullPtr+  handleNullPtr ptr++-- | Free Session object's memory+{# fun session_free as freeSession+  { toPointer `Session' } -> `Int' handleInt* #}++{# fun session_disconnect_ex as disconnectSessionEx+  { toPointer `Session', `Int', `String', `String' } -> `Int' handleInt* #}++-- | Disconnect session (but do not free memory)+disconnectSession :: Session+                  -> String  -- ^ Goodbye message+                  -> IO Int+disconnectSession s msg = disconnectSessionEx s 11 msg ""++{# fun session_set_blocking as setBlocking+  { toPointer `Session', bool2int `Bool' } -> `()' #}++bool2int :: Bool -> CInt+bool2int True  = 1+bool2int False = 0++-- | Run SSH handshake on network socket.+{# fun session_handshake as handshake+  { toPointer `Session', ssh2socket `Socket' } -> `Int' handleInt* #}++-- | Create KnownHosts object for given session.+{# fun knownhost_init as initKnownHosts+  { toPointer `Session' } -> `KnownHosts' handleNullPtr* #}++-- | Free KnownHosts object's memory+{# fun knownhost_free as freeKnownHosts+  { toPointer `KnownHosts' } -> `()' #}++{# fun knownhost_readfile as knownHostsReadFile_+  { toPointer `KnownHosts', `String', id `CInt' } -> `Int' handleInt* #}++-- | Read known hosts from file+knownHostsReadFile :: KnownHosts+                   -> FilePath   -- ^ Path to known_hosts file+                   -> IO Int+knownHostsReadFile kh path = knownHostsReadFile_ kh path 1++-- | Get remote host public key+{# fun session_hostkey as getHostKey+  { toPointer `Session', alloca- `Size' peek*, alloca- `CInt' peek* } -> `String' #}++{# fun knownhost_checkp as checkKnownHost_+  { toPointer `KnownHosts',+    `String',+    `Int',+    `String',+    `Int',+    typemask2int `[KnownHostType]',+    castPtr `Ptr ()' } -> `KnownHostResult' int2khresult #}++-- | 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 mask = checkKnownHost_ kh host port key (length key) mask nullPtr++-- | Perform public key authentication.+-- Arguments are: session, username, path to public key file,+-- path to private key file, passphrase.+{# fun userauth_publickey_fromfile_ex as publicKeyAuthFile+  { toPointer `Session',+    `String' &,+    `String',+    `String',+    `String' } -> `Int' handleInt* #}++{# fun channel_open_ex as openSessionChannelEx+  { toPointer `Session',+   `String' &,+   `Int', `Int',+   `String' & } -> `Channel' handleNullPtr* #}++-- | Open a channel for session.+openChannelSession :: Session -> IO Channel+openChannelSession s = openSessionChannelEx s "session" 65536 32768 ""++channelProcess :: Channel -> String -> String -> IO Int+channelProcess ch kind command = do+  withCStringLenIntConv kind $ \(kindptr, kindlen) ->+    withCStringLenIntConv command $ \(commandptr, commandlen) ->+      {# call channel_process_startup #}+          (toPointer ch)+          kindptr kindlen+          commandptr commandlen >>= handleInt++-- | Execute command+channelExecute :: Channel -> String -> IO Int+channelExecute c command = channelProcess c "exec" command++-- | Execute shell command+channelShell :: Channel -> IO Int+channelShell c = do+  withCStringLenIntConv "shell" $ \(kindptr, kindlen) ->+    {# call channel_process_startup #}+      (toPointer c)+      kindptr+      kindlen+      nullPtr 0 >>= handleInt++{# fun channel_request_pty_ex as requestPTYEx+  { toPointer `Channel',+    `String' &,+    `String' &,+    `Int', `Int',+    `Int', `Int' } -> `Int' handleInt* #}++requestPTY :: Channel -> String -> IO Int+requestPTY ch term = requestPTYEx ch term "" 0 0 0 0++readChannelEx :: Channel -> Int -> Size -> IO (SSize, String)+readChannelEx ch i size =+  allocaBytes (fromIntegral size) $ \buffer -> do+    rc <- {# call channel_read_ex #} (toPointer ch) (fromIntegral i) buffer size+    when (rc < 0) $+        throw (int2error rc)+    str <- peekCAStringLen (buffer, fromIntegral rc)+    return (rc, str)++-- | Read data from channel.+-- Returns amount of given data and data itself.+-- NOTE: returns bytes sequence, i.e. not Unicode.+readChannel :: Channel         -- +            -> Size             -- ^ Amount of data to read+            -> IO (SSize, String)+readChannel c sz = readChannelEx c 0 sz++{# fun channel_write_ex as writeChannelEx+  { toPointer `Channel',+    `Int',+    withCStringLenIntConv* `String' & } -> `Int' handleInt* #}++-- | Write data to channel.+-- Returns amount of written data.+writeChannel :: Channel -> String -> IO Int+writeChannel ch str = writeChannelEx ch 0 str++{# fun channel_send_eof as channelSendEOF+  { toPointer `Channel' } -> `Int' handleInt* #}++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)++{# fun trace as setTraceMode+  { toPointer `Session', trace2int `[TraceFlag]' } -> `Int' handleInt* #}++-- | Write all data to channel from handle.+-- Returns amount of transferred data.+--writeChannelFromHandle :: Channel -> Handle -> IO Integer+writeChannelFromHandle session ch handle = +  let+    go h done fileSize buffer = do+      sz <- hGetBuf h buffer bufferSize+      sent <- send 0 (fromIntegral sz) buffer+      let newDone = done + sent+      if sz < bufferSize+        then do+             --channelSendEOF ch+             return $ fromIntegral sz+        else do+             rest <- go h newDone  fileSize buffer+             return $ fromIntegral sz + rest+    +    send written 0 _ = return written+    send written size buffer = do+      sent <- {# call channel_write_ex #}+                  (toPointer ch)+                  0+                  (plusPtr buffer written)+                  (fromIntegral size)+      when (sent < 0) $ do+          throw (int2error sent)+      send (written + fromIntegral sent) (size - sent) buffer++    bufferSize = 0x100000++  in do+    fileSize <- hFileSize handle+    {# call trace #} (toPointer session) (512)+    allocaBytes bufferSize $ \buffer ->+        go handle 0 fileSize buffer++-- | Read all data from channel to handle.+-- Returns amount of transferred data.+readChannelToHandle :: Channel -> Handle -> Offset -> IO Integer+readChannelToHandle ch handle fileSize = do+    allocaBytes bufferSize $ \buffer ->+        readChannelCB ch buffer bufferSize fileSize callback+  where+    callback buffer size = hPutBuf handle buffer size++    bufferSize :: Int+    bufferSize = 0x100000++readChannelCB :: Channel -> CString -> Int -> Offset -> (CString -> Int -> IO a) -> IO Integer+readChannelCB ch buffer bufferSize fileSize callback =+  let go got = do+        let toRead = min (fromIntegral fileSize - got) (fromIntegral bufferSize)+        sz <- {# call channel_read_ex #}+                  (toPointer ch)+                  0+                  buffer+                  (fromIntegral toRead)+        when (sz < 0) $+            throw (int2error sz)+        let isz :: Integer+            isz = fromIntegral sz+        callback buffer (fromIntegral sz)+        eof <- {# call 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++{# fun channel_eof as channelIsEOF+  { toPointer `Channel' } -> `Bool' handleBool* #}++-- | Close channel (but do not free memory)+{# fun channel_close as closeChannel+  { toPointer `Channel' } -> `Int' handleInt* #}++-- | Free channel object's memory+{# fun channel_free as freeChannel+  { toPointer `Channel' } -> `Int' handleInt* #}++-- | Get currently blocked directions+{# fun session_block_directions as blockedDirections+  { toPointer `Session' } -> `[Direction]' int2dir #}++-- | Get channel exit status+{# fun channel_get_exit_status as channelExitStatus+  { toPointer `Channel' } -> `Int' handleInt* #}++{# fun channel_get_exit_signal as channelExitSignal_+  { toPointer `Channel',+    alloca- `String' peekCStringPtr*,+    castPtr `Ptr Int',+    alloca- `Maybe String' peekMaybeCStringPtr*,+    castPtr `Ptr Int',+    alloca- `Maybe String' peekMaybeCStringPtr*,+    castPtr `Ptr Int' } -> `Int' handleInt* #}++-- | 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 = channelExitSignal_ ch nullPtr nullPtr nullPtr++-- | Create SCP file send channel.+{# fun scp_send64 as scpSendChannel+  { toPointer `Session',+    `String',+    `Int',+    `Int64',+    round `POSIXTime',+    round `POSIXTime' } -> `Channel' handleNullPtr* #}++type Offset = {# type off_t #}++{# 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+  (ptr, sz) <- withCString path $ \pathptr ->+                  allocaBytes {# sizeof stat_t #} $ \statptr -> do+                    p <- {# call scp_recv #} (toPointer s) pathptr statptr+                    size <- {# get stat_t->st_size #} statptr+                    return (p, size)+  channel <- handleNullPtr ptr+  return (channel, sz)++
+ Network/SSH/Client/LibSSH2/Types.chs view
@@ -0,0 +1,87 @@+{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, StandaloneDeriving #-}++#include <libssh2.h>++{# context lib="ssh2" prefix="libssh2" #}++module Network.SSH.Client.LibSSH2.Types+  (Session,+   KnownHosts,+   Channel,+   IsPointer (..),+   CStringCLen,+   Size, SSize,+   withCStringLenIntConv,+   peekCStringPtr,+   peekMaybeCStringPtr+  ) where++import Foreign+import Foreign.Ptr+import Foreign.C.Types+import Foreign.C.String+import Data.Generics++type Size = {# type size_t #}++type SSize = {# type ssize_t #}++type CStringCLen i = (CString, i)++withCStringLenIntConv :: (Integral i) => String -> (CStringCLen i -> IO a) -> IO a+withCStringLenIntConv str fn =+  withCStringLen str (\(ptr, len) -> fn (ptr, fromIntegral len))++peekCStringPtr :: Ptr CString -> IO String+peekCStringPtr ptr = peekCAString =<< peek ptr++peekMaybeCStringPtr :: Ptr CString -> IO (Maybe String)+peekMaybeCStringPtr ptr = do+  strPtr <- peek ptr+  if strPtr == nullPtr+    then return Nothing+    else Just `fmap` peekCAString strPtr++class IsPointer p where+  fromPointer :: Ptr () -> p+  toPointer :: p -> Ptr ()++{# pointer *SESSION as Session newtype #}++deriving instance Eq Session+deriving instance Data Session+deriving instance Typeable Session++instance Show Session where+  show (Session p) = "<libssh2 session: " ++ show p ++ ">"++instance IsPointer Session where+  fromPointer p = Session (castPtr p)+  toPointer (Session p) = castPtr p++{# pointer *KNOWNHOSTS as KnownHosts newtype #}++deriving instance Eq KnownHosts+deriving instance Data KnownHosts+deriving instance Typeable KnownHosts++instance Show KnownHosts where+  show (KnownHosts p) = "<libssh2 known hosts: " ++ show p ++ ">"++instance IsPointer KnownHosts where+  fromPointer p = KnownHosts (castPtr p)+  toPointer (KnownHosts p) = castPtr p++{# pointer *CHANNEL as Channel newtype #}++deriving instance Eq Channel+deriving instance Data Channel+deriving instance Typeable Channel++instance Show Channel where+  show (Channel p) = "<libssh2 channel: " ++ show p ++ ">"++instance IsPointer Channel where+  fromPointer p = Channel (castPtr p)+  toPointer (Channel p) = castPtr p+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ include/libssh2_local.h view
@@ -0,0 +1,7 @@++#include <sys/stat.h>++// This definition is used to determine sizeof(struct stat),+// because c2hs lacks support for such case.+typedef struct stat stat_t;+
+ libssh2.cabal view
@@ -0,0 +1,49 @@+Name:                libssh2++Version:             0.1++Synopsis:            FFI bindings to libssh2 SSH2 client library (http://libssh2.org/)++Description:         This package provides FFI bindings for SSH2 client library named libssh2.++Homepage:            http://redmine.iportnov.ru/projects/libssh2-hs++License:             BSD3++License-file:        LICENSE++Author:              IlyaPortnov++Maintainer:          portnov84@rambler.ru++-- A copyright notice.+-- Copyright:           ++Category:            Network++Build-type:          Simple++Extra-source-files:  ssh-client.hs, Makefile, include/libssh2_local.h++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.6+++Library+  Exposed-modules:     Network.SSH.Client.LibSSH2.Types+                       Network.SSH.Client.LibSSH2.Foreign+                       Network.SSH.Client.LibSSH2.Errors+                       Network.SSH.Client.LibSSH2+  +  Include-dirs:        include+  Includes:            include/libssh2_local.h++  Build-depends:       base >= 4 && < 5, network >= 2.3,+                       syb >= 0.3.3, time >= 1.2++  Extra-libraries:     "ssh2"+  +  -- Other-modules:       +  +  Build-tools:         c2hs+
+ ssh-client.hs view
@@ -0,0 +1,63 @@++import System.Environment+import System.FilePath+import Codec.Binary.UTF8.String++import Network.SSH.Client.LibSSH2.Foreign+import Network.SSH.Client.LibSSH2++main = do+  args <- getArgs+  case args of+    ["command", user, host, port, cmd]  -> runCommand user host (read port) cmd+    ["send", user, host, port, path]    -> sendFile user host (read port) path+    ["receive", user, host, port, path] -> receiveFile user host (read port) path+    _ -> putStrLn "Synopsis: ssh-client USERNAME HOSTNAME PORT COMMAND"++runCommand login host port command =+  ssh login host port $ \ch -> do+      channelExecute ch command+      result <- readAllChannel ch+      let r = decodeString result+      print (length result)+      print (length r)+      putStrLn r++sendFile login host port path = do+  initialize True+  home <- getEnv "HOME"+  let known_hosts = home </> ".ssh" </> "known_hosts"+      public = home </> ".ssh" </> "id_rsa.pub"+      private = home </> ".ssh" </> "id_rsa"++  withSession host port $ \_ s -> do+      r <- checkHost s host port known_hosts+      print r+      publicKeyAuthFile s login public private ""+      sz <- scpSendFile s 0o644 path (takeFileName path)+      putStrLn $ "Sent: " ++ show sz ++ " bytes."+  exit++receiveFile login host port path = do+  initialize True+  home <- getEnv "HOME"+  let known_hosts = home </> ".ssh" </> "known_hosts"+      public = home </> ".ssh" </> "id_rsa.pub"+      private = home </> ".ssh" </> "id_rsa"++  withSession host port $ \_ s -> do+      r <- checkHost s host port known_hosts+      print r+      publicKeyAuthFile s login public private ""+      sz <- scpReceiveFile s (takeFileName path) path+      putStrLn $ "Received: " ++ show sz ++ " bytes."+  exit++ssh login host port actions = do+  initialize True+  home <- getEnv "HOME"+  let known_hosts = home </> ".ssh" </> "known_hosts"+      public = home </> ".ssh" </> "id_rsa.pub"+      private = home </> ".ssh" </> "id_rsa"+  withSSH2 known_hosts public private login host port $ actions+  exit