~jack/libtelnet-haskell

ref: 435aa32599e2e9c1c4195732f05e960697c58058 libtelnet-haskell/src/Network/Telnet/LibTelnet/Ffi.hsc -rw-r--r-- 5.4 KiB
435aa325Jack Kelly Fix comment typo 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
-- | FFI binding to @libtelnet@.

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