Piezoid · May 7, 2019 13:48 · Jun 18, 2014 · Jun 18, 2014 · Jun 18, 2014 · Jun 4, 2014
diff --git a/fuseblkl.hs b/fuseblkl.hs
@@ -13,12 +13,9 @@ import Data.Ratio ((%))
 import Data.Monoid ((<>), mempty, mconcat)
 import Data.Foldable (foldMap)
 
-
 import qualified Data.ByteString.Char8 as BS
 import Data.ByteString.Builder as B
 
-import Codec.Compression.GZip
-
 import Numeric (showFFloat)
 import System.IO (stderr, stdout, hPutStrLn)
 
@@ -40,7 +37,6 @@ main :: IO ()
 main = do
   input <- mapMaybe processLine
          . BS.lines
---          . decompress
        <$> BS.getContents
 
   let merged = mergeIPR input
@@ -54,9 +50,8 @@ main = do
       percent :: Double
       percent = fromRational $ 100 * nIPs % 2 ^ (32 :: Integer)
 
-      -- Helpers
+      -- Helper
       errPutStrLn = hPutStrLn stderr
-      comp = compressWith defaultCompressParams { compressLevel = bestCompression }
 
   -- Print stats
   errPutStrLn $ shows nInputRules " rules read."

diff --git a/fuseblkl.hs b/fuseblkl.hs
@@ -134,15 +134,14 @@ niprToB (NamedIPR b e n) =  name
          . map B.byteString
          $ n
 
-    ipToB w32 = wordDec a
-              <> char7 '.' <> wordDec b
-              <> char7 '.' <> wordDec c
-              <> char7 '.' <> wordDec d
-      where
-        a = (w32 `unsafeShiftR` 24) .&. 255
-        b = (w32 `unsafeShiftR` 16) .&. 255
-        c = (w32 `unsafeShiftR` 8 ) .&. 255
-        d = w32 .&. 255
+    ipToB w32 = mconcat
+              . intersperse (char7 '.')
+              . map wordDec
+              $ [ (w32 `unsafeShiftR` 24) .&. 255
+                , (w32 `unsafeShiftR` 16) .&. 255
+                , (w32 `unsafeShiftR` 8 ) .&. 255
+                ,  w32 .&. 255
+                ]
 
 merge :: Ord a => [a] -> [a] -> [a]
 merge (x:xs) (y:ys) = case compare x y of

diff --git a/fuseblkl.hs b/fuseblkl.hs
@@ -4,23 +4,24 @@ module Main (main) where
 
 import Control.Applicative ((<$>))
 
-import Numeric (showFFloat)
-import Data.Monoid ((<>))
 import Data.List
 import Data.Maybe (mapMaybe)
 import Data.Word (Word)
+import Data.Char (isSpace)
 import Data.Bits
 import Data.Ratio ((%))
-
+import Data.Monoid ((<>), mempty, mconcat)
 import Data.Foldable (foldMap)
 
+
 import qualified Data.ByteString.Char8 as BS
-import qualified Data.ByteString.Lazy.Char8 as BL
 import Data.ByteString.Builder as B
 
 import Codec.Compression.GZip
 
-import System.IO (stderr, hPutStrLn)
+import Numeric (showFFloat)
+import System.IO (stderr, stdout, hPutStrLn)
+
 
 
 -- | IP stored as 32 bits words are easier to compare and increment
