ping 0.1.0.0 → 0.1.0.1

raw patch · 7 files changed

+45/−15 lines, 7 filesdep ~posix-api

Dependency ranges changed: posix-api

Files

• ping.cabal +12/−2
• src-debug/Network/Icmp/Ping/Debug.hs +6/−0
• src-production/Network/Icmp/Ping/Debug.hs +7/−0
• src/Network/Icmp/Ping.hs +2/−0
• src/Network/Icmp/Ping/Hosts.hs +2/−5
• src/Network/Icmp/Ping/Multihosts.hs +15/−7
• src/Network/Icmp/Ping/Single.hs +1/−1

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: ping-version: 0.1.0.0+version: 0.1.0.1 synopsis: icmp echo requests description:   This library provides functions that have similar behavior as the@@ -30,7 +30,17 @@   CHANGELOG.md   include/custom.h +flag debug+  manual: True+  description: Print debug output +  default: False+ library+  hs-source-dirs: src+  if flag(debug)+    hs-source-dirs: src-debug+  else+    hs-source-dirs: src-production   build-depends:     , base >= 4.11.1 && <5     , ip >= 1.4@@ -47,7 +57,7 @@     Network.Icmp.Ping.Hosts     Network.Icmp.Ping.Multihosts     Network.Icmp.Common-  hs-source-dirs: src+    Network.Icmp.Ping.Debug   default-language: Haskell2010   build-tools: hsc2hs   ghc-options: -O2 -Wall

@@ -0,0 +1,6 @@+module Network.Icmp.Ping.Debug+  ( debug+  ) where++debug :: String -> IO ()+debug = putStrLn

@@ -0,0 +1,7 @@+module Network.Icmp.Ping.Debug+  ( debug+  ) where++debug :: String -> IO ()+debug _ = pure ()+

@@ -12,6 +12,8 @@ -- TODO: Figure out a more graceful way to fail when someone tries -- to ping the broadcast address. Can this be distinguished from the -- error message that we get when the sysctl thing is not set?+--+-- I think this has been solved.  import qualified Network.Icmp.Ping.Single as S import qualified Network.Icmp.Ping.Hosts as H

@@ -31,10 +31,11 @@ import GHC.Exts (RealWorld) import GHC.IO (IO(..)) import Net.Types (IPv4(..),IPv4Range)+import Network.Icmp.Common (IcmpException(..)) import Network.Icmp.Marshal (peekIcmpHeaderPayload,peekIcmpHeaderType) import Network.Icmp.Marshal (peekIcmpHeaderSequenceNumber) import Network.Icmp.Marshal (sizeOfIcmpHeader,pokeIcmpHeader)-import Network.Icmp.Common (IcmpException(..))+import Network.Icmp.Ping.Debug (debug) import Posix.Socket (SocketAddressInternet(..)) import System.Endian (toBE32) import System.Posix.Types (Fd(..))@@ -47,10 +48,6 @@ import qualified Linux.Socket as SCK import qualified Posix.Socket as SCK import qualified Net.IPv4 as IPv4--debug :: String -> IO ()-debug _ = pure ()--- debug = putStrLn  fullPacketSize :: Int fullPacketSize = sizeOfIcmpHeader + 4

@@ -29,6 +29,7 @@ import Network.Icmp.Marshal (peekIcmpHeaderPayload) import Network.Icmp.Marshal (peekIcmpHeaderSequenceNumber) import Network.Icmp.Marshal (sizeOfIcmpHeader,pokeIcmpHeader)+import Network.Icmp.Ping.Debug (debug) import Posix.Socket (SocketAddressInternet(..)) import System.Endian (toBE32) import System.Posix.Types (Fd(..))@@ -51,10 +52,6 @@ -- I lean toward the first option since it would also -- reduce allocations in Network.Icmp.Ping.Hosts. -debug :: String -> IO ()-debug _ = pure ()--- debug = putStrLn- -- Why plus 4? We have 4 extra bytes for the IPv4 address. fullPacketSize :: Int fullPacketSize = sizeOfIcmpHeader + 4@@ -64,11 +61,13 @@ -- True if there is something on the buffer to be read -- and False if nothing showed up in time. waitForRead ::-     Int -- Maximum number of microseconds to wait.+     Bool -- Should we attempt to read?+  -> Int -- Maximum number of microseconds to wait.   -> Fd -- Socket   -> IO Bool-waitForRead !maxWaitTime !sock = if maxWaitTime > 0+waitForRead !shouldRead !maxWaitTime !sock = if maxWaitTime > 0 && shouldRead   then do+    debug ("About to wait for " ++ show maxWaitTime ++ " microseconds")     (isReadyAction,deregister) <- threadWaitReadSTM sock     delay <- registerDelay maxWaitTime     isContentReady <- STM.atomically $@@ -135,6 +134,8 @@                    m <- PM.newPrimArray (totalPings + 4)                    PM.setPrimArray m 0 (totalPings + 4) (0 :: Word64)                    debug ("Sending initial to " ++ show theHost) +                   -- We intentionally discard the time that performSend tells+                   -- us to wait until since we can easily calculate this number.                    performSend 0 now0 nanoPause sock totalPings theHost buffer m >>= \case                      Left err -> pure (Left err)                      Right _ -> pure (Right m)@@ -144,7 +145,14 @@                  Right working -> do                    let go :: Word64 -> Word64 -> IO (Either IcmpException ())                        go !currentPause !nextTime = do-                         waitForRead (word64ToInt (div currentPause 1000)) sock >>= \case+                         -- Since currentPause is represent an an unsigned type,+                         -- it jumps up to near the max bound when we end up+                         -- exceeding the amount of time we are supposed to take.+                         -- The identifier shouldRead becomes False when this happens,+                         -- and we move on to the next round of updates.+                         let shouldRead = currentPause <= nanoPause+                         let microPause = div currentPause 1000+                         waitForRead shouldRead (word64ToInt microPause) sock >>= \case                            True -> do                              debug "Receiving in poll loop"                              r <- SCK.unsafeReceiveFromMutableByteArray_ sock buffer 0 (intToCSize fullPacketSize) SCK.dontWait

@@ -20,10 +20,10 @@ import GHC.Clock (getMonotonicTimeNSec) import GHC.IO (IO(..)) import Net.Types (IPv4(..))+import Network.Icmp.Common (IcmpException(..)) import Network.Icmp.Marshal (peekIcmpHeaderPayload,peekIcmpHeaderType) import Network.Icmp.Marshal (peekIcmpHeaderSequenceNumber) import Network.Icmp.Marshal (sizeOfIcmpHeader,pokeIcmpHeader)-import Network.Icmp.Common (IcmpException(..)) import Posix.Socket (SocketAddressInternet(..)) import System.Endian (toBE32) import System.Posix.Types (Fd(..))