packages feed

network-hans 0.2 → 2.6.3.1

raw patch · 9 files changed

+991/−855 lines, 9 filesdep ~hansPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hans

API changes (from Hackage documentation)

- Network.Socket.Internal: Bound :: SocketStatus
- Network.Socket.Internal: Closed :: SocketStatus
- Network.Socket.Internal: Connected :: SocketStatus
- Network.Socket.Internal: ConvertedToHandle :: SocketStatus
- Network.Socket.Internal: Datagram :: SocketType
- Network.Socket.Internal: ForBoth :: ForAction
- Network.Socket.Internal: ForNeither :: ForAction
- Network.Socket.Internal: ForRead :: ForAction
- Network.Socket.Internal: ForWrite :: ForAction
- Network.Socket.Internal: Listening :: SocketStatus
- Network.Socket.Internal: NoSocketType :: SocketType
- Network.Socket.Internal: NotConnected :: SocketStatus
- Network.Socket.Internal: RDM :: SocketType
- Network.Socket.Internal: Raw :: SocketType
- Network.Socket.Internal: SeqPacket :: SocketType
- Network.Socket.Internal: ShutdownBoth :: ShutdownCmd
- Network.Socket.Internal: ShutdownReceive :: ShutdownCmd
- Network.Socket.Internal: ShutdownSend :: ShutdownCmd
- Network.Socket.Internal: Socket :: MVar SockState -> NetworkStack -> Word64 -> Socket
- Network.Socket.Internal: Stream :: SocketType
- Network.Socket.Internal: [sockIdent] :: Socket -> Word64
- Network.Socket.Internal: [sockNStack] :: Socket -> NetworkStack
- Network.Socket.Internal: [sockState] :: Socket -> MVar SockState
- Network.Socket.Internal: accept :: Socket -> IO (Socket, SockAddr)
- Network.Socket.Internal: bind :: Socket -> SockAddr -> IO ()
- Network.Socket.Internal: close :: Socket -> IO ()
- Network.Socket.Internal: connect :: Socket -> SockAddr -> IO ()
- Network.Socket.Internal: data ForAction
- Network.Socket.Internal: data ShutdownCmd
- Network.Socket.Internal: data Socket
- Network.Socket.Internal: data SocketStatus
- Network.Socket.Internal: data SocketType
- Network.Socket.Internal: defaultProtocol :: ProtocolNumber
- Network.Socket.Internal: getBoundUdpPort :: Socket -> IO (NetworkStack, Maybe UdpPort)
- Network.Socket.Internal: getConnectedHansSocket :: Socket -> ForAction -> IO Socket
- Network.Socket.Internal: getNetworkHansStack :: IO NetworkStack
- Network.Socket.Internal: getNextSockIdent :: IO Word64
- Network.Socket.Internal: getNextUdpPacket :: Socket -> IO (ByteString, SockAddr)
- Network.Socket.Internal: hansTcpSockAddr :: SockAddr -> (IP4, TcpPort)
- Network.Socket.Internal: hansUdpSockAddr :: SockAddr -> (IP4, UdpPort)
- Network.Socket.Internal: instance GHC.Classes.Eq Network.Socket.Internal.ForAction
- Network.Socket.Internal: instance GHC.Classes.Eq Network.Socket.Internal.ShutdownCmd
- Network.Socket.Internal: instance GHC.Classes.Eq Network.Socket.Internal.SockState
- Network.Socket.Internal: instance GHC.Classes.Eq Network.Socket.Internal.Socket
- Network.Socket.Internal: instance GHC.Classes.Eq Network.Socket.Internal.SocketStatus
- Network.Socket.Internal: instance GHC.Classes.Eq Network.Socket.Internal.SocketType
- Network.Socket.Internal: instance GHC.Classes.Ord Network.Socket.Internal.SocketType
- Network.Socket.Internal: instance GHC.Read.Read Network.Socket.Internal.SocketType
- Network.Socket.Internal: instance GHC.Show.Show Network.Socket.Internal.SocketStatus
- Network.Socket.Internal: instance GHC.Show.Show Network.Socket.Internal.SocketType
- Network.Socket.Internal: isBound :: Socket -> IO Bool
- Network.Socket.Internal: isConnected :: Socket -> IO Bool
- Network.Socket.Internal: isListening :: Socket -> IO Bool
- Network.Socket.Internal: isReadable :: Socket -> IO Bool
- Network.Socket.Internal: isSupportedSocketType :: SocketType -> Bool
- Network.Socket.Internal: isWritable :: Socket -> IO Bool
- Network.Socket.Internal: listen :: Socket -> Int -> IO ()
- Network.Socket.Internal: setNetworkHansStack :: NetworkStack -> IO ()
- Network.Socket.Internal: shutdown :: Socket -> ShutdownCmd -> IO ()
- Network.Socket.Internal: socket :: Family -> SocketType -> ProtocolNumber -> IO Socket
- Network.Socket.Internal: type ProtocolNumber = CInt
+ Network.BSD: ifNameToIndex :: String -> IO (Maybe Int)
+ Network.BSD: type ProtocolNumber = CInt
+ Network.Socket: hostAddressToTuple :: HostAddress -> (Word8, Word8, Word8, Word8)
+ Network.Socket: htonl :: Word32 -> Word32
+ Network.Socket: instance GHC.Classes.Eq Network.Socket.SocketType
+ Network.Socket: instance GHC.Classes.Ord Network.Socket.SocketType
+ Network.Socket: instance GHC.Read.Read Network.Socket.SocketType
+ Network.Socket: instance GHC.Show.Show Network.Socket.SocketType
+ Network.Socket: isSupportedSockAddr :: SockAddr -> Bool
+ Network.Socket: isSupportedSocketType :: SocketType -> Bool
+ Network.Socket: ntohl :: Word32 -> Word32
+ Network.Socket: recvFd :: Socket -> IO CInt
+ Network.Socket: sendFd :: Socket -> CInt -> IO ()
+ Network.Socket: tupleToHostAddress :: (Word8, Word8, Word8, Word8) -> HostAddress
+ Network.Socket: type FlowInfo = Word32
+ Network.Socket: type HostAddress = Word32
+ Network.Socket: type ProtocolNumber = CInt
+ Network.Socket: type ScopeID = Word32
+ Network.Socket.Internal: peekSockAddr :: Ptr SockAddr -> IO SockAddr
+ Network.Socket.Internal: pokeSockAddr :: Ptr a -> SockAddr -> IO ()
+ Network.Socket.Internal: sizeOfSockAddr :: SockAddr -> Int
+ Network.Socket.Internal: sizeOfSockAddrByFamily :: Family -> Int
+ Network.Socket.Internal: throwSocketError :: String -> IO a
+ Network.Socket.Internal: throwSocketErrorCode :: String -> CInt -> IO a
+ Network.Socket.Internal: throwSocketErrorIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a
+ Network.Socket.Internal: throwSocketErrorIfMinus1RetryMayBlock :: (Eq a, Num a) => String -> IO b -> IO a -> IO a
+ Network.Socket.Internal: throwSocketErrorIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO ()
+ Network.Socket.Internal: throwSocketErrorIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO ()
+ Network.Socket.Internal: throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a
+ Network.Socket.Internal: throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a
+ Network.Socket.Internal: type FlowInfo = Word32
+ Network.Socket.Internal: type ScopeID = Word32
+ Network.Socket.Internal: withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a
+ Network.Socket.Internal: withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a
+ Network.Socket.Internal: withSocketsDo :: IO a -> IO a
+ Network.Socket.Internal: zeroMemory :: Ptr a -> CSize -> IO ()

Files

