From: Michael Orlitzky Date: Wed, 31 Mar 2010 06:01:31 +0000 (-0400) Subject: Initial commit; the first thing that would compile and produce sane output. X-Git-Tag: 0.0.1~99 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=25b329134812bdd24945ea80544cc1f8acaeb0ed;p=hath.git Initial commit; the first thing that would compile and produce sane output. --- 25b329134812bdd24945ea80544cc1f8acaeb0ed diff --git a/makefile b/makefile new file mode 100644 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 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 +