2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1997
4 \section[BSD]{Misc BSD bindings}
6 The @BSD@ module defines Haskell bindings to network programming
7 functionality that is only provided by BSD-style APIs.
10 {-# OPTIONS -#include "cbits/ghcSockets.h" #-}
15 getHostName, -- :: IO HostName
18 getServiceByName, -- :: ServiceName -> IO ServiceEntry
19 getServicePortNumber, -- :: ServiceName -> IO PortNumber
22 getServiceEntry, -- :: IO ServiceEntry
23 setServiceEntry, -- :: Bool -> IO ()
24 endServiceEntry, -- :: IO ()
25 getServiceEntries, -- :: Bool -> IO [ServiceEntry]
29 getProtocolByName, -- :: ProtocolName -> IO ProtocolEntry
30 getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry
32 setProtocolEntry, -- :: Bool -> IO ()
33 getProtocolEntry, -- :: IO ProtocolEntry
34 endProtocolEntry, -- :: IO ()
35 getProtocolEntries, -- :: Bool -> IO [ProtocolEntry]
38 getProtocolNumber, -- :: ProtocolName -> ProtocolNumber
41 getHostByName, -- :: HostName -> IO HostEntry
42 getHostByAddr, -- :: HostAddress -> Family -> IO HostEntry
44 setHostEntry, -- :: Bool -> IO ()
45 getHostEntry, -- :: IO HostEntry
46 endHostEntry, -- :: IO ()
47 getHostEntries, -- :: Bool -> IO [HostEntry]
52 getNetworkByName, -- :: NetworkName -> IO NetworkEntry
53 getNetworkByAddr, -- :: NetworkAddr -> Family -> IO NetworkEntry
54 setNetworkEntry, -- :: Bool -> IO ()
55 getNetworkEntry, -- :: IO NetworkEntry
56 endNetworkEntry, -- :: IO ()
57 getNetworkEntries -- :: Bool -> IO [NetworkEntry]
68 import PackedString ( byteArrayToPS, unpackPS )
70 import PosixUtil ( strcpy, unvectorize )
76 %***************************************************************************
78 \subsection[BSD-DBTypes]{Service, Protocol \& Host Database Types}
80 %***************************************************************************
83 type HostName = String
84 type ProtocolName = String
85 type ProtocolNumber = Int
86 type ServiceName = String
91 ProtocolName -- Official Name
92 [ProtocolName] -- aliases
93 Int -- Protocol Number
97 ServiceName -- Official Name
98 [ServiceName] -- aliases
99 PortNumber -- Port Number
100 ProtocolName -- Protocol
104 HostName -- Official Name
105 [HostName] -- aliases
106 Family -- Host Type (currently AF_INET)
107 [HostAddress] -- Set of Network Addresses
111 %***************************************************************************
113 \subsection[BSD-DBAccess]{Service, Protocol Host Database Access}
115 %***************************************************************************
117 Calling @getServiceByName@ for a given service and protocol returns the
118 systems service entry. This should be used to find the port numbers
119 for standard protocols such as SMTP and FTP. The remaining three
120 functions should be used for browsing the service database
123 Calling @setServiceEntry@ with \tr{True} indicates that the service
124 database should be left open between calls to @getServiceEntry@. To
125 close the database a call to @endServiceEntry@ is required. This
126 database file is usually stored in the file /etc/services.
129 getServiceByName :: ServiceName -- Service Name
130 -> ProtocolName -- Protocol Name
131 -> IO ServiceEntry -- Service Entry
132 getServiceByName name proto = do
133 ptr <- _ccall_ getservbyname name proto
135 then fail (IOError Nothing NoSuchThing "no such service entry")
136 else unpackServiceEntry ptr
138 getServiceByPort :: PortNumber ->
141 getServiceByPort port proto = do
142 ptr <- _ccall_ getservbyport port proto
144 then fail (IOError Nothing NoSuchThing "no such service entry")
145 else unpackServiceEntry ptr
147 getServicePortNumber :: ServiceName -> IO PortNumber
148 getServicePortNumber name = do
149 (ServiceEntry _ _ port _) <- getServiceByName name "tcp"
152 getServiceEntry :: IO ServiceEntry
154 ptr <- _ccall_ getservent
156 then fail (IOError Nothing NoSuchThing "no such service entry")
157 else unpackServiceEntry ptr
159 setServiceEntry :: Bool -> IO ()
160 setServiceEntry flg = _ccall_ setservent stayOpen
161 where stayOpen = if flg then 1 else 0
163 endServiceEntry :: IO ()
164 endServiceEntry = _ccall_ endservent
166 getServiceEntries :: Bool -> IO [ServiceEntry]
167 getServiceEntries stayOpen = do
168 setServiceEntry stayOpen
169 getEntries (getServiceEntry) (endServiceEntry)
173 The following relate directly to the corresponding \tr{UNIX} {C} calls for
174 returning the protocol entries. The protocol entry is represented by
175 the Haskell type @ProtocolEntry@.
177 As for @setServiceEntry@ above, calling @setProtocolEntry@.
178 determines whether or not the protocol database file, usually
179 \tr{/etc/protocols}, is to be kept open between calls of
180 @getProtocolEntry@. Similarly,
183 getProtocolByName :: ProtocolName -> IO ProtocolEntry
184 getProtocolByNumber :: PortNumber -> IO ProtocolEntry
185 getProtocolNumber :: ProtocolName -> IO ProtocolNumber
187 setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
188 getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
189 endProtocolEntry :: IO ()
190 getProtocolEntries :: Bool -> IO [ProtocolEntry]
194 --getProtocolByName :: ProtocolName -> IO ProtocolEntry
195 getProtocolByName name = do
196 ptr <- _ccall_ getprotobyname name
197 if (ptr == ``NULL'' )
198 then fail (IOError Nothing NoSuchThing "no such protocol entry")
199 else unpackProtocolEntry ptr
201 --getProtocolByNumber :: PortNumber -> IO ProtocolEntry
202 getProtocolByNumber num = do
203 ptr <- _ccall_ getprotobynumber num
205 then fail (IOError Nothing NoSuchThing "no such protocol entry")
206 else unpackProtocolEntry ptr
208 --getProtocolNumber :: ProtocolName -> IO ProtocolNumber
209 getProtocolNumber proto = do
210 (ProtocolEntry _ _ num) <- getProtocolByName proto
213 --getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
214 getProtocolEntry = do
215 ptr <- _ccall_ getprotoent
217 then fail (IOError Nothing NoSuchThing "no such protocol entry")
218 else unpackProtocolEntry ptr
220 --setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
221 setProtocolEntry flg = _ccall_ setprotoent v
222 where v = if flg then 1 else 0
224 --endProtocolEntry :: IO ()
225 endProtocolEntry = _ccall_ endprotoent
227 --getProtocolEntries :: Bool -> IO [ProtocolEntry]
228 getProtocolEntries stayOpen = do
229 setProtocolEntry stayOpen
230 getEntries (getProtocolEntry) (endProtocolEntry)
235 getHostByName :: HostName -> IO HostEntry
236 getHostByName name = do
237 ptr <- _ccall_ gethostbyname name
239 then fail (IOError Nothing NoSuchThing "no such host entry")
240 else unpackHostEntry ptr
242 getHostByAddr :: Family -> HostAddress -> IO HostEntry
243 getHostByAddr family addr = do
244 ptr <- _casm_ ``struct in_addr addr;
245 addr.s_addr = htonl(%0);
246 %r = gethostbyaddr ((char*)&addr, sizeof(struct in_addr), %1);''
250 then fail (IOError Nothing NoSuchThing "no such host entry")
251 else unpackHostEntry ptr
253 getHostEntry :: IO HostEntry
255 ptr <- _ccall_ gethostent
257 then fail (IOError Nothing NoSuchThing "unable to retrieve host entry")
258 else unpackHostEntry ptr
260 setHostEntry :: Bool -> IO ()
261 setHostEntry flg = _ccall_ sethostent v
262 where v = if flg then 1 else 0
264 endHostEntry :: IO ()
265 endHostEntry = _ccall_ endhostent
267 getHostEntries :: Bool -> IO [HostEntry]
268 getHostEntries stayOpen = do
269 setHostEntry stayOpen
270 getEntries (getHostEntry) (endHostEntry)
274 %***************************************************************************
276 \subsection[BSD-Network]{Accessing network information}
278 %***************************************************************************
280 Same set of access functions as for accessing host,protocol and service
281 system info, this time for the types of networks supported.
284 type NetworkAddr = Word
285 type NetworkName = String
289 NetworkName -- official name
290 [NetworkName] -- aliases
294 getNetworkByName :: NetworkName -> IO NetworkEntry
295 getNetworkByName name = do
296 ptr <- _ccall_ getnetbyname name
298 then fail (IOError Nothing NoSuchThing "no such network entry")
299 else unpackNetworkEntry ptr
301 getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry
302 getNetworkByAddr addr family = do
303 ptr <- _casm_ ``long naddr = htonl(%0);
304 %r = getnetbyaddr (naddr, (int)%1);''
308 then fail (IOError Nothing NoSuchThing "no such network entry")
309 else unpackNetworkEntry ptr
311 getNetworkEntry :: IO NetworkEntry
313 ptr <- _ccall_ getnetent
315 then fail (IOError Nothing NoSuchThing "no more network entries")
316 else unpackNetworkEntry ptr
318 setNetworkEntry :: Bool -> IO ()
319 setNetworkEntry flg = _ccall_ setnetent v
320 where v = if flg then 1 else 0
322 endNetworkEntry :: IO ()
323 endNetworkEntry = _ccall_ endnetent
325 getNetworkEntries :: Bool -> IO [NetworkEntry]
326 getNetworkEntries stayOpen = do
327 setNetworkEntry stayOpen
328 getEntries (getNetworkEntry) (endNetworkEntry)
332 %***************************************************************************
334 \subsection[BSD-Misc]{Miscellaneous Functions}
336 %***************************************************************************
338 Calling @getHostName@ returns the standard host name for the current
339 processor, as set at boot time.
342 getHostName :: IO HostName
344 ptr <- stToIO (newCharArray (0,256))
345 rc <- _casm_ ``%r=gethostname(%0, 256);'' ptr
346 ba <- stToIO (unsafeFreezeByteArray ptr)
348 then fail (userError "getHostName: unable to determine host name")
349 else return (unpackPS (byteArrayToPS ba))
352 Helper function used by the exported functions that provides a
353 Haskellised view of the enumerator functions:
356 getEntries :: IO a -- read
359 getEntries getOne atEnd = loop
362 catch (do { v <- getOne; vs <- loop ; return (v:vs) })
363 (\ _ -> do { atEnd; return [] } )
369 char *s_name; /* official name of service */
370 char **s_aliases; /* alias list */
371 int s_port; /* port service resides at */
372 char *s_proto; /* protocol to use */
375 The members of this structure are:
376 s_name The official name of the service.
377 s_aliases A zero terminated list of alternate
378 names for the service.
379 s_port The port number at which the ser-
380 vice resides. Port numbers are
381 returned in network short byte
383 s_proto The name of the protocol to use
384 when contacting the service.
388 unpackServiceEntry :: Addr -> PrimIO ServiceEntry
389 unpackServiceEntry ptr = do
390 str <- _casm_ ``%r = ((struct servent*)%0)->s_name;'' ptr
392 alias <- _casm_ ``%r = ((struct servent*)%0)->s_aliases;'' ptr
393 aliases <- unvectorize alias 0
394 -- Note: port numbers are represented as ints in (struct servent), but
395 -- inet port numbers are 16-bit, hence the use of ntohs() rather than ntohl()
396 port <- _casm_ ``%r = (int)ntohs((int)(((struct servent*)%0)->s_port));'' ptr
397 str <- _casm_ ``%r = (char *)((struct servent*)%0)->s_proto;'' ptr
399 return (ServiceEntry name aliases port proto)
401 -------------------------------------------------------------------------------
403 unpackProtocolEntry :: Addr -> IO ProtocolEntry
404 unpackProtocolEntry ptr = do
405 str <- _casm_ ``%r = ((struct protoent*)%0)->p_name;'' ptr
407 alias <- _casm_ ``%r = ((struct protoent*)%0)->p_aliases;'' ptr
408 aliases <- unvectorize alias 0
409 proto <- _casm_ ``%r = ((struct protoent*)%0)->p_proto;'' ptr
410 return (ProtocolEntry name aliases proto)
412 -------------------------------------------------------------------------------
414 unpackHostEntry :: Addr -> IO HostEntry
415 unpackHostEntry ptr = do
416 str <- _casm_ ``%r = ((struct hostent*)%0)->h_name;'' ptr
418 alias <- _casm_ ``%r = ((struct hostent*)%0)->h_aliases;'' ptr
419 aliases <- unvectorize alias 0
420 addrList <- unvectorizeHostAddrs ptr 0
421 return (HostEntry name aliases AF_INET addrList)
423 -------------------------------------------------------------------------------
425 unpackNetworkEntry :: Addr -> IO NetworkEntry
426 unpackNetworkEntry ptr = do
427 str <- _casm_ ``%r = ((struct netent*)%0)->n_name;'' ptr
429 alias <- _casm_ ``%r = ((struct netent*)%0)->n_aliases;'' ptr
430 aliases <- unvectorize alias 0
431 fam <- _casm_ ``%r = ((struct netent*)%0)->n_addrtype;'' ptr
432 na <- _casm_ ``%r = ((struct netent*)%0)->n_net;'' ptr
433 return (NetworkEntry name aliases (unpackFamily fam) na)
435 -------------------------------------------------------------------------------
437 unvectorizeHostAddrs :: Addr -> Int -> IO [Word]
438 unvectorizeHostAddrs ptr n
439 | str == ``NULL'' = return []
441 x <- _casm_ ``{ unsigned long tmp;
442 if ((((struct hostent*)%0)->h_addr_list[(int)%1]) == NULL)
445 tmp = (W_)ntohl(((struct in_addr *)(((struct hostent*)%0)->h_addr_list[(int)%1]))->s_addr);
448 xs <- unvectorizeHostAddrs ptr (n+1)
450 where str = indexAddrOffAddr ptr n