diff --git a/Certificate.hs b/Certificate.hs --- a/Certificate.hs +++ b/Certificate.hs @@ -36,8 +36,20 @@ showDN dn = mapM_ (\(oid, (_,t)) -> putStrLn (" " ++ show oid ++ ": " ++ t)) dn -showExts es = mapM_ (putStrLn . (" " ++) . showExt) es - where showExt e = maybe ("unknown: " ++ show e) show $ X509.extDecode e +showExts es = do + mapM_ showExt es + putStrLn "known extensions decoded: " + showKnownExtension (X509.extensionGet es :: Maybe X509.ExtBasicConstraints) + showKnownExtension (X509.extensionGet es :: Maybe X509.ExtKeyUsage) + showKnownExtension (X509.extensionGet es :: Maybe X509.ExtSubjectKeyId) + showKnownExtension (X509.extensionGet es :: Maybe X509.ExtSubjectAltName) + showKnownExtension (X509.extensionGet es :: Maybe X509.ExtAuthorityKeyId) + where + showExt (oid,critical,asn1) = do + putStrLn (" OID: " ++ show oid ++ " critical: " ++ show critical) + putStrLn (" " ++ show asn1) + showKnownExtension Nothing = return () + showKnownExtension (Just e) = putStrLn (" " ++ show e) showCert :: X509.X509 -> IO () showCert (X509.X509 cert _ _ sigalg sigbits) = do diff --git a/Data/Certificate/X509.hs b/Data/Certificate/X509.hs --- a/Data/Certificate/X509.hs +++ b/Data/Certificate/X509.hs @@ -20,10 +20,7 @@ , ASN1StringType(..) , ASN1String , Certificate(..) - , CertificateExt - , Ext(..) - , ExtKeyUsageFlag(..) - , extDecode + , module Data.Certificate.X509.Ext -- * helper for signing/veryfing certificate , getSigningData diff --git a/Data/Certificate/X509/Cert.hs b/Data/Certificate/X509/Cert.hs --- a/Data/Certificate/X509/Cert.hs +++ b/Data/Certificate/X509/Cert.hs @@ -7,7 +7,6 @@ , PubKey(..) , ASN1StringType(..) , ASN1String - , CertificateExt , Certificate(..) -- various OID @@ -23,6 +22,9 @@ -- * certificate to/from asn1 , parseCertificate , encodeCertificateHeader + + -- * extensions + , module Data.Certificate.X509.Ext ) where import Data.Word @@ -99,7 +101,7 @@ , certSubjectDN :: [ (OID, ASN1String) ] -- ^ Certificate Subject DN , certValidity :: (Time, Time) -- ^ Certificate Validity period , certPubKey :: PubKey -- ^ Certificate Public key - , certExtensions :: Maybe [CertificateExt] -- ^ Certificate Extensions + , certExtensions :: Maybe [ExtensionRaw] -- ^ Certificate Extensions } deriving (Show,Eq) oidCommonName, oidCountry, oidOrganization, oidOrganizationUnit :: OID @@ -267,7 +269,7 @@ BitString bits -> return $ bitArrayGetData bits _ -> throwError "expecting bitstring" -parseCertExtensions :: ParseASN1 (Maybe [CertificateExt]) +parseCertExtensions :: ParseASN1 (Maybe [ExtensionRaw]) parseCertExtensions = onNextContainerMaybe (Container Context 3) (sortByOID . mapMaybe extractExtension <$> onNextContainer Sequence getSequences) where sortByOID = sortBy (\(a,_,_) (b,_,_) -> a `compare` b) @@ -349,7 +351,7 @@ where pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k -encodeExts :: Maybe [CertificateExt] -> [ASN1] +encodeExts :: Maybe [ExtensionRaw] -> [ASN1] encodeExts Nothing = [] encodeExts (Just l) = asn1Container (Container Context 3) $ concatMap encodeExt l where encodeExt (oid, critical, asn1) = case encodeASN1Stream asn1 of diff --git a/Data/Certificate/X509/Ext.hs b/Data/Certificate/X509/Ext.hs --- a/Data/Certificate/X509/Ext.hs +++ b/Data/Certificate/X509/Ext.hs @@ -8,19 +8,27 @@ -- extension processing module. -- module Data.Certificate.X509.Ext - ( CertificateExt - , Ext(..) + ( ExtensionRaw + , Extension(..) + -- * Common extension usually found in x509v3 + , ExtBasicConstraints(..) + , ExtKeyUsage(..) , ExtKeyUsageFlag(..) - , extDecode + , ExtSubjectKeyId(..) + , ExtSubjectAltName(..) + , ExtAuthorityKeyId(..) + -- * Accessor turning extension into a specific one + , extensionGet ) where import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L import Data.ASN1.DER import Data.ASN1.BitArray import Data.Certificate.X509.Internal -type CertificateExt = (OID, Bool, [ASN1]) +type ExtensionRaw = (OID, Bool, [ASN1]) -- | key usage flag that is found in the key usage extension field. data ExtKeyUsageFlag = @@ -35,51 +43,79 @@ | KeyUsage_decipherOnly -- (8) deriving (Show,Eq,Ord,Enum) +{- -- RFC 5280 -oidSubjectKeyId, oidKeyUsage, oidBasicConstraints, oidDistributionPoints, - oidPolicies, oidPoliciesMapping, oidAuthorityKeyId :: OID -oidSubjectKeyId = [2,5,29,14] -oidKeyUsage = [2,5,29,15] -oidBasicConstraints = [2,5,29,19] +oidDistributionPoints, oidPolicies, oidPoliciesMapping :: OID oidDistributionPoints = [2,5,29,31] oidPolicies = [2,5,29,32] oidPoliciesMapping = [2,5,29,33] -oidAuthorityKeyId = [2,5,29,35] +-} --- | known X509v3 extensions -data Ext = - ExtBasicConstraints Bool - | ExtKeyUsage [ExtKeyUsageFlag] - | ExtSubjectKeyId L.ByteString - | ExtAuthorityKeyId B.ByteString +class Extension a where + extOID :: a -> OID + extEncode :: a -> [ASN1] + extDecode :: [ASN1] -> Either String a + +extensionGet :: Extension a => [ExtensionRaw] -> Maybe a +extensionGet [] = Nothing +extensionGet ((oid,_,asn1):xs) = case extDecode asn1 of + Right b + | oid == extOID b -> Just b + | otherwise -> extensionGet xs + Left _ -> extensionGet xs + +data ExtBasicConstraints = ExtBasicConstraints Bool deriving (Show,Eq) --- | try decoding a certificateExt tuple into a known extension. -extDecode :: CertificateExt -> Maybe Ext -extDecode (oid, _, asn1) - | oid == oidBasicConstraints = decodeBasicConstraints asn1 - | oid == oidSubjectKeyId = decodeSubjectKeyId asn1 - | oid == oidAuthorityKeyId = decodeAuthorityKeyId asn1 - | oid == oidKeyUsage = decodeKeyUsage asn1 - | otherwise = Nothing - where - -- basic constraints - decodeBasicConstraints [Start Sequence,Boolean b,End Sequence] = - Just (ExtBasicConstraints b) - decodeBasicConstraints _ = Nothing - -- subject key id - decodeSubjectKeyId [OctetString o] = - Just (ExtSubjectKeyId o) - decodeSubjectKeyId _ = Nothing - -- key usage - decodeKeyUsage [BitString bits] = Just $ ExtKeyUsage $ bitsToFlags bits - decodeKeyUsage _ = Nothing +instance Extension ExtBasicConstraints where + extOID = const [2,5,29,19] + extEncode (ExtBasicConstraints b) = [Start Sequence,Boolean b,End Sequence] + extDecode [Start Sequence,Boolean b,End Sequence] = Right (ExtBasicConstraints b) + extDecode [Start Sequence,End Sequence] = Right (ExtBasicConstraints False) + extDecode _ = Left "unknown sequence" - decodeAuthorityKeyId [Start Sequence,Other Context 0 keyid,End Sequence] = Just $ ExtAuthorityKeyId keyid - decodeAuthorityKeyId _ = Nothing +data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag] + deriving (Show,Eq) - bitsToFlags bits = - let nb = bitArrayLength bits in - concat $ flip map [0..(nb-1)] $ \i -> do - let isSet = bitArrayGetBit bits i - if isSet then [toEnum $ fromIntegral i] else [] +instance Extension ExtKeyUsage where + extOID = const [2,5,29,15] + extEncode (ExtKeyUsage _) = undefined + extDecode [BitString bits] = Right $ ExtKeyUsage $ bitsToFlags bits + extDecode _ = Left "unknown sequence" + +data ExtSubjectKeyId = ExtSubjectKeyId L.ByteString + deriving (Show,Eq) + +instance Extension ExtSubjectKeyId where + extOID = const [2,5,29,14] + extEncode (ExtSubjectKeyId _) = undefined + extDecode [OctetString o] = Right $ ExtSubjectKeyId o + extDecode _ = Left "unknown sequence" + +data ExtSubjectAltName = ExtSubjectAltName [String] + deriving (Show,Eq) + +instance Extension ExtSubjectAltName where + extOID = const [2,5,29,17] + extEncode (ExtSubjectAltName _) = undefined + extDecode l = runParseASN1 parse l where + parse = do + c <- getNextContainer Sequence + return $ ExtSubjectAltName $ map toStringy c + toStringy (Other Context 2 b) = BC.unpack b + toStringy b = error ("not coping with anything else " ++ show b) + +data ExtAuthorityKeyId = ExtAuthorityKeyId B.ByteString + deriving (Show,Eq) + +instance Extension ExtAuthorityKeyId where + extOID _ = [2,5,29,35] + extEncode (ExtAuthorityKeyId _) = undefined + extDecode [Start Sequence,Other Context 0 keyid,End Sequence] = + Right $ ExtAuthorityKeyId keyid + extDecode _ = Left "unknown sequence" + +bitsToFlags :: Enum a => BitArray -> [a] +bitsToFlags bits = concat $ flip map [0..(bitArrayLength bits-1)] $ \i -> do + let isSet = bitArrayGetBit bits i + if isSet then [toEnum $ fromIntegral i] else [] diff --git a/certificate.cabal b/certificate.cabal --- a/certificate.cabal +++ b/certificate.cabal @@ -1,5 +1,5 @@ Name: certificate -Version: 1.0.1 +Version: 1.1.0 Description: Certificates and Key reader/writer .