{-# LINE 1 "Network/BSD.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module Network.BSD {-# DEPRECATED "This platform dependent module is no longer supported." #-}
(
HostName
, getHostName
, HostEntry(..)
, getHostByName
, getHostByAddr
, hostAddress
{-# LINE 33 "Network/BSD.hsc" #-}
, getHostEntries
, setHostEntry
, getHostEntry
, endHostEntry
{-# LINE 40 "Network/BSD.hsc" #-}
, ServiceEntry(..)
, ServiceName
, getServiceByName
, getServiceByPort
, getServicePortNumber
{-# LINE 49 "Network/BSD.hsc" #-}
, getServiceEntries
, getServiceEntry
, setServiceEntry
, endServiceEntry
{-# LINE 56 "Network/BSD.hsc" #-}
, ProtocolName
, ProtocolNumber
, ProtocolEntry(..)
, getProtocolByName
, getProtocolByNumber
, getProtocolNumber
, defaultProtocol
{-# LINE 67 "Network/BSD.hsc" #-}
, getProtocolEntries
, setProtocolEntry
, getProtocolEntry
, endProtocolEntry
{-# LINE 73 "Network/BSD.hsc" #-}
, PortNumber
, NetworkName
, NetworkAddr
, NetworkEntry(..)
{-# LINE 83 "Network/BSD.hsc" #-}
, getNetworkByName
, getNetworkByAddr
, getNetworkEntries
, setNetworkEntry
, getNetworkEntry
, endNetworkEntry
{-# LINE 91 "Network/BSD.hsc" #-}
{-# LINE 93 "Network/BSD.hsc" #-}
, ifNameToIndex
{-# LINE 96 "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 107 "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 151 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
s_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 155 "Network/BSD.hsc" #-}
s_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 156 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
s_port <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 159 "Network/BSD.hsc" #-}
s_proto <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p >>= peekCString
{-# LINE 160 "Network/BSD.hsc" #-}
return (ServiceEntry {
serviceName = s_name,
serviceAliases = s_aliases,
{-# LINE 166 "Network/BSD.hsc" #-}
servicePort = (fromIntegral (s_port :: CInt)),
{-# LINE 170 "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 208 "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 231 "Network/BSD.hsc" #-}
data ProtocolEntry =
ProtocolEntry {
protoName :: ProtocolName,
protoAliases :: [ProtocolName],
protoNumber :: ProtocolNumber
} deriving (Read, Show, Typeable)
instance Storable ProtocolEntry where
sizeOf _ = 24
{-# LINE 253 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
p_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 257 "Network/BSD.hsc" #-}
p_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 258 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
{-# LINE 267 "Network/BSD.hsc" #-}
p_proto <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 268 "Network/BSD.hsc" #-}
{-# LINE 269 "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 305 "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 328 "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 342 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
h_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 346 "Network/BSD.hsc" #-}
h_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 347 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
h_addrtype <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 350 "Network/BSD.hsc" #-}
h_addr_list <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 352 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peek
return (HostEntry {
hostName = h_name,
hostAliases = h_aliases,
{-# LINE 360 "Network/BSD.hsc" #-}
hostFamily = unpackFamily h_addrtype,
{-# LINE 362 "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 404 "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 427 "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 449 "Network/BSD.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
n_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p >>= peekCString
{-# LINE 453 "Network/BSD.hsc" #-}
n_aliases <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 454 "Network/BSD.hsc" #-}
>>= peekArray0 nullPtr
>>= mapM peekCString
n_addrtype <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 457 "Network/BSD.hsc" #-}
n_net <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p
{-# LINE 458 "Network/BSD.hsc" #-}
return (NetworkEntry {
networkName = n_name,
networkAliases = n_aliases,
networkFamily = unpackFamily (fromIntegral
(n_addrtype :: CInt)),
networkAddress = n_net
})
poke = throwUnsupportedOperationPoke "NetworkEntry"
{-# LINE 470 "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 517 "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