-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


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







{-# LINE 13 "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,
   directTcpIpEx,
   channelExitStatus, channelExitSignal,
   scpSendChannel, scpReceiveChannel, pollChannelRead,

   -- * SFTP functions
   sftpInit, sftpShutdown,
   sftpOpenDir, sftpReadDir, sftpCloseHandle,
   sftpOpenFile,
   sftpRenameFile, sftpRenameFileEx,
   sftpWriteFileFromHandler, sftpReadFileToHandler,
   sftpFstat, sftpDeleteFile,

   RenameFlag (..), SftpFileTransferFlags (..),
   SftpAttributes (..),

   -- * SSH Agent functions
   Agent (..), AgentPublicKey,
   agentInit,
   agentConnect, agentDisconnect,
   agentListIdentities,
   agentGetIdentity,
   agentGetIdentities,
   agentFree,
   agentPublicKeyComment,
   agentPublicKeyBlob,
   agentUserAuth,
   agentAuthenticate,

   -- * Debug
   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.Exception (throw, tryJust)
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, withFdSocket)
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 (KnownHostType -> KnownHostType -> Bool
(KnownHostType -> KnownHostType -> Bool)
-> (KnownHostType -> KnownHostType -> Bool) -> Eq KnownHostType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KnownHostType -> KnownHostType -> Bool
$c/= :: KnownHostType -> KnownHostType -> Bool
== :: KnownHostType -> KnownHostType -> Bool
$c== :: KnownHostType -> KnownHostType -> Bool
Eq, Int -> KnownHostType -> ShowS
[KnownHostType] -> ShowS
KnownHostType -> String
(Int -> KnownHostType -> ShowS)
-> (KnownHostType -> String)
-> ([KnownHostType] -> ShowS)
-> Show KnownHostType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KnownHostType] -> ShowS
$cshowList :: [KnownHostType] -> ShowS
show :: KnownHostType -> String
$cshow :: KnownHostType -> String
showsPrec :: Int -> KnownHostType -> ShowS
$cshowsPrec :: Int -> KnownHostType -> ShowS
Show)

kht2int :: KnownHostType -> CInt
kht2int :: KnownHostType -> CInt
kht2int KnownHostType
TYPE_MASK   = CInt
0xffff
kht2int KnownHostType
TYPE_PLAIN  = CInt
1
kht2int KnownHostType
TYPE_SHA1   = CInt
2
kht2int KnownHostType
TYPE_CUSTOM = CInt
3
kht2int KnownHostType
KEYENC_MASK = CInt
3 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
kht2int KnownHostType
KEYENC_RAW  = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
kht2int KnownHostType
KEYENC_BASE64 = CInt
2 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
kht2int KnownHostType
KEY_MASK    = CInt
3 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_SHIFT   = CInt
18
kht2int KnownHostType
KEY_RSA1    = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_SSHRSA  = CInt
2 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_SSHDSS  = CInt
3 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
18

typemask2int :: [KnownHostType] -> CInt
typemask2int :: [KnownHostType] -> CInt
typemask2int [KnownHostType]
list = (CInt -> CInt -> CInt) -> CInt -> [CInt] -> CInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) CInt
0 ((KnownHostType -> CInt) -> [KnownHostType] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map KnownHostType -> CInt
kht2int [KnownHostType]
list)

-- Result of matching host against known_hosts.
data KnownHostResult =
    MATCH
  | MISMATCH
  | NOTFOUND
  | FAILURE
  deriving (KnownHostResult -> KnownHostResult -> Bool
(KnownHostResult -> KnownHostResult -> Bool)
-> (KnownHostResult -> KnownHostResult -> Bool)
-> Eq KnownHostResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KnownHostResult -> KnownHostResult -> Bool
$c/= :: KnownHostResult -> KnownHostResult -> Bool
== :: KnownHostResult -> KnownHostResult -> Bool
$c== :: KnownHostResult -> KnownHostResult -> Bool
Eq, Int -> KnownHostResult -> ShowS
[KnownHostResult] -> ShowS
KnownHostResult -> String
(Int -> KnownHostResult -> ShowS)
-> (KnownHostResult -> String)
-> ([KnownHostResult] -> ShowS)
-> Show KnownHostResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KnownHostResult] -> ShowS
$cshowList :: [KnownHostResult] -> ShowS
show :: KnownHostResult -> String
$cshow :: KnownHostResult -> String
showsPrec :: Int -> KnownHostResult -> ShowS
$cshowsPrec :: Int -> KnownHostResult -> ShowS
Show, Eq KnownHostResult
Eq KnownHostResult
-> (KnownHostResult -> KnownHostResult -> Ordering)
-> (KnownHostResult -> KnownHostResult -> Bool)
-> (KnownHostResult -> KnownHostResult -> Bool)
-> (KnownHostResult -> KnownHostResult -> Bool)
-> (KnownHostResult -> KnownHostResult -> Bool)
-> (KnownHostResult -> KnownHostResult -> KnownHostResult)
-> (KnownHostResult -> KnownHostResult -> KnownHostResult)
-> Ord KnownHostResult
KnownHostResult -> KnownHostResult -> Bool
KnownHostResult -> KnownHostResult -> Ordering
KnownHostResult -> KnownHostResult -> KnownHostResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KnownHostResult -> KnownHostResult -> KnownHostResult
$cmin :: KnownHostResult -> KnownHostResult -> KnownHostResult
max :: KnownHostResult -> KnownHostResult -> KnownHostResult
$cmax :: KnownHostResult -> KnownHostResult -> KnownHostResult
>= :: KnownHostResult -> KnownHostResult -> Bool
$c>= :: KnownHostResult -> KnownHostResult -> Bool
> :: KnownHostResult -> KnownHostResult -> Bool
$c> :: KnownHostResult -> KnownHostResult -> Bool
<= :: KnownHostResult -> KnownHostResult -> Bool
$c<= :: KnownHostResult -> KnownHostResult -> Bool
< :: KnownHostResult -> KnownHostResult -> Bool
$c< :: KnownHostResult -> KnownHostResult -> Bool
compare :: KnownHostResult -> KnownHostResult -> Ordering
$ccompare :: KnownHostResult -> KnownHostResult -> Ordering
$cp1Ord :: Eq KnownHostResult
Ord, Int -> KnownHostResult
KnownHostResult -> Int
KnownHostResult -> [KnownHostResult]
KnownHostResult -> KnownHostResult
KnownHostResult -> KnownHostResult -> [KnownHostResult]
KnownHostResult
-> KnownHostResult -> KnownHostResult -> [KnownHostResult]
(KnownHostResult -> KnownHostResult)
-> (KnownHostResult -> KnownHostResult)
-> (Int -> KnownHostResult)
-> (KnownHostResult -> Int)
-> (KnownHostResult -> [KnownHostResult])
-> (KnownHostResult -> KnownHostResult -> [KnownHostResult])
-> (KnownHostResult -> KnownHostResult -> [KnownHostResult])
-> (KnownHostResult
    -> KnownHostResult -> KnownHostResult -> [KnownHostResult])
-> Enum KnownHostResult
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KnownHostResult
-> KnownHostResult -> KnownHostResult -> [KnownHostResult]
$cenumFromThenTo :: KnownHostResult
-> KnownHostResult -> KnownHostResult -> [KnownHostResult]
enumFromTo :: KnownHostResult -> KnownHostResult -> [KnownHostResult]
$cenumFromTo :: KnownHostResult -> KnownHostResult -> [KnownHostResult]
enumFromThen :: KnownHostResult -> KnownHostResult -> [KnownHostResult]
$cenumFromThen :: KnownHostResult -> KnownHostResult -> [KnownHostResult]
enumFrom :: KnownHostResult -> [KnownHostResult]
$cenumFrom :: KnownHostResult -> [KnownHostResult]
fromEnum :: KnownHostResult -> Int
$cfromEnum :: KnownHostResult -> Int
toEnum :: Int -> KnownHostResult
$ctoEnum :: Int -> KnownHostResult
pred :: KnownHostResult -> KnownHostResult
$cpred :: KnownHostResult -> KnownHostResult
succ :: KnownHostResult -> KnownHostResult
$csucc :: KnownHostResult -> KnownHostResult
Enum)

int2khresult :: CInt -> KnownHostResult
int2khresult :: CInt -> KnownHostResult
int2khresult = Int -> KnownHostResult
forall a. Enum a => Int -> a
toEnum (Int -> KnownHostResult)
-> (CInt -> Int) -> CInt -> KnownHostResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

data KnownHost = KnownHost {
  KnownHost -> CUInt
khMagic :: CUInt,
  KnownHost -> Ptr ()
khNode :: Ptr (),
  KnownHost -> String
khName :: String,
  KnownHost -> String
khKey :: String,
  KnownHost -> [KnownHostType]
khTypeMask :: [KnownHostType] }
  deriving (KnownHost -> KnownHost -> Bool
(KnownHost -> KnownHost -> Bool)
-> (KnownHost -> KnownHost -> Bool) -> Eq KnownHost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KnownHost -> KnownHost -> Bool
$c/= :: KnownHost -> KnownHost -> Bool
== :: KnownHost -> KnownHost -> Bool
$c== :: KnownHost -> KnownHost -> Bool
Eq, Int -> KnownHost -> ShowS
[KnownHost] -> ShowS
KnownHost -> String
(Int -> KnownHost -> ShowS)
-> (KnownHost -> String)
-> ([KnownHost] -> ShowS)
-> Show KnownHost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KnownHost] -> ShowS
$cshowList :: [KnownHost] -> ShowS
show :: KnownHost -> String
$cshow :: KnownHost -> String
showsPrec :: Int -> KnownHost -> ShowS
$cshowsPrec :: Int -> KnownHost -> ShowS
Show)

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

