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" #-}
17 getHostName, -- :: IO HostName
21 getServiceByName, -- :: ServiceName -> ProtocolName -> IO ServiceEntry
22 getServiceByPort, -- :: PortNumber -> ProtocolName -> IO ServiceEntry
23 getServicePortNumber, -- :: ServiceName -> IO PortNumber
25 #ifndef cygwin32_TARGET_OS
26 getServiceEntry, -- :: IO ServiceEntry
27 setServiceEntry, -- :: Bool -> IO ()
28 endServiceEntry, -- :: IO ()
29 getServiceEntries, -- :: Bool -> IO [ServiceEntry]
35 getProtocolByName, -- :: ProtocolName -> IO ProtocolEntry
36 getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry
37 getProtocolNumber, -- :: ProtocolName -> ProtocolNumber
39 #ifndef cygwin32_TARGET_OS
40 setProtocolEntry, -- :: Bool -> IO ()
41 getProtocolEntry, -- :: IO ProtocolEntry
42 endProtocolEntry, -- :: IO ()
43 getProtocolEntries, -- :: Bool -> IO [ProtocolEntry]
47 mkPortNumber, -- :: Int -> PortNumber
50 getHostByName, -- :: HostName -> IO HostEntry
51 getHostByAddr, -- :: HostAddress -> Family -> IO HostEntry
52 hostAddress, -- :: HostEntry -> HostAddress
54 #ifndef cygwin32_TARGET_OS
55 setHostEntry, -- :: Bool -> IO ()
56 getHostEntry, -- :: IO HostEntry
57 endHostEntry, -- :: IO ()
58 getHostEntries, -- :: Bool -> IO [HostEntry]
64 #ifndef cygwin32_TARGET_OS
65 getNetworkByName, -- :: NetworkName -> IO NetworkEntry
66 getNetworkByAddr, -- :: NetworkAddr -> Family -> IO NetworkEntry
67 setNetworkEntry, -- :: Bool -> IO ()
68 getNetworkEntry, -- :: IO NetworkEntry
69 endNetworkEntry, -- :: IO ()
70 getNetworkEntries -- :: Bool -> IO [NetworkEntry]
76 import PrelIOBase ( IOError (..), IOErrorType(..) )
80 import PackedString ( cByteArrayToPS, unpackPS, unpackCStringIO )
82 import Util ( unvectorize )
88 %***************************************************************************
90 \subsection[BSD-DBTypes]{Service, Protocol \& Host Database Types}
92 %***************************************************************************
95 type HostName = String
96 type ProtocolName = String
97 type ServiceName = String
101 protoName :: ProtocolName, -- Official Name
102 protoAliases :: [ProtocolName], -- aliases
103 protoNumber :: ProtocolNumber -- Protocol Number
108 serviceName :: ServiceName, -- Official Name
109 serviceAliases :: [ServiceName], -- aliases
110 servicePort :: PortNumber, -- Port Number ( network byte order )
111 serviceProtocol :: ProtocolName -- Protocol
116 hostName :: HostName, -- Official Name
117 hostAliases :: [HostName], -- aliases
118 hostFamily :: Family, -- Host Type (currently AF_INET)
119 hostAddresses :: [HostAddress] -- Set of Network Addresses (in network byte order)
122 -- convenience function:
123 hostAddress :: HostEntry -> HostAddress
124 hostAddress (HostEntry nm _ _ ls) =
126 [] -> error ("BSD.hostAddress: empty network address list for " ++ nm)
131 %***************************************************************************
133 \subsection[BSD-DBAccess]{Service, Protocol Host Database Access}
135 %***************************************************************************
137 Calling @getServiceByName@ for a given service and protocol returns the
138 systems service entry. This should be used to find the port numbers
139 for standard protocols such as SMTP and FTP. The remaining three
140 functions should be used for browsing the service database
143 Calling @setServiceEntry@ with \tr{True} indicates that the service
144 database should be left open between calls to @getServiceEntry@. To
145 close the database a call to @endServiceEntry@ is required. This
146 database file is usually stored in the file /etc/services.
149 getServiceByName :: ServiceName -- Service Name
150 -> ProtocolName -- Protocol Name
151 -> IO ServiceEntry -- Service Entry
152 getServiceByName name proto = do
153 ptr <- _ccall_ getservbyname name proto
155 then fail (IOError Nothing NoSuchThing "getServiceByName" "no such service entry")
156 else unpackServiceEntry ptr
158 getServiceByPort :: PortNumber
161 getServiceByPort (PNum port) proto = do
162 ptr <- _ccall_ getservbyport port proto
164 then fail (IOError Nothing NoSuchThing "getServiceByPort" "no such service entry")
165 else unpackServiceEntry ptr
167 getServicePortNumber :: ServiceName -> IO PortNumber
168 getServicePortNumber name = do
169 (ServiceEntry _ _ port _) <- getServiceByName name "tcp"
172 #ifndef cygwin32_TARGET_OS
173 getServiceEntry :: IO ServiceEntry
175 ptr <- _ccall_ getservent
177 then fail (IOError Nothing NoSuchThing "getServiceEntry" "no such service entry")
178 else unpackServiceEntry ptr
180 setServiceEntry :: Bool -> IO ()
181 setServiceEntry flg = _ccall_ setservent stayOpen
182 where stayOpen = if flg then 1 else 0
184 endServiceEntry :: IO ()
185 endServiceEntry = _ccall_ endservent
187 getServiceEntries :: Bool -> IO [ServiceEntry]
188 getServiceEntries stayOpen = do
189 setServiceEntry stayOpen
190 getEntries (getServiceEntry) (endServiceEntry)
194 The following relate directly to the corresponding \tr{UNIX} {C} calls for
195 returning the protocol entries. The protocol entry is represented by
196 the Haskell type @ProtocolEntry@.
198 As for @setServiceEntry@ above, calling @setProtocolEntry@.
199 determines whether or not the protocol database file, usually
200 \tr{/etc/protocols}, is to be kept open between calls of
201 @getProtocolEntry@. Similarly,
204 getProtocolByName :: ProtocolName -> IO ProtocolEntry
205 getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
206 getProtocolNumber :: ProtocolName -> IO ProtocolNumber
208 #ifndef cygwin32_TARGET_OS
209 setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
210 getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
211 endProtocolEntry :: IO ()
212 getProtocolEntries :: Bool -> IO [ProtocolEntry]
217 --getProtocolByName :: ProtocolName -> IO ProtocolEntry
218 getProtocolByName name = do
219 ptr <- _ccall_ getprotobyname name
221 then fail (IOError Nothing NoSuchThing "getProtocolByName" "no such protocol entry")
222 else unpackProtocolEntry ptr
224 --getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
225 getProtocolByNumber num = do
226 ptr <- _ccall_ getprotobynumber num
228 then fail (IOError Nothing NoSuchThing "getProtocolByNumber" "no such protocol entry")
229 else unpackProtocolEntry ptr
231 --getProtocolNumber :: ProtocolName -> IO ProtocolNumber
232 getProtocolNumber proto = do
233 (ProtocolEntry _ _ num) <- getProtocolByName proto
236 #ifndef cygwin32_TARGET_OS
237 --getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
238 getProtocolEntry = do
239 ptr <- _ccall_ getprotoent
241 then fail (IOError Nothing NoSuchThing "getProtocolEntry" "no such protocol entry")
242 else unpackProtocolEntry ptr
244 --setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
245 setProtocolEntry flg = _ccall_ setprotoent v
246 where v = if flg then 1 else 0
248 --endProtocolEntry :: IO ()
249 endProtocolEntry = _ccall_ endprotoent
251 --getProtocolEntries :: Bool -> IO [ProtocolEntry]
252 getProtocolEntries stayOpen = do
253 setProtocolEntry stayOpen
254 getEntries (getProtocolEntry) (endProtocolEntry)
260 getHostByName :: HostName -> IO HostEntry
261 getHostByName name = do
262 ptr <- _ccall_ gethostbyname name
264 then fail (IOError Nothing NoSuchThing "getHostByName" "no such host entry")
265 else unpackHostEntry ptr
267 getHostByAddr :: Family -> HostAddress -> IO HostEntry
268 getHostByAddr family addr = do
269 ptr <- _casm_ ``struct in_addr addr;
271 %r = gethostbyaddr ((char*)&addr, sizeof(struct in_addr), %1);''
275 then fail (IOError Nothing NoSuchThing "getHostByAddr" "no such host entry")
276 else unpackHostEntry ptr
278 #ifndef cygwin32_TARGET_OS
279 getHostEntry :: IO HostEntry
281 ptr <- _ccall_ gethostent
283 then fail (IOError Nothing NoSuchThing "getHostEntry" "unable to retrieve host entry")
284 else unpackHostEntry ptr
286 setHostEntry :: Bool -> IO ()
287 setHostEntry flg = _ccall_ sethostent v
288 where v = if flg then 1 else 0
290 endHostEntry :: IO ()
291 endHostEntry = _ccall_ endhostent
293 getHostEntries :: Bool -> IO [HostEntry]
294 getHostEntries stayOpen = do
295 setHostEntry stayOpen
296 getEntries (getHostEntry) (endHostEntry)
300 %***************************************************************************
302 \subsection[BSD-Network]{Accessing network information}
304 %***************************************************************************
306 Same set of access functions as for accessing host,protocol and service
307 system info, this time for the types of networks supported.
310 -- network addresses are represented in host byte order.
311 type NetworkAddr = Word
313 type NetworkName = String
317 networkName :: NetworkName, -- official name
318 networkAliases :: [NetworkName], -- aliases
319 networkFamily :: Family, -- type
320 networkAddress :: NetworkAddr
322 #ifndef cygwin32_TARGET_OS
323 getNetworkByName :: NetworkName -> IO NetworkEntry
324 getNetworkByName name = do
325 ptr <- _ccall_ getnetbyname name
327 then fail (IOError Nothing NoSuchThing "getNetworkByName" "no such network entry")
328 else unpackNetworkEntry ptr
330 getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry
331 getNetworkByAddr addr family = do
332 ptr <- _ccall_ getnetbyaddr addr (packFamily family)
334 then fail (IOError Nothing NoSuchThing "getNetworkByAddr" "no such network entry")
335 else unpackNetworkEntry ptr
337 getNetworkEntry :: IO NetworkEntry
339 ptr <- _ccall_ getnetent
341 then fail (IOError Nothing NoSuchThing "getNetworkEntry" "no more network entries")
342 else unpackNetworkEntry ptr
344 setNetworkEntry :: Bool -> IO ()
345 setNetworkEntry flg = _ccall_ setnetent v
346 where v = if flg then 1 else 0
348 endNetworkEntry :: IO ()
349 endNetworkEntry = _ccall_ endnetent
351 getNetworkEntries :: Bool -> IO [NetworkEntry]
352 getNetworkEntries stayOpen = do
353 setNetworkEntry stayOpen
354 getEntries (getNetworkEntry) (endNetworkEntry)
359 %***************************************************************************
361 \subsection[BSD-Misc]{Miscellaneous Functions}
363 %***************************************************************************
365 Calling @getHostName@ returns the standard host name for the current
366 processor, as set at boot time.
369 getHostName :: IO HostName
371 ptr <- stToIO (newCharArray (0,256))
372 rc <- _casm_ ``%r=gethostname(%0, 256);'' ptr
373 ba <- stToIO (unsafeFreezeByteArray ptr)
375 then fail (userError "getHostName: unable to determine host name")
376 else return (unpackPS (cByteArrayToPS ba))
379 Helper function used by the exported functions that provides a
380 Haskellised view of the enumerator functions:
383 getEntries :: IO a -- read
386 getEntries getOne atEnd = loop
389 catch (do { v <- getOne; vs <- loop ; return (v:vs) })
390 (\ _ -> do { atEnd; return [] } )
396 char *s_name; /* official name of service */
397 char **s_aliases; /* alias list */
398 int s_port; /* port service resides at */
399 char *s_proto; /* protocol to use */
402 The members of this structure are:
403 s_name The official name of the service.
404 s_aliases A zero terminated list of alternate
405 names for the service.
406 s_port The port number at which the ser-
407 vice resides. Port numbers are
408 returned in network short byte
410 s_proto The name of the protocol to use
411 when contacting the service.
415 unpackServiceEntry :: Addr -> PrimIO ServiceEntry
416 unpackServiceEntry ptr = do
417 str <- _casm_ ``%r = ((struct servent*)%0)->s_name;'' ptr
418 name <- unpackCStringIO str
419 alias <- _casm_ ``%r = ((struct servent*)%0)->s_aliases;'' ptr
420 aliases <- unvectorize alias 0
421 port <- _casm_ ``%r = (int)(((struct servent*)%0)->s_port);'' ptr
422 str <- _casm_ ``%r = (char *)((struct servent*)%0)->s_proto;'' ptr
423 proto <- unpackCStringIO str
424 return (ServiceEntry name aliases (PNum port) proto)
426 -------------------------------------------------------------------------------
428 unpackProtocolEntry :: Addr -> IO ProtocolEntry
429 unpackProtocolEntry ptr = do
430 str <- _casm_ ``%r = ((struct protoent*)%0)->p_name;'' ptr
431 name <- unpackCStringIO str
432 alias <- _casm_ ``%r = ((struct protoent*)%0)->p_aliases;'' ptr
433 aliases <- unvectorize alias 0
434 proto <- _casm_ ``%r = ((struct protoent*)%0)->p_proto;'' ptr
435 return (ProtocolEntry name aliases proto)
437 -------------------------------------------------------------------------------
439 unpackHostEntry :: Addr -> IO HostEntry
440 unpackHostEntry ptr = do
441 str <- _casm_ ``%r = ((struct hostent*)%0)->h_name;'' ptr
442 name <- unpackCStringIO str
443 alias <- _casm_ ``%r = ((struct hostent*)%0)->h_aliases;'' ptr
444 aliases <- unvectorize alias 0
445 addrList <- unvectorizeHostAddrs ptr 0
446 return (HostEntry name aliases AF_INET addrList)
448 -------------------------------------------------------------------------------
450 unpackNetworkEntry :: Addr -> IO NetworkEntry
451 unpackNetworkEntry ptr = do
452 str <- _casm_ ``%r = ((struct netent*)%0)->n_name;'' ptr
453 name <- unpackCStringIO str
454 alias <- _casm_ ``%r = ((struct netent*)%0)->n_aliases;'' ptr
455 aliases <- unvectorize alias 0
456 fam <- _casm_ ``%r = ((struct netent*)%0)->n_addrtype;'' ptr
457 na <- _casm_ ``%r = ((struct netent*)%0)->n_net;'' ptr
458 return (NetworkEntry name aliases (unpackFamily fam) na)
460 -------------------------------------------------------------------------------
462 unvectorizeHostAddrs :: Addr -> Int -> IO [HostAddress]
463 unvectorizeHostAddrs ptr n = do
464 x <- _casm_ ``{ unsigned long tmp;
465 if ((((struct hostent*)%0)->h_addr_list[(int)%1]) == NULL)
468 tmp = (W_)((struct in_addr *)(((struct hostent*)%0)->h_addr_list[(int)%1]))->s_addr;
471 if x == (W# (int2Word# 0#))
474 xs <- unvectorizeHostAddrs ptr (n+1)