{-# LINE 1 "Network/BSD.hsc" #-}
{-# LANGUAGE CPP, NondecreasingIndentation, DeriveDataTypeable, BangPatterns #-}
#include "HsNetDef.h"
module Network.BSD
(
N.HostName
, N.HostAddress
, N.Family(AF_UNSPEC, AF_UNIX, AF_INET, AF_INET6, AF_IMPLINK, AF_PUP, AF_CHAOS, AF_NS, AF_NBS, AF_ECMA, AF_DATAKIT, AF_CCITT, AF_SNA, AF_DECnet, AF_DLI, AF_LAT, AF_HYLINK, AF_APPLETALK, AF_ROUTE, AF_NETBIOS, AF_NIT, AF_802, AF_ISO, AF_OSI, AF_NETMAN, AF_X25, AF_AX25, AF_OSINET, AF_GOSSIP, AF_IPX, Pseudo_AF_XTP, AF_CTF, AF_WAN, AF_SDL, AF_NETWARE, AF_NDD, AF_INTF, AF_COIP, AF_CNT, Pseudo_AF_RTIP, Pseudo_AF_PIP, AF_SIP, AF_ISDN, Pseudo_AF_KEY, AF_NATM, AF_ARP, Pseudo_AF_HDRCMPLT, AF_ENCAP, AF_LINK, AF_RAW, AF_RIF, AF_NETROM, AF_BRIDGE, AF_ATMPVC, AF_ROSE, AF_NETBEUI, AF_SECURITY, AF_PACKET, AF_ASH, AF_ECONET, AF_ATMSVC, AF_IRDA, AF_PPPOX, AF_WANPIPE, AF_BLUETOOTH, AF_CAN)
, getHostName
, HostEntry(..)
, getHostByName
, getHostByAddr
, hostAddress
{-# LINE 50 "Network/BSD.hsc" #-}
, getHostEntries
, setHostEntry
, getHostEntry
, endHostEntry
{-# LINE 57 "Network/BSD.hsc" #-}
, ServiceEntry(..)
, N.ServiceName
, N.PortNumber
, getServiceByName
, getServiceByPort
, getServicePortNumber
{-# LINE 67 "Network/BSD.hsc" #-}
, getServiceEntries
, getServiceEntry
, setServiceEntry
, endServiceEntry
{-# LINE 74 "Network/BSD.hsc" #-}
, ProtocolName
, N.ProtocolNumber
, ProtocolEntry(..)
, getProtocolByName
, getProtocolByNumber
, getProtocolNumber
, N.defaultProtocol
{-# LINE 85 "Network/BSD.hsc" #-}
, getProtocolEntries
, setProtocolEntry
, getProtocolEntry
, endProtocolEntry
{-# LINE 91 "Network/BSD.hsc" #-}
, NetworkName
, NetworkAddr
, NetworkEntry(..)
{-# LINE 98 "Network/BSD.hsc" #-}
, getNetworkByName
, getNetworkByAddr
, getNetworkEntries
, setNetworkEntry
, getNetworkEntry
, endNetworkEntry
{-# LINE 106 "Network/BSD.hsc" #-}
, N.ifNameToIndex
) where
import qualified Network.Socket as N
import Control.Concurrent (MVar, newMVar, withMVar)
import qualified Control.Exception as E
import Foreign.C.String (CString, peekCString, withCString)
{-# LINE 120 "Network/BSD.hsc" #-}
import Foreign.C.Types ( CInt(..), CULong(..), CSize(..) )
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Array (allocaArray0, peekArray0)
import Foreign.Marshal.Utils (with, fromBool)
import Data.Typeable
import System.IO.Error (ioeSetErrorString, mkIOError)
import System.IO.Unsafe (unsafePerformIO)
import GHC.IO.Exception
import Control.DeepSeq (NFData(rnf))
import Control.Monad (liftM)
import Network.Socket.Internal (throwSocketErrorIfMinus1_)
type ProtocolName = String
data ServiceEntry =
ServiceEntry {
serviceName :: N.ServiceName,
serviceAliases :: [N.ServiceName],
servicePort :: N.PortNumber,
serviceProtocol :: ProtocolName
} deriving (Show, Typeable)
instance NFData ServiceEntry where
rnf (ServiceEntry n a !_pn pr) = rnf (n,a,pr)
instance Storable ServiceEntry where
sizeOf _ = 32
{-# LINE 171 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
s_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 175 "Network/BSD.hsc" #-}
s_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 176 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
s_port <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 179 "Network/BSD.hsc" #-}
s_proto <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p >>= peekCString
{-# LINE 180 "Network/BSD.hsc" #-}
return (ServiceEntry {
serviceName = s_name,
serviceAliases = s_aliases,
{-# LINE 186 "Network/BSD.hsc" #-}
servicePort = (fromIntegral (s_port :: CInt)),
{-# LINE 190 "Network/BSD.hsc" #-}
serviceProtocol = s_proto
})
poke = throwUnsupportedOperationPoke "ServiceEntry"
getServiceByName :: N.ServiceName
-> ProtocolName
-> IO ServiceEntry
getServiceByName name proto = withLock $ do
withCString name $ \ cstr_name -> do
withCString proto $ \ cstr_proto -> do
throwNoSuchThingIfNull "Network.BSD.getServiceByName" "no such service entry"
$ c_getservbyname cstr_name cstr_proto
>>= peek
foreign import CALLCONV unsafe "getservbyname"
c_getservbyname :: CString -> CString -> IO (Ptr ServiceEntry)
getServiceByPort :: N.PortNumber -> ProtocolName -> IO ServiceEntry
getServiceByPort port proto = withLock $ do
withCString proto $ \ cstr_proto -> do
throwNoSuchThingIfNull "Network.BSD.getServiceByPort" "no such service entry"
$ c_getservbyport (fromIntegral port) cstr_proto
>>= peek
foreign import CALLCONV unsafe "getservbyport"
c_getservbyport :: CInt -> CString -> IO (Ptr ServiceEntry)
getServicePortNumber :: N.ServiceName -> IO N.PortNumber
getServicePortNumber name = do
(ServiceEntry _ _ port _) <- getServiceByName name "tcp"
return port
{-# LINE 228 "Network/BSD.hsc" #-}
getServiceEntry :: IO ServiceEntry
getServiceEntry = withLock getServiceEntry'
getServiceEntry' :: IO ServiceEntry
getServiceEntry' = do
throwNoSuchThingIfNull "Network.BSD.getServiceEntry" "no such service entry"
$ c_getservent
>>= peek
foreign import ccall unsafe "getservent" c_getservent :: IO (Ptr ServiceEntry)
setServiceEntry :: Bool -> IO ()
setServiceEntry = withLock . setServiceEntry'
setServiceEntry' :: Bool -> IO ()
setServiceEntry' flg = c_setservent (fromBool flg)
foreign import ccall unsafe "setservent" c_setservent :: CInt -> IO ()
endServiceEntry :: IO ()
endServiceEntry = withLock $ c_endservent
foreign import ccall unsafe "endservent" c_endservent :: IO ()
getServiceEntries :: Bool -> IO [ServiceEntry]
getServiceEntries stayOpen = withLock $ do
setServiceEntry' stayOpen
getEntries getServiceEntry' c_endservent
{-# LINE 262 "Network/BSD.hsc" #-}
data ProtocolEntry =
ProtocolEntry {
protoName :: ProtocolName,
protoAliases :: [ProtocolName],
protoNumber :: N.ProtocolNumber
} deriving (Read, Show, Typeable)
instance NFData ProtocolEntry where
rnf (ProtocolEntry na a !_nu) = rnf (na,a)
instance Storable ProtocolEntry where
sizeOf _ = 24
{-# LINE 290 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
p_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 294 "Network/BSD.hsc" #-}
p_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 295 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
{-# LINE 304 "Network/BSD.hsc" #-}
p_proto <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 305 "Network/BSD.hsc" #-}
{-# LINE 306 "Network/BSD.hsc" #-}
return (ProtocolEntry {
protoName = p_name,
protoAliases = p_aliases,
protoNumber = p_proto
})
poke = throwUnsupportedOperationPoke "ProtocolEntry"
getProtocolByName :: ProtocolName -> IO ProtocolEntry
getProtocolByName name = withLock $ do
withCString name $ \ name_cstr -> do
throwNoSuchThingIfNull "Network.BSD.getProtocolByName" ("no such protocol name: " ++ name)
$ c_getprotobyname name_cstr
>>= peek
foreign import CALLCONV unsafe "getprotobyname"
c_getprotobyname :: CString -> IO (Ptr ProtocolEntry)
getProtocolByNumber :: N.ProtocolNumber -> IO ProtocolEntry
getProtocolByNumber num = withLock $ do
throwNoSuchThingIfNull "Network.BSD.getProtocolByNumber" ("no such protocol number: " ++ show num)
$ c_getprotobynumber (fromIntegral num)
>>= peek
foreign import CALLCONV unsafe "getprotobynumber"
c_getprotobynumber :: CInt -> IO (Ptr ProtocolEntry)
getProtocolNumber :: ProtocolName -> IO N.ProtocolNumber
getProtocolNumber proto = do
(ProtocolEntry _ _ num) <- getProtocolByName proto
return num
{-# LINE 343 "Network/BSD.hsc" #-}
getProtocolEntry :: IO ProtocolEntry
getProtocolEntry = withLock getProtocolEntry'
getProtocolEntry' :: IO ProtocolEntry
getProtocolEntry' = do
ent <- throwNoSuchThingIfNull "Network.BSD.getProtocolEntry" "no such protocol entry"
$ c_getprotoent
peek ent
foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry)
setProtocolEntry :: Bool -> IO ()
setProtocolEntry = withLock . setProtocolEntry'
setProtocolEntry' :: Bool -> IO ()
setProtocolEntry' flg = c_setprotoent (fromBool flg)
foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO ()
endProtocolEntry :: IO ()
endProtocolEntry = withLock $ c_endprotoent
foreign import ccall unsafe "endprotoent" c_endprotoent :: IO ()
getProtocolEntries :: Bool -> IO [ProtocolEntry]
getProtocolEntries stayOpen = withLock $ do
setProtocolEntry' stayOpen
getEntries getProtocolEntry' c_endprotoent
{-# LINE 377 "Network/BSD.hsc" #-}
data HostEntry =
HostEntry {
hostName :: N.HostName,
hostAliases :: [N.HostName],
hostFamily :: N.Family,
hostAddresses :: [N.HostAddress]
} deriving (Read, Show, Typeable)
instance NFData HostEntry where
rnf (HostEntry n al !_f ad) = rnf (n,al,ad)
instance Storable HostEntry where
sizeOf _ = 32
{-# LINE 397 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
h_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 401 "Network/BSD.hsc" #-}
h_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 402 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
h_addrtype <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 405 "Network/BSD.hsc" #-}
h_addr_list <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 407 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peek
return (HostEntry {
hostName = h_name,
hostAliases = h_aliases,
{-# LINE 415 "Network/BSD.hsc" #-}
hostFamily = N.unpackFamily h_addrtype,
{-# LINE 417 "Network/BSD.hsc" #-}
hostAddresses = h_addr_list
})
poke = throwUnsupportedOperationPoke "HostEntry"
hostAddress :: HostEntry -> N.HostAddress
hostAddress (HostEntry nm _ _ ls) =
case ls of
[] -> error $ "Network.BSD.hostAddress: empty network address list for " ++ nm
(x:_) -> x
getHostByName :: N.HostName -> IO HostEntry
getHostByName name = withLock $ do
withCString name $ \ name_cstr -> do
ent <- throwNoSuchThingIfNull "Network.BSD.getHostByName" "no such host entry"
$ c_gethostbyname name_cstr
peek ent
foreign import CALLCONV safe "gethostbyname"
c_gethostbyname :: CString -> IO (Ptr HostEntry)
getHostByAddr :: N.Family -> N.HostAddress -> IO HostEntry
getHostByAddr family addr = do
with addr $ \ ptr_addr -> withLock $ do
throwNoSuchThingIfNull "Network.BSD.getHostByAddr" "no such host entry"
$ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (N.packFamily family)
>>= peek
foreign import CALLCONV safe "gethostbyaddr"
c_gethostbyaddr :: Ptr N.HostAddress -> CInt -> CInt -> IO (Ptr HostEntry)
{-# LINE 461 "Network/BSD.hsc" #-}
getHostEntry :: IO HostEntry
getHostEntry = withLock getHostEntry
getHostEntry' :: IO HostEntry
getHostEntry' = do
throwNoSuchThingIfNull "Network.BSD.getHostEntry" "unable to retrieve host entry"
$ c_gethostent
>>= peek
foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry)
setHostEntry :: Bool -> IO ()
setHostEntry = withLock . setHostEntry'
setHostEntry' :: Bool -> IO ()
setHostEntry' flg = c_sethostent (fromBool flg)
foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO ()
endHostEntry :: IO ()
endHostEntry = withLock $ c_endhostent
foreign import ccall unsafe "endhostent" c_endhostent :: IO ()
getHostEntries :: Bool -> IO [HostEntry]
getHostEntries stayOpen = withLock $ do
setHostEntry' stayOpen
getEntries getHostEntry' c_endhostent
{-# LINE 495 "Network/BSD.hsc" #-}
type NetworkAddr = CULong
type NetworkName = String
data NetworkEntry =
NetworkEntry {
networkName :: NetworkName,
networkAliases :: [NetworkName],
networkFamily :: N.Family,
networkAddress :: NetworkAddr
} deriving (Read, Show, Typeable)
instance NFData NetworkEntry where
rnf (NetworkEntry n al !_f !_ad) = rnf (n,al)
instance Storable NetworkEntry where
sizeOf _ = 32
{-# LINE 523 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
n_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 527 "Network/BSD.hsc" #-}
n_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 528 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
n_addrtype <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 531 "Network/BSD.hsc" #-}
n_net <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p
{-# LINE 532 "Network/BSD.hsc" #-}
return (NetworkEntry {
networkName = n_name,
networkAliases = n_aliases,
networkFamily = N.unpackFamily (fromIntegral (n_addrtype :: CInt)),
networkAddress = n_net
})
poke = throwUnsupportedOperationPoke "NetworkEntry"
{-# LINE 543 "Network/BSD.hsc" #-}
getNetworkByName :: NetworkName -> IO NetworkEntry
getNetworkByName name = withLock $ do
withCString name $ \ name_cstr -> do
throwNoSuchThingIfNull "Network.BSD.getNetworkByName" "no such network entry"
$ c_getnetbyname name_cstr
>>= peek
foreign import ccall unsafe "getnetbyname"
c_getnetbyname :: CString -> IO (Ptr NetworkEntry)
getNetworkByAddr :: NetworkAddr -> N.Family -> IO NetworkEntry
getNetworkByAddr addr family = withLock $ do
throwNoSuchThingIfNull "Network.BSD.getNetworkByAddr" "no such network entry"
$ c_getnetbyaddr addr (N.packFamily family)
>>= peek
foreign import ccall unsafe "getnetbyaddr"
c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry)
getNetworkEntry :: IO NetworkEntry
getNetworkEntry = withLock getNetworkEntry'
getNetworkEntry' :: IO NetworkEntry
getNetworkEntry' = do
throwNoSuchThingIfNull "Network.BSD.getNetworkEntry" "no more network entries"
$ c_getnetent
>>= peek
foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry)
setNetworkEntry :: Bool -> IO ()
setNetworkEntry = withLock . setNetworkEntry'
setNetworkEntry' :: Bool -> IO ()
setNetworkEntry' flg = c_setnetent (fromBool flg)
foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO ()
endNetworkEntry :: IO ()
endNetworkEntry = withLock $ c_endnetent
foreign import ccall unsafe "endnetent" c_endnetent :: IO ()
getNetworkEntries :: Bool -> IO [NetworkEntry]
getNetworkEntries stayOpen = withLock $ do
setNetworkEntry' stayOpen
getEntries getNetworkEntry' c_endnetent
{-# LINE 603 "Network/BSD.hsc" #-}
{-# NOINLINE lock #-}
lock :: MVar ()
lock = unsafePerformIO $ N.withSocketsDo $ newMVar ()
withLock :: IO a -> IO a
withLock act = withMVar lock (\_ -> act)
getHostName :: IO N.HostName
getHostName = do
let size = 256
allocaArray0 size $ \ cstr -> do
throwSocketErrorIfMinus1_ "Network.BSD.getHostName" $ c_gethostname cstr (fromIntegral size)
peekCString cstr
foreign import CALLCONV unsafe "gethostname"
c_gethostname :: CString -> CSize -> IO CInt
getEntries :: IO a
-> IO ()
-> IO [a]
getEntries getOne atEnd = loop
where
loop = do
vv <- E.catch (liftM Just getOne)
(\ e -> let _types = e :: IOException in return Nothing)
case vv of
Nothing -> return []
Just v -> loop >>= \ vs -> atEnd >> return (v:vs)
throwNoSuchThingIfNull :: String -> String -> IO (Ptr a) -> IO (Ptr a)
throwNoSuchThingIfNull loc desc act = do
ptr <- act
if (ptr == nullPtr)
then ioError (ioeSetErrorString (mkIOError NoSuchThing loc Nothing Nothing) desc)
else return ptr
throwUnsupportedOperationPoke :: String -> Ptr a -> a -> IO ()
throwUnsupportedOperationPoke typ _ _ =
ioError $ ioeSetErrorString ioe "Operation not implemented"
where
ioe = mkIOError UnsupportedOperation
("Network.BSD: instance Storable " ++ typ ++ ": poke")
Nothing
Nothing