Initial commit; the first thing that would compile and produce sane output.

diff --git a/makefile b/makefile
new file mode 100644 (file)
index 0000000..46c4826
--- /dev/null
+++ b/makefile
@@ -0,0 +1,15 @@
+BIN=hath
+
+all: $(BIN)
+
+$(BIN): src/*.hs
+       ghc -O2 -Wall --make -o bin/${BIN} src/*.hs
+
+profile: src/*.hs
+       ghc -O2 -Wall -prof -auto-all --make -o bin/$(BIN) src/*.hs
+
+clean:
+       rm -f bin/$(BIN)
+       rm -f src/*.hi
+       rm -f src/*.o
+       rm -f *.prof

diff --git a/src/hath.hs b/src/hath.hs
new file mode 100644 (file)
index 0000000..d0c5afe
--- /dev/null
+++ b/src/hath.hs
@@ -0,0 +1,147 @@
+import qualified Data.Char as DC
+import qualified Data.List as DL
+import qualified Numeric as N
+import System.Exit (exitFailure)
+import Text.Regex.Posix
+
+splitWith :: (a -> Bool) -> [a] -> [[a]]
+splitWith p xs =
+    ys : case zs of
+           []   -> []
+           _:ws -> splitWith p ws
+    where (ys,zs) = break p xs
+
+
+octets :: String -> [Int]
+octets cidr = map read (take 4 (splitWith (`elem` "./") cidr))
+
+maskbits :: String -> Int
+maskbits cidr = read ((splitWith (`elem` "/") cidr) !! 1)
+
+
+pad_left_to :: Int -> a -> [a] -> [a]
+pad_left_to len pad_elem xs =
+     if (length xs) >= len then
+         xs
+     else
+         (replicate padcount pad_elem) ++ xs
+         where
+           padcount = len - (length xs)
+
+pad_right_to :: Int -> a -> [a] -> [a]
+pad_right_to len pad_elem xs =
+     if (length xs) >= len then
+         xs
+     else
+         xs ++ (replicate padcount pad_elem)
+         where
+           padcount = len - (length xs)
+
+                      
+base_two :: Int -> String
+base_two n = N.showIntAtBase 2 DC.intToDigit n ""
+
+ip_base_two :: [Int] -> String
+ip_base_two octet_list =
+    DL.concatMap ((pad_left_to 8 '0') .base_two) octet_list
+
+min_base_two_address :: String -> String
+min_base_two_address cidr =
+    pad_right_to 32 '0' netpart
+    where
+      netpart = take (maskbits cidr) (ip_base_two (octets cidr))
+
+max_base_two_address :: String -> String
+max_base_two_address cidr =
+    pad_right_to 32 '1' netpart
+    where
+      netpart = take (maskbits cidr) (ip_base_two (octets cidr))
+
+min_base_two_octets :: String -> [String]
+min_base_two_octets cidr =
+    [octet1, octet2, octet3, octet4]
+    where
+      addr   = min_base_two_address cidr      
+      octet1 = fst (DL.splitAt 8 addr)
+      octet2 = fst (DL.splitAt 8 (snd (DL.splitAt 8 addr)))
+      octet3 = fst (DL.splitAt 8 (snd (DL.splitAt 16 addr)))
+      octet4 = snd (DL.splitAt 24 addr)
+
+max_base_two_octets :: String -> [String]
+max_base_two_octets cidr =
+    [octet1, octet2, octet3, octet4]
+    where
+      addr   = max_base_two_address cidr      
+      octet1 = fst (DL.splitAt 8 addr)
+      octet2 = fst (DL.splitAt 8 (snd (DL.splitAt 8 addr)))
+      octet3 = fst (DL.splitAt 8 (snd (DL.splitAt 16 addr)))
+      octet4 = snd (DL.splitAt 24 addr)
+
+
+min_octets :: String -> [Int]
+min_octets cidr =
+    map base_two_to_base_ten (min_base_two_octets cidr)
+
+max_octets :: String -> [Int]
+max_octets cidr =
+    map base_two_to_base_ten (max_base_two_octets cidr)
+
+is_binary_digit :: Char -> Bool
+is_binary_digit c =
+    if c `elem` ['0','1'] then
+        True
+    else
+        False
+       
+base_two_to_base_ten :: String -> Int
+base_two_to_base_ten s =
+    if (length parsed) == 0 then
+        0
+    else
+        fst (parsed !! 0)
+    where
+      parsed = N.readInt 2 is_binary_digit DC.digitToInt s
+
+
+cidr_to_regex :: String -> String
+cidr_to_regex cidr =
+    range1 ++ "\\." ++ range2 ++ "\\." ++ range3 ++ "\\." ++ range4
+    where
+      range1 = numeric_range min1 max1
+      range2 = numeric_range min2 max2
+      range3 = numeric_range min3 max3
+      range4 = numeric_range min4 max4
+      min1   = (min_octets cidr) !! 0
+      min2   = (min_octets cidr) !! 1
+      min3   = (min_octets cidr) !! 2
+      min4   = (min_octets cidr) !! 3
+      max1   = (max_octets cidr) !! 0
+      max2   = (max_octets cidr) !! 1
+      max3   = (max_octets cidr) !! 2
+      max4   = (max_octets cidr) !! 3
+
+               
+is_valid_cidr :: String -> Bool
+is_valid_cidr cidr = cidr =~ "([0-9]{1,3}\\.){3}[0-9]{1,3}/[0-9]{1,2}"
+
+alternate :: [String] -> String
+alternate terms = "(" ++ (concat (DL.intersperse "|" terms)) ++ ")"
+                  
+numeric_range :: Int -> Int -> String
+numeric_range x y =
+    alternate (map show [lower..upper])
+     where
+       lower = minimum [x,y]
+       upper = maximum [x,y]
+               
+main :: IO ()
+main = do
+  line <- getLine
+           
+  if (is_valid_cidr line)
+    then do
+        putStrLn (cidr_to_regex line)
+    else do
+        putStrLn "Error: not valid CIDR notation."
+        exitFailure
+