diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2013-12-25 PHO + + * OpenSSL/Session.hsc (contextSetCertificateChainFile): Add + function to support for setting a certificate chain file, + Patch by Jacob Stanley. + + * HsOpenSSL.cabal (Extra-Source-Files): Add Server-example files, + Patch by Jacob Stanley. + + * HsOpenSSL.cabal (Version): Bump version to 0.10.4 + 2013-12-11 PHO * OpenSSL.hsc [base < 4.6] (modifyMVar_): Fix compilation, diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -12,7 +12,7 @@ , which is a pure Haskell implementation of SSL. . -Version: 0.10.3.6 +Version: 0.10.4 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen @@ -34,6 +34,9 @@ examples/GenRSAKey.hs examples/HelloWorld.hs examples/PKCS7.hs + examples/Server.hs + examples/server.crt + examples/server.pem tests/Base64.hs tests/Cipher.hs tests/DSA.hs diff --git a/OpenSSL/Session.hsc b/OpenSSL/Session.hsc --- a/OpenSSL/Session.hsc +++ b/OpenSSL/Session.hsc @@ -14,6 +14,7 @@ , contextSetCertificate , contextSetPrivateKeyFile , contextSetCertificateFile + , contextSetCertificateChainFile , contextSetCiphers , contextSetDefaultCiphers , contextCheckPrivateKey @@ -177,6 +178,19 @@ -- and, if that fails, as ASN1. If both fail, an exception is raised. contextSetCertificateFile :: SSLContext -> FilePath -> IO () contextSetCertificateFile = contextLoadFile _ssl_ctx_use_certificate_file + +foreign import ccall unsafe "SSL_CTX_use_certificate_chain_file" + _ssl_ctx_use_certificate_chain_file :: Ptr SSLContext_ -> CString -> IO CInt + +-- | Install a certificate chain in a context. The certificates must be in PEM +-- format and must be sorted starting with the subject's certificate (actual +-- client or server certificate), followed by intermediate CA certificates if +-- applicable, and ending at the highest level (root) CA. +contextSetCertificateChainFile :: SSLContext -> FilePath -> IO () +contextSetCertificateChainFile context path = + withContext context $ \ctx -> + withCString path $ \cpath -> + _ssl_ctx_use_certificate_chain_file ctx cpath >>= failIf_ (/= 1) foreign import ccall unsafe "SSL_CTX_set_cipher_list" _ssl_ctx_set_cipher_list :: Ptr SSLContext_ -> CString -> IO CInt diff --git a/examples/Server.hs b/examples/Server.hs new file mode 100644 --- /dev/null +++ b/examples/Server.hs @@ -0,0 +1,44 @@ +module Main where + +import Control.Concurrent (threadDelay) +import Control.Monad +import Network.Socket +import OpenSSL +import OpenSSL.EVP.PKey +import OpenSSL.PEM +import OpenSSL.RSA +import qualified OpenSSL.Session as SSL +import Text.Printf + +main = withOpenSSL (dumpPEM >> main') + +dumpPEM = do pem <- readFile "server.pem" + Just key <- liftM toKeyPair $ readPrivateKey pem PwNone + + let n = rsaN key + e = rsaE key + d = rsaD key + printf "n (public modulus) = %s\n" (show n) + printf "e (public exponent) = %s\n" (show e) + printf "d (private exponent) = %s\n" (show d) + +main' = do + sock <- socket AF_INET Stream 0 + bindSocket sock $ SockAddrInet (fromIntegral 4112) iNADDR_ANY + setSocketOption sock ReuseAddr 1 + putStrLn "\n*** Listening to 4112/tcp ***" + listen sock 1 + (sock', sockaddr) <- accept sock + print $ "Accepted connection from " ++ show sockaddr + + ctx <- SSL.context + SSL.contextSetPrivateKeyFile ctx "server.pem" + SSL.contextSetCertificateFile ctx "server.crt" + SSL.contextSetCiphers ctx "DEFAULT" + SSL.contextCheckPrivateKey ctx >>= print + conn <- SSL.connection ctx sock' + SSL.accept conn + b <- SSL.read conn 1024 + SSL.write conn b + SSL.shutdown conn SSL.Bidirectional + diff --git a/examples/server.crt b/examples/server.crt new file mode 100644 --- /dev/null +++ b/examples/server.crt @@ -0,0 +1,18 @@ +-----BEGIN CERTIFICATE----- +MIIC1TCCAj6gAwIBAgIJAK8d9L3ArBp+MA0GCSqGSIb3DQEBBQUAMFExCzAJBgNV +BAYTAlVTMRMwEQYDVQQIEwpDYWxpZm9ybmlhMRYwFAYDVQQHEw1TYW4gRnJhbmNp +c2NvMRUwEwYDVQQKEwxUZXN0aW5nIEx0ZC4wHhcNMDgwMjEzMTg1NzIwWhcNMTgw +MjEwMTg1NzIwWjBRMQswCQYDVQQGEwJVUzETMBEGA1UECBMKQ2FsaWZvcm5pYTEW +MBQGA1UEBxMNU2FuIEZyYW5jaXNjbzEVMBMGA1UEChMMVGVzdGluZyBMdGQuMIGf +MA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQCbeCZfNbMAGpFeE/ttioZhIWCP3xKU +OX+ZNsMa3m3+olXx7xBjJIiF7u2VT7EqAnrdk2L8YqfDT543ihEJ6STBcrR8JCYw +SE45QQNf02lRvXCG//s1H75cd/2fMeg6x8aQEgL8tFvNwTlsW9W61+qlLPanCz2s +kkIqevMWcn/VVQIDAQABo4G0MIGxMB0GA1UdDgQWBBTqhsnHVVEunLFm+GyrnQBE +uDCSUDCBgQYDVR0jBHoweIAU6obJx1VRLpyxZvhsq50ARLgwklChVaRTMFExCzAJ +BgNVBAYTAlVTMRMwEQYDVQQIEwpDYWxpZm9ybmlhMRYwFAYDVQQHEw1TYW4gRnJh +bmNpc2NvMRUwEwYDVQQKEwxUZXN0aW5nIEx0ZC6CCQCvHfS9wKwafjAMBgNVHRME +BTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAEwbwKDRq1tYoEfbzX7W7iqnBHYgg0gy +EbP4/7VCShUvZwdFWXe9om+W+3i83xeziBXFlNQfkXAKuoZRZSZ/6km9cbBNQYyx +cAZwPGwmEQwVteLpIVqeFID5q9WTlb+PoTGhxsa36NLwzoFoptHGP9ou0X5FibDT +X6eg/Y6Ie1bF +-----END CERTIFICATE----- diff --git a/examples/server.pem b/examples/server.pem new file mode 100644 --- /dev/null +++ b/examples/server.pem @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQCbeCZfNbMAGpFeE/ttioZhIWCP3xKUOX+ZNsMa3m3+olXx7xBj +JIiF7u2VT7EqAnrdk2L8YqfDT543ihEJ6STBcrR8JCYwSE45QQNf02lRvXCG//s1 +H75cd/2fMeg6x8aQEgL8tFvNwTlsW9W61+qlLPanCz2skkIqevMWcn/VVQIDAQAB +AoGARGdJ4sw6tMn7ubvq/Rhc5bGMzeBlSUg/JwdcMp85IDcGv4ri1+xEEUG90Nse +ZRBwRLtLayZxD9MhFuitdIHbBH7BMR9F/lOF/b9vItyUbH1TmPM+64Px5mwbnmXQ +RPWUQbfg3GKjyycHjnLujmrD6kzocuUTxlOsaKBZFk+Q0yUCQQDLIcutn+3alc0A +BFRlkPqZOPAIGEPs47dtc588MiV2fJOlzWub9wo6286wwtuDSmkw7PJDCdt9/jw1 +6bep6kxDAkEAw+6z+X4/AYUqzP79Hr9f43x0ZfwmM7z6zbS5xAYDyyOV6jqNzlJw +84QAI8oIijPJqa2SLe48RzpdyiYDlz0KhwJBAMGJNI77RlqxyTzP4z1V0X21AvUj +cWw9ViGBPODUgl8OuHoLaxCRYfzMOnStYwoHFowX5YY72RWE6gcP4/6PDhMCQQC+ +M4c697cqPp/iCNandpgbOcG1DyX2q8m8z2hWRpCALrdlfhoS5C0J+GY6V/IaV1O5 +B+oT9GVHr/1EM8rgkj0ZAkBhVzqfVz/iMyYnOk0rusWUoDzWvKh+mS6o5UlWa6Ko +jrwaPf6HhX1aP8d6W1jmfNXenuqH/uPBf8mJUCzrlsOX +-----END RSA PRIVATE KEY-----