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]
66 import Foreign -- Addr..
67 import PackedString ( byteArrayToPS, unpackPS )
69 import PosixUtil ( strcpy, unvectorize )
75 %***************************************************************************
77 \subsection[BSD-DBTypes]{Service, Protocol \& Host Database Types}
79 %***************************************************************************
82 type HostName = String
83 type ProtocolName = String
84 type ProtocolNumber = Int
85 type ServiceName = String
90 ProtocolName -- Official Name
91 [ProtocolName] -- aliases
92 Int -- Protocol Number
96 ServiceName -- Official Name
97 [ServiceName] -- aliases
98 PortNumber -- Port Number
99 ProtocolName -- Protocol
103 HostName -- Official Name
104 [HostName] -- aliases
105 Family -- Host Type (currently AF_INET)
106 [HostAddress] -- Set of Network Addresses
110 %***************************************************************************
112 \subsection[BSD-DBAccess]{Service, Protocol Host Database Access}
114 %***************************************************************************
116 Calling @getServiceByName@ for a given service and protocol returns the
117 systems service entry. This should be used to find the port numbers
118 for standard protocols such as SMTP and FTP. The remaining three
119 functions should be used for browsing the service database
122 Calling @setServiceEntry@ with \tr{True} indicates that the service
123 database should be left open between calls to @getServiceEntry@. To
124 close the database a call to @endServiceEntry@ is required. This
125 database file is usually stored in the file /etc/services.
128 getServiceByName :: ServiceName -- Service Name
129 -> ProtocolName -- Protocol Name
130 -> IO ServiceEntry -- Service Entry
131 getServiceByName name proto = do
132 ptr <- _ccall_ getservbyname name proto
134 then fail (IOError Nothing NoSuchThing "no such service entry")
135 else unpackServiceEntry ptr
137 getServiceByPort :: PortNumber ->
140 getServiceByPort port proto = do
141 ptr <- _ccall_ getservbyport port proto
143 then fail (IOError Nothing NoSuchThing "no such service entry")
144 else unpackServiceEntry ptr
146 getServicePortNumber :: ServiceName -> IO PortNumber
147 getServicePortNumber name = do
148 (ServiceEntry _ _ port _) <- getServiceByName name "tcp"
151 getServiceEntry :: IO ServiceEntry
153 ptr <- _ccall_ getservent
155 then fail (IOError Nothing NoSuchThing "no such service entry")
156 else unpackServiceEntry ptr
158 setServiceEntry :: Bool -> IO ()
159 setServiceEntry flg = _ccall_ setservent stayOpen
160 where stayOpen = if flg then 1 else 0
162 endServiceEntry :: IO ()
163 endServiceEntry = _ccall_ endservent
165 getServiceEntries :: Bool -> IO [ServiceEntry]
166 getServiceEntries stayOpen = do
167 setServiceEntry stayOpen
168 getEntries (getServiceEntry) (endServiceEntry)
172 The following relate directly to the corresponding \tr{UNIX} {C} calls for
173 returning the protocol entries. The protocol entry is represented by
174 the Haskell type @ProtocolEntry@.
176 As for @setServiceEntry@ above, calling @setProtocolEntry@.
177 determines whether or not the protocol database file, usually
178 \tr{/etc/protocols}, is to be kept open between calls of
179 @getProtocolEntry@. Similarly,
182 getProtocolByName :: ProtocolName -> IO ProtocolEntry
183 getProtocolByNumber :: PortNumber -> IO ProtocolEntry
184 getProtocolNumber :: ProtocolName -> IO ProtocolNumber
186 setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
187 getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
188 endProtocolEntry :: IO ()
189 getProtocolEntries :: Bool -> IO [ProtocolEntry]
193 --getProtocolByName :: ProtocolName -> IO ProtocolEntry
194 getProtocolByName name = do
195 ptr <- _ccall_ getprotobyname name
196 if (ptr == ``NULL'' )
197 then fail (IOError Nothing NoSuchThing "no such protocol entry")
198 else unpackProtocolEntry ptr
200 --getProtocolByNumber :: PortNumber -> IO ProtocolEntry
201 getProtocolByNumber num = do
202 ptr <- _ccall_ getprotobynumber num
204 then fail (IOError Nothing NoSuchThing "no such protocol entry")
205 else unpackProtocolEntry ptr
207 --getProtocolNumber :: ProtocolName -> IO ProtocolNumber
208 getProtocolNumber proto = do
209 (ProtocolEntry _ _ num) <- getProtocolByName proto
212 --getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
213 getProtocolEntry = do
214 ptr <- _ccall_ getprotoent
216 then fail (IOError Nothing NoSuchThing "no such protocol entry")
217 else unpackProtocolEntry ptr
219 --setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
220 setProtocolEntry flg = _ccall_ setprotoent v
221 where v = if flg then 1 else 0
223 --endProtocolEntry :: IO ()
224 endProtocolEntry = _ccall_ endprotoent
226 --getProtocolEntries :: Bool -> IO [ProtocolEntry]
227 getProtocolEntries stayOpen = do
228 setProtocolEntry stayOpen
229 getEntries (getProtocolEntry) (endProtocolEntry)
234 getHostByName :: HostName -> IO HostEntry
235 getHostByName name = do
236 ptr <- _ccall_ gethostbyname name
238 then fail (IOError Nothing NoSuchThing "no such host entry")
239 else unpackHostEntry ptr
241 getHostByAddr :: Family -> HostAddress -> IO HostEntry
242 getHostByAddr family addr = do
243 ptr <- _casm_ ``struct in_addr addr;
244 addr.s_addr = htonl(%0);
245 %r = gethostbyaddr ((char*)&addr, sizeof(struct in_addr), %1);''
249 then fail (IOError Nothing NoSuchThing "no such host entry")
250 else unpackHostEntry ptr
252 getHostEntry :: IO HostEntry
254 ptr <- _ccall_ gethostent
256 then fail (IOError Nothing NoSuchThing "unable to retrieve host entry")
257 else unpackHostEntry ptr
259 setHostEntry :: Bool -> IO ()
260 setHostEntry flg = _ccall_ sethostent v
261 where v = if flg then 1 else 0
263 endHostEntry :: IO ()
264 endHostEntry = _ccall_ endhostent
266 getHostEntries :: Bool -> IO [HostEntry]
267 getHostEntries stayOpen = do
268 setHostEntry stayOpen
269 getEntries (getHostEntry) (endHostEntry)
273 %***************************************************************************
275 \subsection[BSD-Network]{Accessing network information}
277 %***************************************************************************
279 Same set of access functions as for accessing host,protocol and service
280 system info, this time for the types of networks supported.
283 type NetworkAddr = Word
284 type NetworkName = String
288 NetworkName -- official name
289 [NetworkName] -- aliases
293 getNetworkByName :: NetworkName -> IO NetworkEntry
294 getNetworkByName name = do
295 ptr <- _ccall_ getnetbyname name
297 then fail (IOError Nothing NoSuchThing "no such network entry")
298 else unpackNetworkEntry ptr
300 getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry
301 getNetworkByAddr addr family = do
302 ptr <- _casm_ ``long naddr = htonl(%0);
303 %r = getnetbyaddr (naddr, (int)%1);''
307 then fail (IOError Nothing NoSuchThing "no such network entry")
308 else unpackNetworkEntry ptr
310 getNetworkEntry :: IO NetworkEntry
312 ptr <- _ccall_ getnetent
314 then fail (IOError Nothing NoSuchThing "no more network entries")
315 else unpackNetworkEntry ptr
317 setNetworkEntry :: Bool -> IO ()
318 setNetworkEntry flg = _ccall_ setnetent v
319 where v = if flg then 1 else 0
321 endNetworkEntry :: IO ()
322 endNetworkEntry = _ccall_ endnetent
324 getNetworkEntries :: Bool -> IO [NetworkEntry]
325 getNetworkEntries stayOpen = do
326 setNetworkEntry stayOpen
327 getEntries (getNetworkEntry) (endNetworkEntry)
331 %***************************************************************************
333 \subsection[BSD-Misc]{Miscellaneous Functions}
335 %***************************************************************************
337 Calling @getHostName@ returns the standard host name for the current
338 processor, as set at boot time.
341 getHostName :: IO HostName
343 ptr <- stToIO (newCharArray (0,256))
344 rc <- _casm_ ``%r=gethostname(%0, 256);'' ptr
345 ba <- stToIO (unsafeFreezeByteArray ptr)
347 then fail (userError "getHostName: unable to determine host name")
348 else return (unpackPS (byteArrayToPS ba))
351 Helper function used by the exported functions that provides a
352 Haskellised view of the enumerator functions:
355 getEntries :: IO a -- read
358 getEntries getOne atEnd = loop
361 catch (do { v <- getOne; vs <- loop ; return (v:vs) })
362 (\ _ -> do { atEnd; return [] } )
368 char *s_name; /* official name of service */
369 char **s_aliases; /* alias list */
370 int s_port; /* port service resides at */
371 char *s_proto; /* protocol to use */
374 The members of this structure are:
375 s_name The official name of the service.
376 s_aliases A zero terminated list of alternate
377 names for the service.
378 s_port The port number at which the ser-
379 vice resides. Port numbers are
380 returned in network short byte
382 s_proto The name of the protocol to use
383 when contacting the service.
387 unpackServiceEntry :: Addr -> PrimIO ServiceEntry
388 unpackServiceEntry ptr = do
389 str <- _casm_ ``%r = ((struct servent*)%0)->s_name;'' ptr
391 alias <- _casm_ ``%r = ((struct servent*)%0)->s_aliases;'' ptr
392 aliases <- unvectorize alias 0
393 -- Note: port numbers are represented as ints in (struct servent), but
394 -- inet port numbers are 16-bit, hence the use of ntohs() rather than ntohl()
395 port <- _casm_ ``%r = (int)ntohs((int)(((struct servent*)%0)->s_port));'' ptr
396 str <- _casm_ ``%r = (char *)((struct servent*)%0)->s_proto;'' ptr
398 return (ServiceEntry name aliases port proto)
400 -------------------------------------------------------------------------------
402 unpackProtocolEntry :: Addr -> IO ProtocolEntry
403 unpackProtocolEntry ptr = do
404 str <- _casm_ ``%r = ((struct protoent*)%0)->p_name;'' ptr
406 alias <- _casm_ ``%r = ((struct protoent*)%0)->p_aliases;'' ptr
407 aliases <- unvectorize alias 0
408 proto <- _casm_ ``%r = ((struct protoent*)%0)->p_proto;'' ptr
409 return (ProtocolEntry name aliases proto)
411 -------------------------------------------------------------------------------
413 unpackHostEntry :: Addr -> IO HostEntry
414 unpackHostEntry ptr = do
415 str <- _casm_ ``%r = ((struct hostent*)%0)->h_name;'' ptr
417 alias <- _casm_ ``%r = ((struct hostent*)%0)->h_aliases;'' ptr
418 aliases <- unvectorize alias 0
419 addrList <- unvectorizeHostAddrs ptr 0
420 return (HostEntry name aliases AF_INET addrList)
422 -------------------------------------------------------------------------------
424 unpackNetworkEntry :: Addr -> IO NetworkEntry
425 unpackNetworkEntry ptr = do
426 str <- _casm_ ``%r = ((struct netent*)%0)->n_name;'' ptr
428 alias <- _casm_ ``%r = ((struct netent*)%0)->n_aliases;'' ptr
429 aliases <- unvectorize alias 0
430 fam <- _casm_ ``%r = ((struct netent*)%0)->n_addrtype;'' ptr
431 na <- _casm_ ``%r = ((struct netent*)%0)->n_net;'' ptr
432 return (NetworkEntry name aliases (unpackFamily fam) na)
434 -------------------------------------------------------------------------------
436 unvectorizeHostAddrs :: Addr -> Int -> IO [Word]
437 unvectorizeHostAddrs ptr n
438 | str == ``NULL'' = return []
440 x <- _casm_ ``{ unsigned long tmp;
441 if ((((struct hostent*)%0)->h_addr_list[(int)%1]) == NULL)
444 tmp = (W_)ntohl(((struct in_addr *)(((struct hostent*)%0)->h_addr_list[(int)%1]))->s_addr);
447 xs <- unvectorizeHostAddrs ptr (n+1)
449 where str = indexAddrOffAddr ptr n