packages feed

GeoIp (empty) → 0.1

raw patch · 6 files changed

+259/−0 lines, 6 filesdep +basedep +bytestringdep +bytestring-mmapsetup-changed

Dependencies added: base, bytestring, bytestring-mmap

Files

+ Copying view
@@ -0,0 +1,19 @@+Copyright (c) 2008 Stephen Cook++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ GeoIp.cabal view
@@ -0,0 +1,25 @@+Name:		GeoIp+Version:	0.1+License:	OtherLicense+License-File: Copying+Author:		Stephen Cook+Maintainer: siti@orcon.net.nz+category:	Network+Synopsis:	Pure bindings for the MaxMind IP database.+Stability:	alpha+build-type: Simple+Description:+  GeoIp is a pure haskell binding to the MaxMind IP database.+  The IP database contains information such as the approximate+  longitude and latitude of an IP address.+Cabal-Version: >= 1.2++Library+  Exposed-modules:+    Network.GeoIp.GeoCityIp+  Other-modules:+    Network.GeoIp.GeoDB+  ghc-options: -Wall -fglasgow-exts+  Build-Depends: base, bytestring, bytestring-mmap++
+ Network/GeoIp/GeoCityIp.hs view
@@ -0,0 +1,73 @@++-- | This module loads the MaxMind's GeoIp City database.+module Network.GeoIp.GeoCityIp (+	GeoCityDB,+	load,+	findRange,+	findLocation) where++import qualified Data.ByteString as B+import Data.Int+import Data.Bits++import Network.GeoIp.GeoDB++data GeoCityDB = GeoCityDB GeoDB++-- | Load the city database.  If an error is triggered then+--   Left is returned with an error string.+load :: FilePath -> IO (Either String GeoCityDB)+load geoFile = do+	eGeo <- makeGeoDB geoFile+	case eGeo of+		Left e -> return $ Left e+		Right geo ->+			if dataBaseType geo == geoIPCountryEdition then+				return $ Right (GeoCityDB geo)+			else+				return $ Left ("load: Incorrect database type.  Database type is: " ++ (show $ dataBaseType geo))++extractRecordCity :: GeoDB -> Int -> (Double, Double)+extractRecordCity geo cursor =+	(latitude, longitude)+	where+		recordCursor = cursor + (2 * (recordLength geo) - 1) * (dataBaseSegments geo)+		memo = B.drop recordCursor (mem geo)+		(_, countryMem) = getBytes 1 memo+		(_, regionMem) = extractNullString countryMem+		(_, cityMem) = extractNullString regionMem+		(_, postalMem) = extractNullString cityMem+		(latitude, latMem) = ((fromIntegral ((getNumber $ B.take 3 postalMem)::Integer)) / 10000 - 180, B.drop 3 postalMem)+		(longitude, _) = ((fromIntegral ((getNumber $ B.take 3 latMem)::Integer)) / 10000 - 180, B.drop 3 latMem)+++generateMask :: forall a. (Num a, Bits a) => Int -> Int -> a+generateMask from to =+	if from <= to then+		(bit from) .|. generateMask (from+1) to+	else+		(bit from)++-- | Find the IP range that the IP address is in.  The result is monadic.+--   In most cases you will want to use the Maybe monad.+findRange :: (Monad m) => GeoCityDB -> Integer -> m (Integer, Integer)+findRange (GeoCityDB geo) address = do+	(cursor, netMask) <- seekRecord geo address+	let+		bitMask = generateMask (31 - netMask) 31+		hostMask = generateMask 0 netMask+	if cursor == dataBaseSegments geo then+		fail "Could not find IP"+		else+			return (address .&. bitMask, address .|. hostMask)			+	+-- | Find the location of an IP address. The tuple returned is @(latitude, longitude)@.+--   The result is monadic, in most cases you will want to use the Maybe monad.+findLocation :: (Monad m) => GeoCityDB -> Integer -> m (Double, Double)+findLocation (GeoCityDB geo) address = do+	(cursor, _) <- seekRecord geo address+	if cursor == dataBaseSegments geo then+		fail "Could not find IP"+		else+			return (extractRecordCity geo cursor)+
+ Network/GeoIp/GeoDB.hs view
@@ -0,0 +1,122 @@+module Network.GeoIp.GeoDB where++import System.IO.Posix.MMap+import qualified Data.ByteString as B+import Data.Bits+import Data.Generics++data GeoDB = GeoDB {+	mem :: B.ByteString,+	dataBaseType :: Int,+	recordLength :: Int,+	dataBaseSegments :: Int+} deriving (Data, Typeable, Show)++makeGeoDB :: FilePath -> IO (Either String GeoDB)+makeGeoDB geoFile = do+	memo <- unsafeMMapFile geoFile+	let+		defaultGeo = GeoDB {mem = memo, dataBaseType = geoIPCountryEdition, recordLength = standardRecordLength, dataBaseSegments = countryBegin}+		eGeo = setupSegments defaultGeo ((B.length memo) - 3) 0+	return eGeo++setupSegments :: GeoDB -> Int -> Int -> Either String GeoDB+setupSegments geo cursor sizeRead+	| sizeRead >= structureMaxSize = Left "SetupSegments: could not find magic bytes. Incorrect file?"+	| otherwise = +		if B.index (mem geo) cursor == 255 && B.index (mem geo) (cursor+1) == 255 && B.index (mem geo) (cursor+2) == 255 then+			let+				byteDbType = B.index (mem geo) (cursor+3)+				databaseType = if byteDbType >= 106 then (byteDbType - 105) else byteDbType+			in+				if databaseType == geoIPRegionEditionRev0 then+					Right geo { dataBaseSegments = stateBeginRev0 }+				else+					if databaseType == geoIPRegionEditionRev1 then+						Right geo { dataBaseSegments = stateBeginRev1 }+					else+						if (databaseType == geoIPCityEditionRev0 || databaseType == geoIPCityEditionRev1 || databaseType == geoIPOrgEdition || databaseType == geoIPIspEdition || databaseType == geoIPAsNumEdition) then+							let newgeo = geo {dataBaseSegments = getNumber $ B.take segmentRecordLength $ B.drop (cursor+4) (mem geo)}+							in+								if (databaseType == geoIPOrgEdition || databaseType == geoIPIspEdition) then+									Right newgeo {recordLength = orgRecordLength}+								else+									Right newgeo				+						else+							Right geo+		else+			setupSegments geo (cursor - 4) (sizeRead + 4)++getNumber :: forall b. (Bits b) => B.ByteString -> b+getNumber bytes = fst $ B.foldl combine (0, 0) bytes+	where+		combine (num, pos) b = (num + ((fromIntegral b) `shiftL` (pos*8)), pos + 1)++extractNullString :: B.ByteString -> (B.ByteString, B.ByteString)+extractNullString memo =+	(memTaken, memLeft)+	where+		memTaken = B.takeWhile (/=0) memo+		memLeft = B.drop ((B.length memTaken) + 1) memo++getBytes :: Int -> B.ByteString -> (B.ByteString, B.ByteString)+getBytes num memo = (B.take num memo, B.drop num memo)++seekRecord :: forall a m. (Bits a, Monad m) => GeoDB -> a -> m (Int, Int)+seekRecord geo ipNum = seekRecord_ geo 31 0 ipNum++seekRecord_ :: forall a m. (Bits a, Monad m) => GeoDB -> Int -> Int -> a -> m (Int, Int)+seekRecord_ geo depth offset ipNum+	| depth < 0 = fail "Could not find record.  Database is possibly corrupt"+	| otherwise =+		if newOffset >= (dataBaseSegments geo) then+			return (newOffset, 32 - depth)+		else+			seekRecord_ geo (depth - 1) newOffset ipNum+		where+			cursor = (recordLength geo) * 2 * offset+			newOffset =+				if (ipNum .&. (1 `shiftL` depth) /= 0) then+					offsetFunction 1+				else+					offsetFunction 0+			offsetFunction pos = getNumber (B.take (recordLength geo) $ B.drop (cursor + (pos * (recordLength geo))) (mem geo))++geoIPCountryEdition :: forall n. (Num n) => n+geoIPCountryEdition = 1+geoIPRegionEditionRev0 :: forall n. (Num n) => n+geoIPRegionEditionRev0 = 7+geoIPCityEditionRev0 :: forall n. (Num n) => n+geoIPCityEditionRev0 = 6+geoIPOrgEdition :: forall n. (Num n) => n+geoIPOrgEdition = 5+geoIPIspEdition :: forall n. (Num n) => n+geoIPIspEdition = 4+geoIPCityEditionRev1 :: forall n. (Num n) => n+geoIPCityEditionRev1 = 2+geoIPRegionEditionRev1 :: forall n. (Num n) => n+geoIPRegionEditionRev1 = 3+--geoIPProxyEdition :: forall n. (Num n) => n+--geoIPProxyEdition = 8+geoIPAsNumEdition :: forall n. (Num n) => n+geoIPAsNumEdition = 9+--geoIPNetspeedEdition :: forall n. (Num n) => n+--geoIPNetspeedEdition = 10+--geoIPDomainEdition :: forall n. (Num n) => n+--geoIPDomainEdition = 11+structureMaxSize :: forall n. (Num n) => n+structureMaxSize = 20+segmentRecordLength :: forall n. (Num n) => n+segmentRecordLength = 3+standardRecordLength :: forall n. (Num n) => n+standardRecordLength = 3+orgRecordLength :: forall n. (Num n) => n+orgRecordLength = 4++stateBeginRev0 :: forall n. (Num n) => n+stateBeginRev0 = 16700000+stateBeginRev1 :: forall n. (Num n) => n+stateBeginRev1 = 16000000+countryBegin :: forall n. (Num n) => n+countryBegin = 16776960+
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMainWithHooks defaultUserHooks
+ examples/TestGeoIp.hs view
@@ -0,0 +1,17 @@+import Network.GeoIp.GeoCityIp++main :: IO ()+main = do+	eGeo <- load "GeoLiteCity.dat"+	case eGeo of+		Left e -> do+			putStrLn e+		Right geo -> do+			let+				mRange :: Maybe (Integer, Integer)+				mRange = findRange geo 3413704712+				mLocation :: Maybe (Double, Double)+				mLocation = findLocation geo 3413704712+			putStrLn $ show mRange+			putStrLn $ show mLocation+			putStrLn "Data from c library in February 2008 is: 203.121.0.8 -> (3.166700, 101.699997)"