diff --git a/GoogleSB.cabal b/GoogleSB.cabal new file mode 100644 --- /dev/null +++ b/GoogleSB.cabal @@ -0,0 +1,21 @@ +Name: GoogleSB +Version: 0.1 +Synopsis: Interface to Google Safe Browsing API +License: BSD3 +License-file: LICENSE +Author: Alex Ott +Copyright: (c) Alex Ott, 2009 +Maintainer: alexott@gmail.com +Build-Type: Simple +Cabal-Version: >=1.2 +Category: Security +-- Homepage: +Description: + This package implements support for Google Safe Browsing API, that provides + almost real-time information about malware & other malicious sites on the Web + +Extra-Source-Files: README + +Library + Exposed-modules: GoogleSB + Build-depends: base >= 3, base <= 5, HTTP, mtl, binary, Crypto, split, network, haskell98 diff --git a/GoogleSB.hs b/GoogleSB.hs new file mode 100644 --- /dev/null +++ b/GoogleSB.hs @@ -0,0 +1,196 @@ +{- |This module provides support for Google Safe Browsing API (). + To use this module you need to obtain access key from project's page. + + Typical use of this module will look like: + +> Right mhsh <- updateHash your_key makeEmptyMalwareHash +> checkURL mhsh "http://kaishi2009.com/" +> checkURL mhsh ... + +It's better to save hashes between runs to avoid of full updates every time. So at the end of program it's better to store hash on disk with following code: + +> saveHash "malware.dat" mhsh + +And during startup, load it from file, if it exists on disk: + +> Right mhsh <- load Hash "malware.dat" + +-} +module GoogleSB + (Hash, + updateHash, + loadHash, + saveHash, + checkURL, + makeEmptyBlackHash, + makeEmptyMalwareHash + ) + where + +import IO +import Network.URI +import Network.Browser +import Network.HTTP +import Data.List.Split (splitOn) +import Data.List (intercalate, nub, foldl', elem, delete, intersect, sort) +import Data.Digest.MD5 (hash) +import Data.Char (ord, chr, toLower) +import Codec.Utils +import Numeric (showHex, readHex) +import Data.Binary +import Control.Monad +import qualified Control.Exception as Ex +import Control.Monad.Error + + +{- |Data structure to store data about Hash. It contains information about version, name + of hash, and actual Hash data -} +data Hash = Hash { + versionMajor :: Int -- ^Major part of version number + , versionMinor :: Int -- ^Minor part of version number + , name :: String -- ^Hash name (see documentation about Google SB) + , hashes :: [Integer] -- ^Actual data + } deriving (Show, Eq) + +instance Binary Hash where + put (Hash vmj vmn name hsh) = put vmj >> put vmn >> put name >> put hsh + get = liftM4 Hash get get get get + +-- |Creates empty 'black' Hash object +makeEmptyBlackHash :: Hash +makeEmptyBlackHash = Hash { versionMajor = 1, versionMinor= -1, hashes= [], name = "goog-black-hash"} + +-- |Creates empty 'malware' Hash object +makeEmptyMalwareHash :: Hash +makeEmptyMalwareHash = Hash { versionMajor = 1, versionMinor= -1, hashes= [], name = "goog-malware-hash"} + +{- |Performs update of Hash from server. For first update, you need to provide hash + created by 'makeEmptyBlackHash' or 'makeEmptyMalwareHash'. And for later updates, you + will use existing hashes to get only updates to hashes, not the full database. -} +updateHash :: String -- ^Access key for Google SB. See module description + -> Hash -- ^Hash to update. Use 'makeEmptyBlackHash' or 'makeEmptyMalwareHash' for first update + -> IO (Either String Hash) {- ^Result of update: 'Left String' if error happens + (String contains error message), or 'Right Hash' on success -} +updateHash key hash = Ex.handle (makeHandler "Hash update error: ") $ do + hdata <- downloadHash key hash + return $ case hdata of + Left err -> Left err; + Right str -> parseHash hash str + +{- |Loads Hash from given file -} +loadHash :: FilePath -- ^File from which Hash will loaded + -> IO (Either String Hash) {- ^Result of loading: 'Left String' if error happens + (String contains error message), or 'Right Hash' on success -} +loadHash fname = Ex.handle (makeHandler "Hash load error: ") $ do + hash <- decodeFile fname + return (Right hash) + +-- |Saves Hash into given file +saveHash :: FilePath -- ^File in which Hash will stored + -> Hash -- ^Hash to store + -> IO () +saveHash = encodeFile + +{- |Performs checking of presence of given URL (second argument of function) in the Hash (first argument). -} +checkURL :: Hash -- ^Hash to check against + -> String -- ^URL to check + -> Bool -- ^True, if URL exists in database, False - otherwise +checkURL hsh url = not $ null sl + where hl = map (\ x -> octets2int $ hash $ str2octets x) $ generateURLVariants url + set = hashes hsh + sl = intersect set hl + +-- Auxiliary functions + +-- +makeHandler :: (Monad m) => String -> Ex.SomeException -> m (Either String Hash) +makeHandler str ex = return (Left $ str ++ show (ex::Ex.SomeException)) + +-- +makeSBURL :: String -> Hash -> String +makeSBURL key hash = "http://sb.google.com/safebrowsing/update?client=api&apikey=" ++ key + ++ "&version=" ++ name hash + ++ ":" ++ (show $ versionMajor hash) ++ ":" ++ (show $ versionMinor hash) + +-- +downloadHash :: String -> Hash -> IO (Either String String) +downloadHash key hash = do + rspO <- browse $ do + setAllowRedirects True + request $ getRequest $ makeSBURL key hash + let rsp = snd rspO + code = rspCode rsp + return $ case code of + (2,_,_) -> Right $ rspBody rsp; + _ -> Left "Error fetching data" + +-- +getHashVersion :: String -> (Int,Int) +getHashVersion ('[':xs) | last xs == ']' = + let vs = splitOn "." $ head $ tail $ splitOn " " $ init xs + in if null vs + then (-1,-1) + else (read (head vs)::Int, read (last vs)::Int) + | otherwise = (-1,-1) +getHashVersion _ = (-1, -1) + +parseHash :: Hash -> String -> (Either String Hash) +parseHash h [] = Right h +parseHash h d = + let l = lines d + (vmj,vmn) = getHashVersion $ head l + stripTab s = if last s == '\t' then init s else s + convString = fst . head . readHex . stripTab + loop h' [""] = h' + loop h' [] = h' + loop h' (x:xs) | head x == '-' = loop (delete (convString $ tail x) h') xs + | head x == '+' = loop ((convString $ tail x) `seq` (convString $ tail x) : h') xs + | otherwise = loop ((convString x) `seq` (convString x) : h') xs + in if null l || vmj == -1 || vmn == -1 + then Left "Hash parse error" + else Right h { hashes = sort $ loop (hashes h) $ tail l, + versionMajor = vmj, + versionMinor = vmn} + + +str2octets :: String -> [Octet] +str2octets = concatMap (\ x -> toTwosComp $ ord x) + +-- +octets2int :: [Octet] -> Integer +octets2int = foldl' (\x y -> x*256 + fromIntegral y) 0 + +-- +lowercase :: String -> String +lowercase = map (\x -> toLower x) + +-- +generateURLVariants :: String -> [String] +generateURLVariants uri = + let u = parseURI uri + in case u of + Nothing -> [""] + Just r -> nub [ h ++ p | h <- generateHosts (uriAuthority r), + p <- generatePaths (uriPath r) (uriQuery r)] + +-- +generateHosts :: (Maybe URIAuth) -> [String] +generateHosts Nothing = [] +generateHosts (Just auth) = h:nl + where h = lowercase $ uriRegName auth + hl=reverse $ splitOn "." h + nl=map (\ x -> intercalate "." $ reverse $ take x hl) [2..(min 5 $ length hl -1)] + +-- length $ generateURLVariants "http://a.b.c.d.e.f.g/1.html" == 10 +-- length $ generateURLVariants "http://a.b.c/1/2.html?param=1" == 8 + +-- +generatePaths :: String -> String -> [String] +generatePaths path [] = path:nl + where np = normalizePathSegments path + pl = drop 1 $ splitOn "/" np + plLenght = length pl + lastChar x = if x == 0 || x == plLenght then "" else "/" + nl = map (\ x -> '/':(intercalate "/" $ take x pl) ++ lastChar x) [0..(min 3 plLenght)] +generatePaths path query = (path ++ query) : generatePaths path [] + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2009, Alex Ott + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of contributors may not be used to endorse or promote + products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,5 @@ +This package implements support for Google Safe Browsing API +(http://code.google.com/apis/safebrowsing/) + +For description of package, please refer to documentation inside package sources (it could +be extracted with haddock) diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,5 @@ +#! /usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple( defaultMain ) +> main = defaultMain