1{-# LANGUAGE CPP, ForeignFunctionInterface #-} 2{-# OPTIONS_HADDOCK hide #-} 3{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 4----------------------------------------------------------------------------- 5-- | 6-- Module : Network.BSD 7-- Copyright : (c) The University of Glasgow 2001 8-- License : BSD-style (see the file libraries/network/LICENSE) 9-- 10-- Maintainer : libraries@haskell.org 11-- Stability : experimental 12-- Portability : non-portable 13-- 14-- The "Network.BSD" module defines Haskell bindings to network 15-- programming functionality provided by BSD Unix derivatives. 16-- 17----------------------------------------------------------------------------- 18 19#include "HsNet.h" 20##include "HsNetDef.h" 21 22module Network.BSD {-# DEPRECATED "This platform dependent module is no longer supported." #-} 23 ( 24 -- * Host names 25 HostName 26 , getHostName 27 28 , HostEntry(..) 29 , getHostByName 30 , getHostByAddr 31 , hostAddress 32 33#if defined(HAVE_GETHOSTENT) && !defined(mingw32_HOST_OS) 34 , getHostEntries 35 36 -- ** Low level functionality 37 , setHostEntry 38 , getHostEntry 39 , endHostEntry 40#endif 41 42 -- * Service names 43 , ServiceEntry(..) 44 , ServiceName 45 , getServiceByName 46 , getServiceByPort 47 , getServicePortNumber 48 49#if !defined(mingw32_HOST_OS) 50 , getServiceEntries 51 52 -- ** Low level functionality 53 , getServiceEntry 54 , setServiceEntry 55 , endServiceEntry 56#endif 57 58 -- * Protocol names 59 , ProtocolName 60 , ProtocolNumber 61 , ProtocolEntry(..) 62 , getProtocolByName 63 , getProtocolByNumber 64 , getProtocolNumber 65 , defaultProtocol 66 67#if !defined(mingw32_HOST_OS) 68 , getProtocolEntries 69 -- ** Low level functionality 70 , setProtocolEntry 71 , getProtocolEntry 72 , endProtocolEntry 73#endif 74 75 -- * Port numbers 76 , PortNumber 77 78 -- * Network names 79 , NetworkName 80 , NetworkAddr 81 , NetworkEntry(..) 82 83#if !defined(mingw32_HOST_OS) 84 , getNetworkByName 85 , getNetworkByAddr 86 , getNetworkEntries 87 -- ** Low level functionality 88 , setNetworkEntry 89 , getNetworkEntry 90 , endNetworkEntry 91#endif 92 93#if defined(HAVE_IF_NAMETOINDEX) 94 -- * Interface names 95 , ifNameToIndex 96#endif 97 98 ) where 99 100import Network.Socket 101 102import Control.Concurrent (MVar, newMVar, withMVar) 103import qualified Control.Exception as E 104import Foreign.C.String (CString, peekCString, withCString) 105#if defined(HAVE_WINSOCK2_H) 106import Foreign.C.Types ( CShort ) 107#endif 108import Foreign.C.Types ( CInt(..), CULong(..), CSize(..) ) 109import Foreign.Ptr (Ptr, nullPtr) 110import Foreign.Storable (Storable(..)) 111import Foreign.Marshal.Array (allocaArray0, peekArray0) 112import Foreign.Marshal.Utils (with, fromBool) 113import Data.Typeable 114import System.IO.Error (ioeSetErrorString, mkIOError) 115import System.IO.Unsafe (unsafePerformIO) 116 117import GHC.IO.Exception 118 119import Control.Monad (liftM) 120 121import Network.Socket.Internal (throwSocketErrorIfMinus1_) 122 123-- --------------------------------------------------------------------------- 124-- Basic Types 125 126type ProtocolName = String 127 128-- --------------------------------------------------------------------------- 129-- Service Database Access 130 131-- Calling getServiceByName for a given service and protocol returns 132-- the systems service entry. This should be used to find the port 133-- numbers for standard protocols such as SMTP and FTP. The remaining 134-- three functions should be used for browsing the service database 135-- sequentially. 136 137-- Calling setServiceEntry with True indicates that the service 138-- database should be left open between calls to getServiceEntry. To 139-- close the database a call to endServiceEntry is required. This 140-- database file is usually stored in the file /etc/services. 141 142data ServiceEntry = 143 ServiceEntry { 144 serviceName :: ServiceName, -- Official Name 145 serviceAliases :: [ServiceName], -- aliases 146 servicePort :: PortNumber, -- Port Number ( network byte order ) 147 serviceProtocol :: ProtocolName -- Protocol 148 } deriving (Show, Typeable) 149 150instance Storable ServiceEntry where 151 sizeOf _ = #const sizeof(struct servent) 152 alignment _ = alignment (undefined :: CInt) -- ??? 153 154 peek p = do 155 s_name <- (#peek struct servent, s_name) p >>= peekCString 156 s_aliases <- (#peek struct servent, s_aliases) p 157 >>= peekArray0 nullPtr 158 >>= mapM peekCString 159 s_port <- (#peek struct servent, s_port) p 160 s_proto <- (#peek struct servent, s_proto) p >>= peekCString 161 return (ServiceEntry { 162 serviceName = s_name, 163 serviceAliases = s_aliases, 164#if defined(HAVE_WINSOCK2_H) 165 servicePort = (fromIntegral (s_port :: CShort)), 166#else 167 -- s_port is already in network byte order, but it 168 -- might be the wrong size. 169 servicePort = (fromIntegral (s_port :: CInt)), 170#endif 171 serviceProtocol = s_proto 172 }) 173 174 poke = throwUnsupportedOperationPoke "ServiceEntry" 175 176 177-- | Get service by name. 178getServiceByName :: ServiceName -- Service Name 179 -> ProtocolName -- Protocol Name 180 -> IO ServiceEntry -- Service Entry 181getServiceByName name proto = withLock $ do 182 withCString name $ \ cstr_name -> do 183 withCString proto $ \ cstr_proto -> do 184 throwNoSuchThingIfNull "Network.BSD.getServiceByName" "no such service entry" 185 $ c_getservbyname cstr_name cstr_proto 186 >>= peek 187 188foreign import CALLCONV unsafe "getservbyname" 189 c_getservbyname :: CString -> CString -> IO (Ptr ServiceEntry) 190 191-- | Get the service given a 'PortNumber' and 'ProtocolName'. 192getServiceByPort :: PortNumber -> ProtocolName -> IO ServiceEntry 193getServiceByPort port proto = withLock $ do 194 withCString proto $ \ cstr_proto -> do 195 throwNoSuchThingIfNull "Network.BSD.getServiceByPort" "no such service entry" 196 $ c_getservbyport (fromIntegral port) cstr_proto 197 >>= peek 198 199foreign import CALLCONV unsafe "getservbyport" 200 c_getservbyport :: CInt -> CString -> IO (Ptr ServiceEntry) 201 202-- | Get the 'PortNumber' corresponding to the 'ServiceName'. 203getServicePortNumber :: ServiceName -> IO PortNumber 204getServicePortNumber name = do 205 (ServiceEntry _ _ port _) <- getServiceByName name "tcp" 206 return port 207 208#if !defined(mingw32_HOST_OS) 209getServiceEntry :: IO ServiceEntry 210getServiceEntry = withLock $ do 211 throwNoSuchThingIfNull "Network.BSD.getServiceEntry" "no such service entry" 212 $ c_getservent 213 >>= peek 214 215foreign import ccall unsafe "getservent" c_getservent :: IO (Ptr ServiceEntry) 216 217setServiceEntry :: Bool -> IO () 218setServiceEntry flg = withLock $ c_setservent (fromBool flg) 219 220foreign import ccall unsafe "setservent" c_setservent :: CInt -> IO () 221 222endServiceEntry :: IO () 223endServiceEntry = withLock $ c_endservent 224 225foreign import ccall unsafe "endservent" c_endservent :: IO () 226 227getServiceEntries :: Bool -> IO [ServiceEntry] 228getServiceEntries stayOpen = do 229 setServiceEntry stayOpen 230 getEntries (getServiceEntry) (endServiceEntry) 231#endif 232 233-- --------------------------------------------------------------------------- 234-- Protocol Entries 235 236-- The following relate directly to the corresponding UNIX C 237-- calls for returning the protocol entries. The protocol entry is 238-- represented by the Haskell type ProtocolEntry. 239 240-- As for setServiceEntry above, calling setProtocolEntry. 241-- determines whether or not the protocol database file, usually 242-- @/etc/protocols@, is to be kept open between calls of 243-- getProtocolEntry. Similarly, 244 245data ProtocolEntry = 246 ProtocolEntry { 247 protoName :: ProtocolName, -- Official Name 248 protoAliases :: [ProtocolName], -- aliases 249 protoNumber :: ProtocolNumber -- Protocol Number 250 } deriving (Read, Show, Typeable) 251 252instance Storable ProtocolEntry where 253 sizeOf _ = #const sizeof(struct protoent) 254 alignment _ = alignment (undefined :: CInt) -- ??? 255 256 peek p = do 257 p_name <- (#peek struct protoent, p_name) p >>= peekCString 258 p_aliases <- (#peek struct protoent, p_aliases) p 259 >>= peekArray0 nullPtr 260 >>= mapM peekCString 261#if defined(HAVE_WINSOCK2_H) 262 -- With WinSock, the protocol number is only a short; 263 -- hoist it in as such, but represent it on the Haskell side 264 -- as a CInt. 265 p_proto_short <- (#peek struct protoent, p_proto) p 266 let p_proto = fromIntegral (p_proto_short :: CShort) 267#else 268 p_proto <- (#peek struct protoent, p_proto) p 269#endif 270 return (ProtocolEntry { 271 protoName = p_name, 272 protoAliases = p_aliases, 273 protoNumber = p_proto 274 }) 275 276 poke = throwUnsupportedOperationPoke "ProtocolEntry" 277 278 279getProtocolByName :: ProtocolName -> IO ProtocolEntry 280getProtocolByName name = withLock $ do 281 withCString name $ \ name_cstr -> do 282 throwNoSuchThingIfNull "Network.BSD.getProtocolByName" ("no such protocol name: " ++ name) 283 $ c_getprotobyname name_cstr 284 >>= peek 285 286foreign import CALLCONV unsafe "getprotobyname" 287 c_getprotobyname :: CString -> IO (Ptr ProtocolEntry) 288 289 290getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry 291getProtocolByNumber num = withLock $ do 292 throwNoSuchThingIfNull "Network.BSD.getProtocolByNumber" ("no such protocol number: " ++ show num) 293 $ c_getprotobynumber (fromIntegral num) 294 >>= peek 295 296foreign import CALLCONV unsafe "getprotobynumber" 297 c_getprotobynumber :: CInt -> IO (Ptr ProtocolEntry) 298 299 300getProtocolNumber :: ProtocolName -> IO ProtocolNumber 301getProtocolNumber proto = do 302 (ProtocolEntry _ _ num) <- getProtocolByName proto 303 return num 304 305#if !defined(mingw32_HOST_OS) 306getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB 307getProtocolEntry = withLock $ do 308 ent <- throwNoSuchThingIfNull "Network.BSD.getProtocolEntry" "no such protocol entry" 309 $ c_getprotoent 310 peek ent 311 312foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry) 313 314setProtocolEntry :: Bool -> IO () -- Keep DB Open ? 315setProtocolEntry flg = withLock $ c_setprotoent (fromBool flg) 316 317foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO () 318 319endProtocolEntry :: IO () 320endProtocolEntry = withLock $ c_endprotoent 321 322foreign import ccall unsafe "endprotoent" c_endprotoent :: IO () 323 324getProtocolEntries :: Bool -> IO [ProtocolEntry] 325getProtocolEntries stayOpen = withLock $ do 326 setProtocolEntry stayOpen 327 getEntries (getProtocolEntry) (endProtocolEntry) 328#endif 329 330-- --------------------------------------------------------------------------- 331-- Host lookups 332 333data HostEntry = 334 HostEntry { 335 hostName :: HostName, -- Official Name 336 hostAliases :: [HostName], -- aliases 337 hostFamily :: Family, -- Host Type (currently AF_INET) 338 hostAddresses :: [HostAddress] -- Set of Network Addresses (in network byte order) 339 } deriving (Read, Show, Typeable) 340 341instance Storable HostEntry where 342 sizeOf _ = #const sizeof(struct hostent) 343 alignment _ = alignment (undefined :: CInt) -- ??? 344 345 peek p = do 346 h_name <- (#peek struct hostent, h_name) p >>= peekCString 347 h_aliases <- (#peek struct hostent, h_aliases) p 348 >>= peekArray0 nullPtr 349 >>= mapM peekCString 350 h_addrtype <- (#peek struct hostent, h_addrtype) p 351 -- h_length <- (#peek struct hostent, h_length) p 352 h_addr_list <- (#peek struct hostent, h_addr_list) p 353 >>= peekArray0 nullPtr 354 >>= mapM peek 355 return (HostEntry { 356 hostName = h_name, 357 hostAliases = h_aliases, 358#if defined(HAVE_WINSOCK2_H) 359 hostFamily = unpackFamily (fromIntegral (h_addrtype :: CShort)), 360#else 361 hostFamily = unpackFamily h_addrtype, 362#endif 363 hostAddresses = h_addr_list 364 }) 365 366 poke = throwUnsupportedOperationPoke "HostEntry" 367 368 369-- convenience function: 370hostAddress :: HostEntry -> HostAddress 371hostAddress (HostEntry nm _ _ ls) = 372 case ls of 373 [] -> error $ "Network.BSD.hostAddress: empty network address list for " ++ nm 374 (x:_) -> x 375 376-- getHostByName must use the same lock as the *hostent functions 377-- may cause problems if called concurrently. 378 379-- | Resolve a 'HostName' to IPv4 address. 380getHostByName :: HostName -> IO HostEntry 381getHostByName name = withLock $ do 382 withCString name $ \ name_cstr -> do 383 ent <- throwNoSuchThingIfNull "Network.BSD.getHostByName" "no such host entry" 384 $ c_gethostbyname name_cstr 385 peek ent 386 387foreign import CALLCONV safe "gethostbyname" 388 c_gethostbyname :: CString -> IO (Ptr HostEntry) 389 390 391-- The locking of gethostbyaddr is similar to gethostbyname. 392-- | Get a 'HostEntry' corresponding to the given address and family. 393-- Note that only IPv4 is currently supported. 394getHostByAddr :: Family -> HostAddress -> IO HostEntry 395getHostByAddr family addr = do 396 with addr $ \ ptr_addr -> withLock $ do 397 throwNoSuchThingIfNull "Network.BSD.getHostByAddr" "no such host entry" 398 $ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (packFamily family) 399 >>= peek 400 401foreign import CALLCONV safe "gethostbyaddr" 402 c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry) 403 404#if defined(HAVE_GETHOSTENT) && !defined(mingw32_HOST_OS) 405getHostEntry :: IO HostEntry 406getHostEntry = withLock $ do 407 throwNoSuchThingIfNull "Network.BSD.getHostEntry" "unable to retrieve host entry" 408 $ c_gethostent 409 >>= peek 410 411foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry) 412 413setHostEntry :: Bool -> IO () 414setHostEntry flg = withLock $ c_sethostent (fromBool flg) 415 416foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO () 417 418endHostEntry :: IO () 419endHostEntry = withLock $ c_endhostent 420 421foreign import ccall unsafe "endhostent" c_endhostent :: IO () 422 423getHostEntries :: Bool -> IO [HostEntry] 424getHostEntries stayOpen = do 425 setHostEntry stayOpen 426 getEntries (getHostEntry) (endHostEntry) 427#endif 428 429-- --------------------------------------------------------------------------- 430-- Accessing network information 431 432-- Same set of access functions as for accessing host,protocol and 433-- service system info, this time for the types of networks supported. 434 435-- network addresses are represented in host byte order. 436type NetworkAddr = CULong 437 438type NetworkName = String 439 440data NetworkEntry = 441 NetworkEntry { 442 networkName :: NetworkName, -- official name 443 networkAliases :: [NetworkName], -- aliases 444 networkFamily :: Family, -- type 445 networkAddress :: NetworkAddr 446 } deriving (Read, Show, Typeable) 447 448instance Storable NetworkEntry where 449 sizeOf _ = #const sizeof(struct hostent) 450 alignment _ = alignment (undefined :: CInt) -- ??? 451 452 peek p = do 453 n_name <- (#peek struct netent, n_name) p >>= peekCString 454 n_aliases <- (#peek struct netent, n_aliases) p 455 >>= peekArray0 nullPtr 456 >>= mapM peekCString 457 n_addrtype <- (#peek struct netent, n_addrtype) p 458 n_net <- (#peek struct netent, n_net) p 459 return (NetworkEntry { 460 networkName = n_name, 461 networkAliases = n_aliases, 462 networkFamily = unpackFamily (fromIntegral 463 (n_addrtype :: CInt)), 464 networkAddress = n_net 465 }) 466 467 poke = throwUnsupportedOperationPoke "NetworkEntry" 468 469 470#if !defined(mingw32_HOST_OS) 471getNetworkByName :: NetworkName -> IO NetworkEntry 472getNetworkByName name = withLock $ do 473 withCString name $ \ name_cstr -> do 474 throwNoSuchThingIfNull "Network.BSD.getNetworkByName" "no such network entry" 475 $ c_getnetbyname name_cstr 476 >>= peek 477 478foreign import ccall unsafe "getnetbyname" 479 c_getnetbyname :: CString -> IO (Ptr NetworkEntry) 480 481getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry 482getNetworkByAddr addr family = withLock $ do 483 throwNoSuchThingIfNull "Network.BSD.getNetworkByAddr" "no such network entry" 484 $ c_getnetbyaddr addr (packFamily family) 485 >>= peek 486 487foreign import ccall unsafe "getnetbyaddr" 488 c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry) 489 490getNetworkEntry :: IO NetworkEntry 491getNetworkEntry = withLock $ do 492 throwNoSuchThingIfNull "Network.BSD.getNetworkEntry" "no more network entries" 493 $ c_getnetent 494 >>= peek 495 496foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry) 497 498-- | Open the network name database. The parameter specifies 499-- whether a connection is maintained open between various 500-- networkEntry calls 501setNetworkEntry :: Bool -> IO () 502setNetworkEntry flg = withLock $ c_setnetent (fromBool flg) 503 504foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO () 505 506-- | Close the connection to the network name database. 507endNetworkEntry :: IO () 508endNetworkEntry = withLock $ c_endnetent 509 510foreign import ccall unsafe "endnetent" c_endnetent :: IO () 511 512-- | Get the list of network entries. 513getNetworkEntries :: Bool -> IO [NetworkEntry] 514getNetworkEntries stayOpen = do 515 setNetworkEntry stayOpen 516 getEntries (getNetworkEntry) (endNetworkEntry) 517#endif 518 519-- Mutex for name service lockdown 520 521{-# NOINLINE lock #-} 522lock :: MVar () 523lock = unsafePerformIO $ withSocketsDo $ newMVar () 524 525withLock :: IO a -> IO a 526withLock act = withMVar lock (\_ -> act) 527 528-- --------------------------------------------------------------------------- 529-- Miscellaneous Functions 530 531-- | Calling getHostName returns the standard host name for the current 532-- processor, as set at boot time. 533 534getHostName :: IO HostName 535getHostName = do 536 let size = 256 537 allocaArray0 size $ \ cstr -> do 538 throwSocketErrorIfMinus1_ "Network.BSD.getHostName" $ c_gethostname cstr (fromIntegral size) 539 peekCString cstr 540 541foreign import CALLCONV unsafe "gethostname" 542 c_gethostname :: CString -> CSize -> IO CInt 543 544-- Helper function used by the exported functions that provides a 545-- Haskellised view of the enumerator functions: 546 547getEntries :: IO a -- read 548 -> IO () -- at end 549 -> IO [a] 550getEntries getOne atEnd = loop 551 where 552 loop = do 553 vv <- E.catch (liftM Just getOne) 554 (\ e -> let _types = e :: IOException in return Nothing) 555 case vv of 556 Nothing -> return [] 557 Just v -> loop >>= \ vs -> atEnd >> return (v:vs) 558 559 560throwNoSuchThingIfNull :: String -> String -> IO (Ptr a) -> IO (Ptr a) 561throwNoSuchThingIfNull loc desc act = do 562 ptr <- act 563 if (ptr == nullPtr) 564 then ioError (ioeSetErrorString (mkIOError NoSuchThing loc Nothing Nothing) desc) 565 else return ptr 566 567throwUnsupportedOperationPoke :: String -> Ptr a -> a -> IO () 568throwUnsupportedOperationPoke typ _ _ = 569 ioError $ ioeSetErrorString ioe "Operation not implemented" 570 where 571 ioe = mkIOError UnsupportedOperation 572 ("Network.BSD: instance Storable " ++ typ ++ ": poke") 573 Nothing 574 Nothing 575