module Network.SSH.Client.LibSSH2.Foreign
(
KnownHosts, KnownHostResult (..), KnownHostType (..), KnownHost (..),
initialize, exit,
initSession, freeSession, disconnectSession,
handshake,
setBlocking,
initKnownHosts, freeKnownHosts, knownHostsReadFile,
getHostKey, checkKnownHost,
publicKeyAuthFile,
usernamePasswordAuth,
openChannelSession, closeChannel, freeChannel,
channelSendEOF, channelWaitEOF, channelIsEOF,
readChannel, writeChannel,
writeChannelFromHandle, readChannelToHandle,
channelProcess, channelExecute, channelShell,
requestPTY, requestPTYEx,
channelExitStatus, channelExitSignal,
scpSendChannel, scpReceiveChannel, pollChannelRead,
sftpInit, sftpShutdown,
sftpOpenDir, sftpReadDir, sftpCloseHandle,
sftpOpenFile,
sftpRenameFile, sftpRenameFileEx,
sftpWriteFileFromHandler, sftpReadFileToHandler,
sftpFstat, sftpDeleteFile,
RenameFlag (..), SftpFileTransferFlags (..),
SftpAttributes (..),
TraceFlag (..), setTraceMode
) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import Control.Monad (void)
import Data.Time.Clock.POSIX
import Foreign hiding (void)
import Foreign.C.Types
import Foreign.C.String
import System.IO
import Network.Socket (Socket(MkSocket), isReadable)
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
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)
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')
initialize :: Bool -> IO ()
initialize flags = void . handleInt (Nothing :: Maybe Session) $ initialize_ flags
exit :: IO ()
exit =
exit'_ >>
return ()
initSession :: IO Session
initSession = handleNullPtr (Nothing :: Maybe Session) 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')
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
C2HSImp.withCString a3 $ \a3' ->
C2HSImp.withCString a4 $ \a4' ->
disconnectSessionEx'_ a1' a2' a3' a4' >>= \res ->
let {res' = fromIntegral res} in
return (res')
disconnectSession :: Session
-> String
-> 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' >>
return ()
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')
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')
initKnownHosts :: Session -> IO KnownHosts
initKnownHosts session = handleNullPtr (Nothing :: Maybe Session) knownHostsFromPointer $ initKnownHosts_ session
freeKnownHosts :: (KnownHosts) -> IO ()
freeKnownHosts a1 =
let {a1' = toPointer a1} in
freeKnownHosts'_ a1' >>
return ()
knownHostsReadFile_ :: (KnownHosts) -> (String) -> (CInt) -> IO ((Int))
knownHostsReadFile_ a1 a2 a3 =
let {a1' = toPointer a1} in
C2HSImp.withCString a2 $ \a2' ->
let {a3' = id a3} in
knownHostsReadFile_'_ a1' a2' a3' >>= \res ->
let {res' = fromIntegral res} in
return (res')
knownHostsReadFile :: KnownHosts
-> FilePath
-> IO Int
knownHostsReadFile kh path = handleInt (Nothing :: Maybe Session) $ knownHostsReadFile_ kh path 1
getHostKey :: (Session) -> IO ((String), (Size), (CInt))
getHostKey a1 =
let {a1' = toPointer a1} in
alloca $ \a2' ->
alloca $ \a3' ->
getHostKey'_ a1' a2' a3' >>= \res ->
C2HSImp.peekCString res >>= \res' ->
peek a2'>>= \a2'' ->
peek a3'>>= \a3'' ->
return (res', a2'', a3'')
checkKnownHost_ :: (KnownHosts) -> (String) -> (Int) -> (String) -> (Int) -> ([KnownHostType]) -> (Ptr ()) -> IO ((KnownHostResult))
checkKnownHost_ a1 a2 a3 a4 a5 a6 a7 =
let {a1' = toPointer a1} in
C2HSImp.withCString a2 $ \a2' ->
let {a3' = fromIntegral a3} in
C2HSImp.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')
checkKnownHost :: KnownHosts
-> String
-> Int
-> String
-> [KnownHostType]
-> IO KnownHostResult
checkKnownHost kh host port key flags = checkKnownHost_ kh host port key (length key) flags nullPtr
publicKeyAuthFile_ :: (Session) -> (String) -> (String) -> (String) -> (String) -> IO ((Int))
publicKeyAuthFile_ a1 a2 a3 a4 a5 =
let {a1' = toPointer a1} in
(\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a2 $ \(a2'1, a2'2) ->
C2HSImp.withCString a3 $ \a3' ->
C2HSImp.withCString a4 $ \a4' ->
C2HSImp.withCString a5 $ \a5' ->
publicKeyAuthFile_'_ a1' a2'1 a2'2 a3' a4' a5' >>= \res ->
let {res' = fromIntegral res} in
return (res')
publicKeyAuthFile :: Session
-> String
-> String
-> String
-> String
-> IO ()
publicKeyAuthFile session username public private passphrase = void . handleInt (Just session) $
publicKeyAuthFile_ session username public private passphrase
usernamePasswordAuth :: Session
-> String
-> String
-> 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
(\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a2 $ \(a2'1, a2'2) ->
let {a3' = fromIntegral a3} in
let {a4' = fromIntegral a4} in
(\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) 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')
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
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
(\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a2 $ \(a2'1, a2'2) ->
(\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a3 $ \(a3'1, a3'2) ->
channelProcessStartup_'_ a1' a2'1 a2'2 a3'1 a3'2 >>= \res ->
let {res' = fromIntegral res} in
return (res')
channelShell :: Channel -> IO ()
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)
requestPTYEx :: (Channel) -> (String) -> (String) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ((Int))
requestPTYEx a1 a2 a3 a4 a5 a6 a7 =
let {a1' = toPointer a1} in
(\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a2 $ \(a2'1, a2'2) ->
(\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) 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')
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 = do
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)
readChannel :: Channel
-> Size
-> IO BSS.ByteString
readChannel c sz = readChannelEx c 0 sz
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')
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')
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' >>
return ()
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
(toPointer ch)
0
(plusPtr buffer written)
(fromIntegral size)
send (written + fromIntegral sent) (size fromIntegral sent) buffer
bufferSize = 0x100000
in allocaBytes bufferSize $ go 0
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
(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')
closeChannel_ :: (Channel) -> IO ((Int))
closeChannel_ a1 =
let {a1' = toPointer a1} in
closeChannel_'_ a1' >>= \res ->
let {res' = fromIntegral res} in
return (res')
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')
freeChannel :: Channel -> IO ()
freeChannel channel = void . handleInt (Just $ channelSession channel) $ freeChannel_ channel
channelExitStatus :: (Channel) -> IO ((Int))
channelExitStatus a1 =
let {a1' = toPointer a1} in
channelExitStatus'_ a1' >>= \res ->
let {res' = fromIntegral res} in
return (res')
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 ->
let {res' = fromIntegral res} in
peekCStringPtr a2'>>= \a2'' ->
peekMaybeCStringPtr a4'>>= \a4'' ->
peekMaybeCStringPtr a6'>>= \a6'' ->
return (res', a2'', a4'', a6'')
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
C2HSImp.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')
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 = (C2HSImp.CLong)
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 {C2HSImp.peekByteOff ptr 48 :: IO C2HSImp.CLong}) statptr
return (channel, size)
pollChannelRead :: Channel -> IO Bool
pollChannelRead ch = do
mbSocket <- sessionGetSocket (channelSession ch)
case mbSocket of
Nothing -> error "pollChannelRead without socket present"
Just socket -> isReadable socket
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)
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
sftpInit_ :: (Session) -> IO ((Ptr ()))
sftpInit_ a1 =
let {a1' = toPointer a1} in
sftpInit_'_ a1' >>= \res ->
let {res' = id res} in
return (res')
sftpShutdown_ :: (Sftp) -> IO ((Int))
sftpShutdown_ a1 =
let {a1' = toPointer a1} in
sftpShutdown_'_ a1' >>= \res ->
let {res' = fromIntegral res} in
return (res')
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)
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
libssh2_sftp_open_ex (toPointer sftp) pathP (toEnum pathL) flags mode open_type
sftpReadDir :: SftpHandle -> IO (Maybe (BSS.ByteString, SftpAttributes))
sftpReadDir sftph = do
let bufflen = 512
allocaBytes bufflen $ \bufptr -> do
allocaBytes 56 $ \sftpattrptr -> do
rc <- handleInt (Just sftph) $
libssh2_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
sftpCloseHandle :: SftpHandle -> IO ()
sftpCloseHandle sftph =
void . handleInt (Just $ sftpHandleSession sftph) $
libssh2_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)
sftpRenameFile :: Sftp
-> FilePath
-> FilePath
-> IO ()
sftpRenameFile sftp src dest =
sftpRenameFileEx sftp src dest [ RENAME_NATIVE, RENAME_ATOMIC, RENAME_OVERWRITE]
sftpRenameFileEx :: Sftp
-> FilePath
-> FilePath
-> [RenameFlag]
-> IO ()
sftpRenameFileEx sftp src dest flags =
withCStringLen src $ \(srcP, srcL) ->
withCStringLen dest $ \(destP, destL) ->
void . handleInt (Just $ sftpSession sftp) $
libssh2_sftp_rename_ex (toPointer sftp) srcP (toEnum srcL) destP (toEnum destL) (renameFlag2int flags )
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)
$ libssh2_sftp_read (toPointer sftph)
(buf `plusPtr` alreadyread)
(fromIntegral toread)
receive (toread fromIntegral received) buf (alreadyread + fromIntegral received)
bufferSize = 0x100000
in allocaBytes bufferSize $ go 0
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)
$ libssh2_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)
sftpFstat :: SftpHandle
-> IO (SftpAttributes)
sftpFstat sftph = do
allocaBytes 56 $ \sftpattrptr -> do
_ <- handleInt (Just sftph) $
libssh2_sftp_fstat_ex (toPointer sftph) sftpattrptr 0
parseSftpAttributes sftpattrptr
parseSftpAttributes :: Ptr a -> IO SftpAttributes
parseSftpAttributes sftpattrptr = do
flags<- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CULong}) sftpattrptr
size <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CULLong}) sftpattrptr
uid <- (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CULong}) sftpattrptr
gid <- (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CULong}) sftpattrptr
perm <- (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO C2HSImp.CULong}) sftpattrptr
atime<- (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO C2HSImp.CULong}) sftpattrptr
mtime<- (\ptr -> do {C2HSImp.peekByteOff ptr 48 :: IO C2HSImp.CULong}) sftpattrptr
return $ SftpAttributes flags size uid gid perm atime mtime
sftpDeleteFile :: Sftp
-> FilePath
-> IO ()
sftpDeleteFile sftp path = do
withCStringLen path $ \(str,len) -> do
void . handleInt (Just sftp) $
libssh2_sftp_unlink_ex (toPointer sftp) str (toEnum len)
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_init"
initialize_'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_exit"
exit'_ :: (IO ())
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_init_ex"
libssh2_session_init_ex :: ((C2HSImp.FunPtr (C2HSImp.CULong -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO (C2HSImp.Ptr ()))))) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO ())))) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO (C2HSImp.Ptr ())))))) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_free"
freeSession_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_disconnect_ex"
disconnectSessionEx'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_set_blocking"
setBlocking'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_handshake"
handshake_'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_init"
initKnownHosts_'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_free"
freeKnownHosts'_ :: ((C2HSImp.Ptr ()) -> (IO ()))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_readfile"
knownHostsReadFile_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_hostkey"
getHostKey'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_checkp"
checkKnownHost_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_userauth_publickey_fromfile_ex"
publicKeyAuthFile_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_userauth_password_ex"
libssh2_userauth_password_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO ())))))) -> (IO C2HSImp.CInt)))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_open_ex"
openSessionChannelEx'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO (C2HSImp.Ptr ())))))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_process_startup"
channelProcessStartup_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_request_pty_ex"
requestPTYEx'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_read_ex"
libssh2_channel_read_ex :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CLong)))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_write_ex"
libssh2_channel_write_ex :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CLong)))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_send_eof"
channelSendEOF_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_wait_eof"
channelWaitEOF_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_trace"
setTraceMode'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_eof"
libssh2_channel_eof :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_eof"
channelIsEOF'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_close"
closeChannel_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_free"
freeChannel_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_get_exit_status"
channelExitStatus'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_get_exit_signal"
channelExitSignal_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt))))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_scp_send64"
scpSendChannel_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CLLong -> (C2HSImp.CLong -> (C2HSImp.CLong -> (IO (C2HSImp.Ptr ()))))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_scp_recv"
libssh2_scp_recv :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_init"
sftpInit_'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_shutdown"
sftpShutdown_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_open_ex"
libssh2_sftp_open_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CULong -> (C2HSImp.CLong -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_readdir_ex"
libssh2_sftp_readdir_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_close_handle"
libssh2_sftp_close_handle :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_rename_ex"
libssh2_sftp_rename_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CLong -> (IO C2HSImp.CInt)))))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_read"
libssh2_sftp_read :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CLong))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_write"
libssh2_sftp_write :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CLong))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_fstat_ex"
libssh2_sftp_fstat_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_unlink_ex"
libssh2_sftp_unlink_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))