domain-auth 0.2.0 → 0.2.1
raw patch · 9 files changed
+45/−31 lines, 9 filesdep +crypto-pubkey-typesdep ~RSAdep ~dns
Dependencies added: crypto-pubkey-types
Dependency ranges changed: RSA, dns
Files
- Network/DomainAuth/DK/Parser.hs +0/−1
- Network/DomainAuth/DK/Verify.hs +1/−1
- Network/DomainAuth/DKIM/Btag.hs +2/−1
- Network/DomainAuth/DKIM/Parser.hs +0/−1
- Network/DomainAuth/DKIM/Verify.hs +2/−2
- Network/DomainAuth/Pubkey/RSAPub.hs +8/−3
- Network/DomainAuth/SPF.hs +3/−2
- Network/DomainAuth/SPF/Resolver.hs +15/−12
- domain-auth.cabal +14/−8
Network/DomainAuth/DK/Parser.hs view
@@ -9,7 +9,6 @@ import Data.Maybe import Network.DomainAuth.DK.Types import Network.DomainAuth.Mail-import Prelude hiding (catch) {-| Parsing DomainKey-Signature:.
Network/DomainAuth/DK/Verify.hs view
@@ -53,7 +53,7 @@ ---------------------------------------------------------------- verifyDK :: Mail -> DK -> PublicKey -> Bool-verifyDK mail dk pub = rsassa_pkcs1_v1_5_verify ha_SHA1 pub cmail sig+verifyDK mail dk pub = rsassa_pkcs1_v1_5_verify hashSHA1 pub cmail sig where sig = B.decode . dkSignature $ dk cmail = toLazyByteString (prepareDK dk mail)
Network/DomainAuth/DKIM/Btag.hs view
@@ -1,5 +1,6 @@ module Network.DomainAuth.DKIM.Btag where +import Control.Monad import Data.ByteString.Char8 import Data.Maybe import Text.Appar.ByteString@@ -18,6 +19,6 @@ b <- string "b" w <- many $ oneOf " \t\r\n" e <- string "="- some $ noneOf ";"+ void . some $ noneOf ";" s <- option "" (string ";") return $ b ++ w ++ e ++ s
Network/DomainAuth/DKIM/Parser.hs view
@@ -8,7 +8,6 @@ import Data.Maybe import Network.DomainAuth.DKIM.Types import Network.DomainAuth.Mail-import Prelude hiding (catch) {-| Parsing DKIM-Signature:.
Network/DomainAuth/DKIM/Verify.hs view
@@ -57,8 +57,8 @@ bodyHash2 = B.decode . dkimBodyHash hashAlgo1 :: DkimSigAlgo -> HashInfo-hashAlgo1 RSA_SHA1 = ha_SHA1-hashAlgo1 RSA_SHA256 = ha_SHA256+hashAlgo1 RSA_SHA1 = hashSHA1+hashAlgo1 RSA_SHA256 = hashSHA256 hashAlgo2 :: DkimSigAlgo -> BL.ByteString -> BL.ByteString hashAlgo2 RSA_SHA1 = bytestringDigest . sha1
Network/DomainAuth/Pubkey/RSAPub.hs view
@@ -4,6 +4,7 @@ import Codec.Crypto.RSA import Control.Applicative+import Crypto.Types.PubKey.RSA import Data.ByteString (ByteString) import qualified Data.ByteString as BS (foldl', dropWhile, length, tail) import qualified Data.ByteString.Char8 as BS ()@@ -20,10 +21,14 @@ decode = (>>= return . decodeRSAPublicyKey) lookupPublicKey' :: DNS.Resolver -> Domain -> IO (Maybe ByteString)-lookupPublicKey' resolver domain = extractPub <$> DNS.lookupTXT resolver domain+lookupPublicKey' resolver domain = do+ ex <- DNS.lookupTXT resolver domain+ case ex of+ Left _ -> return Nothing+ Right x -> return $ extractPub x -extractPub :: Maybe [ByteString] -> Maybe ByteString-extractPub = (>>= lookup "p" . parseTaggedValue . head)+extractPub :: [ByteString] -> Maybe ByteString+extractPub = lookup "p" . parseTaggedValue . head decodeRSAPublicyKey :: ByteString -> PublicKey decodeRSAPublicyKey bs = PublicKey size n e
Network/DomainAuth/SPF.hs view
@@ -8,11 +8,12 @@ , defaultLimit ) where +import Control.Exception as E import Data.IP import Network.DNS (Domain, Resolver)-import Network.DomainAuth.Types import Network.DomainAuth.SPF.Eval import Network.DomainAuth.SPF.Resolver+import Network.DomainAuth.Types import System.IO.Error {-|@@ -24,7 +25,7 @@ -} runSPF :: Limit -> Resolver -> Domain -> IP -> IO DAResult runSPF lim resolver dom ip =- (resolveSPF resolver dom ip >>= evalSPF lim ip) `catch` spfErrorHandle+ (resolveSPF resolver dom ip >>= evalSPF lim ip) `E.catch` spfErrorHandle spfErrorHandle :: IOError -> IO DAResult spfErrorHandle e = case ioeGetErrorString e of
Network/DomainAuth/SPF/Resolver.hs view
@@ -24,8 +24,12 @@ let is = filterSPFWithIP ip (fromJust jrs) return $ map (toSpfSeq resolver dom ip) is where- getSPFRR jrc = let ts = filter ("v=spf1" `BS.isPrefixOf`) (fromJust jrc)- in if null ts then "" else head ts+ getSPFRR (Left _) = error "getSPRRR"+ getSPFRR (Right rc)+ | null ts = ""+ | otherwise = head ts+ where+ ts = filter ("v=spf1" `BS.isPrefixOf`) rc checkSyntax rs estr = when (isNothing rs) (fail estr) checkExistence rr estr = when (BS.null rr) (fail estr) @@ -69,21 +73,20 @@ toSpfSeq r _ (IPv6 _) (SPF_Address q (Just dom) (_,l6)) = lookupAAAA r dom >>= doit6 q l6 -doit4 :: Qualifier -> Int -> Maybe [IPv4] -> IO SpfSeq-doit4 q l4 is = do- checkDNS is "TempError"- return $ SS_IPv4Ranges q $ map (mkr l4) $ fromJust is+doit4 :: Qualifier -> Int -> Either DNSError [IPv4] -> IO SpfSeq+doit4 _ _ (Left _) = fail "TempError"+doit4 q l4 (Right is) = return $ SS_IPv4Ranges q $ map (mkr l4) is where mkr = flip makeAddrRange -doit6 :: Qualifier -> Int -> Maybe [IPv6] -> IO SpfSeq-doit6 q l6 is = do- checkDNS is "TempError"- return $ SS_IPv6Ranges q $ map (mkr l6) $ fromJust is+doit6 :: Qualifier -> Int -> Either DNSError [IPv6] -> IO SpfSeq+doit6 _ _ (Left _) = fail "TempError"+doit6 q l6 (Right is) = return $ SS_IPv6Ranges q $ map (mkr l6) is where mkr = flip makeAddrRange ---------------------------------------------------------------- -checkDNS :: Maybe a -> String -> IO ()-checkDNS jrc estr = when (isNothing jrc) (fail estr)+checkDNS :: Either DNSError a -> String -> IO ()+checkDNS (Right _) _ = return ()+checkDNS (Left _) estr = fail estr
domain-auth.cabal view
@@ -1,5 +1,5 @@ Name: domain-auth-Version: 0.2.0+Version: 0.2.1 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -11,10 +11,7 @@ Cabal-Version: >= 1.6 Build-Type: Simple library- if impl(ghc >= 6.12)- GHC-Options: -Wall -fno-warn-unused-do-bind- else- GHC-Options: -Wall+ GHC-Options: -Wall Exposed-Modules: Network.DomainAuth Network.DomainAuth.Mail Network.DomainAuth.DK@@ -44,9 +41,18 @@ Network.DomainAuth.SPF.Parser Network.DomainAuth.SPF.Resolver Network.DomainAuth.SPF.Types- Build-Depends: base >= 4 && < 5, appar, dns, iproute,- network, bytestring, RSA, binary,- containers, SHA, blaze-builder+ Build-Depends: base >= 4 && < 5+ , RSA >= 2.0+ , SHA+ , appar+ , binary+ , blaze-builder+ , bytestring+ , containers+ , crypto-pubkey-types+ , dns >= 1.0+ , iproute+ , network Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/domain-auth.git