diff --git a/Certificate.hs b/Certificate.hs --- a/Certificate.hs +++ b/Certificate.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} +import Data.Either import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString as B @@ -8,7 +9,8 @@ import qualified Data.Certificate.X509 as X509 import Data.Certificate.KeyRSA as KeyRSA import Data.Certificate.KeyDSA as KeyDSA -import Data.Certificate.PEM +import Data.List (find) +import Data.PEM (pemParseBS, pemContent, pemName) import System.Console.CmdArgs import Control.Monad import Control.Applicative ((<$>)) @@ -104,15 +106,15 @@ , "coefficient: " ++ (show $ RSA.private_qinv privkey) ] -showDSAKey :: KeyDSA.Private -> String -showDSAKey key = unlines - [ "version: " ++ (show $ KeyDSA.version key) - , "priv " ++ (show $ KeyDSA.priv key) - , "pub: " ++ (show $ KeyDSA.pub key) - , "p: " ++ (show $ KeyDSA.p key) - , "q: " ++ (show $ KeyDSA.q key) - , "g: " ++ (show $ KeyDSA.g key) +showDSAKey :: (DSA.PublicKey,DSA.PrivateKey) -> String +showDSAKey (pubkey,privkey) = unlines + [ "priv " ++ (show $ DSA.private_x privkey) + , "pub: " ++ (show $ DSA.public_y pubkey) + , "p: " ++ (show p) + , "q: " ++ (show g) + , "g: " ++ (show q) ] + where (p,g,q) = DSA.private_params privkey showASN1 :: Int -> [ASN1] -> IO () showASN1 at = prettyPrint at where @@ -153,22 +155,17 @@ p (BMPString t) = putStr ("bmpstring: " ++ t) p (Other tc tn x) = putStr "other" -doMain :: CertMainOpts -> IO () -doMain opts@(X509 _ _ _ _ _) = do - cert <- maybe (error "cannot read PEM certificate") (id) . parsePEMCert <$> B.readFile (head $ files opts) +parsePEMCert = either (const []) (rights . map getCert) . pemParseBS + where getCert pem = either Left (\x -> Right (pemContent pem,x)) $ X509.decodeCertificate $ L.fromChunks [pemContent pem] +processCert opts (cert, x509) = do when (raw opts) $ putStrLn $ hexdump $ L.fromChunks [cert] when (asn1 opts) $ case decodeASN1Stream $ L.fromChunks [cert] of Left err -> error ("decoding ASN1 failed: " ++ show err) Right asn1 -> showASN1 0 asn1 - let x509o = X509.decodeCertificate $ L.fromChunks [cert] - let x509 = case x509o of - Left err -> error ("decoding certificate failed: " ++ show err) - Right c -> c when (text opts || not (or [asn1 opts,raw opts])) $ showCert x509 when (verify opts) $ verifyCert x509 - exitSuccess where verifyCert x509@(X509.X509 cert _ _ sigalg sig) = do sysx509 <- SysCert.findCertificate (matchsysX509 cert) @@ -208,20 +205,22 @@ let x = X509.certSubjectDN syscert let y = X509.certIssuerDN cert x == y + +doMain :: CertMainOpts -> IO () +doMain opts@(X509 {}) = B.readFile (head $ files opts) >>= mapM_ (processCert opts) . parsePEMCert doMain (Key files) = do - content <- B.readFile $ head files - let pems = parsePEMs content - let rsadata = findPEM "RSA PRIVATE KEY" pems - let dsadata = findPEM "DSA PRIVATE KEY" pems + pems <- either error id . pemParseBS <$> B.readFile (head files) + let rsadata = find ((== "RSA PRIVATE KEY") . pemName) pems + let dsadata = find ((== "DSA PRIVATE KEY") . pemName) pems case (rsadata, dsadata) of (Just x, _) -> do - let rsaKey = KeyRSA.decodePrivate $ L.fromChunks [x] + let rsaKey = KeyRSA.decodePrivate $ L.fromChunks [pemContent x] case rsaKey of Left err -> error err Right k -> putStrLn $ showRSAKey k (_, Just x) -> do - let rsaKey = KeyDSA.decodePrivate $ L.fromChunks [x] + let rsaKey = KeyDSA.decodePrivate $ L.fromChunks [pemContent x] case rsaKey of Left err -> error err Right k -> putStrLn $ showDSAKey k diff --git a/Data/Certificate/KeyDSA.hs b/Data/Certificate/KeyDSA.hs --- a/Data/Certificate/KeyDSA.hs +++ b/Data/Certificate/KeyDSA.hs @@ -9,55 +9,46 @@ -- module Data.Certificate.KeyDSA - ( Private(..) - , decodePrivate - , encodePrivate - ) where + ( decodePrivate + , encodePrivate + ) where import Data.ASN1.DER (encodeASN1Stream, ASN1(..), ASN1ConstructionType(..)) import Data.ASN1.BER (decodeASN1Stream) import qualified Data.ByteString.Lazy as L - -data Private = Private - { version :: Int - , priv :: Integer - , pub :: Integer - , p :: Integer - , q :: Integer - , g :: Integer - } +import qualified Crypto.Types.PubKey.DSA as DSA -parsePrivate :: [ASN1] -> Either String Private +parsePrivate :: [ASN1] -> Either String (DSA.PublicKey, DSA.PrivateKey) parsePrivate - [ Start Sequence - , IntVal ver, IntVal p_pub, IntVal p_priv, IntVal p_p, IntVal p_g, IntVal p_q - , End Sequence ] = - Right $ Private - { version = fromIntegral ver - , priv = p_priv - , pub = p_pub - , p = p_p - , q = p_q - , g = p_g - } + [ Start Sequence + , IntVal 0, IntVal pub, IntVal priv, IntVal p, IntVal g, IntVal q + , End Sequence ] = Right (pubkey, privkey) + where + privkey = DSA.PrivateKey { DSA.private_params = params, DSA.private_x = priv } + pubkey = DSA.PublicKey { DSA.public_params = params, DSA.public_y = pub } + params = (p,g,q) +parsePrivate (Start Sequence : IntVal n : _) + | n == 0 = Left "DSA key format: not recognized" + | otherwise = Left ("DSA key format: unknown version " ++ show n) parsePrivate _ = Left "unexpected format" -decodePrivate :: L.ByteString -> Either String Private +decodePrivate :: L.ByteString -> Either String (DSA.PublicKey, DSA.PrivateKey) decodePrivate dat = either (Left . show) parsePrivate $ decodeASN1Stream dat -encodePrivate :: Private -> L.ByteString -encodePrivate pk = - case encodeASN1Stream pkseq of - Left err -> error $ show err - Right lbs -> lbs - where pkseq = - [ Start Sequence - , IntVal $ fromIntegral $ version pk - , IntVal $ pub pk - , IntVal $ priv pk - , IntVal $ p pk - , IntVal $ g pk - , IntVal $ q pk - , End Sequence - ] +encodePrivate :: (DSA.PublicKey, DSA.PrivateKey) -> L.ByteString +encodePrivate (pubkey, privkey) = + case encodeASN1Stream pkseq of + Left err -> error $ show err + Right lbs -> lbs + where pkseq = + [ Start Sequence + , IntVal 0 + , IntVal $ DSA.public_y pubkey + , IntVal $ DSA.private_x privkey + , IntVal p + , IntVal g + , IntVal q + , End Sequence + ] + (p,g,q) = DSA.private_params privkey diff --git a/Data/Certificate/PEM.hs b/Data/Certificate/PEM.hs deleted file mode 100644 --- a/Data/Certificate/PEM.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- | --- Module : Data.Certificate.PEM --- License : BSD-style --- Maintainer : Vincent Hanquez --- Stability : experimental --- Portability : unknown --- --- Read PEM files --- -module Data.Certificate.PEM - ( parsePEMCert - , parsePEMCertReq - , parsePEMKey - , parsePEMKeyRSA - , parsePEMKeyDSA - , parsePEMs - , findPEM - ) where - -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC -import Data.ByteString.Base64 -import Data.List - -type PEM = (String, ByteString) - -takeTillEnd :: [ByteString] -> ([ByteString], [ByteString]) -takeTillEnd ls = break (BC.isPrefixOf "-----END ") ls - -findSectionName :: ByteString -> String -findSectionName s = BC.unpack $ B.take (B.length x - 5) x - where x = B.drop 11 s - -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/System/Certificate/X509/MacOS.hs b/System/Certificate/X509/MacOS.hs --- a/System/Certificate/X509/MacOS.hs +++ b/System/Certificate/X509/MacOS.hs @@ -3,7 +3,6 @@ ) where import Data.Certificate.X509 -import Data.Certificate.PEM import System.Process import Data.ByteString hiding (filter, map) import qualified Data.ByteString.Lazy as LBS diff --git a/System/Certificate/X509/Unix.hs b/System/Certificate/X509/Unix.hs --- a/System/Certificate/X509/Unix.hs +++ b/System/Certificate/X509/Unix.hs @@ -13,18 +13,18 @@ -- default is SYSTEM_CERTIFICATE_PATH -- module System.Certificate.X509.Unix - ( getSystemPath - , readAll - , findCertificate - ) where + ( getSystemPath + , readAll + , findCertificate + ) where import System.Directory (getDirectoryContents) import System.Environment (getEnv) -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, find) +import Data.PEM (PEM(..), pemParseBS) import Data.Either import Data.Certificate.X509 -import Data.Certificate.PEM import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L @@ -40,42 +40,28 @@ envPathOverride :: String envPathOverride = "SYSTEM_CERTIFICATE_PATH" +listSystemCertificates :: IO [FilePath] +listSystemCertificates = do + path <- getSystemPath + map (path ++) . filter (not . isPrefixOf ".") <$> getDirectoryContents 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) + where + inDefault :: IOException -> IO FilePath + inDefault _ = return defaultSystemPath -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] +readCertificates :: FilePath -> IO [X509] +readCertificates file = either (const []) (rights . map getCert) . pemParseBS <$> B.readFile file + where getCert pem = decodeCertificate $ L.fromChunks [pemContent pem] -readAll :: IO [Either ReadErr X509] +readAll :: IO [X509] readAll = do - path <- getSystemPath - certfiles <- filter (not . isPrefixOf ".") <$> getDirectoryContents path - forM certfiles $ \certfile -> readCertificate (path ++ certfile) + certfiles <- listSystemCertificates + concat . rights <$> mapM (trySE . readCertificates) certfiles 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 +findCertificate f = find f <$> readAll + +trySE :: IO a -> IO (Either SomeException a) +trySE = try diff --git a/certificate.cabal b/certificate.cabal --- a/certificate.cabal +++ b/certificate.cabal @@ -1,5 +1,5 @@ Name: certificate -Version: 1.1.1 +Version: 1.2.0 Description: Certificates and Key reader/writer . @@ -29,15 +29,14 @@ Build-Depends: base >= 3 && < 5 , bytestring , mtl + , pem >= 0.1 && < 0.2 , asn1-data >= 0.6.1.3 && < 0.7 - , base64-bytestring , crypto-pubkey-types , directory , time Exposed-modules: Data.Certificate.X509 Data.Certificate.X509.Cert Data.Certificate.X509.Ext - Data.Certificate.PEM Data.Certificate.KeyDSA Data.Certificate.KeyRSA System.Certificate.X509