diff --git a/Certificate.hs b/Certificate.hs new file mode 100644 --- /dev/null +++ b/Certificate.hs @@ -0,0 +1,67 @@ +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as B +import Data.Certificate.X509 +import Data.Certificate.Key +import Data.Certificate.PEM +import System +import Text.Hexdump +import Control.Monad +import Data.Maybe + +import Data.ASN1.DER + +readcert :: FilePath -> IO (Either String Certificate) +readcert file = B.readFile file >>= return . either Left (decodeCertificate . L.fromChunks . (:[])) . parsePEMCert + +readprivate :: FilePath -> IO (Either String PrivateKey) +readprivate file = B.readFile file >>= return . either Left (decodePrivateKey . L.fromChunks . (:[])) . parsePEMKey + +showCert :: Certificate -> String +showCert cert = + let ver = certVersion cert in + let ser = certSerial cert in + let sigalg = certSignatureAlg cert in + let idn = certIssuerDN cert in + let sdn = certSubjectDN cert in + let valid = certValidity cert in + let pk = certPubKey cert in + let exts = certExtensions cert in + let sig = certSignature cert in + let other = certOthers cert in + + unlines [ + "version: " ++ show ver, + "serial: " ++ show ser, + "sigalg: " ++ show sigalg, + "issuer: " ++ show idn, + "subject: " ++ show sdn, + "valid: " ++ show valid, + "pk: " ++ show pk, + "exts: " ++ show exts, + "sig: " ++ show sig, + "other: " ++ show other ] + +showKey :: PrivateKey -> String +showKey key = + unlines [ + "version: " ++ (show $ privKey_version key), + "len-modulus: " ++ (show $ privKey_lenmodulus key), + "modulus: " ++ (show $ privKey_modulus key), + "public exponant: " ++ (show $ privKey_public_exponant key), + "private exponant: " ++ (show $ privKey_private_exponant key), + "coefficient: " ++ (show $ privKey_coef key) + ] + +main = do + args <- getArgs + case args !! 0 of + "private" -> do + c <- readprivate (args !! 1) + case c of + Left err -> error err + Right cert -> putStrLn $ showKey cert + "cert" -> do + c <- readcert (args !! 1) + case c of + Left err -> error err + Right cert -> putStrLn $ showCert cert diff --git a/Data/Certificate/Key.hs b/Data/Certificate/Key.hs new file mode 100644 --- /dev/null +++ b/Data/Certificate/Key.hs @@ -0,0 +1,73 @@ +-- | +-- Module : Data.Certificate.Key +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- Read/Write Private Key +-- + +module Data.Certificate.Key ( + PrivateKey(..), + decodePrivateKey, + encodePrivateKey + ) where + +import Data.ASN1.DER hiding (decodeASN1) +import Data.ASN1.BER (decodeASN1) +import qualified Data.ByteString.Lazy as L + +data PrivateKey = PrivateKey + { privKey_version :: Int + , privKey_lenmodulus :: Int + , privKey_modulus :: Integer + , privKey_public_exponant :: Integer + , privKey_private_exponant :: Integer + , privKey_p1 :: Integer + , privKey_p2 :: Integer + , privKey_exp1 :: Integer + , privKey_exp2 :: Integer + , privKey_coef :: Int + } + +parsePrivateKey :: ASN1 -> Either String PrivateKey +parsePrivateKey x = + case x of + Sequence [ IntVal ver, IntVal modulus, IntVal pub_exp + , IntVal priv_exp, IntVal p1, IntVal p2 + , IntVal exp1, IntVal exp2, IntVal coef ] -> + Right $ PrivateKey + { privKey_version = fromIntegral ver + , privKey_lenmodulus = calculate_modulus modulus 1 + , privKey_modulus = modulus + , privKey_public_exponant = pub_exp + , privKey_private_exponant = priv_exp + , privKey_p1 = p1 + , privKey_p2 = p2 + , privKey_exp1 = exp1 + , privKey_exp2 = exp2 + , privKey_coef = fromIntegral coef } + _ -> + Left "unexpected format" + where + calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1) + +decodePrivateKey :: L.ByteString -> Either String PrivateKey +decodePrivateKey dat = either (Left . show) parsePrivateKey $ decodeASN1 dat + +encodePrivateKey :: PrivateKey -> L.ByteString +encodePrivateKey pk = encodeASN1 pkseq + where + pkseq = Sequence [ IntVal ver, IntVal modulus, IntVal pub_exp + , IntVal priv_exp, IntVal p1, IntVal p2 + , IntVal exp1, IntVal exp2, IntVal coef ] + ver = fromIntegral $ privKey_version pk + modulus = privKey_modulus pk + pub_exp = privKey_public_exponant pk + priv_exp = privKey_private_exponant pk + p1 = privKey_p1 pk + p2 = privKey_p2 pk + exp1 = privKey_exp1 pk + exp2 = privKey_exp2 pk + coef = fromIntegral $ privKey_coef pk diff --git a/Data/Certificate/PEM.hs b/Data/Certificate/PEM.hs new file mode 100644 --- /dev/null +++ b/Data/Certificate/PEM.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Data.Certificate.PEM +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- Read PEM files +-- +module Data.Certificate.PEM ( + parsePEM, + parsePEMCert, + parsePEMKey + ) 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 + +mapTill :: (a -> Bool) -> (a -> b) -> [a] -> [b] +mapTill _ _ [] = [] +mapTill endp f (x:xs) = if endp x then [] else f x : mapTill endp f xs + +{- | 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 + +parsePEMCert :: ByteString -> Either String ByteString +parsePEMCert = parsePEM "-----BEGIN CERTIFICATE-----" "-----END CERTIFICATE-----" + +parsePEMKey :: ByteString -> Either String ByteString +parsePEMKey = parsePEM "-----BEGIN RSA PRIVATE KEY-----" "-----END RSA PRIVATE KEY-----" diff --git a/Data/Certificate/X509.hs b/Data/Certificate/X509.hs new file mode 100644 --- /dev/null +++ b/Data/Certificate/X509.hs @@ -0,0 +1,370 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Data.Certificate.X509 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- Read/Write X509 certificate +-- + +module Data.Certificate.X509 ( + -- * Data Structure + PubKeyDesc(..), + PubKey(..), + CertificateDN(..), + Certificate(..), + + -- * serialization from ASN1 bytestring + decodeCertificate, + encodeCertificate + ) where + +import Data.Word +import Data.List (find) +import Data.ASN1.DER +import Data.Maybe +import qualified Data.ByteString.Lazy as L +import Control.Monad.State +import Control.Monad.Error + +{- +the structure of an X509 Certificate is the following: + +Certificate + 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) + ... +Certificate Signature Algorithm +Certificate Signature +-} + +{- +data CertError = + CertErrorMissing String + | CertErrorBadFormat String + | CertErrorMisc String + deriving (Show) +-} +type OID = [Integer] + +data SignatureALG = + SignatureALG_md5WithRSAEncryption + | SignatureALG_md2WithRSAEncryption + | SignatureALG_sha1WithRSAEncryption + | SignatureALG_rsa + | SignatureALG_dsa + | SignatureALG_dsaWithSHA1 + | SignatureALG_Unknown OID + deriving (Show, Eq) + +data PubKeyDesc = + PubKeyRSA (Int, Integer, Integer) -- len modulus, modulus, e + | PubKeyDSA (L.ByteString, Integer, Integer, Integer) -- pub, p, q, g + | PubKeyUnknown [Word8] + deriving (Show) + +data PubKey = PubKey SignatureALG PubKeyDesc -- OID RSA|DSA|rawdata + deriving (Show) + +data CertificateDN = CertificateDN { + cdnCommonName :: Maybe String, + cdnCountry :: Maybe String, + cdnOrganization :: Maybe String, + cdnOrganizationUnit :: Maybe String, + cdnOthers :: [ (OID, String) ] + } deriving (Show) + +-- FIXME use a proper standard type for representing time. +type Time = (Int, Int, Int, Int, Int, Int, Bool) + +data Certificate = Certificate { + certVersion :: Int, + certSerial :: Integer, + certSignatureAlg :: SignatureALG, + certIssuerDN :: CertificateDN, + certSubjectDN :: CertificateDN, + certValidity :: (Time, Time), + certPubKey :: PubKey, + certExtensions :: Maybe [ASN1], + certSignature :: Maybe (SignatureALG, [Word8]), + certOthers :: [ASN1] + } deriving (Show) + +{- | parse a RSA pubkeys from ASN1 encoded bits. + - return PubKeyRSA (len-modulus, modulus, e) if successful -} +parse_RSA :: L.ByteString -> PubKeyDesc +parse_RSA bits = + case decodeASN1 $ bits of + Right (Sequence [ IntVal modulus, IntVal pubexp ]) -> + PubKeyRSA (calculate_modulus modulus 1, modulus, pubexp) + _ -> + PubKeyUnknown $ L.unpack bits + where + calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1) + +newtype ParseCert a = P { runP :: ErrorT String (State [ASN1]) a } + deriving (Monad, MonadError String) + +runParseCert :: ParseCert a -> [ASN1] -> Either String a +runParseCert f s = + case runState (runErrorT (runP f)) s of + (Left err, _) -> Left err + (Right r, _) -> Right r + +getNext :: ParseCert ASN1 +getNext = do + list <- P (lift get) + case list of + [] -> throwError "empty" + (h:l) -> P (lift (put l)) >> return h + +getRemaining :: ParseCert [ASN1] +getRemaining = P (lift get) + +hasNext :: ParseCert Bool +hasNext = do + list <- P (lift get) + case list of + [] -> return False + _ -> return True + +lookNext :: ParseCert ASN1 +lookNext = do + list <- P (lift get) + case list of + [] -> throwError "empty" + (h:_) -> return h + +parseCertHeaderVersion :: ParseCert Int +parseCertHeaderVersion = do + n <- lookNext + v <- case n of + Other Application 0 (Right [ IntVal v ]) -> getNext >> return (fromIntegral v) + _ -> return 1 + return v + +parseCertHeaderSerial :: ParseCert 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,113549,1,1,1], SignatureALG_rsa) + , ([1,2,840,10040,4,1], SignatureALG_dsa) + , ([1,2,840,10040,4,3], SignatureALG_dsaWithSHA1) + ] + + +oidSig :: OID -> SignatureALG +oidSig oid = maybe (SignatureALG_Unknown oid) snd $ find ((==) oid . fst) sig_table + +sigOID :: SignatureALG -> OID +sigOID (SignatureALG_Unknown oid) = oid +sigOID sig = maybe [] fst $ find ((==) sig . snd) sig_table + +parseCertHeaderAlgorithmID :: ParseCert SignatureALG +parseCertHeaderAlgorithmID = do + n <- getNext + case n of + Sequence [ OID oid, Null ] -> return $ oidSig oid + _ -> throwError "algorithm ID bad format" + +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) + +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 () + ) + +parseCertHeaderDN :: ParseCert CertificateDN +parseCertHeaderDN = do + n <- getNext + case n of + Sequence l -> do + let defdn = CertificateDN { + cdnCommonName = Nothing, + cdnCountry = Nothing, + cdnOrganization = Nothing, + cdnOrganizationUnit = Nothing, + cdnOthers = [] + } + let dn = execState (parseCertHeaderDNHelper l) defdn + return dn + _ -> throwError "Distinguished name bad format" + +parseCertHeaderValidity :: ParseCert (Time, Time) +parseCertHeaderValidity = do + n <- getNext + case n of + Sequence [ UTCTime t1, UTCTime t2 ] -> return (t1, t2) + _ -> throwError "bad validity format" + +parseCertHeaderSubjectPK :: ParseCert PubKey +parseCertHeaderSubjectPK = do + n <- getNext + case n of + Sequence [ Sequence [ OID pkalg, Null], BitString _ bits ] -> do + let sig = oidSig pkalg + let desc = case sig of + SignatureALG_sha1WithRSAEncryption -> parse_RSA bits + SignatureALG_md5WithRSAEncryption -> parse_RSA bits + SignatureALG_md2WithRSAEncryption -> parse_RSA bits + 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 ] -> + let sig = oidSig pkalg in + return $ PubKey sig (PubKeyDSA (dsapub, dsaP, dsaQ, dsaG)) + _ -> + throwError ("subject public key bad format : " ++ show n) + +parseCertExtensions :: ParseCert (Maybe [ASN1]) +parseCertExtensions = do + h <- hasNext + if h + then do + n <- lookNext + case n of + Other Application 3 (Right l) -> getNext >> return (Just l) + _ -> return Nothing + else return Nothing + +{- | parse header structure of a x509 certificate. it contains + - the version, the serial number, the issuer DN, the validity period, + - the subject DN, and the public keys -} +parseCertificate :: ParseCert Certificate +parseCertificate = do + version <- parseCertHeaderVersion + serial <- parseCertHeaderSerial + sigalg <- parseCertHeaderAlgorithmID + issuer <- parseCertHeaderDN + validity <- parseCertHeaderValidity + subject <- parseCertHeaderDN + pk <- parseCertHeaderSubjectPK + exts <- parseCertExtensions + l <- getRemaining + + return $ Certificate { + certVersion = version, + certSerial = serial, + certSignatureAlg = sigalg, + certIssuerDN = issuer, + certSubjectDN = subject, + certValidity = validity, + certPubKey = pk, + certSignature = Nothing, + certExtensions = exts, + certOthers = l + } + +processCertificate :: ASN1 -> ASN1 -> ASN1 -> Either String Certificate +processCertificate header sigalg sig = do + let sigAlg = + case sigalg of + Sequence [ OID oid, Null ] -> oidSig oid + _ -> SignatureALG_Unknown [] + let sigbits = + case sig of + BitString _ bits -> bits + _ -> error "signature not in right format" + case header of + Sequence l -> + let cert = runParseCert parseCertificate l in + either Left (\c -> Right $ c { certSignature = Just (sigAlg, L.unpack sigbits) }) cert + _ -> Left "Certificate is not a sequence" + + +{- | parse root structure of a x509 certificate. this has to be a sequence of 3 objects : + - * the header + - * the signature algorithm + - * the signature -} +parseCertRoot :: ASN1 -> Either String Certificate +parseCertRoot (Sequence [ header, sigalg, sig ]) = processCertificate header sigalg sig +parseCertRoot x = Left ("certificate root element error: " ++ show x) + +decodeCertificate :: L.ByteString -> Either String Certificate +decodeCertificate by = either (Left . show) parseCertRoot $ decodeASN1 by + +encodeDN :: CertificateDN -> ASN1 +encodeDN dn = Sequence sets + where + sets = catMaybes [ + maybe Nothing (mapSet [2,5,4,3]) $ cdnCommonName dn, + maybe Nothing (mapSet [2,5,4,6]) $ cdnCountry dn, + maybe Nothing (mapSet [2,5,4,10]) $ cdnOrganization dn, + maybe Nothing (mapSet [2,5,4,11]) $ cdnOrganizationUnit dn + ] + mapSet oid str = Just $ Set [ + Sequence [ + OID oid, + PrintableString (L.pack $ map (toEnum . fromEnum) str) ] + ] + +encodePK :: PubKey -> ASN1 +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 (PubKeyUnknown l)) = Sequence [ Sequence [ OID $ sigOID sig, Null ], BitString 0 (L.pack l) ] + +encodeCertificateHeader :: Certificate -> [ASN1] +encodeCertificateHeader cert = + [ eVer, eSerial, eAlgId, eIssuer, eValidity, eSubject, epkinfo ] ++ others + where + eVer = Other Application 0 (Right [ IntVal (fromIntegral $ certVersion cert) ]) + eSerial = IntVal $ certSerial cert + eAlgId = Sequence [ OID (sigOID $ certSignatureAlg cert), Null ] + eIssuer = encodeDN $ certIssuerDN cert + (t1, t2) = certValidity cert + eValidity = Sequence [ UTCTime t1, UTCTime t2 ] + eSubject = encodeDN $ certSubjectDN cert + epkinfo = encodePK $ certPubKey cert + others = [] + +encodeCertificate :: Certificate -> L.ByteString +encodeCertificate cert = encodeASN1 rootSeq + where + (sigalg, sigbits) = fromJust $ certSignature cert + esigalg = Sequence [ OID (sigOID sigalg), Null ] + esig = BitString 0 $ L.pack sigbits + header = Sequence $ encodeCertificateHeader cert + rootSeq = Sequence [ header, esigalg, esig ] diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2010 Vincent Hanquez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/certificate.cabal b/certificate.cabal new file mode 100644 --- /dev/null +++ b/certificate.cabal @@ -0,0 +1,41 @@ +Name: certificate +Version: 0.1 +Description: Certificate and Key reader/writer +License: BSD3 +License-file: LICENSE +Copyright: Vincent Hanquez +Author: Vincent Hanquez +Maintainer: Vincent Hanquez +Synopsis: Certificate and Key Reader/Writer +Build-Type: Simple +Category: Data +stability: experimental +Cabal-Version: >=1.6 + +Flag executable + Description: Build the executable + Default: False + +Library + Build-Depends: base >= 3 && < 5, + binary >= 0.5, + bytestring, + mtl, + asn1-data, + base64-bytestring + Exposed-modules: Data.Certificate.X509, + Data.Certificate.PEM, + Data.Certificate.Key + ghc-options: -Wall + +Executable certificate + Main-Is: Certificate.hs + if flag(executable) + Buildable: True + Build-depends: RSA, hexdump, haskell98 + else + Buildable: False + +source-repository head + type: git + location: git://github.com/vincenthz/hs-certificate