From 36ab1882d2f0626749561e9618bd3ec0fdc9456d Mon Sep 17 00:00:00 2001 From: pho Date: Fri, 22 Jun 2007 16:37:23 +0900 Subject: [PATCH] OpenSSL.X509.Request darcs-hash:20070622073723-62b54-b6077532653d43f6bf83acaf9efc484b1f4fb0c3.gz --- .boring | 1 + HsOpenSSL.cabal | 1 + OpenSSL/PEM.hsc | 61 ++++++++++++++- OpenSSL/X509.hsc | 3 +- OpenSSL/X509/Request.hsc | 160 +++++++++++++++++++++++++++++++++++++++ cbits/HsOpenSSL.c | 8 ++ cbits/HsOpenSSL.h | 3 + examples/HelloWorld.hs | 26 +++---- 8 files changed, 244 insertions(+), 19 deletions(-) create mode 100644 OpenSSL/X509/Request.hsc diff --git a/.boring b/.boring index 867e509..295893f 100644 --- a/.boring +++ b/.boring @@ -75,6 +75,7 @@ _stub\.(c|h)$ ^OpenSSL/Stack\.hs$ ^OpenSSL/X509\.hs$ ^OpenSSL/X509/Name\.hs$ +^OpenSSL/X509/Request\.hs$ ^Setup$ ^aclocal\.m4$ ^configure$ diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal index 2302c2f..7e856e1 100644 --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -36,6 +36,7 @@ Exposed-Modules: OpenSSL.Utils OpenSSL.X509 OpenSSL.X509.Name + OpenSSL.X509.Request Extensions: ForeignFunctionInterface ghc-options: diff --git a/OpenSSL/PEM.hsc b/OpenSSL/PEM.hsc index 0c7b51e..8ed6b60 100644 --- a/OpenSSL/PEM.hsc +++ b/OpenSSL/PEM.hsc @@ -11,6 +11,9 @@ module OpenSSL.PEM , writeX509 , readX509 + + , writeX509Req + , readX509Req ) where @@ -25,6 +28,7 @@ import OpenSSL.EVP.Cipher import OpenSSL.EVP.PKey import OpenSSL.Utils import OpenSSL.X509 +import OpenSSL.X509.Request import Prelude hiding (catch) import System.IO @@ -244,4 +248,59 @@ readX509' bio readX509 :: String -> IO X509 readX509 pemStr - = newConstMem pemStr >>= readX509' \ No newline at end of file + = newConstMem pemStr >>= readX509' + + +{- PKCS#10 certificate request ----------------------------------------------- -} + +foreign import ccall safe "PEM_write_bio_X509_REQ" + _write_bio_X509_REQ :: Ptr BIO_ + -> Ptr X509_REQ + -> IO Int + +foreign import ccall safe "PEM_write_bio_X509_REQ_NEW" + _write_bio_X509_REQ_NEW :: Ptr BIO_ + -> Ptr X509_REQ + -> IO Int + +foreign import ccall safe "PEM_read_bio_X509_REQ" + _read_bio_X509_REQ :: Ptr BIO_ + -> Ptr (Ptr X509_REQ) + -> FunPtr PemPasswordCallback + -> Ptr () + -> IO (Ptr X509_REQ) + + +writeX509Req' :: BIO -> X509Req -> Bool -> IO () +writeX509Req' bio req new + = withForeignPtr bio $ \ bioPtr -> + withForeignPtr req $ \ reqPtr -> + writer bioPtr reqPtr + >>= failIf (/= 1) + >> return () + where + writer = if new then + _write_bio_X509_REQ_NEW + else + _write_bio_X509_REQ + + +writeX509Req :: X509Req -> Bool -> IO String +writeX509Req req new + = do mem <- newMem + writeX509Req' mem req new + bioRead mem + + +readX509Req' :: BIO -> IO X509Req +readX509Req' bio + = withForeignPtr bio $ \ bioPtr -> + withCString "" $ \ passPtr -> + _read_bio_X509_REQ bioPtr nullPtr nullFunPtr (unsafeCoercePtr passPtr) + >>= failIfNull + >>= wrapX509Req + + +readX509Req :: String -> IO X509Req +readX509Req pemStr + = newConstMem pemStr >>= readX509Req' diff --git a/OpenSSL/X509.hsc b/OpenSSL/X509.hsc index dd21b78..2aa899e 100644 --- a/OpenSSL/X509.hsc +++ b/OpenSSL/X509.hsc @@ -8,6 +8,7 @@ module OpenSSL.X509 , signX509 , verifyX509 + , printX509 , getVersion @@ -48,8 +49,6 @@ import OpenSSL.Stack import OpenSSL.X509.Name -{- X509 ---------------------------------------------------------------------- -} - type X509 = ForeignPtr X509_ data X509_ = X509_ diff --git a/OpenSSL/X509/Request.hsc b/OpenSSL/X509/Request.hsc new file mode 100644 index 0000000..afd6d39 --- /dev/null +++ b/OpenSSL/X509/Request.hsc @@ -0,0 +1,160 @@ +{- -*- haskell -*- -} +#include "HsOpenSSL.h" +module OpenSSL.X509.Request + ( X509Req + , X509_REQ + , newX509Req + , wrapX509Req -- private + + , signX509Req + , verifyX509Req + + , printX509Req + + , getVersion + , setVersion + + , getSubjectName + , setSubjectName + + , getPublicKey + , setPublicKey + ) + where + +import Control.Monad +import Foreign +import Foreign.C +import OpenSSL.BIO +import OpenSSL.EVP.Digest +import OpenSSL.EVP.PKey +import OpenSSL.Utils +import OpenSSL.X509.Name + + +type X509Req = ForeignPtr X509_REQ +data X509_REQ = X509_REQ + + +foreign import ccall unsafe "X509_REQ_new" + _new :: IO (Ptr X509_REQ) + +foreign import ccall unsafe "&X509_REQ_free" + _free :: FunPtr (Ptr X509_REQ -> IO ()) + +foreign import ccall unsafe "X509_REQ_sign" + _sign :: Ptr X509_REQ -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO Int + +foreign import ccall unsafe "X509_REQ_verify" + _verify :: Ptr X509_REQ -> Ptr EVP_PKEY -> IO Int + +foreign import ccall unsafe "X509_REQ_print" + _print :: Ptr BIO_ -> Ptr X509_REQ -> IO Int + +foreign import ccall unsafe "HsOpenSSL_X509_REQ_get_version" + _get_version :: Ptr X509_REQ -> IO CLong + +foreign import ccall unsafe "X509_REQ_set_version" + _set_version :: Ptr X509_REQ -> CLong -> IO Int + +foreign import ccall unsafe "HsOpenSSL_X509_REQ_get_subject_name" + _get_subject_name :: Ptr X509_REQ -> IO (Ptr X509_NAME) + +foreign import ccall unsafe "X509_REQ_set_subject_name" + _set_subject_name :: Ptr X509_REQ -> Ptr X509_NAME -> IO Int + +foreign import ccall unsafe "X509_REQ_get_pubkey" + _get_pubkey :: Ptr X509_REQ -> IO (Ptr EVP_PKEY) + +foreign import ccall unsafe "X509_REQ_set_pubkey" + _set_pubkey :: Ptr X509_REQ -> Ptr EVP_PKEY -> IO Int + + +newX509Req :: IO X509Req +newX509Req = _new >>= wrapX509Req + + +wrapX509Req :: Ptr X509_REQ -> IO X509Req +wrapX509Req = newForeignPtr _free + + +signX509Req :: X509Req -> EvpPKey -> Maybe EvpMD -> IO () +signX509Req req pkey mDigest + = withForeignPtr req $ \ reqPtr -> + withForeignPtr pkey $ \ pkeyPtr -> + do digest <- case mDigest of + Just md -> return md + Nothing -> pkeyDefaultMD pkey + _sign reqPtr pkeyPtr digest + >>= failIf (== 0) + return () + + +verifyX509Req :: X509Req -> EvpPKey -> IO Bool +verifyX509Req req pkey + = withForeignPtr req $ \ reqPtr -> + withForeignPtr pkey $ \ pkeyPtr -> + _verify reqPtr pkeyPtr + >>= interpret + where + interpret :: Int -> IO Bool + interpret 1 = return True + interpret 0 = return False + interpret _ = raiseOpenSSLError + + +printX509Req :: X509Req -> IO String +printX509Req req + = do mem <- newMem + withForeignPtr req $ \ reqPtr -> + withForeignPtr mem $ \ memPtr -> + _print memPtr reqPtr + >>= failIf (/= 1) + bioRead mem + + +getVersion :: X509Req -> IO Int +getVersion req + = withForeignPtr req $ \ reqPtr -> + liftM fromIntegral $ _get_version reqPtr + + +setVersion :: X509Req -> Int -> IO () +setVersion req ver + = withForeignPtr req $ \ reqPtr -> + _set_version reqPtr (fromIntegral ver) + >>= failIf (/= 1) + >> return () + + +getSubjectName :: X509Req -> Bool -> IO [(String, String)] +getSubjectName req wantLongName + = withForeignPtr req $ \ reqPtr -> + do namePtr <- _get_subject_name reqPtr + peekX509Name namePtr wantLongName + + +setSubjectName :: X509Req -> [(String, String)] -> IO () +setSubjectName req subject + = withForeignPtr req $ \ reqPtr -> + withX509Name subject $ \ namePtr -> + _set_subject_name reqPtr namePtr + >>= failIf (/= 1) + >> return () + + +getPublicKey :: X509Req -> IO EvpPKey +getPublicKey req + = withForeignPtr req $ \ reqPtr -> + _get_pubkey reqPtr + >>= failIfNull + >>= wrapPKey + + +setPublicKey :: X509Req -> EvpPKey -> IO () +setPublicKey req pkey + = withForeignPtr req $ \ reqPtr -> + withForeignPtr pkey $ \ pkeyPtr -> + _set_pubkey reqPtr pkeyPtr + >>= failIf (/= 1) + >> return () \ No newline at end of file diff --git a/cbits/HsOpenSSL.c b/cbits/HsOpenSSL.c index d074a49..535ce20 100644 --- a/cbits/HsOpenSSL.c +++ b/cbits/HsOpenSSL.c @@ -69,6 +69,14 @@ ASN1_TIME* HsOpenSSL_X509_get_notAfter(X509* x509) { return X509_get_notAfter(x509); } +long HsOpenSSL_X509_REQ_get_version(X509_REQ* req) { + return X509_REQ_get_version(req); +} + +X509_NAME* HsOpenSSL_X509_REQ_get_subject_name(X509_REQ* req) { + return X509_REQ_get_subject_name(req); +} + /* ASN1 ***********************************************************************/ ASN1_INTEGER* HsOpenSSL_M_ASN1_INTEGER_new() { return M_ASN1_INTEGER_new(); diff --git a/cbits/HsOpenSSL.h b/cbits/HsOpenSSL.h index 5749ebd..bb8ea77 100644 --- a/cbits/HsOpenSSL.h +++ b/cbits/HsOpenSSL.h @@ -30,6 +30,9 @@ long HsOpenSSL_X509_get_version(X509* x509); ASN1_TIME* HsOpenSSL_X509_get_notBefore(X509* x509); ASN1_TIME* HsOpenSSL_X509_get_notAfter(X509* x509); +long HsOpenSSL_X509_REQ_get_version(X509_REQ* req); +X509_NAME* HsOpenSSL_X509_REQ_get_subject_name(X509_REQ* req); + /* ASN1 ***********************************************************************/ ASN1_INTEGER* HsOpenSSL_M_ASN1_INTEGER_new(); void HsOpenSSL_M_ASN1_INTEGER_free(ASN1_INTEGER* intPtr); diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs index eccd1a1..5130377 100644 --- a/examples/HelloWorld.hs +++ b/examples/HelloWorld.hs @@ -16,28 +16,22 @@ import OpenSSL.EVP.Verify import OpenSSL.PEM import OpenSSL.RSA import OpenSSL.X509 +import OpenSSL.X509.Request as R import System.IO import Text.Printf main = withOpenSSL $ - do x509 <- newX509 - setVersion x509 2 - setSerialNumber x509 12345678 - setIssuerName x509 [("C", "JP")] - setSubjectName x509 [("ST", "foo")] - setNotBefore x509 =<< getCurrentTime - setNotAfter x509 =<< liftM (addUTCTime (365 * 24 * 60 * 60)) getCurrentTime - - cliPKey <- generateKey 512 65537 Nothing >>= newPKeyRSA - setPublicKey x509 cliPKey - - caPem <- readFile "../tmp/priv.pem" - caPKey <- readPrivateKey caPem PwNone - signX509 x509 caPKey Nothing + do req <- newX509Req + R.setVersion req 0 + R.setSubjectName req [("C", "JP")] + + pem <- readFile "../tmp/priv.pem" + pkey <- readPrivateKey pem PwNone + R.setPublicKey req pkey - setIssuerName x509 [] - verifyX509 x509 caPKey >>= print + signX509Req req pkey Nothing + verifyX509Req req pkey >>= print {- do x509 <- readX509 =<< readFile "../tmp/cert.pem" getVersion x509 >>= print