diff --git a/network-hans.cabal b/network-hans.cabal --- a/network-hans.cabal +++ b/network-hans.cabal @@ -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 diff --git a/src/Hans/Socket/Handle.hs b/src/Hans/Socket/Handle.hs deleted file mode 100644 --- a/src/Hans/Socket/Handle.hs +++ /dev/null @@ -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 "" 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 () diff --git a/src/Network/BSD.hs b/src/Network/BSD.hs --- a/src/Network/BSD.hs +++ b/src/Network/BSD.hs @@ -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 diff --git a/src/Network/BSD/ServiceDB.hs b/src/Network/BSD/ServiceDB.hs --- a/src/Network/BSD/ServiceDB.hs +++ b/src/Network/BSD/ServiceDB.hs @@ -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" [] diff --git a/src/Network/Socket.hs b/src/Network/Socket.hs --- a/src/Network/Socket.hs +++ b/src/Network/Socket.hs @@ -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 diff --git a/src/Network/Socket/ByteString.hs b/src/Network/Socket/ByteString.hs --- a/src/Network/Socket/ByteString.hs +++ b/src/Network/Socket/ByteString.hs @@ -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)) diff --git a/src/Network/Socket/ByteString/Lazy.hs b/src/Network/Socket/ByteString/Lazy.hs --- a/src/Network/Socket/ByteString/Lazy.hs +++ b/src/Network/Socket/ByteString/Lazy.hs @@ -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) diff --git a/src/Network/Socket/Internal.hs b/src/Network/Socket/Internal.hs --- a/src/Network/Socket/Internal.hs +++ b/src/Network/Socket/Internal.hs @@ -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 () diff --git a/src/Network/Socket/Types.hs b/src/Network/Socket/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Socket/Types.hs @@ -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))