libssh2 0.2.0.4 → 0.2.0.5
raw patch · 6 files changed
+523/−726 lines, 6 filesdep +select
Dependencies added: select
Files
- libssh2.cabal +2/−2
- src/Network/SSH/Client/LibSSH2.hs +139/−5
- src/Network/SSH/Client/LibSSH2/Errors.chs +90/−16
- src/Network/SSH/Client/LibSSH2/Foreign.chs +249/−9
- src/Network/SSH/Client/LibSSH2/Foreign.hs +0/−693
- src/Network/SSH/Client/LibSSH2/Types.chs +43/−1
libssh2.cabal view
@@ -1,6 +1,6 @@ Name: libssh2 -Version: 0.2.0.4+Version: 0.2.0.5 Synopsis: FFI bindings to libssh2 SSH2 client library (http://libssh2.org/) @@ -62,7 +62,7 @@ Build-depends: base >= 4 && < 5, network >= 2.3, syb >= 0.3.3, time >= 1.2,- bytestring >= 0.9+ bytestring >= 0.9, select >= 0.4 Extra-libraries: "ssh2" pkgconfig-depends: libssh2 >= 1.2.8
src/Network/SSH/Client/LibSSH2.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Network.SSH.Client.LibSSH2 (-- * Types- Session, Channel, KnownHosts,+ Session, Channel, KnownHosts, Sftp, SftpHandle,+ SftpAttributes, SftpList, SftpFileTransferFlags, -- * Functions withSSH2,@@ -17,6 +18,16 @@ runShellCommands, execCommands, + -- * Sftp Functions+ withSFTP,+ withSFTPUser,+ sftpListDir,+ sftpRenameFile,+ sftpSendFile, sftpSendFromHandle,+ sftpReceiveFile, sftpReadFileToHandler,+ sftpFstat,+ sftpDeleteFile,+ -- * Utilities socketConnect, sessionInit,@@ -143,10 +154,10 @@ 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+ bs <- do isReadable <- pollChannelRead ch+ if isReadable+ then readChannel ch 0x400+ else return BSS.empty if BSS.length bs > 0 then go (bs : acc) else return (BSL.fromChunks $ reverse acc)@@ -218,3 +229,126 @@ freeChannel ch return (exitStatus, result) +-- | Execute some actions within SFTP connection.+-- Uses public key authentication.+withSFTP :: FilePath -- ^ Path to known_hosts file+ -> FilePath -- ^ Path to public key file+ -> FilePath -- ^ Path to private key file+ -> String -- ^ Passphrase+ -> String -- ^ Remote user name+ -> String -- ^ Remote host name+ -> Int -- ^ Remote port number (usually 22)+ -> (Sftp -> IO a) -- ^ Actions to perform on sftp session+ -> IO a+withSFTP 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+ withSftpSession s fn++-- | Execute some actions within SFTP connection.+-- Uses username/password authentication.+withSFTPUser :: FilePath -- ^ Path to known_hosts file+ -> String -- ^ Remote user name+ -> String -- ^ Remote password+ -> String -- ^ Remote host name+ -> Int -- ^ Remote port number (usually 22)+ -> (Sftp -> IO a) -- ^ Actions to perform on sftp session+ -> IO a+withSFTPUser known_hosts login password 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+ usernamePasswordAuth s login password+ withSftpSession s fn++-- | Execute some actions within SFTP session+withSftpSession :: Session -- ^ Remote host name+ -> (Sftp -> IO a) -- ^ Actions to perform on sftp session+ -> IO a+withSftpSession session =+ E.bracket (sftpInit session) sftpShutdown++type SftpList = [(BSS.ByteString, SftpAttributes)]++-- | Reads directory information+-- Returns the list of files with attributes, directory . and ..+-- are not excluded+sftpListDir :: Sftp -- ^ Opened sftp session+ -> FilePath -- ^ Remote directory to read+ -> IO SftpList+sftpListDir sftp path =+ let+ collectFiles :: SftpHandle -> SftpList -> IO SftpList+ collectFiles h acc = do+ v <- sftpReadDir h+ case v of+ Nothing -> return acc+ Just r -> collectFiles h (r : acc)+ in+ withDirList sftp path $ \h ->+ collectFiles h []++withDirList :: Sftp+ -> FilePath+ -> (SftpHandle -> IO a)+ -> IO a+withDirList sftp path = E.bracket (sftpOpenDir sftp path) sftpCloseHandle+++-- | Send a file to remote host via SFTP+-- Returns size of sent data.+sftpSendFile :: Sftp -- ^ Opened sftp session+ -> FilePath -- ^ Path to local file+ -> FilePath -- ^ Remote file path+ -> Int -- ^ File creation mode (0o777, for example)+ -> IO Integer+sftpSendFile sftp local remote mode =+ withFile local ReadMode $ \fh ->+ sftpSendFromHandle sftp fh remote mode++-- | Send a file to remote host via SFTP+-- Returns size of sent data.+sftpSendFromHandle :: Sftp -- ^ Opened sftp session+ -> Handle -- ^ Handle to read from+ -> FilePath -- ^ Remote file path+ -> Int -- ^ File creation mode (0o777, for example)+ -> IO Integer+sftpSendFromHandle sftp fh remote mode = do+ let flags = [FXF_WRITE, FXF_CREAT, FXF_TRUNC, FXF_EXCL]+ withOpenSftpFile sftp remote mode flags $ \sftph ->+ sftpWriteFileFromHandler sftph fh++-- | Received a file from remote host via SFTP+-- Returns size of received data.+sftpReceiveFile :: Sftp -- ^ Opened sftp session+ -> FilePath -- ^ Path to local file+ -> FilePath -- ^ Remote file path+ -> IO Integer+sftpReceiveFile sftp local remote =+ withFile local WriteMode $ \fh ->+ sftpReceiveToHandle sftp remote fh++-- | Received a file from remote host via SFTP+-- Returns size of received data.+sftpReceiveToHandle :: Sftp -- ^ Opened sftp session+ -> FilePath -- ^ Path to remote file+ -> Handle -- ^ Open handle to write to+ -> IO Integer+sftpReceiveToHandle sftp remote fh = do+ result <- withOpenSftpFile sftp remote 0 [FXF_READ] $ \sftph -> do+ fstat <- sftpFstat sftph+ sftpReadFileToHandler sftph fh (fromIntegral $ saFileSize fstat)+ return $ fromIntegral result++withOpenSftpFile :: Sftp+ -> FilePath+ -> Int+ -> [SftpFileTransferFlags]+ -> (SftpHandle -> IO a)+ -> IO a+withOpenSftpFile sftp path mode flags =+ E.bracket (sftpOpenFile sftp path mode flags) sftpCloseHandle
src/Network/SSH/Client/LibSSH2/Errors.chs view
@@ -8,12 +8,14 @@ #endif #include <libssh2.h>+#include <libssh2_sftp.h> {# context lib="ssh2" prefix="libssh2" #} module Network.SSH.Client.LibSSH2.Errors (-- * Types ErrorCode (..),+ SftpErrorCode (..), NULL_POINTER, -- * Utilities@@ -21,10 +23,12 @@ -- * Functions getLastError,+ getLastSftpError, handleInt, handleBool, handleNullPtr, int2error, error2int,+ int2sftperror, sftperror2int, blockedDirections, threadWaitSession ) where@@ -140,15 +144,18 @@ -- | Throw an exception if negative value passed, -- or return unchanged value.-handleInt :: (IntResult a) => Maybe Session -> IO a -> IO a+handleInt :: (IntResult a, SshCtx ctx) => Maybe ctx -> IO a -> IO a handleInt s io = do x <- io let r = intResult x if r < 0 then case int2error r of EAGAIN -> threadWaitSession s >> handleInt s io- err -> throwIO err- else return x + err ->+ case s of+ Nothing -> throw err+ Just ctx -> throwCtxSpecificError ctx err+ else return x handleBool :: CInt -> IO Bool handleBool x@@ -158,32 +165,99 @@ -- | Throw an exception if null pointer passed, -- or return it casted to right type.-handleNullPtr :: Maybe Session -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a-handleNullPtr s fromPointer io = do- p <- io- if p == nullPtr - then case s of- Nothing -> throw NULL_POINTER- Just session -> do+handleNullPtr :: (SshCtx c) => Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a+handleNullPtr m_ctx fromPointer io = do+ ptr <- io+ if ptr == nullPtr+ then case m_ctx of+ Nothing -> throw NULL_POINTER+ Just ctx -> do+ let session = getSession ctx (r, _) <- getLastError session case int2error r of- EAGAIN -> threadWaitSession (Just session) >> handleNullPtr s fromPointer io- err -> throw err- else fromPointer p+ EAGAIN -> threadWaitSession (Just session) >> handleNullPtr m_ctx fromPointer io+ err -> throwCtxSpecificError ctx err+ else fromPointer ptr -- | Get currently blocked directions {# fun session_block_directions as blockedDirections { toPointer `Session' } -> `[Direction]' int2dir #} -threadWaitSession :: Maybe Session -> IO ()+threadWaitSession :: (SshCtx ctx) => Maybe ctx -> IO () threadWaitSession Nothing = error "EAGAIN thrown without session present"-threadWaitSession (Just s) = do+threadWaitSession (Just ctx) = do+ let s = getSession ctx mSocket <- sessionGetSocket s case mSocket of Nothing -> error "EAGAIN thrown on session without socket"- Just socket -> do + Just socket -> do dirs <- blockedDirections s if (OUTBOUND `elem` dirs) then threadWaitWrite socket else threadWaitRead socket +-- | Sftp++{# fun sftp_last_error as getLastSftpError_+ {toPointer `Sftp'} -> `Int' #}++-- | Get last sftp related error.+getLastSftpError :: Sftp -> IO Int+getLastSftpError sftp = getLastSftpError_ sftp++sftperror2int :: (Num i) => SftpErrorCode -> i+sftperror2int = fromIntegral . fromEnum++int2sftperror :: (Integral i) => i -> SftpErrorCode+int2sftperror = toEnum . fromIntegral++-- | Sftp error code returning from libssh2+data SftpErrorCode =+ FX_OK+ | FX_EOF+ | FX_NO_SUCH_FILE+ | FX_PERMISSION_DENIED+ | FX_FAILURE+ | FX_BAD_MESSAGE+ | FX_NO_CONNECTION+ | FX_CONNECTION_LOST+ | FX_OP_UNSUPPORTED+ | FX_INVALID_HANDLE+ | FX_NO_SUCH_PATH+ | FX_FILE_ALREADY_EXISTS+ | FX_WRITE_PROTECT+ | FX_NO_MEDIA+ | FX_NO_SPACE_ON_FILESYSTEM+ | FX_QUOTA_EXCEEDED+ | FX_UNKNOWN_PRINCIPAL+ | FX_LOCK_CONFLICT+ | FX_DIR_NOT_EMPTY+ | FX_NOT_A_DIRECTORY+ | FX_INVALID_FILENAME+ | FX_LINK_LOOP+ deriving (Eq, Show, Ord, Enum, Data, Typeable)++instance Exception SftpErrorCode+++class SshCtx a where+ getSession :: a -> Session+ throwCtxSpecificError :: a -> ErrorCode -> IO b++instance SshCtx Session where+ getSession = id+ throwCtxSpecificError _ er = throw er++instance SshCtx Sftp where+ getSession = sftpSession++ throwCtxSpecificError ctx SFTP_PROTOCOL = do+ er <- getLastSftpError ctx+ throw (int2sftperror er)+ throwCtxSpecificError _ er = throw er++instance SshCtx SftpHandle where+ getSession = getSession . sftpHandleSession++ throwCtxSpecificError ctx =+ throwCtxSpecificError (sftpHandleSession ctx)
src/Network/SSH/Client/LibSSH2/Foreign.chs view
@@ -9,6 +9,7 @@ #include "libssh2_local.h" #include <libssh2.h>+#include <libssh2_sftp.h> {# context lib="ssh2" prefix="libssh2" #} @@ -38,8 +39,19 @@ channelProcess, channelExecute, channelShell, requestPTY, requestPTYEx, channelExitStatus, channelExitSignal,- scpSendChannel, scpReceiveChannel, pollChannelRead_,+ scpSendChannel, scpReceiveChannel, pollChannelRead, + -- * SFTP functions+ sftpInit, sftpShutdown,+ sftpOpenDir, sftpReadDir, sftpCloseHandle,+ sftpOpenFile,+ sftpRenameFile, sftpRenameFileEx,+ sftpWriteFileFromHandler, sftpReadFileToHandler,+ sftpFstat, sftpDeleteFile,++ RenameFlag (..), SftpFileTransferFlags (..),+ SftpAttributes (..),+ -- * Debug TraceFlag (..), setTraceMode ) where@@ -48,8 +60,11 @@ import Foreign.C.Types import Foreign.C.String import System.IO-import Network.Socket (Socket(MkSocket))+import Network.Socket (Socket(MkSocket), fdSocket) import Data.Time.Clock.POSIX+import System.Posix.IO.Select+import System.Posix.IO.Select.Types+import System.Posix.Types import qualified Data.ByteString as BSS import qualified Data.ByteString.Unsafe as BSS @@ -139,9 +154,9 @@ -- or False to disable it. initialize :: Bool -> IO () #ifdef GCRYPT-initialize flags = void . handleInt Nothing $ gcryptFix >> initialize_ flags+initialize flags = void . handleInt (Nothing :: Maybe Session) $ gcryptFix >> initialize_ flags #else-initialize flags = void . handleInt Nothing $ initialize_ flags+initialize flags = void . handleInt (Nothing :: Maybe Session) $ initialize_ flags #endif -- | Deinitialize libssh2.@@ -154,7 +169,7 @@ -- | Create Session object initSession :: IO Session-initSession = handleNullPtr Nothing sessionFromPointer $ +initSession = handleNullPtr (Nothing :: Maybe Session) sessionFromPointer $ {# call session_init_ex #} nullFunPtr nullFunPtr nullFunPtr nullPtr {# fun session_free as freeSession_@@ -194,7 +209,7 @@ -- | Create KnownHosts object for given session. initKnownHosts :: Session -> IO KnownHosts-initKnownHosts session = handleNullPtr Nothing knownHostsFromPointer $ initKnownHosts_ session+initKnownHosts session = handleNullPtr (Nothing :: Maybe Session) knownHostsFromPointer $ initKnownHosts_ session -- | Free KnownHosts object's memory {# fun knownhost_free as freeKnownHosts@@ -207,7 +222,7 @@ knownHostsReadFile :: KnownHosts -> FilePath -- ^ Path to known_hosts file -> IO Int-knownHostsReadFile kh path = handleInt Nothing $ knownHostsReadFile_ kh path 1+knownHostsReadFile kh path = handleInt (Nothing :: Maybe Session) $ knownHostsReadFile_ kh path 1 -- | Get remote host public key {# fun session_hostkey as getHostKey@@ -496,5 +511,230 @@ size <- {# get stat_t->st_size #} statptr return (channel, size) -{# fun poll_channel_read as pollChannelRead_- { toPointer `Channel' } -> `Int' #}+-- {# fun poll_channel_read as pollChannelRead_+-- { toPointer `Channel' } -> `Int' #}++pollChannelRead :: Channel -> IO Bool+pollChannelRead ch = do+ mbSocket <- sessionGetSocket (channelSession ch)+ case mbSocket of+ Nothing -> error "pollChannelRead without socket present"+ Just socket -> (== 1) <$> select'' [Fd $ fdSocket socket] [] [] (finite 0 100)++--+-- | Sftp support+--++-- SFTP File Transfer Flags. See libssh2 documentation+data SftpFileTransferFlags =+ FXF_READ+ | FXF_WRITE+ | FXF_APPEND+ | FXF_CREAT+ | FXF_TRUNC+ | FXF_EXCL+ deriving (Eq, Show)++ftf2int :: SftpFileTransferFlags -> CULong+ftf2int FXF_READ = 0x00000001+ftf2int FXF_WRITE = 0x00000002+ftf2int FXF_APPEND = 0x00000004+ftf2int FXF_CREAT = 0x00000008+ftf2int FXF_TRUNC = 0x00000010+ftf2int FXF_EXCL = 0x00000020++ftransferflags2int :: [SftpFileTransferFlags] -> CULong+ftransferflags2int list = foldr (.|.) 0 (map ftf2int list)++-- | Flags for open_ex()+data OpenExFlags = OpenFile+ | OpenDir+ deriving (Eq, Show)++oef2int :: (Num a) => OpenExFlags -> a+oef2int OpenFile = 0+oef2int OpenDir = 1++sftpInit :: Session -> IO Sftp+sftpInit s = handleNullPtr (Just s) (sftpFromPointer s) $+ sftpInit_ s++sftpShutdown :: Sftp -> IO ()+sftpShutdown sftp =+ void . handleInt (Just sftp) $ sftpShutdown_ sftp++{# fun sftp_init as sftpInit_+ { toPointer `Session' } -> `Ptr ()' id #}++{# fun sftp_shutdown as sftpShutdown_+ { toPointer `Sftp' } -> `Int' #}++-- | Open regular file handler+sftpOpenFile :: Sftp -> String -> Int -> [SftpFileTransferFlags] -> IO SftpHandle+sftpOpenFile sftp path mode flags =+ handleNullPtr (Just sftp) ( sftpHandleFromPointer sftp ) $+ sftpOpen_ sftp path (toEnum mode) flags (oef2int OpenFile)++-- | Open directory file handler+sftpOpenDir :: Sftp -> String -> IO SftpHandle+sftpOpenDir sftp path =+ handleNullPtr (Just sftp) ( sftpHandleFromPointer sftp ) $+ sftpOpen_ sftp path 0 [] (oef2int OpenDir)++sftpOpen_ :: Sftp -> String -> CLong -> [SftpFileTransferFlags] -> CInt -> IO (Ptr ())+sftpOpen_ sftp path mode fl open_type =+ let flags = ftransferflags2int fl+ in+ withCStringLen path $ \(pathP, pathL) -> do+ {# call sftp_open_ex #} (toPointer sftp) pathP (toEnum pathL) flags mode open_type++-- | Read directory from file handler+sftpReadDir :: SftpHandle -> IO (Maybe (BSS.ByteString, SftpAttributes))+sftpReadDir sftph = do+ let bufflen = 512+ allocaBytes bufflen $ \bufptr -> do+ allocaBytes {# sizeof _LIBSSH2_SFTP_ATTRIBUTES #} $ \sftpattrptr -> do+ rc <- handleInt (Just sftph) $+ {# call sftp_readdir_ex #} (toPointer sftph) bufptr (fromIntegral bufflen) nullPtr 0 sftpattrptr+ case rc == 0 of+ False -> do+ fstat <- parseSftpAttributes sftpattrptr+ filename <- BSS.packCStringLen (bufptr, intResult rc)+ return $ Just (filename, fstat)+ True ->+ return Nothing++-- | Close file handle+sftpCloseHandle :: SftpHandle -> IO ()+sftpCloseHandle sftph =+ void . handleInt (Just $ sftpHandleSession sftph) $+ {# call sftp_close_handle #} (toPointer sftph)++data RenameFlag =+ RENAME_OVERWRITE+ | RENAME_ATOMIC+ | RENAME_NATIVE+ deriving (Eq, Show)++rf2long :: RenameFlag -> CLong+rf2long RENAME_OVERWRITE = 0x00000001+rf2long RENAME_ATOMIC = 0x00000002+rf2long RENAME_NATIVE = 0x00000004++renameFlag2int :: [RenameFlag] -> CLong+renameFlag2int flags = foldr (.|.) 0 (map rf2long flags)++-- | Rename a file on the sftp server+sftpRenameFile :: Sftp -- ^ Opened sftp session+ -> FilePath -- ^ Old file name+ -> FilePath -- ^ New file name+ -> IO ()+sftpRenameFile sftp src dest =+ sftpRenameFileEx sftp src dest [ RENAME_NATIVE, RENAME_ATOMIC, RENAME_OVERWRITE]++-- | Rename a file on the sftp server+sftpRenameFileEx :: Sftp -- ^ Opened sftp session+ -> FilePath -- ^ Old file name+ -> FilePath -- ^ New file name+ -> [RenameFlag] -- ^ Rename flags+ -> IO ()+sftpRenameFileEx sftp src dest flags =+ withCStringLen src $ \(srcP, srcL) ->+ withCStringLen dest $ \(destP, destL) ->+ void . handleInt (Just $ sftpSession sftp) $+ {# call sftp_rename_ex #} (toPointer sftp) srcP (toEnum srcL) destP (toEnum destL) (renameFlag2int flags )++-- | Download file from the sftp server+sftpReadFileToHandler :: SftpHandle -> Handle -> Int -> IO Int+sftpReadFileToHandler sftph fh fileSize =+ let+ go :: Int -> Ptr a -> IO Int+ go received buffer = do+ let toRead :: Int+ toRead = min (fromIntegral fileSize - received) bufferSize+ sz <- receive toRead buffer 0+ _ <- hPutBuf fh buffer sz+ let newreceived :: Int+ newreceived = (received + fromIntegral sz)+ if newreceived < fromIntegral fileSize+ then go newreceived buffer+ else return $ fromIntegral newreceived++ receive :: Int -> Ptr a -> Int -> IO Int+ receive 0 _ read_sz = return read_sz+ receive toread buf alreadyread = do+ received <- handleInt (Just sftph)+ $ {# call sftp_read #} (toPointer sftph)+ (buf `plusPtr` alreadyread)+ (fromIntegral toread)+ receive (toread - fromIntegral received) buf (alreadyread + fromIntegral received)++ bufferSize = 0x100000++ in allocaBytes bufferSize $ go 0++-- | Upload file to the sftp server+sftpWriteFileFromHandler :: SftpHandle -> Handle -> IO Integer+sftpWriteFileFromHandler sftph fh =+ let+ go :: Integer -> Ptr a -> IO Integer+ go done buffer = do+ sz <- hGetBuf fh 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 buf = do+ sent <- handleInt (Just sftph)+ $ {# call sftp_write #} (toPointer sftph)+ (buf `plusPtr` written)+ (fromIntegral size)+ send (written + fromIntegral sent) (size - fromIntegral sent) buf++ bufferSize :: Int+ bufferSize = 0x100000++ in allocaBytes bufferSize $ go 0++data SftpAttributes = SftpAttributes {+ saFlags :: CULong,+ saFileSize :: CULLong,+ saUid :: CULong,+ saGid :: CULong,+ saPermissions :: CULong,+ saAtime :: CULong,+ saMtime :: CULong+ } deriving (Show, Eq)++-- | Get sftp attributes from the sftp handler+sftpFstat :: SftpHandle+ -> IO (SftpAttributes)+sftpFstat sftph = do+ allocaBytes {# sizeof _LIBSSH2_SFTP_ATTRIBUTES #} $ \sftpattrptr -> do+ _ <- handleInt (Just sftph) $+ {# call sftp_fstat_ex #} (toPointer sftph) sftpattrptr 0+ parseSftpAttributes sftpattrptr++parseSftpAttributes sftpattrptr = do+ flags<- {# get _LIBSSH2_SFTP_ATTRIBUTES->flags #} sftpattrptr+ size <- {# get _LIBSSH2_SFTP_ATTRIBUTES->filesize #} sftpattrptr+ uid <- {# get _LIBSSH2_SFTP_ATTRIBUTES->uid #} sftpattrptr+ gid <- {# get _LIBSSH2_SFTP_ATTRIBUTES->gid #} sftpattrptr+ perm <- {# get _LIBSSH2_SFTP_ATTRIBUTES->permissions #} sftpattrptr+ atime<- {# get _LIBSSH2_SFTP_ATTRIBUTES->atime #} sftpattrptr+ mtime<- {# get _LIBSSH2_SFTP_ATTRIBUTES->mtime #} sftpattrptr++ return $ SftpAttributes flags size uid gid perm atime mtime++-- | Delete file from SFTP server+sftpDeleteFile :: Sftp -- ^ Opened sftp session+ -> FilePath -- ^ Path to the file to be deleted+ -> IO ()+sftpDeleteFile sftp path = do+ withCStringLen path $ \(str,len) -> do+ void . handleInt (Just sftp) $+ {# call sftp_unlink_ex #} (toPointer sftp) str (toEnum len)
− src/Network/SSH/Client/LibSSH2/Foreign.hs
@@ -1,693 +0,0 @@--- 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 ())))))
src/Network/SSH/Client/LibSSH2/Types.chs view
@@ -8,6 +8,7 @@ #endif #include <libssh2.h>+#include <libssh2_sftp.h> {# context lib="ssh2" prefix="libssh2" #} @@ -15,6 +16,8 @@ (Session, KnownHosts, Channel,+ Sftp,+ SftpHandle, ToPointer (..), Direction (..), int2dir,@@ -28,7 +31,12 @@ sessionFromPointer, sessionGetSocket, sessionSetSocket,- channelSession+ channelSession,+ sftpFromPointer,+ sftpSession,+ sftpHandlePtr,+ sftpHandleFromPointer,+ sftpHandleSession ) where import Foreign@@ -131,3 +139,37 @@ int2dir 2 = [OUTBOUND] int2dir 3 = [INBOUND, OUTBOUND] int2dir x = error $ "Unknown direction: " ++ show x++--+-- | Sftp support+--++sftpFromPointer :: Session -> Ptr () -> IO Sftp+sftpFromPointer session ptr = return $ Sftp (castPtr ptr) session++{# pointer *SFTP as CSftp #}++data Sftp = Sftp { sftpPtr :: CSftp+ , sftpSession :: Session+ }++instance Show Sftp where+ show sftp = "<libssh2 sftp: " ++ show (sftpPtr sftp) ++ ">"++instance ToPointer Sftp where+ toPointer = castPtr . sftpPtr++sftpHandleFromPointer :: Sftp -> Ptr () -> IO SftpHandle+sftpHandleFromPointer sftp ptr = return $ SftpHandle (castPtr ptr) sftp++{# pointer *SFTP_HANDLE as CSftpHandle #}++data SftpHandle = SftpHandle { sftpHandlePtr :: CSftpHandle+ , sftpHandleSession :: Sftp+ }++instance Show SftpHandle where+ show handle = "<libssh2 sftp handle: " ++ show (sftpHandlePtr handle) ++ ">"++instance ToPointer SftpHandle where+ toPointer = castPtr . sftpHandlePtr