@@ -31,23 +32,24 @@ type IP = Word
 data NamedIPR = NamedIPR
                   {-# UNPACK #-} !IP
                   {-# UNPACK #-} !IP
-                  {-# UNPACK #-} !BS.ByteString
+                                 ![BS.ByteString]
   deriving (Eq, Ord)
 
 
 main :: IO ()
 main = do
-  input <- BL.lines . decompress <$> BL.getContents
+  input <- mapMaybe processLine
+         . BS.lines
+--          . decompress
+       <$> BS.getContents
 
-  let merged = merge . sort -- . (\xs -> [x | Just x <- xs])
-             . mapMaybe (processLine . BL.toStrict)
-             $ input
+  let merged = mergeIPR input
 
       -- Stats
       nInputRules = length input
       nOutputRules = length merged
 
-      nIPs = toInteger . sum $ [1 + e - s | NamedIPR s e _ <- merged ]
+      nIPs = toInteger . sum $ [1 + e - b | NamedIPR b e _ <- merged ]
 
       percent :: Double
       percent = fromRational $ 100 * nIPs % 2 ^ (32 :: Integer)
@@ -61,12 +63,12 @@ main = do
   errPutStrLn $ showFFloat (Just 2) percent
               . showString "% of IPv4 space is covered with "
               . shows nOutputRules
-              $ " ranges."
+              . showString " ranges, for a total of "
+              . shows nIPs
+              $ " addresses."
 
   -- Print merged list
-  BL.putStr . comp . B.toLazyByteString . foldMap niprToB $ merged
-
-
+  B.hPutBuilder stdout . foldMap niprToB $ merged
 
 
 processLine :: BS.ByteString -> Maybe NamedIPR
@@ -82,9 +84,9 @@ processLine l =
                  = (readIP a, readIP o)
                  |otherwise = error $ "malformed range: " ++ show iprBS
 
-    readWord8 x | Just (i, s) <- BS.readInt x
+    readWord8 x | Just (i, b) <- BS.readInt x
                 , 0 <= i, i < 256
-                , BS.null s
+                , BS.null b
                 = fromInteger . toInteger $ i
                 | otherwise = error $ "malformed ip digit: " ++ show x
 
@@ -95,41 +97,57 @@ processLine l =
                  .|. (a `unsafeShiftL` 24)
                 | otherwise = error $ "malformed IP: " ++ show ipbs
 
+    names = sort
+          . filter (not . BS.null)
+          . map (BS.dropWhile isSpace)
+          . BS.split ','
+          $ name
+
   in if ignored || (start > end)
       then Nothing
-      else Just (NamedIPR start end name)
+      else Just (NamedIPR start end names)
 
 
-merge :: [NamedIPR] -> [NamedIPR]
-merge = foldl' f []
+mergeIPR :: [NamedIPR] -> [NamedIPR]
+-- mergeIPR = foldr (flip f) [] . sortBy (flip compare)
+mergeIPR = foldl' f [] . sort
   where
-    f cl@(c@(NamedIPR cs ce cn):l) x@(NamedIPR s e n)
-      | c == x
-      = cl -- identical lines
-      | nextIP ce >= s -- overlapping range
-      = NamedIPR cs e (cn <> "+" <> n) : l
+    f cl@(x@(NamedIPR xb xe xn):xs) y@(NamedIPR yb ye yn)
+      | nextIP xe >= yb -- overlapping range
+      = NamedIPR xb ye (merge xn yn) : xs
       | otherwise -- disjoint ranges
-      = x : cl
+      = y : cl
     f [] c = [c] -- Initial case
 
     nextIP ip | ip /= maxBound = ip + 1
               | otherwise = ip
 
-
 niprToB :: NamedIPR -> Builder
-niprToB (NamedIPR s e n) = B.byteString n
-                  --wordDec (1 + e - s)
-                 <> char7 ':' <> ipToB s
+niprToB (NamedIPR b e n) =  name
+--                   wordDec (1 + e - b)
+                 <> char7 ':' <> ipToB b
                  <> char7 '-' <> ipToB e
                  <> char7 '\n'
-
-ipToB :: IP -> Builder
-ipToB w32 = wordDec a
-          <> char7 '.' <> wordDec b
-          <> char7 '.' <> wordDec c
-          <> char7 '.' <> wordDec d
   where
-    a = (w32 `unsafeShiftR` 24) .&. 255
-    b = (w32 `unsafeShiftR` 16) .&. 255
-    c = (w32 `unsafeShiftR` 8 ) .&. 255
-    d = w32 .&. 255
+    name = mconcat
+         . intersperse (B.shortByteString ", ")
+         . map B.byteString
+         $ n
+
+    ipToB w32 = wordDec a
+              <> char7 '.' <> wordDec b
+              <> char7 '.' <> wordDec c
+              <> char7 '.' <> wordDec d
+      where
+        a = (w32 `unsafeShiftR` 24) .&. 255
+        b = (w32 `unsafeShiftR` 16) .&. 255
+        c = (w32 `unsafeShiftR` 8 ) .&. 255
+        d = w32 .&. 255
+
+merge :: Ord a => [a] -> [a] -> [a]
+merge (x:xs) (y:ys) = case compare x y of
+                           LT -> x : merge xs (y:ys)
+                           GT -> y : merge (x:xs) ys
+                           EQ -> x : merge xs ys
+merge xs [] = xs
+merge [] ys = ys
diff --git a/fuseblkl.hs b/fuseblkl.hs
@@ -2,22 +2,26 @@
 
 module Main (main) where
 
-import Prelude
+import Control.Applicative ((<$>))
 
-import Control.Monad
-
-import Data.Ord
-import Data.Monoid
+import Numeric (showFFloat)
+import Data.Monoid ((<>))
 import Data.List
-import Data.Word
+import Data.Maybe (mapMaybe)
+import Data.Word (Word)
 import Data.Bits
+import Data.Ratio ((%))
+
+import Data.Foldable (foldMap)
 
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as BL
 import Data.ByteString.Builder as B
 
 import Codec.Compression.GZip
 
+import System.IO (stderr, hPutStrLn)
+
 
 -- | IP stored as 32 bits words are easier to compare and increment
 -- Machine words (maybe 64 bits) are slightly faster (no narrowing)
@@ -32,14 +36,37 @@ data NamedIPR = NamedIPR
 
 
 main :: IO ()
-main = BL.putStr . comp
-     . B.toLazyByteString . mconcat . map niprToB
-     . merge . sort . (\xs -> [x | Just x <- xs])
-     . map (processLine . BL.toStrict) -- Strict BS are faster to parse
-     . BL.lines . decompress
-     =<< BL.getContents
-  where
-    comp = compressWith defaultCompressParams { compressLevel = bestCompression }
+main = do
+  input <- BL.lines . decompress <$> BL.getContents
+
+  let merged = merge . sort -- . (\xs -> [x | Just x <- xs])
+             . mapMaybe (processLine . BL.toStrict)
+             $ input
+
+      -- Stats
+      nInputRules = length input
+      nOutputRules = length merged
+
+      nIPs = toInteger . sum $ [1 + e - s | NamedIPR s e _ <- merged ]
+
+      percent :: Double
+      percent = fromRational $ 100 * nIPs % 2 ^ (32 :: Integer)
+
+      -- Helpers
+      errPutStrLn = hPutStrLn stderr
+      comp = compressWith defaultCompressParams { compressLevel = bestCompression }
+
+  -- Print stats
+  errPutStrLn $ shows nInputRules " rules read."
+  errPutStrLn $ showFFloat (Just 2) percent
+              . showString "% of IPv4 space is covered with "
+              . shows nOutputRules
+              $ " ranges."
+
+  -- Print merged list
+  BL.putStr . comp . B.toLazyByteString . foldMap niprToB $ merged
+
+
 
 
 processLine :: BS.ByteString -> Maybe NamedIPR
@@ -53,21 +80,21 @@ processLine l =
 
     (start, end) | [a, o] <- BS.split '-' iprBS
                  = (readIP a, readIP o)
-                 |otherwise = merror $ "malformed range: " ++ show iprBS
+                 |otherwise = error $ "malformed range: " ++ show iprBS
 
     readWord8 x | Just (i, s) <- BS.readInt x
                 , 0 <= i, i < 256
                 , BS.null s
                 = fromInteger . toInteger $ i
-                | otherwise = merror $ "malformed ip digit: " ++ show x
-
+                | otherwise = error $ "malformed ip digit: " ++ show x
 
     readIP ipbs | [a,b,c,d] <- map readWord8 . BS.split '.' $ ipbs
                 =     d
                  .|. (c `unsafeShiftL` 8)
                  .|. (b `unsafeShiftL` 16)
                  .|. (a `unsafeShiftL` 24)
-                | otherwise = merror $ "malformed IP: " ++ show ipbs
+                | otherwise = error $ "malformed IP: " ++ show ipbs
+
   in if ignored || (start > end)
       then Nothing
       else Just (NamedIPR start end name)
@@ -78,12 +105,10 @@ merge = foldl' f []
   where
     f cl@(c@(NamedIPR cs ce cn):l) x@(NamedIPR s e n)
       | c == x
-      = l -- identical lines
-      | cs == s -- identical start
-      = NamedIPR cs (max ce e) (cn <> "+" <> n) : l
+      = cl -- identical lines
       | nextIP ce >= s -- overlapping range
       = NamedIPR cs e (cn <> "+" <> n) : l
-      | otherwise -- Case disjoint ranges
+      | otherwise -- disjoint ranges
       = x : cl
     f [] c = [c] -- Initial case
 
@@ -93,6 +118,7 @@ merge = foldl' f []
 
 niprToB :: NamedIPR -> Builder
 niprToB (NamedIPR s e n) = B.byteString n
+                  --wordDec (1 + e - s)
                  <> char7 ':' <> ipToB s
                  <> char7 '-' <> ipToB e
                  <> char7 '\n'
@@ -107,8 +133,3 @@ ipToB w32 = wordDec a
     b = (w32 `unsafeShiftR` 16) .&. 255
     c = (w32 `unsafeShiftR` 8 ) .&. 255
     d = w32 .&. 255
-
-
-merror :: String -> a
-merror = error
--- merror = const undefined -- don't emit Show instance
diff --git a/fuseblkl.hs b/fuseblkl.hs
@@ -68,7 +68,7 @@ processLine l =
                  .|. (b `unsafeShiftL` 16)
                  .|. (a `unsafeShiftL` 24)
                 | otherwise = merror $ "malformed IP: " ++ show ipbs
-  in if ignored || (start >= end)
+  in if ignored || (start > end)
       then Nothing
       else Just (NamedIPR start end name)
 

diff --git a/fuseblkl.hs b/fuseblkl.hs
@@ -68,7 +68,7 @@ processLine l =
                  .|. (b `unsafeShiftL` 16)
                  .|. (a `unsafeShiftL` 24)
                 | otherwise = merror $ "malformed IP: " ++ show ipbs
-  in if ignored
+  in if ignored || (start >= end)
       then Nothing
       else Just (NamedIPR start end name)
 

diff --git a/fuseblkl.hs b/fuseblkl.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main (main) where
+
+import Prelude
+
+import Control.Monad
+
+import Data.Ord
+import Data.Monoid
+import Data.List
+import Data.Word
+import Data.Bits
+
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.ByteString.Builder as B
+
+import Codec.Compression.GZip
+
+
+-- | IP stored as 32 bits words are easier to compare and increment
+-- Machine words (maybe 64 bits) are slightly faster (no narrowing)
+type IP = Word
+
+-- | Named ip range
+data NamedIPR = NamedIPR
+                  {-# UNPACK #-} !IP
+                  {-# UNPACK #-} !IP
+                  {-# UNPACK #-} !BS.ByteString
+  deriving (Eq, Ord)
+
+
+main :: IO ()
+main = BL.putStr . comp
+     . B.toLazyByteString . mconcat . map niprToB
+     . merge . sort . (\xs -> [x | Just x <- xs])
+     . map (processLine . BL.toStrict) -- Strict BS are faster to parse
+     . BL.lines . decompress
+     =<< BL.getContents
+  where
+    comp = compressWith defaultCompressParams { compressLevel = bestCompression }
+
+
+processLine :: BS.ByteString -> Maybe NamedIPR
+processLine l =
+  let
+    ignored = BS.null l || ('#' == BS.head l)
+
+    (name, iprBS) = case BS.split ':' l of
+                       [n, r] -> (n, r)
+                       xs -> (BS.concat $ init xs, last xs)
+
+    (start, end) | [a, o] <- BS.split '-' iprBS
+                 = (readIP a, readIP o)
+                 |otherwise = merror $ "malformed range: " ++ show iprBS
+
+    readWord8 x | Just (i, s) <- BS.readInt x
+                , 0 <= i, i < 256
+                , BS.null s
+                = fromInteger . toInteger $ i
+                | otherwise = merror $ "malformed ip digit: " ++ show x
+
+
+    readIP ipbs | [a,b,c,d] <- map readWord8 . BS.split '.' $ ipbs
+                =     d
+                 .|. (c `unsafeShiftL` 8)
+                 .|. (b `unsafeShiftL` 16)
+                 .|. (a `unsafeShiftL` 24)
+                | otherwise = merror $ "malformed IP: " ++ show ipbs
+  in if ignored
+      then Nothing
+      else Just (NamedIPR start end name)
+
+
+merge :: [NamedIPR] -> [NamedIPR]
+merge = foldl' f []
+  where
+    f cl@(c@(NamedIPR cs ce cn):l) x@(NamedIPR s e n)
+      | c == x
+      = l -- identical lines
+      | cs == s -- identical start
+      = NamedIPR cs (max ce e) (cn <> "+" <> n) : l
+      | nextIP ce >= s -- overlapping range
+      = NamedIPR cs e (cn <> "+" <> n) : l
+      | otherwise -- Case disjoint ranges
+      = x : cl
+    f [] c = [c] -- Initial case
+
+    nextIP ip | ip /= maxBound = ip + 1
+              | otherwise = ip
+
+
+niprToB :: NamedIPR -> Builder
+niprToB (NamedIPR s e n) = B.byteString n
+                 <> char7 ':' <> ipToB s
+                 <> char7 '-' <> ipToB e
+                 <> char7 '\n'
+
+ipToB :: IP -> Builder
+ipToB w32 = wordDec a
+          <> char7 '.' <> wordDec b
+          <> char7 '.' <> wordDec c
+          <> char7 '.' <> wordDec d
+  where
+    a = (w32 `unsafeShiftR` 24) .&. 255
+    b = (w32 `unsafeShiftR` 16) .&. 255
+    c = (w32 `unsafeShiftR` 8 ) .&. 255
+    d = w32 .&. 255
+
+
+merror :: String -> a
+merror = error
+-- merror = const undefined -- don't emit Show instance
No results found