|
Packit |
090c59 |
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
|
|
Packit |
090c59 |
-----------------------------------------------------------------------------
|
|
Packit |
090c59 |
-- |
|
|
Packit |
090c59 |
-- Module : Network.BSD
|
|
Packit |
090c59 |
-- Copyright : (c) The University of Glasgow 2001
|
|
Packit |
090c59 |
-- License : BSD-style (see the file libraries/network/LICENSE)
|
|
Packit |
090c59 |
--
|
|
Packit |
090c59 |
-- Maintainer : libraries@haskell.org
|
|
Packit |
090c59 |
-- Stability : experimental
|
|
Packit |
090c59 |
-- Portability : non-portable
|
|
Packit |
090c59 |
--
|
|
Packit |
090c59 |
-- The "Network.BSD" module defines Haskell bindings to network
|
|
Packit |
090c59 |
-- programming functionality provided by BSD Unix derivatives.
|
|
Packit |
090c59 |
--
|
|
Packit |
090c59 |
-----------------------------------------------------------------------------
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#include "HsNet.h"
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
module Network.BSD
|
|
Packit |
090c59 |
(
|
|
Packit |
090c59 |
-- * Host names
|
|
Packit |
090c59 |
HostName
|
|
Packit |
090c59 |
, getHostName
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
, HostEntry(..)
|
|
Packit |
090c59 |
, getHostByName
|
|
Packit |
090c59 |
, getHostByAddr
|
|
Packit |
090c59 |
, hostAddress
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if defined(HAVE_GETHOSTENT) && !defined(mingw32_HOST_OS)
|
|
Packit |
090c59 |
, getHostEntries
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ** Low level functionality
|
|
Packit |
090c59 |
, setHostEntry
|
|
Packit |
090c59 |
, getHostEntry
|
|
Packit |
090c59 |
, endHostEntry
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- * Service names
|
|
Packit |
090c59 |
, ServiceEntry(..)
|
|
Packit |
090c59 |
, ServiceName
|
|
Packit |
090c59 |
, getServiceByName
|
|
Packit |
090c59 |
, getServiceByPort
|
|
Packit |
090c59 |
, getServicePortNumber
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if !defined(mingw32_HOST_OS)
|
|
Packit |
090c59 |
, getServiceEntries
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ** Low level functionality
|
|
Packit |
090c59 |
, getServiceEntry
|
|
Packit |
090c59 |
, setServiceEntry
|
|
Packit |
090c59 |
, endServiceEntry
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- * Protocol names
|
|
Packit |
090c59 |
, ProtocolName
|
|
Packit |
090c59 |
, ProtocolNumber
|
|
Packit |
090c59 |
, ProtocolEntry(..)
|
|
Packit |
090c59 |
, getProtocolByName
|
|
Packit |
090c59 |
, getProtocolByNumber
|
|
Packit |
090c59 |
, getProtocolNumber
|
|
Packit |
090c59 |
, defaultProtocol
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if !defined(mingw32_HOST_OS)
|
|
Packit |
090c59 |
, getProtocolEntries
|
|
Packit |
090c59 |
-- ** Low level functionality
|
|
Packit |
090c59 |
, setProtocolEntry
|
|
Packit |
090c59 |
, getProtocolEntry
|
|
Packit |
090c59 |
, endProtocolEntry
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- * Port numbers
|
|
Packit |
090c59 |
, PortNumber
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- * Network names
|
|
Packit |
090c59 |
, NetworkName
|
|
Packit |
090c59 |
, NetworkAddr
|
|
Packit |
090c59 |
, NetworkEntry(..)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if !defined(mingw32_HOST_OS)
|
|
Packit |
090c59 |
, getNetworkByName
|
|
Packit |
090c59 |
, getNetworkByAddr
|
|
Packit |
090c59 |
, getNetworkEntries
|
|
Packit |
090c59 |
-- ** Low level functionality
|
|
Packit |
090c59 |
, setNetworkEntry
|
|
Packit |
090c59 |
, getNetworkEntry
|
|
Packit |
090c59 |
, endNetworkEntry
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if defined(HAVE_IF_NAMETOINDEX)
|
|
Packit |
090c59 |
-- * Interface names
|
|
Packit |
090c59 |
, ifNameToIndex
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
) where
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
import Network.Socket
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
import Control.Concurrent (MVar, newMVar, withMVar)
|
|
Packit |
090c59 |
import qualified Control.Exception as E
|
|
Packit |
090c59 |
import Foreign.C.String (CString, peekCString, withCString)
|
|
Packit |
090c59 |
#if defined(HAVE_WINSOCK2_H)
|
|
Packit |
090c59 |
import Foreign.C.Types ( CShort )
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
import Foreign.C.Types ( CInt(..), CUInt(..), CULong(..), CSize(..) )
|
|
Packit |
090c59 |
import Foreign.Ptr (Ptr, nullPtr)
|
|
Packit |
090c59 |
import Foreign.Storable (Storable(..))
|
|
Packit |
090c59 |
import Foreign.Marshal.Array (allocaArray0, peekArray0)
|
|
Packit |
090c59 |
import Foreign.Marshal.Utils (with, fromBool)
|
|
Packit |
090c59 |
import Data.Typeable
|
|
Packit |
090c59 |
import System.IO.Error (ioeSetErrorString, mkIOError)
|
|
Packit |
090c59 |
import System.IO.Unsafe (unsafePerformIO)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
import GHC.IO.Exception
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
import Control.Monad (liftM)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
import Network.Socket.Internal (throwSocketErrorIfMinus1_)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ---------------------------------------------------------------------------
|
|
Packit |
090c59 |
-- Basic Types
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
type ProtocolName = String
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ---------------------------------------------------------------------------
|
|
Packit |
090c59 |
-- Service Database Access
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- Calling getServiceByName for a given service and protocol returns
|
|
Packit |
090c59 |
-- the systems service entry. This should be used to find the port
|
|
Packit |
090c59 |
-- numbers for standard protocols such as SMTP and FTP. The remaining
|
|
Packit |
090c59 |
-- three functions should be used for browsing the service database
|
|
Packit |
090c59 |
-- sequentially.
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- Calling setServiceEntry with True indicates that the service
|
|
Packit |
090c59 |
-- database should be left open between calls to getServiceEntry. To
|
|
Packit |
090c59 |
-- close the database a call to endServiceEntry is required. This
|
|
Packit |
090c59 |
-- database file is usually stored in the file /etc/services.
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
data ServiceEntry =
|
|
Packit |
090c59 |
ServiceEntry {
|
|
Packit |
090c59 |
serviceName :: ServiceName, -- Official Name
|
|
Packit |
090c59 |
serviceAliases :: [ServiceName], -- aliases
|
|
Packit |
090c59 |
servicePort :: PortNumber, -- Port Number ( network byte order )
|
|
Packit |
090c59 |
serviceProtocol :: ProtocolName -- Protocol
|
|
Packit |
090c59 |
} deriving (Show, Typeable)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
instance Storable ServiceEntry where
|
|
Packit |
090c59 |
sizeOf _ = #const sizeof(struct servent)
|
|
Packit |
090c59 |
alignment _ = alignment (undefined :: CInt) -- ???
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
peek p = do
|
|
Packit |
090c59 |
s_name <- (#peek struct servent, s_name) p >>= peekCString
|
|
Packit |
090c59 |
s_aliases <- (#peek struct servent, s_aliases) p
|
|
Packit |
090c59 |
>>= peekArray0 nullPtr
|
|
Packit |
090c59 |
>>= mapM peekCString
|
|
Packit |
090c59 |
s_port <- (#peek struct servent, s_port) p
|
|
Packit |
090c59 |
s_proto <- (#peek struct servent, s_proto) p >>= peekCString
|
|
Packit |
090c59 |
return (ServiceEntry {
|
|
Packit |
090c59 |
serviceName = s_name,
|
|
Packit |
090c59 |
serviceAliases = s_aliases,
|
|
Packit |
090c59 |
#if defined(HAVE_WINSOCK2_H)
|
|
Packit |
090c59 |
servicePort = (fromIntegral (s_port :: CShort)),
|
|
Packit |
090c59 |
#else
|
|
Packit |
090c59 |
-- s_port is already in network byte order, but it
|
|
Packit |
090c59 |
-- might be the wrong size.
|
|
Packit |
090c59 |
servicePort = (fromIntegral (s_port :: CInt)),
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
serviceProtocol = s_proto
|
|
Packit |
090c59 |
})
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
poke = throwUnsupportedOperationPoke "ServiceEntry"
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- | Get service by name.
|
|
Packit |
090c59 |
getServiceByName :: ServiceName -- Service Name
|
|
Packit |
090c59 |
-> ProtocolName -- Protocol Name
|
|
Packit |
090c59 |
-> IO ServiceEntry -- Service Entry
|
|
Packit |
090c59 |
getServiceByName name proto = withLock $ do
|
|
Packit |
090c59 |
withCString name $ \ cstr_name -> do
|
|
Packit |
090c59 |
withCString proto $ \ cstr_proto -> do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getServiceByName" "no such service entry"
|
|
Packit |
090c59 |
$ c_getservbyname cstr_name cstr_proto
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import CALLCONV unsafe "getservbyname"
|
|
Packit |
090c59 |
c_getservbyname :: CString -> CString -> IO (Ptr ServiceEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- | Get the service given a 'PortNumber' and 'ProtocolName'.
|
|
Packit |
090c59 |
getServiceByPort :: PortNumber -> ProtocolName -> IO ServiceEntry
|
|
Packit |
090c59 |
getServiceByPort port proto = withLock $ do
|
|
Packit |
090c59 |
withCString proto $ \ cstr_proto -> do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getServiceByPort" "no such service entry"
|
|
Packit |
090c59 |
$ c_getservbyport (fromIntegral port) cstr_proto
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import CALLCONV unsafe "getservbyport"
|
|
Packit |
090c59 |
c_getservbyport :: CInt -> CString -> IO (Ptr ServiceEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- | Get the 'PortNumber' corresponding to the 'ServiceName'.
|
|
Packit |
090c59 |
getServicePortNumber :: ServiceName -> IO PortNumber
|
|
Packit |
090c59 |
getServicePortNumber name = do
|
|
Packit |
090c59 |
(ServiceEntry _ _ port _) <- getServiceByName name "tcp"
|
|
Packit |
090c59 |
return port
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if !defined(mingw32_HOST_OS)
|
|
Packit |
090c59 |
getServiceEntry :: IO ServiceEntry
|
|
Packit |
090c59 |
getServiceEntry = withLock $ do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getServiceEntry" "no such service entry"
|
|
Packit |
090c59 |
$ c_getservent
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "getservent" c_getservent :: IO (Ptr ServiceEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
setServiceEntry :: Bool -> IO ()
|
|
Packit |
090c59 |
setServiceEntry flg = withLock $ c_setservent (fromBool flg)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "setservent" c_setservent :: CInt -> IO ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
endServiceEntry :: IO ()
|
|
Packit |
090c59 |
endServiceEntry = withLock $ c_endservent
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "endservent" c_endservent :: IO ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getServiceEntries :: Bool -> IO [ServiceEntry]
|
|
Packit |
090c59 |
getServiceEntries stayOpen = do
|
|
Packit |
090c59 |
setServiceEntry stayOpen
|
|
Packit |
090c59 |
getEntries (getServiceEntry) (endServiceEntry)
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ---------------------------------------------------------------------------
|
|
Packit |
090c59 |
-- Protocol Entries
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- The following relate directly to the corresponding UNIX C
|
|
Packit |
090c59 |
-- calls for returning the protocol entries. The protocol entry is
|
|
Packit |
090c59 |
-- represented by the Haskell type ProtocolEntry.
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- As for setServiceEntry above, calling setProtocolEntry.
|
|
Packit |
090c59 |
-- determines whether or not the protocol database file, usually
|
|
Packit |
090c59 |
-- @/etc/protocols@, is to be kept open between calls of
|
|
Packit |
090c59 |
-- getProtocolEntry. Similarly,
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
data ProtocolEntry =
|
|
Packit |
090c59 |
ProtocolEntry {
|
|
Packit |
090c59 |
protoName :: ProtocolName, -- Official Name
|
|
Packit |
090c59 |
protoAliases :: [ProtocolName], -- aliases
|
|
Packit |
090c59 |
protoNumber :: ProtocolNumber -- Protocol Number
|
|
Packit |
090c59 |
} deriving (Read, Show, Typeable)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
instance Storable ProtocolEntry where
|
|
Packit |
090c59 |
sizeOf _ = #const sizeof(struct protoent)
|
|
Packit |
090c59 |
alignment _ = alignment (undefined :: CInt) -- ???
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
peek p = do
|
|
Packit |
090c59 |
p_name <- (#peek struct protoent, p_name) p >>= peekCString
|
|
Packit |
090c59 |
p_aliases <- (#peek struct protoent, p_aliases) p
|
|
Packit |
090c59 |
>>= peekArray0 nullPtr
|
|
Packit |
090c59 |
>>= mapM peekCString
|
|
Packit |
090c59 |
#if defined(HAVE_WINSOCK2_H)
|
|
Packit |
090c59 |
-- With WinSock, the protocol number is only a short;
|
|
Packit |
090c59 |
-- hoist it in as such, but represent it on the Haskell side
|
|
Packit |
090c59 |
-- as a CInt.
|
|
Packit |
090c59 |
p_proto_short <- (#peek struct protoent, p_proto) p
|
|
Packit |
090c59 |
let p_proto = fromIntegral (p_proto_short :: CShort)
|
|
Packit |
090c59 |
#else
|
|
Packit |
090c59 |
p_proto <- (#peek struct protoent, p_proto) p
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
return (ProtocolEntry {
|
|
Packit |
090c59 |
protoName = p_name,
|
|
Packit |
090c59 |
protoAliases = p_aliases,
|
|
Packit |
090c59 |
protoNumber = p_proto
|
|
Packit |
090c59 |
})
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
poke = throwUnsupportedOperationPoke "ProtocolEntry"
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getProtocolByName :: ProtocolName -> IO ProtocolEntry
|
|
Packit |
090c59 |
getProtocolByName name = withLock $ do
|
|
Packit |
090c59 |
withCString name $ \ name_cstr -> do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getProtocolByName" ("no such protocol name: " ++ name)
|
|
Packit |
090c59 |
$ c_getprotobyname name_cstr
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import CALLCONV unsafe "getprotobyname"
|
|
Packit |
090c59 |
c_getprotobyname :: CString -> IO (Ptr ProtocolEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
|
|
Packit |
090c59 |
getProtocolByNumber num = withLock $ do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getProtocolByNumber" ("no such protocol number: " ++ show num)
|
|
Packit |
090c59 |
$ c_getprotobynumber (fromIntegral num)
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import CALLCONV unsafe "getprotobynumber"
|
|
Packit |
090c59 |
c_getprotobynumber :: CInt -> IO (Ptr ProtocolEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getProtocolNumber :: ProtocolName -> IO ProtocolNumber
|
|
Packit |
090c59 |
getProtocolNumber proto = do
|
|
Packit |
090c59 |
(ProtocolEntry _ _ num) <- getProtocolByName proto
|
|
Packit |
090c59 |
return num
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if !defined(mingw32_HOST_OS)
|
|
Packit |
090c59 |
getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
|
|
Packit |
090c59 |
getProtocolEntry = withLock $ do
|
|
Packit |
090c59 |
ent <- throwNoSuchThingIfNull "Network.BSD.getProtocolEntry" "no such protocol entry"
|
|
Packit |
090c59 |
$ c_getprotoent
|
|
Packit |
090c59 |
peek ent
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
|
|
Packit |
090c59 |
setProtocolEntry flg = withLock $ c_setprotoent (fromBool flg)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
endProtocolEntry :: IO ()
|
|
Packit |
090c59 |
endProtocolEntry = withLock $ c_endprotoent
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "endprotoent" c_endprotoent :: IO ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getProtocolEntries :: Bool -> IO [ProtocolEntry]
|
|
Packit |
090c59 |
getProtocolEntries stayOpen = withLock $ do
|
|
Packit |
090c59 |
setProtocolEntry stayOpen
|
|
Packit |
090c59 |
getEntries (getProtocolEntry) (endProtocolEntry)
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ---------------------------------------------------------------------------
|
|
Packit |
090c59 |
-- Host lookups
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
data HostEntry =
|
|
Packit |
090c59 |
HostEntry {
|
|
Packit |
090c59 |
hostName :: HostName, -- Official Name
|
|
Packit |
090c59 |
hostAliases :: [HostName], -- aliases
|
|
Packit |
090c59 |
hostFamily :: Family, -- Host Type (currently AF_INET)
|
|
Packit |
090c59 |
hostAddresses :: [HostAddress] -- Set of Network Addresses (in network byte order)
|
|
Packit |
090c59 |
} deriving (Read, Show, Typeable)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
instance Storable HostEntry where
|
|
Packit |
090c59 |
sizeOf _ = #const sizeof(struct hostent)
|
|
Packit |
090c59 |
alignment _ = alignment (undefined :: CInt) -- ???
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
peek p = do
|
|
Packit |
090c59 |
h_name <- (#peek struct hostent, h_name) p >>= peekCString
|
|
Packit |
090c59 |
h_aliases <- (#peek struct hostent, h_aliases) p
|
|
Packit |
090c59 |
>>= peekArray0 nullPtr
|
|
Packit |
090c59 |
>>= mapM peekCString
|
|
Packit |
090c59 |
h_addrtype <- (#peek struct hostent, h_addrtype) p
|
|
Packit |
090c59 |
-- h_length <- (#peek struct hostent, h_length) p
|
|
Packit |
090c59 |
h_addr_list <- (#peek struct hostent, h_addr_list) p
|
|
Packit |
090c59 |
>>= peekArray0 nullPtr
|
|
Packit |
090c59 |
>>= mapM peek
|
|
Packit |
090c59 |
return (HostEntry {
|
|
Packit |
090c59 |
hostName = h_name,
|
|
Packit |
090c59 |
hostAliases = h_aliases,
|
|
Packit |
090c59 |
#if defined(HAVE_WINSOCK2_H)
|
|
Packit |
090c59 |
hostFamily = unpackFamily (fromIntegral (h_addrtype :: CShort)),
|
|
Packit |
090c59 |
#else
|
|
Packit |
090c59 |
hostFamily = unpackFamily h_addrtype,
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
hostAddresses = h_addr_list
|
|
Packit |
090c59 |
})
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
poke = throwUnsupportedOperationPoke "HostEntry"
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- convenience function:
|
|
Packit |
090c59 |
hostAddress :: HostEntry -> HostAddress
|
|
Packit |
090c59 |
hostAddress (HostEntry nm _ _ ls) =
|
|
Packit |
090c59 |
case ls of
|
|
Packit |
090c59 |
[] -> error $ "Network.BSD.hostAddress: empty network address list for " ++ nm
|
|
Packit |
090c59 |
(x:_) -> x
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- getHostByName must use the same lock as the *hostent functions
|
|
Packit |
090c59 |
-- may cause problems if called concurrently.
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- | Resolve a 'HostName' to IPv4 address.
|
|
Packit |
090c59 |
getHostByName :: HostName -> IO HostEntry
|
|
Packit |
090c59 |
getHostByName name = withLock $ do
|
|
Packit |
090c59 |
withCString name $ \ name_cstr -> do
|
|
Packit |
090c59 |
ent <- throwNoSuchThingIfNull "Network.BSD.getHostByName" "no such host entry"
|
|
Packit |
090c59 |
$ c_gethostbyname name_cstr
|
|
Packit |
090c59 |
peek ent
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import CALLCONV safe "gethostbyname"
|
|
Packit |
090c59 |
c_gethostbyname :: CString -> IO (Ptr HostEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- The locking of gethostbyaddr is similar to gethostbyname.
|
|
Packit |
090c59 |
-- | Get a 'HostEntry' corresponding to the given address and family.
|
|
Packit |
090c59 |
-- Note that only IPv4 is currently supported.
|
|
Packit |
090c59 |
getHostByAddr :: Family -> HostAddress -> IO HostEntry
|
|
Packit |
090c59 |
getHostByAddr family addr = do
|
|
Packit |
090c59 |
with addr $ \ ptr_addr -> withLock $ do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getHostByAddr" "no such host entry"
|
|
Packit |
090c59 |
$ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (packFamily family)
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import CALLCONV safe "gethostbyaddr"
|
|
Packit |
090c59 |
c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if defined(HAVE_GETHOSTENT) && !defined(mingw32_HOST_OS)
|
|
Packit |
090c59 |
getHostEntry :: IO HostEntry
|
|
Packit |
090c59 |
getHostEntry = withLock $ do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getHostEntry" "unable to retrieve host entry"
|
|
Packit |
090c59 |
$ c_gethostent
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
setHostEntry :: Bool -> IO ()
|
|
Packit |
090c59 |
setHostEntry flg = withLock $ c_sethostent (fromBool flg)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
endHostEntry :: IO ()
|
|
Packit |
090c59 |
endHostEntry = withLock $ c_endhostent
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "endhostent" c_endhostent :: IO ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getHostEntries :: Bool -> IO [HostEntry]
|
|
Packit |
090c59 |
getHostEntries stayOpen = do
|
|
Packit |
090c59 |
setHostEntry stayOpen
|
|
Packit |
090c59 |
getEntries (getHostEntry) (endHostEntry)
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ---------------------------------------------------------------------------
|
|
Packit |
090c59 |
-- Accessing network information
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- Same set of access functions as for accessing host,protocol and
|
|
Packit |
090c59 |
-- service system info, this time for the types of networks supported.
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- network addresses are represented in host byte order.
|
|
Packit |
090c59 |
type NetworkAddr = CULong
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
type NetworkName = String
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
data NetworkEntry =
|
|
Packit |
090c59 |
NetworkEntry {
|
|
Packit |
090c59 |
networkName :: NetworkName, -- official name
|
|
Packit |
090c59 |
networkAliases :: [NetworkName], -- aliases
|
|
Packit |
090c59 |
networkFamily :: Family, -- type
|
|
Packit |
090c59 |
networkAddress :: NetworkAddr
|
|
Packit |
090c59 |
} deriving (Read, Show, Typeable)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
instance Storable NetworkEntry where
|
|
Packit |
090c59 |
sizeOf _ = #const sizeof(struct hostent)
|
|
Packit |
090c59 |
alignment _ = alignment (undefined :: CInt) -- ???
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
peek p = do
|
|
Packit |
090c59 |
n_name <- (#peek struct netent, n_name) p >>= peekCString
|
|
Packit |
090c59 |
n_aliases <- (#peek struct netent, n_aliases) p
|
|
Packit |
090c59 |
>>= peekArray0 nullPtr
|
|
Packit |
090c59 |
>>= mapM peekCString
|
|
Packit |
090c59 |
n_addrtype <- (#peek struct netent, n_addrtype) p
|
|
Packit |
090c59 |
n_net <- (#peek struct netent, n_net) p
|
|
Packit |
090c59 |
return (NetworkEntry {
|
|
Packit |
090c59 |
networkName = n_name,
|
|
Packit |
090c59 |
networkAliases = n_aliases,
|
|
Packit |
090c59 |
networkFamily = unpackFamily (fromIntegral
|
|
Packit |
090c59 |
(n_addrtype :: CInt)),
|
|
Packit |
090c59 |
networkAddress = n_net
|
|
Packit |
090c59 |
})
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
poke = throwUnsupportedOperationPoke "NetworkEntry"
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if !defined(mingw32_HOST_OS)
|
|
Packit |
090c59 |
getNetworkByName :: NetworkName -> IO NetworkEntry
|
|
Packit |
090c59 |
getNetworkByName name = withLock $ do
|
|
Packit |
090c59 |
withCString name $ \ name_cstr -> do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getNetworkByName" "no such network entry"
|
|
Packit |
090c59 |
$ c_getnetbyname name_cstr
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "getnetbyname"
|
|
Packit |
090c59 |
c_getnetbyname :: CString -> IO (Ptr NetworkEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry
|
|
Packit |
090c59 |
getNetworkByAddr addr family = withLock $ do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getNetworkByAddr" "no such network entry"
|
|
Packit |
090c59 |
$ c_getnetbyaddr addr (packFamily family)
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "getnetbyaddr"
|
|
Packit |
090c59 |
c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getNetworkEntry :: IO NetworkEntry
|
|
Packit |
090c59 |
getNetworkEntry = withLock $ do
|
|
Packit |
090c59 |
throwNoSuchThingIfNull "Network.BSD.getNetworkEntry" "no more network entries"
|
|
Packit |
090c59 |
$ c_getnetent
|
|
Packit |
090c59 |
>>= peek
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- | Open the network name database. The parameter specifies
|
|
Packit |
090c59 |
-- whether a connection is maintained open between various
|
|
Packit |
090c59 |
-- networkEntry calls
|
|
Packit |
090c59 |
setNetworkEntry :: Bool -> IO ()
|
|
Packit |
090c59 |
setNetworkEntry flg = withLock $ c_setnetent (fromBool flg)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- | Close the connection to the network name database.
|
|
Packit |
090c59 |
endNetworkEntry :: IO ()
|
|
Packit |
090c59 |
endNetworkEntry = withLock $ c_endnetent
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import ccall unsafe "endnetent" c_endnetent :: IO ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- | Get the list of network entries.
|
|
Packit |
090c59 |
getNetworkEntries :: Bool -> IO [NetworkEntry]
|
|
Packit |
090c59 |
getNetworkEntries stayOpen = do
|
|
Packit |
090c59 |
setNetworkEntry stayOpen
|
|
Packit |
090c59 |
getEntries (getNetworkEntry) (endNetworkEntry)
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ---------------------------------------------------------------------------
|
|
Packit |
090c59 |
-- Interface names
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#if defined(HAVE_IF_NAMETOINDEX)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- returns the index of the network interface corresponding to the name ifname.
|
|
Packit |
090c59 |
ifNameToIndex :: String -> IO (Maybe Int)
|
|
Packit |
090c59 |
ifNameToIndex ifname = do
|
|
Packit |
090c59 |
index <- withCString ifname c_if_nametoindex
|
|
Packit |
090c59 |
-- On failure zero is returned. We'll return Nothing.
|
|
Packit |
090c59 |
return $ if index == 0 then Nothing else Just $ fromIntegral index
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import CALLCONV safe "if_nametoindex"
|
|
Packit |
090c59 |
c_if_nametoindex :: CString -> IO CUInt
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
#endif
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- Mutex for name service lockdown
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
{-# NOINLINE lock #-}
|
|
Packit |
090c59 |
lock :: MVar ()
|
|
Packit |
090c59 |
lock = unsafePerformIO $ withSocketsDo $ newMVar ()
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
withLock :: IO a -> IO a
|
|
Packit |
090c59 |
withLock act = withMVar lock (\_ -> act)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- ---------------------------------------------------------------------------
|
|
Packit |
090c59 |
-- Miscellaneous Functions
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- | Calling getHostName returns the standard host name for the current
|
|
Packit |
090c59 |
-- processor, as set at boot time.
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getHostName :: IO HostName
|
|
Packit |
090c59 |
getHostName = do
|
|
Packit |
090c59 |
let size = 256
|
|
Packit |
090c59 |
allocaArray0 size $ \ cstr -> do
|
|
Packit |
090c59 |
throwSocketErrorIfMinus1_ "Network.BSD.getHostName" $ c_gethostname cstr (fromIntegral size)
|
|
Packit |
090c59 |
peekCString cstr
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
foreign import CALLCONV unsafe "gethostname"
|
|
Packit |
090c59 |
c_gethostname :: CString -> CSize -> IO CInt
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
-- Helper function used by the exported functions that provides a
|
|
Packit |
090c59 |
-- Haskellised view of the enumerator functions:
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
getEntries :: IO a -- read
|
|
Packit |
090c59 |
-> IO () -- at end
|
|
Packit |
090c59 |
-> IO [a]
|
|
Packit |
090c59 |
getEntries getOne atEnd = loop
|
|
Packit |
090c59 |
where
|
|
Packit |
090c59 |
loop = do
|
|
Packit |
090c59 |
vv <- E.catch (liftM Just getOne)
|
|
Packit |
090c59 |
(\ e -> let _types = e :: IOException in return Nothing)
|
|
Packit |
090c59 |
case vv of
|
|
Packit |
090c59 |
Nothing -> return []
|
|
Packit |
090c59 |
Just v -> loop >>= \ vs -> atEnd >> return (v:vs)
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
throwNoSuchThingIfNull :: String -> String -> IO (Ptr a) -> IO (Ptr a)
|
|
Packit |
090c59 |
throwNoSuchThingIfNull loc desc act = do
|
|
Packit |
090c59 |
ptr <- act
|
|
Packit |
090c59 |
if (ptr == nullPtr)
|
|
Packit |
090c59 |
then ioError (ioeSetErrorString (mkIOError NoSuchThing loc Nothing Nothing) desc)
|
|
Packit |
090c59 |
else return ptr
|
|
Packit |
090c59 |
|
|
Packit |
090c59 |
throwUnsupportedOperationPoke :: String -> Ptr a -> a -> IO ()
|
|
Packit |
090c59 |
throwUnsupportedOperationPoke typ _ _ =
|
|
Packit |
090c59 |
ioError $ ioeSetErrorString ioe "Operation not implemented"
|
|
Packit |
090c59 |
where
|
|
Packit |
090c59 |
ioe = mkIOError UnsupportedOperation
|
|
Packit |
090c59 |
("Network.BSD: instance Storable " ++ typ ++ ": poke")
|
|
Packit |
090c59 |
Nothing
|
|
Packit |
090c59 |
Nothing
|