ssh2socket :: Socket
           -> IO CInt
ssh2socket :: Socket -> IO CInt
ssh2socket Socket
s =
  Socket -> (CInt -> IO CInt) -> IO CInt
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s CInt -> IO CInt
forall (f :: * -> *) a. Applicative f => a -> f a
pure

initialize_ :: (Bool) -> IO ((Int))
initialize_ :: Bool -> IO Int
initialize_ Bool
a1 =
  let {a1' :: CInt
a1' = Bool -> CInt
init_crypto Bool
a1} in 
  CInt -> IO CInt
initialize_'_ CInt
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | Initialize libssh2. Pass True to enable encryption
-- or False to disable it.
initialize :: Bool -> IO ()
initialize :: Bool -> IO ()
initialize Bool
flags = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> (IO Int -> IO Int) -> IO Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Session -> IO Int -> IO Int
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Maybe Session
forall a. Maybe a
Nothing :: Maybe Session) (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO Int
initialize_ Bool
flags

-- | Deinitialize libssh2.
exit :: IO ()
exit :: IO ()
exit =
  IO ()
exit'_ IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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


-- | Create Session object
initSession :: IO Session
initSession :: IO Session
initSession = Maybe Session
-> (Ptr () -> IO Session) -> IO (Ptr ()) -> IO Session
forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (Maybe Session
forall a. Maybe a
Nothing :: Maybe Session) Ptr () -> IO Session
sessionFromPointer (IO (Ptr ()) -> IO Session) -> IO (Ptr ()) -> IO Session
forall a b. (a -> b) -> a -> b
$
  FunPtr (CULong -> Ptr (Ptr ()) -> IO (Ptr ()))
-> FunPtr (Ptr () -> Ptr (Ptr ()) -> IO ())
-> FunPtr (Ptr () -> CULong -> Ptr (Ptr ()) -> IO (Ptr ()))
-> Ptr ()
-> IO (Ptr ())
libssh2_session_init_ex FunPtr (CULong -> Ptr (Ptr ()) -> IO (Ptr ()))
forall a. FunPtr a
nullFunPtr FunPtr (Ptr () -> Ptr (Ptr ()) -> IO ())
forall a. FunPtr a
nullFunPtr FunPtr (Ptr () -> CULong -> Ptr (Ptr ()) -> IO (Ptr ()))
forall a. FunPtr a
nullFunPtr Ptr ()
forall a. Ptr a
nullPtr

freeSession_ :: (Session) -> IO ((Int))
freeSession_ :: Session -> IO Int
freeSession_ Session
a1 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  Ptr () -> IO CInt
freeSession_'_ Ptr ()
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  return (res')

{-# LINE 214 "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 :: Session -> Int -> String -> String -> IO Int
disconnectSessionEx Session
a1 Int
a2 String
a3 String
a4 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in 
  String -> (CString -> IO Int) -> IO Int
forall a. String -> (CString -> IO a) -> IO a
C2HSImp.withCString String
a3 ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \CString
a3' -> 
  String -> (CString -> IO Int) -> IO Int
forall a. String -> (CString -> IO a) -> IO a
C2HSImp.withCString String
a4 ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \CString
a4' -> 
  Ptr () -> CInt -> CString -> CString -> IO CInt
disconnectSessionEx'_ Ptr ()
a1' CInt
a2' CString
a3' CString
a4' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = fromIntegral res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 221 "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' >>
  return ()

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


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

session_handshake :: (Ptr ()) -> (CInt) -> IO ((Int))
session_handshake :: Ptr () -> CInt -> IO Int
session_handshake Ptr ()
a1 CInt
a2 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
a2} in 
  Ptr () -> CInt -> IO CInt
session_handshake'_ Ptr ()
a1' CInt
a2' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


handshake_ :: Session -> Socket -> IO Int
handshake_ session socket = do
  session_handshake (toPointer session) =<< ssh2socket socket

-- | Run SSH handshake on network socket.
handshake :: Session -> Socket -> IO ()
handshake :: Session -> Socket -> IO ()
handshake Session
session Socket
socket = do
  Session -> Maybe Socket -> IO ()
sessionSetSocket Session
session (Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
socket)
  IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Session -> IO Int -> IO Int
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Session -> Maybe Session
forall a. a -> Maybe a
Just Session
session)
       (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Session -> Socket -> IO Int
handshake_ Session
session Socket
socket

initKnownHosts_ :: (Session) -> IO ((Ptr ()))
initKnownHosts_ :: Session -> IO (Ptr ())
initKnownHosts_ Session
a1 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  Ptr () -> IO (Ptr ())
initKnownHosts_'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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


-- | Create KnownHosts object for given session.
initKnownHosts :: Session -> IO KnownHosts
initKnownHosts :: Session -> IO KnownHosts
initKnownHosts Session
session = Maybe Session
-> (Ptr () -> IO KnownHosts) -> IO (Ptr ()) -> IO KnownHosts
forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (Maybe Session
forall a. Maybe a
Nothing :: Maybe Session) Ptr () -> IO KnownHosts
knownHostsFromPointer (IO (Ptr ()) -> IO KnownHosts) -> IO (Ptr ()) -> IO KnownHosts
forall a b. (a -> b) -> a -> b
$ Session -> IO (Ptr ())
initKnownHosts_ Session
session

-- | Free KnownHosts object's memory
freeKnownHosts :: (KnownHosts) -> IO ()
freeKnownHosts :: KnownHosts -> IO ()
freeKnownHosts KnownHosts
a1 =
  let {a1' :: Ptr ()
a1' = KnownHosts -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer KnownHosts
a1} in 
  Ptr () -> IO ()
freeKnownHosts'_ Ptr ()
a1' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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


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')

{-# LINE 267 "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 :: Maybe Session) $ knownHostsReadFile_ kh path 1

-- | Get remote host public key
getHostKey :: (Session) -> IO ((String), (Size), (CInt))
getHostKey :: Session -> IO (String, CULong, CInt)
getHostKey Session
a1 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  (Ptr CULong -> IO (String, CULong, CInt))
-> IO (String, CULong, CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO (String, CULong, CInt))
 -> IO (String, CULong, CInt))
-> (Ptr CULong -> IO (String, CULong, CInt))
-> IO (String, CULong, CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
a2' -> 
  (Ptr CInt -> IO (String, CULong, CInt))
-> IO (String, CULong, CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (String, CULong, CInt))
 -> IO (String, CULong, CInt))
-> (Ptr CInt -> IO (String, CULong, CInt))
-> IO (String, CULong, CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a3' -> 
  Ptr () -> Ptr CULong -> Ptr CInt -> IO CString
getHostKey'_ Ptr ()
a1' Ptr CULong
a2' Ptr CInt
a3' IO CString
-> (CString -> IO (String, CULong, CInt))
-> IO (String, CULong, CInt)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
res ->
  CString -> IO String
C2HSImp.peekCString CString
res IO String
-> (String -> IO (String, CULong, CInt))
-> IO (String, CULong, CInt)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
res' ->
  Ptr CULong -> IO CULong
forall a. Storable a => Ptr a -> IO a
peek  Ptr CULong
a2'IO CULong
-> (CULong -> IO (String, CULong, CInt))
-> IO (String, CULong, CInt)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CULong
a2'' -> 
  Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek  Ptr CInt
a3'IO CInt
-> (CInt -> IO (String, CULong, CInt)) -> IO (String, CULong, CInt)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
a3'' -> 
  (String, CULong, CInt) -> IO (String, CULong, CInt)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
res', CULong
a2'', CInt
a3'')

{-# LINE 277 "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 
  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')

{-# LINE 286 "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 :: KnownHosts
-> String -> Int -> String -> [KnownHostType] -> IO KnownHostResult
checkKnownHost KnownHosts
kh String
host Int
port String
key [KnownHostType]
flags = KnownHosts
-> String
-> Int
-> String
-> Int
-> [KnownHostType]
-> Ptr ()
-> IO KnownHostResult
checkKnownHost_ KnownHosts
kh String
host Int
port String
key (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
key) [KnownHostType]
flags Ptr ()
forall a. Ptr a
nullPtr

-- TODO: I don't see the '&' in the libssh2 docs?
publicKeyAuthFile_ :: (Session) -> (String) -> (String) -> (String) -> (String) -> IO ((Int))
publicKeyAuthFile_ :: Session -> String -> String -> String -> String -> IO Int
publicKeyAuthFile_ Session
a1 String
a2 String
a3 String
a4 String
a5 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  (\String
s (CString, CUInt) -> IO Int
f -> String -> (CStringLen -> IO Int) -> IO Int
forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(CString
p, Int
n) -> (CString, CUInt) -> IO Int
f (CString
p, Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a2 (((CString, CUInt) -> IO Int) -> IO Int)
-> ((CString, CUInt) -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(CString
a2'1, CUInt
a2'2) -> 
  String -> (CString -> IO Int) -> IO Int
forall a. String -> (CString -> IO a) -> IO a
C2HSImp.withCString String
a3 ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \CString
a3' -> 
  String -> (CString -> IO Int) -> IO Int
forall a. String -> (CString -> IO a) -> IO a
C2HSImp.withCString String
a4 ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \CString
a4' -> 
  String -> (CString -> IO Int) -> IO Int
forall a. String -> (CString -> IO a) -> IO a
C2HSImp.withCString String
a5 ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \CString
a5' -> 
  Ptr ()
-> CString -> CUInt -> CString -> CString -> CString -> IO CInt
publicKeyAuthFile_'_ Ptr ()
a1' CString
a2'1  CUInt
a2'2 CString
a3' CString
a4' CString
a5' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 303 "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 -> String -> String -> String -> String -> IO ()
publicKeyAuthFile Session
session String
username String
public String
private String
passphrase = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> (IO Int -> IO Int) -> IO Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Session -> IO Int -> IO Int
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Session -> Maybe Session
forall a. a -> Maybe a
Just Session
session) (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
  Session -> String -> String -> String -> String -> IO Int
publicKeyAuthFile_ Session
session String
username String
public String
private String
passphrase

-- | Perform username/password authentication.
usernamePasswordAuth :: Session -- ^ Session
                     -> String  -- ^ Username
                     -> String  -- ^ Password
                     -> IO ()
usernamePasswordAuth :: Session -> String -> String -> IO ()
usernamePasswordAuth Session
session String
username String
password =
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
username ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
usernameptr -> do
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
password ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
passwordptr -> do
      IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> (IO CInt -> IO CInt) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Session -> IO CInt -> IO CInt
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Session -> Maybe Session
forall a. a -> Maybe a
Just Session
session) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
        Ptr ()
-> CString
-> CUInt
-> CString
-> CUInt
-> FunPtr
     (Ptr () -> Ptr CString -> Ptr CInt -> Ptr (Ptr ()) -> IO ())
-> IO CInt
libssh2_userauth_password_ex (Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
session) CString
usernameptr (Int -> CUInt
forall a. Enum a => Int -> a
toEnum (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
username) CString
passwordptr (Int -> CUInt
forall a. Enum a => Int -> a
toEnum (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
password) FunPtr (Ptr () -> Ptr CString -> Ptr CInt -> Ptr (Ptr ()) -> IO ())
forall a. FunPtr a
nullFunPtr

openSessionChannelEx :: (Session) -> (String) -> (Int) -> (Int) -> (String) -> IO ((Ptr ()))
openSessionChannelEx :: Session -> String -> Int -> Int -> String -> IO (Ptr ())
openSessionChannelEx Session
a1 String
a2 Int
a3 Int
a4 String
a5 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  (\String
s (CString, CUInt) -> IO (Ptr ())
f -> String -> (CStringLen -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(CString
p, Int
n) -> (CString, CUInt) -> IO (Ptr ())
f (CString
p, Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a2 (((CString, CUInt) -> IO (Ptr ())) -> IO (Ptr ()))
-> ((CString, CUInt) -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \(CString
a2'1, CUInt
a2'2) -> 
  let {a3' :: CUInt
a3' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a3} in 
  let {a4' :: CUInt
a4' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a4} in 
  (\String
s (CString, CUInt) -> IO (Ptr ())
f -> String -> (CStringLen -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(CString
p, Int
n) -> (CString, CUInt) -> IO (Ptr ())
f (CString
p, Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a5 (((CString, CUInt) -> IO (Ptr ())) -> IO (Ptr ()))
-> ((CString, CUInt) -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \(CString
a5'1, CUInt
a5'2) -> 
  Ptr ()
-> CString
-> CUInt
-> CUInt
-> CUInt
-> CString
-> CUInt
-> IO (Ptr ())
openSessionChannelEx'_ Ptr ()
a1' CString
a2'1  CUInt
a2'2 CUInt
a3' CUInt
a4' CString
a5'1  CUInt
a5'2 IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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


directTcpIpEx_ :: (Session) -> (String) -> (Int) -> (String) -> (Int) -> IO ((Ptr ()))
directTcpIpEx_ a1 a2 a3 a4 a5 =
  let {a1' = toPointer a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  C2HSImp.withCString a4 $ \a4' -> 
  let {a5' = fromIntegral a5} in 
  directTcpIpEx_'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

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


directTcpIpEx :: Session -> String -> Int -> String -> Int -> IO Channel
directTcpIpEx s host port shost sport = handleNullPtr (Just s) (channelFromPointer s) $ directTcpIpEx_ s host port shost sport

-- | Open a channel for session.
openChannelSession :: Session -> IO Channel
openChannelSession :: Session -> IO Channel
openChannelSession Session
s = Maybe Session
-> (Ptr () -> IO Channel) -> IO (Ptr ()) -> IO Channel
forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (Session -> Maybe Session
forall a. a -> Maybe a
Just Session
s) (Session -> Ptr () -> IO Channel
channelFromPointer Session
s) (IO (Ptr ()) -> IO Channel) -> IO (Ptr ()) -> IO Channel
forall a b. (a -> b) -> a -> b
$
  Session -> String -> Int -> Int -> String -> IO (Ptr ())
openSessionChannelEx Session
s String
"session" Int
65536 Int
32768 String
""

channelProcess :: Channel -> String -> String -> IO ()
channelProcess :: Channel -> String -> String -> IO ()
channelProcess Channel
ch String
kind String
command = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> (IO Int -> IO Int) -> IO Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Session -> IO Int -> IO Int
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Session -> Maybe Session
forall a. a -> Maybe a
Just (Session -> Maybe Session) -> Session -> Maybe Session
forall a b. (a -> b) -> a -> b
$ Channel -> Session
channelSession Channel
ch) (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
  Channel -> String -> String -> IO Int
channelProcessStartup_ Channel
ch String
kind String
command

-- | Execute command
channelExecute :: Channel -> String -> IO ()
channelExecute :: Channel -> String -> IO ()
channelExecute Channel
c String
command = Channel -> String -> String -> IO ()
channelProcess Channel
c String
"exec" String
command

channelProcessStartup_ :: (Channel) -> (String) -> (String) -> IO ((Int))
channelProcessStartup_ :: Channel -> String -> String -> IO Int
channelProcessStartup_ Channel
a1 String
a2 String
a3 =
  let {a1' :: Ptr ()
a1' = Channel -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  (\String
s (CString, CUInt) -> IO Int
f -> String -> (CStringLen -> IO Int) -> IO Int
forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(CString
p, Int
n) -> (CString, CUInt) -> IO Int
f (CString
p, Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a2 (((CString, CUInt) -> IO Int) -> IO Int)
-> ((CString, CUInt) -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(CString
a2'1, CUInt
a2'2) -> 
  (\String
s (CString, CUInt) -> IO Int
f -> String -> (CStringLen -> IO Int) -> IO Int
forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(CString
p, Int
n) -> (CString, CUInt) -> IO Int
f (CString
p, Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a3 (((CString, CUInt) -> IO Int) -> IO Int)
-> ((CString, CUInt) -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(CString
a3'1, CUInt
a3'2) -> 
  Ptr () -> CString -> CUInt -> CString -> CUInt -> IO CInt
channelProcessStartup_'_ Ptr ()
a1' CString
a2'1  CUInt
a2'2 CString
a3'1  CUInt
a3'2 IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | Execute shell command
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 :: Channel -> String -> String -> Int -> Int -> Int -> Int -> IO Int
requestPTYEx Channel
a1 String
a2 String
a3 Int
a4 Int
a5 Int
a6 Int
a7 =
  let {a1' :: Ptr ()
a1' = Channel -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  (\String
s (CString, CUInt) -> IO Int
f -> String -> (CStringLen -> IO Int) -> IO Int
forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(CString
p, Int
n) -> (CString, CUInt) -> IO Int
f (CString
p, Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a2 (((CString, CUInt) -> IO Int) -> IO Int)
-> ((CString, CUInt) -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(CString
a2'1, CUInt
a2'2) -> 
  (\String
s (CString, CUInt) -> IO Int
f -> String -> (CStringLen -> IO Int) -> IO Int
forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(CString
p, Int
n) -> (CString, CUInt) -> IO Int
f (CString
p, Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a3 (((CString, CUInt) -> IO Int) -> IO Int)
-> ((CString, CUInt) -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(CString
a3'1, CUInt
a3'2) -> 
  let {a4' :: CInt
a4' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a4} in 
  let {a5' :: CInt
a5' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a5} in 
  let {a6' :: CInt
a6' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a6} in 
  let {a7' :: CInt
a7' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a7} in 
  Ptr ()
-> CString
-> CUInt
-> CString
-> CUInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO CInt
requestPTYEx'_ Ptr ()
a1' CString
a2'1  CUInt
a2'2 CString
a3'1  CUInt
a3'2 CInt
a4' CInt
a5' CInt
a6' CInt
a7' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 372 "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 = 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)

-- | Read data from channel.
readChannel :: Channel         --
            -> Size             -- ^ Amount of data to read
            -> IO BSS.ByteString
readChannel :: Channel -> CULong -> IO ByteString
readChannel Channel
c CULong
sz = Channel -> Int -> CULong -> IO ByteString
readChannelEx Channel
c Int
0 CULong
sz

-- | Write data to channel.
writeChannel :: Channel -> BSS.ByteString -> IO ()
writeChannel :: Channel -> ByteString -> IO ()
writeChannel Channel
ch ByteString
bs =
    ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BSS.unsafeUseAsCString ByteString
bs ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CULong -> CString -> IO ()
go Int
0 (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CULong) -> Int -> CULong
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BSS.length ByteString
bs)
  where
    go :: Int -> CULong -> CString -> IO ()
    go :: Int -> CULong -> CString -> IO ()
go Int
offset CULong
len CString
cstr = do
      CLong
written <- Maybe Session -> IO CLong -> IO CLong
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Session -> Maybe Session
forall a. a -> Maybe a
Just (Session -> Maybe Session) -> Session -> Maybe Session
forall a b. (a -> b) -> a -> b
$ Channel -> Session
channelSession Channel
ch)
                           (IO CLong -> IO CLong) -> IO CLong -> IO CLong
forall a b. (a -> b) -> a -> b
$ Ptr () -> CInt -> CString -> CULong -> IO CLong
libssh2_channel_write_ex (Channel -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Channel
ch)
                                                         CInt
0
                                                         (CString
cstr CString -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)
                                                         (CULong -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULong
len)
      if CLong -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
written CULong -> CULong -> Bool
forall a. Ord a => a -> a -> Bool
< CULong
len
        then Int -> CULong -> CString -> IO ()
go (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
written) (CULong
len CULong -> CULong -> CULong
forall a. Num a => a -> a -> a
- CLong -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
written) CString
cstr
        else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

channelSendEOF_ :: (Channel) -> IO ((Int))
channelSendEOF_ :: Channel -> IO Int
channelSendEOF_ Channel
a1 =
  let {a1' :: Ptr ()
a1' = Channel -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  Ptr () -> IO CInt
channelSendEOF_'_ Ptr ()
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = fromIntegral res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 406 "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 412 "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 :: TraceFlag -> CInt
tf2int TraceFlag
T_TRANS = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
tf2int TraceFlag
T_KEX   = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
2
tf2int TraceFlag
T_AUTH  = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
3
tf2int TraceFlag
T_CONN  = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
4
tf2int TraceFlag
T_SCP   = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
5
tf2int TraceFlag
T_SFTP  = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
6
tf2int TraceFlag
T_ERROR = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
7
tf2int TraceFlag
T_PUBLICKEY = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
8
tf2int TraceFlag
T_SOCKET = CInt
1 CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
9

trace2int :: [TraceFlag] -> CInt
trace2int :: [TraceFlag] -> CInt
trace2int [TraceFlag]
flags = (CInt -> CInt -> CInt) -> CInt -> [CInt] -> CInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) CInt
0 ((TraceFlag -> CInt) -> [TraceFlag] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map TraceFlag -> CInt
tf2int [TraceFlag]
flags)

setTraceMode :: (Session) -> ([TraceFlag]) -> IO ()
setTraceMode :: Session -> [TraceFlag] -> IO ()
setTraceMode Session
a1 [TraceFlag]
a2 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  let {a2' :: CInt
a2' = [TraceFlag] -> CInt
trace2int [TraceFlag]
a2} in 
  Ptr () -> CInt -> IO CInt
setTraceMode'_ Ptr ()
a1' CInt
a2' IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 444 "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 464 "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 :: Channel -> Handle -> CLong -> IO Integer
readChannelToHandle Channel
ch Handle
h CLong
fileSize = do
    Int -> (CString -> IO Integer) -> IO Integer
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize ((CString -> IO Integer) -> IO Integer)
-> (CString -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \CString
buffer ->
        Channel
-> CString
-> Int
-> CLong
-> (CString -> Int -> IO ())
-> IO Integer
readChannelCB Channel
ch CString
buffer Int
bufferSize CLong
fileSize CString -> Int -> IO ()
forall a. Ptr a -> Int -> IO ()
callback
  where
    callback :: Ptr a -> Int -> IO ()
callback Ptr a
buffer Int
size = Handle -> Ptr a -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr a
buffer Int
size

    bufferSize :: Int
    bufferSize :: Int
bufferSize = Int
0x100000

readChannelCB :: Channel -> CString -> Int -> Offset -> (CString -> Int -> IO ()) -> IO Integer
readChannelCB :: Channel
-> CString
-> Int
-> CLong
-> (CString -> Int -> IO ())
-> IO Integer
readChannelCB Channel
ch CString
buffer Int
bufferSize CLong
fileSize CString -> Int -> IO ()
callback =
  let go :: a -> IO Integer
go a
got = do
        let toRead :: a
toRead = a -> a -> a
forall a. Ord a => a -> a -> a
min (CLong -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
fileSize a -> a -> a
forall a. Num a => a -> a -> a
- a
got) (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufferSize)
        CLong
sz <- Maybe Session -> IO CLong -> IO CLong
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Session -> Maybe Session
forall a. a -> Maybe a
Just (Session -> Maybe Session) -> Session -> Maybe Session
forall a b. (a -> b) -> a -> b
$ Channel -> Session
channelSession Channel
ch) (IO CLong -> IO CLong) -> IO CLong -> IO CLong
forall a b. (a -> b) -> a -> b
$
                Ptr () -> CInt -> CString -> CULong -> IO CLong
libssh2_channel_read_ex
{-# LINE 492 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}

                  (toPointer ch)
                  0
                  buffer
                  (fromIntegral toRead)
        let isz :: Integer
            isz :: Integer
isz = CLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sz
        CString -> Int -> IO ()
callback CString
buffer (CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sz)
        CInt
eof <- Ptr () -> IO CInt
libssh2_channel_eof (Channel -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Channel
ch)
        let newGot :: a
newGot = a
got a -> a -> a
forall a. Num a => a -> a -> a
+ CLong -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sz
        if  (CInt
eof CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1) Bool -> Bool -> Bool
|| (a
newGot a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== CLong -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
fileSize)
          then do
               Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
isz
          else do
               Integer
rest <- a -> IO Integer
go a
newGot
               Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ Integer
isz Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rest
  in Integer -> IO Integer
forall a. Integral a => a -> IO Integer
go (Integer
0 :: Integer)

channelIsEOF :: (Channel) -> IO ((Bool))
channelIsEOF :: Channel -> IO Bool
channelIsEOF Channel
a1 =
  let {a1' :: Ptr ()
a1' = Channel -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  Ptr () -> IO CInt
channelIsEOF'_ Ptr ()
a1' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  CInt -> IO Bool
handleBool CInt
res IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
res' ->
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 511 "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 514 "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_ :: Channel -> IO Int
freeChannel_ Channel
a1 =
  let {a1' :: Ptr ()
a1' = Channel -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  Ptr () -> IO CInt
freeChannel_'_ Ptr ()
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (res')

{-# LINE 521 "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 :: Channel -> IO Int
channelExitStatus Channel
a1 =
  let {a1' :: Ptr ()
a1' = Channel -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  Ptr () -> IO CInt
channelExitStatus'_ Ptr ()
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 529 "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 ->
  let {res' = fromIntegral res} in
  peekCStringPtr  a2'>>= \a2'' -> 
  peekMaybeCStringPtr  a4'>>= \a4'' -> 
  peekMaybeCStringPtr  a6'>>= \a6'' -> 
  return (res', a2'', a4'', a6'')

{-# LINE 538 "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 
  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')

{-# LINE 551 "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 = (C2HSImp.CLong)
{-# LINE 558 "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 :: Session -> String -> IO (Channel, CLong)
scpReceiveChannel Session
s String
path = do
  String -> (CString -> IO (Channel, CLong)) -> IO (Channel, CLong)
forall a. String -> (CString -> IO a) -> IO a
withCString String
path ((CString -> IO (Channel, CLong)) -> IO (Channel, CLong))
-> (CString -> IO (Channel, CLong)) -> IO (Channel, CLong)
forall a b. (a -> b) -> a -> b
$ \CString
pathptr ->
     Int -> (Ptr () -> IO (Channel, CLong)) -> IO (Channel, CLong)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
144 ((Ptr () -> IO (Channel, CLong)) -> IO (Channel, CLong))
-> (Ptr () -> IO (Channel, CLong)) -> IO (Channel, CLong)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
statptr -> do
       Channel
channel <- Maybe Session
-> (Ptr () -> IO Channel) -> IO (Ptr ()) -> IO Channel
forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (Session -> Maybe Session
forall a. a -> Maybe a
Just Session
s) (Session -> Ptr () -> IO Channel
channelFromPointer Session
s) (IO (Ptr ()) -> IO Channel) -> IO (Ptr ()) -> IO Channel
forall a b. (a -> b) -> a -> b
$ Ptr () -> CString -> Ptr () -> IO (Ptr ())
libssh2_scp_recv (Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
s) CString
pathptr Ptr ()
statptr
       CLong
size <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO CLong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
48 :: IO C2HSImp.CLong}) Ptr ()
statptr
       (Channel, CLong) -> IO (Channel, CLong)
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel
channel, CLong
size)

-- {# fun poll_channel_read as pollChannelRead_
--     { toPointer `Channel' } -> `Int' #}

pollChannelRead :: Channel -> IO Bool
pollChannelRead :: Channel -> IO Bool
pollChannelRead Channel
ch = do
  Maybe Socket
mbSocket <- Session -> IO (Maybe Socket)
sessionGetSocket (Channel -> Session
channelSession Channel
ch)
  case Maybe Socket
mbSocket of
    Maybe Socket
Nothing -> String -> IO Bool
forall a. HasCallStack => String -> a
error String
"pollChannelRead without socket present"
    Just Socket
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

--
-- | Sftp support
--

-- SFTP File Transfer Flags. See libssh2 documentation
data SftpFileTransferFlags =
    FXF_READ
  | FXF_WRITE
  | FXF_APPEND
  | FXF_CREAT
  | FXF_TRUNC
  | FXF_EXCL
  deriving (SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
(SftpFileTransferFlags -> SftpFileTransferFlags -> Bool)
-> (SftpFileTransferFlags -> SftpFileTransferFlags -> Bool)
-> Eq SftpFileTransferFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
$c/= :: SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
== :: SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
$c== :: SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
Eq, Int -> SftpFileTransferFlags -> ShowS
[SftpFileTransferFlags] -> ShowS
SftpFileTransferFlags -> String
(Int -> SftpFileTransferFlags -> ShowS)
-> (SftpFileTransferFlags -> String)
-> ([SftpFileTransferFlags] -> ShowS)
-> Show SftpFileTransferFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SftpFileTransferFlags] -> ShowS
$cshowList :: [SftpFileTransferFlags] -> ShowS
show :: SftpFileTransferFlags -> String
$cshow :: SftpFileTransferFlags -> String
showsPrec :: Int -> SftpFileTransferFlags -> ShowS
$cshowsPrec :: Int -> SftpFileTransferFlags -> ShowS
Show)

ftf2int :: SftpFileTransferFlags -> CULong
ftf2int :: SftpFileTransferFlags -> CULong
ftf2int SftpFileTransferFlags
FXF_READ   = CULong
0x00000001
ftf2int SftpFileTransferFlags
FXF_WRITE  = CULong
0x00000002
ftf2int SftpFileTransferFlags
FXF_APPEND = CULong
0x00000004
ftf2int SftpFileTransferFlags
FXF_CREAT  = CULong
0x00000008
ftf2int SftpFileTransferFlags
FXF_TRUNC  = CULong
0x00000010
ftf2int SftpFileTransferFlags
FXF_EXCL   = CULong
0x00000020

ftransferflags2int :: [SftpFileTransferFlags] -> CULong
ftransferflags2int :: [SftpFileTransferFlags] -> CULong
ftransferflags2int [SftpFileTransferFlags]
list = (CULong -> CULong -> CULong) -> CULong -> [CULong] -> CULong
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CULong -> CULong -> CULong
forall a. Bits a => a -> a -> a
(.|.) CULong
0 ((SftpFileTransferFlags -> CULong)
-> [SftpFileTransferFlags] -> [CULong]
forall a b. (a -> b) -> [a] -> [b]
map SftpFileTransferFlags -> CULong
ftf2int [SftpFileTransferFlags]
list)

-- | Flags for open_ex()
data OpenExFlags = OpenFile
                 | OpenDir
                 deriving (OpenExFlags -> OpenExFlags -> Bool
(OpenExFlags -> OpenExFlags -> Bool)
-> (OpenExFlags -> OpenExFlags -> Bool) -> Eq OpenExFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenExFlags -> OpenExFlags -> Bool
$c/= :: OpenExFlags -> OpenExFlags -> Bool
== :: OpenExFlags -> OpenExFlags -> Bool
$c== :: OpenExFlags -> OpenExFlags -> Bool
Eq, Int -> OpenExFlags -> ShowS
[OpenExFlags] -> ShowS
OpenExFlags -> String
(Int -> OpenExFlags -> ShowS)
-> (OpenExFlags -> String)
-> ([OpenExFlags] -> ShowS)
-> Show OpenExFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenExFlags] -> ShowS
$cshowList :: [OpenExFlags] -> ShowS
show :: OpenExFlags -> String
$cshow :: OpenExFlags -> String
showsPrec :: Int -> OpenExFlags -> ShowS
$cshowsPrec :: Int -> OpenExFlags -> ShowS
Show)

oef2int :: (Num a) => OpenExFlags -> a
oef2int :: OpenExFlags -> a
oef2int OpenExFlags
OpenFile = a
0
oef2int OpenExFlags
OpenDir  = a
1

sftpInit :: Session ->  IO Sftp
sftpInit :: Session -> IO Sftp
sftpInit Session
s = Maybe Session -> (Ptr () -> IO Sftp) -> IO (Ptr ()) -> IO Sftp
forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (Session -> Maybe Session
forall a. a -> Maybe a
Just Session
s) (Session -> Ptr () -> IO Sftp
sftpFromPointer Session
s) (IO (Ptr ()) -> IO Sftp) -> IO (Ptr ()) -> IO Sftp
forall a b. (a -> b) -> a -> b
$
  Session -> IO (Ptr ())
sftpInit_ Session
s

sftpShutdown :: Sftp -> IO ()
sftpShutdown :: Sftp -> IO ()
sftpShutdown Sftp
sftp =
  IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> (IO Int -> IO Int) -> IO Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Sftp -> IO Int -> IO Int
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Sftp -> Maybe Sftp
forall a. a -> Maybe a
Just Sftp
sftp) (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Sftp -> IO Int
sftpShutdown_ Sftp
sftp

sftpInit_ :: (Session) -> IO ((Ptr ()))
sftpInit_ :: Session -> IO (Ptr ())
sftpInit_ Session
a1 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  Ptr () -> IO (Ptr ())
sftpInit_'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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


sftpShutdown_ :: (Sftp) -> IO ((Int))
sftpShutdown_ :: Sftp -> IO Int
sftpShutdown_ Sftp
a1 =
  let {a1' :: Ptr ()
a1' = Sftp -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Sftp
a1} in 
  Ptr () -> IO CInt
sftpShutdown_'_ Ptr ()
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | 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 -> String -> IO SftpHandle
sftpOpenDir Sftp
sftp String
path =
  Maybe Sftp
-> (Ptr () -> IO SftpHandle) -> IO (Ptr ()) -> IO SftpHandle
forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (Sftp -> Maybe Sftp
forall a. a -> Maybe a
Just Sftp
sftp) ( Sftp -> Ptr () -> IO SftpHandle
sftpHandleFromPointer Sftp
sftp ) (IO (Ptr ()) -> IO SftpHandle) -> IO (Ptr ()) -> IO SftpHandle
forall a b. (a -> b) -> a -> b
$
      Sftp
-> String
-> CLong
-> [SftpFileTransferFlags]
-> CInt
-> IO (Ptr ())
sftpOpen_ Sftp
sftp String
path CLong
0 [] (OpenExFlags -> CInt
forall a. Num a => OpenExFlags -> a
oef2int OpenExFlags
OpenDir)

sftpOpen_ :: Sftp -> String -> CLong -> [SftpFileTransferFlags] -> CInt -> IO (Ptr ())
sftpOpen_ :: Sftp
-> String
-> CLong
-> [SftpFileTransferFlags]
-> CInt
-> IO (Ptr ())
sftpOpen_ Sftp
sftp String
path CLong
mode [SftpFileTransferFlags]
fl CInt
open_type =
  let flags :: CULong
flags = [SftpFileTransferFlags] -> CULong
ftransferflags2int [SftpFileTransferFlags]
fl
  in
    String -> (CStringLen -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
path ((CStringLen -> IO (Ptr ())) -> IO (Ptr ()))
-> (CStringLen -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \(CString
pathP, Int
pathL) -> do
      Ptr ()
-> CString -> CUInt -> CULong -> CLong -> CInt -> IO (Ptr ())
libssh2_sftp_open_ex (Sftp -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Sftp
sftp) CString
pathP (Int -> CUInt
forall a. Enum a => Int -> a
toEnum Int
pathL) CULong
flags CLong
mode CInt
open_type

-- | Read directory from file handler
sftpReadDir :: SftpHandle -> IO (Maybe (BSS.ByteString, SftpAttributes))
sftpReadDir :: SftpHandle -> IO (Maybe (ByteString, SftpAttributes))
sftpReadDir SftpHandle
sftph = do
  let bufflen :: Int
bufflen = Int
512
  Int
-> (CString -> IO (Maybe (ByteString, SftpAttributes)))
-> IO (Maybe (ByteString, SftpAttributes))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufflen ((CString -> IO (Maybe (ByteString, SftpAttributes)))
 -> IO (Maybe (ByteString, SftpAttributes)))
-> (CString -> IO (Maybe (ByteString, SftpAttributes)))
-> IO (Maybe (ByteString, SftpAttributes))
forall a b. (a -> b) -> a -> b
$ \CString
bufptr -> do
    Int
-> (Ptr () -> IO (Maybe (ByteString, SftpAttributes)))
-> IO (Maybe (ByteString, SftpAttributes))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((Ptr () -> IO (Maybe (ByteString, SftpAttributes)))
 -> IO (Maybe (ByteString, SftpAttributes)))
-> (Ptr () -> IO (Maybe (ByteString, SftpAttributes)))
-> IO (Maybe (ByteString, SftpAttributes))
forall a b. (a -> b) -> a -> b
$ \Ptr ()
sftpattrptr -> do
      CInt
rc <- Maybe SftpHandle -> IO CInt -> IO CInt
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (SftpHandle -> Maybe SftpHandle
forall a. a -> Maybe a
Just SftpHandle
sftph) (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
        Ptr ()
-> CString -> CULong -> CString -> CULong -> Ptr () -> IO CInt
libssh2_sftp_readdir_ex (SftpHandle -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph) CString
bufptr (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufflen) CString
forall a. Ptr a
nullPtr CULong
0 Ptr ()
sftpattrptr
      case CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 of
        Bool
False -> do
         SftpAttributes
fstat    <- Ptr () -> IO SftpAttributes
forall a. Ptr a -> IO SftpAttributes
parseSftpAttributes Ptr ()
sftpattrptr
         ByteString
filename <- CStringLen -> IO ByteString
BSS.packCStringLen (CString
bufptr, CInt -> Int
forall a. IntResult a => a -> Int
intResult CInt
rc)
         Maybe (ByteString, SftpAttributes)
-> IO (Maybe (ByteString, SftpAttributes))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ByteString, SftpAttributes)
 -> IO (Maybe (ByteString, SftpAttributes)))
-> Maybe (ByteString, SftpAttributes)
-> IO (Maybe (ByteString, SftpAttributes))
forall a b. (a -> b) -> a -> b
$ (ByteString, SftpAttributes) -> Maybe (ByteString, SftpAttributes)
forall a. a -> Maybe a
Just (ByteString
filename, SftpAttributes
fstat)
        Bool
True ->
           Maybe (ByteString, SftpAttributes)
-> IO (Maybe (ByteString, SftpAttributes))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ByteString, SftpAttributes)
forall a. Maybe a
Nothing

-- | Close file handle
sftpCloseHandle :: SftpHandle -> IO ()
sftpCloseHandle :: SftpHandle -> IO ()
sftpCloseHandle SftpHandle
sftph =
  IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> (IO CInt -> IO CInt) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Sftp -> IO CInt -> IO CInt
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Sftp -> Maybe Sftp
forall a. a -> Maybe a
Just (Sftp -> Maybe Sftp) -> Sftp -> Maybe Sftp
forall a b. (a -> b) -> a -> b
$ SftpHandle -> Sftp
sftpHandleSession SftpHandle
sftph) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    Ptr () -> IO CInt
libssh2_sftp_close_handle (SftpHandle -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph)

data RenameFlag =
    RENAME_OVERWRITE
  | RENAME_ATOMIC
  | RENAME_NATIVE
  deriving (RenameFlag -> RenameFlag -> Bool
(RenameFlag -> RenameFlag -> Bool)
-> (RenameFlag -> RenameFlag -> Bool) -> Eq RenameFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenameFlag -> RenameFlag -> Bool
$c/= :: RenameFlag -> RenameFlag -> Bool
== :: RenameFlag -> RenameFlag -> Bool
$c== :: RenameFlag -> RenameFlag -> Bool
Eq, Int -> RenameFlag -> ShowS
[RenameFlag] -> ShowS
RenameFlag -> String
(Int -> RenameFlag -> ShowS)
-> (RenameFlag -> String)
-> ([RenameFlag] -> ShowS)
-> Show RenameFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenameFlag] -> ShowS
$cshowList :: [RenameFlag] -> ShowS
show :: RenameFlag -> String
$cshow :: RenameFlag -> String
showsPrec :: Int -> RenameFlag -> ShowS
$cshowsPrec :: Int -> RenameFlag -> ShowS
Show)

rf2long :: RenameFlag -> CLong
rf2long :: RenameFlag -> CLong
rf2long RenameFlag
RENAME_OVERWRITE = CLong
0x00000001
rf2long RenameFlag
RENAME_ATOMIC    = CLong
0x00000002
rf2long RenameFlag
RENAME_NATIVE    = CLong
0x00000004

renameFlag2int :: [RenameFlag] -> CLong
renameFlag2int :: [RenameFlag] -> CLong
renameFlag2int [RenameFlag]
flags = (CLong -> CLong -> CLong) -> CLong -> [CLong] -> CLong
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CLong -> CLong -> CLong
forall a. Bits a => a -> a -> a
(.|.) CLong
0 ((RenameFlag -> CLong) -> [RenameFlag] -> [CLong]
forall a b. (a -> b) -> [a] -> [b]
map RenameFlag -> CLong
rf2long [RenameFlag]
flags)

-- | Rename a file on the sftp server
sftpRenameFile :: Sftp     -- ^ Opened sftp session
               -> FilePath -- ^ Old file name
               -> FilePath -- ^ New file name
               -> IO ()
sftpRenameFile :: Sftp -> String -> String -> IO ()
sftpRenameFile Sftp
sftp String
src String
dest =
  Sftp -> String -> String -> [RenameFlag] -> IO ()
sftpRenameFileEx Sftp
sftp String
src String
dest [ RenameFlag
RENAME_NATIVE, RenameFlag
RENAME_ATOMIC, RenameFlag
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 -> String -> String -> [RenameFlag] -> IO ()
sftpRenameFileEx Sftp
sftp String
src String
dest [RenameFlag]
flags =
  String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
src ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
srcP, Int
srcL) ->
    String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
dest ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
destP, Int
destL) ->
      IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> (IO CInt -> IO CInt) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Session -> IO CInt -> IO CInt
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Session -> Maybe Session
forall a. a -> Maybe a
Just (Session -> Maybe Session) -> Session -> Maybe Session
forall a b. (a -> b) -> a -> b
$ Sftp -> Session
sftpSession Sftp
sftp) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
         Ptr () -> CString -> CUInt -> CString -> CUInt -> CLong -> IO CInt
libssh2_sftp_rename_ex (Sftp -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Sftp
sftp) CString
srcP (Int -> CUInt
forall a. Enum a => Int -> a
toEnum Int
srcL) CString
destP (Int -> CUInt
forall a. Enum a => Int -> a
toEnum Int
destL) ([RenameFlag] -> CLong
renameFlag2int [RenameFlag]
flags )

-- | Download file from the sftp server
sftpReadFileToHandler :: SftpHandle -> Handle -> Int -> IO Int
sftpReadFileToHandler :: SftpHandle -> Handle -> Int -> IO Int
sftpReadFileToHandler SftpHandle
sftph Handle
fh Int
fileSize =
  let
    go :: Int -> Ptr a -> IO Int
    go :: Int -> Ptr a -> IO Int
go Int
received Ptr a
buffer = do
      let toRead :: Int
          toRead :: Int
toRead = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fileSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
received) Int
bufferSize
      Int
sz <- Int -> Ptr a -> Int -> IO Int
forall a. Int -> Ptr a -> Int -> IO Int
receive Int
toRead Ptr a
buffer Int
0
      ()
_ <- Handle -> Ptr a -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
fh Ptr a
buffer Int
sz
      let newreceived :: Int
          newreceived :: Int
newreceived = (Int
received Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
      if Int
newreceived Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fileSize
         then Int -> Ptr a -> IO Int
forall a. Int -> Ptr a -> IO Int
go Int
newreceived Ptr a
buffer
         else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newreceived

    receive :: Int -> Ptr a -> Int -> IO Int
    receive :: Int -> Ptr a -> Int -> IO Int
receive Int
0 Ptr a
_ Int
read_sz = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
read_sz
    receive Int
toread Ptr a
buf Int
alreadyread = do
       CLong
received <- Maybe SftpHandle -> IO CLong -> IO CLong
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (SftpHandle -> Maybe SftpHandle
forall a. a -> Maybe a
Just SftpHandle
sftph)
                       (IO CLong -> IO CLong) -> IO CLong -> IO CLong
forall a b. (a -> b) -> a -> b
$ Ptr () -> CString -> CULong -> IO CLong
libssh2_sftp_read (SftpHandle -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph)
                                              (Ptr a
buf Ptr a -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
alreadyread)
                                              (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
toread)
       Int -> Ptr a -> Int -> IO Int
forall a. Int -> Ptr a -> Int -> IO Int
receive (Int
toread Int -> Int -> Int
forall a. Num a => a -> a -> a
- CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
received) Ptr a
buf (Int
alreadyread Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
received)

    bufferSize :: Int
bufferSize = Int
0x100000

  in Int -> (Ptr Any -> IO Int) -> IO Int
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize ((Ptr Any -> IO Int) -> IO Int) -> (Ptr Any -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Any -> IO Int
forall a. Int -> Ptr a -> IO Int
go Int
0

-- | Upload file to the sftp server
sftpWriteFileFromHandler :: SftpHandle -> Handle -> IO Integer
sftpWriteFileFromHandler :: SftpHandle -> Handle -> IO Integer
sftpWriteFileFromHandler SftpHandle
sftph Handle
fh =
  let
    go :: Integer -> Ptr a -> IO Integer
    go :: Integer -> Ptr a -> IO Integer
go Integer
done Ptr a
buffer = do
      Int
sz <- Handle -> Ptr a -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
fh Ptr a
buffer Int
bufferSize
      Int -> CLong -> Ptr a -> IO ()
forall a. Int -> CLong -> Ptr a -> IO ()
send Int
0 (Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) Ptr a
buffer
      let newDone :: Integer
newDone = Integer
done Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz
      if Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufferSize
        then Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
newDone
        else Integer -> Ptr a -> IO Integer
forall a. Integer -> Ptr a -> IO Integer
go Integer
newDone Ptr a
buffer

    send :: Int -> CLong -> Ptr a -> IO ()
    send :: Int -> CLong -> Ptr a -> IO ()
send Int
_ CLong
0 Ptr a
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    send Int
written CLong
size Ptr a
buf = do
      CLong
sent <- Maybe SftpHandle -> IO CLong -> IO CLong
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (SftpHandle -> Maybe SftpHandle
forall a. a -> Maybe a
Just SftpHandle
sftph)
                           (IO CLong -> IO CLong) -> IO CLong -> IO CLong
forall a b. (a -> b) -> a -> b
$ Ptr () -> CString -> CULong -> IO CLong
libssh2_sftp_write (SftpHandle -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph)
                                                   (Ptr a
buf Ptr a -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
written)
                                                   (CLong -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
size)
      Int -> CLong -> Ptr a -> IO ()
forall a. Int -> CLong -> Ptr a -> IO ()
send (Int
written Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sent) (CLong
size CLong -> CLong -> CLong
forall a. Num a => a -> a -> a
- CLong -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sent) Ptr a
buf

    bufferSize :: Int
    bufferSize :: Int
bufferSize = Int
0x100000

  in Int -> (Ptr Any -> IO Integer) -> IO Integer
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize ((Ptr Any -> IO Integer) -> IO Integer)
-> (Ptr Any -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Ptr Any -> IO Integer
forall a. Integer -> Ptr a -> IO Integer
go Integer
0

data SftpAttributes = SftpAttributes {
  SftpAttributes -> CULong
saFlags :: CULong,
  SftpAttributes -> CULLong
saFileSize :: CULLong,
  SftpAttributes -> CULong
saUid :: CULong,
  SftpAttributes -> CULong
saGid :: CULong,
  SftpAttributes -> CULong
saPermissions :: CULong,
  SftpAttributes -> CULong
saAtime :: CULong,
  SftpAttributes -> CULong
saMtime :: CULong
  } deriving (Int -> SftpAttributes -> ShowS
[SftpAttributes] -> ShowS
SftpAttributes -> String
(Int -> SftpAttributes -> ShowS)
-> (SftpAttributes -> String)
-> ([SftpAttributes] -> ShowS)
-> Show SftpAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SftpAttributes] -> ShowS
$cshowList :: [SftpAttributes] -> ShowS
show :: SftpAttributes -> String
$cshow :: SftpAttributes -> String
showsPrec :: Int -> SftpAttributes -> ShowS
$cshowsPrec :: Int -> SftpAttributes -> ShowS
Show, SftpAttributes -> SftpAttributes -> Bool
(SftpAttributes -> SftpAttributes -> Bool)
-> (SftpAttributes -> SftpAttributes -> Bool) -> Eq SftpAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SftpAttributes -> SftpAttributes -> Bool
$c/= :: SftpAttributes -> SftpAttributes -> Bool
== :: SftpAttributes -> SftpAttributes -> Bool
$c== :: SftpAttributes -> SftpAttributes -> Bool
Eq)

-- | Get sftp attributes from the sftp handler
sftpFstat :: SftpHandle
          -> IO (SftpAttributes)
sftpFstat :: SftpHandle -> IO SftpAttributes
sftpFstat SftpHandle
sftph = do
  Int -> (Ptr () -> IO SftpAttributes) -> IO SftpAttributes
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((Ptr () -> IO SftpAttributes) -> IO SftpAttributes)
-> (Ptr () -> IO SftpAttributes) -> IO SftpAttributes
forall a b. (a -> b) -> a -> b
$ \Ptr ()
sftpattrptr -> do
    CInt
_ <- Maybe SftpHandle -> IO CInt -> IO CInt
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (SftpHandle -> Maybe SftpHandle
forall a. a -> Maybe a
Just SftpHandle
sftph) (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
       Ptr () -> Ptr () -> CInt -> IO CInt
libssh2_sftp_fstat_ex (SftpHandle -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph) Ptr ()
sftpattrptr CInt
0
    Ptr () -> IO SftpAttributes
forall a. Ptr a -> IO SftpAttributes
parseSftpAttributes Ptr ()
sftpattrptr

parseSftpAttributes :: Ptr a -> IO SftpAttributes -- TODO why not storable?
parseSftpAttributes :: Ptr a -> IO SftpAttributes
parseSftpAttributes Ptr a
sftpattrptr = do
    CULong
flags<- (\Ptr a
ptr -> do {Ptr a -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr a
ptr Int
0 :: IO C2HSImp.CULong}) Ptr a
sftpattrptr
    CULLong
size <- (\Ptr a
ptr -> do {Ptr a -> Int -> IO CULLong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr a
ptr Int
8 :: IO C2HSImp.CULLong}) Ptr a
sftpattrptr
    CULong
uid  <- (\Ptr a
ptr -> do {Ptr a -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr a
ptr Int
16 :: IO C2HSImp.CULong}) Ptr a
sftpattrptr
    CULong
gid  <- (\Ptr a
ptr -> do {Ptr a -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr a
ptr Int
24 :: IO C2HSImp.CULong}) Ptr a
sftpattrptr
    CULong
perm <- (\Ptr a
ptr -> do {Ptr a -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr a
ptr Int
32 :: IO C2HSImp.CULong}) Ptr a
sftpattrptr
    CULong
atime<- (\Ptr a
ptr -> do {Ptr a -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr a
ptr Int
40 :: IO C2HSImp.CULong}) Ptr a
sftpattrptr
    CULong
mtime<- (\Ptr a
ptr -> do {Ptr a -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr a
ptr Int
48 :: IO C2HSImp.CULong}) Ptr a
sftpattrptr

    SftpAttributes -> IO SftpAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return (SftpAttributes -> IO SftpAttributes)
-> SftpAttributes -> IO SftpAttributes
forall a b. (a -> b) -> a -> b
$ CULong
-> CULLong
-> CULong
-> CULong
-> CULong
-> CULong
-> CULong
-> SftpAttributes
SftpAttributes CULong
flags CULLong
size CULong
uid CULong
gid CULong
perm CULong
atime CULong
mtime

-- | Delete file from SFTP server
sftpDeleteFile :: Sftp     -- ^ Opened sftp session
               -> FilePath -- ^ Path to the file to be deleted
               -> IO ()
sftpDeleteFile :: Sftp -> String -> IO ()
sftpDeleteFile Sftp
sftp String
path = do
  String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
path ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
str,Int
len) -> do
    IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> (IO CInt -> IO CInt) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Sftp -> IO CInt -> IO CInt
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Sftp -> Maybe Sftp
forall a. a -> Maybe a
Just Sftp
sftp) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      Ptr () -> CString -> CUInt -> IO CInt
libssh2_sftp_unlink_ex (Sftp -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Sftp
sftp) CString
str (Int -> CUInt
forall a. Enum a => Int -> a
toEnum Int
len)


--
-- | Agent support
--

-- | Initialize a new ssh agent handle.
agentInit :: Session -> IO Agent
agentInit :: Session -> IO Agent
agentInit Session
s = Maybe Session -> (Ptr () -> IO Agent) -> IO (Ptr ()) -> IO Agent
forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (Session -> Maybe Session
forall a. a -> Maybe a
Just Session
s) (Session -> Ptr () -> IO Agent
agentFromPointer Session
s) (IO (Ptr ()) -> IO Agent) -> IO (Ptr ()) -> IO Agent
forall a b. (a -> b) -> a -> b
$ Session -> IO (Ptr ())
agentInit_ Session
s

agentInit_ :: (Session) -> IO ((Ptr ()))
agentInit_ :: Session -> IO (Ptr ())
agentInit_ Session
a1 =
  let {a1' :: Ptr ()
a1' = Session -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  Ptr () -> IO (Ptr ())
agentInit_'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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


agentFree :: (Agent) -> IO ()
agentFree a1 =
  let {a1' = toPointer a1} in 
  agentFree'_ a1' >>
  return ()

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


-- | Attempt to establish a connection to an ssh agent process.
-- | The environment variable @SSH_AUTH_SOCK@ is used to determine where to connect on unix.
agentConnect :: Agent -> IO ()
agentConnect agent = void . handleInt (Just agent) $ agentConnect_ agent

agentConnect_ :: (Agent) -> IO ((Int))
agentConnect_ :: Agent -> IO Int
agentConnect_ Agent
a1 =
  let {a1' :: Ptr ()
a1' = Agent -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Agent
a1} in 
  Ptr () -> IO CInt
agentConnect_'_ Ptr ()
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | Get or update the list of known identities. Must be called at least once.
agentListIdentities :: Agent -> IO ()
agentListIdentities agent = void . handleInt (Just agent) $ agentListIdentities_ agent

agentListIdentities_ :: (Agent) -> IO ((Int))
agentListIdentities_ a1 =
  let {a1' = toPointer a1} in 
  agentListIdentities_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


-- | Cleans up a connection to an ssh agent.
agentDisconnect :: Agent -> IO ()
agentDisconnect agent = void . handleInt (Just agent) $ agentDisconnect_ agent

agentDisconnect_ :: (Agent) -> IO ((Int))
agentDisconnect_ a1 =
  let {a1' = toPointer a1} in 
  agentDisconnect_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


-- | Copies all the keys from the agent to the local process.
agentGetIdentities :: Agent -> IO [AgentPublicKey]
agentGetIdentities agent = agentGetIdentities_ agent []
  where
    agentGetIdentities_ :: Agent -> [AgentPublicKey] -> IO [AgentPublicKey]
    agentGetIdentities_ agent' acc@[] = do
      k <- agentGetIdentity agent' Nothing
      case k of
        Just aKey -> agentGetIdentities_ agent' [aKey]
        Nothing -> return acc
    agentGetIdentities_ agent' acc = do
      k <- agentGetIdentity agent' $ Just $ head acc
      case k of
        Just aKey -> agentGetIdentities_ agent' (aKey:acc)
        Nothing -> return acc

agentNullPublicKey :: IO AgentPublicKey
agentNullPublicKey :: IO AgentPublicKey
agentNullPublicKey = Ptr () -> IO AgentPublicKey
agentPublicKeyFromPointer Ptr ()
forall a. Ptr a
nullPtr

-- | Copies one identity from the agent to the local process.
agentGetIdentity :: Agent                     -- ^ Agent handle.
                 -> Maybe AgentPublicKey      -- ^ Previous key returned.
                 -> IO (Maybe AgentPublicKey)
agentGetIdentity :: Agent -> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity Agent
agent Maybe AgentPublicKey
Nothing = do
  AgentPublicKey
nullKey <- IO AgentPublicKey
agentNullPublicKey
  Agent -> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity Agent
agent (AgentPublicKey -> Maybe AgentPublicKey
forall a. a -> Maybe a
Just AgentPublicKey
nullKey)
agentGetIdentity Agent
agent (Just AgentPublicKey
key) = do
  Agent -> AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity_ Agent
agent AgentPublicKey
key

agentGetIdentity_ :: Agent -> AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity_ :: Agent -> AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity_ Agent
a AgentPublicKey
pk = do
  AgentPublicKey
-> (Ptr AgentPublicKey -> IO (Maybe AgentPublicKey))
-> IO (Maybe AgentPublicKey)
forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey AgentPublicKey
pk ((Ptr AgentPublicKey -> IO (Maybe AgentPublicKey))
 -> IO (Maybe AgentPublicKey))
-> (Ptr AgentPublicKey -> IO (Maybe AgentPublicKey))
-> IO (Maybe AgentPublicKey)
forall a b. (a -> b) -> a -> b
$ \Ptr AgentPublicKey
pkPtr -> do
    (Ptr () -> IO (Maybe AgentPublicKey)) -> IO (Maybe AgentPublicKey)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr () -> IO (Maybe AgentPublicKey))
 -> IO (Maybe AgentPublicKey))
-> (Ptr () -> IO (Maybe AgentPublicKey))
-> IO (Maybe AgentPublicKey)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr -> do
      (CInt
res, Ptr ()
pptr) <- Ptr () -> (Ptr (Ptr ()) -> IO (CInt, Ptr ())) -> IO (CInt, Ptr ())
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr ()
ptr ((Ptr (Ptr ()) -> IO (CInt, Ptr ())) -> IO (CInt, Ptr ()))
-> (Ptr (Ptr ()) -> IO (CInt, Ptr ())) -> IO (CInt, Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
pkStore -> do
                CInt
x <- Ptr () -> Ptr (Ptr ()) -> Ptr () -> IO CInt
libssh2_agent_get_identity (Agent -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Agent
a) Ptr (Ptr ())
pkStore (Ptr AgentPublicKey -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr AgentPublicKey
pkPtr)
                Ptr ()
pptr <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
pkStore
                (CInt, Ptr ()) -> IO (CInt, Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
x, Ptr ()
pptr)
      IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Agent -> IO CInt -> IO CInt
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Agent -> Maybe Agent
forall a. a -> Maybe a
Just Agent
a) (CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res)
      if CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
        then do
          AgentPublicKey
resPkPtr <- Ptr () -> IO AgentPublicKey
agentPublicKeyFromPointer Ptr ()
pptr
          Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AgentPublicKey -> IO (Maybe AgentPublicKey))
-> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
forall a b. (a -> b) -> a -> b
$ AgentPublicKey -> Maybe AgentPublicKey
forall a. a -> Maybe a
Just AgentPublicKey
resPkPtr
        else Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AgentPublicKey
forall a. Maybe a
Nothing

-- | Return the comment from the given agent public key.
agentPublicKeyComment :: AgentPublicKey -> IO BSS.ByteString
agentPublicKeyComment :: AgentPublicKey -> IO ByteString
agentPublicKeyComment AgentPublicKey
pk = do
  AgentPublicKey
-> (Ptr AgentPublicKey -> IO ByteString) -> IO ByteString
forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey AgentPublicKey
pk ((Ptr AgentPublicKey -> IO ByteString) -> IO ByteString)
-> (Ptr AgentPublicKey -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr AgentPublicKey
pkPtr -> do
    CString
c <- (\Ptr AgentPublicKey
ptr -> do {Ptr AgentPublicKey -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AgentPublicKey
ptr Int
32 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr AgentPublicKey
pkPtr
    CString -> IO ByteString
BSS.packCString CString
c

-- | Return the bytes of the given agent public key.
agentPublicKeyBlob :: AgentPublicKey -> IO BSS.ByteString
agentPublicKeyBlob :: AgentPublicKey -> IO ByteString
agentPublicKeyBlob AgentPublicKey
pk = do
  AgentPublicKey
-> (Ptr AgentPublicKey -> IO ByteString) -> IO ByteString
forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey AgentPublicKey
pk ((Ptr AgentPublicKey -> IO ByteString) -> IO ByteString)
-> (Ptr AgentPublicKey -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr AgentPublicKey
pkPtr -> do
    Ptr CUChar
blobPtr <- (\Ptr AgentPublicKey
ptr -> do {Ptr AgentPublicKey -> Int -> IO (Ptr CUChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AgentPublicKey
ptr Int
16 :: IO (C2HSImp.Ptr C2HSImp.CUChar)}) Ptr AgentPublicKey
pkPtr
    CULong
blobLen <- (\Ptr AgentPublicKey
ptr -> do {Ptr AgentPublicKey -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AgentPublicKey
ptr Int
24 :: IO C2HSImp.CULong}) Ptr AgentPublicKey
pkPtr
    CStringLen -> IO ByteString
BSS.packCStringLen (Ptr CUChar -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
blobPtr, CULong -> Int
forall a. Enum a => a -> Int
fromEnum CULong
blobLen)

-- | Perform agent based public key authentication.
-- You almost certainly want @agentAuthenticate instead of this, since this
-- only does one round of authentication with the agent.
agentUserAuth :: Agent          -- ^ Agent handle.
              -> String         -- ^ Username to authenticate with.
              -> AgentPublicKey -- ^ Public key to use from the agent.
              -> IO ()
agentUserAuth :: Agent -> String -> AgentPublicKey -> IO ()
agentUserAuth Agent
agent String
username AgentPublicKey
key = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> (IO Int -> IO Int) -> IO Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Agent -> IO Int -> IO Int
forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (Agent -> Maybe Agent
forall a. a -> Maybe a
Just Agent
agent) (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Agent -> String -> AgentPublicKey -> IO Int
agentUserAuth_ Agent
agent String
username AgentPublicKey
key

agentUserAuth_ :: (Agent) -> (String) -> (AgentPublicKey) -> IO ((Int))
agentUserAuth_ :: Agent -> String -> AgentPublicKey -> IO Int
agentUserAuth_ Agent
a1 String
a2 AgentPublicKey
a3 =
  let {a1' :: Ptr ()
a1' = Agent -> Ptr ()
forall p. ToPointer p => p -> Ptr ()
toPointer Agent
a1} in 
  String -> (CString -> IO Int) -> IO Int
forall a. String -> (CString -> IO a) -> IO a
C2HSImp.withCString String
a2 ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \CString
a2' -> 
  AgentPublicKey -> (Ptr () -> IO Int) -> IO Int
forall a. AgentPublicKey -> (Ptr () -> IO a) -> IO a
withAgentPublicKeyVoidPtr AgentPublicKey
a3 ((Ptr () -> IO Int) -> IO Int) -> (Ptr () -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a3' -> 
  Ptr () -> CString -> Ptr () -> IO CInt
agentUserAuth_'_ Ptr ()
a1' CString
a2' Ptr ()
a3' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | Authenticate with an ssh agent.
-- Takes a user and an agent and tries each key from the agent in succession.
-- Throws AUTHENTICATION_FAILED if it's unable to authenticate.
-- If you call this, you need to call @agentListIdentities at least once.
agentAuthenticate :: String -- ^ Remote user name.
                  -> Agent  -- ^ Connection to an agent.
                  -> IO ()
agentAuthenticate :: String -> Agent -> IO ()
agentAuthenticate String
login Agent
agent = do
  Maybe AgentPublicKey
firstKey <- Agent -> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity Agent
agent Maybe AgentPublicKey
forall a. Maybe a
Nothing
  String -> Agent -> Maybe AgentPublicKey -> IO ()
agentAuthenticate' String
login Agent
agent Maybe AgentPublicKey
firstKey
  where
      agentAuthenticate' :: String -> Agent -> Maybe AgentPublicKey -> IO ()
agentAuthenticate' String
_ Agent
_ Maybe AgentPublicKey
Nothing = ErrorCode -> IO ()
forall a e. Exception e => e -> a
throw ErrorCode
AUTHENTICATION_FAILED
      agentAuthenticate' String
u Agent
a (Just AgentPublicKey
k) = do
          Either () ()
r <- (ErrorCode -> Maybe ()) -> IO () -> IO (Either () ())
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust ErrorCode -> Maybe ()
isAuthenticationFailed (Agent -> String -> AgentPublicKey -> IO ()
agentUserAuth Agent
a String
u AgentPublicKey
k)
          case Either () ()
r of
              Left ()
_ -> do
                  Maybe AgentPublicKey
nextKey <- Agent -> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity Agent
a (Maybe AgentPublicKey -> IO (Maybe AgentPublicKey))
-> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
forall a b. (a -> b) -> a -> b
$ AgentPublicKey -> Maybe AgentPublicKey
forall a. a -> Maybe a
Just AgentPublicKey
k
                  String -> Agent -> Maybe AgentPublicKey -> IO ()
agentAuthenticate' String
u Agent
a Maybe AgentPublicKey
nextKey
              Right ()
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      isAuthenticationFailed :: ErrorCode -> Maybe ()
isAuthenticationFailed ErrorCode
AUTHENTICATION_FAILED = () -> Maybe ()
forall a. a -> Maybe a
Just ()
      isAuthenticationFailed ErrorCode
_ = Maybe ()
forall a. Maybe a
Nothing

withAgentPublicKeyVoidPtr :: AgentPublicKey -> (Ptr () -> IO a) -> IO a
withAgentPublicKeyVoidPtr :: AgentPublicKey -> (Ptr () -> IO a) -> IO a
withAgentPublicKeyVoidPtr AgentPublicKey
p Ptr () -> IO a
f = AgentPublicKey -> (Ptr AgentPublicKey -> IO a) -> IO a
forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey AgentPublicKey
p ((Ptr AgentPublicKey -> IO a) -> IO a)
-> (Ptr AgentPublicKey -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr AgentPublicKey
pp -> Ptr () -> IO a
f (Ptr AgentPublicKey -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr AgentPublicKey
pp)

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"
  session_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_direct_tcpip_ex"
  directTcpIpEx_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (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))))

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

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

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

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

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

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

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