{-# 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.KeyRSA as KeyRSA
import Data.Certificate.KeyDSA as KeyDSA
import Data.Certificate.PEM
import System.Console.CmdArgs
import Control.Monad
import Control.Applicative ((<$>))
import Data.Maybe
import System.Exit
import Data.ASN1.DER (decodeASN1Stream, ASN1(..), ASN1ConstructionType(..))
import Numeric
hexdump :: L.ByteString -> String
hexdump bs = concatMap hex $ L.unpack bs
where hex n
| n > 0xa = showHex n ""
| otherwise = "0" ++ showHex n ""
showDN dn = mapM_ (\(oid, (_,t)) -> putStrLn (" " ++ show oid ++ ": " ++ T.unpack t)) dn
showExts e = putStrLn $ show e
showCert :: X509 -> IO ()
showCert (X509 cert _ sigalg sigbits) = 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 ("sigAlg: " ++ show sigalg)
putStrLn ("sig: " ++ show sigbits)
showRSAKey :: KeyRSA.Private -> String
showRSAKey key = unlines
[ "version: " ++ (show $ KeyRSA.version key)
, "len-modulus: " ++ (show $ KeyRSA.lenmodulus key)
, "modulus: " ++ (show $ KeyRSA.modulus key)
, "public exponant: " ++ (show $ KeyRSA.public_exponant key)
, "private exponant: " ++ (show $ KeyRSA.private_exponant key)
, "p1: " ++ (show $ KeyRSA.p1 key)
, "p2: " ++ (show $ KeyRSA.p2 key)
, "exp1: " ++ (show $ KeyRSA.exp1 key)
, "exp2: " ++ (show $ KeyRSA.exp2 key)
, "coefficient: " ++ (show $ KeyRSA.coef key)
]
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)
]
showASN1 :: [ASN1] -> IO ()
showASN1 = prettyPrint 0 where
indent n = putStr (replicate n ' ')
prettyPrint n [] = return ()
prettyPrint n (x@(Start _) : xs) = indent n >> p x >> putStrLn "" >> prettyPrint (n+1) xs
prettyPrint n (x@(End _) : xs) = indent (n-1) >> p x >> putStrLn "" >> prettyPrint (n-1) xs
prettyPrint n (x : xs) = indent n >> p x >> putStrLn "" >> prettyPrint n xs
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 (Start Sequence) = putStr "sequence"
p (End Sequence) = putStr "end-sequence"
p (Start Set) = putStr "set"
p (End Set) = putStr "end-set"
p (Start _) = putStr "container"
p (End _) = putStr "end-container"
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 (Other tc tn x) = putStr "other"
doMain :: CertMainOpts -> IO ()
doMain opts@(X509Opt _ _ _ _) = 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 decodeASN1Stream $ 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
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
case (rsadata, dsadata) of
(Just x, _) -> do
let rsaKey = KeyRSA.decodePrivate $ L.fromChunks [x]
case rsaKey of
Left err -> error err
Right k -> putStrLn $ showRSAKey k
(_, Just x) -> do
let rsaKey = KeyDSA.decodePrivate $ L.fromChunks [x]
case rsaKey of
Left err -> error err
Right k -> putStrLn $ showDSAKey k
_ -> do
putStrLn "no recognized private key found"
data CertMainOpts =
X509Opt
{ files :: [FilePath]
, asn1 :: Bool
, text :: Bool
, raw :: Bool
}
| Key
{ files :: [FilePath]
}
deriving (Show,Data,Typeable)
x509Opts = X509Opt
{ 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 = cmdArgsRun mode >>= doMain