diff --git a/Certificate.hs b/Certificate.hs --- a/Certificate.hs +++ b/Certificate.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC @@ -32,12 +32,12 @@ | n > 0xa = showHex n "" | otherwise = "0" ++ showHex n "" -showDN dn = mapM_ (\(oid, (_,t)) -> putStrLn (" " ++ show oid ++ ": " ++ T.unpack t)) dn +showDN dn = mapM_ (\(oid, (_,t)) -> putStrLn (" " ++ show oid ++ ": " ++ t)) dn showExts e = putStrLn $ show e showCert :: X509.X509 -> IO () -showCert (X509.X509 cert _ sigalg sigbits) = do +showCert (X509.X509 cert _ _ sigalg sigbits) = do putStrLn ("version: " ++ show (X509.certVersion cert)) putStrLn ("serial: " ++ show (X509.certSerial cert)) putStrLn ("sigalg: " ++ show (X509.certSignatureAlg cert)) @@ -94,7 +94,7 @@ 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 (UTF8String t) = putStr ("utf8string:" ++ t) p (Start Sequence) = putStr "sequence" p (End Sequence) = putStr "end-sequence" p (Start Set) = putStr "set" @@ -102,7 +102,7 @@ p (Start _) = putStr "container" p (End _) = putStr "end-container" p (NumericString bs) = putStr "numericstring:" - p (PrintableString t) = putStr ("printablestring: " ++ T.unpack t) + p (PrintableString t) = putStr ("printablestring: " ++ t) p (T61String bs) = putStr "t61string:" p (VideoTexString bs) = putStr "videotexstring:" p (IA5String bs) = putStr "ia5string:" @@ -111,9 +111,9 @@ p (GraphicString bs) = putStr "graphicstring:" p (VisibleString bs) = putStr "visiblestring:" p (GeneralString bs) = putStr "generalstring:" - p (UniversalString t) = putStr ("universalstring:" ++ T.unpack t) + p (UniversalString t) = putStr ("universalstring:" ++ t) p (CharacterString bs) = putStr "characterstring:" - p (BMPString t) = putStr ("bmpstring: " ++ T.unpack t) + p (BMPString t) = putStr ("bmpstring: " ++ t) p (Other tc tn x) = putStr "other" doMain :: CertMainOpts -> IO () @@ -133,11 +133,11 @@ when (verify opts) $ verifyCert x509 exitSuccess where - verifyCert x509@(X509.X509 cert _ sigalg sig) = do + verifyCert x509@(X509.X509 cert _ _ sigalg sig) = do sysx509 <- SysCert.findCertificate (matchsysX509 cert) case sysx509 of Nothing -> putStrLn "couldn't find signing certificate" - Just (X509.X509 syscert _ _ _) -> do + Just (X509.X509 syscert _ _ _ _) -> do verifyAlg (B.concat $ L.toChunks $ X509.getSigningData x509) (B.pack sig) sigalg @@ -145,14 +145,14 @@ rsaVerify h hdesc pk a b = either (Left . show) (Right) $ RSA.verify h hdesc pk a b - verifyF X509.SignatureALG_md2WithRSAEncryption (X509.PubKeyRSA rsakey) = - rsaVerify MD2.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey) + verifyF X509.SignatureALG_md2WithRSAEncryption (X509.PubKeyRSA rsak) = rsaVerify MD2.hash asn1 (mkRSA rsak) + where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x02\x10" - verifyF X509.SignatureALG_md5WithRSAEncryption (X509.PubKeyRSA rsakey) = - rsaVerify MD5.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey) + verifyF X509.SignatureALG_md5WithRSAEncryption (X509.PubKeyRSA rsak) = rsaVerify MD5.hash asn1 (mkRSA rsak) + where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" - verifyF X509.SignatureALG_sha1WithRSAEncryption (X509.PubKeyRSA rsakey) = - rsaVerify SHA1.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey) + verifyF X509.SignatureALG_sha1WithRSAEncryption (X509.PubKeyRSA rsak) = rsaVerify SHA1.hash asn1 (mkRSA rsak) + where asn1 = "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14" verifyF X509.SignatureALG_dsaWithSHA1 (X509.PubKeyDSA (pub,p,q,g)) = (\_ _ -> Left "unimplemented DSA checking") @@ -170,7 +170,7 @@ Right True -> putStrLn "certificate verified" Right False -> putStrLn "certificate not verified" - matchsysX509 cert (X509.X509 syscert _ _ _) = do + matchsysX509 cert (X509.X509 syscert _ _ _ _) = do let x = X509.certSubjectDN syscert let y = X509.certIssuerDN cert x == y diff --git a/Data/Certificate/X509.hs b/Data/Certificate/X509.hs --- a/Data/Certificate/X509.hs +++ b/Data/Certificate/X509.hs @@ -38,14 +38,14 @@ import Data.Certificate.X509Internal import Data.Certificate.X509Cert -data X509 = X509 Certificate (Maybe L.ByteString) SignatureALG [Word8] +data X509 = X509 Certificate (Maybe L.ByteString) (Maybe L.ByteString) SignatureALG [Word8] deriving (Show,Eq) {- | get signing data related to a X509 message, - which is either the cached data or the encoded certificate -} getSigningData :: X509 -> L.ByteString -getSigningData (X509 _ (Just e) _ _) = e -getSigningData (X509 cert Nothing _ _) = e +getSigningData (X509 _ (Just e) _ _ _) = e +getSigningData (X509 cert Nothing _ _ _) = e where (Right e) = encodeASN1Stream header header = asn1Container Sequence $ encodeCertificateHeader cert @@ -72,7 +72,7 @@ (Right c, [BitString _ b]) -> let certevs = toBytes $ concatMap snd certrepr in let sigalg = onContainer sigalgseq (parseSigAlg . map fst) in - Right $ X509 c (Just certevs) sigalg (L.unpack b) + Right $ X509 c (Just certevs) (Just by) sigalg (L.unpack b) (Left err, _) -> Left $ ("certificate error: " ++ show err) _ -> Left $ "certificate structure error" where @@ -89,7 +89,8 @@ {-| encode a X509 certificate to a bytestring -} encodeCertificate :: X509 -> L.ByteString -encodeCertificate (X509 cert _ sigalg sigbits) = case encodeASN1Stream rootSeq of +encodeCertificate (X509 _ _ (Just lbs) _ _ ) = lbs +encodeCertificate (X509 cert _ Nothing sigalg sigbits) = case encodeASN1Stream rootSeq of Right x -> x Left err -> error (show err) where diff --git a/Data/Certificate/X509Cert.hs b/Data/Certificate/X509Cert.hs --- a/Data/Certificate/X509Cert.hs +++ b/Data/Certificate/X509Cert.hs @@ -29,7 +29,6 @@ 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 @@ -79,7 +78,7 @@ deriving (Show, Eq) data ASN1StringType = UTF8 | Printable | Univ | BMP | IA5 | T61 deriving (Show,Eq) -type ASN1String = (ASN1StringType, Text) +type ASN1String = (ASN1StringType, String) data Certificate = Certificate { certVersion :: Int -- ^ Certificate Version diff --git a/System/Certificate/X509.hs b/System/Certificate/X509.hs --- a/System/Certificate/X509.hs +++ b/System/Certificate/X509.hs @@ -1,81 +1,19 @@ +{-# LANGUAGE CPP #-} -- | -- Module : System.Certificate.X509 -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental --- Portability : linux only --- --- this module is portable to unix system where there is usually --- a /etc/ssl/certs with system X509 certificates. --- --- the path can be dynamically override using the environment variable --- defined by envPathOverride in the module, which by --- default is SYSTEM_CERTIFICATE_PATH +-- Portability : good -- module System.Certificate.X509 - ( getSystemPath - , readAll - , findCertificate + ( findCertificate ) where -import System.Directory (getDirectoryContents) -import System.Environment (getEnv) -import Data.List (isPrefixOf) - -import Data.Either -import Data.Certificate.X509 -import Data.Certificate.PEM -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L - -import Control.Applicative ((<$>)) -import Control.Exception -import Control.Monad - -import Prelude hiding (catch) - -defaultSystemPath :: FilePath -defaultSystemPath = "/etc/ssl/certs/" - -envPathOverride :: String -envPathOverride = "SYSTEM_CERTIFICATE_PATH" - -getSystemPath :: IO FilePath -getSystemPath = catch (getEnv envPathOverride) inDefault - where - inDefault :: IOException -> IO FilePath - inDefault _ = return defaultSystemPath - -data ReadErr = - Exception IOException - | CertError String - deriving (Show,Eq) - -readCertificate :: FilePath -> IO (Either ReadErr X509) -readCertificate file = do - rawdata <- try $ B.readFile file :: IO (Either IOException B.ByteString) - either (return . Left . Exception) parseCert $ rawdata - where - parseCert pemdata = case parsePEMCert pemdata of - Nothing -> return $ Left $ CertError "certificate not in PEM format" - Just certdata -> do - return $ either (Left . CertError) Right $ decodeCertificate $ L.fromChunks [certdata] - -readAll :: IO [Either ReadErr X509] -readAll = do - path <- getSystemPath - certfiles <- filter (not . isPrefixOf ".") <$> getDirectoryContents path - forM certfiles $ \certfile -> readCertificate (path ++ certfile) - -findCertificate :: (X509 -> Bool) -> IO (Maybe X509) -findCertificate f = do - path <- getSystemPath - certfiles <- filter (not . isPrefixOf ".") <$> getDirectoryContents path - loop $ map (path ++) certfiles - where - loop [] = return Nothing - loop (x:xs) = do - ox509 <- readCertificate x - case ox509 of - Left _ -> loop xs - Right x509 -> if f x509 then return $ Just x509 else loop xs +#if defined(WINDOWS) +import System.Certificate.X509.Win32 +#elif defined(MACOSX) +import System.Certificate.X509.MacOS +#else +import System.Certificate.X509.Unix +#endif diff --git a/certificate.cabal b/certificate.cabal --- a/certificate.cabal +++ b/certificate.cabal @@ -1,5 +1,5 @@ Name: certificate -Version: 0.7.0 +Version: 0.8.0 Description: Certificates and Key reader/writer . @@ -28,9 +28,8 @@ Library Build-Depends: base >= 3 && < 5 , bytestring - , text >= 0.11 , mtl - , asn1-data >= 0.4.6 && < 0.5 + , asn1-data >= 0.5.0 && < 0.6 , base64-bytestring , directory Exposed-modules: Data.Certificate.X509, @@ -41,6 +40,11 @@ System.Certificate.X509 Other-modules: Data.Certificate.X509Internal ghc-options: -Wall + if os(windows) + cpp-options: -DWINDOWS + Build-Depends: Win32 + if os(OSX) + cpp-options: -DMACOSX Executable certificate Main-Is: Certificate.hs