{-# LINE 1 "Network/BSD.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
#include "HsNetDef.h"
module Network.BSD {-# DEPRECATED "This platform dependent module is no longer supported." #-}
(
HostName
, getHostName
, HostEntry(..)
, getHostByName
, getHostByAddr
, hostAddress
{-# LINE 34 "Network/BSD.hsc" #-}
, getHostEntries
, setHostEntry
, getHostEntry
, endHostEntry
{-# LINE 41 "Network/BSD.hsc" #-}
, ServiceEntry(..)
, ServiceName
, getServiceByName
, getServiceByPort
, getServicePortNumber
{-# LINE 50 "Network/BSD.hsc" #-}
, getServiceEntries
, getServiceEntry
, setServiceEntry
, endServiceEntry
{-# LINE 57 "Network/BSD.hsc" #-}
, ProtocolName
, ProtocolNumber
, ProtocolEntry(..)
, getProtocolByName
, getProtocolByNumber
, getProtocolNumber
, defaultProtocol
{-# LINE 68 "Network/BSD.hsc" #-}
, getProtocolEntries
, setProtocolEntry
, getProtocolEntry
, endProtocolEntry
{-# LINE 74 "Network/BSD.hsc" #-}
, PortNumber
, NetworkName
, NetworkAddr
, NetworkEntry(..)
{-# LINE 84 "Network/BSD.hsc" #-}
, getNetworkByName
, getNetworkByAddr
, getNetworkEntries
, setNetworkEntry
, getNetworkEntry
, endNetworkEntry
{-# LINE 92 "Network/BSD.hsc" #-}
{-# LINE 94 "Network/BSD.hsc" #-}
, ifNameToIndex
{-# LINE 97 "Network/BSD.hsc" #-}
) where
import Network.Socket
import Control.Concurrent (MVar, newMVar, withMVar)
import qualified Control.Exception as E
import Foreign.C.String (CString, peekCString, withCString)
{-# LINE 108 "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.Monad (liftM)
import Network.Socket.Internal (throwSocketErrorIfMinus1_)
type ProtocolName = String
data ServiceEntry =
ServiceEntry {
serviceName :: ServiceName,
serviceAliases :: [ServiceName],
servicePort :: PortNumber,
serviceProtocol :: ProtocolName
} deriving (Show, Typeable)
instance Storable ServiceEntry where
sizeOf _ = 32
{-# LINE 152 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
s_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 156 "Network/BSD.hsc" #-}
s_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 157 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
s_port <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 160 "Network/BSD.hsc" #-}
s_proto <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p >>= peekCString
{-# LINE 161 "Network/BSD.hsc" #-}
return (ServiceEntry {
serviceName = s_name,
serviceAliases = s_aliases,
{-# LINE 167 "Network/BSD.hsc" #-}
servicePort = (fromIntegral (s_port :: CInt)),
{-# LINE 171 "Network/BSD.hsc" #-}
serviceProtocol = s_proto
})
poke = throwUnsupportedOperationPoke "ServiceEntry"
getServiceByName :: 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 :: 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 :: ServiceName -> IO PortNumber
getServicePortNumber name = do
(ServiceEntry _ _ port _) <- getServiceByName name "tcp"
return port
{-# LINE 209 "Network/BSD.hsc" #-}
getServiceEntry :: IO ServiceEntry
getServiceEntry = withLock $ 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 flg = withLock $ 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 = do
setServiceEntry stayOpen
getEntries (getServiceEntry) (endServiceEntry)
{-# LINE 232 "Network/BSD.hsc" #-}
data ProtocolEntry =
ProtocolEntry {
protoName :: ProtocolName,
protoAliases :: [ProtocolName],
protoNumber :: ProtocolNumber
} deriving (Read, Show, Typeable)
instance Storable ProtocolEntry where
sizeOf _ = 24
{-# LINE 254 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
p_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 258 "Network/BSD.hsc" #-}
p_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 259 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
{-# LINE 268 "Network/BSD.hsc" #-}
p_proto <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 269 "Network/BSD.hsc" #-}
{-# LINE 270 "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 :: 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 ProtocolNumber
getProtocolNumber proto = do
(ProtocolEntry _ _ num) <- getProtocolByName proto
return num
{-# LINE 306 "Network/BSD.hsc" #-}
getProtocolEntry :: IO ProtocolEntry
getProtocolEntry = withLock $ 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 flg = withLock $ 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) (endProtocolEntry)
{-# LINE 329 "Network/BSD.hsc" #-}
data HostEntry =
HostEntry {
hostName :: HostName,
hostAliases :: [HostName],
hostFamily :: Family,
hostAddresses :: [HostAddress]
} deriving (Read, Show, Typeable)
instance Storable HostEntry where
sizeOf _ = 32
{-# LINE 343 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
h_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 347 "Network/BSD.hsc" #-}
h_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 348 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
h_addrtype <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 351 "Network/BSD.hsc" #-}
h_addr_list <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 353 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peek
return (HostEntry {
hostName = h_name,
hostAliases = h_aliases,
{-# LINE 361 "Network/BSD.hsc" #-}
hostFamily = unpackFamily h_addrtype,
{-# LINE 363 "Network/BSD.hsc" #-}
hostAddresses = h_addr_list
})
poke = throwUnsupportedOperationPoke "HostEntry"
hostAddress :: HostEntry -> HostAddress
hostAddress (HostEntry nm _ _ ls) =
case ls of
[] -> error $ "Network.BSD.hostAddress: empty network address list for " ++ nm
(x:_) -> x
getHostByName :: 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 :: Family -> 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)) (packFamily family)
>>= peek
foreign import CALLCONV safe "gethostbyaddr"
c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry)
{-# LINE 405 "Network/BSD.hsc" #-}
getHostEntry :: IO HostEntry
getHostEntry = withLock $ 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 flg = withLock $ 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 = do
setHostEntry stayOpen
getEntries (getHostEntry) (endHostEntry)
{-# LINE 428 "Network/BSD.hsc" #-}
type NetworkAddr = CULong
type NetworkName = String
data NetworkEntry =
NetworkEntry {
networkName :: NetworkName,
networkAliases :: [NetworkName],
networkFamily :: Family,
networkAddress :: NetworkAddr
} deriving (Read, Show, Typeable)
instance Storable NetworkEntry where
sizeOf _ = 32
{-# LINE 450 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
n_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 454 "Network/BSD.hsc" #-}
n_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 455 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
n_addrtype <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 458 "Network/BSD.hsc" #-}
n_net <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p
{-# LINE 459 "Network/BSD.hsc" #-}
return (NetworkEntry {
networkName = n_name,
networkAliases = n_aliases,
networkFamily = unpackFamily (fromIntegral
(n_addrtype :: CInt)),
networkAddress = n_net
})
poke = throwUnsupportedOperationPoke "NetworkEntry"
{-# LINE 471 "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 -> Family -> IO NetworkEntry
getNetworkByAddr addr family = withLock $ do
throwNoSuchThingIfNull "Network.BSD.getNetworkByAddr" "no such network entry"
$ c_getnetbyaddr addr (packFamily family)
>>= peek
foreign import ccall unsafe "getnetbyaddr"
c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry)
getNetworkEntry :: IO NetworkEntry
getNetworkEntry = withLock $ 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 flg = withLock $ 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 = do
setNetworkEntry stayOpen
getEntries (getNetworkEntry) (endNetworkEntry)
{-# LINE 518 "Network/BSD.hsc" #-}
{-# NOINLINE lock #-}
lock :: MVar ()
lock = unsafePerformIO $ withSocketsDo $ newMVar ()
withLock :: IO a -> IO a
withLock act = withMVar lock (\_ -> act)
getHostName :: IO 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