network-hans.cabal view
@@ -1,5 +1,5 @@ name:           network-hans-version:        0.2+version:        2.6.3.1 cabal-version:  >= 1.8 license:        BSD3 license-file:   LICENSE@@ -20,6 +20,7 @@         location:       git://github.com/GaloisInc/network-hans.git  library+        ghc-options:                    -Wall         hs-source-dirs:                 src         extensions:                     DeriveDataTypeable,                                         ForeignFunctionInterface,@@ -35,13 +36,13 @@                                         Network.Socket.Internal          other-modules:-                                        Hans.Socket.Handle,-                                        Network.BSD.ServiceDB+                                        Network.BSD.ServiceDB,+                                        Network.Socket.Types          build-depends:-                                        base       >= 4.0 && < 5.0,-                                        bytestring >= 0.9 && < 0.12,-                                        hans       >= 2.4 && < 2.8,-                                        parsec     >= 3.0 && < 4.0+                                        base       >= 4.0   && < 5.0,+                                        bytestring >= 0.9   && < 0.12,+                                        hans       >= 3.0.1 && < 4.0,+                                        parsec     >= 3.0   && < 4.0  
− src/Hans/Socket/Handle.hs
@@ -1,116 +0,0 @@-module Hans.Socket.Handle(makeHansHandle) where--import Control.Concurrent-import Control.Concurrent.MVar-import Control.Exception-import Control.Monad-import qualified Data.ByteString as BSS-import Data.ByteString.Lazy(ByteString)-import qualified Data.ByteString.Lazy as BS-import Data.Typeable-import Foreign.Ptr-import GHC.IO.Buffer-import GHC.IO.BufferedIO-import GHC.IO.Device-import GHC.IO.Handle-import Hans.Layer.Tcp.Socket(canSend, canRecv)-import Hans.NetworkStack-import Prelude hiding (read)-import System.IO--data BufferedSocket = BS {-    bsSocket   :: Socket-  , bsRefCount :: MVar Int-  }- deriving (Typeable)--newBufferedSocket :: Socket -> IO BufferedSocket-newBufferedSocket sock =-  do mv <- newMVar 1-     return (BS sock mv)--addRef :: BufferedSocket -> IO ()-addRef bs = modifyMVar_ (bsRefCount bs) (return . (+ 1))--dropRef :: BufferedSocket -> IO ()-dropRef bs =-  do count <- modifyMVar (bsRefCount bs) $-                \ x ->-                  let x' = x - 1-                  in return (x', x')-     when (count == 0) $ Hans.NetworkStack.close (bsSocket bs)--instance IODevice BufferedSocket where-  ready dev write msecs =-    do let tester = if write then canSend else canRecv-       canDo <- tester (bsSocket dev)-       if | canDo      -> return True-          | msecs <= 0 -> return False-          | otherwise  -> do let delay = min msecs 100-                             threadDelay (delay * 1000)-                             ready dev write (msecs - delay)-  close bs     = dropRef bs-  isTerminal _ = return False-  isSeekable _ = return False-  seek _ _ _   = throwIO (userError "Seek on HaNS socket.")-  tell _       = throwIO (userError "Tell on HaNS socket.")-  getSize _    = throwIO (userError "getSize on HaNS socket.")-  setSize _ _  = throwIO (userError "setSize on HaNS socket.")-  setEcho _ _  = throwIO (userError "setEcho on HaNS socket.")-  getEcho _    = throwIO (userError "getEcho on HaNS socket.")-  setRaw _ _   = return ()-  devType _    = return Stream-  dup bs       = addRef bs >> return bs-  dup2 _ _     = throwIO (userError "dup2 on HaNS socket.")--instance RawIO BufferedSocket where-  read sock dptr sz =-    do bstr <- recvBytes (bsSocket sock) (fromIntegral sz)-       when (BS.length bstr > 0) $ copyBS (BS.toChunks bstr) dptr sz-       return (fromIntegral (BS.length bstr))-  readNonBlocking sock dptr sz =-    do canGo <- canRecv (bsSocket sock)-       if canGo-          then Just `fmap` read sock dptr sz-          else return (Just 0)-  write sock ptr sz =-    do bstr <- BSS.packCStringLen (castPtr ptr, sz)-       sendAll (bsSocket sock) (BS.fromStrict bstr)-   where-    sendAll sock bstr-      | BS.null bstr = return ()-      | otherwise    = do num <- sendBytes sock bstr-                          sendAll sock (BS.drop (fromIntegral num) bstr)-  writeNonBlocking sock ptr sz =-    do canGo <- canSend (bsSocket sock)-       if canGo-          then do bstr <- BSS.packCStringLen (castPtr ptr, sz)-                  num  <- sendBytes (bsSocket sock) (BS.fromStrict bstr)-                  return (fromIntegral num)-          else return 0--instance BufferedIO BufferedSocket where-  newBuffer         _ = newByteBuffer (64 * 1024)-  fillReadBuffer      = readBuf-  fillReadBuffer0     = readBufNonBlocking-  flushWriteBuffer    = writeBuf-  flushWriteBuffer0   = writeBufNonBlocking--makeHansHandle :: Socket -> IOMode -> IO Handle-makeHansHandle socket mode =-  do buffSocket <- newBufferedSocket socket-     mkFileHandle buffSocket "<socket>" mode Nothing noNewlineTranslation--copyBS :: [BSS.ByteString] -> Ptr a -> Int -> IO ()-copyBS [] _ _ = return ()-copyBS (f:rest) sptr szLeft-  | BSS.null f   = copyBS rest sptr szLeft-  | szLeft <= 0  = return ()-  | otherwise    =-      do let (chunk1, chunk2) = BSS.splitAt szLeft f-             amt              = fromIntegral (BSS.length chunk1)-         BSS.useAsCString chunk1 $ \ dptr -> memcpy dptr sptr amt-         copyBS (chunk2 : rest) (sptr `plusPtr` amt) (szLeft - amt)--foreign import ccall unsafe "string.h memcpy"-  memcpy :: Ptr a -> Ptr b -> Int -> IO ()
src/Network/BSD.hs view
@@ -1,5 +1,5 @@ module Network.BSD(-         HostName(..)+         HostName        , getHostName        , HostEntry(..)        , getHostByName@@ -19,6 +19,7 @@        , setServiceEntry        , endServiceEntry        , ProtocolName+       , ProtocolNumber        , ProtocolEntry(..)        , getProtocolByName        , getProtocolByNumber@@ -36,15 +37,17 @@        , setNetworkEntry        , getNetworkEntry        , endNetworkEntry+       , ifNameToIndex        )  where -import Control.Exception-import Data.Typeable-import Foreign.C.Types-import Hans.Address.IP4-import Network.BSD.ServiceDB-import Network.Socket.Internal+import Control.Exception(throw)+import Data.Typeable(Typeable)+import Foreign.C.Types(CInt, CULong)+import Hans.IP4(packIP4)+import Network.BSD.ServiceDB(ServiceEntry(..), ServiceName, serviceDB)+import Network.Socket.Internal(PortNumber(..), HostAddress, Family(..))+import Network.Socket.Types(fromIP4)  type HostName = String @@ -118,6 +121,10 @@ endServiceEntry :: IO () endServiceEntry  = return () +type ProtocolName = String++type ProtocolNumber = CInt+ data ProtocolEntry = ProtocolEntry {     protoName    :: ProtocolName   , protoAliases :: [ProtocolName]@@ -177,10 +184,10 @@ networkDB :: [NetworkEntry] networkDB  = [     NetworkEntry "default"    [] AF_INET 0-  , NetworkEntry "loopback"   [] AF_INET (convertToWord32' (IP4 127 0 0 0))-  , NetworkEntry "link-local" [] AF_INET (convertToWord32' (IP4 169 254 0 0))+  , NetworkEntry "loopback"   [] AF_INET (fromIP4' (packIP4 127 0 0 0))+  , NetworkEntry "link-local" [] AF_INET (fromIP4' (packIP4 169 254 0 0))   ]- where convertToWord32' = fromIntegral . convertToWord32+ where fromIP4' = fromIntegral . fromIP4  getNetworkByName :: NetworkName -> IO NetworkEntry getNetworkByName nm = return (go networkDB)@@ -209,3 +216,6 @@  endNetworkEntry :: IO () endNetworkEntry = return ()++ifNameToIndex :: String -> IO (Maybe Int)+ifNameToIndex _ = return Nothing
src/Network/BSD/ServiceDB.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -O0 #-}+{-# OPTIONS_GHC -O0 -Rghc-timing #-} module Network.BSD.ServiceDB(          ProtocolName        , ServiceName@@ -7,8 +7,8 @@        )  where -import Data.Typeable-import Data.Word+import Data.Typeable(Typeable)+import Data.Word(Word16) import Network.Socket.Internal(PortNumber(..))  type ProtocolName = String@@ -27,76 +27,76 @@  serviceDB :: [ServiceEntry] serviceDB = [-    makeService "tcpmux"         1    "tcp" []-  , makeService "tcpmux"         1    "udp" []-  , makeService "rje"            5    "tcp" []-  , makeService "rje"            5    "udp" []-  , makeService "echo"           7    "tcp" []-  , makeService "echo"           7    "udp" []-  , makeService "discard"        9    "tcp"  ["sink","null"]-  , makeService "discard"        9    "udp"  ["sink","null"]-  , makeService "systat"         11    "tcp" ["users"]-  , makeService "systat"         11    "udp" ["users"]-  , makeService "daytime"        13    "tcp" []-  , makeService "daytime"        13    "udp" []-  , makeService "qotd"           17    "tcp" ["quote"]-  , makeService "qotd"           17    "udp" ["quote"]-  , makeService "msp"            18    "tcp" []-  , makeService "msp"            18    "udp" []-  , makeService "chargen"        19    "tcp" ["ttytst","source"]-  , makeService "chargen"        19    "udp" ["ttytst","source"]-  , makeService "ftp-data"       20    "tcp" []-  , makeService "ftp-data"       20    "udp" []-  , makeService "ftp"            21    "tcp" []+    makeService "tcpmux"         1    "tcp"   []+  , makeService "tcpmux"         1    "udp"   []+  , makeService "rje"            5    "tcp"   []+  , makeService "rje"            5    "udp"   []+  , makeService "echo"           7    "tcp"   []+  , makeService "echo"           7    "udp"   []+  , makeService "discard"        9    "tcp"   ["sink","null"]+  , makeService "discard"        9    "udp"   ["sink","null"]+  , makeService "systat"         11    "tcp"  ["users"]+  , makeService "systat"         11    "udp"  ["users"]+  , makeService "daytime"        13    "tcp"  []+  , makeService "daytime"        13    "udp"  []+  , makeService "qotd"           17    "tcp"  ["quote"]+  , makeService "qotd"           17    "udp"  ["quote"]+  , makeService "msp"            18    "tcp"  []+  , makeService "msp"            18    "udp"  []+  , makeService "chargen"        19    "tcp"  ["ttytst","source"]+  , makeService "chargen"        19    "udp"  ["ttytst","source"]+  , makeService "ftp-data"       20    "tcp"  []+  , makeService "ftp-data"       20    "udp"  []+  , makeService "ftp"            21    "tcp"  []   , makeService "ftp"            21    "udp"  ["fsp","fspd"]-  , makeService "ssh"            22    "tcp" []-  , makeService "ssh"            22    "udp" []-  , makeService "telnet"         23    "tcp" []-  , makeService "telnet"         23    "udp" []-  , makeService "lmtp"           24    "tcp" []-  , makeService "lmtp"           24    "udp" []-  , makeService "smtp"           25    "tcp" ["mail"]-  , makeService "smtp"           25    "udp" ["mail"]-  , makeService "time"           37    "tcp" ["timserver"]-  , makeService "time"           37    "udp" ["timserver"]-  , makeService "rlp"            39    "tcp" ["resource"]-  , makeService "rlp"            39    "udp" ["resource"]-  , makeService "nameserver"     42    "tcp" ["name"]-  , makeService "nameserver"     42    "udp" ["name"]-  , makeService "nicname"        43    "tcp" ["whois"]-  , makeService "nicname"        43    "udp" ["whois"]-  , makeService "tacacs"         49    "tcp" []-  , makeService "tacacs"         49    "udp" []-  , makeService "re-mail-ck"     50    "tcp" []-  , makeService "re-mail-ck"     50    "udp" []-  , makeService "domain"         53    "tcp" []-  , makeService "domain"         53    "udp" []-  , makeService "whois++"        63    "tcp" ["whoispp"]-  , makeService "whois++"        63    "udp" ["whoispp"]-  , makeService "bootps"         67    "tcp" []-  , makeService "bootps"         67    "udp" []-  , makeService "bootpc"         68    "tcp" ["dhcpc"]-  , makeService "bootpc"         68    "udp" ["dhcpc"]-  , makeService "tftp"           69    "tcp" []-  , makeService "tftp"           69    "udp" []-  , makeService "gopher"         70    "tcp" []-  , makeService "gopher"         70    "udp" []-  , makeService "netrjs-1"       71    "tcp" []-  , makeService "netrjs-1"       71    "udp" []-  , makeService "netrjs-2"       72    "tcp" []-  , makeService "netrjs-2"       72    "udp" []-  , makeService "netrjs-3"       73    "tcp" []-  , makeService "netrjs-3"       73    "udp" []-  , makeService "netrjs-4"       74    "tcp" []-  , makeService "netrjs-4"       74    "udp" []-  , makeService "finger"         79    "tcp" []-  , makeService "finger"         79    "udp" []-  , makeService "http"           80    "tcp" ["www","www-http"]-  , makeService "http"           80    "udp" ["www","www-http"]-  , makeService "kerberos"       88    "tcp" ["kerberos5","krb5"]-  , makeService "kerberos"       88    "udp" ["kerberos5","krb5"]-  , makeService "supdup"         95    "tcp" []-  , makeService "supdup"         95    "udp" []+  , makeService "ssh"            22    "tcp"  []+  , makeService "ssh"            22    "udp"  []+  , makeService "telnet"         23    "tcp"  []+  , makeService "telnet"         23    "udp"  []+  , makeService "lmtp"           24    "tcp"  []+  , makeService "lmtp"           24    "udp"  []+  , makeService "smtp"           25    "tcp"  ["mail"]+  , makeService "smtp"           25    "udp"  ["mail"]+  , makeService "time"           37    "tcp"  ["timserver"]+  , makeService "time"           37    "udp"  ["timserver"]+  , makeService "rlp"            39    "tcp"  ["resource"]+  , makeService "rlp"            39    "udp"  ["resource"]+  , makeService "nameserver"     42    "tcp"  ["name"]+  , makeService "nameserver"     42    "udp"  ["name"]+  , makeService "nicname"        43    "tcp"  ["whois"]+  , makeService "nicname"        43    "udp"  ["whois"]+  , makeService "tacacs"         49    "tcp"  []+  , makeService "tacacs"         49    "udp"  []+  , makeService "re-mail-ck"     50    "tcp"  []+  , makeService "re-mail-ck"     50    "udp"  []+  , makeService "domain"         53    "tcp"  []+  , makeService "domain"         53    "udp"  []+  , makeService "whois++"        63    "tcp"  ["whoispp"]+  , makeService "whois++"        63    "udp"  ["whoispp"]+  , makeService "bootps"         67    "tcp"  []+  , makeService "bootps"         67    "udp"  []+  , makeService "bootpc"         68    "tcp"  ["dhcpc"]+  , makeService "bootpc"         68    "udp"  ["dhcpc"]+  , makeService "tftp"           69    "tcp"  []+  , makeService "tftp"           69    "udp"  []+  , makeService "gopher"         70    "tcp"  []+  , makeService "gopher"         70    "udp"  []+  , makeService "netrjs-1"       71    "tcp"  []+  , makeService "netrjs-1"       71    "udp"  []+  , makeService "netrjs-2"       72    "tcp"  []+  , makeService "netrjs-2"       72    "udp"  []+  , makeService "netrjs-3"       73    "tcp"  []+  , makeService "netrjs-3"       73    "udp"  []+  , makeService "netrjs-4"       74    "tcp"  []+  , makeService "netrjs-4"       74    "udp"  []+  , makeService "finger"         79    "tcp"  []+  , makeService "finger"         79    "udp"  []+  , makeService "http"           80    "tcp"  ["www","www-http"]+  , makeService "http"           80    "udp"  ["www","www-http"]+  , makeService "kerberos"       88    "tcp"  ["kerberos5","krb5"]+  , makeService "kerberos"       88    "udp"  ["kerberos5","krb5"]+  , makeService "supdup"         95    "tcp"  []+  , makeService "supdup"         95    "udp"  []   , makeService "hostname"       101    "tcp" ["hostnames"]   , makeService "hostname"       101    "udp" ["hostnames"]   , makeService "iso-tsap"       102    "tcp" ["tsap"]@@ -286,169 +286,169 @@   , makeService "afpovertcp"     548    "tcp" []   , makeService "afpovertcp"     548    "udp" []   , makeService "remotefs"       556    "tcp" ["rfs_server","rfs"]-  , makeService "socks"          1080    "tcp" []-  , makeService "socks"          1080    "udp" []-  , makeService "bvcontrol"      1236    "tcp" ["rmtcfg"]-  , makeService "bvcontrol"      1236    "udp" []-  , makeService "h323hostcallsc" 1300    "tcp" []-  , makeService "h323hostcallsc" 1300    "udp" []-  , makeService "ms-sql-s"       1433    "tcp" []-  , makeService "ms-sql-s"       1433    "udp" []-  , makeService "ms-sql-m"       1434    "tcp" []-  , makeService "ms-sql-m"       1434    "udp" []-  , makeService "ica"            1494    "tcp" []-  , makeService "ica"            1494    "udp" []-  , makeService "wins"           1512    "tcp" []-  , makeService "wins"           1512    "udp" []-  , makeService "ingreslock"     1524    "tcp" []-  , makeService "ingreslock"     1524    "udp" []-  , makeService "prospero-np"    1525    "tcp" ["orasrv"]-  , makeService "prospero-np"    1525    "udp" ["orasrv"]-  , makeService "datametrics"    1645    "tcp" ["old-radius","sightline"]-  , makeService "datametrics"    1645    "udp" ["old-radius","sightline"]-  , makeService "sa-msg-port"    1646    "tcp" ["old-radacct"]-  , makeService "sa-msg-port"    1646    "udp" ["old-radacct"]-  , makeService "kermit"         1649    "tcp" []-  , makeService "kermit"         1649    "udp" []-  , makeService "l2tp"           1701    "tcp" ["l2f"]-  , makeService "l2tp"           1701    "udp" ["l2f"]-  , makeService "h323gatedisc"   1718    "tcp" []-  , makeService "h323gatedisc"   1718    "udp" []-  , makeService "h323gatestat"   1719    "tcp" []-  , makeService "h323gatestat"   1719    "udp" []-  , makeService "h323hostcall"   1720    "tcp" []-  , makeService "h323hostcall"   1720    "udp" []-  , makeService "tftp-mcast"     1758    "tcp" []-  , makeService "tftp-mcast"     1758    "udp" []-  , makeService "mtftp"          1759    "udp" ["spss-lm"]-  , makeService "hello"          1789    "tcp" []-  , makeService "hello"          1789    "udp" []-  , makeService "radius"         1812    "tcp" []-  , makeService "radius"         1812    "udp" []-  , makeService "radius-acct"    1813    "tcp" ["radacct"]-  , makeService "radius-acct"    1813    "udp" ["radacct"]-  , makeService "mtp"            1911    "tcp" []-  , makeService "mtp"            1911    "udp" []-  , makeService "hsrp"           1985    "tcp" []-  , makeService "hsrp"           1985    "udp" []-  , makeService "licensedaemon"  1986    "tcp" []-  , makeService "licensedaemon"  1986    "udp" []-  , makeService "gdp-port"       1997    "tcp" []-  , makeService "gdp-port"       1997    "udp" []-  , makeService "sieve-filter"   2000    "tcp" ["cisco-sccp"]-  , makeService "sieve-filter"   2000    "udp" ["cisco-sccp"]-  , makeService "nfs"            2049    "tcp" ["nfsd","shilp"]-  , makeService "nfs"            2049    "udp" ["nfsd","shilp"]-  , makeService "zephyr-srv"     2102    "tcp" []-  , makeService "zephyr-srv"     2102    "udp" []-  , makeService "zephyr-clt"     2103    "tcp" []-  , makeService "zephyr-clt"     2103    "udp" []-  , makeService "zephyr-hm"      2104    "tcp" []-  , makeService "zephyr-hm"      2104    "udp" []-  , makeService "cvspserver"     2401    "tcp" []-  , makeService "cvspserver"     2401    "udp" []-  , makeService "venus"          2430    "tcp" []-  , makeService "venus"          2430    "udp" []-  , makeService "venus-se"       2431    "tcp" []-  , makeService "venus-se"       2431    "udp" []-  , makeService "codasrv"        2432    "tcp" []-  , makeService "codasrv"        2432    "udp" []-  , makeService "codasrv-se"     2433    "tcp" []-  , makeService "codasrv-se"     2433    "udp" []-  , makeService "hpstgmgr"       2600    "tcp" ["zebrasrv"]-  , makeService "hpstgmgr"       2600    "udp" []-  , makeService "discp-client"   2601    "tcp" ["zebra"]-  , makeService "discp-client"   2601    "udp" []-  , makeService "discp-server"   2602    "tcp" ["ripd"]-  , makeService "discp-server"   2602    "udp" []-  , makeService "servicemeter"   2603    "tcp" ["ripngd"]-  , makeService "servicemeter"   2603    "udp" []-  , makeService "nsc-ccs"        2604    "tcp" ["ospfd"]-  , makeService "nsc-ccs"        2604    "udp" []-  , makeService "nsc-posa"       2605    "tcp" ["bgpd"]-  , makeService "nsc-posa"       2605    "udp" []-  , makeService "netmon"         2606    "tcp" ["ospf6d"]-  , makeService "netmon"         2606    "udp" []-  , makeService "dict"           2628    "tcp" []-  , makeService "dict"           2628    "udp" []-  , makeService "corbaloc"       2809    "tcp" []-  , makeService "icpv2"          3130    "tcp" []-  , makeService "icpv2"          3130    "udp" []-  , makeService "mysql"          3306    "tcp" []-  , makeService "mysql"          3306    "udp" []-  , makeService "trnsprntproxy"  3346    "tcp" []-  , makeService "trnsprntproxy"  3346    "udp" []-  , makeService "pxe"            4011    "udp" ["altserviceboot"]-  , makeService "fud"            4201    "udp" []-  , makeService "rwhois"         4321    "tcp" []-  , makeService "rwhois"         4321    "udp" []-  , makeService "krb524"         4444    "tcp" ["nv-video"]-  , makeService "krb524"         4444    "udp" ["nv-video"]-  , makeService "rfe"            5002    "tcp" []-  , makeService "rfe"            5002    "udp" []-  , makeService "cfengine"       5308    "tcp" []-  , makeService "cfengine"       5308    "udp" []-  , makeService "cvsup"          5999    "tcp" ["CVSup"]-  , makeService "cvsup"          5999    "udp" ["CVSup"]-  , makeService "x11"            6000    "tcp" ["X"]-  , makeService "afs3-fileserver"7000    "tcp" []-  , makeService "afs3-fileserver"7000    "udp" []-  , makeService "afs3-callback"  7001    "tcp" []-  , makeService "afs3-callback"  7001    "udp" []-  , makeService "afs3-prserver"  7002    "tcp" []-  , makeService "afs3-prserver"  7002    "udp" []-  , makeService "afs3-vlserver"  7003    "tcp" []-  , makeService "afs3-vlserver"  7003    "udp" []-  , makeService "afs3-kaserver"  7004    "tcp" []-  , makeService "afs3-kaserver"  7004    "udp" []-  , makeService "afs3-volser"    7005    "tcp" []-  , makeService "afs3-volser"    7005    "udp" []-  , makeService "afs3-errors"    7006    "tcp" []-  , makeService "afs3-errors"    7006    "udp" []-  , makeService "afs3-bos"       7007    "tcp" []-  , makeService "afs3-bos"       7007    "udp" []-  , makeService "afs3-update"    7008    "tcp" []-  , makeService "afs3-update"    7008    "udp" []-  , makeService "afs3-rmtsys"    7009    "tcp" []-  , makeService "afs3-rmtsys"    7009    "udp" []-  , makeService "amanda"         10080    "tcp" []-  , makeService "amanda"         10080    "udp" []-  , makeService "pgpkeyserver"   11371    "tcp" ["hkp"]-  , makeService "pgpkeyserver"   11371    "udp" ["hkp"]-  , makeService "asgcypresstcps" 11489    "tcp" []-  , makeService "h323callsigalt" 11720    "tcp" []-  , makeService "h323callsigalt" 11720    "udp" []-  , makeService "bprd"           13720    "tcp" []-  , makeService "bprd"           13720    "udp" []-  , makeService "bpdbm"          13721    "tcp" []-  , makeService "bpdbm"          13721    "udp" []-  , makeService "bpjava-msvc"    13722    "tcp" []-  , makeService "bpjava-msvc"    13722    "udp" []-  , makeService "vnetd"          13724    "tcp" []-  , makeService "vnetd"          13724    "udp" []-  , makeService "bpcd"           13782    "tcp" []-  , makeService "bpcd"           13782    "udp" []-  , makeService "vopied"         13783    "tcp" []-  , makeService "vopied"         13783    "udp" []-  , makeService "wnn6"           22273    "tcp" ["wnn4"]-  , makeService "wnn6"           22273    "udp" ["wnn4"]-  , makeService "quake"          26000    "tcp" []-  , makeService "quake"          26000    "udp" []-  , makeService "wnn6-ds"        26208    "tcp" []-  , makeService "wnn6-ds"        26208    "udp" []-  , makeService "traceroute"     33434    "tcp" []-  , makeService "traceroute"     33434    "udp" []+  , makeService "socks"          1080   "tcp" []+  , makeService "socks"          1080   "udp" []+  , makeService "bvcontrol"      1236   "tcp" ["rmtcfg"]+  , makeService "bvcontrol"      1236   "udp" []+  , makeService "h323hostcallsc" 1300   "tcp" []+  , makeService "h323hostcallsc" 1300   "udp" []+  , makeService "ms-sql-s"       1433   "tcp" []+  , makeService "ms-sql-s"       1433   "udp" []+  , makeService "ms-sql-m"       1434   "tcp" []+  , makeService "ms-sql-m"       1434   "udp" []+  , makeService "ica"            1494   "tcp" []+  , makeService "ica"            1494   "udp" []+  , makeService "wins"           1512   "tcp" []+  , makeService "wins"           1512   "udp" []+  , makeService "ingreslock"     1524   "tcp" []+  , makeService "ingreslock"     1524   "udp" []+  , makeService "prospero-np"    1525   "tcp" ["orasrv"]+  , makeService "prospero-np"    1525   "udp" ["orasrv"]+  , makeService "datametrics"    1645   "tcp" ["old-radius","sightline"]+  , makeService "datametrics"    1645   "udp" ["old-radius","sightline"]+  , makeService "sa-msg-port"    1646   "tcp" ["old-radacct"]+  , makeService "sa-msg-port"    1646   "udp" ["old-radacct"]+  , makeService "kermit"         1649   "tcp" []+  , makeService "kermit"         1649   "udp" []+  , makeService "l2tp"           1701   "tcp" ["l2f"]+  , makeService "l2tp"           1701   "udp" ["l2f"]+  , makeService "h323gatedisc"   1718   "tcp" []+  , makeService "h323gatedisc"   1718   "udp" []+  , makeService "h323gatestat"   1719   "tcp" []+  , makeService "h323gatestat"   1719   "udp" []+  , makeService "h323hostcall"   1720   "tcp" []+  , makeService "h323hostcall"   1720   "udp" []+  , makeService "tftp-mcast"     1758   "tcp" []+  , makeService "tftp-mcast"     1758   "udp" []+  , makeService "mtftp"          1759   "udp" ["spss-lm"]+  , makeService "hello"          1789   "tcp" []+  , makeService "hello"          1789   "udp" []+  , makeService "radius"         1812   "tcp" []+  , makeService "radius"         1812   "udp" []+  , makeService "radius-acct"    1813   "tcp" ["radacct"]+  , makeService "radius-acct"    1813   "udp" ["radacct"]+  , makeService "mtp"            1911   "tcp" []+  , makeService "mtp"            1911   "udp" []+  , makeService "hsrp"           1985   "tcp" []+  , makeService "hsrp"           1985   "udp" []+  , makeService "licensedaemon"  1986   "tcp" []+  , makeService "licensedaemon"  1986   "udp" []+  , makeService "gdp-port"       1997   "tcp" []+  , makeService "gdp-port"       1997   "udp" []+  , makeService "sieve-filter"   2000   "tcp" ["cisco-sccp"]+  , makeService "sieve-filter"   2000   "udp" ["cisco-sccp"]+  , makeService "nfs"            2049   "tcp" ["nfsd","shilp"]+  , makeService "nfs"            2049   "udp" ["nfsd","shilp"]+  , makeService "zephyr-srv"     2102   "tcp" []+  , makeService "zephyr-srv"     2102   "udp" []+  , makeService "zephyr-clt"     2103   "tcp" []+  , makeService "zephyr-clt"     2103   "udp" []+  , makeService "zephyr-hm"      2104   "tcp" []+  , makeService "zephyr-hm"      2104   "udp" []+  , makeService "cvspserver"     2401   "tcp" []+  , makeService "cvspserver"     2401   "udp" []+  , makeService "venus"          2430   "tcp" []+  , makeService "venus"          2430   "udp" []+  , makeService "venus-se"       2431   "tcp" []+  , makeService "venus-se"       2431   "udp" []+  , makeService "codasrv"        2432   "tcp" []+  , makeService "codasrv"        2432   "udp" []+  , makeService "codasrv-se"     2433   "tcp" []+  , makeService "codasrv-se"     2433   "udp" []+  , makeService "hpstgmgr"       2600   "tcp" ["zebrasrv"]+  , makeService "hpstgmgr"       2600   "udp" []+  , makeService "discp-client"   2601   "tcp" ["zebra"]+  , makeService "discp-client"   2601   "udp" []+  , makeService "discp-server"   2602   "tcp" ["ripd"]+  , makeService "discp-server"   2602   "udp" []+  , makeService "servicemeter"   2603   "tcp" ["ripngd"]+  , makeService "servicemeter"   2603   "udp" []+  , makeService "nsc-ccs"        2604   "tcp" ["ospfd"]+  , makeService "nsc-ccs"        2604   "udp" []+  , makeService "nsc-posa"       2605   "tcp" ["bgpd"]+  , makeService "nsc-posa"       2605   "udp" []+  , makeService "netmon"         2606   "tcp" ["ospf6d"]+  , makeService "netmon"         2606   "udp" []+  , makeService "dict"           2628   "tcp" []+  , makeService "dict"           2628   "udp" []+  , makeService "corbaloc"       2809   "tcp" []+  , makeService "icpv2"          3130   "tcp" []+  , makeService "icpv2"          3130   "udp" []+  , makeService "mysql"          3306   "tcp" []+  , makeService "mysql"          3306   "udp" []+  , makeService "trnsprntproxy"  3346   "tcp" []+  , makeService "trnsprntproxy"  3346   "udp" []+  , makeService "pxe"            4011   "udp" ["altserviceboot"]+  , makeService "fud"            4201   "udp" []+  , makeService "rwhois"         4321   "tcp" []+  , makeService "rwhois"         4321   "udp" []+  , makeService "krb524"         4444   "tcp" ["nv-video"]+  , makeService "krb524"         4444   "udp" ["nv-video"]+  , makeService "rfe"            5002   "tcp" []+  , makeService "rfe"            5002   "udp" []+  , makeService "cfengine"       5308   "tcp" []+  , makeService "cfengine"       5308   "udp" []+  , makeService "cvsup"          5999   "tcp" ["CVSup"]+  , makeService "cvsup"          5999   "udp" ["CVSup"]+  , makeService "x11"            6000   "tcp" ["X"]+  , makeService "afs3-fileserver"7000   "tcp" []+  , makeService "afs3-fileserver"7000   "udp" []+  , makeService "afs3-callback"  7001   "tcp" []+  , makeService "afs3-callback"  7001   "udp" []+  , makeService "afs3-prserver"  7002   "tcp" []+  , makeService "afs3-prserver"  7002   "udp" []+  , makeService "afs3-vlserver"  7003   "tcp" []+  , makeService "afs3-vlserver"  7003   "udp" []+  , makeService "afs3-kaserver"  7004   "tcp" []+  , makeService "afs3-kaserver"  7004   "udp" []+  , makeService "afs3-volser"    7005   "tcp" []+  , makeService "afs3-volser"    7005   "udp" []+  , makeService "afs3-errors"    7006   "tcp" []+  , makeService "afs3-errors"    7006   "udp" []+  , makeService "afs3-bos"       7007   "tcp" []+  , makeService "afs3-bos"       7007   "udp" []+  , makeService "afs3-update"    7008   "tcp" []+  , makeService "afs3-update"    7008   "udp" []+  , makeService "afs3-rmtsys"    7009   "tcp" []+  , makeService "afs3-rmtsys"    7009   "udp" []+  , makeService "amanda"         10080  "tcp" []+  , makeService "amanda"         10080  "udp" []+  , makeService "pgpkeyserver"   11371  "tcp" ["hkp"]+  , makeService "pgpkeyserver"   11371  "udp" ["hkp"]+  , makeService "asgcypresstcps" 11489  "tcp" []+  , makeService "h323callsigalt" 11720  "tcp" []+  , makeService "h323callsigalt" 11720  "udp" []+  , makeService "bprd"           13720  "tcp" []+  , makeService "bprd"           13720  "udp" []+  , makeService "bpdbm"          13721  "tcp" []+  , makeService "bpdbm"          13721  "udp" []+  , makeService "bpjava-msvc"    13722  "tcp" []+  , makeService "bpjava-msvc"    13722  "udp" []+  , makeService "vnetd"          13724  "tcp" []+  , makeService "vnetd"          13724  "udp" []+  , makeService "bpcd"           13782  "tcp" []+  , makeService "bpcd"           13782  "udp" []+  , makeService "vopied"         13783  "tcp" []+  , makeService "vopied"         13783  "udp" []+  , makeService "wnn6"           22273  "tcp" ["wnn4"]+  , makeService "wnn6"           22273  "udp" ["wnn4"]+  , makeService "quake"          26000  "tcp" []+  , makeService "quake"          26000  "udp" []+  , makeService "wnn6-ds"        26208  "tcp" []+  , makeService "wnn6-ds"        26208  "udp" []+  , makeService "traceroute"     33434  "tcp" []+  , makeService "traceroute"     33434  "udp" []   , makeService "kerberos_master"751    "udp" ["pump"]   , makeService "kerberos_master"751    "tcp" ["pump"]   , makeService "passwd_server"  752    "udp" ["qrh"]   , makeService "krbupdate"      760    "tcp" ["kreg","ns"]-  , makeService "kpop"           1109    "tcp" []-  , makeService "knetd"          2053    "tcp" ["lot105-ds-upd"]+  , makeService "kpop"           1109   "tcp" []+  , makeService "knetd"          2053   "tcp" ["lot105-ds-upd"]   , makeService "krb5_prop"      754    "tcp" ["tell"]-  , makeService "eklogin"        2105    "tcp" ["minipay"]+  , makeService "eklogin"        2105   "tcp" ["minipay"]   , makeService "supfilesrv"     871    "tcp" []-  , makeService "supfiledbg"     1127    "tcp" ["kwdb-commn"]-  , makeService "netstat"        15    "tcp" []+  , makeService "supfiledbg"     1127   "tcp" ["kwdb-commn"]+  , makeService "netstat"        15     "tcp" []   , makeService "poppassd"       106    "tcp" []   , makeService "poppassd"       106    "udp" []   , makeService "omirr"          808    "tcp" ["omirrd"]@@ -456,135 +456,135 @@   , makeService "swat"           901    "tcp" ["smpnameres"]   , makeService "rndc"           953    "tcp" []   , makeService "rndc"           953    "udp" []-  , makeService "skkserv"        1178    "tcp" ["sgi-storman"]-  , makeService "xtel"           1313    "tcp" ["bmc_patroldb","bmc-patroldb"]-  , makeService "support"        1529    "tcp" ["prmsd","gnatsd","coauthor"]-  , makeService "cfinger"        2003    "tcp" ["brutus"]-  , makeService "ninstall"       2150    "tcp" ["dynamic3d"]-  , makeService "ninstall"       2150    "udp" ["dynamic3d"]-  , makeService "afbackup"       2988    "tcp" ["hippad"]-  , makeService "afbackup"       2988    "udp" ["hippad"]-  , makeService "squid"          3128    "tcp" ["ndl-aas"]-  , makeService "prsvp"          3455    "tcp" []-  , makeService "prsvp"          3455    "udp" []-  , makeService "distcc"         3632    "tcp" []-  , makeService "svn"            3690    "tcp" []-  , makeService "svn"            3690    "udp" []-  , makeService "postgres"       5432    "tcp" ["postgresql"]-  , makeService "postgres"       5432    "udp" ["postgresql"]-  , makeService "fax"            4557    "tcp" []-  , makeService "hylafax"        4559    "tcp" []-  , makeService "sgi-dgl"        5232    "tcp" ["csedaemon"]-  , makeService "sgi-dgl"        5232    "udp" []-  , makeService "hostmon"        5355    "tcp" ["llmnr"]-  , makeService "hostmon"        5355    "udp" ["llmnr"]-  , makeService "canna"          5680    "tcp" ["auriga-router"]-  , makeService "x11-ssh-offset" 6010    "tcp" []-  , makeService "xfs"            7100    "tcp" ["font-service"]-  , makeService "tircproxy"      7666    "tcp" []-  , makeService "webcache"       8080    "tcp" ["http-alt"]-  , makeService "webcache"       8080    "udp" ["http-alt"]-  , makeService "tproxy"         8081    "tcp" ["sunproxyadmin"]-  , makeService "tproxy"         8081    "udp" ["sunproxyadmin"]-  , makeService "jetdirect"      9100    "tcp" ["laserjet","hplj","hp-pdl-datastr","pdl-datastream"]-  , makeService "mandelspawn"    9359    "udp" ["mandelbrot"]-  , makeService "kamanda"        10081    "tcp" ["famdc"]-  , makeService "kamanda"        10081    "udp" ["famdc"]-  , makeService "amandaidx"      10082    "tcp" []-  , makeService "amidxtape"      10083    "tcp" []-  , makeService "isdnlog"        20011    "tcp" []-  , makeService "isdnlog"        20011    "udp" []-  , makeService "wnn4_Kr"        22305    "tcp" ["cis"]-  , makeService "wnn4_Cn"        22289    "tcp" []-  , makeService "wnn4_Tw"        22321    "tcp" []-  , makeService "binkp"          24554    "tcp" []-  , makeService "binkp"          24554    "udp" []-  , makeService "canditv"        24676    "tcp" []-  , makeService "canditv"        24676    "udp" []-  , makeService "asp"            27374    "tcp" []-  , makeService "asp"            27374    "udp" []-  , makeService "tfido"          60177    "tcp" []-  , makeService "tfido"          60177    "udp" []-  , makeService "fido"           60179    "tcp" []-  , makeService "fido"           60179    "udp" []-  , makeService "compressnet"    2    "tcp" []-  , makeService "compressnet"    2    "udp" []-  , makeService "nsw-fe"         27    "tcp" []-  , makeService "nsw-fe"         27    "udp" []-  , makeService "msg-icp"        29    "tcp" []-  , makeService "msg-icp"        29    "udp" []-  , makeService "msg-auth"       31    "tcp" []-  , makeService "msg-auth"       31    "udp" []-  , makeService "dsp"            33    "tcp" []-  , makeService "dsp"            33    "udp" []-  , makeService "rap"            38    "tcp" []-  , makeService "rap"            38    "udp" []-  , makeService "graphics"       41    "tcp" []-  , makeService "graphics"       41    "udp" []-  , makeService "mpm-flags"      44    "tcp" []-  , makeService "mpm-flags"      44    "udp" []-  , makeService "mpm"            45    "tcp" []-  , makeService "mpm"            45    "udp" []-  , makeService "mpm-snd"        46    "tcp" []-  , makeService "mpm-snd"        46    "udp" []-  , makeService "ni-ftp"         47    "tcp" []-  , makeService "ni-ftp"         47    "udp" []-  , makeService "auditd"         48    "tcp" []-  , makeService "auditd"         48    "udp" []-  , makeService "la-maint"       51    "tcp" []-  , makeService "la-maint"       51    "udp" []-  , makeService "xns-time"       52    "tcp" []-  , makeService "xns-time"       52    "udp" []-  , makeService "xns-ch"         54    "tcp" []-  , makeService "xns-ch"         54    "udp" []-  , makeService "isi-gl"         55    "tcp" []-  , makeService "isi-gl"         55    "udp" []-  , makeService "xns-auth"       56    "tcp" []-  , makeService "xns-auth"       56    "udp" []-  , makeService "xns-mail"       58    "tcp" []-  , makeService "xns-mail"       58    "udp" []-  , makeService "ni-mail"        61    "tcp" []-  , makeService "ni-mail"        61    "udp" []-  , makeService "acas"           62    "tcp" []-  , makeService "acas"           62    "udp" []-  , makeService "covia"          64    "tcp" []-  , makeService "covia"          64    "udp" []-  , makeService "tacacs-ds"      65    "tcp" []-  , makeService "tacacs-ds"      65    "udp" []-  , makeService "sql*net"        66    "tcp" []-  , makeService "sql*net"        66    "udp" []-  , makeService "deos"           76    "tcp" []-  , makeService "deos"           76    "udp" []-  , makeService "vettcp"         78    "tcp" []-  , makeService "vettcp"         78    "udp" []-  , makeService "xfer"           82    "tcp" []-  , makeService "xfer"           82    "udp" []-  , makeService "mit-ml-dev"     83    "tcp" []-  , makeService "mit-ml-dev"     83    "udp" []-  , makeService "ctf"            84    "tcp" []-  , makeService "ctf"            84    "udp" []-  , makeService "mfcobol"        86    "tcp" []-  , makeService "mfcobol"        86    "udp" []-  , makeService "su-mit-tg"      89    "tcp" []-  , makeService "su-mit-tg"      89    "udp" []-  , makeService "dnsix"          90    "tcp" []-  , makeService "dnsix"          90    "udp" []-  , makeService "mit-dov"        91    "tcp" []-  , makeService "mit-dov"        91    "udp" []-  , makeService "npp"            92    "tcp" []-  , makeService "npp"            92    "udp" []-  , makeService "dcp"            93    "tcp" []-  , makeService "dcp"            93    "udp" []-  , makeService "objcall"        94    "tcp" []-  , makeService "objcall"        94    "udp" []-  , makeService "dixie"          96    "tcp" []-  , makeService "dixie"          96    "udp" []-  , makeService "swift-rvf"      97    "tcp" []-  , makeService "swift-rvf"      97    "udp" []-  , makeService "tacnews"        98    "tcp" []-  , makeService "tacnews"        98    "udp" []-  , makeService "metagram"       99    "tcp" []-  , makeService "metagram"       99    "udp" []+  , makeService "skkserv"        1178   "tcp" ["sgi-storman"]+  , makeService "xtel"           1313   "tcp" ["bmc_patroldb","bmc-patroldb"]+  , makeService "support"        1529   "tcp" ["prmsd","gnatsd","coauthor"]+  , makeService "cfinger"        2003   "tcp" ["brutus"]+  , makeService "ninstall"       2150   "tcp" ["dynamic3d"]+  , makeService "ninstall"       2150   "udp" ["dynamic3d"]+  , makeService "afbackup"       2988   "tcp" ["hippad"]+  , makeService "afbackup"       2988   "udp" ["hippad"]+  , makeService "squid"          3128   "tcp" ["ndl-aas"]+  , makeService "prsvp"          3455   "tcp" []+  , makeService "prsvp"          3455   "udp" []+  , makeService "distcc"         3632   "tcp" []+  , makeService "svn"            3690   "tcp" []+  , makeService "svn"            3690   "udp" []+  , makeService "postgres"       5432   "tcp" ["postgresql"]+  , makeService "postgres"       5432   "udp" ["postgresql"]+  , makeService "fax"            4557   "tcp" []+  , makeService "hylafax"        4559   "tcp" []+  , makeService "sgi-dgl"        5232   "tcp" ["csedaemon"]+  , makeService "sgi-dgl"        5232   "udp" []+  , makeService "hostmon"        5355   "tcp" ["llmnr"]+  , makeService "hostmon"        5355   "udp" ["llmnr"]+  , makeService "canna"          5680   "tcp" ["auriga-router"]+  , makeService "x11-ssh-offset" 6010   "tcp" []+  , makeService "xfs"            7100   "tcp" ["font-service"]+  , makeService "tircproxy"      7666   "tcp" []+  , makeService "webcache"       8080   "tcp" ["http-alt"]+  , makeService "webcache"       8080   "udp" ["http-alt"]+  , makeService "tproxy"         8081   "tcp" ["sunproxyadmin"]+  , makeService "tproxy"         8081   "udp" ["sunproxyadmin"]+  , makeService "jetdirect"      9100   "tcp" ["laserjet","hplj","hp-pdl-datastr","pdl-datastream"]+  , makeService "mandelspawn"    9359   "udp" ["mandelbrot"]+  , makeService "kamanda"        10081  "tcp" ["famdc"]+  , makeService "kamanda"        10081  "udp" ["famdc"]+  , makeService "amandaidx"      10082  "tcp" []+  , makeService "amidxtape"      10083  "tcp" []+  , makeService "isdnlog"        20011  "tcp" []+  , makeService "isdnlog"        20011  "udp" []+  , makeService "wnn4_Kr"        22305  "tcp" ["cis"]+  , makeService "wnn4_Cn"        22289  "tcp" []+  , makeService "wnn4_Tw"        22321  "tcp" []+  , makeService "binkp"          24554  "tcp" []+  , makeService "binkp"          24554  "udp" []+  , makeService "canditv"        24676  "tcp" []+  , makeService "canditv"        24676  "udp" []+  , makeService "asp"            27374  "tcp" []+  , makeService "asp"            27374  "udp" []+  , makeService "tfido"          60177  "tcp" []+  , makeService "tfido"          60177  "udp" []+  , makeService "fido"           60179  "tcp" []+  , makeService "fido"           60179  "udp" []+  , makeService "compressnet"    2      "tcp" []+  , makeService "compressnet"    2      "udp" []+  , makeService "nsw-fe"         27     "tcp" []+  , makeService "nsw-fe"         27     "udp" []+  , makeService "msg-icp"        29     "tcp" []+  , makeService "msg-icp"        29     "udp" []+  , makeService "msg-auth"       31     "tcp" []+  , makeService "msg-auth"       31     "udp" []+  , makeService "dsp"            33     "tcp" []+  , makeService "dsp"            33     "udp" []+  , makeService "rap"            38     "tcp" []+  , makeService "rap"            38     "udp" []+  , makeService "graphics"       41     "tcp" []+  , makeService "graphics"       41     "udp" []+  , makeService "mpm-flags"      44     "tcp" []+  , makeService "mpm-flags"      44     "udp" []+  , makeService "mpm"            45     "tcp" []+  , makeService "mpm"            45     "udp" []+  , makeService "mpm-snd"        46     "tcp" []+  , makeService "mpm-snd"        46     "udp" []+  , makeService "ni-ftp"         47     "tcp" []+  , makeService "ni-ftp"         47     "udp" []+  , makeService "auditd"         48     "tcp" []+  , makeService "auditd"         48     "udp" []+  , makeService "la-maint"       51     "tcp" []+  , makeService "la-maint"       51     "udp" []+  , makeService "xns-time"       52     "tcp" []+  , makeService "xns-time"       52     "udp" []+  , makeService "xns-ch"         54     "tcp" []+  , makeService "xns-ch"         54     "udp" []+  , makeService "isi-gl"         55     "tcp" []+  , makeService "isi-gl"         55     "udp" []+  , makeService "xns-auth"       56     "tcp" []+  , makeService "xns-auth"       56     "udp" []+  , makeService "xns-mail"       58     "tcp" []+  , makeService "xns-mail"       58     "udp" []+  , makeService "ni-mail"        61     "tcp" []+  , makeService "ni-mail"        61     "udp" []+  , makeService "acas"           62     "tcp" []+  , makeService "acas"           62     "udp" []+  , makeService "covia"          64     "tcp" []+  , makeService "covia"          64     "udp" []+  , makeService "tacacs-ds"      65     "tcp" []+  , makeService "tacacs-ds"      65     "udp" []+  , makeService "sql*net"        66     "tcp" []+  , makeService "sql*net"        66     "udp" []+  , makeService "deos"           76     "tcp" []+  , makeService "deos"           76     "udp" []+  , makeService "vettcp"         78     "tcp" []+  , makeService "vettcp"         78     "udp" []+  , makeService "xfer"           82     "tcp" []+  , makeService "xfer"           82     "udp" []+  , makeService "mit-ml-dev"     83     "tcp" []+  , makeService "mit-ml-dev"     83     "udp" []+  , makeService "ctf"            84     "tcp" []+  , makeService "ctf"            84     "udp" []+  , makeService "mfcobol"        86     "tcp" []+  , makeService "mfcobol"        86     "udp" []+  , makeService "su-mit-tg"      89     "tcp" []+  , makeService "su-mit-tg"      89     "udp" []+  , makeService "dnsix"          90     "tcp" []+  , makeService "dnsix"          90     "udp" []+  , makeService "mit-dov"        91     "tcp" []+  , makeService "mit-dov"        91     "udp" []+  , makeService "npp"            92     "tcp" []+  , makeService "npp"            92     "udp" []+  , makeService "dcp"            93     "tcp" []+  , makeService "dcp"            93     "udp" []+  , makeService "objcall"        94     "tcp" []+  , makeService "objcall"        94     "udp" []+  , makeService "dixie"          96     "tcp" []+  , makeService "dixie"          96     "udp" []+  , makeService "swift-rvf"      97     "tcp" []+  , makeService "swift-rvf"      97     "udp" []+  , makeService "tacnews"        98     "tcp" []+  , makeService "tacnews"        98     "udp" []+  , makeService "metagram"       99     "tcp" []+  , makeService "metagram"       99     "udp" []   , makeService "newacct"        100    "tcp" []   , makeService "iso-tsap"       102    "udp" []   , makeService "gppitnp"        103    "tcp" []
src/Network/Socket.hs view
@@ -1,11 +1,22 @@ module Network.Socket(          Socket-       , SocketType(..)        , Family(..)        , isSupportedFamily+       , SocketType(..)+       , isSupportedSocketType        , SockAddr(..)+       , isSupportedSockAddr        , SocketStatus(..)+       , HostAddress+       , hostAddressToTuple+       , tupleToHostAddress+       , FlowInfo+       , ScopeID+       , htonl+       , ntohl        , ShutdownCmd(..)+       , ProtocolNumber+       , defaultProtocol        , PortNumber(..)        , HostName        , ServiceName@@ -27,15 +38,15 @@        , getPeerCred        , socketPort        , socketToHandle-       , sendTo-       , sendBufTo-       , recvFrom-       , recvBufFrom        , send+       , sendTo        , recv+       , recvFrom        , recvLen        , sendBuf        , recvBuf+       , sendBufTo+       , recvBufFrom        , inet_addr        , inet_ntoa        , shutdown@@ -46,10 +57,11 @@        , isReadable        , isWritable        , SocketOption(..)-       , defaultProtocol        , isSupportedSocketOption        , getSocketOption        , setSocketOption+       , sendFd+       , recvFd        , aNY_PORT        , iNADDR_ANY        , iN6ADDR_ANY@@ -62,33 +74,85 @@        )  where -import Control.Concurrent.MVar-import Control.Exception-import Data.Typeable-import Data.Word-import Data.ByteString(useAsCStringLen, packCStringLen)+import           Control.Concurrent.MVar()+import           Control.Exception(SomeException, throwIO, catch)+import           Data.Bits(shiftR, shiftL, (.|.), (.&.))+import           Data.ByteString(useAsCStringLen, packCStringLen) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL-import Data.ByteString.Lazy.Char8(pack, unpack)-import Foreign.C.Types-import Foreign.Ptr-import Foreign.Storable-import GHC.IO.Handle(mkFileHandle)-import Hans.Address.IP4-import Hans.Message.Tcp(getPort)-import qualified Hans.NetworkStack as NS-import Hans.Socket.Handle-import Network.BSD+import           Data.ByteString.Lazy.Char8(pack, unpack)+import           Data.Typeable(Typeable)+import           Data.Word(Word8, Word32)+import           Foreign.C.Types(CUInt, CInt)+import           Foreign.Ptr(Ptr, castPtr)+import           Foreign.Storable()+import           Hans.IP4(packIP4, unpackIP4)+import           Hans.Lens(view)+import           Hans.Socket(tcpRemoteAddr, tcpRemotePort,+                             tcpLocalAddr, tcpLocalPort)+import           Hans.Socket.Handle()+import           Network.BSD(ProtocolNumber, ServiceEntry(..), ServiceName,+                             HostName, hostAddress, getHostByName,HostEntry(..),+                             getHostByAddr, ProtocolEntry(..),+                             getProtocolByNumber, getProtocolByName,+                             getServiceByName) import qualified Network.Socket.ByteString as NBS-import Network.Socket.Internal+import           Network.Socket.Internal(HostAddress, HostAddress6, Family(..),+                                         PortNumber(..), SockAddr(..)) import qualified Network.Socket.ByteString.Lazy as SL-import System.IO+import           Network.Socket.Types(Socket, SocketStatus(..), Direction(..),+                                      withTcpSocket, close, fromIP4, toIP4,+                                      getSocketStatus, directionOpen,+                                      newSocket, connectIP4, bindIP4,+                                      listen, acceptIP4,+                                      socketToHandle, ShutdownCmd(..), shutdown)  isSupportedFamily :: Family -> Bool isSupportedFamily AF_INET = True isSupportedFamily _       = False +data SocketType = NoSocketType+                | Stream+                | Datagram+                | Raw+                | RDM+                | SeqPacket+ deriving (Eq, Ord, Read, Show)++isSupportedSocketType :: SocketType -> Bool+isSupportedSocketType Stream   = True+isSupportedSocketType Datagram = True+isSupportedSocketType _        = False++isSupportedSockAddr :: SockAddr -> Bool+isSupportedSockAddr _ = True++hostAddressToTuple :: HostAddress -> (Word8, Word8, Word8, Word8)+hostAddressToTuple = unpackIP4 . toIP4++tupleToHostAddress :: (Word8, Word8, Word8, Word8) -> HostAddress+tupleToHostAddress (a, b, c, d) = fromIP4 (packIP4 a b c d)++type FlowInfo = Word32++type ScopeID = Word32++htonl :: Word32 -> Word32+htonl = bswap32++ntohl :: Word32 -> Word32+ntohl = bswap32++bswap32 :: Word32 -> Word32+bswap32 x = (((x) .&. 0xFF000000) `shiftR` 24) .|.+            (((x) .&. 0x00FF0000) `shiftR`  8) .|.+            (((x) .&. 0x0000FF00) `shiftL`  8) .|.+            (((x) .&. 0x000000FF) `shiftL` 24)++defaultProtocol :: ProtocolNumber+defaultProtocol  = 6+ data AddrInfo = AddrInfo {         addrFlags      :: [AddrInfoFlag]       , addrFamily     :: Family@@ -119,11 +183,11 @@   getAddrInfo mai (Just "127.0.0.1") msn getAddrInfo (Just hints) (Just hostname) msn =   do addr  <- case reads hostname of-                [(addr, "")] -> return (convertToWord32 addr)+                [(addr, "")] -> return (fromIP4 addr)                 _            -> hostAddress `fmap` (getHostByName hostname)      (port, proto) <- case msn of                         Nothing -> return (0, defaultProtocol)-                        Just sn ->+                        Just _ ->                           do pent <- getProtocolByNumber (addrProtocol hints)                              entry <- getServiceByName "sn" (protoName pent)                              let port = servicePort entry@@ -149,19 +213,35 @@ socketPair _ _ _  =   throwIO (userError "FIXME: ERROR: network-hans does not support socketPair") +connect :: Socket -> SockAddr -> IO ()+connect sock (SockAddrInet (PortNum port) addr) =+  connectIP4 sock (toIP4 addr) (fromIntegral port)++bind :: Socket -> SockAddr -> IO ()+bind sock (SockAddrInet (PortNum port) addr) =+  bindIP4 sock addr' port'+ where+  port' = if port == 0          then Nothing else Just (fromIntegral port)+  addr' = if addr == iNADDR_ANY then Nothing else Just (toIP4 addr)++accept :: Socket -> IO (Socket, SockAddr)+accept sock =+  do (sock', addr, port) <- acceptIP4 sock+     return (sock', SockAddrInet (PortNum (fromIntegral port)) (fromIP4 addr))+ getPeerName :: Socket -> IO SockAddr getPeerName s =-  do nsock <- getConnectedHansSocket s ForNeither-     let oaddr = convertToWord32 (NS.sockRemoteHost nsock)-         oport = fromIntegral (getPort (NS.sockRemotePort nsock))-     return (SockAddrInet oport oaddr)+  withTcpSocket s ForNeither $ \ tcps ->+    do let addr = view tcpRemoteAddr tcps+           port = view tcpRemotePort tcps+       return (SockAddrInet (PortNum port) (fromIP4 addr))  getSocketName :: Socket -> IO SockAddr getSocketName s = -  do nsock <- getConnectedHansSocket s ForNeither-     let lport = fromIntegral (getPort (NS.sockLocalPort nsock))-         laddr = convertToWord32 (IP4 127 0 0 1)-     return (SockAddrInet lport laddr)+  withTcpSocket s ForNeither $ \ tcps ->+    do let addr = view tcpLocalAddr tcps+           port = view tcpLocalPort tcps+       return (SockAddrInet (PortNum port) (fromIP4 addr))  getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt) getPeerCred _ =@@ -172,11 +252,6 @@   do SockAddrInet port _ <- getSocketName sock      return port -socketToHandle :: Socket -> IOMode -> IO Handle-socketToHandle so mode =-  do nsock <- getConnectedHansSocket so ForBoth-     makeHansHandle nsock mode- sendTo :: Socket -> String -> SockAddr -> IO Int sendTo s str addr = NBS.sendTo s (BSC.pack str) addr @@ -228,8 +303,29 @@ inet_ntoa :: HostAddress -> IO String inet_ntoa addr =   catch (hostName `fmap` getHostByAddr AF_INET addr)-        (\ (_ :: SomeException) -> return (show (convertFromWord32 addr)))+        (\ (_ :: SomeException) -> return (show (toIP4 addr))) +isConnected :: Socket -> IO Bool+isConnected s = (== Connected) `fmap` getSocketStatus s++isBound :: Socket -> IO Bool+isBound s = (== Bound) `fmap` getSocketStatus s++isListening :: Socket -> IO Bool+isListening s = (== Listening) `fmap` getSocketStatus s++isReadable :: Socket -> IO Bool+isReadable s = directionOpen s ForRead++isWritable :: Socket -> IO Bool+isWritable s = directionOpen s ForWrite++socket :: Family -> SocketType -> ProtocolNumber -> IO Socket+socket AF_INET Stream   6  = newSocket True+socket AF_INET Datagram 17 = newSocket False+socket _       _        _  =+  throwIO (userError "Unsupported socket options.")+ data SocketOption = Debug | ReuseAddr | Type | SoError | DontRoute | Broadcast                   | SendBuffer | RecvBuffer | KeepAlive | OOBInline | TimeToLive                   | MaxSegment | NoDelay | Cork | Linger | ReusePort@@ -246,6 +342,12 @@  setSocketOption :: Socket -> SocketOption -> Int -> IO () setSocketOption _ _ _ = return ()++sendFd :: Socket -> CInt -> IO ()+sendFd _ _ = fail "Cannot get file descriptor from Hans."++recvFd :: Socket -> IO CInt+recvFd _ = fail "Cannot get file descriptor from Hans."  aNY_PORT :: PortNumber aNY_PORT  = 0
src/Network/Socket/ByteString.hs view
@@ -10,12 +10,13 @@        )  where -import Data.ByteString(ByteString)-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import Hans.NetworkStack(sendUdp)-import Network.Socket.Internal+import           Data.ByteString(ByteString)+import qualified Data.ByteString                as S+import qualified Data.ByteString.Lazy           as L+import           Hans.Socket(recvfrom, sendto) import qualified Network.Socket.ByteString.Lazy as NSL+import           Network.Socket.Internal(SockAddr(..), PortNumber(..))+import           Network.Socket.Types(Socket, withUdpSocket, toIP4, fromIP4)  send :: Socket -> ByteString -> IO Int send sock bstr = fromIntegral `fmap` NSL.send sock (L.fromStrict bstr)@@ -24,29 +25,38 @@ sendAll sock bstr = NSL.sendAll sock (L.fromStrict bstr)  sendTo :: Socket -> ByteString -> SockAddr -> IO Int-sendTo sock bstr saddr =-  do (ns, myport) <- getBoundUdpPort sock-     sendUdp ns dest myport dport (L.fromStrict bstr)-     return (fromIntegral (S.length bstr))- where (dest, dport) = hansUdpSockAddr saddr+sendTo s b a =+  do sendAllTo s b a+     return (S.length b)  sendAllTo :: Socket -> ByteString -> SockAddr -> IO ()-sendAllTo s b a = sendTo s b a >> return ()+sendAllTo sock bstr (SockAddrInet (PortNum port) addr) =+  withUdpSocket sock $ \ usock ->+    sendto usock addr' port' bstr'+ where+  addr' = toIP4 addr+  port' = fromIntegral port+  bstr' = L.fromStrict bstr  sendMany :: Socket -> [ByteString] -> IO () sendMany sock bstrs = NSL.sendAll sock (L.fromChunks bstrs)  sendManyTo :: Socket -> [ByteString] -> SockAddr -> IO ()-sendManyTo sock bstrs saddr =-  do (ns, myport) <- getBoundUdpPort sock-     sendUdp ns dest myport dport (L.fromChunks bstrs)- where (dest, dport) = hansUdpSockAddr saddr+sendManyTo sock bstrs (SockAddrInet (PortNum port) addr) =+  withUdpSocket sock $ \ usock ->+   sendto usock addr' port' bstr'+ where+  addr' = toIP4 addr+  port' = fromIntegral port+  bstr' = L.fromChunks bstrs  recv :: Socket -> Int -> IO ByteString recv sock amt = L.toStrict `fmap` NSL.recv sock (fromIntegral amt)  recvFrom :: Socket -> Int -> IO (ByteString, SockAddr) recvFrom sock maxbytes =-  do (bstr, addr) <- getNextUdpPacket sock-     return (S.take (fromIntegral maxbytes) bstr, addr)+  withUdpSocket sock $ \ usock ->+    do (_, addr, port, inbstr) <- recvfrom usock+       let res = L.toStrict (L.take (fromIntegral maxbytes) inbstr)+       return (res, SockAddrInet (PortNum port) (fromIP4 addr)) 
src/Network/Socket/ByteString/Lazy.hs view
@@ -6,17 +6,18 @@        )  where -import Data.ByteString.Lazy(ByteString)+import           Data.ByteString.Lazy(ByteString) import qualified Data.ByteString.Lazy as L-import Data.Int-import qualified Hans.NetworkStack as NS-import Network.Socket.Internal-import Prelude hiding (getContents)-import System.IO.Unsafe(unsafeInterleaveIO)+import           Data.Int(Int64)+import           Hans.Socket(DataSocket(..))+import           Network.Socket.Types(Socket, Direction(..), withTcpSocket)+import           Prelude hiding (getContents)+import           System.IO.Unsafe(unsafeInterleaveIO)  send :: Socket -> ByteString -> IO Int64-send sock bstr = getConnectedHansSocket sock ForWrite >>=-  (\ s -> NS.sendBytes s bstr)+send sock bstr =+  withTcpSocket sock ForWrite $ \ tcps ->+    fromIntegral `fmap` sWrite tcps bstr  sendAll :: Socket -> ByteString -> IO () sendAll sock bstr@@ -37,6 +38,7 @@                   return (bstr `L.append` next)  recv :: Socket -> Int64 -> IO ByteString-recv sock amt = getConnectedHansSocket sock ForRead >>=-  (\ s -> NS.recvBytes s amt)+recv sock amt =+  withTcpSocket sock ForRead $ \ tcps ->+    sRead tcps (fromIntegral amt) 
src/Network/Socket/Internal.hs view
@@ -1,304 +1,93 @@ module Network.Socket.Internal(-         Socket(..)-       , SocketStatus(..)-       , socket-       , connect-       , bind-       , listen-       , accept-       , ShutdownCmd(..)-       , close-       , shutdown-       , isConnected-       , isBound-       , isListening-       , isReadable-       , isWritable-       , SocketType(..)-       , isSupportedSocketType-       , ProtocolNumber-       , defaultProtocol-       , ForAction(..)-       , getConnectedHansSocket-       , getBoundUdpPort-       , getNextUdpPacket-       , SockAddr(..)-       , hansUdpSockAddr, hansTcpSockAddr+         HostAddress+       , HostAddress6+       , FlowInfo+       , ScopeID        , PortNumber(..)+       , SockAddr(..)+       , peekSockAddr+       , pokeSockAddr+       , sizeOfSockAddr+       , sizeOfSockAddrByFamily+       , withSockAddr+       , withNewSockAddr        , Family(..)-       , HostAddress-       , HostAddress6-       , getNetworkHansStack-       , setNetworkHansStack-       , getNextSockIdent+       , throwSocketError+       , throwSocketErrorCode+       , throwSocketErrorIfMinus1_+       , throwSocketErrorIfMinus1Retry+       , throwSocketErrorIfMinus1Retry_+       , throwSocketErrorIfMinus1RetryMayBlock+       , throwSocketErrorWaitRead+       , throwSocketErrorWaitWrite+       , withSocketsDo+       , zeroMemory        )  where -import Control.Concurrent.Chan-import Control.Concurrent.MVar-import Control.Exception-import Control.Monad-import Data.Typeable-import Data.ByteString(ByteString)-import Data.Word(Word64, Word32,Word16)-import Foreign.C.Types-import Foreign.Storable-import Hans.Address.IP4-import Hans.Message.Tcp(getPort)-import Hans.Message.Udp(getUdpPort)-import Hans.NetworkStack(NetworkStack)-import qualified Hans.NetworkStack as NS-import System.IO.Unsafe--type ProtocolNumber = CInt--defaultProtocol :: ProtocolNumber-defaultProtocol = 6--data Socket = Socket {-    sockState  :: MVar SockState-  , sockNStack :: NetworkStack-  , sockIdent  :: Word64-  }--data ForAction = ForNeither | ForRead | ForWrite | ForBoth-  deriving (Eq)--getConnectedHansSocket :: Socket -> ForAction -> IO NS.Socket-getConnectedHansSocket sock forWrite =-  do state <- readMVar (sockState sock)-     case state of-       SockConnected s c -> checkDone c forWrite >> return s-       _                 -> throwIO (userError "Socket not in connected state.")- where-  checkDone Nothing _ =-           return ()-  checkDone (Just ShutdownReceive) x-    | x `elem` [ForRead, ForBoth] =-           throwIO (userError "Read on Socket set shutdown/receive.")-    | otherwise =-           return ()-  checkDone (Just ShutdownSend) x-    | x `elem` [ForWrite, ForBoth] =-           throwIO (userError "Write on Socket set shutdown/send.")-    | otherwise =-           return ()-  checkDone (Just ShutdownBoth) x-    | x /= ForNeither =-           throwIO (userError "Read or write on shutdown socket.")-    | otherwise =-           return ()--getBoundUdpPort :: Socket -> IO (NetworkStack, Maybe NS.UdpPort)-getBoundUdpPort sock =-  do state <- readMVar (sockState sock)-     case state of-       SockBoundUdp mp _ -> return (sockNStack sock, mp)-       _                 -> throwIO (userError "Socket not bound to UDP.")--getNextUdpPacket :: Socket -> IO (ByteString, SockAddr)-getNextUdpPacket sock =-  do state <- readMVar (sockState sock)-     case state of-       SockBoundUdp _ c -> readChan c-       _                -> throwIO (userError "Socket not bound to UDP.")--instance Eq Socket where-  a == b = sockIdent a == sockIdent b--data SocketStatus = NotConnected-                  | Bound-                  | Listening-                  | Connected-                  | ConvertedToHandle-                  | Closed- deriving (Eq, Show)--data SocketType = NoSocketType-                | Stream-                | Datagram-                | Raw-                | RDM-                | SeqPacket-  deriving (Eq, Ord, Read, Show, Typeable)--isSupportedSocketType :: SocketType -> Bool-isSupportedSocketType Stream   = True-isSupportedSocketType Datagram = True--data SockState = SockInitialUdp-               | SockInitialTcp-               | SockConnected NS.Socket (Maybe ShutdownCmd)-               | SockBoundUdp (Maybe NS.UdpPort) (Chan (ByteString, SockAddr))-               | SockBoundTcp IP4 NS.TcpPort-               | SockListening NS.Socket-               | SockClosed--instance Eq SockState where-  SockInitialTcp == SockInitialTcp = True-  SockInitialUdp == SockInitialUdp = True-  SockClosed     == SockClosed     = True-  _              == _              = False--socket :: Family -> SocketType -> ProtocolNumber -> IO Socket-socket AF_INET Stream   6  =-  do sockState  <- newMVar SockInitialTcp-     sockNStack <- getNetworkHansStack-     sockIdent  <- getNextSockIdent-     return Socket { .. }-socket AF_INET Datagram 17 =-  do sockState  <- newMVar SockInitialUdp-     sockNStack <- getNetworkHansStack-     sockIdent  <- getNextSockIdent-     return Socket { .. }-socket _       _        _  =-  throwIO (userError "ERROR: Unsupported socket options.")--connect :: Socket -> SockAddr -> IO ()-connect sock (SockAddrInet (PortNum port) addr) =-  do state <- takeMVar (sockState sock)-     unless (state == SockInitialTcp) $-       throwIO (userError "Attempt to connect() on a non-TCP socket.")-     let dest  = convertFromWord32 addr-         dport = fromIntegral port-         ns    = sockNStack sock-     catch (do hsock <- NS.connect ns dest dport Nothing-               putMVar (sockState sock) (SockConnected hsock Nothing))-           (\ e ->-             do putMVar (sockState sock) state-                throwIO (e :: SomeException))--bind :: Socket -> SockAddr -> IO ()-bind sock (SockAddrInet (PortNum port) addr) =-  do state <- takeMVar (sockState sock)-     case state of-       SockInitialUdp ->-         do chan <- newChan-            let port' = fromIntegral port-            NS.addUdpHandler (sockNStack sock) port' (udpHandler chan)-            let state' = SockBoundUdp (Just port') chan-            putMVar (sockState sock) state'-       SockInitialTcp ->-         do let port' = fromIntegral port-                addr' = convertFromWord32 addr-            putMVar (sockState sock) (SockBoundTcp addr' port')-       _ ->-         do putMVar (sockState sock) state-            throwIO (userError "Bind called on incompatible socket.")- where-  udpHandler :: Chan (ByteString, SockAddr) -> IP4 -> NS.UdpPort -> ByteString -> IO ()-  udpHandler chan addr port bstr =-    let sport = PortNum (fromIntegral (getUdpPort port))-        saddr = convertToWord32 addr-    in writeChan chan (bstr, SockAddrInet sport saddr)--listen :: Socket -> Int -> IO ()-listen sock _ =-  do state <- takeMVar (sockState sock)-     case state of-       SockBoundTcp addr port ->-         do nsock <- NS.listen (sockNStack sock) addr port-            putMVar (sockState sock) (SockListening nsock)-       _ ->-         throwIO (userError "Listen called on unbound or non-TCP socket.")--accept :: Socket -> IO (Socket, SockAddr)-accept sock =-  do state <- readMVar (sockState sock)-     case state of-       SockListening lsock ->-         do newsock <- NS.accept lsock-            state   <- newMVar (SockConnected newsock Nothing)-            newid   <- getNextSockIdent-            let sock' = Socket state (sockNStack sock) newid-                oaddr = convertToWord32 (NS.sockRemoteHost newsock)-                oport = fromIntegral (getPort (NS.sockRemotePort newsock))-            return (sock', SockAddrInet oport oaddr)--data ShutdownCmd = ShutdownReceive | ShutdownSend | ShutdownBoth-  deriving (Typeable, Eq)+import Control.Exception(throwIO)+import Control.Monad(unless)+import Data.Typeable(Typeable)+import Data.Word(Word32, Word16)+import Foreign.C.Error(Errno(..), throwErrno, errnoToIOError,+                       throwErrnoIfMinus1_, throwErrnoIfMinus1Retry,+                       throwErrnoIfMinus1RetryMayBlock)+import Foreign.C.Types(CInt(..), CSize(..))+import Foreign.Marshal.Alloc(allocaBytes)+import Foreign.Ptr(Ptr, castPtr)+import Foreign.Storable(Storable(..))+import Network.Socket.Types(Socket) -shutdown :: Socket -> ShutdownCmd -> IO ()-shutdown so cmd =-  do state <- takeMVar (sockState so)-     case state of-       SockConnected sock oshtd ->-         do let shtd = advanceShutdown oshtd cmd-            if shtd == ShutdownBoth-               then do putMVar (sockState so) SockClosed-                       NS.close sock-               else putMVar (sockState so) (SockConnected sock (Just shtd))+type HostAddress = Word32 -advanceShutdown :: Maybe ShutdownCmd -> ShutdownCmd -> ShutdownCmd-advanceShutdown Nothing                x               = x-advanceShutdown _                      ShutdownBoth    = ShutdownBoth-advanceShutdown (Just ShutdownReceive) ShutdownSend    = ShutdownBoth-advanceShutdown (Just ShutdownSend)    ShutdownReceive = ShutdownBoth-advanceShutdown (Just y)               x               = y+type HostAddress6 = (Word32, Word32, Word32, Word32) -close :: Socket -> IO ()-close so =-  do state <- takeMVar (sockState so)-     case state of-       SockConnected sock       _ -> NS.close sock-       SockBoundUdp (Just port) _ -> NS.removeUdpHandler (sockNStack so) port-       SockListening sock         -> NS.close sock-       _                          -> return ()-     putMVar (sockState so) SockClosed+type FlowInfo = Word32 -isConnected :: Socket -> IO Bool-isConnected so =-  do state <- readMVar (sockState so)-     case state of-       SockConnected _ _ -> return True-       _                 -> return False+type ScopeID = Word32 -isBound :: Socket -> IO Bool-isBound so =-  do state <- readMVar (sockState so)-     case state of-       SockBoundUdp _ _ -> return True-       SockBoundTcp _ _ -> return True-       _                -> return False+newtype PortNumber = PortNum Word16+  deriving (Enum, Eq, Integral, Num, Ord, Real, Show, Typeable, Storable) -isListening :: Socket -> IO Bool-isListening so =-  do state <- readMVar (sockState so)-     case state of-       SockListening _ -> return True-       _               -> return False+data SockAddr = SockAddrInet PortNumber HostAddress+ deriving (Eq, Ord, Show, Typeable) -isReadable :: Socket -> IO Bool-isReadable so =-  do state <- readMVar (sockState so)-     case state of-       SockBoundUdp _ _                       -> return True-       SockConnected _ (Just ShutdownReceive) -> return False-       SockConnected _ _                      -> return  True-       _                                      -> return False+peekSockAddr :: Ptr SockAddr -> IO SockAddr+peekSockAddr ptr =+  do family <- peek (castPtr ptr) :: IO Word16+     unless (family == 2) $+       throwIO (userError ("peekSockAddr: " ++ show family +++                           "not supported on this platform."))+     addr <- peekByteOff (castPtr ptr) 4+     port <- peekByteOff (castPtr ptr) 2+     return (SockAddrInet (PortNum port) addr) -isWritable :: Socket -> IO Bool-isWritable so = -  do state <- readMVar (sockState so)-     case state of-       SockBoundUdp _ _                    -> return True-       SockConnected _ (Just ShutdownSend) -> return False-       SockConnected _ _                   -> return  True-       _                                   -> return False+pokeSockAddr :: Ptr a -> SockAddr -> IO ()+pokeSockAddr ptr (SockAddrInet (PortNum port) addr) =+  do pokeByteOff (castPtr ptr) 0 (2 :: Word16)+     pokeByteOff (castPtr ptr) 2 port+     pokeByteOff (castPtr ptr) 4 addr -data SockAddr = SockAddrInet PortNumber HostAddress- deriving (Eq, Ord, Show, Typeable)+sizeOfSockAddr :: SockAddr -> Int+sizeOfSockAddr _ = 8 -hansUdpSockAddr :: SockAddr -> (IP4, NS.UdpPort)-hansUdpSockAddr (SockAddrInet (PortNum pn) addr) =-  (convertFromWord32 addr, fromIntegral pn)+sizeOfSockAddrByFamily :: Family -> Int+sizeOfSockAddrByFamily f =+  case f of+    AF_INET -> 8+    _       -> error ("sizeOfSockAddrByFamily: " ++ show f +++                      " not supported.") -hansTcpSockAddr :: SockAddr -> (IP4, NS.TcpPort)-hansTcpSockAddr (SockAddrInet (PortNum pn) addr) =-  (convertFromWord32 addr, fromIntegral pn)+withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a+withSockAddr saddr action =+  allocaBytes (sizeOfSockAddr saddr) $ \ ptr ->+    do pokeSockAddr ptr saddr+       action (castPtr ptr) (sizeOfSockAddr saddr) -newtype PortNumber = PortNum Word16-  deriving (Enum, Eq, Integral, Num, Ord, Real, Show, Typeable, Storable)+withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a+withNewSockAddr family action =+  allocaBytes (sizeOfSockAddrByFamily family) $ \ ptr ->+    action ptr (sizeOfSockAddrByFamily family)  data Family     = AF_UNSPEC           -- ^unspecified@@ -368,25 +157,78 @@     | AF_BLUETOOTH        -- ^bluetooth sockets   deriving (Eq, Ord, Read, Show) -type HostAddress = Word32+throwSocketError :: String -> IO a+throwSocketError = throwErrno -type HostAddress6 = (Word32, Word32, Word32, Word32)+throwSocketErrorCode :: String -> CInt ->IO a+throwSocketErrorCode loc errno =+  ioError (errnoToIOError loc (Errno errno) Nothing Nothing) -{-# NOINLINE evilNSMVar #-}-evilNSMVar :: MVar NetworkStack-evilNSMVar =-  unsafePerformIO (newMVar (error "Access before set of network stack!"))+-- | Throw an 'IOError' corresponding to the current socket error if+-- the IO action returns a result of @-1@.  Discards the result of the+-- IO action after error handling.+throwSocketErrorIfMinus1_+    :: (Eq a, Num a)+    => String  -- ^ textual description of the location+    -> IO a    -- ^ the 'IO' operation to be executed+    -> IO ()+throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_ -getNetworkHansStack :: IO NetworkStack-getNetworkHansStack = readMVar evilNSMVar+-- | Throw an 'IOError' corresponding to the current socket error if+-- the IO action returns a result of @-1@, but retries in case of an+-- interrupted operation.+throwSocketErrorIfMinus1Retry+    :: (Eq a, Num a)+    => String  -- ^ textual description of the location+    -> IO a    -- ^ the 'IO' operation to be executed+    -> IO a+throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry -setNetworkHansStack :: NetworkStack -> IO ()-setNetworkHansStack ns = swapMVar evilNSMVar ns >> return ()+-- | Throw an 'IOError' corresponding to the current socket error if+-- the IO action returns a result of @-1@, but retries in case of an+-- interrupted operation. Discards the result of the IO action after+-- error handling.+throwSocketErrorIfMinus1Retry_+    :: (Eq a, Num a)+    => String  -- ^ textual description of the location+    -> IO a    -- ^ the 'IO' operation to be executed+    -> IO ()+throwSocketErrorIfMinus1Retry_ loc m =+    throwSocketErrorIfMinus1Retry loc m >> return () -{-# NOINLINE evilSockIdentMVar #-}-evilSockIdentMVar :: MVar Word64-evilSockIdentMVar = unsafePerformIO (newMVar 0)+-- | Throw an 'IOError' corresponding to the current socket error if+-- the IO action returns a result of @-1@, but retries in case of an+-- interrupted operation.  Checks for operations that would block and+-- executes an alternative action before retrying in that case.+throwSocketErrorIfMinus1RetryMayBlock+    :: (Eq a, Num a)+    => String  -- ^ textual description of the location+    -> IO b    -- ^ action to execute before retrying if an+               --   immediate retry would block+    -> IO a    -- ^ the 'IO' operation to be executed+    -> IO a+throwSocketErrorIfMinus1RetryMayBlock name on_block act =+    throwErrnoIfMinus1RetryMayBlock name act on_block -getNextSockIdent :: IO Word64-getNextSockIdent  = modifyMVar evilSockIdentMVar (\ x -> return (x + 1, x))+-- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with+-- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready,+-- and try again.+throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a+throwSocketErrorWaitRead _ _ _ =+  fail "FIXME: throwSocketErrorWaitRead is not supported in network-hans" +-- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with+-- @EWOULDBLOCK@ or similar, wait for the socket to be write-ready,+-- and try again.+throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a+throwSocketErrorWaitWrite _ _ _ =+  fail "FIXME: throwSocketErrorWaitWrite is not supported in network-hans"++withSocketsDo :: IO a -> IO a+withSocketsDo action = action++zeroMemory :: Ptr a -> CSize -> IO ()+zeroMemory p s = memset p 0 s++foreign import ccall unsafe "string.h"+  memset :: Ptr a -> CInt -> CSize -> IO ()
+ src/Network/Socket/Types.hs view
@@ -0,0 +1,285 @@+module Network.Socket.Types(+         Socket+       , newSocket+       , connectIP4+       , bindIP4+       , listen+       , acceptIP4+       , SocketStatus(..)+       , getSocketStatus+       , Direction(..)+       , directionOpen+       , withTcpSocket+       , withUdpSocket+       , socketToHandle+       , ShutdownCmd(..)+       , shutdown+       , close+       , toIP4, fromIP4+       , setNetworkStack+       )+ where++import Control.Concurrent.MVar(MVar, newMVar, withMVar,+                               readMVar, swapMVar,+                               modifyMVar, modifyMVar_)+import Control.Monad(void)+import Data.Bits(shiftL, shiftR, (.|.), (.&.))+import Data.Maybe(fromMaybe)+import Data.Typeable(Typeable)+import Data.Word(Word64, Word32)+import Hans.Addr(wildcardAddr)+import Hans.IP4(IP4, packIP4, unpackIP4)+import Hans.Lens(view)+import Hans.Socket(TcpSocket, TcpListenSocket, UdpSocket, SockPort,+                   tcpRemoteAddr, tcpRemotePort, defaultSocketConfig,+                   newUdpSocket, sConnect, sListen, sAccept, sClose)+import Hans.Socket.Handle(makeHansHandle)+import Hans.Types(NetworkStack)+import System.IO(Handle, IOMode(..))+import System.IO.Unsafe(unsafePerformIO)++data Socket = Socket (MVar SocketState) Word64++instance Eq Socket where+  (Socket _ a) == (Socket _ b) = a == b++newSocket :: Bool -> IO Socket+newSocket isTcp =+  do mv    <- newMVar (if isTcp then CreatedTcp else CreatedUdp)+     ident <- nextSocketIdent+     return (Socket mv ident)++data SocketState = CreatedTcp | CreatedUdp+                 | BoundUdp     (UdpSocket IP4)+                 | BoundTcp     (Maybe IP4)     (Maybe SockPort)+                 | ListeningTcp (TcpListenSocket IP4)+                 | ConnectedTcp (TcpSocket IP4) Direction+                 | Converted+                 | ClosedSocket++connectIP4 :: Socket -> IP4 -> SockPort -> IO ()+connectIP4 (Socket mvs _) addr port =+  modifyMVar_ mvs $ \ curstate ->+    case curstate of+      CreatedTcp ->+        do let conf = defaultSocketConfig+               src  = wildcardAddr undefined+           ns <- readMVar evilNetworkStackMVar+           sock <- sConnect ns conf Nothing src Nothing addr port+           return (ConnectedTcp sock ForBoth)+      CreatedUdp ->+        fail "Cannot connect UDP socket."+      BoundUdp _ ->+        fail "Cannot connect bound UDP socket."+      BoundTcp maddr mport ->+        do let conf = defaultSocketConfig+               src  = fromMaybe (wildcardAddr undefined) maddr+           ns <- readMVar evilNetworkStackMVar+           sock <- sConnect ns conf Nothing src mport addr port+           return (ConnectedTcp sock ForBoth)+      ListeningTcp _ ->+        fail "Canoot connect listening TCP socket."+      ConnectedTcp _ _ ->+        fail "Cannot connect connected TCP socket."+      Converted ->+        fail "Cannot connect converted socket."+      ClosedSocket ->+        fail "Cannot connect closed socket."++bindIP4 :: Socket -> Maybe IP4 -> Maybe SockPort -> IO ()+bindIP4 (Socket mvs _) maddr mport =+  modifyMVar_ mvs $ \ curstate ->+    case curstate of+      CreatedTcp ->+        return (BoundTcp maddr mport)+      CreatedUdp ->+        do let addr    = fromMaybe (wildcardAddr undefined) maddr+               conf    = defaultSocketConfig+           ns <- readMVar evilNetworkStackMVar+           sock <- newUdpSocket ns conf Nothing addr mport+           return (BoundUdp sock)+      BoundUdp _ ->+        fail "Cannot re-bind bound UDP port."+      BoundTcp _ _ ->+        fail "Cannot re-bind bound TCP port."+      ListeningTcp _ ->+        fail "Cannot bind listening TCP socket."+      ConnectedTcp _ _ ->+        fail "Cannot bind connected TCP socket."+      Converted ->+        fail "Cannot bind converted socket."+      ClosedSocket ->+        fail "Cannot connect closed socket."++listen :: Socket -> Int -> IO ()+listen (Socket mvs _) backlog =+  modifyMVar_ mvs $ \ curstate ->+    case curstate of+      BoundTcp maddr (Just port) ->+        do let addr = fromMaybe (wildcardAddr undefined) maddr+               conf = defaultSocketConfig+           ns <- readMVar evilNetworkStackMVar+           lsock <- sListen ns conf addr port backlog+           return (ListeningTcp lsock)+      BoundTcp _ Nothing ->+        fail "Cannot listen on socket with unbound port."+      _ ->+        fail "Cannot listen on unbound TCP port."++acceptIP4 :: Socket -> IO (Socket, IP4, SockPort)+acceptIP4 (Socket mvs _) =+  do curstate <- readMVar mvs+     case curstate of+       ListeningTcp lsock ->+         do sock <- sAccept lsock+            let addr = view tcpRemoteAddr sock+                port = view tcpRemotePort sock+            stateMV <- newMVar (ConnectedTcp sock ForBoth)+            ident   <- nextSocketIdent+            return (Socket stateMV ident, addr, port)+       _ ->+         fail "Illegal state for accept socket."++data ShutdownCmd = ShutdownReceive | ShutdownSend | ShutdownBoth+ deriving (Typeable, Eq)++shutdown :: Socket -> ShutdownCmd -> IO ()+shutdown (Socket mvs _) cmd =+  modifyMVar_ mvs $ \ curstate ->+    case curstate of+      ConnectedTcp sock _ | cmd == ShutdownBoth ->+        sClose sock >> return ClosedSocket+      ConnectedTcp sock ForRead | cmd == ShutdownReceive ->+        sClose sock >> return ClosedSocket+      ConnectedTcp sock ForWrite | cmd == ShutdownSend ->+        sClose sock >> return ClosedSocket+      ConnectedTcp sock _ | cmd == ShutdownReceive ->+        return (ConnectedTcp sock ForWrite)+      ConnectedTcp sock _ | cmd == ShutdownSend ->+        return (ConnectedTcp sock ForRead)+      ConnectedTcp _ _ ->+        fail "Internal consistency error in shutdown."+      _ ->+        fail "Shutdown called on un-connected socket."++close :: Socket -> IO ()+close (Socket mvs _) =+  modifyMVar_ mvs (\ _ -> return ClosedSocket)++socketToHandle :: Socket -> IOMode -> IO Handle+socketToHandle (Socket mvs _) mode =+  modifyMVar mvs $ \ curstate ->+    case curstate of+      ConnectedTcp sock ForBoth ->+        do hndl <- makeHansHandle sock mode+           return (Converted, hndl)+      ConnectedTcp sock ForRead | mode == ReadMode ->+        do hndl <- makeHansHandle sock mode+           return (Converted, hndl)+      ConnectedTcp sock ForWrite | mode `elem` [AppendMode, WriteMode] ->+        do hndl <- makeHansHandle sock mode+           return (Converted, hndl)+      ConnectedTcp _ allowed ->+        fail ("Access error converted socket to handle. Socket is in " +++              show allowed ++ " mode, but IOMode was " ++ show mode)+      _ ->+        fail ("Cannot convert unconnected socket to a handle.")++data SocketStatus = NotConnected+                  | Bound+                  | Listening+                  | Connected+                  | ConvertedToHandle+                  | Closed+ deriving (Eq, Show)++getSocketStatus :: Socket -> IO SocketStatus+getSocketStatus (Socket mvs _) =+  withMVar mvs $ \ curstate ->+    case curstate of+      CreatedTcp       -> return NotConnected+      CreatedUdp       -> return NotConnected+      BoundUdp     _   -> return Bound+      BoundTcp     _ _ -> return Bound+      ListeningTcp _   -> return Listening+      ConnectedTcp _ _ -> return Connected+      Converted        -> return ConvertedToHandle+      ClosedSocket     -> return Closed++data Direction = ForWrite | ForRead | ForBoth | ForNeither+ deriving (Show)++directionOpen :: Socket -> Direction -> IO Bool+directionOpen (Socket mvs _) req =+  withMVar mvs $ \ curstate ->+    case curstate of+      ConnectedTcp _ dir -> return (modesMatch req dir)+      _                  -> return False++withTcpSocket :: Socket -> Direction -> (TcpSocket IP4 -> IO a) -> IO a+withTcpSocket (Socket mvs _) dir action =+  withMVar mvs $ \ curstate ->+    case curstate of+      ConnectedTcp sock dir' | modesMatch dir dir' ->+        action sock+      ConnectedTcp _ dir' ->+        fail ("Mismatch between requested direction (" ++ show dir +++              ") and allowed (" ++ show dir' ++ ")")+      _ ->+        fail ("TCP operation on non-TCP socket.")++withUdpSocket :: Socket -> (UdpSocket IP4 -> IO a) -> IO a+withUdpSocket (Socket mvs _) action =+  withMVar mvs $ \ curstate ->+    case curstate of+      BoundUdp udps ->+        action udps+      _ ->+        fail "UDP operation on non-UDP socket."++toIP4 :: Word32 -> IP4+toIP4 w32 = packIP4 a b c d+ where+  a = fromIntegral ((w32 `shiftR` 24) .&. 0xFF)+  b = fromIntegral ((w32 `shiftR` 16) .&. 0xFF)+  c = fromIntegral ((w32 `shiftR`  8) .&. 0xFF)+  d = fromIntegral ((w32 `shiftR`  0) .&. 0xFF)++fromIP4 :: IP4 -> Word32+fromIP4 ipaddr = w32+ where+  (a, b, c, d) = unpackIP4 ipaddr+  --+  w32 = a' .|. b' .|. c' .|. d'+  a'  = fromIntegral a `shiftL` 24+  b'  = fromIntegral b `shiftL` 16+  c'  = fromIntegral c `shiftL`  8+  d'  = fromIntegral d `shiftL`  0+ +modesMatch :: Direction -> Direction -> Bool+modesMatch ForBoth    ForBoth  = True+modesMatch ForBoth    _        = False+modesMatch ForRead    ForBoth  = True+modesMatch ForRead    ForRead  = True+modesMatch ForRead    _        = False+modesMatch ForWrite   ForBoth  = True+modesMatch ForWrite   ForWrite = True+modesMatch ForWrite   _        = False+modesMatch ForNeither _        = True++{-# NOINLINE evilNetworkStackMVar #-}+evilNetworkStackMVar :: MVar NetworkStack+evilNetworkStackMVar =+  unsafePerformIO (newMVar (error "Access before network stack set!"))++{-# NOINLINE evilSocketIDMVar #-}+evilSocketIDMVar :: MVar Word64+evilSocketIDMVar =+  unsafePerformIO (newMVar 1)++setNetworkStack :: NetworkStack -> IO ()+setNetworkStack = void . swapMVar evilNetworkStackMVar++nextSocketIdent :: IO Word64+nextSocketIdent = modifyMVar evilSocketIDMVar (\ x -> return (x + 1, x))