~jack/libtelnet-haskell

ref: 6a8d7db4d1faac82a15e2d9905dd61d5f13d8471 libtelnet-haskell/src/Network/Telnet/LibTelnet/Ffi.hsc -rw-r--r-- 5.7 KiB
6a8d7db4Jack Kelly Documentation updates 2 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
{-|
Module      : Network.Telnet.LibTelnet.Ffi
Description : Low-level FFI binding
Copyright   : (c) 2017-2019 Jack Kelly
License     : GPL-3.0-or-later
Maintainer  : jack@jackkelly.name
Stability   : experimental
Portability : non-portable

FFI binding to @libtelnet@. The vast majority of these functions are
generated from @foreign import@ declarations.
-}

module Network.Telnet.LibTelnet.Ffi where

import           Network.Telnet.LibTelnet.Iac (Iac(..), iacNull)
import           Network.Telnet.LibTelnet.Options (Option(..))
import qualified Network.Telnet.LibTelnet.Types as T

import           Control.Exception (throwIO)
import           Control.Monad (when)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import           Data.List (genericLength)
import           Foreign hiding (newForeignPtr)
import           Foreign.C (CSize(..), CString, CUChar(..))
import           Foreign.Concurrent (newForeignPtr)

#include <libtelnet.h>

-- | Wrap 'cTelnetInit'.
telnetInit
  :: [T.TelnetTeloptT]
  -> TelnetEventHandlerT
  -> [T.Flag]
  -> IO (ForeignPtr T.TelnetT)
telnetInit options handler flags = do
  optionsA <- newArray0 (T.TelnetTeloptT (-1) iacNull iacNull) options
  handlerP <- wrapEventHandler handler
  let flagsC = foldr ((.|.) . T.unFlag) 0 flags
  telnet <- cTelnetInit optionsA handlerP flagsC nullPtr
  when (telnet == nullPtr) $ throwIO T.NullTelnetPtr

  newForeignPtr telnet $ do
    cTelnetFree telnet
    freeHaskellFunPtr handlerP
    free optionsA

-- | C function @telnet_init@.
foreign import ccall "libtelnet.h telnet_init"
  cTelnetInit
    :: Ptr T.TelnetTeloptT -- ^ @const telnet_telopt_t *telopts@
    -> FunPtr TelnetEventHandlerT -- ^ @telnet_event_handler_t eh@
    -> CUChar -- ^ @unsigned char flags@
    -> Ptr () -- ^ @void *user_data@
    -> IO (Ptr T.TelnetT)

-- | C function @telnet_free@.
foreign import ccall "libtelnet.h telnet_free"
  cTelnetFree :: Ptr T.TelnetT -> IO ()

-- | Represents @telnet_event_handler_t@.
type TelnetEventHandlerT = Ptr T.TelnetT -> Ptr T.EventT -> Ptr () -> IO ()

-- | Wrap an 'TelnetEventHandlerT' to pass to C code.
foreign import ccall "wrapper"
  wrapEventHandler :: TelnetEventHandlerT -> IO (FunPtr TelnetEventHandlerT)

-- | Wrap 'cTelnetRecv'.
telnetRecv :: Ptr T.TelnetT -> ByteString -> IO ()
telnetRecv telnetP bs = B.useAsCStringLen bs $
    \(buffer, size) -> cTelnetRecv telnetP buffer $ fromIntegral size

-- | C function @telnet_recv@.
foreign import ccall "libtelnet.h telnet_recv"
  cTelnetRecv
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> CString -- ^ @const char *buffer@
    -> CSize -- ^ @size_t size@
    -> IO ()

-- | C function @telnet_iac@.
foreign import ccall "libtelnet.h telnet_iac"
  cTelnetIac
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> Iac -- ^ @unsigned char cmd@
    -> IO ()

-- | C function @telnet_negotiate@.
foreign import ccall "libtelnet.h telnet_negotiate"
  cTelnetNegotiate
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> Iac -- ^ unsigned char cmd
    -> Option -- ^ unsigned char opt
    -> IO ()

-- | Wrap 'cTelnetSend'.
telnetSend :: Ptr T.TelnetT -> ByteString -> IO ()
telnetSend telnetP bs = B.useAsCStringLen bs $
    \(buffer, size) -> cTelnetSend telnetP buffer $ fromIntegral size

-- | C function @telnet_send@.
foreign import ccall "libtelnet.h telnet_send"
  cTelnetSend
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> CString -- ^ @const char *buffer@
    -> CSize -- ^ @size_t size@
    -> IO ()

-- | Wrap 'cTelnetSubnegotiation'.
telnetSubnegotiation :: Ptr T.TelnetT -> Option -> ByteString -> IO ()
telnetSubnegotiation telnetP opt bs = B.useAsCStringLen bs $
    \(buffer, size) ->
      cTelnetSubnegotiation telnetP opt buffer $ fromIntegral size

-- | C function @telnet_subnegotiation@.
foreign import ccall "libtelnet.h telnet_subnegotiation"
  cTelnetSubnegotiation
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> Option -- ^ @unsigned char telopt@
    -> CString -- ^ @const char *buffer@
    -> CSize -- ^ @size_t size@
    -> IO ()

-- | C function @telnet_begin_compress2@.
foreign import ccall "libtelnet.h telnet_begin_compress2"
  cTelnetBeginCompress2
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> IO ()

-- | C function @telnet_begin_newenviron@.
foreign import ccall "libtelnet.h telnet_begin_newenviron"
  cTelnetBeginNewEnviron
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> T.ECmd -- ^ @unsigned char type@
    -> IO ()

-- | C function @telnet_newenviron_value@.
foreign import ccall "libtelnet.h telnet_newenviron_value"
  cTelnetNewEnvironValue
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> T.EVar -- ^ @unsigned char type@
    -> CString -- ^ @const char *string@
    -> IO ()

-- | C function @telnet_ttype_send@.
foreign import ccall "libtelnet.h telnet_ttype_send"
  cTelnetTTypeSend
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> IO ()

-- | C function @telnet_ttype_is@.
foreign import ccall "libtelnet.h telnet_ttype_is"
  cTelnetTTypeIs
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> CString -- ^ @const char *ttype@
    -> IO ()

-- | Wrap 'cTelnetSendZmp'.
telnetSendZmp :: Ptr T.TelnetT -> [ByteString] -> IO ()
telnetSendZmp telnetP cmd = useAsCStrings cmd $
    \cCmd -> cTelnetSendZmp telnetP (genericLength cmd) cCmd

-- | C function @telnet_send_zmp@.
foreign import ccall "libtelnet.h telnet_send_zmp"
  cTelnetSendZmp
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> CSize -- ^ @size_t argc@
    -> Ptr CString -- ^ @const char **argv@
    -> IO ()

-- | Collect '[ByteString]' into a temporary array of strings in a
-- 'Ptr CString', for passing to C functions.
useAsCStrings :: [ByteString] -> (Ptr CString -> IO a) -> IO a
useAsCStrings list f = go list [] where
  go [] css = withArray (reverse css) f
  go (bs:bss) css = B.useAsCString bs $ \cs -> go bss (cs:css)