xandkar · October 20, 2012 05:00 · Oct 20, 2012 · Oct 20, 2012
diff --git a/concurrent_port_scanner.hs b/concurrent_port_scanner.hs
@@ -1,3 +1,5 @@
+-- http://blog.moertel.com/articles/2004/03/13/concurrent-port-scanner-in-haskell
+
 module Main (main) where
 
 import Control.Concurrent

diff --git a/concurrent_port_scanner.hs b/concurrent_port_scanner.hs
@@ -0,0 +1,51 @@
+module Main (main) where
+
+import Control.Concurrent
+import Control.Exception
+import Data.Maybe
+import Network
+import Network.BSD
+import System.Environment
+import System.Exit
+import System.IO
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+        [host, from, to] -> withSocketsDo $
+                            scanRange host [read from .. read to]
+        _                -> usage
+
+usage = do
+    hPutStrLn stderr "Usage: Portscan host from_port to_port"
+    exitFailure
+
+scanRange host ports =
+    mapM (threadWithChannel . scanPort host . fromIntegral) ports >>=
+    mapM_ hitCheck
+  where
+    hitCheck mvar = takeMVar mvar >>= maybe (return ()) printHit
+    printHit port = putStrLn =<< showService port
+
+threadWithChannel action = do
+    mvar <- newEmptyMVar
+    forkIO (action >>= putMVar mvar)
+    return mvar
+
+scanPort host port =
+    withDefault Nothing (tryPort >> return (Just port))
+  where
+    tryPort = connectTo host (PortNumber port) >>= hClose
+
+showService port =
+    withDefault (show port) $ do
+        service <- getServiceByPort port "tcp" 
+        return (show port ++ " " ++ serviceName service)
+
+withDefault defaultVal action =
+    handle (const $ return defaultVal) action
+
+-- Local Variables:  ***
+-- compile-command: "ghc -o Portscan --make Portscan.hs" ***
+-- End: ***