certificate (empty) → 0.1
raw patch · 7 files changed
+623/−0 lines, 7 filesdep +RSAdep +asn1-datadep +basesetup-changed
Dependencies added: RSA, asn1-data, base, base64-bytestring, binary, bytestring, haskell98, hexdump, mtl
Files
- Certificate.hs +67/−0
- Data/Certificate/Key.hs +73/−0
- Data/Certificate/PEM.hs +43/−0
- Data/Certificate/X509.hs +370/−0
- LICENSE +27/−0
- Setup.hs +2/−0
- certificate.cabal +41/−0
+ Certificate.hs view
@@ -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
+ Data/Certificate/Key.hs view
@@ -0,0 +1,73 @@+-- |+-- Module : Data.Certificate.Key+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- 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
+ Data/Certificate/PEM.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Data.Certificate.PEM+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- 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-----"
+ Data/Certificate/X509.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module : Data.Certificate.X509+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- 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 ]
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2010 Vincent Hanquez <vincent@snarc.org>++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ certificate.cabal view
@@ -0,0 +1,41 @@+Name: certificate+Version: 0.1+Description: Certificate and Key reader/writer+License: BSD3+License-file: LICENSE+Copyright: Vincent Hanquez <vincent@snarc.org>+Author: Vincent Hanquez <vincent@snarc.org>+Maintainer: Vincent Hanquez <vincent@snarc.org>+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