-- GENERATED by C->Haskell Compiler, version 0.16.4 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}



{-# LINE 6 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

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.
initialize :: Bool -> IO (Int)
initialize a1 =
  let {a1' = init_crypto a1} in 
  initialize'_ a1' >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 128 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Deinitialize libssh2.
exit :: IO ()
exit =
  exit'_ >>= \res ->
  return ()
{-# LINE 131 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Create Session object
initSession :: IO Session
initSession = do
  ptr <- libssh2_session_init_ex nullFunPtr nullFunPtr nullFunPtr nullPtr
  handleNullPtr ptr

-- | Free Session object's memory
freeSession :: Session -> IO (Int)
freeSession a1 =
  let {a1' = toPointer a1} in 
  freeSession'_ a1' >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 141 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

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 ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 144 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Disconnect session (but do not free memory)
disconnectSession :: Session
                  -> String  -- ^ Goodbye message
                  -> IO Int
disconnectSession s msg = 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 153 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

bool2int :: Bool -> CInt
bool2int True  = 1
bool2int False = 0

-- | Run SSH handshake on network socket.
handshake :: Session -> Socket -> IO (Int)
handshake a1 a2 =
  let {a1' = toPointer a1} in 
  let {a2' = ssh2socket a2} in 
  handshake'_ a1' a2' >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 161 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Create KnownHosts object for given session.
initKnownHosts :: Session -> IO (KnownHosts)
initKnownHosts a1 =
  let {a1' = toPointer a1} in 
  initKnownHosts'_ a1' >>= \res ->
  handleNullPtr res >>= \res' ->
  return (res')
{-# LINE 165 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Free KnownHosts object's memory
freeKnownHosts :: KnownHosts -> IO ()
freeKnownHosts a1 =
  let {a1' = toPointer a1} in 
  freeKnownHosts'_ a1' >>= \res ->
  return ()
{-# LINE 169 "./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 ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 172 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | 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
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 182 "./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 191 "./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 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.
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 ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 210 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

openSessionChannelEx :: Session -> String -> Int -> Int -> String -> IO (Channel)
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 ->
  handleNullPtr res >>= \res' ->
  return (res')
{-# LINE 216 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | 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) ->
      libssh2_channel_process_startup
{-# LINE 226 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}
          (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) ->
    libssh2_channel_process_startup
{-# LINE 239 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}
      (toPointer c)
      kindptr
      kindlen
      nullPtr 0 >>= handleInt

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 ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 250 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

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 <- libssh2_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

writeChannelEx :: Channel -> Int -> String -> IO (Int)
writeChannelEx a1 a2 a3 =
  let {a1' = toPointer a1} in 
  let {a2' = fromIntegral a2} in 
  withCStringLenIntConv a3 $ \(a3'1, a3'2) -> 
  writeChannelEx'_ a1' a2' a3'1  a3'2 >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 275 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Write data to channel.
-- Returns amount of written data.
writeChannel :: Channel -> String -> IO Int
writeChannel ch str = writeChannelEx ch 0 str

channelSendEOF :: Channel -> IO (Int)
channelSendEOF a1 =
  let {a1' = toPointer a1} in 
  channelSendEOF'_ a1' >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 283 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

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 (Int)
setTraceMode a1 a2 =
  let {a1' = toPointer a1} in 
  let {a2' = trace2int a2} in 
  setTraceMode'_ a1' a2' >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 312 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | 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 <- libssh2_channel_write_ex
{-# LINE 333 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}
                  (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
    libssh2_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 <- libssh2_channel_read_ex
{-# LINE 366 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}
                  (toPointer ch)
                  0
                  buffer
                  (fromIntegral toRead)
        when (sz < 0) $
            throw (int2error sz)
        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

channelIsEOF :: Channel -> IO (Bool)
channelIsEOF a1 =
  let {a1' = toPointer a1} in 
  channelIsEOF'_ a1' >>= \res ->
  handleBool res >>= \res' ->
  return (res')
{-# LINE 387 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Close channel (but do not free memory)
closeChannel :: Channel -> IO (Int)
closeChannel a1 =
  let {a1' = toPointer a1} in 
  closeChannel'_ a1' >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 391 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Free channel object's memory
freeChannel :: Channel -> IO (Int)
freeChannel a1 =
  let {a1' = toPointer a1} in 
  freeChannel'_ a1' >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 395 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Get currently blocked directions
blockedDirections :: Session -> IO ([Direction])
blockedDirections a1 =
  let {a1' = toPointer a1} in 
  blockedDirections'_ a1' >>= \res ->
  let {res' = int2dir res} in
  return (res')
{-# LINE 399 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | Get channel exit status
channelExitStatus :: Channel -> IO (Int)
channelExitStatus a1 =
  let {a1' = toPointer a1} in 
  channelExitStatus'_ a1' >>= \res ->
  handleInt res >>= \res' ->
  return (res')
{-# LINE 403 "./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'' -> 
  handleInt res >>= \res' ->
  return (res', a2'', a4'', a6'')
{-# LINE 412 "./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 = channelExitSignal_ ch nullPtr nullPtr nullPtr

-- | Create SCP file send channel.
scpSendChannel :: Session -> String -> Int -> Int64 -> POSIXTime -> POSIXTime -> IO (Channel)
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 ->
  handleNullPtr res >>= \res' ->
  return (res')
{-# LINE 426 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

type Offset = (CLong)
{-# LINE 428 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

newtype Stat = Stat (Ptr (Stat))
{-# LINE 430 "./Network/SSH/Client/LibSSH2/Foreign.chs" #-}

-- | 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 88 $ \statptr -> do
                    p <- libssh2_scp_recv (toPointer s) pathptr statptr
                    size <- (\ptr -> do {peekByteOff ptr 44 ::IO CLong}) statptr
                    return (p, size)
  channel <- handleNullPtr ptr
  return (channel, sz)



foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_init"
  initialize'_ :: (CInt -> (IO 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 :: ((FunPtr (CUInt -> ((Ptr (Ptr ())) -> (IO (Ptr ()))))) -> ((FunPtr ((Ptr ()) -> ((Ptr (Ptr ())) -> (IO ())))) -> ((FunPtr ((Ptr ()) -> (CUInt -> ((Ptr (Ptr ())) -> (IO (Ptr ())))))) -> ((Ptr ()) -> (IO (Ptr ()))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_free"
  freeSession'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_disconnect_ex"
  disconnectSessionEx'_ :: ((Ptr ()) -> (CInt -> ((Ptr CChar) -> ((Ptr CChar) -> (IO CInt)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_set_blocking"
  setBlocking'_ :: ((Ptr ()) -> (CInt -> (IO ())))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_handshake"
  handshake'_ :: ((Ptr ()) -> (CInt -> (IO CInt)))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_init"
  initKnownHosts'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_free"
  freeKnownHosts'_ :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_readfile"
  knownHostsReadFile_'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (IO CInt))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_hostkey"
  getHostKey'_ :: ((Ptr ()) -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO (Ptr CChar)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_checkp"
  checkKnownHost_'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> ((Ptr CChar) -> (CUInt -> (CInt -> ((Ptr (Ptr ())) -> (IO CInt))))))))

foreign import ccall safe "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 "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 "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_process_startup"
  libssh2_channel_process_startup :: ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> ((Ptr CChar) -> (CUInt -> (IO CInt))))))

foreign import ccall safe "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 "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_read_ex"
  libssh2_channel_read_ex :: ((Ptr ()) -> (CInt -> ((Ptr CChar) -> (CUInt -> (IO CInt)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_write_ex"
  writeChannelEx'_ :: ((Ptr ()) -> (CInt -> ((Ptr CChar) -> (CUInt -> (IO CInt)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_send_eof"
  channelSendEOF'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_trace"
  setTraceMode'_ :: ((Ptr ()) -> (CInt -> (IO CInt)))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_write_ex"
  libssh2_channel_write_ex :: ((Ptr ()) -> (CInt -> ((Ptr CChar) -> (CUInt -> (IO CInt)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_trace"
  libssh2_trace :: ((Ptr ()) -> (CInt -> (IO CInt)))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_eof"
  libssh2_channel_eof :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_eof"
  channelIsEOF'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_close"
  closeChannel'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_free"
  freeChannel'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_block_directions"
  blockedDirections'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_get_exit_status"
  channelExitStatus'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_get_exit_signal"
  channelExitSignal_'_ :: ((Ptr ()) -> ((Ptr (Ptr CChar)) -> ((Ptr CUInt) -> ((Ptr (Ptr CChar)) -> ((Ptr CUInt) -> ((Ptr (Ptr CChar)) -> ((Ptr CUInt) -> (IO CInt))))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_scp_send64"
  scpSendChannel'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (CLLong -> (CLong -> (CLong -> (IO (Ptr ()))))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_scp_recv"
  libssh2_scp_recv :: ((Ptr ()) -> ((Ptr CChar) -> ((Ptr ()) -> (IO (Ptr ())))))