diff --git a/Certificate.hs b/Certificate.hs --- a/Certificate.hs +++ b/Certificate.hs @@ -11,10 +11,10 @@ import Data.ASN1.DER readcert :: FilePath -> IO (Either String Certificate) -readcert file = B.readFile file >>= return . either Left (decodeCertificate . L.fromChunks . (:[])) . parsePEMCert +readcert file = B.readFile file >>= return . maybe (Left "no valid certificate found") (decodeCertificate . L.fromChunks . (:[])) . parsePEMCert readprivate :: FilePath -> IO (Either String PrivateKey) -readprivate file = B.readFile file >>= return . either Left (decodePrivateKey . L.fromChunks . (:[])) . parsePEMKey +readprivate file = B.readFile file >>= return . maybe (Left "no valid private RSA key found") (decodePrivateKey . L.fromChunks . (:[])) . parsePEMKeyRSA showCert :: Certificate -> String showCert cert = diff --git a/Data/Certificate/PEM.hs b/Data/Certificate/PEM.hs --- a/Data/Certificate/PEM.hs +++ b/Data/Certificate/PEM.hs @@ -9,35 +9,58 @@ -- -- Read PEM files -- -module Data.Certificate.PEM ( - parsePEM, - parsePEMCert, - parsePEMKey +module Data.Certificate.PEM + ( parsePEMCert + , parsePEMCertReq + , parsePEMKey + , parsePEMKeyRSA + , parsePEMKeyDSA + , parsePEMs ) where import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.ByteString.Base64 -import Data.Either +import Data.List -mapTill :: (a -> Bool) -> (a -> b) -> [a] -> [b] -mapTill _ _ [] = [] -mapTill endp f (x:xs) = if endp x then [] else f x : mapTill endp f xs +type PEM = (String, ByteString) -{- | parse a PEM content that is delimited by the begin string and the end string, - and returns the base64-decoded bytestring on success or a string on error. -} -parsePEM :: ByteString -> ByteString -> ByteString -> Either String ByteString -parsePEM begin end content = - concatErrOrContent $ mapTill ((==) end) (decode) $ tail $ dropWhile ((/=) begin) ls - where - ls = BC.split '\n' content - concatErrOrContent x = - let (l, r) = partitionEithers x in - if l == [] then Right $ B.concat r else Left $ head l +takeTillEnd :: [ByteString] -> ([ByteString], [ByteString]) +takeTillEnd ls = break (BC.isPrefixOf "-----END ") ls -parsePEMCert :: ByteString -> Either String ByteString -parsePEMCert = parsePEM "-----BEGIN CERTIFICATE-----" "-----END CERTIFICATE-----" +findSectionName :: ByteString -> String +findSectionName s = BC.unpack $ B.take (B.length x - 5) x + where x = B.drop 11 s -parsePEMKey :: ByteString -> Either String ByteString -parsePEMKey = parsePEM "-----BEGIN RSA PRIVATE KEY-----" "-----END RSA PRIVATE KEY-----" +parsePEMSections :: [ByteString] -> [PEM] +parsePEMSections [] = [] +parsePEMSections (x:xs) + | "-----BEGIN " `B.isPrefixOf` x = + let (content, rest) = takeTillEnd xs in + case decode $ B.concat content of + Left _ -> parsePEMSections rest + Right y -> (findSectionName x, y) : parsePEMSections rest + | otherwise = parsePEMSections xs + +parsePEMs :: ByteString -> [PEM] +parsePEMs content = parsePEMSections $ BC.lines content + +findPEM :: String -> [PEM] -> Maybe ByteString +findPEM name = maybe Nothing (Just . snd) . find ((==) name . fst) + +parsePEMCert :: ByteString -> Maybe ByteString +parsePEMCert = findPEM "CERTIFICATE" . parsePEMs + +parsePEMCertReq :: ByteString -> Maybe ByteString +parsePEMCertReq = findPEM "CERTIFICATE REQUEST" . parsePEMs + +parsePEMKeyRSA :: ByteString -> Maybe ByteString +parsePEMKeyRSA = findPEM "RSA PRIVATE KEY" . parsePEMs + +parsePEMKeyDSA :: ByteString -> Maybe ByteString +parsePEMKeyDSA = findPEM "DSA PRIVATE KEY" . parsePEMs + +{-# DEPRECATED parsePEMKey "use parsePEMKeyRSA now" #-} +parsePEMKey :: ByteString -> Maybe ByteString +parsePEMKey = parsePEMKeyRSA diff --git a/Data/Certificate/X509.hs b/Data/Certificate/X509.hs --- a/Data/Certificate/X509.hs +++ b/Data/Certificate/X509.hs @@ -73,9 +73,9 @@ deriving (Show, Eq) data PubKeyDesc = - PubKeyRSA (Int, Integer, Integer) -- ^ RSA format with (len modulus, modulus, e) - | PubKeyDSA (L.ByteString, Integer, Integer, Integer) -- ^ DSA format with (pub, p, q, g) - | PubKeyUnknown [Word8] -- ^ unrecognized format + PubKeyRSA (Int, Integer, Integer) -- ^ RSA format with (len modulus, modulus, e) + | PubKeyDSA (Integer, Integer, Integer, Integer) -- ^ DSA format with (pub, p, q, g) + | PubKeyUnknown [Word8] -- ^ unrecognized format deriving (Show,Eq) data PubKey = PubKey SignatureALG PubKeyDesc -- OID RSA|DSA|rawdata @@ -92,6 +92,26 @@ -- FIXME use a proper standard type for representing time. type Time = (Int, Int, Int, Int, Int, Int, Bool) +data CertKeyUsage = + CertKeyUsageDigitalSignature + | CertKeyUsageNonRepudiation + | CertKeyUsageKeyEncipherment + | CertKeyUsageDataEncipherment + | CertKeyUsageKeyAgreement + | CertKeyUsageKeyCertSign + | CertKeyUsageCRLSign + | CertKeyUsageEncipherOnly + | CertKeyUsageDecipherOnly + deriving (Show, Eq) + +data CertificateExts = CertificateExts + { certExtKeyUsage :: Maybe (Bool, [CertKeyUsage]) + , certExtBasicConstraints :: Maybe (Bool, Bool) + , certExtSubjectKeyIdentifier :: Maybe (Bool, [Word8]) + , certExtPolicies :: Maybe (Bool) + , certExtOthers :: [ (OID, Bool, ASN1) ] + } deriving (Show,Eq) + data Certificate = Certificate { certVersion :: Int -- ^ Certificate Version , certSerial :: Integer -- ^ Certificate Serial number @@ -100,7 +120,7 @@ , certSubjectDN :: CertificateDN -- ^ Certificate Subject DN , certValidity :: (Time, Time) -- ^ Certificate Validity period , certPubKey :: PubKey -- ^ Certificate Public key - , certExtensions :: Maybe [ASN1] -- ^ Certificate Extensions (format will change) + , certExtensions :: Maybe CertificateExts -- ^ Certificate Extensions , certSignature :: Maybe (SignatureALG, [Word8]) -- ^ Certificate Signature Algorithm and Signature , certOthers :: [ASN1] -- ^ any others fields not parsed } deriving (Show,Eq) @@ -188,29 +208,32 @@ n <- getNext case n of Sequence [ OID oid, Null ] -> return $ oidSig oid - _ -> throwError "algorithm ID bad format" + Sequence [ OID oid ] -> return $ oidSig oid + _ -> throwError ("algorithm ID bad format " ++ show n) -stringOfASN1PrintString :: ASN1 -> String -stringOfASN1PrintString (PrintableString x) = map (toEnum.fromEnum) $ L.unpack x -stringOfASN1PrintString (UTF8String x) = map (toEnum.fromEnum) $ L.unpack x -stringOfASN1PrintString x = error ("not a print string " ++ show x) +stringOfASN1String :: ASN1 -> String +stringOfASN1String (PrintableString x) = map (toEnum.fromEnum) $ L.unpack x +stringOfASN1String (UTF8String x) = map (toEnum.fromEnum) $ L.unpack x +stringOfASN1String (T61String x) = map (toEnum.fromEnum) $ L.unpack x +stringOfASN1String (UniversalString x) = map (toEnum.fromEnum) $ L.unpack x +stringOfASN1String (BMPString x) = map (toEnum.fromEnum) $ L.unpack x +stringOfASN1String x = error ("not a print string " ++ show x) parseCertHeaderDNHelper :: [ASN1] -> State CertificateDN () parseCertHeaderDNHelper l = do - forM_ l $ (\e -> do - case e of - Set [ Sequence [ OID [2,5,4,3], val ] ] -> - modify (\s -> s { cdnCommonName = Just $ stringOfASN1PrintString val }) - Set [ Sequence [ OID [2,5,4,6], val ] ] -> - modify (\s -> s { cdnCountry = Just $ stringOfASN1PrintString val }) - Set [ Sequence [ OID [2,5,4,10], val ] ] -> - modify (\s -> s { cdnOrganization = Just $ stringOfASN1PrintString val }) - Set [ Sequence [ OID [2,5,4,11], val ] ] -> - modify (\s -> s { cdnOrganizationUnit = Just $ stringOfASN1PrintString val }) - Set [ Sequence [ OID oid, val ] ] -> - modify (\s -> s { cdnOthers = (oid, show val) : cdnOthers s }) - _ -> - return () + forM_ l $ (\e -> case e of + Set [ Sequence [ OID [2,5,4,3], val ] ] -> + modify (\s -> s { cdnCommonName = Just $ stringOfASN1String val }) + Set [ Sequence [ OID [2,5,4,6], val ] ] -> + modify (\s -> s { cdnCountry = Just $ stringOfASN1String val }) + Set [ Sequence [ OID [2,5,4,10], val ] ] -> + modify (\s -> s { cdnOrganization = Just $ stringOfASN1String val }) + Set [ Sequence [ OID [2,5,4,11], val ] ] -> + modify (\s -> s { cdnOrganizationUnit = Just $ stringOfASN1String val }) + Set [ Sequence [ OID oid, val ] ] -> + modify (\s -> s { cdnOthers = (oid, show val) : cdnOthers s }) + _ -> + return () ) parseCertHeaderDN :: ParseCert CertificateDN @@ -218,15 +241,14 @@ n <- getNext case n of Sequence l -> do - let defdn = CertificateDN { - cdnCommonName = Nothing, - cdnCountry = Nothing, - cdnOrganization = Nothing, - cdnOrganizationUnit = Nothing, - cdnOthers = [] + let defdn = CertificateDN + { cdnCommonName = Nothing + , cdnCountry = Nothing + , cdnOrganization = Nothing + , cdnOrganizationUnit = Nothing + , cdnOthers = [] } - let dn = execState (parseCertHeaderDNHelper l) defdn - return dn + return $ execState (parseCertHeaderDNHelper l) defdn _ -> throwError "Distinguished name bad format" parseCertHeaderValidity :: ParseCert (Time, Time) @@ -249,21 +271,77 @@ SignatureALG_rsa -> parse_RSA bits _ -> PubKeyUnknown $ L.unpack bits return $ PubKey sig desc - Sequence [ Sequence [ OID pkalg, Sequence [ IntVal dsaP, IntVal dsaQ, IntVal dsaG ]], BitString _ dsapub ] -> + Sequence [ Sequence [ OID pkalg, Sequence [ IntVal dsaP, IntVal dsaQ, IntVal dsaG ]], BitString _ dsapubenc ] -> let sig = oidSig pkalg in - return $ PubKey sig (PubKeyDSA (dsapub, dsaP, dsaQ, dsaG)) + case decodeASN1 dsapubenc of + Right (IntVal dsapub) -> return $ PubKey sig (PubKeyDSA (dsapub, dsaP, dsaQ, dsaG)) + _ -> throwError "unrecognized DSA pub format" _ -> throwError ("subject public key bad format : " ++ show n) -parseCertExtensions :: ParseCert (Maybe [ASN1]) +-- RFC 5280 +parseCertExtensionHelper :: [ASN1] -> State CertificateExts () +parseCertExtensionHelper l = do + forM_ (mapMaybe extractStruct l) $ \e -> case e of + ([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) } + + return () + -} + ([2,5,29,19], critical, Right (Sequence [Boolean True])) -> + modify (\s -> s { certExtBasicConstraints = Just (critical, True) }) + {- + ([2,5,29,31], critical, obj) -> -- distributions points + return () + ([2,5,29,32], critical, obj) -> -- policies + return () + ([2,5,29,33], critical, obj) -> -- policies mapping + return () + ([2,5,29,35], critical, obj) -> -- authority key identifer + return () + -} + (oid, critical, Right obj) -> + modify (\s -> s { certExtOthers = (oid, critical, obj) : certExtOthers s }) + (_, True, Left _) -> fail "critical extension not understood" + (_, False, Left _) -> return () + where + extractStruct (Sequence [ OID oid, Boolean True, OctetString obj ]) = Just (oid, True, decodeASN1 obj) + extractStruct (Sequence [ OID oid, OctetString obj ]) = Just (oid, False, decodeASN1 obj) + extractStruct _ = Nothing + +parseCertExtensions :: ParseCert (Maybe CertificateExts) parseCertExtensions = do h <- hasNext if h then do n <- lookNext case n of - Other Context 3 (Right l) -> getNext >> return (Just l) - _ -> return Nothing + Other Context 3 (Right [Sequence l]) -> do + _ <- getNext + let def = CertificateExts + { certExtKeyUsage = Nothing + , certExtBasicConstraints = Nothing + , certExtSubjectKeyIdentifier = Nothing + , certExtPolicies = Nothing + , certExtOthers = [] + } + return $ Just $ execState (parseCertExtensionHelper l) def + Other Context 3 _ -> + throwError "certificate header bad format" + _ -> + return Nothing else return Nothing {- | parse header structure of a x509 certificate. it contains @@ -339,8 +417,10 @@ encodePK (PubKey sig (PubKeyRSA (_, modulus, e))) = Sequence [ Sequence [ OID $ sigOID sig, Null ], BitString 0 bits ] where bits = encodeASN1 $ Sequence [ IntVal modulus, IntVal e ] -encodePK (PubKey sig (PubKeyDSA (bits, p, q, g))) = Sequence [ Sequence [ OID $ sigOID sig, dsaseq ], BitString 0 bits ] - where dsaseq = Sequence [ IntVal p, IntVal q, IntVal g ] +encodePK (PubKey sig (PubKeyDSA (pub, p, q, g))) = Sequence [ Sequence [ OID $ sigOID sig, dsaseq ], BitString 0 bits ] + where + dsaseq = Sequence [ IntVal p, IntVal q, IntVal g ] + bits = encodeASN1 $ IntVal pub encodePK (PubKey sig (PubKeyUnknown l)) = Sequence [ Sequence [ OID $ sigOID sig, Null ], BitString 0 (L.pack l) ] @@ -348,7 +428,7 @@ encodeCertificateHeader cert = [ eVer, eSerial, eAlgId, eIssuer, eValidity, eSubject, epkinfo ] ++ others where - eVer = Other Application 0 (Right [ IntVal (fromIntegral $ certVersion cert) ]) + eVer = Other Context 0 (Right [ IntVal (fromIntegral $ certVersion cert) ]) eSerial = IntVal $ certSerial cert eAlgId = Sequence [ OID (sigOID $ certSignatureAlg cert), Null ] eIssuer = encodeDN $ certIssuerDN cert diff --git a/certificate.cabal b/certificate.cabal --- a/certificate.cabal +++ b/certificate.cabal @@ -1,5 +1,5 @@ Name: certificate -Version: 0.2.1 +Version: 0.3 Description: Certificates and Key reader/writer .