diff --git a/Certificate.hs b/Certificate.hs --- a/Certificate.hs +++ b/Certificate.hs @@ -1,70 +1,145 @@ +{-# LANGUAGE DeriveDataTypeable #-} + import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString as B +import qualified Data.Text.Lazy as T +import Data.Text.Lazy.Encoding (decodeUtf8) import Data.Certificate.X509 import Data.Certificate.Key import Data.Certificate.PEM -import System +import System.Console.CmdArgs import Control.Monad +import Control.Applicative ((<$>)) import Data.Maybe +import System.Exit import Data.ASN1.DER - -readcert :: FilePath -> IO (Either String Certificate) -readcert file = B.readFile file >>= return . maybe (Left "no valid certificate found") (decodeCertificate . L.fromChunks . (:[])) . parsePEMCert +import Numeric readprivate :: FilePath -> IO (Either String PrivateKey) readprivate file = B.readFile file >>= return . maybe (Left "no valid private RSA key found") (decodePrivateKey . L.fromChunks . (:[])) . parsePEMKeyRSA -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 +hexdump :: L.ByteString -> String +hexdump bs = concatMap hex $ L.unpack bs + where hex n + | n > 0xa = showHex n "" + | otherwise = "0" ++ showHex n "" - 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 ] +showDN dn = mapM_ (\(oid, (_,t)) -> putStrLn (" " ++ show oid ++ ": " ++ T.unpack t)) dn +showExts e = putStrLn $ show e + +showCert :: Certificate -> IO () +showCert cert = do + putStrLn ("version: " ++ show (certVersion cert)) + putStrLn ("serial: " ++ show (certSerial cert)) + putStrLn ("sigalg: " ++ show (certSignatureAlg cert)) + putStrLn "issuer:" + showDN $ certIssuerDN cert + putStrLn "subject:" + showDN $ certSubjectDN cert + putStrLn ("valid: " ++ show (certValidity cert)) + putStrLn ("pk: " ++ show (certPubKey cert)) + putStrLn "exts:" + showExts $ certExtensions cert + putStrLn ("sig: " ++ show (certSignature cert)) + putStrLn ("other: " ++ show (certOthers cert)) + + 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), - "p1: " ++ (show $ privKey_p1 key), - "p2: " ++ (show $ privKey_p2 key), - "exp1: " ++ (show $ privKey_exp1 key), - "exp2: " ++ (show $ privKey_exp2 key), - "coefficient: " ++ (show $ privKey_coef key) - ] +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) + , "p1: " ++ (show $ privKey_p1 key) + , "p2: " ++ (show $ privKey_p2 key) + , "exp1: " ++ (show $ privKey_exp1 key) + , "exp2: " ++ (show $ privKey_exp2 key) + , "coefficient: " ++ (show $ privKey_coef key) + ] +showASN1 :: ASN1 -> IO () +showASN1 = prettyPrint 0 where + prettyPrint l a = indent l >> p l a >> putStrLn "" + indent l = putStr (replicate l ' ') + p _ (EOC) = putStr "" + p _ (Boolean b) = putStr ("bool: " ++ show b) + p _ (IntVal i) = putStr ("int: " ++ showHex i "") + p _ (BitString i bs) = putStr ("bitstring: " ++ hexdump bs) + p _ (OctetString bs) = putStr ("octetstring: " ++ hexdump bs) + p _ (Null) = putStr "null" + p _ (OID is) = putStr ("OID: " ++ show is) + p _ (Real d) = putStr "real" + p _ (Enumerated) = putStr "enum" + p _ (UTF8String t) = putStr ("utf8string:" ++ T.unpack t) + p l (Sequence o) = putStrLn "sequence" >> mapM_ (prettyPrint (l+1)) o >> indent l >> putStr "end-sequence" + p l (Set o) = putStrLn "set" >> mapM_ (prettyPrint (l+1)) o >> indent l >> putStr "end-set" + p _ (NumericString bs) = putStr "numericstring:" + p _ (PrintableString t) = putStr ("printablestring: " ++ T.unpack t) + p _ (T61String bs) = putStr "t61string:" + p _ (VideoTexString bs) = putStr "videotexstring:" + p _ (IA5String bs) = putStr "ia5string:" + p _ (UTCTime time) = putStr ("utctime: " ++ show time) + p _ (GeneralizedTime time) = putStr ("generalizedtime: " ++ show time) + p _ (GraphicString bs) = putStr "graphicstring:" + p _ (VisibleString bs) = putStr "visiblestring:" + p _ (GeneralString bs) = putStr "generalstring:" + p _ (UniversalString t) = putStr ("universalstring:" ++ T.unpack t) + p _ (CharacterString bs) = putStr "characterstring:" + p _ (BMPString t) = putStr ("bmpstring: " ++ T.unpack t) + p l (Other tc tn x) = putStr "other:" + +mainX509 :: CertMainOpts -> IO () +mainX509 opts = do + cert <- maybe (error "cannot read PEM certificate") (id) . parsePEMCert <$> B.readFile (head $ files opts) + + when (raw opts) $ putStrLn $ hexdump $ L.fromChunks [cert] + when (asn1 opts) $ case decodeASN1 $ L.fromChunks [cert] of + Left err -> error ("decoding ASN1 failed: " ++ show err) + Right asn1 -> showASN1 asn1 + when (text opts || not (or [asn1 opts,raw opts])) $ case decodeCertificate $ L.fromChunks [cert] of + Left err -> error ("decoding certificate failed: " ++ show err) + Right c -> showCert c + exitSuccess + +mainKey :: CertMainOpts -> IO () +mainKey opts = do + c <- readprivate $ head $ files opts + case c of + Left err -> error err + Right cert -> putStrLn $ showKey cert + +data CertMainOpts = + X509 + { files :: [FilePath] + , asn1 :: Bool + , text :: Bool + , raw :: Bool + } + | Key + { files :: [FilePath] + } + deriving (Show,Data,Typeable) + +x509Opts = X509 + { files = def &= args &= typFile + , asn1 = def + , text = def + , raw = def + } &= help "x509 certificate related commands" + +keyOpts = Key + { files = def &= args &= typFile + } &= help "keys related commands" + +mode = cmdArgsMode $ modes [x509Opts,keyOpts] + &= help "create, manipulate certificate (x509,etc) and keys" &= program "certificate" &= summary "certificate v0.1" + 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 + x <- cmdArgsRun mode + case x of + X509 _ _ _ _ -> mainX509 x + Key _ -> mainKey x diff --git a/Data/Certificate/X509.hs b/Data/Certificate/X509.hs --- a/Data/Certificate/X509.hs +++ b/Data/Certificate/X509.hs @@ -10,22 +10,34 @@ -- Read/Write X509 certificate -- -module Data.Certificate.X509 ( +module Data.Certificate.X509 + ( -- * Data Structure - PubKeyDesc(..), - PubKey(..), - CertificateDN(..), - Certificate(..), + SignatureALG(..) + , PubKeyALG(..) + , PubKeyDesc(..) + , PubKey(..) + , Certificate(..) + , ASN1StringType(..) + , ASN1String + -- * some common OIDs found in certificate Distinguish Names + , oidCommonName + , oidCountry + , oidOrganization + , oidOrganizationUnit + -- * serialization from ASN1 bytestring - decodeCertificate, - encodeCertificate + , decodeCertificate + , encodeCertificate ) where import Data.Word import Data.List (find) import Data.ASN1.DER import Data.Maybe +import Data.ByteString.Lazy (ByteString) +import Data.Text.Lazy (Text) import qualified Data.ByteString.Lazy as L import Control.Monad.State import Control.Monad.Error @@ -66,29 +78,28 @@ SignatureALG_md5WithRSAEncryption | SignatureALG_md2WithRSAEncryption | SignatureALG_sha1WithRSAEncryption - | SignatureALG_rsa - | SignatureALG_dsa | SignatureALG_dsaWithSHA1 + | SignatureALG_ecdsaWithSHA384 | SignatureALG_Unknown OID deriving (Show, Eq) +data PubKeyALG = + PubKeyALG_RSA + | PubKeyALG_DSA + | PubKeyALG_ECDSA + | PubKeyALG_Unknown OID + deriving (Show,Eq) + data PubKeyDesc = PubKeyRSA (Int, Integer, Integer) -- ^ RSA format with (len modulus, modulus, e) | PubKeyDSA (Integer, Integer, Integer, Integer) -- ^ DSA format with (pub, p, q, g) + | PubKeyECDSA ASN1 -- ^ ECDSA format not done yet FIXME | PubKeyUnknown [Word8] -- ^ unrecognized format deriving (Show,Eq) -data PubKey = PubKey SignatureALG PubKeyDesc -- OID RSA|DSA|rawdata +data PubKey = PubKey PubKeyALG PubKeyDesc -- OID RSA|DSA|rawdata deriving (Show,Eq) -data CertificateDN = CertificateDN - { cdnCommonName :: Maybe String -- ^ Certificate DN Common Name - , cdnCountry :: Maybe String -- ^ Certificate DN Country of Issuance - , cdnOrganization :: Maybe String -- ^ Certificate DN Organization - , cdnOrganizationUnit :: Maybe String -- ^ Certificate DN Organization Unit - , cdnOthers :: [ (OID, String) ] -- ^ Certificate DN Other Attributes - } deriving (Show,Eq) - -- FIXME use a proper standard type for representing time. type Time = (Int, Int, Int, Int, Int, Int, Bool) @@ -112,12 +123,21 @@ , certExtOthers :: [ (OID, Bool, ASN1) ] } deriving (Show,Eq) +data ASN1StringType = UTF8 | Printable | Univ | BMP | IA5 deriving (Show,Eq) +type ASN1String = (ASN1StringType, Text) + +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] + data Certificate = Certificate { certVersion :: Int -- ^ Certificate Version , certSerial :: Integer -- ^ Certificate Serial number , certSignatureAlg :: SignatureALG -- ^ Certificate Signature algorithm - , certIssuerDN :: CertificateDN -- ^ Certificate Issuer DN - , certSubjectDN :: CertificateDN -- ^ Certificate Subject DN + , 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 CertificateExts -- ^ Certificate Extensions @@ -127,7 +147,7 @@ {- | parse a RSA pubkeys from ASN1 encoded bits. - return PubKeyRSA (len-modulus, modulus, e) if successful -} -parse_RSA :: L.ByteString -> PubKeyDesc +parse_RSA :: ByteString -> PubKeyDesc parse_RSA bits = case decodeASN1 $ bits of Right (Sequence [ IntVal modulus, IntVal pubexp ]) -> @@ -137,6 +157,12 @@ where calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1) +parse_ECDSA :: ByteString -> PubKeyDesc +parse_ECDSA bits = + case decodeASN1 bits of + Right l -> PubKeyECDSA l + Left x -> PubKeyUnknown $ map (fromIntegral . fromEnum) $ show x + newtype ParseCert a = P { runP :: ErrorT String (State [ASN1]) a } deriving (Monad, MonadError String) @@ -190,19 +216,31 @@ [ ([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) + , ([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) + ] 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 + parseCertHeaderAlgorithmID :: ParseCert SignatureALG parseCertHeaderAlgorithmID = do n <- getNext @@ -211,45 +249,30 @@ Sequence [ OID oid ] -> return $ oidSig oid _ -> throwError ("algorithm ID bad format " ++ show n) -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) +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 x = error ("not a print string " ++ show x) -parseCertHeaderDNHelper :: [ASN1] -> State CertificateDN () -parseCertHeaderDNHelper l = do - 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 () - ) +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 -parseCertHeaderDN :: ParseCert CertificateDN +parseCertHeaderDN :: ParseCert [ (OID, ASN1String) ] parseCertHeaderDN = do n <- getNext case n of - Sequence l -> do - let defdn = CertificateDN - { cdnCommonName = Nothing - , cdnCountry = Nothing - , cdnOrganization = Nothing - , cdnOrganizationUnit = Nothing - , cdnOthers = [] - } - return $ execState (parseCertHeaderDNHelper l) defdn + Sequence l -> mapM parseDNOne l _ -> throwError "Distinguished name bad format" + where + parseDNOne (Set [ Sequence [OID oid, val]]) = return (oid, asn1String val) + parseDNOne _ = throwError "field in dn bad format" parseCertHeaderValidity :: ParseCert (Time, Time) parseCertHeaderValidity = do @@ -260,17 +283,22 @@ matchPubKey :: ASN1 -> ParseCert PubKey matchPubKey (Sequence[Sequence[OID pkalg,Null],BitString _ bits]) = do - let sig = oidSig pkalg + let sig = oidPubKey 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 + PubKeyALG_RSA -> parse_RSA bits _ -> PubKeyUnknown $ L.unpack bits return $ PubKey sig desc +matchPubKey (Sequence[Sequence[OID pkalg,OID pkgalg2],BitString _ bits]) = do + let sig = oidPubKey pkalg + let desc = case sig of + PubKeyALG_ECDSA -> parse_ECDSA bits + _ -> PubKeyUnknown $ L.unpack bits + return $ PubKey sig desc + + matchPubKey (Sequence[Sequence[OID pkalg,Sequence[IntVal p,IntVal q,IntVal g]], BitString _ pubenc ]) = do - let sig = oidSig pkalg + let sig = oidPubKey pkalg case decodeASN1 pubenc of Right (IntVal dsapub) -> return $ PubKey sig (PubKeyDSA (dsapub, p, q, g)) _ -> throwError "unrecognized DSA pub format" @@ -361,17 +389,17 @@ 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 + return $ Certificate + { certVersion = version + , certSerial = serial + , certSignatureAlg = sigalg + , certIssuerDN = issuer + , certSubjectDN = subject + , certValidity = validity + , certPubKey = pk + , certSignature = Nothing + , certExtensions = exts + , certOthers = l } {- | parse root structure of a x509 certificate. this has to be a sequence of 3 objects : @@ -400,31 +428,21 @@ decodeCertificate :: L.ByteString -> Either String Certificate decodeCertificate by = either (Left . show) processCertificate $ decodeASN1 by -encodeDN :: CertificateDN -> ASN1 -encodeDN dn = Sequence sets +encodeDN :: [ (OID, ASN1String) ] -> ASN1 +encodeDN dn = Sequence $ map dnSet dn 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) ] - ] + dnSet (oid, stringy) = Set [ Sequence [ OID oid, encodeAsn1String stringy ]] encodePK :: PubKey -> ASN1 -encodePK (PubKey sig (PubKeyRSA (_, modulus, e))) = Sequence [ Sequence [ OID $ sigOID sig, Null ], BitString 0 bits ] +encodePK (PubKey sig (PubKeyRSA (_, modulus, e))) = Sequence [ Sequence [ OID $ pubkeyalgOID sig, Null ], BitString 0 bits ] where bits = encodeASN1 $ Sequence [ IntVal modulus, IntVal e ] -encodePK (PubKey sig (PubKeyDSA (pub, p, q, g))) = Sequence [ Sequence [ OID $ sigOID sig, dsaseq ], BitString 0 bits ] +encodePK (PubKey sig (PubKeyDSA (pub, p, q, g))) = Sequence [ Sequence [ OID $ pubkeyalgOID 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) ] +encodePK (PubKey sig (PubKeyUnknown l)) = Sequence [ Sequence [ OID $ pubkeyalgOID sig, Null ], BitString 0 (L.pack l) ] encodeCertificateHeader :: Certificate -> [ASN1] encodeCertificateHeader cert = diff --git a/Tests.hs b/Tests.hs new file mode 100644 --- /dev/null +++ b/Tests.hs @@ -0,0 +1,4 @@ +import qualified Tests.Unit as Unit + +main = do + Unit.runTests diff --git a/certificate.cabal b/certificate.cabal --- a/certificate.cabal +++ b/certificate.cabal @@ -1,5 +1,5 @@ Name: certificate -Version: 0.3.2 +Version: 0.4.0 Description: Certificates and Key reader/writer . @@ -17,6 +17,10 @@ Homepage: http://github.com/vincenthz/hs-certificate Cabal-Version: >=1.6 +Flag test + Description: Build unit test + Default: False + Flag executable Description: Build the executable Default: False @@ -25,8 +29,9 @@ Build-Depends: base >= 3 && < 7, binary >= 0.5, bytestring, + text >= 0.11, mtl, - asn1-data >= 0.2, + asn1-data >= 0.3 && < 0.4, base64-bytestring Exposed-modules: Data.Certificate.X509, Data.Certificate.PEM, @@ -37,7 +42,15 @@ Main-Is: Certificate.hs if flag(executable) Buildable: True - Build-depends: haskell98 + Build-depends: cmdargs, text >= 0.11 + else + Buildable: False + +executable Tests + Main-is: Tests.hs + if flag(test) + Buildable: True + Build-Depends: base >= 3 && < 7, directory, HUnit, QuickCheck >= 2, bytestring else Buildable: False