module IP2Proxy (Meta, IP2ProxyRecord(..), getModuleVersion, getPackageVersion, getDatabaseVersion, open, getAll, getCountryShort, getCountryLong, getRegion, getCity, getISP, getProxyType, getDomain, getUsageType, getASN, getAS, getLastSeen, isProxy) where
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS8
import Data.Word
import Data.Bits
import Data.Binary.Get
import Data.IP
import Control.Exception
data IP2ProxyRecord = IP2ProxyRecord {
country_short :: String,
country_long :: String,
region :: String,
city :: String,
isp :: String,
proxy_type :: String,
domain :: String,
usage_type :: String,
asn :: String,
as :: String,
last_seen :: String,
is_proxy :: Int
} deriving (Show)
data Meta = Meta {
databasetype :: Int,
databasecolumn :: Int,
databaseyear :: Int,
databasemonth :: Int,
databaseday :: Int,
ipv4databasecount :: Int,
ipv4databaseaddr :: Int,
ipv6databasecount :: Int,
ipv6databaseaddr :: Int,
ipv4indexbaseaddr :: Int,
ipv6indexbaseaddr :: Int,
ipv4columnsize :: Int,
ipv6columnsize :: Int
} deriving (Show)
getMeta = do
databasetype <- getWord8
databasecolumn <- getWord8
databaseyear <- getWord8
databasemonth <- getWord8
databaseday <- getWord8
ipv4databasecount <- getWord32le
ipv4databaseaddr <- getWord32le
ipv6databasecount <- getWord32le
ipv6databaseaddr <- getWord32le
ipv4indexbaseaddr <- getWord32le
ipv6indexbaseaddr <- getWord32le
let ipv4columnsize = fromIntegral databasecolumn `shiftL` 2
let ipv6columnsize = 16 + ((fromIntegral databasecolumn - 1) `shiftL` 2)
let meta = Meta (fromIntegral databasetype) (fromIntegral databasecolumn) (fromIntegral databaseyear) (fromIntegral databasemonth) (fromIntegral databaseday) (fromIntegral ipv4databasecount) (fromIntegral ipv4databaseaddr) (fromIntegral ipv6databasecount) (fromIntegral ipv6databaseaddr) (fromIntegral ipv4indexbaseaddr) (fromIntegral ipv6indexbaseaddr) ipv4columnsize ipv6columnsize
return meta
getModuleVersion :: String
getModuleVersion = "2.2.1"
getPackageVersion :: Meta -> String
getPackageVersion meta = (show (databasetype meta))
getDatabaseVersion :: Meta -> String
getDatabaseVersion meta = "20" ++ (show (databaseyear meta)) ++ "." ++ (show (databasemonth meta)) ++ "." ++ (show (databaseday meta))
ipToOcts :: IP -> [Int]
ipToOcts (IPv4 ip) = fromIPv4 ip
ipToOcts (IPv6 ip) = fromIPv6b ip
ipToInteger :: IP -> Integer
ipToInteger = sum . map (\(n,o) -> toInteger o * 256 ^ n) . zip [0..] . reverse . ipToOcts
ipStringToInteger :: String -> Integer
ipStringToInteger = ipToInteger . read
open :: String -> IO Meta
open myfile = do
contents <- BS.readFile myfile
return $ runGet getMeta contents
readuint8 :: BS.ByteString -> Int -> Int
readuint8 contents startpos = fromIntegral (runGet getWord8 (BS.drop (fromIntegral startpos - 1) contents))
readuint32 :: BS.ByteString -> Int -> Int
readuint32 contents startpos = fromIntegral (runGet getWord32le (BS.drop (fromIntegral startpos - 1) contents))
readuint32row :: BS.ByteString -> Int -> Int
readuint32row row startpos = fromIntegral (runGet getWord32le (BS.drop (fromIntegral startpos) row))
getuint128 = do
uint64A <- getWord64le
uint64B <- getWord64le
let uint128 = (toInteger uint64A) + ((toInteger uint64B) `rotateL` 64)
return uint128
readuint128 :: BS.ByteString -> Int -> Integer
readuint128 contents startpos = runGet getuint128 (BS.drop (fromIntegral startpos - 1) contents)
readstr :: BS.ByteString -> Int -> String
readstr contents startpos = do
let len = runGet getWord8 (BS.drop (fromIntegral startpos) contents)
str <- BS8.unpack (BS.take (fromIntegral len) (BS.drop (fromIntegral startpos + 1) contents))
return str
readcolcountry :: BS.ByteString -> Int -> Int -> [Int] -> (String, String)
readcolcountry contents dbtype rowoffset col = do
let x = "NOT SUPPORTED"
let [colpos] = take 1 (drop dbtype col)
if colpos == 0
then do
(x, x)
else do
let coloffset = (colpos - 1) `shiftL` 2
let x0 = readuint32 contents (rowoffset + coloffset)
let x1 = readstr contents x0
let x2 = readstr contents (x0 + 3)
(x1, x2)
readcolcountryrow :: BS.ByteString -> BS.ByteString -> Int -> [Int] -> (String, String)
readcolcountryrow contents row dbtype col = do
let x = "NOT SUPPORTED"
let [colpos] = take 1 (drop dbtype col)
if colpos == 0
then do
(x, x)
else do
let coloffset = (colpos - 2) `shiftL` 2
let x0 = readuint32row row coloffset
let x1 = readstr contents x0
let x2 = readstr contents (x0 + 3)
(x1, x2)
readcolstring :: BS.ByteString -> Int -> Int -> [Int] -> String
readcolstring contents dbtype rowoffset col = do
let [colpos] = take 1 (drop dbtype col)
if colpos == 0
then do
"NOT SUPPORTED"
else do
let coloffset = (colpos - 1) `shiftL` 2
readstr contents (readuint32 contents (rowoffset + coloffset))
readcolstringrow :: BS.ByteString -> BS.ByteString -> Int -> [Int] -> String
readcolstringrow contents row dbtype col = do
let [colpos] = take 1 (drop dbtype col)
if colpos == 0
then do
"NOT SUPPORTED"
else do
let coloffset = (colpos - 2) `shiftL` 2
readstr contents (readuint32row row coloffset)
countif :: (a -> Bool) -> [a] -> Int
countif f = length . filter f
readrecord :: BS.ByteString -> Int -> Int -> Int -> IP2ProxyRecord
readrecord contents dbtype rowoffset mode = do
let country_position = [0, 2, 3, 3, 3, 3, 3, 3, 3]
let region_position = [0, 0, 0, 4, 4, 4, 4, 4, 4]
let city_position = [0, 0, 0, 5, 5, 5, 5, 5, 5]
let isp_position = [0, 0, 0, 0, 6, 6, 6, 6, 6]
let proxytype_position = [0, 0, 2, 2, 2, 2, 2, 2, 2]
let domain_position = [0, 0, 0, 0, 0, 7, 7, 7, 7]
let usagetype_position = [0, 0, 0, 0, 0, 0, 8, 8, 8]
let asn_position = [0, 0, 0, 0, 0, 0, 0, 9, 9]
let as_position = [0, 0, 0, 0, 0, 0, 0, 10, 10]
let lastseen_position = [0, 0, 0, 0, 0, 0, 0, 0, 11]
let countryshort_field = 1
let countrylong_field = 2
let region_field = 4
let city_field = 8
let isp_field = 16
let proxytype_field = 32
let isproxy_field = 64
let domain_field = 128
let usagetype_field = 256
let asn_field = 512
let as_field = 1024
let lastseen_field = 2048
let allcols = (take 1 (drop dbtype country_position)) ++ (take 1 (drop dbtype region_position)) ++ (take 1 (drop dbtype city_position)) ++ (take 1 (drop dbtype isp_position)) ++ (take 1 (drop dbtype proxytype_position)) ++ (take 1 (drop dbtype domain_position)) ++ (take 1 (drop dbtype usagetype_position)) ++ (take 1 (drop dbtype asn_position)) ++ (take 1 (drop dbtype as_position)) ++ (take 1 (drop dbtype lastseen_position))
let cols = (countif (>0) allcols) `shiftL` 2
let row = BS.take (fromIntegral cols) (BS.drop (fromIntegral rowoffset - 1) contents)
let proxy_type = if (((.&.) mode proxytype_field) /= 0) || (((.&.) mode isproxy_field) /= 0)
then readcolstringrow contents row dbtype proxytype_position
else ""
let (country_short, country_long) = if (((.&.) mode countryshort_field) /= 0) || (((.&.) mode countrylong_field) /= 0) || (((.&.) mode isproxy_field) /= 0)
then readcolcountryrow contents row dbtype country_position
else ("", "")
let region = if ((.&.) mode region_field) /= 0
then readcolstringrow contents row dbtype region_position
else ""
let city = if ((.&.) mode city_field) /= 0
then readcolstringrow contents row dbtype city_position
else ""
let isp = if ((.&.) mode isp_field) /= 0
then readcolstringrow contents row dbtype isp_position
else ""
let domain = if ((.&.) mode domain_field) /= 0
then readcolstringrow contents row dbtype domain_position
else ""
let usage_type = if ((.&.) mode usagetype_field) /= 0
then readcolstringrow contents row dbtype usagetype_position
else ""
let asn = if ((.&.) mode asn_field) /= 0
then readcolstringrow contents row dbtype asn_position
else ""
let as = if ((.&.) mode as_field) /= 0
then readcolstringrow contents row dbtype as_position
else ""
let last_seen = if ((.&.) mode lastseen_field) /= 0
then readcolstringrow contents row dbtype lastseen_position
else ""
let is_proxy = if (country_short == "-") || (proxy_type == "-")
then 0
else if (proxy_type == "DCH") || (proxy_type == "SES")
then 2
else 1
IP2ProxyRecord country_short country_long region city isp proxy_type domain usage_type asn as last_seen is_proxy
searchtree :: BS.ByteString -> Integer -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> IP2ProxyRecord
searchtree contents ipnum dbtype low high baseaddr colsize iptype mode = do
if low <= high
then do
let mid = ((low + high) `shiftR` 1)
let rowoffset = baseaddr + (mid * colsize)
let rowoffset2 = rowoffset + colsize
let ipfrom = if (iptype == 4)
then toInteger $ readuint32 contents rowoffset
else readuint128 contents rowoffset
let ipto = if (iptype == 4)
then toInteger $ readuint32 contents rowoffset2
else readuint128 contents rowoffset2
if ipnum >= ipfrom && ipnum < ipto
then do
if iptype == 4
then
readrecord contents dbtype (rowoffset + 4) mode
else
readrecord contents dbtype (rowoffset + 16) mode
else if ipnum < ipfrom
then
searchtree contents ipnum dbtype low (mid - 1) baseaddr colsize iptype mode
else
searchtree contents ipnum dbtype (mid + 1) high baseaddr colsize iptype mode
else do
let x = "INVALID IP ADDRESS"
IP2ProxyRecord x x x x x x x x x x x (-1)
search4 :: BS.ByteString -> Integer -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> IP2ProxyRecord
search4 contents ipnum dbtype low high baseaddr indexbaseaddr colsize mode = do
if indexbaseaddr > 0
then do
let indexpos = fromIntegral (((ipnum `rotateR` 16) `rotateL` 3) + (toInteger indexbaseaddr))
let low2 = readuint32 contents indexpos
let high2 = readuint32 contents (indexpos + 4)
searchtree contents ipnum dbtype low2 high2 baseaddr colsize 4 mode
else
searchtree contents ipnum dbtype low high baseaddr colsize 4 mode
search6 :: BS.ByteString -> Integer -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> IP2ProxyRecord
search6 contents ipnum dbtype low high baseaddr indexbaseaddr colsize mode = do
if indexbaseaddr > 0
then do
let indexpos = fromIntegral (((ipnum `rotateR` 112) `rotateL` 3) + (toInteger indexbaseaddr))
let low2 = readuint32 contents indexpos
let high2 = readuint32 contents (indexpos + 4)
searchtree contents ipnum dbtype low2 high2 baseaddr colsize 6 mode
else
searchtree contents ipnum dbtype low high baseaddr colsize 6 mode
tryfirst myIP = do
result <- try (evaluate (ipStringToInteger myIP)) :: IO (Either SomeException Integer)
case result of
Left ex -> return $ toInteger (1 - 2)
Right val -> return val
getAll :: String -> Meta -> String -> IO IP2ProxyRecord
getAll myfile meta myip = do
result <- doQuery myfile meta myip 4095
return result
getCountryShort :: String -> Meta -> String -> IO String
getCountryShort myfile meta myip = do
result <- doQuery myfile meta myip 1
return (show (country_short result))
getCountryLong :: String -> Meta -> String -> IO String
getCountryLong myfile meta myip = do
result <- doQuery myfile meta myip 2
return (show (country_long result))
getRegion :: String -> Meta -> String -> IO String
getRegion myfile meta myip = do
result <- doQuery myfile meta myip 4
return (show (region result))
getCity :: String -> Meta -> String -> IO String
getCity myfile meta myip = do
result <- doQuery myfile meta myip 8
return (show (city result))
getISP :: String -> Meta -> String -> IO String
getISP myfile meta myip = do
result <- doQuery myfile meta myip 16
return (show (isp result))
getProxyType :: String -> Meta -> String -> IO String
getProxyType myfile meta myip = do
result <- doQuery myfile meta myip 32
return (show (proxy_type result))
getDomain :: String -> Meta -> String -> IO String
getDomain myfile meta myip = do
result <- doQuery myfile meta myip 128
return (show (domain result))
getUsageType :: String -> Meta -> String -> IO String
getUsageType myfile meta myip = do
result <- doQuery myfile meta myip 256
return (show (usage_type result))
getASN :: String -> Meta -> String -> IO String
getASN myfile meta myip = do
result <- doQuery myfile meta myip 512
return (show (asn result))
getAS :: String -> Meta -> String -> IO String
getAS myfile meta myip = do
result <- doQuery myfile meta myip 1024
return (show (as result))
getLastSeen :: String -> Meta -> String -> IO String
getLastSeen myfile meta myip = do
result <- doQuery myfile meta myip 2048
return (show (last_seen result))
isProxy :: String -> Meta -> String -> IO String
isProxy myfile meta myip = do
result <- doQuery myfile meta myip 64
return (show (is_proxy result))
doQuery :: String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery myfile meta myip mode = do
contents <- BS.readFile myfile
let fromV4Mapped = 281470681743360
let toV4Mapped = 281474976710655
let fromV4Compatible = 0
let toV4Compatible = 4294967295
let from6To4 = 42545680458834377588178886921629466624
let to6To4 = 42550872755692912415807417417958686719
let fromTeredo = 42540488161975842760550356425300246528
let toTeredo = 42540488241204005274814694018844196863
let last32Bits = 4294967295
ipnum <- tryfirst myip
if ipnum == -1
then do
let x = "INVALID IP ADDRESS"
return $ IP2ProxyRecord x x x x x x x x x x x (-1)
else if ipnum >= fromV4Mapped && ipnum <= toV4Mapped
then do
return $ search4 contents (ipnum - (toInteger fromV4Mapped)) (databasetype meta) 0 (ipv4databasecount meta) (ipv4databaseaddr meta) (ipv4indexbaseaddr meta) (ipv4columnsize meta) mode
else if ipnum >= from6To4 && ipnum <= to6To4
then do
return $ search4 contents ((ipnum `rotateR` 80) .&. last32Bits) (databasetype meta) 0 (ipv4databasecount meta) (ipv4databaseaddr meta) (ipv4indexbaseaddr meta) (ipv4columnsize meta) mode
else if ipnum >= fromTeredo && ipnum <= toTeredo
then do
return $ search4 contents ((complement ipnum) .&. last32Bits) (databasetype meta) 0 (ipv4databasecount meta) (ipv4databaseaddr meta) (ipv4indexbaseaddr meta) (ipv4columnsize meta) mode
else if ipnum >= fromV4Compatible && ipnum <= toV4Compatible
then do
return $ search4 contents ipnum (databasetype meta) 0 (ipv4databasecount meta) (ipv4databaseaddr meta) (ipv4indexbaseaddr meta) (ipv4columnsize meta) mode
else do
return $ search6 contents ipnum (databasetype meta) 0 (ipv6databasecount meta) (ipv6databaseaddr meta) (ipv6indexbaseaddr meta) (ipv6columnsize meta) mode