~jack/libtelnet-haskell

ref: 435aa32599e2e9c1c4195732f05e960697c58058 libtelnet-haskell/src/Network/Telnet/LibTelnet/Types.hsc -rw-r--r-- 10.8 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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RecordWildCards            #-}

-- | Wrapping of @libtelnet@ types.

module Network.Telnet.LibTelnet.Types where

import Network.Telnet.LibTelnet.Iac
import Network.Telnet.LibTelnet.Options

import Control.Exception (Exception, throwIO)
import Data.Typeable (Typeable)
import Foreign
import Foreign.C
import GHC.Generics (Generic)

#include <libtelnet.h>

-- | Uninhabited type for pointer safety (@telnet_t@).
data TelnetT

-- | Exceptions thrown by the binding, for when something has gone
-- seriously wrong. Errors detected by @libtelnet@ are not thrown but
-- instead are passed to the event handler.
data TelnetException
  = NullTelnetPtr
  | UnexpectedEventType TelnetEventTypeT
  | UnexpectedEnvironCmd ECmd
  | UnexpectedEnvironVar EVar
  | UnexpectedTerminalTypeCmd TCmd
  deriving (Eq, Generic, Show, Typeable)

instance Exception TelnetException

-- | Flags for @telnet_init@.
newtype Flag = Flag { unFlag :: CUChar }
#{enum Flag, Flag
 , flagProxy = TELNET_FLAG_PROXY
 }

-- | Wraps @telnet_telopt_t@.
data TelnetTeloptT = TelnetTeloptT
  { _telopt :: CShort -- ^ option value
  , _us :: Iac -- ^ option supported on server
  , _him :: Iac -- ^ allow clients to use the option?
  }

