OpenSSL.X509.Request

darcs-hash:20070622073723-62b54-b6077532653d43f6bf83acaf9efc484b1f4fb0c3.gz

.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$

HsOpenSSL.cabal

@@ -36,6 +36,7 @@ Exposed-Modules:
         OpenSSL.Utils
         OpenSSL.X509
         OpenSSL.X509.Name
+        OpenSSL.X509.Request
 Extensions:
         ForeignFunctionInterface
 ghc-options:

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'
+    = 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'

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_
 

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 ()

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();

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);

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