certificate 0.9.1 → 0.9.2
raw patch · 8 files changed
+520/−508 lines, 8 filesdep +processdep ~asn1-datadep ~base
Dependencies added: process
Dependency ranges changed: asn1-data, base
Files
- Certificate.hs +24/−16
- Data/Certificate/X509.hs +11/−5
- Data/Certificate/X509/Cert.hs +371/−0
- Data/Certificate/X509/Internal.hs +95/−0
- Data/Certificate/X509Cert.hs +0/−388
- Data/Certificate/X509Internal.hs +0/−92
- System/Certificate/X509/MacOS.hs +12/−1
- certificate.cabal +7/−6
Certificate.hs view
@@ -24,6 +24,7 @@ import qualified Crypto.Cipher.DSA as DSA import Data.ASN1.DER (decodeASN1Stream, ASN1(..), ASN1ConstructionType(..))+import Data.ASN1.BitArray import Text.Printf import Numeric @@ -35,7 +36,8 @@ showDN dn = mapM_ (\(oid, (_,t)) -> putStrLn (" " ++ show oid ++ ": " ++ t)) dn -showExts e = mapM_ (putStrLn . (" " ++) . show) e+showExts es = mapM_ (putStrLn . (" " ++) . showExt) es+ where showExt e = maybe ("unknown: " ++ show e) show $ X509.extDecode e showCert :: X509.X509 -> IO () showCert (X509.X509 cert _ _ sigalg sigbits) = do@@ -54,13 +56,19 @@ printf " modulus: %x\n" modulus printf " e : %x\n" e X509.PubKeyDSA (pub,p,q,g) -> do- putStrLn "public key SSA:"+ putStrLn "public key DSA:" printf " pub : %x\n" pub printf " p : %d\n" p printf " q : %x\n" q printf " g : %x\n" g+ X509.PubKeyUnknown oid ws -> do+ printf "public key unknown: %s\n" (show oid)+ printf " raw bytes: %s\n" (show ws)+ case decodeASN1Stream $ L.pack ws of+ Left err -> printf " asn1 decoding failed: %s\n" (show err)+ Right l -> printf " asn1 decoding:\n" >> showASN1 4 l pk ->- printf "public key: %s" (show pk)+ printf "public key: %s\n" (show pk) case X509.certExtensions cert of Nothing -> return () Just es -> do@@ -94,8 +102,8 @@ , "g: " ++ (show $ KeyDSA.g key) ] -showASN1 :: [ASN1] -> IO ()-showASN1 = prettyPrint 0 where+showASN1 :: Int -> [ASN1] -> IO ()+showASN1 at = prettyPrint at where indent n = putStr (replicate n ' ') prettyPrint n [] = return ()@@ -105,7 +113,7 @@ p (Boolean b) = putStr ("bool: " ++ show b) p (IntVal i) = putStr ("int: " ++ showHex i "")- p (BitString i bs) = putStr ("bitstring: " ++ hexdump bs)+ p (BitString bits) = putStr ("bitstring: " ++ (hexdump $ bitArrayGetData bits)) p (OctetString bs) = putStr ("octetstring: " ++ hexdump bs) p (Null) = putStr "null" p (OID is) = putStr ("OID: " ++ show is)@@ -140,7 +148,7 @@ when (raw opts) $ putStrLn $ hexdump $ L.fromChunks [cert] when (asn1 opts) $ case decodeASN1Stream $ L.fromChunks [cert] of Left err -> error ("decoding ASN1 failed: " ++ show err)- Right asn1 -> showASN1 asn1+ Right asn1 -> showASN1 0 asn1 let x509o = X509.decodeCertificate $ L.fromChunks [cert] let x509 = case x509o of@@ -162,16 +170,16 @@ rsaVerify h hdesc pk a b = either (Left . show) (Right) $ RSA.verify h hdesc pk a b - verifyF X509.SignatureALG_md2WithRSAEncryption (X509.PubKeyRSA rsak) = rsaVerify MD2.hash asn1 (mkRSA rsak)- where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x02\x10"-- verifyF X509.SignatureALG_md5WithRSAEncryption (X509.PubKeyRSA rsak) = rsaVerify MD5.hash asn1 (mkRSA rsak)- where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10"-- verifyF X509.SignatureALG_sha1WithRSAEncryption (X509.PubKeyRSA rsak) = rsaVerify SHA1.hash asn1 (mkRSA rsak)- where asn1 = "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14"+ verifyF (X509.SignatureALG hash X509.PubKeyALG_RSA) (X509.PubKeyRSA rsak) =+ let (f, asn1) = case hash of+ X509.HashMD2 -> (MD2.hash, "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x02\x10")+ X509.HashMD5 -> (MD5.hash, "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10")+ X509.HashSHA1 -> (SHA1.hash, "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14")+ _ -> error ("unsupported hash in RSA: " ++ show hash)+ in+ rsaVerify f asn1 (mkRSA rsak) - verifyF X509.SignatureALG_dsaWithSHA1 (X509.PubKeyDSA (pub,p,q,g)) =+ verifyF (X509.SignatureALG _ X509.PubKeyALG_DSA) (X509.PubKeyDSA (pub,p,q,g)) = (\_ _ -> Left "unimplemented DSA checking") verifyF _ _ =
Data/Certificate/X509.hs view
@@ -14,12 +14,16 @@ X509(..) -- * Data Structure (reexported from X509Cert) , SignatureALG(..)+ , HashALG(..) , PubKeyALG(..) , PubKey(..) , ASN1StringType(..) , ASN1String , Certificate(..) , CertificateExt+ , Ext(..)+ , ExtKeyUsageFlag(..)+ , extDecode -- * helper for signing/veryfing certificate , getSigningData@@ -33,10 +37,12 @@ import Data.ASN1.DER import Data.ASN1.Stream (getConstructedEndRepr) import Data.ASN1.Raw (toBytes)+import Data.ASN1.BitArray import qualified Data.ByteString.Lazy as L -import Data.Certificate.X509Internal-import Data.Certificate.X509Cert+import Data.Certificate.X509.Internal+import Data.Certificate.X509.Cert+import Data.Certificate.X509.Ext data X509 = X509 Certificate (Maybe L.ByteString) (Maybe L.ByteString) SignatureALG [Word8] deriving (Show,Eq)@@ -69,10 +75,10 @@ let (sigseq,_) = getConstructedEndRepr rem2 in let cert = onContainer certrepr (runParseASN1 parseCertificate . map fst) in case (cert, map fst sigseq) of- (Right c, [BitString _ b]) ->+ (Right c, [BitString b]) -> let certevs = toBytes $ concatMap snd certrepr in let sigalg = onContainer sigalgseq (parseSigAlg . map fst) in- Right $ X509 c (Just certevs) (Just by) sigalg (L.unpack b)+ Right $ X509 c (Just certevs) (Just by) sigalg (L.unpack $ bitArrayGetData b) (Left err, _) -> Left $ ("certificate error: " ++ show err) _ -> Left $ "certificate structure error" where@@ -95,6 +101,6 @@ Left err -> error (show err) where esigalg = asn1Container Sequence [OID (sigOID sigalg), Null]- esig = BitString 0 $ L.pack sigbits+ esig = BitString $ toBitArray (L.pack sigbits) 0 header = asn1Container Sequence $ encodeCertificateHeader cert rootSeq = asn1Container Sequence (header ++ esigalg ++ [esig])
+ Data/Certificate/X509/Cert.hs view
@@ -0,0 +1,371 @@+module Data.Certificate.X509.Cert+ ( + -- * Data Structure+ SignatureALG(..)+ , HashALG(..)+ , PubKeyALG(..)+ , PubKey(..)+ , ASN1StringType(..)+ , ASN1String+ , CertificateExt+ , Certificate(..)++ -- various OID+ , oidCommonName+ , oidCountry+ , oidOrganization+ , oidOrganizationUnit++ -- signature to/from oid+ , oidSig+ , sigOID++ -- * certificate to/from asn1+ , parseCertificate+ , encodeCertificateHeader+ ) where++import Data.Word+import Data.List (find)+import Data.ASN1.DER+import Data.ASN1.BitArray+import Data.Maybe+import Data.Time.Calendar+import Data.Time.Clock (DiffTime, secondsToDiffTime)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as L+import Control.Applicative ((<$>))+import Control.Monad.State+import Control.Monad.Error+import Data.Certificate.X509.Internal+import Data.Certificate.X509.Ext++data HashALG =+ HashMD2+ | HashMD5+ | HashSHA1+ | HashSHA224+ | HashSHA256+ | HashSHA384+ | HashSHA512+ deriving (Show,Eq)++data PubKeyALG =+ PubKeyALG_RSA+ | PubKeyALG_DSA+ | PubKeyALG_ECDSA+ | PubKeyALG_DH+ | PubKeyALG_Unknown OID+ deriving (Show,Eq)++data SignatureALG =+ SignatureALG HashALG PubKeyALG+ | SignatureALG_Unknown OID+ deriving (Show,Eq)++data PubKey =+ PubKeyRSA (Int,Integer,Integer) -- ^ RSA format with (len modulus, modulus, e)+ | PubKeyDSA (Integer,Integer,Integer,Integer) -- ^ DSA format with (pub, p, q, g)+ | PubKeyDH (Integer,Integer,Integer,Maybe Integer,([Word8], Integer))+ -- ^ DH format with (p,g,q,j,(seed,pgenCounter))+ | PubKeyECDSA [ASN1] -- ^ ECDSA format not done yet FIXME+ | PubKeyUnknown OID [Word8] -- ^ unrecognized format+ deriving (Show,Eq)++type Time = (Day, DiffTime, Bool)++data CertKeyUsage =+ CertKeyUsageDigitalSignature+ | CertKeyUsageNonRepudiation+ | CertKeyUsageKeyEncipherment+ | CertKeyUsageDataEncipherment+ | CertKeyUsageKeyAgreement+ | CertKeyUsageKeyCertSign+ | CertKeyUsageCRLSign+ | CertKeyUsageEncipherOnly+ | CertKeyUsageDecipherOnly+ deriving (Show, Eq)++data ASN1StringType = UTF8 | Printable | Univ | BMP | IA5 | T61 deriving (Show,Eq)+type ASN1String = (ASN1StringType, String)++data Certificate = Certificate+ { certVersion :: Int -- ^ Certificate Version+ , certSerial :: Integer -- ^ Certificate Serial number+ , certSignatureAlg :: SignatureALG -- ^ Certificate Signature algorithm+ , certIssuerDN :: [ (OID, ASN1String) ] -- ^ Certificate Issuer DN+ , certSubjectDN :: [ (OID, ASN1String) ] -- ^ Certificate Subject DN+ , certValidity :: (Time, Time) -- ^ Certificate Validity period+ , certPubKey :: PubKey -- ^ Certificate Public key+ , certExtensions :: Maybe [CertificateExt] -- ^ Certificate Extensions+ } deriving (Show,Eq)++oidCommonName, oidCountry, oidOrganization, oidOrganizationUnit :: OID+oidCommonName = [2,5,4,3]+oidCountry = [2,5,4,6]+oidOrganization = [2,5,4,10]+oidOrganizationUnit = [2,5,4,11]++{- | parse a RSA pubkeys from ASN1 encoded bits.+ - return PubKeyRSA (len-modulus, modulus, e) if successful -}+parse_RSA :: ByteString -> ParseASN1 PubKey+parse_RSA bits =+ case decodeASN1Stream $ bits of+ Right [Start Sequence, IntVal modulus, IntVal pubexp, End Sequence] ->+ return $ PubKeyRSA (calculate_modulus modulus 1, modulus, pubexp)+ _ ->+ throwError ("bad RSA format")+ where+ calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)++parse_ECDSA :: ByteString -> ParseASN1 PubKey+parse_ECDSA bits =+ case decodeASN1Stream bits of+ Right l -> return $ PubKeyECDSA l+ Left _ -> return $ PubKeyUnknown (pubkeyalgOID PubKeyALG_ECDSA) (L.unpack bits)++parseCertHeaderVersion :: ParseASN1 Int+parseCertHeaderVersion = do+ v <- onNextContainerMaybe (Container Context 0) $ do+ n <- getNext+ case n of+ IntVal v -> return $ fromIntegral v+ _ -> throwError "unexpected type for version"+ return $ maybe 1 id v++parseCertHeaderSerial :: ParseASN1 Integer+parseCertHeaderSerial = do+ n <- getNext+ case n of+ IntVal v -> return v+ _ -> throwError ("missing serial" ++ show n)++sig_table :: [ (OID, SignatureALG) ]+sig_table =+ [ ([1,2,840,113549,1,1,5], SignatureALG HashSHA1 PubKeyALG_RSA)+ , ([1,2,840,113549,1,1,4], SignatureALG HashMD5 PubKeyALG_RSA)+ , ([1,2,840,113549,1,1,2], SignatureALG HashMD2 PubKeyALG_RSA)+ , ([1,2,840,113549,1,1,11], SignatureALG HashSHA256 PubKeyALG_RSA)+ , ([1,2,840,10040,4,3], SignatureALG HashSHA1 PubKeyALG_DSA)+ , ([1,2,840,10045,4,3,1], SignatureALG HashSHA224 PubKeyALG_ECDSA)+ , ([1,2,840,10045,4,3,2], SignatureALG HashSHA256 PubKeyALG_ECDSA)+ , ([1,2,840,10045,4,3,3], SignatureALG HashSHA384 PubKeyALG_ECDSA)+ , ([1,2,840,10045,4,3,4], SignatureALG HashSHA512 PubKeyALG_ECDSA)+ ]++pk_table :: [ (OID, PubKeyALG) ]+pk_table =+ [ ([1,2,840,113549,1,1,1], PubKeyALG_RSA)+ , ([1,2,840,10040,4,1], PubKeyALG_DSA)+ , ([1,2,840,10045,2,1], PubKeyALG_ECDSA)+ , ([1,2,840,10046,2,1], PubKeyALG_DH)+ ]++oidSig :: OID -> SignatureALG+oidSig oid = maybe (SignatureALG_Unknown oid) id $ lookup oid sig_table++oidPubKey :: OID -> PubKeyALG+oidPubKey oid = maybe (PubKeyALG_Unknown oid) id $ lookup oid pk_table++sigOID :: SignatureALG -> OID+sigOID (SignatureALG_Unknown oid) = oid+sigOID sig = maybe [] fst $ find ((==) sig . snd) sig_table++pubkeyalgOID :: PubKeyALG -> OID+pubkeyalgOID (PubKeyALG_Unknown oid) = oid+pubkeyalgOID sig = maybe [] fst $ find ((==) sig . snd) pk_table++pubkeyToAlg :: PubKey -> PubKeyALG+pubkeyToAlg (PubKeyRSA _) = PubKeyALG_RSA+pubkeyToAlg (PubKeyDSA _) = PubKeyALG_DSA+pubkeyToAlg (PubKeyDH _) = PubKeyALG_DH+pubkeyToAlg (PubKeyECDSA _) = PubKeyALG_ECDSA+pubkeyToAlg (PubKeyUnknown oid _) = PubKeyALG_Unknown oid++parseCertHeaderAlgorithmID :: ParseASN1 SignatureALG+parseCertHeaderAlgorithmID = do+ n <- getNextContainer Sequence+ case n of+ [ OID oid, Null ] -> return $ oidSig oid+ [ OID oid ] -> return $ oidSig oid+ _ -> throwError ("algorithm ID bad format " ++ show n)++asn1String :: ASN1 -> ASN1String+asn1String (PrintableString x) = (Printable, x)+asn1String (UTF8String x) = (UTF8, x)+asn1String (UniversalString x) = (Univ, x)+asn1String (BMPString x) = (BMP, x)+asn1String (IA5String x) = (IA5, x)+asn1String (T61String x) = (IA5, x)+asn1String x = error ("not a print string " ++ show x)++encodeAsn1String :: ASN1String -> ASN1+encodeAsn1String (Printable, x) = PrintableString x+encodeAsn1String (UTF8, x) = UTF8String x+encodeAsn1String (Univ, x) = UniversalString x+encodeAsn1String (BMP, x) = BMPString x+encodeAsn1String (IA5, x) = IA5String x+encodeAsn1String (T61, x) = T61String x++parseCertHeaderDN :: ParseASN1 [ (OID, ASN1String) ]+parseCertHeaderDN = do+ onNextContainer Sequence getDNs+ where+ getDNs = do+ n <- hasNext+ if n+ then liftM2 (:) parseDNOne getDNs+ else return []+ parseDNOne = onNextContainer Set $ do+ s <- getNextContainer Sequence+ case s of+ [OID oid, val] -> return (oid, asn1String val)+ _ -> throwError "expecting sequence"++parseCertHeaderValidity :: ParseASN1 (Time, Time)+parseCertHeaderValidity = do+ n <- getNextContainer Sequence+ case n of+ [ UTCTime t1, UTCTime t2 ] -> return (convertTime t1, convertTime t2)+ _ -> throwError "bad validity format"+ where convertTime (y,m,d,h,mi,s,u) =+ let day = fromGregorian (fromIntegral y) m d in+ let dtime = secondsToDiffTime (fromIntegral h * 3600 + fromIntegral mi * 60 + fromIntegral s) in+ (day, dtime, u)++parseCertHeaderSubjectPK :: ParseASN1 PubKey+parseCertHeaderSubjectPK = onNextContainer Sequence $ do+ l <- getNextContainer Sequence+ bits <- getNextBitString+ case l of+ [OID pkalg,Null] -> do+ let sig = oidPubKey pkalg+ case sig of+ PubKeyALG_RSA -> parse_RSA bits+ _ -> return $ PubKeyUnknown pkalg $ L.unpack bits+ [OID pkalg,OID _] -> do+ let sig = oidPubKey pkalg+ case sig of+ PubKeyALG_ECDSA -> parse_ECDSA bits+ _ -> return $ PubKeyUnknown pkalg $ L.unpack bits+ [OID pkalg,Start Sequence,IntVal p,IntVal q,IntVal g,End Sequence] -> do+ let sig = oidPubKey pkalg+ case decodeASN1Stream bits of+ Right [IntVal dsapub] -> return $ PubKeyDSA (dsapub, p, q, g)+ _ -> return $ PubKeyUnknown pkalg $ L.unpack bits+ n ->+ throwError ("subject public key bad format : " ++ show n)++ where getNextBitString = getNext >>= \bs -> case bs of+ BitString bits -> return $ bitArrayGetData bits+ _ -> throwError "expecting bitstring"++parseCertExtensions :: ParseASN1 (Maybe [CertificateExt])+parseCertExtensions = do+ onNextContainerMaybe (Container Context 3) (mapMaybe extractExtension <$> onNextContainer Sequence getSequences)+ where+ getSequences = do+ n <- hasNext+ if n+ then getNextContainer Sequence >>= \sq -> liftM (sq :) getSequences+ else return []+ extractExtension [OID oid,Boolean True,OctetString obj] = case decodeASN1Stream obj of+ Left _ -> Nothing+ Right r -> Just (oid, True, r)+ extractExtension [OID oid,OctetString obj] = case decodeASN1Stream obj of+ Left _ -> Nothing+ Right r -> Just (oid, False, r)+ extractExtension _ = Nothing++{- | parse header structure of a x509 certificate. the structure the following:+ Version+ Serial Number+ Algorithm ID+ Issuer+ Validity+ Not Before+ Not After+ Subject+ Subject Public Key Info+ Public Key Algorithm+ Subject Public Key+ Issuer Unique Identifier (Optional) (>= 2)+ Subject Unique Identifier (Optional) (>= 2)+ Extensions (Optional) (>= v3)+-}+parseCertificate :: ParseASN1 Certificate+parseCertificate = do+ version <- parseCertHeaderVersion+ serial <- parseCertHeaderSerial+ sigalg <- parseCertHeaderAlgorithmID+ issuer <- parseCertHeaderDN+ validity <- parseCertHeaderValidity+ subject <- parseCertHeaderDN+ pk <- parseCertHeaderSubjectPK+ exts <- parseCertExtensions+ hnext <- hasNext+ when hnext $ throwError "expecting End Of Data."+ + return $ Certificate+ { certVersion = version+ , certSerial = serial+ , certSignatureAlg = sigalg+ , certIssuerDN = issuer+ , certSubjectDN = subject+ , certValidity = validity+ , certPubKey = pk+ , certExtensions = exts+ }++encodeDN :: [ (OID, ASN1String) ] -> [ASN1]+encodeDN dn = asn1Container Sequence $ concatMap dnSet dn+ where+ dnSet (oid, stringy) = asn1Container Set (asn1Container Sequence [OID oid, encodeAsn1String stringy])++encodePK :: PubKey -> [ASN1]+encodePK k@(PubKeyRSA (_, modulus, e)) =+ asn1Container Sequence (asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray bits 0])+ where+ pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k+ (Right bits) = encodeASN1Stream $ asn1Container Sequence [IntVal modulus, IntVal e]++encodePK k@(PubKeyDSA (pub, p, q, g)) =+ asn1Container Sequence (asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString $ toBitArray bits 0])+ where+ pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k+ dsaseq = asn1Container Sequence [IntVal p,IntVal q,IntVal g]+ (Right bits) = encodeASN1Stream [IntVal pub]++encodePK k@(PubKeyUnknown _ l) =+ asn1Container Sequence (asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray (L.pack l) 0])+ where+ pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k++encodeExts :: Maybe [CertificateExt] -> [ASN1]+encodeExts Nothing = []+encodeExts (Just l) = asn1Container (Container Context 3) $ concatMap encodeExt l+ where encodeExt (oid, critical, asn1) = case encodeASN1Stream asn1 of+ Left _ -> error "cannot encode asn1 extension"+ Right bs -> asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString bs])++encodeCertificateHeader :: Certificate -> [ASN1]+encodeCertificateHeader cert =+ eVer ++ eSerial ++ eAlgId ++ eIssuer ++ eValidity ++ eSubject ++ epkinfo ++ eexts+ where+ eVer = asn1Container (Container Context 0) [IntVal (fromIntegral $ certVersion cert)]+ eSerial = [IntVal $ certSerial cert]+ eAlgId = asn1Container Sequence [OID (sigOID $ certSignatureAlg cert), Null]+ eIssuer = encodeDN $ certIssuerDN cert+ (t1, t2) = certValidity cert+ eValidity = asn1Container Sequence [UTCTime $ unconvertTime t1, UTCTime $ unconvertTime t2]+ eSubject = encodeDN $ certSubjectDN cert+ epkinfo = encodePK $ certPubKey cert+ eexts = encodeExts $ certExtensions cert++ unconvertTime (day, difftime, z) =+ let (y, m, d) = toGregorian day in+ let seconds = floor $ toRational difftime in+ let h = seconds `div` 3600 in+ let mi = (seconds `div` 60) `mod` 60 in+ let s = seconds `mod` 60 in+ (fromIntegral y,m,d,h,mi,s,z)
+ Data/Certificate/X509/Internal.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Certificate.X509.Internal+ ( ParseASN1+ , runParseASN1+ , onNextContainer+ , onNextContainerMaybe+ , getNextContainer+ , getNextContainerMaybe+ , getNext+ , hasNext+ , makeASN1Sequence+ , asn1Container+ , OID+ ) where++import Data.ASN1.DER+import Data.ASN1.Stream (getConstructedEnd)+import Control.Monad.State+import Control.Monad.Error++type OID = [Integer]++newtype ParseASN1 a = P { runP :: ErrorT String (State [ASN1]) a }+ deriving (Functor, Monad, MonadError String)++runParseASN1 :: ParseASN1 a -> [ASN1] -> Either String a+runParseASN1 f s =+ case runState (runErrorT (runP f)) s of+ (Left err, _) -> Left err+ (Right r, _) -> Right r++getNext :: ParseASN1 ASN1+getNext = do+ list <- P (lift get)+ case list of+ [] -> throwError "empty"+ (h:l) -> P (lift (put l)) >> return h++getNextContainer :: ASN1ConstructionType -> ParseASN1 [ASN1]+getNextContainer ty = do+ list <- P (lift get)+ case list of+ [] -> throwError "empty"+ (h:l) -> if h == Start ty+ then do+ let (l1, l2) = getConstructedEnd 0 l+ P (lift $ put l2) >> return l1+ else throwError "not an expected container"+++onNextContainer :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a+onNextContainer ty f = do+ n <- getNextContainer ty+ case runParseASN1 f n of+ Left err -> throwError err+ Right r -> return r++getNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])+getNextContainerMaybe ty = do+ list <- P (lift get)+ case list of+ [] -> return Nothing+ (h:l) -> if h == Start ty+ then do+ let (l1, l2) = getConstructedEnd 0 l+ P (lift $ put l2) >> return (Just l1)+ else return Nothing++onNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)+onNextContainerMaybe ty f = do+ n <- getNextContainerMaybe ty+ case n of+ Just l -> case runParseASN1 f l of+ Left err -> throwError err+ Right r -> return $ Just r+ Nothing -> return Nothing++hasNext :: ParseASN1 Bool+hasNext = do+ list <- P (lift get)+ case list of+ [] -> return False+ _ -> return True++asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1]+asn1Container ty l = [Start ty] ++ l ++ [End ty]++makeASN1Sequence :: [ASN1] -> [[ASN1]]+makeASN1Sequence list =+ let (l1, l2) = getConstructedEnd 0 list in+ case l2 of+ [] -> []+ _ -> l1 : makeASN1Sequence l2+
− Data/Certificate/X509Cert.hs
@@ -1,388 +0,0 @@-module Data.Certificate.X509Cert- ( - -- * Data Structure- SignatureALG(..)- , PubKeyALG(..)- , PubKey(..)- , ASN1StringType(..)- , ASN1String- , CertificateExt- , Certificate(..)-- -- various OID- , oidCommonName- , oidCountry- , oidOrganization- , oidOrganizationUnit-- -- signature to/from oid- , oidSig- , sigOID-- -- * certificate to/from asn1- , parseCertificate- , encodeCertificateHeader- ) where--import Data.Word-import Data.List (find)-import Data.ASN1.DER-import Data.Maybe-import Data.Time.Calendar-import Data.Time.Clock (DiffTime, secondsToDiffTime)-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as L-import Control.Applicative ((<$>))-import Control.Monad.State-import Control.Monad.Error-import Data.Certificate.X509Internal--type OID = [Integer]--data SignatureALG =- SignatureALG_md5WithRSAEncryption- | SignatureALG_md2WithRSAEncryption- | SignatureALG_sha1WithRSAEncryption- | SignatureALG_dsaWithSHA1- | SignatureALG_ecdsaWithSHA384- | SignatureALG_Unknown OID- deriving (Show, Eq)--data PubKeyALG =- PubKeyALG_RSA- | PubKeyALG_DSA- | PubKeyALG_ECDSA- | PubKeyALG_DH- | PubKeyALG_Unknown OID- deriving (Show,Eq)--data PubKey =- PubKeyRSA (Int,Integer,Integer) -- ^ RSA format with (len modulus, modulus, e)- | PubKeyDSA (Integer,Integer,Integer,Integer) -- ^ DSA format with (pub, p, q, g)- | PubKeyDH (Integer,Integer,Integer,Maybe Integer,([Word8], Integer))- -- ^ DH format with (p,g,q,j,(seed,pgenCounter))- | PubKeyECDSA [ASN1] -- ^ ECDSA format not done yet FIXME- | PubKeyUnknown OID [Word8] -- ^ unrecognized format- deriving (Show,Eq)--type Time = (Day, DiffTime, Bool)--data CertKeyUsage =- CertKeyUsageDigitalSignature- | CertKeyUsageNonRepudiation- | CertKeyUsageKeyEncipherment- | CertKeyUsageDataEncipherment- | CertKeyUsageKeyAgreement- | CertKeyUsageKeyCertSign- | CertKeyUsageCRLSign- | CertKeyUsageEncipherOnly- | CertKeyUsageDecipherOnly- deriving (Show, Eq)--data ASN1StringType = UTF8 | Printable | Univ | BMP | IA5 | T61 deriving (Show,Eq)-type ASN1String = (ASN1StringType, String)--type CertificateExt = (OID, Bool, [ASN1])--data Certificate = Certificate- { certVersion :: Int -- ^ Certificate Version- , certSerial :: Integer -- ^ Certificate Serial number- , certSignatureAlg :: SignatureALG -- ^ Certificate Signature algorithm- , certIssuerDN :: [ (OID, ASN1String) ] -- ^ Certificate Issuer DN- , certSubjectDN :: [ (OID, ASN1String) ] -- ^ Certificate Subject DN- , certValidity :: (Time, Time) -- ^ Certificate Validity period- , certPubKey :: PubKey -- ^ Certificate Public key- , certExtensions :: Maybe [CertificateExt] -- ^ Certificate Extensions- } deriving (Show,Eq)--oidCommonName, oidCountry, oidOrganization, oidOrganizationUnit :: OID-oidCommonName = [2,5,4,3]-oidCountry = [2,5,4,6]-oidOrganization = [2,5,4,10]-oidOrganizationUnit = [2,5,4,11]--{- | parse a RSA pubkeys from ASN1 encoded bits.- - return PubKeyRSA (len-modulus, modulus, e) if successful -}-parse_RSA :: ByteString -> ParseASN1 PubKey-parse_RSA bits =- case decodeASN1Stream $ bits of- Right [Start Sequence, IntVal modulus, IntVal pubexp, End Sequence] ->- return $ PubKeyRSA (calculate_modulus modulus 1, modulus, pubexp)- _ ->- throwError ("bad RSA format")- where- calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)--parse_ECDSA :: ByteString -> ParseASN1 PubKey-parse_ECDSA bits =- case decodeASN1Stream bits of- Right l -> return $ PubKeyECDSA l- Left _ -> return $ PubKeyUnknown (pubkeyalgOID PubKeyALG_ECDSA) (L.unpack bits)--parseCertHeaderVersion :: ParseASN1 Int-parseCertHeaderVersion = do- v <- onNextContainerMaybe (Container Context 0) $ do- n <- getNext- case n of- IntVal v -> return $ fromIntegral v- _ -> throwError "unexpected type for version"- return $ maybe 1 id v--parseCertHeaderSerial :: ParseASN1 Integer-parseCertHeaderSerial = do- n <- getNext- case n of- IntVal v -> return v- _ -> throwError ("missing serial" ++ show n)--sig_table :: [ (OID, SignatureALG) ]-sig_table =- [ ([1,2,840,113549,1,1,5], SignatureALG_sha1WithRSAEncryption)- , ([1,2,840,113549,1,1,4], SignatureALG_md5WithRSAEncryption)- , ([1,2,840,113549,1,1,2], SignatureALG_md2WithRSAEncryption)- , ([1,2,840,10040,4,3], SignatureALG_dsaWithSHA1)- , ([1,2,840,10045,4,3,3], SignatureALG_ecdsaWithSHA384)- ]--pk_table :: [ (OID, PubKeyALG) ]-pk_table =- [ ([1,2,840,113549,1,1,1], PubKeyALG_RSA)- , ([1,2,840,10040,4,1], PubKeyALG_DSA)- , ([1,2,840,10045,2,1], PubKeyALG_ECDSA)- , ([1,2,840,10046,2,1], PubKeyALG_DH)- ]--oidSig :: OID -> SignatureALG-oidSig oid = maybe (SignatureALG_Unknown oid) snd $ find ((==) oid . fst) sig_table--oidPubKey :: OID -> PubKeyALG-oidPubKey oid = maybe (PubKeyALG_Unknown oid) snd $ find ((==) oid . fst) pk_table--sigOID :: SignatureALG -> OID-sigOID (SignatureALG_Unknown oid) = oid-sigOID sig = maybe [] fst $ find ((==) sig . snd) sig_table--pubkeyalgOID :: PubKeyALG -> OID-pubkeyalgOID (PubKeyALG_Unknown oid) = oid-pubkeyalgOID sig = maybe [] fst $ find ((==) sig . snd) pk_table--pubkeyToAlg :: PubKey -> PubKeyALG-pubkeyToAlg (PubKeyRSA _) = PubKeyALG_RSA-pubkeyToAlg (PubKeyDSA _) = PubKeyALG_DSA-pubkeyToAlg (PubKeyDH _) = PubKeyALG_DH-pubkeyToAlg (PubKeyECDSA _) = PubKeyALG_ECDSA-pubkeyToAlg (PubKeyUnknown oid _) = PubKeyALG_Unknown oid--parseCertHeaderAlgorithmID :: ParseASN1 SignatureALG-parseCertHeaderAlgorithmID = do- n <- getNextContainer Sequence- case n of- [ OID oid, Null ] -> return $ oidSig oid- [ OID oid ] -> return $ oidSig oid- _ -> throwError ("algorithm ID bad format " ++ show n)--asn1String :: ASN1 -> ASN1String-asn1String (PrintableString x) = (Printable, x)-asn1String (UTF8String x) = (UTF8, x)-asn1String (UniversalString x) = (Univ, x)-asn1String (BMPString x) = (BMP, x)-asn1String (IA5String x) = (IA5, x)-asn1String (T61String x) = (IA5, x)-asn1String x = error ("not a print string " ++ show x)--encodeAsn1String :: ASN1String -> ASN1-encodeAsn1String (Printable, x) = PrintableString x-encodeAsn1String (UTF8, x) = UTF8String x-encodeAsn1String (Univ, x) = UniversalString x-encodeAsn1String (BMP, x) = BMPString x-encodeAsn1String (IA5, x) = IA5String x-encodeAsn1String (T61, x) = T61String x--parseCertHeaderDN :: ParseASN1 [ (OID, ASN1String) ]-parseCertHeaderDN = do- onNextContainer Sequence getDNs- where- getDNs = do- n <- hasNext- if n- then do- dn <- parseDNOne- liftM (dn :) getDNs- else return []- parseDNOne = onNextContainer Set $ do- s <- getNextContainer Sequence- case s of- [OID oid, val] -> return (oid, asn1String val)- _ -> throwError "expecting sequence"--parseCertHeaderValidity :: ParseASN1 (Time, Time)-parseCertHeaderValidity = do- n <- getNextContainer Sequence- case n of- [ UTCTime t1, UTCTime t2 ] -> return (convertTime t1, convertTime t2)- _ -> throwError "bad validity format"- where convertTime (y,m,d,h,mi,s,u) =- let day = fromGregorian (fromIntegral y) m d in- let dtime = secondsToDiffTime (fromIntegral h * 3600 + fromIntegral mi * 60 + fromIntegral s) in- (day, dtime, u)--parseCertHeaderSubjectPK :: ParseASN1 PubKey-parseCertHeaderSubjectPK = onNextContainer Sequence $ do- l <- getNextContainer Sequence- bits <- getNextBitString- case l of- [OID pkalg,Null] -> do- let sig = oidPubKey pkalg- case sig of- PubKeyALG_RSA -> parse_RSA bits- _ -> return $ PubKeyUnknown pkalg $ L.unpack bits- [OID pkalg,OID _] -> do- let sig = oidPubKey pkalg- case sig of- PubKeyALG_ECDSA -> parse_ECDSA bits- _ -> return $ PubKeyUnknown pkalg $ L.unpack bits- [OID pkalg,Start Sequence,IntVal p,IntVal q,IntVal g,End Sequence] -> do- let sig = oidPubKey pkalg- case decodeASN1Stream bits of- Right [IntVal dsapub] -> return $ PubKeyDSA (dsapub, p, q, g)- _ -> return $ PubKeyUnknown pkalg $ L.unpack bits- n ->- throwError ("subject public key bad format : " ++ show n)-- where getNextBitString = getNext >>= \bs -> case bs of- BitString _ bits -> return bits- _ -> throwError "expecting bitstring"---- RFC 5280-{-- ([2,5,29,14], critical, Right [OctetString x]) ->- modify (\s -> s { certExtSubjectKeyIdentifier = Just (critical, L.unpack x) })- ([2,5,29,15], critical, Right (BitString _ _)) ->- all the flags:- digitalSignature (0),- nonRepudiation (1), -- recent editions of X.509 have renamed this bit to contentCommitment- keyEncipherment (2),- dataEncipherment (3),- keyAgreement (4),- keyCertSign (5),- cRLSign (6),- encipherOnly (7),- decipherOnly (8) }- ([2,5,29,19], -- basic contraints- ([2,5,29,31] -- distributions points- ([2,5,29,32] -- policies- ([2,5,29,33] -- policies mapping- ([2,5,29,35], critical, obj) -> -- authority key identifer--}----extGetDistributionPoint :: [CertificateExt] -> --parseCertExtensions :: ParseASN1 (Maybe [CertificateExt])-parseCertExtensions = do- onNextContainerMaybe (Container Context 3) (mapMaybe extractExtension <$> onNextContainer Sequence getSequences)- where- getSequences = do- n <- hasNext- if n- then getNextContainer Sequence >>= \sq -> liftM (sq :) getSequences- else return []- extractExtension [OID oid,Boolean True,OctetString obj] = case decodeASN1Stream obj of- Left _ -> Nothing- Right r -> Just (oid, True, r)- extractExtension [OID oid,OctetString obj] = case decodeASN1Stream obj of- Left _ -> Nothing- Right r -> Just (oid, False, r)- extractExtension _ = Nothing--{- | parse header structure of a x509 certificate. the structure the following:- Version- Serial Number- Algorithm ID- Issuer- Validity- Not Before- Not After- Subject- Subject Public Key Info- Public Key Algorithm- Subject Public Key- Issuer Unique Identifier (Optional) (>= 2)- Subject Unique Identifier (Optional) (>= 2)- Extensions (Optional) (>= v3)--}-parseCertificate :: ParseASN1 Certificate-parseCertificate = do- version <- parseCertHeaderVersion- serial <- parseCertHeaderSerial- sigalg <- parseCertHeaderAlgorithmID- issuer <- parseCertHeaderDN- validity <- parseCertHeaderValidity- subject <- parseCertHeaderDN- pk <- parseCertHeaderSubjectPK- exts <- parseCertExtensions- hnext <- hasNext- when hnext $ throwError "expecting End Of Data."- - return $ Certificate- { certVersion = version- , certSerial = serial- , certSignatureAlg = sigalg- , certIssuerDN = issuer- , certSubjectDN = subject- , certValidity = validity- , certPubKey = pk- , certExtensions = exts- }--encodeDN :: [ (OID, ASN1String) ] -> [ASN1]-encodeDN dn = asn1Container Sequence $ concatMap dnSet dn- where- dnSet (oid, stringy) = asn1Container Set (asn1Container Sequence [OID oid, encodeAsn1String stringy])--encodePK :: PubKey -> [ASN1]-encodePK k@(PubKeyRSA (_, modulus, e)) =- asn1Container Sequence (asn1Container Sequence [pkalg,Null] ++ [BitString 0 bits])- where- pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k- (Right bits) = encodeASN1Stream $ asn1Container Sequence [IntVal modulus, IntVal e]--encodePK k@(PubKeyDSA (pub, p, q, g)) =- asn1Container Sequence (asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString 0 bits])- where- pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k- dsaseq = asn1Container Sequence [IntVal p,IntVal q,IntVal g]- (Right bits) = encodeASN1Stream [IntVal pub]--encodePK k@(PubKeyUnknown _ l) =- asn1Container Sequence (asn1Container Sequence [pkalg,Null] ++ [BitString 0 $ L.pack l])- where- pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k--encodeExts :: Maybe [CertificateExt] -> [ASN1]-encodeExts Nothing = []-encodeExts (Just l) = asn1Container (Container Context 3) $ concatMap encodeExt l- where encodeExt (oid, critical, asn1) = case encodeASN1Stream asn1 of- Left _ -> error "cannot encode asn1 extension"- Right bs -> asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString bs])--encodeCertificateHeader :: Certificate -> [ASN1]-encodeCertificateHeader cert =- eVer ++ eSerial ++ eAlgId ++ eIssuer ++ eValidity ++ eSubject ++ epkinfo ++ eexts- where- eVer = asn1Container (Container Context 0) [IntVal (fromIntegral $ certVersion cert)]- eSerial = [IntVal $ certSerial cert]- eAlgId = asn1Container Sequence [OID (sigOID $ certSignatureAlg cert), Null]- eIssuer = encodeDN $ certIssuerDN cert- (t1, t2) = certValidity cert- eValidity = asn1Container Sequence [UTCTime $ unconvertTime t1, UTCTime $ unconvertTime t2]- eSubject = encodeDN $ certSubjectDN cert- epkinfo = encodePK $ certPubKey cert- eexts = encodeExts $ certExtensions cert-- unconvertTime (day, difftime, z) =- let (y, m, d) = toGregorian day in- let seconds = floor $ toRational difftime in- let h = seconds `div` 3600 in- let mi = (seconds `div` 60) `mod` 60 in- let s = seconds `mod` 60 in- (fromIntegral y,m,d,h,mi,s,z)
− Data/Certificate/X509Internal.hs
@@ -1,92 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Data.Certificate.X509Internal- ( ParseASN1- , runParseASN1- , onNextContainer- , onNextContainerMaybe- , getNextContainer- , getNextContainerMaybe- , getNext- , hasNext- , makeASN1Sequence- , asn1Container- ) where--import Data.ASN1.DER-import Data.ASN1.Stream (getConstructedEnd)-import Control.Monad.State-import Control.Monad.Error--newtype ParseASN1 a = P { runP :: ErrorT String (State [ASN1]) a }- deriving (Functor, Monad, MonadError String)--runParseASN1 :: ParseASN1 a -> [ASN1] -> Either String a-runParseASN1 f s =- case runState (runErrorT (runP f)) s of- (Left err, _) -> Left err- (Right r, _) -> Right r--getNext :: ParseASN1 ASN1-getNext = do- list <- P (lift get)- case list of- [] -> throwError "empty"- (h:l) -> P (lift (put l)) >> return h--getNextContainer :: ASN1ConstructionType -> ParseASN1 [ASN1]-getNextContainer ty = do- list <- P (lift get)- case list of- [] -> throwError "empty"- (h:l) -> if h == Start ty- then do- let (l1, l2) = getConstructedEnd 0 l- P (lift $ put l2) >> return l1- else throwError "not an expected container"---onNextContainer :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a-onNextContainer ty f = do- n <- getNextContainer ty- case runParseASN1 f n of- Left err -> throwError err- Right r -> return r--getNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])-getNextContainerMaybe ty = do- list <- P (lift get)- case list of- [] -> return Nothing- (h:l) -> if h == Start ty- then do- let (l1, l2) = getConstructedEnd 0 l- P (lift $ put l2) >> return (Just l1)- else return Nothing--onNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)-onNextContainerMaybe ty f = do- n <- getNextContainerMaybe ty- case n of- Just l -> case runParseASN1 f l of- Left err -> throwError err- Right r -> return $ Just r- Nothing -> return Nothing--hasNext :: ParseASN1 Bool-hasNext = do- list <- P (lift get)- case list of- [] -> return False- _ -> return True--asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1]-asn1Container ty l = [Start ty] ++ l ++ [End ty]--makeASN1Sequence :: [ASN1] -> [[ASN1]]-makeASN1Sequence list =- let (l1, l2) = getConstructedEnd 0 list in- case l2 of- [] -> []- _ -> l1 : makeASN1Sequence l2-
System/Certificate/X509/MacOS.hs view
@@ -4,6 +4,17 @@ import Data.Certificate.X509 import Data.Certificate.PEM+import System.Process+import Data.ByteString hiding (filter, map)+import qualified Data.ByteString.Lazy as LBS+import Control.Applicative+import Data.Either+import Data.Maybe findCertificate :: (X509 -> Bool) -> IO (Maybe X509)-findCertificate f = undefined+findCertificate f = do+ (_, h, _, ph) <- runInteractiveCommand "security find-certificate -pa"+ waitForProcess ph+ pems <- parsePEMs <$> hGetContents h+ let targets = rights $ map (decodeCertificate . LBS.fromChunks . pure . snd) $ filter ((=="CERTIFICATE") . fst) pems+ return $ listToMaybe $ filter f targets
certificate.cabal view
@@ -1,5 +1,5 @@ Name: certificate-Version: 0.9.1+Version: 0.9.2 Description: Certificates and Key reader/writer .@@ -29,17 +29,17 @@ Build-Depends: base >= 3 && < 5 , bytestring , mtl- , asn1-data >= 0.5.0 && < 0.6+ , asn1-data >= 0.6.0 && < 0.7 , base64-bytestring , directory , time- Exposed-modules: Data.Certificate.X509,- Data.Certificate.X509Cert,- Data.Certificate.PEM,+ Exposed-modules: Data.Certificate.X509+ Data.Certificate.X509.Cert+ Data.Certificate.PEM Data.Certificate.KeyDSA Data.Certificate.KeyRSA System.Certificate.X509- Other-modules: Data.Certificate.X509Internal+ Other-modules: Data.Certificate.X509.Internal System.Certificate.X509.Unix ghc-options: -Wall if os(windows)@@ -48,6 +48,7 @@ Other-modules: System.Certificate.X509.Win32 if os(OSX) cpp-options: -DMACOSX+ Build-Depends: process Other-modules: System.Certificate.X509.MacOS Executable certificate