instance Storable TelnetTeloptT where
  sizeOf _ = (#size telnet_telopt_t)
  alignment _ = (#alignment telnet_telopt_t)

  peek p = do
    telopt <- (#peek telnet_telopt_t, telopt) p
    us <- (#peek telnet_telopt_t, us) p
    him <- (#peek telnet_telopt_t, him) p

    pure $ TelnetTeloptT telopt us him

  poke p TelnetTeloptT{..} = do
    (#poke telnet_telopt_t, telopt) p _telopt
    (#poke telnet_telopt_t, us) p _us
    (#poke telnet_telopt_t, him) p _him

-- | Wraps @telnet_event_t@.
data EventT
  = Data (CString, CSize) -- ^ 'eventData'
  | Send (CString, CSize) -- ^ 'eventSend'
  | Warning ErrorT -- ^ 'eventWarning'
  | Error ErrorT -- ^ 'eventError'
  | Command Iac -- ^ 'eventIac'
  | Will Option -- ^ 'eventWill'
  | Wont Option -- ^ 'eventWont'
  | Do Option -- ^ 'eventDo'
  | Dont Option -- ^ 'eventDont'
  | Subnegotiation Option (CString, CSize) -- ^ 'eventSubnegotiation'
  | Zmp (Ptr CString, CSize) -- ^ 'eventZmp'
  | TerminalType TCmd CString -- ^ 'eventTType'
  | Compress CUChar -- ^ 'eventCompress'
  | Environ ECmd (Ptr TelnetEnvironT, CSize) -- ^ 'eventEnviron'
  | Mssp (Ptr TelnetEnvironT, CSize) -- ^ 'eventMssp'

instance Storable EventT where
  sizeOf _ = (#size telnet_event_t)
  alignment _ = (#alignment telnet_event_t)

  peek p = do
    eType <- (#peek telnet_event_t, type) p
    if | eType `elem` [eventData, eventSend] -> do
           ctor <- if | eType == eventData -> pure Data
                      | eType == eventSend -> pure Send
                      | otherwise -> throwIO $ UnexpectedEventType eType
           buffer <- (#peek telnet_event_t, data.buffer) p
           size <- (#peek telnet_event_t, data.size) p
           pure $ ctor (buffer, size)

       | eType `elem` [eventWarning, eventError] -> do
           ctor <- if | eType == eventWarning -> pure Warning
                      | eType == eventError -> pure Error
                      | otherwise -> throwIO $ UnexpectedEventType eType
           file <- (#peek telnet_event_t, error.file) p
           func <- (#peek telnet_event_t, error.func) p
           msg <- (#peek telnet_event_t, error.msg) p
           line <- (#peek telnet_event_t, error.line) p
           errcode <- (#peek telnet_event_t, error.errcode) p

           pure . ctor $ ErrorT file func msg line errcode

       | eType == eventIac ->
           Command <$> (#peek telnet_event_t, iac.cmd) p

       | eType `elem` [eventWill, eventWont, eventDo, eventDont] -> do
           ctor <- if | eType == eventWill -> pure Will
                      | eType == eventWont -> pure Wont
                      | eType == eventDo -> pure Do
                      | eType == eventDont -> pure Dont
                      | otherwise -> throwIO $ UnexpectedEventType eType
           ctor <$> (#peek telnet_event_t, neg.telopt) p

       | eType == eventSubnegotiation -> do
           telopt <- (#peek telnet_event_t, sub.telopt) p
           buffer <- (#peek telnet_event_t, sub.buffer) p
           size <- (#peek telnet_event_t, sub.size) p

           pure $ Subnegotiation telopt (buffer, size)

       | eType == eventZmp -> do
           argc <- (#peek telnet_event_t, zmp.argc) p
           argv <- (#peek telnet_event_t, zmp.argv) p

           pure $ Zmp (argv, argc)

       | eType == eventTType -> do
           cmd <- (#peek telnet_event_t, ttype.cmd) p
           name <- (#peek telnet_event_t, ttype.name) p

           pure $ TerminalType cmd name

       | eType == eventCompress ->
           Compress <$> (#peek telnet_event_t, compress.state) p

       | eType == eventEnviron -> do
           cmd <- (#peek telnet_event_t, environ.cmd) p
           values <- (#peek telnet_event_t, environ.values) p
           size <- (#peek telnet_event_t, environ.size) p

           pure $ Environ cmd (values, size)

       | eType == eventMssp -> do
           values <- (#peek telnet_event_t, mssp.values) p
           size <- (#peek telnet_event_t, mssp.size) p

           pure $ Mssp (values, size)

       | otherwise -> throwIO $ UnexpectedEventType eType

  poke p (Data (buffer, size)) = do
    (#poke telnet_event_t, type) p eventData
    (#poke telnet_event_t, data.buffer) p buffer
    (#poke telnet_event_t, data.size) p size

  poke p (Send (buffer, size)) = do
    (#poke telnet_event_t, type) p eventSend
    (#poke telnet_event_t, data.buffer) p buffer
    (#poke telnet_event_t, data.size) p size

  poke p (Warning ErrorT{..}) = do
    (#poke telnet_event_t, type) p eventWarning
    (#poke telnet_event_t, error.file) p _file
    (#poke telnet_event_t, error.func) p _func
    (#poke telnet_event_t, error.msg) p _msg
    (#poke telnet_event_t, error.line) p _line
    (#poke telnet_event_t, error.errcode) p _errcode

  poke p (Error ErrorT{..}) = do
    (#poke telnet_event_t, type) p eventError
    (#poke telnet_event_t, error.file) p _file
    (#poke telnet_event_t, error.func) p _func
    (#poke telnet_event_t, error.msg) p _msg
    (#poke telnet_event_t, error.line) p _line
    (#poke telnet_event_t, error.errcode) p _errcode

  poke p (Command cmd) = do
    (#poke telnet_event_t, type) p eventIac
    (#poke telnet_event_t, iac.cmd) p cmd

  poke p (Will opt) = do
    (#poke telnet_event_t, type) p eventWill
    (#poke telnet_event_t, neg.telopt) p opt

  poke p (Wont opt) = do
    (#poke telnet_event_t, type) p eventWont
    (#poke telnet_event_t, neg.telopt) p opt

  poke p (Do opt) = do
    (#poke telnet_event_t, type) p eventDo
    (#poke telnet_event_t, neg.telopt) p opt

  poke p (Dont opt) = do
    (#poke telnet_event_t, type) p eventDont
    (#poke telnet_event_t, neg.telopt) p opt

  poke p (Subnegotiation opt (buffer, size)) = do
    (#poke telnet_event_t, type) p eventSubnegotiation
    (#poke telnet_event_t, sub.telopt) p opt
    (#poke telnet_event_t, sub.buffer) p buffer
    (#poke telnet_event_t, sub.size) p size

  poke p (Zmp (argv, argc)) = do
    (#poke telnet_event_t, type) p eventZmp
    (#poke telnet_event_t, zmp.argv) p argv
    (#poke telnet_event_t, zmp.argc) p argc

  poke p (TerminalType cmd name) = do
    (#poke telnet_event_t, type) p eventTType
    (#poke telnet_event_t, ttype.cmd) p cmd
    (#poke telnet_event_t, ttype.name) p name

  poke p (Compress state) = do
    (#poke telnet_event_t, type) p eventCompress
    (#poke telnet_event_t, compress.state) p state

  poke p (Environ cmd (values, size)) = do
    (#poke telnet_event_t, type) p eventEnviron
    (#poke telnet_event_t, environ.cmd) p cmd
    (#poke telnet_event_t, environ.values) p values
    (#poke telnet_event_t, environ.size) p size

  poke p (Mssp (values, size)) = do
    (#poke telnet_event_t, type) p eventMssp
    (#poke telnet_event_t, mssp.values) p values
    (#poke telnet_event_t, mssp.size) p size

-- | Constants from @telnet_event_type_t@.
newtype TelnetEventTypeT = TelnetEventTypeT { unTelnetEventTypeT :: CInt }
  deriving (Eq, Show, Storable)
#{enum TelnetEventTypeT, TelnetEventTypeT
 , eventData = TELNET_EV_DATA
 , eventSend = TELNET_EV_SEND
 , eventIac = TELNET_EV_IAC
 , eventWill = TELNET_EV_WILL
 , eventWont = TELNET_EV_WONT
 , eventDo = TELNET_EV_DO
 , eventDont = TELNET_EV_DONT
 , eventSubnegotiation = TELNET_EV_SUBNEGOTIATION
 , eventCompress = TELNET_EV_COMPRESS
 , eventZmp = TELNET_EV_ZMP
 , eventTType = TELNET_EV_TTYPE
 , eventEnviron = TELNET_EV_ENVIRON
 , eventMssp = TELNET_EV_MSSP
 , eventWarning = TELNET_EV_WARNING
 , eventError = TELNET_EV_ERROR
 }

-- | Data in 'Warning' and 'Error' events, modeled after @struct
-- error_t@ inside @telnet_event_t@.
data ErrorT = ErrorT
  { _file :: CString
  , _func :: CString
  , _msg :: CString
  , _line :: CInt
  , _errcode :: TelnetErrorT
  }

-- | Constants from @telnet_error_t@.
newtype TelnetErrorT = TelnetErrorT { unTelnetErrorT :: CInt }
  deriving (Eq, Show, Storable)
#{enum TelnetErrorT, TelnetErrorT
 , errOK = TELNET_EOK
 , errBadVal = TELNET_EBADVAL
 , errNoMem = TELNET_ENOMEM
 , errOverflow = TELNET_EOVERFLOW
 , errProtocol = TELNET_EPROTOCOL
 , errCompress = TELNET_ECOMPRESS
 }

-- | Constants for @TERMINAL-TYPE@ commands.
newtype TCmd = TCmd { unTCmd :: CUChar } deriving (Eq, Show, Storable)
#{enum TCmd, TCmd
 , tCmdIs = TELNET_TTYPE_IS
 , tCmdSend = TELNET_TTYPE_SEND
 }

-- | Constants for @ENVIRON@/@NEW-ENVIRON@ commands.
newtype ECmd = ECmd { unECmd :: CUChar } deriving (Eq, Show, Storable)
#{enum ECmd, ECmd
 , eCmdIs = TELNET_ENVIRON_IS
 , eCmdSend = TELNET_ENVIRON_SEND
 , eCmdInfo = TELNET_ENVIRON_INFO
 }

-- | Constants for @ENVIRON@/@NEW-ENVIRON@ variables.
newtype EVar = EVar { unEvar :: CUChar } deriving (Eq, Show, Storable)
#{enum EVar, EVar
 , eVar = TELNET_ENVIRON_VAR
 , eValue = TELNET_ENVIRON_VALUE
 , eUserVar = TELNET_ENVIRON_USERVAR
 }

-- | Constants for MSSP.
newtype MsspVar = MsspVar { unMsspVar :: CUChar } deriving (Eq, Show, Storable)
#{enum MsspVar, MsspVar
 , msspVar = TELNET_MSSP_VAR
 , msspVal = TELNET_MSSP_VAL
 }

-- | @ENVIRONMENT@\/@NEW-ENVIRONMENT@\/@MSSP@ messages, wrapping
-- @telnet_environ_t@.
data TelnetEnvironT = TelnetEnvironT
  { _type :: EVar -- ^ @unsigned char type@
  , _var :: CString -- ^ @char *var@
  , _value :: CString -- ^ @char *value@
  }

instance Storable TelnetEnvironT where
  sizeOf _ = (#size struct telnet_environ_t)
  alignment _ = (#alignment struct telnet_environ_t)

  peek p = do
    type_ <- (#peek struct telnet_environ_t, type) p
    var <- (#peek struct telnet_environ_t, var) p
    value <- (#peek struct telnet_environ_t, value) p

    pure $ TelnetEnvironT type_ var value

  poke p TelnetEnvironT{..} = do
    (#poke struct telnet_environ_t, type) p _type
    (#poke struct telnet_environ_t, var) p _var
    (#poke struct telnet_environ_t, value) p _value