2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
4 % Last Modified: Fri Jul 21 12:08:19 1995
5 % Darren J Moffat <moffatd@dcs.gla.ac.uk>
6 \section[BSD]{Misc BSD bindings}
21 getHostName, -- :: IO String
22 -- select, -- :: SelectData -> IO (Maybe SelectData)
24 getServiceByName, -- :: ServiceName -> IO ServiceEntry
25 getServicePortNumber, -- :: ServiceName -> IO PortNumber
26 getServiceEntry, -- :: IO ServiceEntry
27 setServiceEntry, -- :: Bool -> IO ()
28 endServiceEntry, -- :: IO ()
30 getProtocolByName, -- :: ProtocolName -> IO ProtocolEntry
31 getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry
32 getProtocolNumber, -- :: ProtocolName -> ProtocolNumber
33 getProtocolEntry, -- :: IO ProtocolEntry
34 setProtocolEntry, -- :: Bool -> IO ()
35 endProtocolEntry, -- :: IO ()
37 getHostByName, -- :: HostName -> IO HostEntry
38 getHostByAddr, -- :: Family -> HostAddress -> IO HostEntry
39 getHostEntry, -- :: IO HostEntry
40 setHostEntry, -- :: Bool -> IO ()
41 endHostEntry, -- :: IO ()
43 -- make interface self-sufficient:
55 %***************************************************************************
57 \subsection[BSD-DBTypes]{Service, Protocol \& Host Database Types}
59 %***************************************************************************
63 type HostName = String
64 type ProtocolName = String
65 type ProtocolNumber = Int
66 type ServiceName = String
68 data ProtocolEntry = ProtocolEntry
69 ProtocolName -- Official Name
70 [ProtocolName] -- Set of Aliases
71 Int -- Protocol Number
73 data ServiceEntry = ServiceEntry
74 ServiceName -- Official Name
75 [ServiceName] -- Set of Aliases
76 PortNumber -- Port Number
77 ProtocolName -- Protocol
79 data HostEntry = HostEntry
80 HostName -- Official Name
81 [HostName] -- Set of Aliases
82 Family -- Host Type (currently AF_INET)
83 [HostAddress] -- Set of Network Addresses
88 %***************************************************************************
90 \subsection[LibSocket-DBAccess]{Service, Protocol Host Database Access}
92 %***************************************************************************
96 Calling $getServiceByName$ for a given service and protocol returns the
97 systems service entry. This should be used to find the port numbers
98 for standard protocols such as smtp and FTP. The remaining three
99 functions should be used for browsing the service database
102 Calling $setServiceEntry$ with $True$ indicates that the service
103 database should be left open between calls to $getServiceEntry$. To
104 close the database a call to $endServiceEntry$ is required. This
105 database file is usually stored in the file /etc/services.
109 getServiceByName :: ServiceName -> -- Service Name
110 ProtocolName -> -- Protocol Name
111 IO ServiceEntry -- Service Entry
112 getServiceByName name proto =
113 _ccall_ getservbyname name proto `thenPrimIO` \ ptr ->
114 if ptr == ``NULL'' then
115 failWith (NoSuchThing "no such service entry")
117 unpackServiceEntry ptr `thenPrimIO` \ servent ->
120 getServiceByPort :: PortNumber ->
123 getServiceByPort port proto =
124 _ccall_ getservbyport port proto `thenPrimIO` \ ptr ->
125 if ptr == ``NULL'' then
126 failWith (NoSuchThing "no such service entry")
128 unpackServiceEntry ptr `thenPrimIO` \ servent ->
131 getServicePortNumber :: ServiceName -> IO PortNumber
132 getServicePortNumber name =
133 getServiceByName name "tcp" >>= \ (ServiceEntry _ _ port _) ->
136 getServiceEntry :: IO ServiceEntry
138 _ccall_ getservent `thenPrimIO` \ ptr ->
139 if ptr == ``NULL'' then
140 failWith (NoSuchThing "no such service entry")
142 unpackServiceEntry ptr `thenPrimIO` \ servent ->
145 setServiceEntry :: Bool -> IO ()
146 setServiceEntry True = primIOToIO (_ccall_ setservent 1)
147 setServiceEntry False = primIOToIO (_ccall_ setservent 0)
149 endServiceEntry :: IO ()
150 endServiceEntry = primIOToIO (_ccall_ endservent)
154 The following relate directly to the corresponding UNIX C calls for
155 returning the protocol entries. The protocol entry is represented by
156 the Haskell type type ProtocolEntry = (String, [String], Int).
158 As for $setServiceEntry$ above, calling $setProtocolEntry$.
159 determines whether or not the protocol database file, usually
160 /etc/protocols, is to be kept open between calls of
164 getProtocolByName :: ProtocolName -> -- Protocol Name
165 IO ProtocolEntry -- Protocol Entry
166 getProtocolByName name =
167 _ccall_ getprotobyname name `thenPrimIO` \ ptr ->
168 if ptr == ``NULL'' then
169 failWith (NoSuchThing "no such protocol entry")
171 unpackProtocolEntry ptr `thenPrimIO` \ protoent ->
174 getProtocolByNumber :: PortNumber -> -- Protocol Number
175 IO ProtocolEntry -- Protocol Entry
176 getProtocolByNumber num =
177 _ccall_ getprotobynumber num `thenPrimIO` \ ptr ->
178 if ptr == ``NULL'' then
179 failWith (NoSuchThing "no such protocol entry")
181 unpackProtocolEntry ptr `thenPrimIO` \ protoent ->
184 getProtocolNumber :: ProtocolName -> IO ProtocolNumber
185 getProtocolNumber proto =
186 getProtocolByName proto >>= \ (ProtocolEntry _ _ num) ->
189 getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
191 _ccall_ getprotoent `thenPrimIO` \ ptr ->
192 if ptr == ``NULL'' then
193 failWith (NoSuchThing "no such protocol entry")
195 unpackProtocolEntry ptr `thenPrimIO` \ protoent ->
198 setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
199 setProtocolEntry True = primIOToIO (_ccall_ setprotoent 1)
200 setProtocolEntry False = primIOToIO (_ccall_ setprotoent 0)
202 endProtocolEntry :: IO ()
203 endProtocolEntry = primIOToIO (_ccall_ endprotoent)
211 getHostByName :: HostName -> IO HostEntry
213 _ccall_ gethostbyname name `thenPrimIO` \ ptr ->
214 if ptr == ``NULL'' then
215 failWith (NoSuchThing "no such host entry")
217 unpackHostEntry ptr `thenPrimIO` \ hostent ->
220 getHostByAddr :: Family -> HostAddress -> IO HostEntry
221 getHostByAddr family addr =
222 _casm_ ``%r = gethostbyaddr (%0, sizeof(%0), %1);''
223 addr (packFamily family) `thenPrimIO` \ ptr ->
224 if ptr == ``NULL'' then
225 failWith (NoSuchThing "no such host entry")
227 unpackHostEntry ptr `thenPrimIO` \ hostent ->
230 getHostEntry :: IO HostEntry
232 _ccall_ gethostent `thenPrimIO` \ ptr ->
233 if ptr == ``NULL'' then
234 failWith (NoSuchThing "no such host entry")
236 unpackHostEntry ptr `thenPrimIO` \ hostent ->
239 setHostEntry :: Bool -> IO ()
240 setHostEntry True = primIOToIO (_ccall_ sethostent 1)
241 setHostEntry False = primIOToIO (_ccall_ sethostent 0)
243 endHostEntry :: IO ()
244 endHostEntry = primIOToIO (_ccall_ endprotoent)
248 %***************************************************************************
250 \subsection[BSD-Misc]{Miscellaneous Functions}
252 %***************************************************************************
255 The $select$ call is is used to make the process sleep until at least
256 one of the given handles, is ready for reading, writing or has had an
257 exception condition raised against it. The handles which are ready are
258 returned in $SelectData$.
260 Select will also return after the given timeout, which is given in
261 nanoseconds, has expired. In this case $Nothing$ is returned.
263 There is no provision of checking the amount of time remaining since
264 the $select$ system call does not make this information available on
265 all systems. Some always return a zero timeout where others return
268 Possible return values from select are then:
270 \item ([Handle], [Handle], [Handle], Nothing)
276 type SelectData = ([Handle], -- Read Handles
277 [Handle], -- Write Handles
278 [Handle], -- Exception Handles
279 Maybe Integer) -- Timeout
280 select :: SelectData -> IO (Maybe SelectData)
285 Calling $getHostName$ returns the standard host name for the current
286 processor, as set at boot time.
290 getHostName :: IO HostName
292 newCharArray (0,256) `thenPrimIO` \ ptr ->
293 _casm_ ``%r = gethostname(%0, 256);'' ptr `seqPrimIO`
294 mutByteArr2Addr ptr `thenPrimIO` \ ptr' ->
295 if ptr' == ``NULL'' then
296 fail "getHostName: unable to determine hostname"
298 return (_unpackPS (_packCString ptr'))
305 char *s_name; /* official name of service */
306 char **s_aliases; /* alias list */
307 int s_port; /* port service resides at */
308 char *s_proto; /* protocol to use */
311 The members of this structure are:
312 s_name The official name of the service.
313 s_aliases A zero terminated list of alternate
314 names for the service.
315 s_port The port number at which the ser-
316 vice resides. Port numbers are
317 returned in network short byte
319 s_proto The name of the protocol to use
320 when contacting the service.
324 unpackServiceEntry :: _Addr -> PrimIO ServiceEntry
325 unpackServiceEntry ptr =
326 _casm_ ``%r = ((struct servent*)%0)->s_name;'' ptr
327 `thenPrimIO` \ str ->
328 strcpy str `thenPrimIO` \ name ->
329 _casm_ ``%r = ((struct servent*)%0)->s_aliases;'' ptr
330 `thenPrimIO` \ alias ->
331 unvectorize alias 0 `thenStrictlyST` \ aliases ->
332 _casm_ ``%r = ((struct servent*)%0)->s_port;'' ptr
333 `thenPrimIO` \ port ->
334 _casm_ ``%r = ((struct servent*)%0)->s_proto;'' ptr
335 `thenPrimIO` \ str ->
336 strcpy str `thenPrimIO` \ proto ->
338 returnPrimIO (ServiceEntry name aliases port proto)
340 -------------------------------------------------------------------------------
342 unpackProtocolEntry :: _Addr -> PrimIO ProtocolEntry
343 unpackProtocolEntry ptr =
344 _casm_ ``%r = ((struct protoent*)%0)->p_name;'' ptr
345 `thenPrimIO` \ str ->
346 strcpy str `thenPrimIO` \ name ->
347 _casm_ ``%r = ((struct protoent*)%0)->p_aliases;'' ptr
348 `thenPrimIO` \ alias ->
349 unvectorize alias 0 `thenStrictlyST` \ aliases ->
350 _casm_ ``%r = ((struct protoent*)%0)->p_proto;'' ptr
351 `thenPrimIO` \ proto ->
353 returnPrimIO (ProtocolEntry name aliases proto)
356 -------------------------------------------------------------------------------
358 unpackHostEntry :: _Addr -> PrimIO HostEntry
359 unpackHostEntry ptr =
360 _casm_ ``%r = ((struct hostent*)%0)->h_name;'' ptr
361 `thenPrimIO` \ str ->
362 strcpy str `thenPrimIO` \ name ->
363 _casm_ ``%r = ((struct hostent*)%0)->h_aliases;'' ptr
364 `thenPrimIO` \ alias ->
365 unvectorize alias 0 `thenStrictlyST` \ aliases ->
366 {- _casm_ ``%r = ((struct hostent*)%0)->h_addr_list;'' ptr
367 `thenPrimIO` \ addrs ->
368 unvectorizeHostAddrs addrs 0 `thenStrictlyST` \ addrList ->
369 -} unvectorizeHostAddrs ptr 0 `thenStrictlyST` \ addrList ->
370 returnPrimIO (HostEntry name aliases AF_INET addrList)
372 -------------------------------------------------------------------------------
374 unvectorizeHostAddrs :: _Addr -> Int -> PrimIO [_Word]
375 unvectorizeHostAddrs ptr n
376 | str == ``NULL'' = returnPrimIO []
378 _casm_ ``{ u_long tmp;
379 if ((((struct hostent*)%0)->h_addr_list[(int)%1]) == NULL)
382 tmp = (W_)ntohl(((struct in_addr *)(((struct hostent*)%0)->h_addr_list[(int)%1]))->s_addr);
384 ptr n `thenPrimIO` \ x ->
385 unvectorizeHostAddrs ptr (n+1) `thenPrimIO` \ xs ->
386 returnPrimIO (x : xs)
387 where str = indexAddrOffAddr ptr n
390 unvectorizeHostAddrs :: _Addr -> Int -> PrimIO [_Word]
391 unvectorizeHostAddrs ptr n
392 | str == ``NULL'' = returnPrimIO []
394 _casm_ ``%r = (W_)ntohl(((struct hostent*)%0)->h_addr_list[(int)%1]);''
395 ptr n `thenPrimIO` \ x ->
396 unvectorizeHostAddrs ptr (n+1) `thenPrimIO` \ xs ->
397 returnPrimIO (x : xs)
398 where str = indexAddrOffAddr ptr n
400 -------------------------------------------------------------------------------
402 mutByteArr2Addr :: _MutableByteArray _RealWorld Int -> PrimIO _Addr
403 mutByteArr2Addr arr = _casm_ `` %r=(void *)%0; '' arr