Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

OpenSSL.X509.Revocation

darcs-hash:20070623073933-62b54-b308fa33b04ed466ba693d850a42f1360d8eebc7.gz
  • Loading branch information...
commit 6423c00c53bc29706f4bd9d6e1e8e97c2da750b0 1 parent 36ab188
@phonohawk authored
View
1  .boring
@@ -76,6 +76,7 @@ _stub\.(c|h)$
^OpenSSL/X509\.hs$
^OpenSSL/X509/Name\.hs$
^OpenSSL/X509/Request\.hs$
+^OpenSSL/X509/Revocation\.hs$
^Setup$
^aclocal\.m4$
^configure$
View
1  HsOpenSSL.cabal
@@ -35,6 +35,7 @@ Exposed-Modules:
OpenSSL.Stack
OpenSSL.Utils
OpenSSL.X509
+ OpenSSL.X509.Revocation
OpenSSL.X509.Name
OpenSSL.X509.Request
Extensions:
View
74 OpenSSL.hsc
@@ -52,82 +52,10 @@
#include "HsOpenSSL.h"
module OpenSSL
- ( -- * Initialization
- withOpenSSL
-
- -- * Base64
- , encodeBase64
- , encodeBase64BS
- , encodeBase64LBS
- , decodeBase64
- , decodeBase64BS
- , decodeBase64LBS
-
- -- * Symmetric cipher
- , EvpCipher
- , CryptoMode(..)
- , getCipherByName
- , cipher
- , cipherBS
- , cipherLBS
-
- -- * Message digest
- , EvpMD
- , getDigestByName
- , digest
- , digestBS
- , digestLBS
-
- -- * Keypair
- , EvpPKey
-#ifndef OPENSSL_NO_RSA
- , newPKeyRSA
-#endif
-
- -- * Envelope decryption
- , open
- , openBS
- , openLBS
-
- -- * Envelope Encryption
- , seal
- , sealBS
- , sealLBS
-
- -- * Signing
- , sign
- , signBS
- , signLBS
-
- -- * Signature verification
- , verify
- , verifyBS
- , verifyLBS
-
- -- * PEM routines
- , PemPasswordRWState(..)
- , PemPasswordSupply(..)
- , writePKCS8PrivateKey
- , readPrivateKey
- , writePublicKey
- , readPublicKey
-
- -- * RSA public key cryptosystem
- , RSA
- , generateKey
+ ( withOpenSSL
)
where
-import OpenSSL.EVP.Base64
-import OpenSSL.EVP.Cipher
-import OpenSSL.EVP.Digest
-import OpenSSL.EVP.Open
-import OpenSSL.EVP.PKey
-import OpenSSL.EVP.Seal
-import OpenSSL.EVP.Sign
-import OpenSSL.EVP.Verify
-import OpenSSL.PEM
-import OpenSSL.RSA
import OpenSSL.SSL
View
3  OpenSSL/EVP/Verify.hsc
@@ -12,6 +12,7 @@ import Data.ByteString as B
import Data.ByteString.Base
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as L8
+import Data.Typeable
import Foreign
import Foreign.C
import OpenSSL.EVP.Digest
@@ -20,7 +21,7 @@ import OpenSSL.Utils
data VerifyStatus = VerifySuccess
| VerifyFailure
- deriving (Show, Eq)
+ deriving (Show, Eq, Typeable)
foreign import ccall unsafe "EVP_VerifyFinal"
View
55 OpenSSL/PEM.hsc
@@ -14,6 +14,9 @@ module OpenSSL.PEM
, writeX509Req
, readX509Req
+
+ , writeCRL
+ , readCRL
)
where
@@ -29,6 +32,7 @@ import OpenSSL.EVP.PKey
import OpenSSL.Utils
import OpenSSL.X509
import OpenSSL.X509.Request
+import OpenSSL.X509.Revocation
import Prelude hiding (catch)
import System.IO
@@ -208,7 +212,7 @@ readPublicKey pemStr
{- X.509 certificate --------------------------------------------------------- -}
-foreign import ccall safe "PEM_write_bio_X509_AUX"
+foreign import ccall unsafe "PEM_write_bio_X509_AUX"
_write_bio_X509_AUX :: Ptr BIO_
-> Ptr X509_
-> IO Int
@@ -253,12 +257,12 @@ readX509 pemStr
{- PKCS#10 certificate request ----------------------------------------------- -}
-foreign import ccall safe "PEM_write_bio_X509_REQ"
+foreign import ccall unsafe "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"
+foreign import ccall unsafe "PEM_write_bio_X509_REQ_NEW"
_write_bio_X509_REQ_NEW :: Ptr BIO_
-> Ptr X509_REQ
-> IO Int
@@ -304,3 +308,48 @@ readX509Req' bio
readX509Req :: String -> IO X509Req
readX509Req pemStr
= newConstMem pemStr >>= readX509Req'
+
+
+{- Certificate Revocation List ----------------------------------------------- -}
+
+foreign import ccall unsafe "PEM_write_bio_X509_CRL"
+ _write_bio_X509_CRL :: Ptr BIO_
+ -> Ptr X509_CRL
+ -> IO Int
+
+foreign import ccall safe "PEM_read_bio_X509_CRL"
+ _read_bio_X509_CRL :: Ptr BIO_
+ -> Ptr (Ptr X509_CRL)
+ -> FunPtr PemPasswordCallback
+ -> Ptr ()
+ -> IO (Ptr X509_CRL)
+
+
+writeCRL' :: BIO -> CRL -> IO ()
+writeCRL' bio crl
+ = withForeignPtr bio $ \ bioPtr ->
+ withForeignPtr crl $ \ crlPtr ->
+ _write_bio_X509_CRL bioPtr crlPtr
+ >>= failIf (/= 1)
+ >> return ()
+
+
+writeCRL :: CRL -> IO String
+writeCRL crl
+ = do mem <- newMem
+ writeCRL' mem crl
+ bioRead mem
+
+
+readCRL' :: BIO -> IO CRL
+readCRL' bio
+ = withForeignPtr bio $ \ bioPtr ->
+ withCString "" $ \ passPtr ->
+ _read_bio_X509_CRL bioPtr nullPtr nullFunPtr (unsafeCoercePtr passPtr)
+ >>= failIfNull
+ >>= wrapCRL
+
+
+readCRL :: String -> IO CRL
+readCRL pemStr
+ = newConstMem pemStr >>= readCRL'
View
4 OpenSSL/X509/Request.hsc
@@ -106,8 +106,8 @@ verifyX509Req req pkey
printX509Req :: X509Req -> IO String
printX509Req req
= do mem <- newMem
- withForeignPtr req $ \ reqPtr ->
- withForeignPtr mem $ \ memPtr ->
+ withForeignPtr mem $ \ memPtr ->
+ withForeignPtr req $ \ reqPtr ->
_print memPtr reqPtr
>>= failIf (/= 1)
bioRead mem
View
274 OpenSSL/X509/Revocation.hsc
@@ -0,0 +1,274 @@
+{- -*- haskell -*- -}
+#include "HsOpenSSL.h"
+module OpenSSL.X509.Revocation
+ ( CRL
+ , X509_CRL
+ , RevokedCertificate(..)
+ , newCRL
+ , wrapCRL -- private
+
+ , signCRL
+ , verifyCRL
+
+ , printCRL
+
+ , getVersion
+ , setVersion
+
+ , getLastUpdate
+ , setLastUpdate
+
+ , getNextUpdate
+ , setNextUpdate
+
+ , getIssuerName
+ , setIssuerName
+
+ , getRevokedList
+ , addRevoked
+ , sortCRL
+ )
+ where
+
+import Control.Monad
+import Data.Time.Clock
+import Data.Typeable
+import Foreign
+import Foreign.C
+import OpenSSL.BIO
+import OpenSSL.EVP.Digest
+import OpenSSL.EVP.PKey
+import OpenSSL.Stack
+import OpenSSL.Objects
+import OpenSSL.Utils
+import OpenSSL.X509.Name
+
+
+type CRL = ForeignPtr X509_CRL
+data X509_CRL = X509_CRL
+
+data X509_REVOKED = X509_REVOKED
+
+data RevokedCertificate
+ = RevokedCertificate {
+ revSerialNumber :: Integer
+ , revRevocationDate :: UTCTime
+ }
+ deriving (Show, Eq, Typeable)
+
+
+foreign import ccall unsafe "X509_CRL_new"
+ _new :: IO (Ptr X509_CRL)
+
+foreign import ccall unsafe "&X509_CRL_free"
+ _free :: FunPtr (Ptr X509_CRL -> IO ())
+
+foreign import ccall unsafe "X509_CRL_sign"
+ _sign :: Ptr X509_CRL -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO Int
+
+foreign import ccall unsafe "X509_CRL_verify"
+ _verify :: Ptr X509_CRL -> Ptr EVP_PKEY -> IO Int
+
+foreign import ccall unsafe "X509_CRL_print"
+ _print :: Ptr BIO_ -> Ptr X509_CRL -> IO Int
+
+foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_version"
+ _get_version :: Ptr X509_CRL -> IO CLong
+
+foreign import ccall unsafe "X509_CRL_set_version"
+ _set_version :: Ptr X509_CRL -> CLong -> IO Int
+
+foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_lastUpdate"
+ _get_lastUpdate :: Ptr X509_CRL -> IO (Ptr ASN1_TIME)
+
+foreign import ccall unsafe "X509_CRL_set_lastUpdate"
+ _set_lastUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO Int
+
+foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_nextUpdate"
+ _get_nextUpdate :: Ptr X509_CRL -> IO (Ptr ASN1_TIME)
+
+foreign import ccall unsafe "X509_CRL_set_nextUpdate"
+ _set_nextUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO Int
+
+foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_issuer"
+ _get_issuer_name :: Ptr X509_CRL -> IO (Ptr X509_NAME)
+
+foreign import ccall unsafe "X509_CRL_set_issuer_name"
+ _set_issuer_name :: Ptr X509_CRL -> Ptr X509_NAME -> IO Int
+
+foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_REVOKED"
+ _get_REVOKED :: Ptr X509_CRL -> IO (Ptr STACK)
+
+foreign import ccall unsafe "X509_CRL_add0_revoked"
+ _add0_revoked :: Ptr X509_CRL -> Ptr X509_REVOKED -> IO Int
+
+foreign import ccall unsafe "X509_CRL_sort"
+ _sort :: Ptr X509_CRL -> IO Int
+
+
+
+foreign import ccall unsafe "X509_REVOKED_new"
+ _new_revoked :: IO (Ptr X509_REVOKED)
+
+foreign import ccall unsafe "X509_REVOKED_free"
+ freeRevoked :: Ptr X509_REVOKED -> IO ()
+
+foreign import ccall unsafe "X509_REVOKED_set_serialNumber"
+ _set_serialNumber :: Ptr X509_REVOKED -> Ptr ASN1_INTEGER -> IO Int
+
+foreign import ccall unsafe "X509_REVOKED_set_revocationDate"
+ _set_revocationDate :: Ptr X509_REVOKED -> Ptr ASN1_TIME -> IO Int
+
+
+newCRL :: IO CRL
+newCRL = _new >>= wrapCRL
+
+
+wrapCRL :: Ptr X509_CRL -> IO CRL
+wrapCRL = newForeignPtr _free
+
+
+signCRL :: CRL -> EvpPKey -> Maybe EvpMD -> IO ()
+signCRL crl pkey mDigest
+ = withForeignPtr crl $ \ crlPtr ->
+ withForeignPtr pkey $ \ pkeyPtr ->
+ do digest <- case mDigest of
+ Just md -> return md
+ Nothing -> pkeyDefaultMD pkey
+ _sign crlPtr pkeyPtr digest
+ >>= failIf (== 0)
+ return ()
+
+
+verifyCRL :: CRL -> EvpPKey -> IO Bool
+verifyCRL crl pkey
+ = withForeignPtr crl $ \ crlPtr ->
+ withForeignPtr pkey $ \ pkeyPtr ->
+ _verify crlPtr pkeyPtr
+ >>= interpret
+ where
+ interpret :: Int -> IO Bool
+ interpret 1 = return True
+ interpret 0 = return False
+ interpret _ = raiseOpenSSLError
+
+
+printCRL :: CRL -> IO String
+printCRL crl
+ = do mem <- newMem
+ withForeignPtr mem $ \ memPtr ->
+ withForeignPtr crl $ \ crlPtr ->
+ _print memPtr crlPtr
+ >>= failIf (/= 1)
+ bioRead mem
+
+
+getVersion :: CRL -> IO Int
+getVersion crl
+ = withForeignPtr crl $ \ crlPtr ->
+ liftM fromIntegral $ _get_version crlPtr
+
+
+setVersion :: CRL -> Int -> IO ()
+setVersion crl ver
+ = withForeignPtr crl $ \ crlPtr ->
+ _set_version crlPtr (fromIntegral ver)
+ >>= failIf (/= 1)
+ >> return ()
+
+
+getLastUpdate :: CRL -> IO UTCTime
+getLastUpdate crl
+ = withForeignPtr crl $ \ crlPtr ->
+ _get_lastUpdate crlPtr
+ >>= peekASN1Time
+
+
+setLastUpdate :: CRL -> UTCTime -> IO ()
+setLastUpdate crl utc
+ = withForeignPtr crl $ \ crlPtr ->
+ withASN1Time utc $ \ time ->
+ _set_lastUpdate crlPtr time
+ >>= failIf (/= 1)
+ >> return ()
+
+
+getNextUpdate :: CRL -> IO UTCTime
+getNextUpdate crl
+ = withForeignPtr crl $ \ crlPtr ->
+ _get_nextUpdate crlPtr
+ >>= peekASN1Time
+
+
+setNextUpdate :: CRL -> UTCTime -> IO ()
+setNextUpdate crl utc
+ = withForeignPtr crl $ \ crlPtr ->
+ withASN1Time utc $ \ time ->
+ _set_nextUpdate crlPtr time
+ >>= failIf (/= 1)
+ >> return ()
+
+
+getIssuerName :: CRL -> Bool -> IO [(String, String)]
+getIssuerName crl wantLongName
+ = withForeignPtr crl $ \ crlPtr ->
+ do namePtr <- _get_issuer_name crlPtr
+ peekX509Name namePtr wantLongName
+
+
+setIssuerName :: CRL -> [(String, String)] -> IO ()
+setIssuerName crl issuer
+ = withForeignPtr crl $ \ crlPtr ->
+ withX509Name issuer $ \ namePtr ->
+ _set_issuer_name crlPtr namePtr
+ >>= failIf (/= 1)
+ >> return ()
+
+
+getRevokedList :: CRL -> IO [RevokedCertificate]
+getRevokedList crl
+ = withForeignPtr crl $ \ crlPtr ->
+ do stRevoked <- _get_REVOKED crlPtr
+ mapStack peekRevoked stRevoked
+ where
+ peekRevoked :: Ptr X509_REVOKED -> IO RevokedCertificate
+ peekRevoked rev
+ = do serial <- peekASN1Integer =<< (#peek X509_REVOKED, serialNumber ) rev
+ date <- peekASN1Time =<< (#peek X509_REVOKED, revocationDate) rev
+ return RevokedCertificate {
+ revSerialNumber = serial
+ , revRevocationDate = date
+ }
+
+newRevoked :: RevokedCertificate -> IO (Ptr X509_REVOKED)
+newRevoked revoked
+ = do revPtr <- _new_revoked
+
+ seriRet <- withASN1Integer (revSerialNumber revoked) $ \ serialPtr ->
+ _set_serialNumber revPtr serialPtr
+
+ dateRet <- withASN1Time (revRevocationDate revoked) $ \ datePtr ->
+ _set_revocationDate revPtr datePtr
+
+ if seriRet /= 1 || dateRet /= 1 then
+ freeRevoked revPtr >> raiseOpenSSLError
+ else
+ return revPtr
+
+
+addRevoked :: CRL -> RevokedCertificate -> IO ()
+addRevoked crl revoked
+ = withForeignPtr crl $ \ crlPtr ->
+ do revPtr <- newRevoked revoked
+ ret <- _add0_revoked crlPtr revPtr
+ case ret of
+ 1 -> return ()
+ _ -> freeRevoked revPtr >> raiseOpenSSLError
+
+
+sortCRL :: CRL -> IO ()
+sortCRL crl
+ = withForeignPtr crl $ \ crlPtr ->
+ _sort crlPtr
+ >>= failIf (/= 1)
+ >> return ()
View
20 cbits/HsOpenSSL.c
@@ -77,6 +77,26 @@ X509_NAME* HsOpenSSL_X509_REQ_get_subject_name(X509_REQ* req) {
return X509_REQ_get_subject_name(req);
}
+long HsOpenSSL_X509_CRL_get_version(X509_CRL* crl) {
+ return X509_CRL_get_version(crl);
+}
+
+ASN1_TIME* HsOpenSSL_X509_CRL_get_lastUpdate(X509_CRL* crl) {
+ return X509_CRL_get_lastUpdate(crl);
+}
+
+ASN1_TIME* HsOpenSSL_X509_CRL_get_nextUpdate(X509_CRL* crl) {
+ return X509_CRL_get_nextUpdate(crl);
+}
+
+X509_NAME* HsOpenSSL_X509_CRL_get_issuer(X509_CRL* crl) {
+ return X509_CRL_get_issuer(crl);
+}
+
+STACK_OF(X509_REVOKED)* HsOpenSSL_X509_CRL_get_REVOKED(X509_CRL* crl) {
+ return X509_CRL_get_REVOKED(crl);
+}
+
/* ASN1 ***********************************************************************/
ASN1_INTEGER* HsOpenSSL_M_ASN1_INTEGER_new() {
return M_ASN1_INTEGER_new();
View
6 cbits/HsOpenSSL.h
@@ -33,6 +33,12 @@ 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);
+long HsOpenSSL_X509_CRL_get_version(X509_CRL* crl);
+ASN1_TIME* HsOpenSSL_X509_CRL_get_lastUpdate(X509_CRL* crl);
+ASN1_TIME* HsOpenSSL_X509_CRL_get_nextUpdate(X509_CRL* crl);
+X509_NAME* HsOpenSSL_X509_CRL_get_issuer(X509_CRL* crl);
+STACK_OF(X509_REVOKED)* HsOpenSSL_X509_CRL_get_REVOKED(X509_CRL* crl);
+
/* ASN1 ***********************************************************************/
ASN1_INTEGER* HsOpenSSL_M_ASN1_INTEGER_new();
void HsOpenSSL_M_ASN1_INTEGER_free(ASN1_INTEGER* intPtr);
View
20 examples/HelloWorld.hs
@@ -17,21 +17,27 @@ import OpenSSL.PEM
import OpenSSL.RSA
import OpenSSL.X509
import OpenSSL.X509.Request as R
+import OpenSSL.X509.Revocation as C
import System.IO
import Text.Printf
main = withOpenSSL $
- do req <- newX509Req
- R.setVersion req 0
- R.setSubjectName req [("C", "JP")]
-
+ do crl <- newCRL
+ C.setVersion crl 0
+ C.setLastUpdate crl =<< getCurrentTime
+ C.setNextUpdate crl =<< getCurrentTime
+ C.setIssuerName crl [("C", "JP")]
+ C.addRevoked crl . RevokedCertificate 12 =<< getCurrentTime
+ C.addRevoked crl . RevokedCertificate 9999999999999 =<< getCurrentTime
+ C.addRevoked crl . RevokedCertificate 1000000 =<< getCurrentTime
+ C.sortCRL crl
+
pem <- readFile "../tmp/priv.pem"
pkey <- readPrivateKey pem PwNone
- R.setPublicKey req pkey
+ signCRL crl pkey Nothing
- signX509Req req pkey Nothing
- verifyX509Req req pkey >>= print
+ printCRL crl >>= putStr
{-
do x509 <- readX509 =<< readFile "../tmp/cert.pem"
getVersion x509 >>= print
Please sign in to comment.
Something went wrong with that request. Please try again.