2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1997
4 \section[BSD]{Misc BSD bindings}
6 The @BSD@ module defines Haskell bindings to functionality
7 provided by BSD Unix derivatives. Currently this covers
8 network programming functionality and symbolic links.
9 (OK, so the latter is pretty much supported by most *nixes
10 today, but it was BSD that introduced them.)
13 {-# OPTIONS -#include "cbits/ghcSockets.h" -#include "stgio.h" #-}
20 getHostName, -- :: IO HostName
24 getServiceByName, -- :: ServiceName -> ProtocolName -> IO ServiceEntry
25 getServiceByPort, -- :: PortNumber -> ProtocolName -> IO ServiceEntry
26 getServicePortNumber, -- :: ServiceName -> IO PortNumber
28 #ifndef cygwin32_TARGET_OS
29 getServiceEntry, -- :: IO ServiceEntry
30 setServiceEntry, -- :: Bool -> IO ()
31 endServiceEntry, -- :: IO ()
32 getServiceEntries, -- :: Bool -> IO [ServiceEntry]
38 getProtocolByName, -- :: ProtocolName -> IO ProtocolEntry
39 getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry
40 getProtocolNumber, -- :: ProtocolName -> ProtocolNumber
42 #ifndef cygwin32_TARGET_OS
43 setProtocolEntry, -- :: Bool -> IO ()
44 getProtocolEntry, -- :: IO ProtocolEntry
45 endProtocolEntry, -- :: IO ()
46 getProtocolEntries, -- :: Bool -> IO [ProtocolEntry]
50 mkPortNumber, -- :: Int -> PortNumber
53 getHostByName, -- :: HostName -> IO HostEntry
54 getHostByAddr, -- :: HostAddress -> Family -> IO HostEntry
55 hostAddress, -- :: HostEntry -> HostAddress
57 #ifndef cygwin32_TARGET_OS
58 setHostEntry, -- :: Bool -> IO ()
59 getHostEntry, -- :: IO HostEntry
60 endHostEntry, -- :: IO ()
61 getHostEntries, -- :: Bool -> IO [HostEntry]
67 #ifndef cygwin32_TARGET_OS
68 , getNetworkByName -- :: NetworkName -> IO NetworkEntry
69 , getNetworkByAddr -- :: NetworkAddr -> Family -> IO NetworkEntry
70 , setNetworkEntry -- :: Bool -> IO ()
71 , getNetworkEntry -- :: IO NetworkEntry
72 , endNetworkEntry -- :: IO ()
73 , getNetworkEntries -- :: Bool -> IO [NetworkEntry]
77 , symlink -- :: String -> String -> IO ()
80 , readlink -- :: String -> IO String
87 import PrelIOBase ( IOError (..), IOErrorType(..) )
91 import CString ( unpackCStringIO, unpackCStringBA, unvectorize, unpackNBytesBA )
97 %***************************************************************************
99 \subsection[BSD-DBTypes]{Service, Protocol \& Host Database Types}
101 %***************************************************************************
104 type HostName = String
105 type ProtocolName = String
106 type ServiceName = String
110 protoName :: ProtocolName, -- Official Name
111 protoAliases :: [ProtocolName], -- aliases
112 protoNumber :: ProtocolNumber -- Protocol Number
117 serviceName :: ServiceName, -- Official Name
118 serviceAliases :: [ServiceName], -- aliases
119 servicePort :: PortNumber, -- Port Number ( network byte order )
120 serviceProtocol :: ProtocolName -- Protocol
125 hostName :: HostName, -- Official Name
126 hostAliases :: [HostName], -- aliases
127 hostFamily :: Family, -- Host Type (currently AF_INET)
128 hostAddresses :: [HostAddress] -- Set of Network Addresses (in network byte order)
131 -- convenience function:
132 hostAddress :: HostEntry -> HostAddress
133 hostAddress (HostEntry nm _ _ ls) =
135 [] -> error ("BSD.hostAddress: empty network address list for " ++ nm)
140 %***************************************************************************
142 \subsection[BSD-DBAccess]{Service, Protocol Host Database Access}
144 %***************************************************************************
146 Calling @getServiceByName@ for a given service and protocol returns the
147 systems service entry. This should be used to find the port numbers
148 for standard protocols such as SMTP and FTP. The remaining three
149 functions should be used for browsing the service database
152 Calling @setServiceEntry@ with \tr{True} indicates that the service
153 database should be left open between calls to @getServiceEntry@. To
154 close the database a call to @endServiceEntry@ is required. This
155 database file is usually stored in the file /etc/services.
158 getServiceByName :: ServiceName -- Service Name
159 -> ProtocolName -- Protocol Name
160 -> IO ServiceEntry -- Service Entry
161 getServiceByName name proto = do
162 ptr <- _ccall_ getservbyname name proto
164 then fail (IOError Nothing NoSuchThing "getServiceByName" "no such service entry")
165 else unpackServiceEntry ptr
167 getServiceByPort :: PortNumber
170 getServiceByPort (PNum port) proto = do
171 ptr <- _ccall_ getservbyport port proto
173 then fail (IOError Nothing NoSuchThing "getServiceByPort" "no such service entry")
174 else unpackServiceEntry ptr
176 getServicePortNumber :: ServiceName -> IO PortNumber
177 getServicePortNumber name = do
178 (ServiceEntry _ _ port _) <- getServiceByName name "tcp"
181 #ifndef cygwin32_TARGET_OS
182 getServiceEntry :: IO ServiceEntry
184 ptr <- _ccall_ getservent
186 then fail (IOError Nothing NoSuchThing "getServiceEntry" "no such service entry")
187 else unpackServiceEntry ptr
189 setServiceEntry :: Bool -> IO ()
190 setServiceEntry flg = _ccall_ setservent stayOpen
191 where stayOpen = if flg then 1 else 0
193 endServiceEntry :: IO ()
194 endServiceEntry = _ccall_ endservent
196 getServiceEntries :: Bool -> IO [ServiceEntry]
197 getServiceEntries stayOpen = do
198 setServiceEntry stayOpen
199 getEntries (getServiceEntry) (endServiceEntry)
203 The following relate directly to the corresponding \tr{UNIX} {C} calls for
204 returning the protocol entries. The protocol entry is represented by
205 the Haskell type @ProtocolEntry@.
207 As for @setServiceEntry@ above, calling @setProtocolEntry@.
208 determines whether or not the protocol database file, usually
209 \tr{/etc/protocols}, is to be kept open between calls of
210 @getProtocolEntry@. Similarly,
213 getProtocolByName :: ProtocolName -> IO ProtocolEntry
214 getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
215 getProtocolNumber :: ProtocolName -> IO ProtocolNumber
217 #ifndef cygwin32_TARGET_OS
218 setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
219 getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
220 endProtocolEntry :: IO ()
221 getProtocolEntries :: Bool -> IO [ProtocolEntry]
226 --getProtocolByName :: ProtocolName -> IO ProtocolEntry
227 getProtocolByName name = do
228 ptr <- _ccall_ getprotobyname name
230 then fail (IOError Nothing NoSuchThing "getProtocolByName" "no such protocol entry")
231 else unpackProtocolEntry ptr
233 --getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
234 getProtocolByNumber num = do
235 ptr <- _ccall_ getprotobynumber num
237 then fail (IOError Nothing NoSuchThing "getProtocolByNumber" "no such protocol entry")
238 else unpackProtocolEntry ptr
240 --getProtocolNumber :: ProtocolName -> IO ProtocolNumber
241 getProtocolNumber proto = do
242 (ProtocolEntry _ _ num) <- getProtocolByName proto
245 #ifndef cygwin32_TARGET_OS
246 --getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
247 getProtocolEntry = do
248 ptr <- _ccall_ getprotoent
250 then fail (IOError Nothing NoSuchThing "getProtocolEntry" "no such protocol entry")
251 else unpackProtocolEntry ptr
253 --setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
254 setProtocolEntry flg = _ccall_ setprotoent v
255 where v = if flg then 1 else 0
257 --endProtocolEntry :: IO ()
258 endProtocolEntry = _ccall_ endprotoent
260 --getProtocolEntries :: Bool -> IO [ProtocolEntry]
261 getProtocolEntries stayOpen = do
262 setProtocolEntry stayOpen
263 getEntries (getProtocolEntry) (endProtocolEntry)
269 getHostByName :: HostName -> IO HostEntry
270 getHostByName name = do
271 ptr <- _ccall_ gethostbyname name
273 then fail (IOError Nothing NoSuchThing "getHostByName" "no such host entry")
274 else unpackHostEntry ptr
276 getHostByAddr :: Family -> HostAddress -> IO HostEntry
277 getHostByAddr family addr = do
278 ptr <- _casm_ ``struct in_addr addr;
280 %r = gethostbyaddr ((char*)&addr, sizeof(struct in_addr), %1);''
284 then fail (IOError Nothing NoSuchThing "getHostByAddr" "no such host entry")
285 else unpackHostEntry ptr
287 #ifndef cygwin32_TARGET_OS
288 getHostEntry :: IO HostEntry
290 ptr <- _ccall_ gethostent
292 then fail (IOError Nothing NoSuchThing "getHostEntry" "unable to retrieve host entry")
293 else unpackHostEntry ptr
295 setHostEntry :: Bool -> IO ()
296 setHostEntry flg = _ccall_ sethostent v
297 where v = if flg then 1 else 0
299 endHostEntry :: IO ()
300 endHostEntry = _ccall_ endhostent
302 getHostEntries :: Bool -> IO [HostEntry]
303 getHostEntries stayOpen = do
304 setHostEntry stayOpen
305 getEntries (getHostEntry) (endHostEntry)
309 %***************************************************************************
311 \subsection[BSD-Network]{Accessing network information}
313 %***************************************************************************
315 Same set of access functions as for accessing host,protocol and service
316 system info, this time for the types of networks supported.
319 -- network addresses are represented in host byte order.
320 type NetworkAddr = Word
322 type NetworkName = String
326 networkName :: NetworkName, -- official name
327 networkAliases :: [NetworkName], -- aliases
328 networkFamily :: Family, -- type
329 networkAddress :: NetworkAddr
331 #ifndef cygwin32_TARGET_OS
332 getNetworkByName :: NetworkName -> IO NetworkEntry
333 getNetworkByName name = do
334 ptr <- _ccall_ getnetbyname name
336 then fail (IOError Nothing NoSuchThing "getNetworkByName" "no such network entry")
337 else unpackNetworkEntry ptr
339 getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry
340 getNetworkByAddr addr family = do
341 ptr <- _ccall_ getnetbyaddr addr (packFamily family)
343 then fail (IOError Nothing NoSuchThing "getNetworkByAddr" "no such network entry")
344 else unpackNetworkEntry ptr
346 getNetworkEntry :: IO NetworkEntry
348 ptr <- _ccall_ getnetent
350 then fail (IOError Nothing NoSuchThing "getNetworkEntry" "no more network entries")
351 else unpackNetworkEntry ptr
353 setNetworkEntry :: Bool -> IO ()
354 setNetworkEntry flg = _ccall_ setnetent v
355 where v = if flg then 1 else 0
357 endNetworkEntry :: IO ()
358 endNetworkEntry = _ccall_ endnetent
360 getNetworkEntries :: Bool -> IO [NetworkEntry]
361 getNetworkEntries stayOpen = do
362 setNetworkEntry stayOpen
363 getEntries (getNetworkEntry) (endNetworkEntry)
368 %***************************************************************************
370 \subsection[BSD-Misc]{Miscellaneous Functions}
372 %***************************************************************************
374 Calling @getHostName@ returns the standard host name for the current
375 processor, as set at boot time.
378 getHostName :: IO HostName
380 ptr <- stToIO (newCharArray (0,256))
381 rc <- _casm_ ``%r=gethostname(%0, 256);'' ptr
383 then fail (userError "getHostName: unable to determine host name")
385 ba <- stToIO (unsafeFreezeByteArray ptr)
386 return (unpackCStringBA ba)
389 Helper function used by the exported functions that provides a
390 Haskellised view of the enumerator functions:
393 getEntries :: IO a -- read
396 getEntries getOne atEnd = loop
399 catch (do { v <- getOne; vs <- loop ; return (v:vs) })
400 (\ _ -> do { atEnd; return [] } )
406 char *s_name; /* official name of service */
407 char **s_aliases; /* alias list */
408 int s_port; /* port service resides at */
409 char *s_proto; /* protocol to use */
412 The members of this structure are:
413 s_name The official name of the service.
414 s_aliases A zero terminated list of alternate
415 names for the service.
416 s_port The port number at which the ser-
417 vice resides. Port numbers are
418 returned in network short byte
420 s_proto The name of the protocol to use
421 when contacting the service.
425 unpackServiceEntry :: Addr -> PrimIO ServiceEntry
426 unpackServiceEntry ptr = do
427 str <- _casm_ ``%r = ((struct servent*)%0)->s_name;'' ptr
428 name <- unpackCStringIO str
429 alias <- _casm_ ``%r = ((struct servent*)%0)->s_aliases;'' ptr
430 aliases <- unvectorize alias 0
431 port <- _casm_ ``%r = (int)(((struct servent*)%0)->s_port);'' ptr
432 str <- _casm_ ``%r = (char *)((struct servent*)%0)->s_proto;'' ptr
433 proto <- unpackCStringIO str
434 return (ServiceEntry name aliases (PNum port) proto)
436 -------------------------------------------------------------------------------
438 unpackProtocolEntry :: Addr -> IO ProtocolEntry
439 unpackProtocolEntry ptr = do
440 str <- _casm_ ``%r = ((struct protoent*)%0)->p_name;'' ptr
441 name <- unpackCStringIO str
442 alias <- _casm_ ``%r = ((struct protoent*)%0)->p_aliases;'' ptr
443 aliases <- unvectorize alias 0
444 proto <- _casm_ ``%r = ((struct protoent*)%0)->p_proto;'' ptr
445 return (ProtocolEntry name aliases proto)
447 -------------------------------------------------------------------------------
449 unpackHostEntry :: Addr -> IO HostEntry
450 unpackHostEntry ptr = do
451 str <- _casm_ ``%r = ((struct hostent*)%0)->h_name;'' ptr
452 name <- unpackCStringIO str
453 alias <- _casm_ ``%r = ((struct hostent*)%0)->h_aliases;'' ptr
454 aliases <- unvectorize alias 0
455 addrList <- unvectorizeHostAddrs ptr 0
456 return (HostEntry name aliases AF_INET addrList)
458 -------------------------------------------------------------------------------
460 unpackNetworkEntry :: Addr -> IO NetworkEntry
461 unpackNetworkEntry ptr = do
462 str <- _casm_ ``%r = ((struct netent*)%0)->n_name;'' ptr
463 name <- unpackCStringIO str
464 alias <- _casm_ ``%r = ((struct netent*)%0)->n_aliases;'' ptr
465 aliases <- unvectorize alias 0
466 fam <- _casm_ ``%r = ((struct netent*)%0)->n_addrtype;'' ptr
467 na <- _casm_ ``%r = ((struct netent*)%0)->n_net;'' ptr
468 return (NetworkEntry name aliases (unpackFamily fam) na)
470 -------------------------------------------------------------------------------
472 unvectorizeHostAddrs :: Addr -> Int -> IO [HostAddress]
473 unvectorizeHostAddrs ptr n = do
474 x <- _casm_ ``{ unsigned long tmp;
475 if ((((struct hostent*)%0)->h_addr_list[(int)%1]) == NULL)
478 tmp = (W_)((struct in_addr *)(((struct hostent*)%0)->h_addr_list[(int)%1]))->s_addr;
481 if x == (W# (int2Word# 0#))
484 xs <- unvectorizeHostAddrs ptr (n+1)
490 %***************************************************************************
492 \subsection[BSD-symlink]{Symbolic links}
494 %***************************************************************************
499 symlink :: String -> String -> IO ()
500 symlink actual_path sym_path = do
501 rc <- _ccall_ symlink actual_path sym_path
506 cstr <- _ccall_ getErrStr__
507 estr <- unpackCStringIO cstr
508 fail (userError ("BSD.symlink: " ++ estr))
512 readlink :: String -> IO String
514 mbuf <- stToIO (newCharArray (0, path_max))
515 buf <- stToIO (unsafeFreezeByteArray mbuf)
516 rc <- _ccall_ readlink sym buf (path_max + 1)
518 return (unpackNBytesBA buf rc)
521 cstr <- _ccall_ getErrStr__
522 estr <- unpackCStringIO cstr
523 fail (userError ("BSD.readlink: " ++ estr))
525 path_max = (``PATH_MAX''::Int)