diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,38 +1,258 @@ -2017-06-08 Vladimir Shabanov +2026-06-29 Vladimir Shabanov + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.11 + + * Fix OpenSSL 4.0 compatibility (#106) + by Ravi Kant Sharma @raviksharma + +2026-01-31 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.10 + + * Allow time-1.15; bump CI to GHC 9.14 + by Andreas Abel @andreasabel + + * Disable C warnings (#95) + by Erik de Castro Lopo @erikd + +2025-01-02 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.9 + + * Remove Setup.hs (#101) + by Andreas Abel @andreasabel + +2024-08-19 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.8 + + * Fix up incompatible pointer issues (#94) + by Eric Mertens @glguy + +2024-06-11 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.7 + + * Added generic functionality for adding extensions to X509 (#87) + by Ishan Sharma @ishan-rep + + * Clear error stack after x509_verify validation failure (#91) + by Paolo Capriotti @pcapriotti + + * Add withContextSetKeylogCallback: Allow any type inside action (#85) + by Akshay Mankar @akshaymankar + +2022-06-19 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.6 + + * More options in Options.hsc (#82) + by @BeowulfDragon + + * Add note to help users of Session.read and Session.tryRead (#81) + * Add withContextSetKeylogCallback (#79) + by Akshay Mankar @akshaymankar + + * Github Actions for Linux, MacOS and Windows (#72) + by John Ky @newhoggy + +2022-02-05 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.5 + + * Better suggestions when OpenSSL is not found (#75) + + * Add contextSetALPNProtos + by Akshay Mankar @akshaymankar (#76) + +2022-12-21 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.4 + + * Fixes more OpenSSL 3.0.x compilation issues (#74) + +2022-12-17 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.3 + + * Use capi instead of ccall for better compatibility + with OpenSSL 3.0 (#73, #63) + + * Update documentation for ssl cipher selection + by Adam Sandberg Eriksson @adamse (#66) + +2021-09-29 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.2 + + * Fixed OpenSSL 3.0 linking errors (#62) + +2021-07-28 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7.1 + + * Fix SSL_CTX_set_session_id_context #61 + by @flobrosch (#61) + +2021-04-19 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.7 + + * Added Session.contextSetDefaultVerifyPaths + by Alexander Biehl @alexbiehl (#59) + + * Fix for LibreSSL (#58) + +2021-04-05 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.6.1 + + * Windows: Use libcrypto instead of eay; allow pkg-config. + by @slycelote (#57) + +2021-03-19 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.6 + + * Added Session.contextSetSessionIdContext + by Francesco Gazzetta @fgaz (#56) + +2020-11-06 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.5.1 + + * Fix for older GHC versions. + +2020-11-02 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.5 + (actually it is previous version that should be 0.11.5 + since it added new API but it was already released + so we bumping version here). + + * Handling SSL_ERROR_SYSCALL with errno=0 which means unexpected EOF. + +2020-10-08 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.20 + + * Hostname validation + by @amesgen (#52) + + * Do not compile OpenSSL modules twice for tests + +2020-09-01 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.19 + + * HsOpenSSL.cabal: Discover OpenSSL via pkg-config + by Alexander Biehl @alexbiehl (#51) + +2020-03-31 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.18 + + * LibreSSL compatibility + by Julian Ospald @hasufell (#45, #47) + +2019-09-13 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.17 + + * Allow old time, allows building with bundled time back to GHC-7.4 + by Oleg Grenrus @phadej (#46) + +2019-01-21 Vladimir Shabanov + + * HsOpenSSL.cabal: + Added upper version bounds to all dependencies (#41) + +2019-01-21 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.16 + + * Compatibility for network-3.0.0 + by Roman Borschel @romanb (#40) + + * .travis.yml: Fixed build. Updated to last 3 GHC versions. + +2018-09-08 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.15 + + * Link libopenssl before libcrypto + by Shea Levy @shlevy (#38) + +2018-05-31 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.14 + + * HsOpenSSL.cabal: Removed upper bounds from all dependencies except + base where it is required. + +2018-03-09 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.13 + + * HsOpenSSL.cabal: Removed Cabal upper bound, + fixed Cabal-Version format. + +2018-01-24 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.12 + + * Fix the build with GHC 8.4 + by Ryan Scott @RyanGlScott (#35) + +2017-08-14 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.11 + + * cbits/HsOpenSSL.h: Hack OpenSSL version number when using LibreSSL + by Javier López @TheLinuxKitten (#31) + +2017-07-25 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.10 + + * Declare dependency on `hsc2hs` + by Herbert Valerio Riedel @hvr (#28). + +2017-06-08 Vladimir Shabanov + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.9 * Added -DNOCRYPT to compile in newer MINGW versions by Baojun Wang @wangbj (#27) -2017-04-26 Vladimir Shabanov +2017-04-26 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.8 * Setup.hs: Updated for Cabal-2.0 by Eric Mertens @glguy (#24) -2017-04-17 Vladimir Shabanov +2017-04-17 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.7 * Support for MinGW64, by @varosi (#23) -2017-04-05 Vladimir Shabanov +2017-04-05 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.6 * Setup.hs: builds with ghc 8.2, by Erik de Castro Lopo @erikd (#22) -2017-04-04 Vladimir Shabanov +2017-04-04 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.5 * cbits/HsOpenSSL.c: fixed HMAC_CTX_free invocation (#21) -2017-03-24 Vladimir Shabanov +2017-03-24 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.4 @@ -40,47 +260,47 @@ * Tests/OpenSSL/EVP/Digest.hs: added tests for hmacBS and hmacLBS. -2017-03-22 Vladimir Shabanov +2017-03-22 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.3 * OpenSSL/EVP/Digest.hsc (hmacLBS): added HMAC on lazy bytestrings, by SX91 (#18). -2017-03-11 Vladimir Shabanov +2017-03-11 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.2 * Ported BN to integer-gmp-1.0.x, by SX91 (#17). -2017-02-27 Vladimir Shabanov +2017-02-27 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.1 * Updated for OpenSSL 1.1.0 (#16) -2017-01-24 Vladimir Shabanov +2017-01-24 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4 * Updated for OpenSSL 1.1.0 (#15) -2016-10-17 Vladimir Shabanov +2016-10-17 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.3.2 * Test/*, HsOpenSSL.cabal (Build-Depends): Removed HUnit, test-framework and test-framework-hunit dependencies. -2016-10-15 Vladimir Shabanov +2016-10-15 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.3.1 * OpenSSL/Session.hsc: Detect failure of SSL_CTX_new, by Eric Mertens @glguy (#13) -2016-10-14 Vladimir Shabanov +2016-10-14 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.3 @@ -90,14 +310,14 @@ module. Added encoding/decoding of private keys in ASN.1 DER. by @shak-mar (#12). -2016-10-08 Vladimir Shabanov +2016-10-08 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.2.4 * Setup.hs: Fixed handling of 'cabal configure' errors in Homebrew/MacPorts OpenSSL autodetection. -2016-10-06 Vladimir Shabanov +2016-10-06 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.2.3 @@ -113,14 +333,14 @@ * OpenSSL/Session.hsc: Exposed OpenSSL.Session internal types, by Eric Mertens @glguy (#10). -2016-10-05 Vladimir Shabanov +2016-10-05 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.2.2 * HsOpenSSL.cabal: Added Include-Dirs and Extra-Lib-Dirs for building with Homebrew/MacPorts OpenSSL on Mac OS X 10.11+ (phonohawk#41) -2016-10-04 Vladimir Shabanov +2016-10-04 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.2.1 @@ -131,7 +351,7 @@ * .travis.yml: Added Travis Job, by Herbert Valerio Riedel @hvr (#8). -2016-10-04 Vladimir Shabanov +2016-10-04 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.2 diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -1,7 +1,7 @@ +Cabal-Version: 1.18 Name: HsOpenSSL Synopsis: Partial OpenSSL binding for Haskell Description: - . HsOpenSSL is an OpenSSL binding for Haskell. It can generate RSA and DSA keys, read and write PEM files, generate message digests, sign and verify messages, encrypt and decrypt messages. It has @@ -11,24 +11,36 @@ systems and stable. You may also be interested in the @tls@ package, , which is a pure Haskell implementation of SSL. - . -Version: 0.11.4.9 +Version: 0.11.7.11 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen -Maintainer: Vladimir Shabanov +Maintainer: Vladimir Shabanov Stability: stable -Homepage: https://github.com/vshabanov/HsOpenSSL -Bug-Reports: https://github.com/vshabanov/HsOpenSSL/issues +Homepage: https://github.com/haskell-cryptography/HsOpenSSL +Bug-Reports: https://github.com/haskell-cryptography/HsOpenSSL/issues Category: Cryptography -Cabal-Version: >= 1.12 Tested-With: - GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2 -Build-Type: Custom -Extra-Source-Files: + GHC ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.4 + || ==8.10.7 + || ==9.0.2 + || ==9.2.8 + || ==9.4.8 + || ==9.6.6 + || ==9.8.4 + || ==9.10.3 + || ==9.12.2 + || ==9.14.1 +Build-Type: Simple +Extra-Doc-Files: AUTHORS ChangeLog README.md +Extra-Source-Files: cbits/HsOpenSSL.h cbits/mutex.h examples/Makefile @@ -41,13 +53,13 @@ Source-Repository head Type: git - Location: git://github.com/vshabanov/HsOpenSSL.git + Location: https://github.com/haskell-cryptography/HsOpenSSL.git Flag fast-bignum Description: - Enable fast moving of bignums between OpenSSL and GMP (GHC only). + Enable fast moving of bignums between OpenSSL and GMP (GHC and OpenSSL version < 1.1.0 only). Default: - True + False Flag homebrew-openssl Description: @@ -61,17 +73,23 @@ Default: False -Custom-setup - setup-depends: Cabal >=1.12 && <2.1, - base >=4.4 && <5 +Flag use-pkg-config + Description: + Use pkg-config to find OpenSSL (macOS and linux only). + Default: + False + Manual: + True Library Build-Depends: - base >= 4.4 && < 5, - bytestring >= 0.9 && < 0.11, - network >= 2.1 && < 2.7, - time >= 1.5 && < 1.9 + base >= 4.8 && < 5, + bytestring >= 0.9 && < 0.13, + network >= 2.1 && < 3.3, + time >= 1.5 && < 1.17 + Build-Tools: hsc2hs >= 0.67 + if flag(fast-bignum) && impl(ghc >= 7.10.1) -- only new integer-gmp 1.0.0 is supported -- and it only works in OpenSSL version < 1.1.0 where BIGNUM @@ -80,25 +98,27 @@ Build-Depends: integer-gmp >= 1.0.0 && < 1.1.0 if os(darwin) && flag(homebrew-openssl) - Include-Dirs: /usr/local/opt/openssl/include - Extra-Lib-Dirs: /usr/local/opt/openssl/lib + if arch(aarch64) + Include-Dirs: /opt/homebrew/opt/openssl/include + Extra-Lib-Dirs: /opt/homebrew/opt/openssl/lib + else + Include-Dirs: /usr/local/opt/openssl/include + Extra-Lib-Dirs: /usr/local/opt/openssl/lib if os(darwin) && flag(macports-openssl) - Include-Dirs: /opt/local/include + Include-Dirs: /opt/local/include Extra-Lib-Dirs: /opt/local/lib - if os(mingw32) - if arch(x86_64) - Extra-Libraries: eay32 ssl - - if arch(i386) - Extra-Libraries: eay32 ssl32 + if flag(use-pkg-config) + pkgconfig-depends: libssl, libcrypto + else + Extra-Libraries: ssl crypto + if os(mingw32) C-Sources: cbits/mutex-win.c CC-Options: -D MINGW32 -DNOCRYPT CPP-Options: -DCALLCONV=stdcall else - Extra-Libraries: crypto ssl C-Sources: cbits/mutex-pthread.c CC-Options: -D PTHREAD CPP-Options: -DCALLCONV=ccall @@ -142,6 +162,12 @@ Haskell2010 GHC-Options: -Wall + -Wno-deriving-typeable + -optc=-Wno-unknown-warning-option + -optc=-Wno-discarded-qualifiers + -optc=-Wno-deprecated-declarations + -optc=-Wno-incompatible-pointer-types + -optc=-Wno-pointer-sign C-Sources: cbits/HsOpenSSL.c Include-Dirs: @@ -151,12 +177,13 @@ Test-Suite test-dsa Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/DSA.hs - Other-Modules: Test.OpenSSL.TestUtils + Main-Is: DSA.hs + HS-Source-Dirs: Test/OpenSSL + Other-Modules: TestUtils Build-Depends: HsOpenSSL, - base >= 4.4 && < 5, - bytestring >= 0.9 && < 0.11 + base >= 4.8 && < 5, + bytestring >= 0.9 && < 0.13 Default-Language: Haskell2010 GHC-Options: @@ -164,11 +191,12 @@ Test-Suite test-der Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/DER.hs - Other-Modules: Test.OpenSSL.TestUtils + Main-Is: DER.hs + HS-Source-Dirs: Test/OpenSSL + Other-Modules: TestUtils Build-Depends: HsOpenSSL, - base >= 4.4 && < 5 + base >= 4.8 && < 5 Default-Language: Haskell2010 GHC-Options: @@ -176,12 +204,13 @@ Test-Suite test-evp-base64 Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/EVP/Base64.hs - Other-Modules: Test.OpenSSL.TestUtils + Main-Is: EVP/Base64.hs + HS-Source-Dirs: Test/OpenSSL + Other-Modules: TestUtils Build-Depends: HsOpenSSL, - base >= 4.4 && < 5, - bytestring >= 0.9 && < 0.11 + base >= 4.8 && < 5, + bytestring >= 0.9 && < 0.13 Default-Language: Haskell2010 GHC-Options: @@ -189,12 +218,13 @@ Test-Suite test-evp-digest Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/EVP/Digest.hs - Other-Modules: Test.OpenSSL.TestUtils + Main-Is: EVP/Digest.hs + HS-Source-Dirs: Test/OpenSSL + Other-Modules: TestUtils Build-Depends: HsOpenSSL, - base >= 4.4 && < 5, - bytestring >= 0.9 && < 0.11 + base >= 4.8 && < 5, + bytestring >= 0.9 && < 0.13 Default-Language: Haskell2010 GHC-Options: diff --git a/OpenSSL.hs b/OpenSSL.hs --- a/OpenSSL.hs +++ b/OpenSSL.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |HsOpenSSL is an OpenSSL binding for Haskell. It can generate RSA -- and DSA keys, read and write PEM files, generate message digests, -- sign and verify messages, encrypt and decrypt messages. @@ -52,10 +53,10 @@ import Control.Exception (onException, mask_) #endif -foreign import ccall "HsOpenSSL_init" +foreign import capi "HsOpenSSL.h HsOpenSSL_init" initSSL :: IO () -foreign import ccall "HsOpenSSL_setupMutex" +foreign import capi "HsOpenSSL.h HsOpenSSL_setupMutex" setupMutex :: IO () diff --git a/OpenSSL/ASN1.hsc b/OpenSSL/ASN1.hsc --- a/OpenSSL/ASN1.hsc +++ b/OpenSSL/ASN1.hsc @@ -1,5 +1,7 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} module OpenSSL.ASN1 ( ASN1_OBJECT , obj2nid @@ -29,17 +31,21 @@ import OpenSSL.BN import OpenSSL.Utils +#if !MIN_VERSION_time(1,5,0) +import System.Locale +#endif + {- ASN1_OBJECT --------------------------------------------------------------- -} -data ASN1_OBJECT +data {-# CTYPE "openssl/asn1.h" "ASN1_OBJECT" #-} ASN1_OBJECT -foreign import ccall unsafe "OBJ_obj2nid" +foreign import capi unsafe "openssl/objects.h OBJ_obj2nid" obj2nid :: Ptr ASN1_OBJECT -> IO CInt -foreign import ccall unsafe "OBJ_nid2sn" +foreign import capi unsafe "openssl/objects.h OBJ_nid2sn" _nid2sn :: CInt -> IO CString -foreign import ccall unsafe "OBJ_nid2ln" +foreign import capi unsafe "openssl/objects.h OBJ_nid2ln" _nid2ln :: CInt -> IO CString @@ -53,29 +59,35 @@ {- ASN1_STRING --------------------------------------------------------------- -} -data ASN1_STRING +data {-# CTYPE "openssl/asn1.h" "ASN1_STRING" #-} ASN1_STRING +foreign import capi unsafe "openssl/asn1.h ASN1_STRING_get0_data" + _ASN1_STRING_get0_data :: Ptr ASN1_STRING -> IO (Ptr CChar) + +foreign import capi unsafe "openssl/asn1.h ASN1_STRING_length" + _ASN1_STRING_length :: Ptr ASN1_STRING -> IO CInt + peekASN1String :: Ptr ASN1_STRING -> IO String peekASN1String strPtr - = do buf <- (#peek ASN1_STRING, data ) strPtr - len <- (#peek ASN1_STRING, length) strPtr :: IO CInt + = do buf <- _ASN1_STRING_get0_data strPtr + len <- _ASN1_STRING_length strPtr peekCStringLen (buf, fromIntegral len) {- ASN1_INTEGER -------------------------------------------------------------- -} -data ASN1_INTEGER +data {-# CTYPE "openssl/asn1.h" "ASN1_INTEGER" #-} ASN1_INTEGER -foreign import ccall unsafe "HsOpenSSL_M_ASN1_INTEGER_new" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_M_ASN1_INTEGER_new" _ASN1_INTEGER_new :: IO (Ptr ASN1_INTEGER) -foreign import ccall unsafe "HsOpenSSL_M_ASN1_INTEGER_free" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_M_ASN1_INTEGER_free" _ASN1_INTEGER_free :: Ptr ASN1_INTEGER -> IO () -foreign import ccall unsafe "ASN1_INTEGER_to_BN" +foreign import capi unsafe "openssl/asn1.h ASN1_INTEGER_to_BN" _ASN1_INTEGER_to_BN :: Ptr ASN1_INTEGER -> Ptr BIGNUM -> IO (Ptr BIGNUM) -foreign import ccall unsafe "BN_to_ASN1_INTEGER" +foreign import capi unsafe "openssl/asn1.h BN_to_ASN1_INTEGER" _BN_to_ASN1_INTEGER :: Ptr BIGNUM -> Ptr ASN1_INTEGER -> IO (Ptr ASN1_INTEGER) @@ -103,18 +115,18 @@ {- ASN1_TIME ---------------------------------------------------------------- -} -data ASN1_TIME +data {-# CTYPE "openssl/asn1.h" "ASN1_TIME" #-} ASN1_TIME -foreign import ccall unsafe "HsOpenSSL_M_ASN1_TIME_new" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_M_ASN1_TIME_new" _ASN1_TIME_new :: IO (Ptr ASN1_TIME) -foreign import ccall unsafe "HsOpenSSL_M_ASN1_TIME_free" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_M_ASN1_TIME_free" _ASN1_TIME_free :: Ptr ASN1_TIME -> IO () -foreign import ccall unsafe "ASN1_TIME_set" +foreign import capi unsafe "openssl/asn1.h ASN1_TIME_set" _ASN1_TIME_set :: Ptr ASN1_TIME -> CTime -> IO (Ptr ASN1_TIME) -foreign import ccall unsafe "ASN1_TIME_print" +foreign import capi unsafe "openssl/asn1.h ASN1_TIME_print" _ASN1_TIME_print :: Ptr BIO_ -> Ptr ASN1_TIME -> IO CInt @@ -125,26 +137,13 @@ _ASN1_TIME_print bioPtr time >>= failIf_ (/= 1) timeStr <- bioRead bio - case parseTimeM True locale "%b %e %H:%M:%S %Y %Z" timeStr of +#if MIN_VERSION_time(1,5,0) + case parseTimeM True defaultTimeLocale "%b %e %H:%M:%S %Y %Z" timeStr of +#else + case parseTime defaultTimeLocale "%b %e %H:%M:%S %Y %Z" timeStr of +#endif Just utc -> return utc Nothing -> fail ("peekASN1Time: failed to parse time string: " ++ timeStr) - where - locale :: TimeLocale - locale = TimeLocale { - wDays = undefined - , months = [ (undefined, x) - | x <- [ "Jan", "Feb", "Mar", "Apr", "May", "Jun" - , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" - ] - ] - , amPm = undefined - , dateTimeFmt = undefined - , dateFmt = undefined - , timeFmt = undefined - , time12Fmt = undefined - , knownTimeZones = [] - } - allocaASN1Time :: (Ptr ASN1_TIME -> IO a) -> IO a allocaASN1Time diff --git a/OpenSSL/BIO.hs b/OpenSSL/BIO.hs --- a/OpenSSL/BIO.hs +++ b/OpenSSL/BIO.hs @@ -1,5 +1,6 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {- --------------------------------------------------------------------------- -} {- -} {- FOR INTERNAL USE ONLY -} @@ -87,25 +88,25 @@ {- bio ---------------------------------------------------------------------- -} -data BIO_METHOD +data {-# CTYPE "openssl/bio.h" "BIO_METHOD" #-} BIO_METHOD -- |@BIO@ is a @ForeignPtr@ to an opaque BIO object. They are created by newXXX actions. newtype BIO = BIO (ForeignPtr BIO_) -data BIO_ +data {-# CTYPE "openssl/bio.h" "BIO" #-} BIO_ -foreign import ccall unsafe "BIO_new" +foreign import capi unsafe "openssl/bio.h BIO_new" _new :: Ptr BIO_METHOD -> IO (Ptr BIO_) -foreign import ccall unsafe "BIO_free" +foreign import capi unsafe "openssl/bio.h BIO_free" _free :: Ptr BIO_ -> IO () -foreign import ccall unsafe "BIO_push" +foreign import capi unsafe "openssl/bio.h BIO_push" _push :: Ptr BIO_ -> Ptr BIO_ -> IO (Ptr BIO_) -foreign import ccall unsafe "HsOpenSSL_BIO_set_flags" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_BIO_set_flags" _set_flags :: Ptr BIO_ -> CInt -> IO () -foreign import ccall unsafe "HsOpenSSL_BIO_should_retry" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_BIO_should_retry" _should_retry :: Ptr BIO_ -> IO CInt @@ -178,8 +179,8 @@ setFlags :: BIO -> CInt -> IO () setFlags bio flags = withBioPtr bio $ flip _set_flags flags - + bioShouldRetry :: BIO -> IO Bool bioShouldRetry bio = withBioPtr bio $ \ bioPtr -> @@ -188,13 +189,13 @@ {- ctrl --------------------------------------------------------------------- -} -foreign import ccall unsafe "HsOpenSSL_BIO_flush" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_BIO_flush" _flush :: Ptr BIO_ -> IO CInt -foreign import ccall unsafe "HsOpenSSL_BIO_reset" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_BIO_reset" _reset :: Ptr BIO_ -> IO CInt -foreign import ccall unsafe "HsOpenSSL_BIO_eof" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_BIO_eof" _eof :: Ptr BIO_ -> IO CInt -- |@'bioFlush' bio@ normally writes out any internally buffered data, @@ -223,13 +224,13 @@ {- I/O ---------------------------------------------------------------------- -} -foreign import ccall unsafe "BIO_read" +foreign import capi unsafe "openssl/bio.h BIO_read" _read :: Ptr BIO_ -> Ptr CChar -> CInt -> IO CInt -foreign import ccall unsafe "BIO_gets" +foreign import capi unsafe "openssl/bio.h BIO_gets" _gets :: Ptr BIO_ -> Ptr CChar -> CInt -> IO CInt -foreign import ccall unsafe "BIO_write" +foreign import capi unsafe "openssl/bio.h BIO_write" _write :: Ptr BIO_ -> Ptr CChar -> CInt -> IO CInt -- |@'bioRead' bio@ lazily reads all data in @bio@. @@ -259,7 +260,7 @@ bioReadLBS bio = fmap L.fromChunks lazyRead where chunkSize = L.defaultChunkSize - + lazyRead = unsafeInterleaveIO loop loop = do bs <- bioReadBS bio chunkSize @@ -335,10 +336,10 @@ {- base64 ------------------------------------------------------------------- -} -foreign import ccall unsafe "BIO_f_base64" +foreign import capi unsafe "openssl/bio.h BIO_f_base64" f_base64 :: IO (Ptr BIO_METHOD) -foreign import ccall unsafe "HsOpenSSL_BIO_FLAGS_BASE64_NO_NL" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_BIO_FLAGS_BASE64_NO_NL" _FLAGS_BASE64_NO_NL :: CInt -- |@'newBase64' noNL@ creates a Base64 BIO filter. This is a filter @@ -362,10 +363,10 @@ {- buffer ------------------------------------------------------------------- -} -foreign import ccall unsafe "BIO_f_buffer" +foreign import capi unsafe "openssl/bio.h BIO_f_buffer" f_buffer :: IO (Ptr BIO_METHOD) -foreign import ccall unsafe "HsOpenSSL_BIO_set_buffer_size" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_BIO_set_buffer_size" _set_buffer_size :: Ptr BIO_ -> CInt -> IO CInt @@ -410,10 +411,10 @@ {- mem ---------------------------------------------------------------------- -} -foreign import ccall unsafe "BIO_s_mem" +foreign import ccall unsafe "openssl/bio.h BIO_s_mem" s_mem :: IO (Ptr BIO_METHOD) -foreign import ccall unsafe "BIO_new_mem_buf" +foreign import ccall unsafe "openssl/bio.h BIO_new_mem_buf" _new_mem_buf :: Ptr CChar -> CInt -> IO (Ptr BIO_) @@ -454,7 +455,7 @@ bio <- newForeignPtr_ bioPtr Conc.addForeignPtrFinalizer bio (_free bioPtr >> touchForeignPtr foreignBuf) - + return $ BIO bio -- |@'newConstMemLBS' lbs@ is like 'newConstMem' but takes a @@ -465,7 +466,7 @@ {- null --------------------------------------------------------------------- -} -foreign import ccall unsafe "BIO_s_null" +foreign import ccall unsafe "openssl/bio.h BIO_s_null" s_null :: IO (Ptr BIO_METHOD) -- |@'newNullBIO'@ creates a null BIO sink\/source. Data written to diff --git a/OpenSSL/BN.hsc b/OpenSSL/BN.hsc --- a/OpenSSL/BN.hsc +++ b/OpenSSL/BN.hsc @@ -10,6 +10,7 @@ #endif {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} #if defined(FAST_BIGNUM) {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} @@ -69,13 +70,13 @@ -- |'BigNum' is an opaque object representing a big number. newtype BigNum = BigNum (Ptr BIGNUM) -data BIGNUM +data {-# CTYPE "openssl/bn.h" "BIGNUM" #-} BIGNUM -foreign import ccall unsafe "BN_new" +foreign import capi unsafe "openssl/bn.h BN_new" _new :: IO (Ptr BIGNUM) -foreign import ccall unsafe "BN_free" +foreign import capi unsafe "openssl/bn.h BN_free" _free :: Ptr BIGNUM -> IO () -- |@'allocaBN' f@ allocates a 'BigNum' and computes @f@. Then it @@ -97,13 +98,13 @@ {- slow, safe functions ----------------------------------------------------- -} -foreign import ccall unsafe "BN_bn2dec" +foreign import capi unsafe "openssl/bn.h BN_bn2dec" _bn2dec :: Ptr BIGNUM -> IO CString -foreign import ccall unsafe "BN_dec2bn" +foreign import capi unsafe "openssl/bn.h BN_dec2bn" _dec2bn :: Ptr (Ptr BIGNUM) -> CString -> IO CInt -foreign import ccall unsafe "HsOpenSSL_OPENSSL_free" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_OPENSSL_free" _openssl_free :: Ptr a -> IO () -- |Convert a BIGNUM to an 'Integer'. @@ -137,10 +138,10 @@ -- GC could do nasty things to the data which we thought that we had a pointer -- to -foreign import ccall unsafe "memcpy" +foreign import capi unsafe "string.h memcpy" _copy_in :: ByteArray## -> Ptr () -> CSize -> IO (Ptr ()) -foreign import ccall unsafe "memcpy" +foreign import capi unsafe "string.h memcpy" _copy_out :: Ptr () -> ByteArray## -> CSize -> IO (Ptr ()) -- These are taken from Data.Binary's disabled fast Integer support @@ -242,11 +243,11 @@ withBN :: Integer -> (BigNum -> IO a) -> IO a withBN dec m = bracket (integerToBN dec) (_free . unwrapBN) m -foreign import ccall unsafe "BN_bn2mpi" - _bn2mpi :: Ptr BIGNUM -> Ptr CChar -> IO CInt +foreign import capi unsafe "openssl/bn.h BN_bn2mpi" + _bn2mpi :: Ptr BIGNUM -> Ptr CUChar -> IO CInt -foreign import ccall unsafe "BN_mpi2bn" - _mpi2bn :: Ptr CChar -> CInt -> Ptr BIGNUM -> IO (Ptr BIGNUM) +foreign import capi unsafe "openssl/bn.h BN_mpi2bn" + _mpi2bn :: Ptr CUChar -> CInt -> Ptr BIGNUM -> IO (Ptr BIGNUM) -- |This is an alias to 'bnToInteger'. peekBN :: BigNum -> IO Integer @@ -264,13 +265,13 @@ bytes <- _bn2mpi (unwrapBN bn) nullPtr allocaBytes (fromIntegral bytes) (\buffer -> do _ <- _bn2mpi (unwrapBN bn) buffer - BS.packCStringLen (buffer, fromIntegral bytes)) + BS.packCStringLen (castPtr buffer, fromIntegral bytes)) -- | Convert an MPI into a BigNum. See bnToMPI for details of the format mpiToBN :: BS.ByteString -> IO BigNum mpiToBN mpi = do BS.useAsCStringLen mpi (\(ptr, len) -> do - _mpi2bn ptr (fromIntegral len) nullPtr) >>= return . wrapBN + _mpi2bn (castPtr ptr) (fromIntegral len) nullPtr) >>= return . wrapBN -- | Convert an Integer to an MPI. See bnToMPI for the format integerToMPI :: Integer -> IO BS.ByteString @@ -284,16 +285,16 @@ _free (unwrapBN bn) return v -foreign import ccall unsafe "BN_mod_exp" - _mod_exp :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> BNCtx -> IO (Ptr BIGNUM) +foreign import capi unsafe "openssl/bn.h BN_mod_exp" + _mod_exp :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> BNCtx -> IO CInt type BNCtx = Ptr BNCTX -data BNCTX +data {-# CTYPE "openssl/bn.h" "BN_CTX" #-} BNCTX -foreign import ccall unsafe "BN_CTX_new" +foreign import capi unsafe "openssl/bn.h BN_CTX_new" _BN_ctx_new :: IO BNCtx -foreign import ccall unsafe "BN_CTX_free" +foreign import capi unsafe "openssl/bn.h BN_CTX_free" _BN_ctx_free :: BNCtx -> IO () withBNCtx :: (BNCtx -> IO a) -> IO a @@ -312,10 +313,10 @@ {- Random Integer generation ------------------------------------------------ -} -foreign import ccall unsafe "BN_rand_range" +foreign import capi unsafe "openssl/bn.h BN_rand_range" _BN_rand_range :: Ptr BIGNUM -> Ptr BIGNUM -> IO CInt -foreign import ccall unsafe "BN_pseudo_rand_range" +foreign import capi unsafe "openssl/bn.h BN_pseudo_rand_range" _BN_pseudo_rand_range :: Ptr BIGNUM -> Ptr BIGNUM -> IO CInt -- | Return a strongly random number in the range 0 <= x < n where the given diff --git a/OpenSSL/Cipher.hsc b/OpenSSL/Cipher.hsc --- a/OpenSSL/Cipher.hsc +++ b/OpenSSL/Cipher.hsc @@ -1,5 +1,9 @@ +#include "HsOpenSSL.h" +#include "openssl/aes.h" + {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- | This module interfaces to some of the OpenSSL ciphers without using -- EVP (see OpenSSL.EVP.Cipher). The EVP ciphers are easier to use, -- however, in some cases you cannot do without using the OpenSSL @@ -21,8 +25,7 @@ #endif ) where -#include "HsOpenSSL.h" -#include "openssl/aes.h" + import Control.Monad (when, unless) import Data.IORef import Foreign @@ -37,7 +40,7 @@ modeToInt Encrypt = 1 modeToInt Decrypt = 0 -data AES_KEY +data {-# CTYPE "openssl/aes.h" "AES_KEY" #-} AES_KEY data AESCtx = AESCtx (ForeignPtr AES_KEY) -- the key schedule (ForeignPtr CUChar) -- the IV / counter @@ -45,21 +48,21 @@ (IORef CUInt) -- the number of bytes of the encrypted counter used Mode -foreign import ccall unsafe "memcpy" +foreign import capi unsafe "string.h memcpy" _memcpy :: Ptr CUChar -> Ptr CChar -> CSize -> IO (Ptr ()) -foreign import ccall unsafe "memset" +foreign import capi unsafe "string.h memset" _memset :: Ptr CUChar -> CChar -> CSize -> IO () -foreign import ccall unsafe "AES_set_encrypt_key" +foreign import capi unsafe "openssl/aes.h AES_set_encrypt_key" _AES_set_encrypt_key :: Ptr CChar -> CInt -> Ptr AES_KEY -> IO CInt -foreign import ccall unsafe "AES_set_decrypt_key" +foreign import capi unsafe "openssl/aes.h AES_set_decrypt_key" _AES_set_decrypt_key :: Ptr CChar -> CInt -> Ptr AES_KEY -> IO CInt -foreign import ccall unsafe "AES_cbc_encrypt" +foreign import capi unsafe "openssl/aes.h AES_cbc_encrypt" _AES_cbc_encrypt :: Ptr CChar -> Ptr Word8 -> CULong -> Ptr AES_KEY -> Ptr CUChar -> CInt -> IO () -foreign import ccall unsafe "&free" +foreign import capi unsafe "stdlib.h &free" _free :: FunPtr (Ptr a -> IO ()) -- | Construct a new context which holds the key schedule and IV. @@ -101,7 +104,7 @@ #if OPENSSL_VERSION_NUMBER < 0x10100000L -- seems that AES_ctr128_encrypt was removed in recent OpenSSL versions -foreign import ccall unsafe "AES_ctr128_encrypt" +foreign import capi unsafe "openssl/aes.h AES_ctr128_encrypt" _AES_ctr_encrypt :: Ptr CChar -> Ptr Word8 -> CULong -> Ptr AES_KEY -> Ptr CUChar -> Ptr CUChar -> Ptr CUInt -> IO () -- | Encrypt some number of bytes using CTR mode. This is an IO function diff --git a/OpenSSL/DER.hsc b/OpenSSL/DER.hsc --- a/OpenSSL/DER.hsc +++ b/OpenSSL/DER.hsc @@ -1,4 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |Encoding and decoding of RSA keys using the ASN.1 DER format module OpenSSL.DER ( toDERPub @@ -17,27 +18,26 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B (useAsCStringLen) import qualified Data.ByteString.Internal as BI (createAndTrim) -import Foreign.Ptr (Ptr, nullPtr) -import Foreign.C.String (CString) +import Foreign.Ptr (Ptr, nullPtr, castPtr) import Foreign.C.Types (CLong(..), CInt(..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Storable (poke) import GHC.Word (Word8) import System.IO.Unsafe (unsafePerformIO) -type CDecodeFun = Ptr (Ptr RSA) -> Ptr CString -> CLong -> IO (Ptr RSA) +type CDecodeFun = Ptr (Ptr RSA) -> Ptr (Ptr Word8) -> CLong -> IO (Ptr RSA) type CEncodeFun = Ptr RSA -> Ptr (Ptr Word8) -> IO CInt -foreign import ccall unsafe "d2i_RSAPublicKey" +foreign import capi unsafe "HsOpenSSL.h d2i_RSAPublicKey" _fromDERPub :: CDecodeFun -foreign import ccall unsafe "i2d_RSAPublicKey" +foreign import capi unsafe "HsOpenSSL.h i2d_RSAPublicKey" _toDERPub :: CEncodeFun -foreign import ccall unsafe "d2i_RSAPrivateKey" +foreign import capi unsafe "HsOpenSSL.h d2i_RSAPrivateKey" _fromDERPriv :: CDecodeFun -foreign import ccall unsafe "i2d_RSAPrivateKey" +foreign import capi unsafe "HsOpenSSL.h i2d_RSAPrivateKey" _toDERPriv :: CEncodeFun -- | Generate a function that decodes a key from ASN.1 DER format @@ -47,7 +47,10 @@ -- space required for the RSA key all by itself. It will be freed whenever -- the haskell object is garbage collected, as they are stored in ForeignPtrs -- internally. - rsaPtr <- fun nullPtr csPtr ci + rsaPtr <- fun nullPtr (castPtr csPtr) ci + -- CString is represented as a void* in C and the C compiler whines about + -- a bad pointer conversion in d2i_* functions. So we declare + -- the CDecodeFun to accept Ptr Word8 and perform the castPtr here. if rsaPtr == nullPtr then return Nothing else absorbRSAPtr rsaPtr where usingConvedBS io = B.useAsCStringLen bs $ \(cs, len) -> alloca $ \csPtr -> poke csPtr cs >> io (csPtr, fromIntegral len) diff --git a/OpenSSL/DH.hs b/OpenSSL/DH.hs --- a/OpenSSL/DH.hs +++ b/OpenSSL/DH.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- | Diffie-Hellman key exchange module OpenSSL.DH ( DHP @@ -82,19 +83,19 @@ fromIntegral <$> _DH_compute_key bsPtr (unwrapBN bn) dhPtr >>= failIf (< 0) -foreign import ccall "DH_generate_parameters" +foreign import capi "openssl/dh.h DH_generate_parameters" _DH_generate_parameters :: CInt -> CInt -> Ptr () -> Ptr () -> IO (Ptr DH_) -foreign import ccall "DH_generate_key" +foreign import capi "openssl/dh.h DH_generate_key" _DH_generate_key :: Ptr DH_ -> IO CInt -foreign import ccall "DH_compute_key" +foreign import capi "openssl/dh.h DH_compute_key" _DH_compute_key :: Ptr Word8 -> Ptr BIGNUM -> Ptr DH_ -> IO CInt -foreign import ccall "DH_check" +foreign import capi "openssl/dh.h DH_check" _DH_check :: Ptr DH_ -> Ptr CInt -> IO Bool -foreign import ccall unsafe "DH_size" +foreign import capi unsafe "openssl/dh.h DH_size" _DH_size :: Ptr DH_ -> IO CInt -foreign import ccall unsafe "HsOpenSSL_DHparams_dup" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_DHparams_dup" _DH_dup :: Ptr DH_ -> IO (Ptr DH_) -foreign import ccall unsafe "HsOpenSSL_DH_get_pub_key" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_DH_get_pub_key" _DH_get_pub_key :: Ptr DH_ -> IO (Ptr BIGNUM) -foreign import ccall unsafe "HsOpenSSL_DH_length" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_DH_length" _DH_length :: Ptr DH_ -> IO CInt diff --git a/OpenSSL/DH/Internal.hs b/OpenSSL/DH/Internal.hs --- a/OpenSSL/DH/Internal.hs +++ b/OpenSSL/DH/Internal.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} module OpenSSL.DH.Internal ( DH_, DHP, @@ -23,7 +24,7 @@ import Control.Applicative ((<$>)) #endif -data DH_ +data {-# CTYPE "openssl/dh.h" "DH" #-} DH_ newtype DHP = DHP (ForeignPtr DH_) withDHPPtr :: DHP -> (Ptr DH_ -> IO a) -> IO a @@ -52,5 +53,5 @@ asDHP :: DH -> DHP asDHP (DH fp) = DHP fp -foreign import ccall "DH_free" +foreign import capi "openssl/dh.h DH_free" _DH_free :: Ptr DH_ -> IO () diff --git a/OpenSSL/DSA.hsc b/OpenSSL/DSA.hsc --- a/OpenSSL/DSA.hsc +++ b/OpenSSL/DSA.hsc @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# OPTIONS_HADDOCK prune #-} -- | The Digital Signature Algorithm (FIPS 186-2). -- See @@ -115,37 +116,37 @@ = fmap (/= nullPtr) (dsa_priv_key dsaPtr) -foreign import ccall unsafe "&DSA_free" +foreign import capi unsafe "openssl/dsa.h &DSA_free" _free :: FunPtr (Ptr DSA -> IO ()) -foreign import ccall unsafe "DSA_free" +foreign import capi unsafe "openssl/dsa.h DSA_free" dsa_free :: Ptr DSA -> IO () -foreign import ccall unsafe "BN_free" +foreign import capi unsafe "openssl/dsa.h BN_free" _bn_free :: Ptr BIGNUM -> IO () -foreign import ccall unsafe "DSA_new" +foreign import capi unsafe "openssl/dsa.h DSA_new" _dsa_new :: IO (Ptr DSA) -foreign import ccall unsafe "DSA_generate_key" +foreign import capi unsafe "openssl/dsa.h DSA_generate_key" _dsa_generate_key :: Ptr DSA -> IO () -foreign import ccall unsafe "HsOpenSSL_dsa_sign" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_dsa_sign" _dsa_sign :: Ptr DSA -> CString -> CInt -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO CInt -foreign import ccall unsafe "HsOpenSSL_dsa_verify" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_dsa_verify" _dsa_verify :: Ptr DSA -> CString -> CInt -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt -foreign import ccall safe "DSA_generate_parameters" +foreign import capi safe "openssl/dsa.h DSA_generate_parameters" _generate_params :: CInt -> Ptr CChar -> CInt -> Ptr CInt -> Ptr CInt -> Ptr () -> Ptr () -> IO (Ptr DSA) -foreign import ccall unsafe "HsOpenSSL_DSAPublicKey_dup" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_DSAPublicKey_dup" _pubDup :: Ptr DSA -> IO (Ptr DSA) -foreign import ccall unsafe "HsOpenSSL_DSAPrivateKey_dup" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_DSAPrivateKey_dup" _privDup :: Ptr DSA -> IO (Ptr DSA) -foreign import ccall unsafe "DSA_size" +foreign import capi unsafe "openssl/dsa.h DSA_size" _size :: Ptr DSA -> IO CInt dsa_p, dsa_q, dsa_g, dsa_pub_key, dsa_priv_key :: Ptr DSA -> IO (Ptr BIGNUM) @@ -154,16 +155,16 @@ #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "DSA_get0_pqg" +foreign import capi unsafe "openssl/dsa.h DSA_get0_pqg" _get0_pqg :: Ptr DSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO () -foreign import ccall unsafe "DSA_get0_key" +foreign import capi unsafe "openssl/dsa.h DSA_get0_key" _get0_key :: Ptr DSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO () -foreign import ccall unsafe "DSA_set0_pqg" +foreign import capi unsafe "openssl/dsa.h DSA_set0_pqg" _set0_pqg :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt -foreign import ccall unsafe "DSA_set0_key" +foreign import capi unsafe "openssl/dsa.h DSA_set0_key" _set0_key :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt withPQG :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a) diff --git a/OpenSSL/ERR.hs b/OpenSSL/ERR.hs --- a/OpenSSL/ERR.hs +++ b/OpenSSL/ERR.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} module OpenSSL.ERR ( getError , peekError @@ -9,13 +10,13 @@ import Foreign import Foreign.C -foreign import ccall unsafe "ERR_get_error" +foreign import capi unsafe "openssl/err.h ERR_get_error" getError :: IO CULong -foreign import ccall unsafe "ERR_peek_error" +foreign import capi unsafe "openssl/err.h ERR_peek_error" peekError :: IO CULong -foreign import ccall unsafe "ERR_error_string" +foreign import capi unsafe "openssl/err.h ERR_error_string" _error_string :: CULong -> CString -> IO CString errorString :: CULong -> IO String diff --git a/OpenSSL/EVP/Base64.hs b/OpenSSL/EVP/Base64.hs --- a/OpenSSL/EVP/Base64.hs +++ b/OpenSSL/EVP/Base64.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |An interface to Base64 codec. module OpenSSL.EVP.Base64 ( -- * Encoding @@ -21,9 +22,9 @@ import qualified Data.ByteString.Lazy.Char8 as L8 import Data.List #if MIN_VERSION_base(4,5,0) -import Foreign.C.Types (CChar(..), CInt(..)) +import Foreign.C.Types (CUChar(..), CInt(..)) #else -import Foreign.C.Types (CChar, CInt) +import Foreign.C.Types (CUChar, CInt) #endif import Foreign.Ptr (Ptr, castPtr) import System.IO.Unsafe (unsafePerformIO) @@ -48,8 +49,8 @@ {- encode -------------------------------------------------------------------- -} -foreign import ccall unsafe "EVP_EncodeBlock" - _EncodeBlock :: Ptr CChar -> Ptr CChar -> CInt -> IO CInt +foreign import capi unsafe "openssl/evp.h EVP_EncodeBlock" + _EncodeBlock :: Ptr CUChar -> Ptr CUChar -> CInt -> IO CInt encodeBlock :: B8.ByteString -> B8.ByteString @@ -58,7 +59,7 @@ unsafeUseAsCStringLen inBS $ \ (inBuf, inLen) -> createAndTrim maxOutLen $ \ outBuf -> fmap fromIntegral - (_EncodeBlock (castPtr outBuf) inBuf (fromIntegral inLen)) + (_EncodeBlock (castPtr outBuf) (castPtr inBuf) (fromIntegral inLen)) where maxOutLen = (inputLen `div` 3 + 1) * 4 + 1 -- +1: '\0' inputLen = B8.length inBS @@ -102,8 +103,8 @@ {- decode -------------------------------------------------------------------- -} -foreign import ccall unsafe "EVP_DecodeBlock" - _DecodeBlock :: Ptr CChar -> Ptr CChar -> CInt -> IO CInt +foreign import capi unsafe "openssl/evp.h EVP_DecodeBlock" + _DecodeBlock :: Ptr CUChar -> Ptr CUChar -> CInt -> IO CInt decodeBlock :: B8.ByteString -> B8.ByteString @@ -112,7 +113,7 @@ unsafePerformIO $ unsafeUseAsCStringLen inBS $ \ (inBuf, inLen) -> createAndTrim (B8.length inBS) $ \ outBuf -> - _DecodeBlock (castPtr outBuf) inBuf (fromIntegral inLen) + _DecodeBlock (castPtr outBuf) (castPtr inBuf) (fromIntegral inLen) >>= \ outLen -> return (fromIntegral outLen - paddingLen) where paddingLen :: Int diff --git a/OpenSSL/EVP/Cipher.hs b/OpenSSL/EVP/Cipher.hs --- a/OpenSSL/EVP/Cipher.hs +++ b/OpenSSL/EVP/Cipher.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |An interface to symmetric cipher algorithms. module OpenSSL.EVP.Cipher ( Cipher @@ -25,7 +26,7 @@ import Data.Monoid #endif -foreign import ccall unsafe "EVP_get_cipherbyname" +foreign import capi unsafe "openssl/evp.h EVP_get_cipherbyname" _get_cipherbyname :: CString -> IO (Ptr EVP_CIPHER) -- |@'getCipherByName' name@ returns a symmetric cipher algorithm diff --git a/OpenSSL/EVP/Digest.hsc b/OpenSSL/EVP/Digest.hsc --- a/OpenSSL/EVP/Digest.hsc +++ b/OpenSSL/EVP/Digest.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |An interface to message digest algorithms. module OpenSSL.EVP.Digest ( Digest @@ -37,7 +38,7 @@ import OpenSSL.Objects import System.IO.Unsafe (unsafePerformIO) -foreign import ccall unsafe "EVP_get_digestbyname" +foreign import capi unsafe "openssl/evp.h EVP_get_digestbyname" _get_digestbyname :: CString -> IO (Ptr EVP_MD) -- |@'getDigestByName' name@ returns a message digest algorithm whose @@ -79,7 +80,7 @@ {- HMAC ---------------------------------------------------------------------- -} -foreign import ccall unsafe "HMAC" +foreign import capi unsafe "openssl/hmac.h HMAC" _HMAC :: Ptr EVP_MD -> Ptr CChar -> CInt -> Ptr CChar -> CSize -> Ptr CChar -> Ptr CUInt -> IO () @@ -121,7 +122,7 @@ (fromIntegral iter) (fromIntegral dkeylen) (castPtr dkeydata) >> return () -foreign import ccall unsafe "PKCS5_PBKDF2_HMAC_SHA1" +foreign import capi unsafe "openssl/hmac.h PKCS5_PBKDF2_HMAC_SHA1" _PKCS5_PBKDF2_HMAC_SHA1 :: Ptr CChar -> CInt -> Ptr CChar -> CInt -> CInt -> CInt -> Ptr CChar diff --git a/OpenSSL/EVP/Internal.hsc b/OpenSSL/EVP/Internal.hsc --- a/OpenSSL/EVP/Internal.hsc +++ b/OpenSSL/EVP/Internal.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} module OpenSSL.EVP.Internal ( Cipher(..), EVP_CIPHER, @@ -65,7 +66,7 @@ import Control.Applicative ((<$>)) #endif import Control.Exception (mask, mask_, bracket, onException) -import Foreign.C.Types (CChar) +import Foreign.C.Types (CChar, CUChar) #if MIN_VERSION_base(4,5,0) import Foreign.C.Types (CInt(..), CUInt(..), CSize(..)) #else @@ -91,12 +92,12 @@ -- |@Cipher@ is an opaque object that represents an algorithm of -- symmetric cipher. newtype Cipher = Cipher (Ptr EVP_CIPHER) -data EVP_CIPHER +data {-# CTYPE "openssl/evp.h" "EVP_CIPHER" #-} EVP_CIPHER withCipherPtr :: Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a withCipherPtr (Cipher cipherPtr) f = f cipherPtr -foreign import ccall unsafe "HsOpenSSL_EVP_CIPHER_iv_length" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_EVP_CIPHER_iv_length" _iv_length :: Ptr EVP_CIPHER -> CInt cipherIvLength :: Cipher -> Int @@ -105,26 +106,26 @@ {- EVP_CIPHER_CTX ------------------------------------------------------------ -} newtype CipherCtx = CipherCtx (ForeignPtr EVP_CIPHER_CTX) -data EVP_CIPHER_CTX +data {-# CTYPE "openssl/evp.h" "EVP_CIPHER_CTX" #-} EVP_CIPHER_CTX -foreign import ccall unsafe "EVP_CIPHER_CTX_new" +foreign import capi unsafe "openssl/evp.h EVP_CIPHER_CTX_new" _cipher_ctx_new :: IO (Ptr EVP_CIPHER_CTX) #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "EVP_CIPHER_CTX_reset" +foreign import capi unsafe "openssl/evp.h EVP_CIPHER_CTX_reset" _cipher_ctx_reset :: Ptr EVP_CIPHER_CTX -> IO () #else -foreign import ccall unsafe "EVP_CIPHER_CTX_init" +foreign import capi unsafe "openssl/evp.h EVP_CIPHER_CTX_init" _cipher_ctx_reset :: Ptr EVP_CIPHER_CTX -> IO () #endif -foreign import ccall unsafe "&EVP_CIPHER_CTX_free" +foreign import capi unsafe "openssl/evp.h &EVP_CIPHER_CTX_free" _cipher_ctx_free :: FunPtr (Ptr EVP_CIPHER_CTX -> IO ()) -foreign import ccall unsafe "EVP_CIPHER_CTX_free" +foreign import capi unsafe "openssl/evp.h EVP_CIPHER_CTX_free" _cipher_ctx_free' :: Ptr EVP_CIPHER_CTX -> IO () -foreign import ccall unsafe "HsOpenSSL_EVP_CIPHER_CTX_block_size" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_EVP_CIPHER_CTX_block_size" _cipher_ctx_block_size :: Ptr EVP_CIPHER_CTX -> CInt newCipherCtx :: IO CipherCtx @@ -151,7 +152,7 @@ fromCryptoMode Encrypt = 1 fromCryptoMode Decrypt = 0 -foreign import ccall unsafe "EVP_CIPHER_CTX_set_padding" +foreign import capi unsafe "openssl/evp.h EVP_CIPHER_CTX_set_padding" _SetPadding :: Ptr EVP_CIPHER_CTX -> CInt -> IO CInt cipherSetPadding :: CipherCtx -> Int -> IO CipherCtx @@ -161,7 +162,7 @@ >>= failIf_ (/= 1) return ctx -foreign import ccall unsafe "EVP_CipherInit" +foreign import capi unsafe "openssl/evp.h EVP_CipherInit" _CipherInit :: Ptr EVP_CIPHER_CTX -> Ptr EVP_CIPHER -> CString @@ -183,7 +184,7 @@ >>= failIf_ (/= 1) return ctx -foreign import ccall unsafe "EVP_CipherUpdate" +foreign import capi unsafe "openssl/evp.h EVP_CipherUpdate" _CipherUpdate :: Ptr EVP_CIPHER_CTX -> Ptr CChar -> Ptr CInt -> Ptr CChar -> CInt -> IO CInt @@ -199,7 +200,7 @@ >>= failIf (/= 1) >> fromIntegral <$> peek outLenPtr -foreign import ccall unsafe "EVP_CipherFinal" +foreign import capi unsafe "openssl/evp.h EVP_CipherFinal" _CipherFinal :: Ptr EVP_CIPHER_CTX -> Ptr CChar -> Ptr CInt -> IO CInt cipherFinalBS :: CipherCtx -> IO B8.ByteString @@ -231,7 +232,7 @@ -- |@Digest@ is an opaque object that represents an algorithm of -- message digest. newtype Digest = Digest (Ptr EVP_MD) -data EVP_MD +data {-# CTYPE "openssl/evp.h" "EVP_MD" #-} EVP_MD withMDPtr :: Digest -> (Ptr EVP_MD -> IO a) -> IO a withMDPtr (Digest mdPtr) f = f mdPtr @@ -239,22 +240,22 @@ {- EVP_MD_CTX ---------------------------------------------------------------- -} newtype DigestCtx = DigestCtx (ForeignPtr EVP_MD_CTX) -data EVP_MD_CTX +data {-# CTYPE "openssl/evp.h" "EVP_MD_CTX" #-} EVP_MD_CTX #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "EVP_MD_CTX_new" +foreign import capi unsafe "openssl/evp.h EVP_MD_CTX_new" _md_ctx_new :: IO (Ptr EVP_MD_CTX) -foreign import ccall unsafe "EVP_MD_CTX_reset" +foreign import capi unsafe "openssl/evp.h EVP_MD_CTX_reset" _md_ctx_reset :: Ptr EVP_MD_CTX -> IO () -foreign import ccall unsafe "&EVP_MD_CTX_free" +foreign import capi unsafe "openssl/evp.h &EVP_MD_CTX_free" _md_ctx_free :: FunPtr (Ptr EVP_MD_CTX -> IO ()) #else -foreign import ccall unsafe "EVP_MD_CTX_create" +foreign import capi unsafe "openssl/evp.h EVP_MD_CTX_create" _md_ctx_new :: IO (Ptr EVP_MD_CTX) -foreign import ccall unsafe "EVP_MD_CTX_init" +foreign import capi unsafe "openssl/evp.h EVP_MD_CTX_init" _md_ctx_reset :: Ptr EVP_MD_CTX -> IO () -foreign import ccall unsafe "&EVP_MD_CTX_destroy" +foreign import capi unsafe "openssl/evp.h &EVP_MD_CTX_destroy" _md_ctx_free :: FunPtr (Ptr EVP_MD_CTX -> IO ()) #endif @@ -269,7 +270,7 @@ {- digest -------------------------------------------------------------------- -} -foreign import ccall unsafe "EVP_DigestInit" +foreign import capi unsafe "openssl/evp.h EVP_DigestInit" _DigestInit :: Ptr EVP_MD_CTX -> Ptr EVP_MD -> IO CInt digestInit :: Digest -> IO DigestCtx @@ -280,7 +281,7 @@ >>= failIf_ (/= 1) >> return ctx -foreign import ccall unsafe "EVP_DigestUpdate" +foreign import capi unsafe "openssl/evp.h EVP_DigestUpdate" _DigestUpdate :: Ptr EVP_MD_CTX -> Ptr CChar -> CSize -> IO CInt digestUpdateBS :: DigestCtx -> B8.ByteString -> IO () @@ -291,7 +292,7 @@ >>= failIf (/= 1) >> return () -foreign import ccall unsafe "EVP_DigestFinal" +foreign import capi unsafe "openssl/evp.h EVP_DigestFinal" _DigestFinal :: Ptr EVP_MD_CTX -> Ptr CChar -> Ptr CUInt -> IO CInt digestFinalBS :: DigestCtx -> IO B8.ByteString @@ -325,21 +326,21 @@ {- HMAC ---------------------------------------------------------------------- -} newtype HmacCtx = HmacCtx (ForeignPtr HMAC_CTX) -data HMAC_CTX +data {-# CTYPE "openssl/hmac.h" "HMAC_CTX" #-} HMAC_CTX -foreign import ccall unsafe "HsOpenSSL_HMAC_CTX_new" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_HMAC_CTX_new" _hmac_ctx_new :: IO (Ptr HMAC_CTX) -foreign import ccall unsafe "HMAC_Init" +foreign import capi unsafe "openssl/hmac.h HMAC_Init" _hmac_init :: Ptr HMAC_CTX -> Ptr () -> CInt -> Ptr EVP_MD -> IO CInt -foreign import ccall unsafe "HMAC_Update" - _hmac_update :: Ptr HMAC_CTX -> Ptr CChar -> CInt -> IO CInt +foreign import capi unsafe "openssl/hmac.h HMAC_Update" + _hmac_update :: Ptr HMAC_CTX -> Ptr CUChar -> CSize -> IO CInt -foreign import ccall unsafe "HMAC_Final" - _hmac_final :: Ptr HMAC_CTX -> Ptr CChar -> Ptr CInt -> IO CUInt +foreign import capi unsafe "openssl/hmac.h HMAC_Final" + _hmac_final :: Ptr HMAC_CTX -> Ptr CUChar -> Ptr CUInt -> IO CUInt -foreign import ccall unsafe "&HsOpenSSL_HMAC_CTX_free" +foreign import capi unsafe "HsOpenSSL &HsOpenSSL_HMAC_CTX_free" _hmac_ctx_free :: FunPtr (Ptr HMAC_CTX -> IO ()) newHmacCtx :: IO HmacCtx @@ -384,7 +385,7 @@ -- | VaguePKey is a 'ForeignPtr' to 'EVP_PKEY', that is either public -- key or a ker pair. We can't tell which at compile time. newtype VaguePKey = VaguePKey (ForeignPtr EVP_PKEY) -data EVP_PKEY +data {-# CTYPE "openssl/evp.h" "EVP_PKEY" #-} EVP_PKEY -- | Instances of class 'PKey' can be converted back and forth to -- 'VaguePKey'. @@ -402,13 +403,13 @@ -- | Return the default digesting algorithm for the key. pkeyDefaultMD :: k -> IO Digest -foreign import ccall unsafe "EVP_PKEY_new" +foreign import capi unsafe "openssl/evp.h EVP_PKEY_new" _pkey_new :: IO (Ptr EVP_PKEY) -foreign import ccall unsafe "&EVP_PKEY_free" +foreign import capi unsafe "openssl/evp.h &EVP_PKEY_free" _pkey_free :: FunPtr (Ptr EVP_PKEY -> IO ()) -foreign import ccall unsafe "EVP_PKEY_free" +foreign import capi unsafe "openssl/evp.h EVP_PKEY_free" _pkey_free' :: Ptr EVP_PKEY -> IO () wrapPKeyPtr :: Ptr EVP_PKEY -> IO VaguePKey diff --git a/OpenSSL/EVP/Open.hs b/OpenSSL/EVP/Open.hs --- a/OpenSSL/EVP/Open.hs +++ b/OpenSSL/EVP/Open.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |Asymmetric cipher decryption using encrypted symmetric key. This -- is an opposite of "OpenSSL.EVP.Seal". module OpenSSL.EVP.Open @@ -24,7 +25,7 @@ import OpenSSL.Utils import System.IO.Unsafe (unsafePerformIO) -foreign import ccall unsafe "EVP_OpenInit" +foreign import capi unsafe "openssl/evp.h EVP_OpenInit" _OpenInit :: Ptr EVP_CIPHER_CTX -> Cipher -> Ptr CChar diff --git a/OpenSSL/EVP/PKey.hsc b/OpenSSL/EVP/PKey.hsc --- a/OpenSSL/EVP/PKey.hsc +++ b/OpenSSL/EVP/PKey.hsc @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- |An interface to asymmetric cipher keypair. @@ -50,13 +51,13 @@ toKeyPair (SomeKeyPair pk) = cast pk -getType :: Ptr EVP_PKEY -> IO CInt -#if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "EVP_PKEY_base_id" - _base_id :: Ptr EVP_PKEY -> IO CInt -getType = _base_id +#if OPENSSL_VERSION_PREREQ(3,0) +foreign import capi unsafe "openssl/evp.h EVP_PKEY_get_base_id" getType :: Ptr EVP_PKEY -> IO CInt +#elif OPENSSL_VERSION_NUMBER >= 0x10100000L +foreign import capi unsafe "openssl/evp.h EVP_PKEY_base_id" getType :: Ptr EVP_PKEY -> IO CInt #else +getType :: Ptr EVP_PKEY -> IO CInt getType = (#peek EVP_PKEY, type) #endif @@ -157,10 +158,10 @@ #if !defined(OPENSSL_NO_RSA) -- The resulting Ptr RSA must be freed by caller. -foreign import ccall unsafe "EVP_PKEY_get1_RSA" +foreign import capi unsafe "openssl/evp.h EVP_PKEY_get1_RSA" _get1_RSA :: Ptr EVP_PKEY -> IO (Ptr RSA) -foreign import ccall unsafe "EVP_PKEY_set1_RSA" +foreign import capi unsafe "openssl/evp.h EVP_PKEY_set1_RSA" _set1_RSA :: Ptr EVP_PKEY -> Ptr RSA -> IO CInt @@ -197,10 +198,10 @@ #if !defined(OPENSSL_NO_DSA) -foreign import ccall unsafe "EVP_PKEY_get1_DSA" +foreign import capi unsafe "openssl/evp.h EVP_PKEY_get1_DSA" _get1_DSA :: Ptr EVP_PKEY -> IO (Ptr DSA) -foreign import ccall unsafe "EVP_PKEY_set1_DSA" +foreign import capi unsafe "openssl/evp.h EVP_PKEY_set1_DSA" _set1_DSA :: Ptr EVP_PKEY -> Ptr DSA -> IO CInt dsaToPKey :: DSAKey k => k -> IO VaguePKey @@ -208,6 +209,7 @@ = withDSAPtr dsa $ \dsaPtr -> createPKey $ \pkeyPtr -> _set1_DSA pkeyPtr dsaPtr >>= failIf_ (/= 1) + dsaFromPKey :: DSAKey k => VaguePKey -> IO (Maybe k) dsaFromPKey pk diff --git a/OpenSSL/EVP/Seal.hs b/OpenSSL/EVP/Seal.hs --- a/OpenSSL/EVP/Seal.hs +++ b/OpenSSL/EVP/Seal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |Asymmetric cipher decryption using encrypted symmetric key. This -- is an opposite of "OpenSSL.EVP.Open". module OpenSSL.EVP.Seal @@ -17,12 +18,12 @@ import OpenSSL.Utils -foreign import ccall unsafe "EVP_SealInit" +foreign import capi unsafe "openssl/evp.h EVP_SealInit" _SealInit :: Ptr EVP_CIPHER_CTX -> Cipher -> Ptr (Ptr CChar) -> Ptr CInt - -> CString + -> Ptr CChar -> Ptr (Ptr EVP_PKEY) -> CInt -> IO CInt diff --git a/OpenSSL/EVP/Sign.hs b/OpenSSL/EVP/Sign.hs --- a/OpenSSL/EVP/Sign.hs +++ b/OpenSSL/EVP/Sign.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |Message signing using asymmetric cipher and message digest -- algorithm. This is an opposite of "OpenSSL.EVP.Verify". module OpenSSL.EVP.Sign @@ -21,7 +22,7 @@ import OpenSSL.EVP.Internal import OpenSSL.Utils -foreign import ccall unsafe "EVP_SignFinal" +foreign import capi unsafe "openssl/evp.h EVP_SignFinal" _SignFinal :: Ptr EVP_MD_CTX -> Ptr Word8 -> Ptr CUInt -> Ptr EVP_PKEY -> IO CInt diff --git a/OpenSSL/EVP/Verify.hs b/OpenSSL/EVP/Verify.hs --- a/OpenSSL/EVP/Verify.hs +++ b/OpenSSL/EVP/Verify.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |Message verification using asymmetric cipher and message digest -- algorithm. This is an opposite of "OpenSSL.EVP.Sign". module OpenSSL.EVP.Verify @@ -26,7 +27,7 @@ deriving (Show, Eq, Typeable) -foreign import ccall unsafe "EVP_VerifyFinal" +foreign import capi unsafe "openssl/evp.h EVP_VerifyFinal" _VerifyFinal :: Ptr EVP_MD_CTX -> Ptr CChar -> CUInt -> Ptr EVP_PKEY -> IO CInt diff --git a/OpenSSL/Objects.hsc b/OpenSSL/Objects.hsc --- a/OpenSSL/Objects.hsc +++ b/OpenSSL/Objects.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} module OpenSSL.Objects ( ObjNameType(..) , getObjNames @@ -12,15 +13,15 @@ type ObjName = Ptr OBJ_NAME -data OBJ_NAME +data {-# CTYPE "openssl/objects.h" "OBJ_NAME" #-} OBJ_NAME type DoAllCallback = ObjName -> Ptr () -> IO () -foreign import ccall safe "OBJ_NAME_do_all" +foreign import capi safe "openssl/objects.h OBJ_NAME_do_all" _NAME_do_all :: CInt -> FunPtr DoAllCallback -> Ptr () -> IO () -foreign import ccall safe "OBJ_NAME_do_all_sorted" +foreign import capi safe "openssl/objects.h OBJ_NAME_do_all_sorted" _NAME_do_all_sorted :: CInt -> FunPtr DoAllCallback -> Ptr () -> IO () foreign import ccall "wrapper" diff --git a/OpenSSL/PEM.hs b/OpenSSL/PEM.hs --- a/OpenSSL/PEM.hs +++ b/OpenSSL/PEM.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- |An interface to PEM routines. module OpenSSL.PEM ( -- * Password supply @@ -130,7 +131,7 @@ {- PKCS#8 -------------------------------------------------------------------- -} -foreign import ccall safe "PEM_write_bio_PKCS8PrivateKey" +foreign import capi safe "openssl/pem.h PEM_write_bio_PKCS8PrivateKey" _write_bio_PKCS8PrivateKey :: Ptr BIO_ -> Ptr EVP_PKEY -> Ptr EVP_CIPHER @@ -167,7 +168,7 @@ -> withCipherPtr cipher $ \ cipherPtr -> bracket (mkPemPasswordCallback $ callPasswordCB cb) freeHaskellFunPtr $ \cbPtr -> _write_bio_PKCS8PrivateKey bioPtr pkeyPtr cipherPtr nullPtr 0 cbPtr nullPtr - + Just (cipher, PwTTY) -> withCipherPtr cipher $ \ cipherPtr -> _write_bio_PKCS8PrivateKey bioPtr pkeyPtr cipherPtr nullPtr 0 nullFunPtr nullPtr @@ -191,7 +192,7 @@ bioRead mem -foreign import ccall safe "PEM_read_bio_PrivateKey" +foreign import capi safe "openssl/pem.h PEM_read_bio_PrivateKey" _read_bio_PrivateKey :: Ptr BIO_ -> Ptr (Ptr EVP_PKEY) -> FunPtr PemPasswordCallback' @@ -215,7 +216,7 @@ -> bracket (mkPemPasswordCallback $ callPasswordCB cb) freeHaskellFunPtr $ \cbPtr -> _read_bio_PrivateKey bioPtr nullPtr cbPtr nullPtr PwTTY - -> _read_bio_PrivateKey bioPtr nullPtr nullFunPtr nullPtr + -> _read_bio_PrivateKey bioPtr nullPtr nullFunPtr nullPtr failIfNull_ pkeyPtr fmap fromJust (wrapPKeyPtr pkeyPtr >>= fromPKey) @@ -228,10 +229,10 @@ {- Public Key ---------------------------------------------------------------- -} -foreign import ccall unsafe "PEM_write_bio_PUBKEY" +foreign import capi unsafe "openssl/pem.h PEM_write_bio_PUBKEY" _write_bio_PUBKEY :: Ptr BIO_ -> Ptr EVP_PKEY -> IO CInt -foreign import ccall unsafe "PEM_read_bio_PUBKEY" +foreign import capi unsafe "openssl/pem.h PEM_read_bio_PUBKEY" _read_bio_PUBKEY :: Ptr BIO_ -> Ptr (Ptr EVP_PKEY) -> FunPtr PemPasswordCallback' @@ -273,12 +274,12 @@ {- X.509 certificate --------------------------------------------------------- -} -foreign import ccall unsafe "PEM_write_bio_X509" +foreign import capi unsafe "openssl/pem.h PEM_write_bio_X509" _write_bio_X509 :: Ptr BIO_ -> Ptr X509_ -> IO CInt -foreign import ccall safe "PEM_read_bio_X509" +foreign import capi safe "openssl/pem.h PEM_read_bio_X509" _read_bio_X509 :: Ptr BIO_ -> Ptr (Ptr X509_) -> FunPtr PemPasswordCallback' @@ -318,17 +319,17 @@ {- PKCS#10 certificate request ----------------------------------------------- -} -foreign import ccall unsafe "PEM_write_bio_X509_REQ" +foreign import capi unsafe "openssl/pem.h PEM_write_bio_X509_REQ" _write_bio_X509_REQ :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt -foreign import ccall unsafe "PEM_write_bio_X509_REQ_NEW" +foreign import capi unsafe "openssl/pem.h PEM_write_bio_X509_REQ_NEW" _write_bio_X509_REQ_NEW :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt -foreign import ccall safe "PEM_read_bio_X509_REQ" +foreign import capi safe "openssl/pem.h PEM_read_bio_X509_REQ" _read_bio_X509_REQ :: Ptr BIO_ -> Ptr (Ptr X509_REQ) -> FunPtr PemPasswordCallback' @@ -383,12 +384,12 @@ {- Certificate Revocation List ----------------------------------------------- -} -foreign import ccall unsafe "PEM_write_bio_X509_CRL" +foreign import capi unsafe "openssl/pem.h PEM_write_bio_X509_CRL" _write_bio_X509_CRL :: Ptr BIO_ -> Ptr X509_CRL -> IO CInt -foreign import ccall safe "PEM_read_bio_X509_CRL" +foreign import capi safe "openssl/pem.h PEM_read_bio_X509_CRL" _read_bio_X509_CRL :: Ptr BIO_ -> Ptr (Ptr X509_CRL) -> FunPtr PemPasswordCallback' @@ -429,12 +430,12 @@ {- PKCS#7 -------------------------------------------------------------------- -} -foreign import ccall unsafe "PEM_write_bio_PKCS7" +foreign import capi unsafe "openssl/pem.h PEM_write_bio_PKCS7" _write_bio_PKCS7 :: Ptr BIO_ -> Ptr PKCS7 -> IO CInt -foreign import ccall safe "PEM_read_bio_PKCS7" +foreign import capi safe "openssl/pem.h PEM_read_bio_PKCS7" _read_bio_PKCS7 :: Ptr BIO_ -> Ptr (Ptr PKCS7) -> FunPtr PemPasswordCallback' @@ -473,12 +474,12 @@ {- DH parameters ------------------------------------------------------------- -} -foreign import ccall unsafe "PEM_write_bio_DHparams" +foreign import capi unsafe "openssl/pem.h PEM_write_bio_DHparams" _write_bio_DH :: Ptr BIO_ -> Ptr DH_ -> IO CInt -foreign import ccall safe "PEM_read_bio_DHparams" +foreign import capi safe "openssl/pem.h PEM_read_bio_DHparams" _read_bio_DH :: Ptr BIO_ -> Ptr (Ptr DH_) -> FunPtr PemPasswordCallback' @@ -518,4 +519,4 @@ flip finally (memset passPtr 0 $ fromIntegral passLen) $ act (castPtr passPtr, passLen) -foreign import ccall unsafe memset :: Ptr a -> CInt -> CSize -> IO () +foreign import capi unsafe "string.h memset" memset :: Ptr a -> CInt -> CSize -> IO () diff --git a/OpenSSL/PKCS7.hsc b/OpenSSL/PKCS7.hsc --- a/OpenSSL/PKCS7.hsc +++ b/OpenSSL/PKCS7.hsc @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# OPTIONS_HADDOCK prune #-} -- |An interface to PKCS#7 structure and S\/MIME message. module OpenSSL.PKCS7 @@ -46,7 +47,7 @@ -- very haskellish but please get it out of your mind since OpenSSL is -- written in C. newtype Pkcs7 = Pkcs7 (ForeignPtr PKCS7) -data PKCS7 +data {-# CTYPE "openssl/pkcs7.h" "PKCS7" #-} PKCS7 -- |@'Pkcs7Flag'@ is a set of flags that are used in many operations -- related to PKCS#7. @@ -93,22 +94,22 @@ flagListToInt = foldl' (.|.) 0 . map flagToInt -foreign import ccall "&PKCS7_free" +foreign import capi "openssl/pkcs7.h &PKCS7_free" _free :: FunPtr (Ptr PKCS7 -> IO ()) -foreign import ccall "HsOpenSSL_PKCS7_is_detached" +foreign import capi "HsOpenSSL.h HsOpenSSL_PKCS7_is_detached" _is_detached :: Ptr PKCS7 -> IO CLong -foreign import ccall "PKCS7_sign" +foreign import capi "openssl/pkcs7.h PKCS7_sign" _sign :: Ptr X509_ -> Ptr EVP_PKEY -> Ptr STACK -> Ptr BIO_ -> CInt -> IO (Ptr PKCS7) -foreign import ccall "PKCS7_verify" +foreign import capi "openssl/pkcs7.h PKCS7_verify" _verify :: Ptr PKCS7 -> Ptr STACK -> Ptr X509_STORE -> Ptr BIO_ -> Ptr BIO_ -> CInt -> IO CInt -foreign import ccall "PKCS7_encrypt" +foreign import capi "openssl/pkcs7.h PKCS7_encrypt" _encrypt :: Ptr STACK -> Ptr BIO_ -> Ptr EVP_CIPHER -> CInt -> IO (Ptr PKCS7) -foreign import ccall "PKCS7_decrypt" +foreign import capi "openssl/pkcs7.h PKCS7_decrypt" _decrypt :: Ptr PKCS7 -> Ptr EVP_PKEY -> Ptr X509_ -> Ptr BIO_ -> CInt -> IO CInt @@ -146,7 +147,7 @@ -- chain) -> String -- ^ data to be signed -> [Pkcs7Flag] -- ^ An optional set of flags: - -- + -- -- ['Pkcs7Text'] Many S\/MIME clients -- expect the signed content to include -- valid MIME headers. If the 'Pkcs7Text' @@ -230,7 +231,7 @@ -- present in the PKCS#7 structure -- (that is it is detached). -> [Pkcs7Flag] -- ^ An optional set of flags: - -- + -- -- ['Pkcs7NoIntern'] If -- 'Pkcs7NoIntern' is set the -- certificates in the message itself @@ -344,10 +345,10 @@ {- S/MIME -------------------------------------------------------------------- -} -foreign import ccall unsafe "SMIME_write_PKCS7" +foreign import capi unsafe "openssl/pkcs7.h SMIME_write_PKCS7" _SMIME_write_PKCS7 :: Ptr BIO_ -> Ptr PKCS7 -> Ptr BIO_ -> CInt -> IO CInt -foreign import ccall unsafe "SMIME_read_PKCS7" +foreign import capi unsafe "openssl/pkcs7.h SMIME_read_PKCS7" _SMIME_read_PKCS7 :: Ptr BIO_ -> Ptr (Ptr BIO_) -> IO (Ptr PKCS7) -- |@'writeSmime'@ writes PKCS#7 structure to S\/MIME message. diff --git a/OpenSSL/RSA.hsc b/OpenSSL/RSA.hsc --- a/OpenSSL/RSA.hsc +++ b/OpenSSL/RSA.hsc @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# OPTIONS_HADDOCK prune #-} -- |An interface to RSA public key generator. module OpenSSL.RSA @@ -58,7 +59,7 @@ -- RSAPubKey and RSAKeyPair are in fact the same type at the OpenSSL -- level, but we want to treat them differently for type-safety. -data RSA +data {-# CTYPE "openssl/rsa.h" "RSA" #-} RSA -- |@'RSAKey' a@ is either 'RSAPubKey' or 'RSAKeyPair'. class RSAKey k where @@ -114,16 +115,16 @@ -foreign import ccall unsafe "&RSA_free" +foreign import capi unsafe "openssl/rsa.h &RSA_free" _free :: FunPtr (Ptr RSA -> IO ()) -foreign import ccall unsafe "RSAPublicKey_dup" +foreign import capi unsafe "openssl/rsa.h RSAPublicKey_dup" _pubDup :: Ptr RSA -> IO (Ptr RSA) -foreign import ccall unsafe "RSAPrivateKey_dup" +foreign import capi unsafe "openssl/rsa.h RSAPrivateKey_dup" _privDup :: Ptr RSA -> IO (Ptr RSA) -foreign import ccall unsafe "RSA_size" +foreign import capi unsafe "openssl/rsa.h RSA_size" _size :: Ptr RSA -> IO CInt -- | Make a copy of the public parameters of the given key. @@ -160,7 +161,7 @@ foreign import ccall "wrapper" mkGenKeyCallback :: RSAGenKeyCallback' -> IO (FunPtr RSAGenKeyCallback') -foreign import ccall safe "RSA_generate_key" +foreign import capi safe "openssl/rsa.h RSA_generate_key" _generate_key :: CInt -> CInt -> FunPtr RSAGenKeyCallback' -> Ptr a -> IO (Ptr RSA) -- |@'generateRSAKey'@ generates an RSA keypair. @@ -203,13 +204,13 @@ #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "RSA_get0_key" +foreign import capi unsafe "openssl/rsa.h RSA_get0_key" _get0_key :: Ptr RSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO () -foreign import ccall unsafe "RSA_get0_factors" +foreign import capi unsafe "openssl/rsa.h RSA_get0_factors" _get0_factors :: Ptr RSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO () -foreign import ccall unsafe "RSA_get0_crt_params" +foreign import capi unsafe "openssl/rsa.h RSA_get0_crt_params" _get0_crt_params :: Ptr RSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO () withNED :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO b) diff --git a/OpenSSL/Random.hs b/OpenSSL/Random.hs --- a/OpenSSL/Random.hs +++ b/OpenSSL/Random.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} -- | PRNG services -- See -- For random Integer generation, see "OpenSSL.BN" @@ -13,13 +14,13 @@ import qualified Data.ByteString as BS import OpenSSL.Utils -foreign import ccall unsafe "RAND_bytes" +foreign import capi unsafe "openssl/rand.h RAND_bytes" _RAND_bytes :: Ptr CChar -> CInt -> IO CInt -foreign import ccall unsafe "RAND_pseudo_bytes" +foreign import capi unsafe "openssl/rand.h RAND_pseudo_bytes" _RAND_pseudo_bytes :: Ptr CChar -> CInt -> IO () -foreign import ccall unsafe "RAND_add" +foreign import capi unsafe "openssl/rand.h RAND_add" _RAND_add :: Ptr CChar -> CInt -> CInt -> IO () -- | Return a bytestring consisting of the given number of strongly random diff --git a/OpenSSL/SSL/Option.hsc b/OpenSSL/SSL/Option.hsc --- a/OpenSSL/SSL/Option.hsc +++ b/OpenSSL/SSL/Option.hsc @@ -23,7 +23,9 @@ | SSL_OP_NETSCAPE_CHALLENGE_BUG -- | As of OpenSSL 0.9.8q and 1.0.0c, this option has no effect. | SSL_OP_NETSCAPE_REUSE_CIPHER_CHANGE_BUG + -- | As of OpenSSL 1.0.1h and 1.0.2, this option has no effect. | SSL_OP_SSLREF2_REUSE_CERT_TYPE_BUG + -- | As of OpenSSL 1.1.0 this option has no effect. | SSL_OP_MICROSOFT_BIG_SSLV3_BUFFER #if defined(SSL_OP_SAFARI_ECDHE_ECDSA_BUG) -- | Don't prefer ECDHE-ECDSA ciphers when the client appears to @@ -31,8 +33,11 @@ -- ECDHE-ECDSA ciphers. | SSL_OP_SAFARI_ECDHE_ECDSA_BUG #endif + -- | As of OpenSSL 1.1.0 this option has no effect. | SSL_OP_SSLEAY_080_CLIENT_DH_BUG + -- | As of OpenSSL 1.1.0 this option has no effect. | SSL_OP_TLS_D5_BUG + -- | As of OpenSSL 1.1.0 this option has no effect. | SSL_OP_TLS_BLOCK_PADDING_BUG #if defined(SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS) -- | Disables a countermeasure against a SSL 3.0/TLS 1.0 @@ -47,7 +52,7 @@ -- a workaround for some implementations. | SSL_OP_TLSEXT_PADDING #endif - -- | All of the above bug workarounds. + -- | Default set of options | SSL_OP_ALL #if defined(SSL_OP_TLS_ROLLBACK_BUG) -- | Disable version rollback attack detection. @@ -63,25 +68,9 @@ -- the version rollback protection.) | SSL_OP_TLS_ROLLBACK_BUG #endif - -- | Always create a new key when using temporary/ephemeral DH - -- parameters. This option must be used to prevent small - -- subgroup attacks, when the DH parameters were not generated - -- using \"strong\" primes (e.g. when using DSA-parameters). If - -- \"strong\" primes were used, it is not strictly necessary to - -- generate a new DH key during each handshake but it is also - -- recommended. 'SSL_OP_SINGLE_DH_USE' should therefore be enabled - -- whenever temporary/ephemeral DH parameters are used. + -- | As of OpenSSL 1.1.0 this option has no effect. | SSL_OP_SINGLE_DH_USE - -- | Always use ephemeral (temporary) RSA key when doing RSA - -- operations. According to the specifications this is only - -- done, when a RSA key can only be used for signature - -- operations (namely under export ciphers with restricted RSA - -- keylength). By setting this option, ephemeral RSA keys are - -- always used. This option breaks compatibility with the - -- SSL/TLS specifications and may lead to interoperability - -- problems with clients and should therefore never be - -- used. Ciphers with DHE (ephemeral Diffie-Hellman) key - -- exchange should be used instead. + -- | As of OpenSSL 1.0.1k and 1.0.2, this option has no effect. | SSL_OP_EPHEMERAL_RSA #if defined(SSL_OP_CIPHER_SERVER_PREFERENCE) -- | When choosing a cipher, use the server's preferences @@ -93,20 +82,37 @@ -- the client chooses. | SSL_OP_CIPHER_SERVER_PREFERENCE #endif + -- | As of OpenSSL 1.0.1 this option has no effect. | SSL_OP_PKCS1_CHECK_1 + -- | As of OpenSSL 1.0.1 this option has no effect. | SSL_OP_PKCS1_CHECK_2 - -- | If we accept a netscape connection, demand a client cert, - -- have a non-self-signed CA which does not have its CA in - -- netscape, and the browser has a cert, it will - -- crash/hang. Works for 3.x and 4.xbeta + -- | As of OpenSSL 1.1.0 this option has no effect. | SSL_OP_NETSCAPE_CA_DN_BUG + -- | As of OpenSSL 1.1.0 this option has no effect. | SSL_OP_NETSCAPE_DEMO_CIPHER_CHANGE_BUG - -- | Do not use the SSLv2 protocol. + -- | As of OpenSSL 1.1.0 this option has no effect. | SSL_OP_NO_SSLv2 -- | Do not use the SSLv3 protocol. + -- As of OpenSSL 1.1.0, this option is deprecated | SSL_OP_NO_SSLv3 -- | Do not use the TLSv1 protocol. + -- As of OpenSSL 1.1.0, this option is deprecated | SSL_OP_NO_TLSv1 + -- | Do not use the TLSv1.1 protocol. + -- As of OpenSSL 1.1.0, this option is deprecated + | SSL_OP_NO_TLSv1_1 + -- | Do not use the TLSv1.2 protocol. + -- As of OpenSSL 1.1.0, this option is deprecated + | SSL_OP_NO_TLSv1_2 + -- | Do not use the TLSv1.3 protocol. + -- As of OpenSSL 1.1.0, this option is deprecated + | SSL_OP_NO_TLSv1_3 + -- | Do not use the DTLSv1 protocol. + -- As of OpenSSL 1.1.0, this option is deprecated + | SSL_OP_NO_DTLSv1 + -- | Do not use the DTLSv1.2 protocol. + -- As of OpenSSL 1.1.0, this option is deprecated + | SSL_OP_NO_DTLSv1_2 #if defined(SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION) -- | When performing renegotiation as a server, always start a -- new session (i.e., session resumption requests are only @@ -136,6 +142,41 @@ -- for more details. | SSL_OP_LEGACY_SERVER_CONNECT #endif +#if defined(SSL_OP_NO_EXTENDED_MASTER_SECRET) + -- | Disable Extended master secret. + -- Only available on OpenSSL 3.0.0 and later. + | SSL_OP_NO_EXTENDED_MASTER_SECRET +#endif +#if defined(SSL_OP_CLEANSE_PLAINTEXT) + -- | Cleanse plaintext copies of data. + -- Only available on OpenSSL 3.0.0 and later. + | SSL_OP_CLEANSE_PLAINTEXT +#endif +#if defined(SSL_OP_ENABLE_KTLS) + -- | Enble support for Kernel TLS + -- Only available on OpenSSL 3.0.0 and later + | SSL_OP_ENABLE_KTLS +#endif +#if defined(SSL_OP_IGNORE_UNEXPECTED_EOF) + | SSL_OP_IGNORE_UNEXPECTED_EOF +#endif +#if defined(SSL_OP_ALLOW_CLIENT_RENEGOTIATION) + | SSL_OP_ALLOW_CLIENT_RENEGOTIATION +#endif +#if defined(SSL_OP_DISABLE_TLSEXT_CA_NAMES) + | SSL_OP_DISABLE_TLSEXT_CA_NAMES +#endif + | SSL_OP_CISCO_ANYCONNECT + | SSL_OP_NO_ANTI_REPLAY + | SSL_OP_PRIORITIZE_CHACHA + | SSL_OP_ALLOW_NO_DHE_KEX + | SSL_OP_NO_ENCRYPT_THEN_MAC + | SSL_OP_NO_QUERY_MTU + | SSL_OP_COOKIE_EXCHANGE + | SSL_OP_NO_COMPRESSION + | SSL_OP_ENABLE_MIDDLEBOX_COMPAT + | SSL_OP_NO_RENEGOTIATION + | SSL_OP_CRYPTOPRO_TLSEXT_BUG deriving (Eq, Ord, Show, Typeable) optionToIntegral :: Integral a => SSLOption -> a @@ -172,6 +213,17 @@ optionToIntegral SSL_OP_NO_SSLv2 = #const SSL_OP_NO_SSLv2 optionToIntegral SSL_OP_NO_SSLv3 = #const SSL_OP_NO_SSLv3 optionToIntegral SSL_OP_NO_TLSv1 = #const SSL_OP_NO_TLSv1 +optionToIntegral SSL_OP_NO_TLSv1_1 = #const SSL_OP_NO_TLSv1_1 +optionToIntegral SSL_OP_NO_TLSv1_2 = #const SSL_OP_NO_TLSv1_2 +#if defined(SSL_OP_NO_TLSv1_3) +optionToIntegral SSL_OP_NO_TLSv1_3 = #const SSL_OP_NO_TLSv1_3 +#endif +#if defined(SSL_OP_NO_DTLSv1) +optionToIntegral SSL_OP_NO_DTLSv1 = #const SSL_OP_NO_DTLSv1 +#endif +#if defined(SSL_OP_NO_DTLSv1_2) +optionToIntegral SSL_OP_NO_DTLSv1_2 = #const SSL_OP_NO_DTLSv1_2 +#endif #if defined(SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION) optionToIntegral SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION = #const SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION #endif @@ -182,3 +234,32 @@ #if defined(SSL_OP_LEGACY_SERVER_CONNECT) optionToIntegral SSL_OP_LEGACY_SERVER_CONNECT = #const SSL_OP_LEGACY_SERVER_CONNECT #endif +#if defined(SSL_OP_NO_EXTENDED_MASTER_SECRET) +optionToIntegral SSL_OP_NO_EXTENDED_MASTER_SECRET = #const SSL_OP_NO_EXTENDED_MASTER_SECRET +#endif +#if defined(SSL_OP_CLEANSE_PLAINTEXT) +optionToIntegral SSL_OP_CLEANSE_PLAINTEXT = #const SSL_OP_CLEANSE_PLAINTEXT +#endif +#if defined(SSL_OP_ENABLE_KTLS) +optionToIntegral SSL_OP_ENABLE_KTLS = #const SSL_OP_ENABLE_KTLS +#endif +#if defined(SSL_OP_IGNORE_UNEXPECTED_EOF) +optionToIntegral SSL_OP_IGNORE_UNEXPECTED_EOF = #const SSL_OP_IGNORE_UNEXPECTED_EOF +#endif +#if defined(SSL_OP_ALLOW_CLIENT_RENEGOTIATION) +optionToIntegral SSL_OP_ALLOW_CLIENT_RENEGOTIATION = #const SSL_OP_ALLOW_CLIENT_RENEGOTIATION +#endif +#if defined(SSL_OP_DISABLE_TLSEXT_CA_NAMES) +optionToIntegral SSL_OP_DISABLE_TLSEXT_CA_NAMES = #const SSL_OP_DISABLE_TLSEXT_CA_NAMES +#endif +optionToIntegral SSL_OP_NO_ANTI_REPLAY = #const SSL_OP_NO_ANTI_REPLAY +optionToIntegral SSL_OP_PRIORITIZE_CHACHA = #const SSL_OP_PRIORITIZE_CHACHA +optionToIntegral SSL_OP_ENABLE_MIDDLEBOX_COMPAT = #const SSL_OP_ENABLE_MIDDLEBOX_COMPAT +optionToIntegral SSL_OP_NO_ENCRYPT_THEN_MAC = #const SSL_OP_NO_ENCRYPT_THEN_MAC +optionToIntegral SSL_OP_ALLOW_NO_DHE_KEX = #const SSL_OP_ALLOW_NO_DHE_KEX +optionToIntegral SSL_OP_NO_QUERY_MTU = #const SSL_OP_NO_QUERY_MTU +optionToIntegral SSL_OP_COOKIE_EXCHANGE = #const SSL_OP_COOKIE_EXCHANGE +optionToIntegral SSL_OP_NO_COMPRESSION = #const SSL_OP_NO_COMPRESSION +optionToIntegral SSL_OP_NO_RENEGOTIATION = #const SSL_OP_NO_RENEGOTIATION +optionToIntegral SSL_OP_CRYPTOPRO_TLSEXT_BUG = #const SSL_OP_CRYPTOPRO_TLSEXT_BUG +optionToIntegral SSL_OP_CISCO_ANYCONNECT = #const SSL_OP_CISCO_ANYCONNECT diff --git a/OpenSSL/Session.hsc b/OpenSSL/Session.hsc --- a/OpenSSL/Session.hsc +++ b/OpenSSL/Session.hsc @@ -5,6 +5,7 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | Functions for handling SSL connections. These functions use GHC specific @@ -26,9 +27,13 @@ , contextCheckPrivateKey , VerificationMode(..) , contextSetVerificationMode + , contextSetDefaultVerifyPaths , contextSetCAFile , contextSetCADirectory , contextGetCAStore + , contextSetSessionIdContext + , contextSetALPNProtos + , withContextSetKeylogCallback -- * SSL connections , SSL @@ -38,6 +43,7 @@ , addOption , removeOption , setTlsextHostName + , enableHostnameValidation , accept , tryAccept , connect @@ -76,7 +82,7 @@ ) where -#include "openssl/ssl.h" +#include "HsOpenSSL.h" import Prelude hiding ( #if !MIN_VERSION_base(4,6,0) @@ -101,7 +107,11 @@ import qualified Data.ByteString.Lazy.Internal as L import System.IO.Unsafe import System.Posix.Types (Fd(..)) -import Network.Socket (Socket(..)) +#if MIN_VERSION_network(3,1,0) +import Network.Socket (Socket, withFdSocket) +#else +import Network.Socket (Socket, fdSocket) +#endif #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<$)) @@ -121,7 +131,7 @@ foreign import ccall "wrapper" mkVerifyCb :: VerifyCb -> IO (FunPtr VerifyCb) -data SSLContext_ +data {-# CTYPE "openssl/ssl.h" "SSL_CTX" #-} SSLContext_ -- | An SSL context. Contexts carry configuration such as a server's private -- key, root CA certiifcates etc. Contexts are stateful IO objects; they -- start empty and various options are set on them by the functions in this @@ -132,14 +142,14 @@ } deriving Typeable -data SSLMethod_ +data {-# CTYPE "openssl/ssl.h" "const SSL_METHOD" #-} SSLMethod_ -foreign import ccall unsafe "SSL_CTX_new" _ssl_ctx_new :: Ptr SSLMethod_ -> IO (Ptr SSLContext_) -foreign import ccall unsafe "SSL_CTX_free" _ssl_ctx_free :: Ptr SSLContext_ -> IO () +foreign import capi unsafe "openssl/ssl.h SSL_CTX_new" _ssl_ctx_new :: Ptr SSLMethod_ -> IO (Ptr SSLContext_) +foreign import capi unsafe "openssl/ssl.h SSL_CTX_free" _ssl_ctx_free :: Ptr SSLContext_ -> IO () #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "TLS_method" _ssl_method :: IO (Ptr SSLMethod_) +foreign import capi unsafe "openssl/ssl.h TLS_method" _ssl_method :: IO (Ptr SSLMethod_) #else -foreign import ccall unsafe "SSLv23_method" _ssl_method :: IO (Ptr SSLMethod_) +foreign import capi unsafe "openssl/ssl.h SSLv23_method" _ssl_method :: IO (Ptr SSLMethod_) #endif -- | Create a new SSL context. @@ -165,10 +175,10 @@ touchContext :: SSLContext -> IO () touchContext = (>> return ()) . isEmptyMVar . ctxMVar -foreign import ccall unsafe "HsOpenSSL_SSL_CTX_set_options" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_SSL_CTX_set_options" _SSL_CTX_set_options :: Ptr SSLContext_ -> CLong -> IO CLong -foreign import ccall unsafe "HsOpenSSL_SSL_CTX_clear_options" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_SSL_CTX_clear_options" _SSL_CTX_clear_options :: Ptr SSLContext_ -> CLong -> IO CLong -- | Add a protocol option to the context. @@ -192,9 +202,9 @@ unless (result == 1) $ f ctx cpath (#const SSL_FILETYPE_ASN1) >>= failIf_ (/= 1) -foreign import ccall unsafe "SSL_CTX_use_PrivateKey" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_use_PrivateKey" _ssl_ctx_use_privatekey :: Ptr SSLContext_ -> Ptr EVP_PKEY -> IO CInt -foreign import ccall unsafe "SSL_CTX_use_certificate" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_use_certificate" _ssl_ctx_use_certificate :: Ptr SSLContext_ -> Ptr X509_ -> IO CInt -- | Install a private key into a context. @@ -213,9 +223,9 @@ _ssl_ctx_use_certificate ctx certPtr >>= failIf_ (/= 1) -foreign import ccall unsafe "SSL_CTX_use_PrivateKey_file" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_use_PrivateKey_file" _ssl_ctx_use_privatekey_file :: Ptr SSLContext_ -> CString -> CInt -> IO CInt -foreign import ccall unsafe "SSL_CTX_use_certificate_file" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_use_certificate_file" _ssl_ctx_use_certificate_file :: Ptr SSLContext_ -> CString -> CInt -> IO CInt -- | Install a private key file in a context. The key is given as a path to the @@ -230,7 +240,7 @@ contextSetCertificateFile :: SSLContext -> FilePath -> IO () contextSetCertificateFile = contextLoadFile _ssl_ctx_use_certificate_file -foreign import ccall unsafe "SSL_CTX_use_certificate_chain_file" +foreign import capi unsafe "openssl/ssl.h 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 @@ -243,12 +253,12 @@ withCString path $ \cpath -> _ssl_ctx_use_certificate_chain_file ctx cpath >>= failIf_ (/= 1) -foreign import ccall unsafe "SSL_CTX_set_cipher_list" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_set_cipher_list" _ssl_ctx_set_cipher_list :: Ptr SSLContext_ -> CString -> IO CInt -- | Set the ciphers to be used by the given context. The string argument is a -- list of ciphers, comma separated, as given at --- http://www.openssl.org/docs/apps/ciphers.html +-- . -- -- Unrecognised ciphers are ignored. If no ciphers from the list are -- recognised, an exception is raised. @@ -258,10 +268,11 @@ withCString list $ \cpath -> _ssl_ctx_set_cipher_list ctx cpath >>= failIf_ (/= 1) +-- | Set the ciphers to "DEFAULT". contextSetDefaultCiphers :: SSLContext -> IO () contextSetDefaultCiphers = flip contextSetCiphers "DEFAULT" -foreign import ccall unsafe "SSL_CTX_check_private_key" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_check_private_key" _ssl_ctx_check_private_key :: Ptr SSLContext_ -> IO CInt -- | Return true iff the private key installed in the given context matches the @@ -280,7 +291,7 @@ } deriving Typeable -foreign import ccall unsafe "SSL_CTX_set_verify" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_set_verify" _ssl_set_verify_mode :: Ptr SSLContext_ -> CInt -> FunPtr VerifyCb -> IO () contextSetVerificationMode :: SSLContext -> VerificationMode -> IO () @@ -302,7 +313,28 @@ _ssl_set_verify_mode ctx mode $ fromMaybe nullFunPtr newCb return () -foreign import ccall unsafe "SSL_CTX_load_verify_locations" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_set_default_verify_paths" + _ssl_set_default_verify_paths :: Ptr SSLContext_ -> IO CInt + +-- | Specifies that the default locations from which CA certificates are loaded +-- should be used. There is one default directory and one default file. +-- +-- The default CA certificates directory is called "certs" in the default OpenSSL +-- directory. Alternatively the SSL_CERT_DIR environment variable can be defined +-- to override this location. +-- +-- The default CA certificates file is called "cert.pem" in the default OpenSSL +-- directory. Alternatively the SSL_CERT_FILE environment +-- variable can be defined to override this location. +-- +-- See for +-- more information. +contextSetDefaultVerifyPaths :: SSLContext -> IO () +contextSetDefaultVerifyPaths context = + withContext context $ \ctx -> + _ssl_set_default_verify_paths ctx >>= failIf_ (/= 1) + +foreign import capi unsafe "openssl/ssl.h SSL_CTX_load_verify_locations" _ssl_load_verify_locations :: Ptr SSLContext_ -> Ptr CChar -> Ptr CChar -> IO CInt -- | Set the location of a PEM encoded list of CA certificates to be used when @@ -323,7 +355,7 @@ withCString path $ \cpath -> _ssl_load_verify_locations ctx nullPtr cpath >>= failIf_ (/= 1) -foreign import ccall unsafe "SSL_CTX_get_cert_store" +foreign import capi unsafe "openssl/ssl.h SSL_CTX_get_cert_store" _ssl_get_cert_store :: Ptr SSLContext_ -> IO (Ptr X509_STORE) -- | Get a reference to, not a copy of, the X.509 certificate storage @@ -334,8 +366,56 @@ _ssl_get_cert_store ctx >>= wrapX509Store (touchContext context) +foreign import capi unsafe "openssl/ssl.h SSL_CTX_set_session_id_context" + _ssl_set_session_id_context :: Ptr SSLContext_ -> Ptr CChar -> CUInt -> IO CInt -data SSL_ +-- | Set context within which session can be reused (server side only). +-- +-- If client certificates are used and the session id context is not set, +-- attempts by the clients to reuse a session will make the handshake fail. +contextSetSessionIdContext :: SSLContext -> B.ByteString -> IO () +contextSetSessionIdContext context idCtx = + withContext context $ \ctx -> + B.unsafeUseAsCStringLen idCtx $ \(cIdCtx, len) -> + _ssl_set_session_id_context ctx cIdCtx (fromIntegral len) >>= failIf_ (/= 1) + +foreign import capi unsafe "openssl/ssl.h SSL_CTX_set_alpn_protos" + _ssl_set_alpn_protos :: Ptr SSLContext_ -> Ptr CChar -> CUInt -> IO CInt + +contextSetALPNProtos :: SSLContext -> [B.ByteString] -> IO () +contextSetALPNProtos context protos = + withContext context $ \ctx -> do + -- Protos need to be wire-format as documented here: + -- https://www.openssl.org/docs/man1.0.2/man3/SSL_CTX_set_alpn_protos.html#NOTES + let formattedProtos = B.concat $ map (\p -> B.cons (fromIntegral (B.length p)) p) protos + B.unsafeUseAsCStringLen formattedProtos $ \(cFormattedProtos, len) -> + -- This function breaks the convention of returning '1' for success: + -- https://www.openssl.org/docs/man1.0.2/man3/SSL_CTX_set_alpn_protos.html#RETURN-VALUES + _ssl_set_alpn_protos ctx cFormattedProtos (fromIntegral len) >>= failIf_ (/= 0) + +type KeylogCb = Ptr SSL_ -> CString -> IO () + +foreign import ccall "wrapper" mkKeylogCb :: KeylogCb -> IO (FunPtr KeylogCb) + +foreign import capi "openssl/ssl.h SSL_CTX_set_keylog_callback" _ssl_ctx_set_keylog_callback :: Ptr SSLContext_ -> FunPtr KeylogCb -> IO () + +-- | The key logging callback is called with a String "line". The line is a +-- string containing the key material in the format used by NSS for its +-- SSLKEYLOGFILE debugging output. To recreate that file, the key logging +-- callback should log line, followed by a newline. +-- +-- FIXME: Not re-entrant (ignores previous callback and resets it to +-- nullFunPtr on exit) +withContextSetKeylogCallback :: SSLContext -> (String -> IO ()) -> IO a -> IO a +withContextSetKeylogCallback context cb action = do + -- There doesn't seem to be a way to go from 'Ptr SSL_' to 'SSL', so let's + -- just ignore it in the haskell callback. + bracket + (mkKeylogCb $ \_ssl line -> (cb =<< peekCString line)) + (\cbPtr -> withContext context (flip _ssl_ctx_set_keylog_callback nullFunPtr) >> freeHaskellFunPtr cbPtr) + (\cbPtr -> withContext context (flip _ssl_ctx_set_keylog_callback cbPtr) >> action) + +data {-# CTYPE "openssl/ssl.h" "SSL" #-} SSL_ -- | This is the type of an SSL connection -- -- IO with SSL objects is non-blocking and many SSL functions return a error @@ -351,9 +431,9 @@ } deriving Typeable -foreign import ccall unsafe "SSL_new" _ssl_new :: Ptr SSLContext_ -> IO (Ptr SSL_) -foreign import ccall unsafe "SSL_free" _ssl_free :: Ptr SSL_ -> IO () -foreign import ccall unsafe "SSL_set_fd" _ssl_set_fd :: Ptr SSL_ -> CInt -> IO () +foreign import capi unsafe "openssl/ssl.h SSL_new" _ssl_new :: Ptr SSLContext_ -> IO (Ptr SSL_) +foreign import capi unsafe "openssl/ssl.h SSL_free" _ssl_free :: Ptr SSL_ -> IO () +foreign import capi unsafe "openssl/ssl.h SSL_set_fd" _ssl_set_fd :: Ptr SSL_ -> CInt -> IO () connection' :: SSLContext -> Fd -> Maybe Socket -> IO SSL connection' context fd@(Fd fdInt) sock = do @@ -380,8 +460,17 @@ -- carries a handle to the Socket so you need not worry about the garbage -- collector closing the file descriptor out from under you. connection :: SSLContext -> Socket -> IO SSL -connection context sock@(MkSocket fd _ _ _ _) = +connection context sock = do +#if MIN_VERSION_network(3,1,0) + withFdSocket sock $ \ fd -> connection' context (Fd fd) (Just sock) +#else +#if MIN_VERSION_network(3,0,0) + fd <- fdSocket sock +#else + let fd = fdSocket sock +#endif connection' context (Fd fd) (Just sock) +#endif -- | Wrap a socket Fd in an SSL connection. fdConnection :: SSLContext -> Fd -> IO SSL @@ -391,13 +480,13 @@ withSSL :: SSL -> (Ptr SSL_ -> IO a) -> IO a withSSL = withMVar . sslMVar -foreign import ccall unsafe "HsOpenSSL_SSL_set_options" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_SSL_set_options" _SSL_set_options :: Ptr SSL_ -> CLong -> IO CLong -foreign import ccall unsafe "HsOpenSSL_SSL_clear_options" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_SSL_clear_options" _SSL_clear_options :: Ptr SSL_ -> CLong -> IO CLong -foreign import ccall unsafe "HsOpenSSL_SSL_set_tlsext_host_name" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_SSL_set_tlsext_host_name" _SSL_set_tlsext_host_name :: Ptr SSL_ -> CString -> IO CLong -- | Add a protocol option to the SSL connection. @@ -419,20 +508,73 @@ withCString h $ \ hPtr -> _SSL_set_tlsext_host_name sslPtr hPtr >> return () -foreign import ccall "SSL_accept" _ssl_accept :: Ptr SSL_ -> IO CInt -foreign import ccall "SSL_connect" _ssl_connect :: Ptr SSL_ -> IO CInt -foreign import ccall unsafe "SSL_get_error" _ssl_get_error :: Ptr SSL_ -> CInt -> IO CInt +-- Hostname validation, inspired by https://wiki.openssl.org/index.php/Hostname_validation -throwSSLException :: String -> CInt -> IO a -throwSSLException loc ret +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_enable_hostname_validation" + _enable_hostname_validation :: Ptr SSL_ -> CString -> CSize -> IO CInt + +-- | Enable hostname validation. Also see 'setTlsextHostName'. +-- +-- This uses the built-in mechanism introduced in 1.0.2/1.1.0, and will +-- fail otherwise. +enableHostnameValidation :: SSL -> String -> IO () +enableHostnameValidation ssl host = + withSSL ssl $ \ssl -> + withCStringLen host $ \(host, hostLen) -> + _enable_hostname_validation ssl host (fromIntegral hostLen) >>= failIf_ (/= 1) + +foreign import capi "openssl/ssl.h SSL_accept" _ssl_accept :: Ptr SSL_ -> IO CInt +foreign import capi "openssl/ssl.h SSL_connect" _ssl_connect :: Ptr SSL_ -> IO CInt +foreign import capi unsafe "openssl/ssl.h SSL_get_error" _ssl_get_error :: Ptr SSL_ -> CInt -> IO CInt + +throwSSLException :: String -> CInt -> CInt -> IO a +throwSSLException loc sslErr ret = do e <- getError if e == 0 then case ret of - 0 -> throwIO ConnectionAbruptlyTerminated - _ -> throwErrno loc + 0 -> + throwIO ConnectionAbruptlyTerminated + -- empty error queue and ret==0 meant EOF in older versions + -- of OpenSSL + -- https://github.com/openssl/openssl/commit/beacb0f0c1ae7b0542fe053b95307f515b578eb7 + _ -> do + errno <- getErrno + if errno == eOK then + if sslErr == (#const SSL_ERROR_SYSCALL) then + -- newer OpenSSL versions have bug: + -- SSL_ERROR_SYSCALL with errno=0 means unexpected EOF + -- from the peer + throwIO ConnectionAbruptlyTerminated + else + throwIO $ ProtocolError $ loc ++ ": " + ++ sslErrorString sslErr + else + throwErrno loc else errorString e >>= throwIO . ProtocolError +sslErrorString :: CInt -> String +sslErrorString e = case e of + (#const SSL_ERROR_NONE) -> "SSL_ERROR_NONE" + (#const SSL_ERROR_ZERO_RETURN) -> "SSL_ERROR_ZERO_RETURN" + (#const SSL_ERROR_WANT_READ) -> "SSL_ERROR_WANT_READ" + (#const SSL_ERROR_WANT_WRITE) -> "SSL_ERROR_WANT_WRITE" + (#const SSL_ERROR_WANT_CONNECT) -> "SSL_ERROR_WANT_CONNECT" + (#const SSL_ERROR_WANT_ACCEPT) -> "SSL_ERROR_WANT_ACCEPT" + (#const SSL_ERROR_WANT_X509_LOOKUP) -> "SSL_ERROR_WANT_X509_LOOKUP" +#if defined(SSL_ERROR_WANT_ASYNC) + (#const SSL_ERROR_WANT_ASYNC) -> "SSL_ERROR_WANT_ASYNC" +#endif +#if defined(SSL_ERROR_WANT_ASYNC_JOB) + (#const SSL_ERROR_WANT_ASYNC_JOB) -> "SSL_ERROR_WANT_ASYNC_JOB" +#endif +#if defined(SSL_ERROR_WANT_CLIENT_HELLO_CB) + (#const SSL_ERROR_WANT_CLIENT_HELLO_CB) -> "SSL_ERROR_WANT_CLIENT_HELLO_CB" +#endif + (#const SSL_ERROR_SYSCALL) -> "SSL_ERROR_SYSCALL" + (#const SSL_ERROR_SSL) -> "SSL_ERROR_SSL" + _ -> "Unknown SSL error: " ++ show e + -- | This is the type of an SSL IO operation. Errors are handled by -- exceptions while everything else is one of these. Note that reading -- from an SSL socket can result in WantWrite and vice versa. @@ -468,7 +610,7 @@ case err of (#const SSL_ERROR_WANT_READ ) -> return WantRead (#const SSL_ERROR_WANT_WRITE) -> return WantWrite - _ -> throwSSLException loc n + _ -> throwSSLException loc err n -- | Perform an SSL server handshake accept :: SSL -> IO () @@ -488,8 +630,8 @@ tryConnect ssl = (() <$) <$> sslTryHandshake "SSL_connect" _ssl_connect ssl -foreign import ccall "SSL_read" _ssl_read :: Ptr SSL_ -> Ptr Word8 -> CInt -> IO CInt -foreign import ccall unsafe "SSL_get_shutdown" _ssl_get_shutdown :: Ptr SSL_ -> IO CInt +foreign import capi "openssl/ssl.h SSL_read" _ssl_read :: Ptr SSL_ -> Ptr Word8 -> CInt -> IO CInt +foreign import capi unsafe "openssl/ssl.h SSL_get_shutdown" _ssl_get_shutdown :: Ptr SSL_ -> IO CInt -- | Perform an SSL operation which operates of a buffer and can return -- non-blocking error codes, thus requesting that it be performed again when @@ -518,16 +660,22 @@ (#const SSL_ERROR_ZERO_RETURN) -> return $ SSLDone $ 0 (#const SSL_ERROR_WANT_READ ) -> return WantRead (#const SSL_ERROR_WANT_WRITE ) -> return WantWrite - _ -> throwSSLException loc n + _ -> throwSSLException loc err n -- | Try to read the given number of bytes from an SSL connection. On EOF an -- empty ByteString is returned. If the connection dies without a graceful -- SSL shutdown, an exception is raised. +-- +-- NOTE: The returned bytestring could be shorter than the size requested, see: +-- https://www.openssl.org/docs/man3.0/man3/SSL_read.html read :: SSL -> Int -> IO B.ByteString read ssl nBytes = sslBlock (`tryRead` nBytes) ssl -- | Try to read the given number of bytes from an SSL connection -- without blocking. +-- +-- NOTE: The returned bytestring could be shorter than the size requested, see: +-- https://www.openssl.org/docs/man3.0/man3/SSL_read.html tryRead :: SSL -> Int -> IO (SSLResult B.ByteString) tryRead ssl nBytes = do (bs, result) <- B.createAndTrim' nBytes $ \bufPtr -> @@ -549,7 +697,7 @@ fmap (fmap fromIntegral) (sslIOInner "SSL_read" _ssl_read (castPtr bufPtr) nBytes ssl) -foreign import ccall "SSL_write" _ssl_write :: Ptr SSL_ -> Ptr Word8 -> CInt -> IO CInt +foreign import capi "openssl/ssl.h SSL_write" _ssl_write :: Ptr SSL_ -> Ptr Word8 -> CInt -> IO CInt -- | Write a given ByteString to the SSL connection. Either all the data is -- written or an exception is raised because of an error. @@ -605,7 +753,7 @@ lazyWrite ssl lbs = mapM_ (write ssl) $ L.toChunks lbs -foreign import ccall "SSL_shutdown" _ssl_shutdown :: Ptr SSL_ -> IO CInt +foreign import capi "openssl/ssl.h SSL_shutdown" _ssl_shutdown :: Ptr SSL_ -> IO CInt data ShutdownType = Bidirectional -- ^ wait for the peer to also shutdown | Unidirectional -- ^ only send our shutdown @@ -660,12 +808,15 @@ (#const SSL_ERROR_SYSCALL) -> do sd <- _ssl_get_shutdown sslPtr if sd .&. (#const SSL_RECEIVED_SHUTDOWN) == 0 then - throwSSLException "SSL_shutdown" n + throwSSLException "SSL_shutdown" err n else return $ SSLDone () - _ -> throwSSLException "SSL_shutdown" n - -foreign import ccall "SSL_get_peer_certificate" _ssl_get_peer_cert :: Ptr SSL_ -> IO (Ptr X509_) + _ -> throwSSLException "SSL_shutdown" err n +#if OPENSSL_VERSION_PREREQ(3,0) +foreign import capi "openssl/ssl.h SSL_get1_peer_certificate" _ssl_get_peer_cert :: Ptr SSL_ -> IO (Ptr X509_) +#else +foreign import capi "openssl/ssl.h SSL_get_peer_certificate" _ssl_get_peer_cert :: Ptr SSL_ -> IO (Ptr X509_) +#endif -- | After a successful connection, get the certificate of the other party. If -- this is a server connection, you probably won't get a certificate unless @@ -678,7 +829,7 @@ then return Nothing else fmap Just (wrapX509 cert) -foreign import ccall "SSL_get_verify_result" _ssl_get_verify_result :: Ptr SSL_ -> IO CLong +foreign import capi "openssl/ssl.h SSL_get_verify_result" _ssl_get_verify_result :: Ptr SSL_ -> IO CLong -- | Get the result of verifing the peer's certificate. This is mostly for -- clients to verify the certificate of the server that they have connected diff --git a/OpenSSL/Stack.hsc b/OpenSSL/Stack.hsc --- a/OpenSSL/Stack.hsc +++ b/OpenSSL/Stack.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} module OpenSSL.Stack ( STACK , mapStack @@ -17,34 +18,34 @@ #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "OPENSSL_sk_new_null" +foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_new_null" skNewNull :: IO (Ptr STACK) -foreign import ccall unsafe "OPENSSL_sk_free" +foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_free" skFree :: Ptr STACK -> IO () -foreign import ccall unsafe "OPENSSL_sk_push" +foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_push" skPush :: Ptr STACK -> Ptr () -> IO () -foreign import ccall unsafe "OPENSSL_sk_num" +foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_num" skNum :: Ptr STACK -> IO CInt -foreign import ccall unsafe "OPENSSL_sk_value" +foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_value" skValue :: Ptr STACK -> CInt -> IO (Ptr ()) #else -foreign import ccall unsafe "sk_new_null" +foreign import capi unsafe "openssl/safestack.h sk_new_null" skNewNull :: IO (Ptr STACK) -foreign import ccall unsafe "sk_free" +foreign import capi unsafe "openssl/safestack.h sk_free" skFree :: Ptr STACK -> IO () -foreign import ccall unsafe "sk_push" +foreign import capi unsafe "openssl/safestack.h sk_push" skPush :: Ptr STACK -> Ptr () -> IO () -foreign import ccall unsafe "sk_num" +foreign import capi unsafe "openssl/safestack.h sk_num" skNum :: Ptr STACK -> IO CInt -foreign import ccall unsafe "sk_value" +foreign import capi unsafe "openssl/safestack.h sk_value" skValue :: Ptr STACK -> CInt -> IO (Ptr ()) #endif diff --git a/OpenSSL/Utils.hs b/OpenSSL/Utils.hs --- a/OpenSSL/Utils.hs +++ b/OpenSSL/Utils.hs @@ -4,11 +4,13 @@ , failIf , failIf_ , raiseOpenSSLError + , clearErrorStack , toHex , fromHex , peekCStringCLen ) where +import Control.Monad import Foreign.C.String import Foreign.C.Types import Foreign.Ptr @@ -40,6 +42,12 @@ raiseOpenSSLError :: IO a raiseOpenSSLError = getError >>= errorString >>= fail + + +clearErrorStack :: IO () +clearErrorStack = do + e <- getError + when (e /= 0) clearErrorStack -- | Convert an integer to a hex string toHex :: (Num i, Bits i) => i -> String diff --git a/OpenSSL/X509.hsc b/OpenSSL/X509.hsc --- a/OpenSSL/X509.hsc +++ b/OpenSSL/X509.hsc @@ -1,10 +1,11 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# OPTIONS_HADDOCK prune #-} -- |An interface to X.509 certificate. module OpenSSL.X509 ( -- * Type - X509 + X509(..) , X509_ -- * Functions to manipulate certificate @@ -74,89 +75,89 @@ -- |@'X509'@ is an opaque object that represents X.509 certificate. newtype X509 = X509 (ForeignPtr X509_) -data X509_ +data {-# CTYPE "openssl/x509.h" "X509" #-} X509_ -foreign import ccall unsafe "X509_new" +foreign import capi unsafe "openssl/x509.h X509_new" _new :: IO (Ptr X509_) -foreign import ccall unsafe "&X509_free" +foreign import capi unsafe "openssl/x509.h &X509_free" _free :: FunPtr (Ptr X509_ -> IO ()) -foreign import ccall unsafe "X509_print" +foreign import capi unsafe "openssl/x509.h X509_print" _print :: Ptr BIO_ -> Ptr X509_ -> IO CInt -foreign import ccall unsafe "X509_cmp" +foreign import capi unsafe "openssl/x509.h X509_cmp" _cmp :: Ptr X509_ -> Ptr X509_ -> IO CInt -foreign import ccall unsafe "HsOpenSSL_X509_get_version" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_get_version" _get_version :: Ptr X509_ -> IO CLong -foreign import ccall unsafe "X509_set_version" +foreign import capi unsafe "openssl/x509.h X509_set_version" _set_version :: Ptr X509_ -> CLong -> IO CInt -foreign import ccall unsafe "X509_get_serialNumber" +foreign import capi unsafe "openssl/x509.h X509_get_serialNumber" _get_serialNumber :: Ptr X509_ -> IO (Ptr ASN1_INTEGER) -foreign import ccall unsafe "X509_set_serialNumber" +foreign import capi unsafe "openssl/x509.h X509_set_serialNumber" _set_serialNumber :: Ptr X509_ -> Ptr ASN1_INTEGER -> IO CInt -foreign import ccall unsafe "X509_get_issuer_name" +foreign import capi unsafe "openssl/x509.h X509_get_issuer_name" _get_issuer_name :: Ptr X509_ -> IO (Ptr X509_NAME) -foreign import ccall unsafe "X509_set_issuer_name" +foreign import capi unsafe "openssl/x509.h X509_set_issuer_name" _set_issuer_name :: Ptr X509_ -> Ptr X509_NAME -> IO CInt -foreign import ccall unsafe "X509_get_subject_name" +foreign import capi unsafe "openssl/x509.h X509_get_subject_name" _get_subject_name :: Ptr X509_ -> IO (Ptr X509_NAME) -foreign import ccall unsafe "X509_set_subject_name" +foreign import capi unsafe "openssl/x509.h X509_set_subject_name" _set_subject_name :: Ptr X509_ -> Ptr X509_NAME -> IO CInt -foreign import ccall unsafe "HsOpenSSL_X509_get_notBefore" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_get_notBefore" _get_notBefore :: Ptr X509_ -> IO (Ptr ASN1_TIME) -foreign import ccall unsafe "HsOpenSSL_X509_get_notAfter" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_get_notAfter" _get_notAfter :: Ptr X509_ -> IO (Ptr ASN1_TIME) #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "X509_set1_notBefore" +foreign import capi unsafe "openssl/x509.h X509_set1_notBefore" _set_notBefore :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt -foreign import ccall unsafe "X509_set1_notAfter" +foreign import capi unsafe "openssl/x509.h X509_set1_notAfter" _set_notAfter :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt #else -foreign import ccall unsafe "X509_set_notBefore" +foreign import capi unsafe "openssl/x509.h X509_set_notBefore" _set_notBefore :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt -foreign import ccall unsafe "X509_set_notAfter" +foreign import capi unsafe "openssl/x509.h X509_set_notAfter" _set_notAfter :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt #endif -foreign import ccall unsafe "X509_get_pubkey" +foreign import capi unsafe "openssl/x509.h X509_get_pubkey" _get_pubkey :: Ptr X509_ -> IO (Ptr EVP_PKEY) -foreign import ccall unsafe "X509_set_pubkey" +foreign import capi unsafe "openssl/x509.h X509_set_pubkey" _set_pubkey :: Ptr X509_ -> Ptr EVP_PKEY -> IO CInt -foreign import ccall unsafe "X509_get1_email" +foreign import capi unsafe "openssl/x509v3.h X509_get1_email" _get1_email :: Ptr X509_ -> IO (Ptr STACK) -foreign import ccall unsafe "X509_email_free" +foreign import capi unsafe "openssl/x509v3.h X509_email_free" _email_free :: Ptr STACK -> IO () -foreign import ccall unsafe "X509_sign" +foreign import capi unsafe "openssl/x509.h X509_sign" _sign :: Ptr X509_ -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO CInt -foreign import ccall unsafe "X509_verify" +foreign import capi unsafe "openssl/x509.h X509_verify" _verify :: Ptr X509_ -> Ptr EVP_PKEY -> IO CInt -foreign import ccall safe "i2d_X509_bio" +foreign import capi safe "openssl/x509.h i2d_X509_bio" _write_bio_X509 :: Ptr BIO_ -> Ptr X509_ -> IO CInt -foreign import ccall safe "d2i_X509_bio" +foreign import capi safe "openssl/x509.h d2i_X509_bio" _read_bio_X509 :: Ptr BIO_ -> Ptr (Ptr X509_) -> IO (Ptr X509_) @@ -218,9 +219,9 @@ readX509' :: BIO -> IO X509 readX509' bio = withBioPtr bio $ \ bioPtr -> - _read_bio_X509 bioPtr nullPtr + _read_bio_X509 bioPtr nullPtr >>= failIfNull - >>= wrapX509 + >>= wrapX509 -- |@'readDerX509' der@ reads in a certificate. readDerX509 :: ByteString -> IO X509 @@ -273,7 +274,9 @@ where interpret :: CInt -> IO VerifyStatus interpret 1 = return VerifySuccess - interpret 0 = return VerifyFailure + interpret 0 = do + clearErrorStack + return VerifyFailure interpret _ = raiseOpenSSLError -- |@'printX509' cert@ translates a certificate into human-readable diff --git a/OpenSSL/X509/Name.hsc b/OpenSSL/X509/Name.hsc --- a/OpenSSL/X509/Name.hsc +++ b/OpenSSL/X509/Name.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} module OpenSSL.X509.Name ( X509_NAME @@ -15,28 +16,28 @@ import OpenSSL.ASN1 import OpenSSL.Utils -data X509_NAME -data X509_NAME_ENTRY +data {-# CTYPE "openssl/x509.h" "X509_NAME" #-} X509_NAME +data {-# CTYPE "openssl/x509.h" "X509_NAME_ENTRY" #-} X509_NAME_ENTRY -foreign import ccall unsafe "X509_NAME_new" +foreign import capi unsafe "openssl/x509.h X509_NAME_new" _new :: IO (Ptr X509_NAME) -foreign import ccall unsafe "X509_NAME_free" +foreign import capi unsafe "openssl/x509.h X509_NAME_free" _free :: Ptr X509_NAME -> IO () -foreign import ccall unsafe "X509_NAME_add_entry_by_txt" +foreign import capi unsafe "openssl/x509.h X509_NAME_add_entry_by_txt" _add_entry_by_txt :: Ptr X509_NAME -> CString -> CInt -> Ptr CChar -> CInt -> CInt -> CInt -> IO CInt -foreign import ccall unsafe "X509_NAME_entry_count" +foreign import capi unsafe "openssl/x509.h X509_NAME_entry_count" _entry_count :: Ptr X509_NAME -> IO CInt -foreign import ccall unsafe "X509_NAME_get_entry" +foreign import capi unsafe "openssl/x509.h X509_NAME_get_entry" _get_entry :: Ptr X509_NAME -> CInt -> IO (Ptr X509_NAME_ENTRY) -foreign import ccall unsafe "X509_NAME_ENTRY_get_object" +foreign import capi unsafe "openssl/x509.h X509_NAME_ENTRY_get_object" _ENTRY_get_object :: Ptr X509_NAME_ENTRY -> IO (Ptr ASN1_OBJECT) -foreign import ccall unsafe "X509_NAME_ENTRY_get_data" +foreign import capi unsafe "openssl/x509.h X509_NAME_ENTRY_get_data" _ENTRY_get_data :: Ptr X509_NAME_ENTRY -> IO (Ptr ASN1_STRING) diff --git a/OpenSSL/X509/Request.hs b/OpenSSL/X509/Request.hs --- a/OpenSSL/X509/Request.hs +++ b/OpenSSL/X509/Request.hs @@ -1,5 +1,6 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# OPTIONS_HADDOCK prune #-} -- |An interface to PKCS#10 certificate request. module OpenSSL.X509.Request @@ -31,6 +32,7 @@ , setPublicKey , addExtensions + , addExtensionToX509 ) where @@ -53,52 +55,54 @@ -- |@'X509Req'@ is an opaque object that represents PKCS#10 -- certificate request. newtype X509Req = X509Req (ForeignPtr X509_REQ) -data X509_REQ +data {-# CTYPE "openssl/x509.h" "X509_REQ" #-} X509_REQ -data X509_EXT +data X509_EXT -foreign import ccall unsafe "X509_REQ_new" +foreign import capi unsafe "openssl/x509.h X509_REQ_new" _new :: IO (Ptr X509_REQ) -foreign import ccall unsafe "&X509_REQ_free" +foreign import capi unsafe "openssl/x509.h &X509_REQ_free" _free :: FunPtr (Ptr X509_REQ -> IO ()) -foreign import ccall unsafe "X509_REQ_sign" +foreign import capi unsafe "openssl/x509.h X509_REQ_sign" _sign :: Ptr X509_REQ -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO CInt -foreign import ccall unsafe "X509_REQ_verify" +foreign import capi unsafe "openssl/x509.h X509_REQ_verify" _verify :: Ptr X509_REQ -> Ptr EVP_PKEY -> IO CInt -foreign import ccall unsafe "X509_REQ_print" +foreign import capi unsafe "openssl/x509.h X509_REQ_print" _print :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt -foreign import ccall unsafe "i2d_X509_REQ_bio" +foreign import capi unsafe "openssl/x509.h i2d_X509_REQ_bio" _req_to_der :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt -foreign import ccall unsafe "HsOpenSSL_X509_REQ_get_version" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_REQ_get_version" _get_version :: Ptr X509_REQ -> IO CLong -foreign import ccall unsafe "X509_REQ_set_version" +foreign import capi unsafe "openssl/x509.h X509_REQ_set_version" _set_version :: Ptr X509_REQ -> CLong -> IO CInt -foreign import ccall unsafe "HsOpenSSL_X509_REQ_get_subject_name" +foreign import capi unsafe "HsOpenSSL.h 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" +foreign import capi unsafe "openssl/x509.h X509_REQ_set_subject_name" _set_subject_name :: Ptr X509_REQ -> Ptr X509_NAME -> IO CInt -foreign import ccall unsafe "X509_REQ_get_pubkey" +foreign import capi unsafe "openssl/x509.h X509_REQ_get_pubkey" _get_pubkey :: Ptr X509_REQ -> IO (Ptr EVP_PKEY) -foreign import ccall unsafe "X509_REQ_set_pubkey" +foreign import capi unsafe "openssl/x509.h X509_REQ_set_pubkey" _set_pubkey :: Ptr X509_REQ -> Ptr EVP_PKEY -> IO CInt -foreign import ccall unsafe "X509V3_EXT_nconf_nid" +foreign import capi unsafe "openssl/x509v3.h X509V3_EXT_nconf_nid" _ext_create :: Ptr a -> Ptr b -> CInt -> CString -> IO (Ptr X509_EXT) -foreign import ccall unsafe "X509_REQ_add_extensions" +foreign import capi unsafe "openssl/x509.h X509_REQ_add_extensions" _req_add_extensions :: Ptr X509_REQ -> Ptr STACK -> IO CInt +foreign import capi unsafe "openssl/x509.h X509_add_ext" + _X509_add_ext :: Ptr Cert.X509_ -> Ptr X509_EXT -> CInt -> IO CInt -- |@'newX509Req'@ creates an empty certificate request. You must set -- the following properties to and sign it (see 'signX509Req') to @@ -295,3 +299,23 @@ Cert.setPublicKey cert =<< getPublicKey req return cert + +-- | Add Extensions to a certificate (when the Server accepting certs requires it) +-- E.g.: +-- +-- > addExtensionToX509 cert1 87 "CA:FALSE" +-- > addExtensionToX509 cert1 85 "critical,serverAuth, clientAuth" -- when this extension field is critical +-- +addExtensionToX509 :: X509 -> Int -> String -> IO Bool +addExtensionToX509 (Cert.X509 certFPtr) nid value = do + -- Context and config pointers are set to nullPtr for simplicity. + -- Depending on your use case, you might need to provide actual values. + result <- withForeignPtr certFPtr $ \certPtr -> + withCString value $ \cValue -> do + extPtr <- _ext_create nullPtr nullPtr (fromIntegral nid) cValue + if extPtr /= nullPtr + then do + res <- _X509_add_ext certPtr extPtr (-1) -- Add to the end + return (res == 0) + else return False + return result diff --git a/OpenSSL/X509/Revocation.hsc b/OpenSSL/X509/Revocation.hsc --- a/OpenSSL/X509/Revocation.hsc +++ b/OpenSSL/X509/Revocation.hsc @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# OPTIONS_HADDOCK prune #-} -- |An interface to Certificate Revocation List. module OpenSSL.X509.Revocation @@ -61,8 +62,8 @@ -- |@'CRL'@ is an opaque object that represents Certificate Revocation -- List. newtype CRL = CRL (ForeignPtr X509_CRL) -data X509_CRL -data X509_REVOKED +data {-# CTYPE "openssl/x509.h" "X509_CRL" #-} X509_CRL +data {-# CTYPE "openssl/x509.h" "X509_REVOKED" #-} X509_REVOKED -- |@'RevokedCertificate'@ represents a revoked certificate in a -- list. Each certificates are supposed to be distinguishable by @@ -76,81 +77,81 @@ deriving (Show, Eq, Typeable) -foreign import ccall unsafe "X509_CRL_new" +foreign import capi unsafe "openssl/x509.h X509_CRL_new" _new :: IO (Ptr X509_CRL) -foreign import ccall unsafe "&X509_CRL_free" +foreign import capi unsafe "openssl/x509.h &X509_CRL_free" _free :: FunPtr (Ptr X509_CRL -> IO ()) -foreign import ccall unsafe "X509_CRL_sign" +foreign import capi unsafe "openssl/x509.h X509_CRL_sign" _sign :: Ptr X509_CRL -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO CInt -foreign import ccall unsafe "X509_CRL_verify" +foreign import capi unsafe "openssl/x509.h X509_CRL_verify" _verify :: Ptr X509_CRL -> Ptr EVP_PKEY -> IO CInt -foreign import ccall unsafe "X509_CRL_print" +foreign import capi unsafe "openssl/x509.h X509_CRL_print" _print :: Ptr BIO_ -> Ptr X509_CRL -> IO CInt -foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_version" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_version" _get_version :: Ptr X509_CRL -> IO CLong -foreign import ccall unsafe "X509_CRL_set_version" +foreign import capi unsafe "openssl/x509.h X509_CRL_set_version" _set_version :: Ptr X509_CRL -> CLong -> IO CInt -foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_lastUpdate" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_lastUpdate" _get_lastUpdate :: Ptr X509_CRL -> IO (Ptr ASN1_TIME) -foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_nextUpdate" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_nextUpdate" _get_nextUpdate :: Ptr X509_CRL -> IO (Ptr ASN1_TIME) #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "X509_CRL_set1_lastUpdate" +foreign import capi unsafe "openssl/x509.h X509_CRL_set1_lastUpdate" _set_lastUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt -foreign import ccall unsafe "X509_CRL_set1_nextUpdate" +foreign import capi unsafe "openssl/x509.h X509_CRL_set1_nextUpdate" _set_nextUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt #else -foreign import ccall unsafe "X509_CRL_set_lastUpdate" +foreign import capi unsafe "openssl/x509.h X509_CRL_set_lastUpdate" _set_lastUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt -foreign import ccall unsafe "X509_CRL_set_nextUpdate" +foreign import capi unsafe "openssl/x509.h X509_CRL_set_nextUpdate" _set_nextUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt #endif -foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_issuer" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_issuer" _get_issuer_name :: Ptr X509_CRL -> IO (Ptr X509_NAME) -foreign import ccall unsafe "X509_CRL_set_issuer_name" +foreign import capi unsafe "openssl/x509.h X509_CRL_set_issuer_name" _set_issuer_name :: Ptr X509_CRL -> Ptr X509_NAME -> IO CInt -foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_REVOKED" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_REVOKED" _get_REVOKED :: Ptr X509_CRL -> IO (Ptr STACK) -foreign import ccall unsafe "X509_CRL_add0_revoked" +foreign import capi unsafe "openssl/x509.h X509_CRL_add0_revoked" _add0_revoked :: Ptr X509_CRL -> Ptr X509_REVOKED -> IO CInt #if OPENSSL_VERSION_NUMBER >= 0x10000000 -- This function is only available on OpenSSL 1.0.0 or later. -foreign import ccall unsafe "X509_CRL_get0_by_serial" +foreign import capi unsafe "openssl/x509.h X509_CRL_get0_by_serial" _get0_by_serial :: Ptr X509_CRL -> Ptr (Ptr X509_REVOKED) -> Ptr ASN1_INTEGER -> IO CInt #endif -foreign import ccall unsafe "X509_CRL_sort" +foreign import capi unsafe "openssl/x509.h X509_CRL_sort" _sort :: Ptr X509_CRL -> IO CInt -foreign import ccall unsafe "X509_REVOKED_new" +foreign import capi unsafe "openssl/x509.h X509_REVOKED_new" _new_revoked :: IO (Ptr X509_REVOKED) -foreign import ccall unsafe "X509_REVOKED_free" +foreign import capi unsafe "openssl/x509.h X509_REVOKED_free" freeRevoked :: Ptr X509_REVOKED -> IO () -foreign import ccall unsafe "X509_REVOKED_set_serialNumber" +foreign import capi unsafe "openssl/x509.h X509_REVOKED_set_serialNumber" _set_serialNumber :: Ptr X509_REVOKED -> Ptr ASN1_INTEGER -> IO CInt -foreign import ccall unsafe "X509_REVOKED_set_revocationDate" +foreign import capi unsafe "openssl/x509.h X509_REVOKED_set_revocationDate" _set_revocationDate :: Ptr X509_REVOKED -> Ptr ASN1_TIME -> IO CInt -- |@'newCRL'@ creates an empty revocation list. You must set the @@ -302,10 +303,10 @@ #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "X509_REVOKED_get0_serialNumber" +foreign import capi unsafe "openssl/x509.h X509_REVOKED_get0_serialNumber" _get0_serialNumber :: Ptr X509_REVOKED -> IO (Ptr ASN1_INTEGER) -foreign import ccall unsafe "X509_REVOKED_get0_revocationDate" +foreign import capi unsafe "openssl/x509.h X509_REVOKED_get0_revocationDate" _get0_revocationDate :: Ptr X509_REVOKED -> IO (Ptr ASN1_TIME) getSerialNumber = _get0_serialNumber diff --git a/OpenSSL/X509/Store.hsc b/OpenSSL/X509/Store.hsc --- a/OpenSSL/X509/Store.hsc +++ b/OpenSSL/X509/Store.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} {-# OPTIONS_HADDOCK prune #-} -- |An interface to X.509 certificate store. module OpenSSL.X509.Store @@ -43,19 +44,19 @@ -- certificate store. The certificate store is usually used for chain -- verification. newtype X509Store = X509Store (ForeignPtr X509_STORE) -data X509_STORE +data {-# CTYPE "openssl/x509.h" "X509_STORE" #-} X509_STORE -foreign import ccall unsafe "X509_STORE_new" +foreign import capi unsafe "openssl/x509.h X509_STORE_new" _new :: IO (Ptr X509_STORE) -foreign import ccall unsafe "X509_STORE_free" +foreign import capi unsafe "openssl/x509.h X509_STORE_free" _free :: Ptr X509_STORE -> IO () -foreign import ccall unsafe "X509_STORE_add_cert" +foreign import capi unsafe "openssl/x509.h X509_STORE_add_cert" _add_cert :: Ptr X509_STORE -> Ptr X509_ -> IO CInt -foreign import ccall unsafe "X509_STORE_add_crl" +foreign import capi unsafe "openssl/x509.h X509_STORE_add_crl" _add_crl :: Ptr X509_STORE -> Ptr X509_CRL -> IO CInt -- |@'newX509Store'@ creates an empty X.509 certificate store. @@ -92,30 +93,30 @@ >>= failIf (/= 1) >> return () -data X509_STORE_CTX +data {-# CTYPE "openssl/x509.h" "X509_STORE_CTX" #-} X509_STORE_CTX newtype X509StoreCtx = X509StoreCtx (ForeignPtr X509_STORE_CTX) -foreign import ccall unsafe "X509_STORE_CTX_get_current_cert" +foreign import capi unsafe "openssl/x509.h X509_STORE_CTX_get_current_cert" _store_ctx_get_current_cert :: Ptr X509_STORE_CTX -> IO (Ptr X509_) -foreign import ccall unsafe "HsOpenSSL_X509_STORE_CTX_get0_current_issuer" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_STORE_CTX_get0_current_issuer" _store_ctx_get0_current_issuer :: Ptr X509_STORE_CTX -> IO (Ptr X509_) -foreign import ccall unsafe "HsOpenSSL_X509_STORE_CTX_get0_current_crl" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_STORE_CTX_get0_current_crl" _store_ctx_get0_current_crl :: Ptr X509_STORE_CTX -> IO (Ptr X509_CRL) #if OPENSSL_VERSION_NUMBER >= 0x10100000L -foreign import ccall unsafe "X509_STORE_CTX_get1_chain" +foreign import capi unsafe "openssl/x509.h X509_STORE_CTX_get1_chain" _store_ctx_get_chain :: Ptr X509_STORE_CTX -> IO (Ptr STACK) #else -foreign import ccall unsafe "X509_STORE_CTX_get_chain" +foreign import capi unsafe "openssl/x509.h X509_STORE_CTX_get_chain" _store_ctx_get_chain :: Ptr X509_STORE_CTX -> IO (Ptr STACK) #endif -foreign import ccall unsafe "HsOpenSSL_X509_ref" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_ref" _x509_ref :: Ptr X509_ -> IO () -foreign import ccall unsafe "HsOpenSSL_X509_CRL_ref" +foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_ref" _crl_ref :: Ptr X509_CRL -> IO () withX509StoreCtxPtr :: X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,5 @@ HsOpenSSL -========== - -[![Build Status](https://travis-ci.org/vshabanov/HsOpenSSL.svg?branch=master)](https://travis-ci.org/vshabanov/HsOpenSSL) +========= HsOpenSSL is an (incomplete) OpenSSL binding for Haskell. It can generate RSA and DSA keys, read and write PEM files, generate message diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,110 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TupleSections #-} - -#ifndef MIN_VERSION_Cabal --- MIN_VERSION_Cabal is defined and available to custom Setup.hs scripts --- if either GHC >= 8.0 or cabal-install >= 1.24 is used. --- So if it isn't defined, it's very likely we don't have Cabal >= 2.0. -#define MIN_VERSION_Cabal(x,y,z) 0 -#endif - -import Distribution.Simple -import Distribution.Simple.Setup (ConfigFlags(..), toFlag) -import Distribution.Simple.LocalBuildInfo (localPkgDescr) - -#if MIN_VERSION_Cabal(2,0,0) -import Distribution.PackageDescription (FlagName(..), mkFlagName) -#else -import Distribution.PackageDescription (FlagName(..)) -#endif - -import Distribution.Verbosity (silent) -import System.Info (os) -import qualified Control.Exception as E (tryJust, throw) -import System.IO.Error (isUserError) -import Control.Monad (forM) -import Data.List - -#if !(MIN_VERSION_Cabal(2,0,0)) -mkFlagName = FlagName -#endif - --- On macOS we're checking whether OpenSSL library is avaiable --- and if not, we're trying to find Homebrew or MacPorts OpenSSL installations. --- --- Method is dumb -- set homebrew-openssl or macports-openssl flag and try --- to configure and check C libs. --- --- If no or multiple libraries are found we display error message --- with instructions. - -main - | os == "darwin" = - defaultMainWithHooks simpleUserHooks { confHook = conf } - | otherwise = - defaultMain - -flags = ["homebrew-openssl", "macports-openssl"] - -conf descr cfg = do - c <- tryConfig descr cfg - case c of - Right lbi -> return lbi -- library was found - Left e - | configConfigurationsFlags cfg - `intersect` [(mkFlagName f, True) | f <- flags] /= [] -> - E.throw e - -- flag was set but library still wasn't found - | otherwise -> do - r <- forM flags $ \ f -> - fmap (f,) $ tryConfig descr $ - setFlag (mkFlagName f) cfg { configVerbosity = toFlag silent } - -- TODO: configure is a long operation - -- while checkForeignDeps is fast. - -- Perhaps there is a way to configure once - -- and only apply flags to result and check. - -- However, additional `configure`s happen only on macOS - -- and only when library wasn't found. - case [(f,r) | (f, Right r) <- r] of - [(_,lbi)] -> - return lbi -- library was found - [] -> - fail notFound - fs -> - fail $ multipleFound fs - -notFound = unlines - [ "Can't find OpenSSL library," - , "install it via 'brew install openssl' or 'port install openssl'" - , "or use --extra-include-dirs= and --extra-lib-dirs=" - , "to specify location of installed OpenSSL library." - ] - -multipleFound fs = unlines - [ "Multiple OpenSSL libraries were found," - , "use " ++ intercalate " or " ["'-f " ++ f ++ "'" | (f,_) <- fs] - , "to specify location of installed OpenSSL library." - ] - -setFlag f c = c { configConfigurationsFlags = go (configConfigurationsFlags c) } - where go [] = [] - go (x@(n, _):xs) - | n == f = (f, True) : xs - | otherwise = x : go xs - -tryConfig descr flags = do - lbi <- confHook simpleUserHooks descr flags - -- confHook simpleUserHooks == Distribution.Simple.Configure.configure - - -- Testing whether C lib and header dependencies are working. - -- We check exceptions only here, to check C libs errors but not other - -- configuration problems like not resolved .cabal dependencies. - E.tryJust ue $ do - postConf simpleUserHooks [] flags (localPkgDescr lbi) lbi - -- postConf simpleUserHooks ~== - -- Distribution.Simple.Configure.checkForeignDeps - - return lbi - - where ue e | isUserError e = Just e - | otherwise = Nothing diff --git a/Test/OpenSSL/DER.hs b/Test/OpenSSL/DER.hs --- a/Test/OpenSSL/DER.hs +++ b/Test/OpenSSL/DER.hs @@ -2,7 +2,7 @@ import OpenSSL.RSA import OpenSSL.DER -import Test.OpenSSL.TestUtils +import TestUtils main :: IO () main = do diff --git a/Test/OpenSSL/DSA.hs b/Test/OpenSSL/DSA.hs --- a/Test/OpenSSL/DSA.hs +++ b/Test/OpenSSL/DSA.hs @@ -2,7 +2,7 @@ import qualified Data.ByteString as BS import OpenSSL.DSA -import Test.OpenSSL.TestUtils +import TestUtils -- | This function just runs the example DSA generation, as given in FIP 186-2, -- app 5. diff --git a/Test/OpenSSL/EVP/Base64.hs b/Test/OpenSSL/EVP/Base64.hs --- a/Test/OpenSSL/EVP/Base64.hs +++ b/Test/OpenSSL/EVP/Base64.hs @@ -9,7 +9,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import OpenSSL.EVP.Base64 -import Test.OpenSSL.TestUtils +import TestUtils -- NOTE: bytestring-0.9.0.4 has these instances too, while -- bytestring-0.9.0.3 does not. If our bytestring is 0.9.0.4 we'll diff --git a/Test/OpenSSL/EVP/Digest.hs b/Test/OpenSSL/EVP/Digest.hs --- a/Test/OpenSSL/EVP/Digest.hs +++ b/Test/OpenSSL/EVP/Digest.hs @@ -6,7 +6,7 @@ import OpenSSL import Text.Printf import OpenSSL.EVP.Digest -import Test.OpenSSL.TestUtils +import TestUtils main :: IO () main = withOpenSSL $ do diff --git a/Test/OpenSSL/TestUtils.hs b/Test/OpenSSL/TestUtils.hs --- a/Test/OpenSSL/TestUtils.hs +++ b/Test/OpenSSL/TestUtils.hs @@ -1,4 +1,4 @@ -module Test.OpenSSL.TestUtils where +module TestUtils where import qualified Control.Exception as E import Control.Monad diff --git a/cbits/HsOpenSSL.c b/cbits/HsOpenSSL.c --- a/cbits/HsOpenSSL.c +++ b/cbits/HsOpenSSL.c @@ -119,7 +119,7 @@ #if OPENSSL_VERSION_NUMBER >= 0x10100000L return X509_CRL_get0_lastUpdate(crl); #else - return X509_CRL_get_lastUpdate(crl); + return X509_CRL_get_lastUpdate((X509_CRL*) crl); #endif } @@ -127,7 +127,7 @@ #if OPENSSL_VERSION_NUMBER >= 0x10100000L return X509_CRL_get0_nextUpdate(crl); #else - return X509_CRL_get_nextUpdate(crl); + return X509_CRL_get_nextUpdate((X509_CRL*) crl); #endif } @@ -204,15 +204,19 @@ /* ASN1 ***********************************************************************/ -#if OPENSSL_VERSION_NUMBER >= 0x10100000L +#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(LIBRESSL_VERSION_NUMBER) #define M_ASN1_INTEGER_new() (ASN1_INTEGER *)\ ASN1_STRING_type_new(V_ASN1_INTEGER) -#define M_ASN1_INTEGER_free(a) ASN1_STRING_free((ASN1_STRING *)a) #define M_ASN1_TIME_new() (ASN1_TIME *)\ ASN1_STRING_type_new(V_ASN1_UTCTIME) #define M_ASN1_TIME_free(a) ASN1_STRING_free((ASN1_STRING *)a) #endif +#if OPENSSL_VERSION_NUMBER >= 0x10100000L +#define M_ASN1_INTEGER_free(a) ASN1_STRING_free((ASN1_STRING *)a) +#endif + + ASN1_INTEGER* HsOpenSSL_M_ASN1_INTEGER_new() { return M_ASN1_INTEGER_new(); } @@ -384,5 +388,15 @@ #else long tmp = SSL_get_options(ssl); return SSL_set_options(ssl, tmp & ~options); +#endif +} + +int HsOpenSSL_enable_hostname_validation(SSL* ssl, char* host_name, size_t host_len) { +#if defined(X509_CHECK_FLAG_NO_PARTIAL_WILDCARDS) + X509_VERIFY_PARAM* param = SSL_get0_param(ssl); + X509_VERIFY_PARAM_set_hostflags(param, X509_CHECK_FLAG_NO_PARTIAL_WILDCARDS); + return X509_VERIFY_PARAM_set1_host(param, host_name, host_len); +#else + return 0; #endif } diff --git a/cbits/HsOpenSSL.h b/cbits/HsOpenSSL.h --- a/cbits/HsOpenSSL.h +++ b/cbits/HsOpenSSL.h @@ -20,18 +20,19 @@ #include #include -/* A dirty hack to work around for broken versions of Cabal: - * https://github.com/phonohawk/HsOpenSSL/issues/8 - * - * The trick is to abuse the fact that -Icbits is (almost) always - * passed to hsc2hs so we can reach the cabal_macros.h from cbits, but - * see #23, #24 and #25... - */ -#if !defined(MIN_VERSION_base) && \ - !defined(HSOPENSSL_NEED_NOT_INCLUDE_CABAL_MACROS_H) -# include "../dist/build/autogen/cabal_macros.h" +/* LibreSSL *******************************************************************/ +#if (defined LIBRESSL_VERSION_NUMBER && OPENSSL_VERSION_NUMBER == 0x20000000L) +#undef OPENSSL_VERSION_NUMBER +#define OPENSSL_VERSION_NUMBER 0x1000107fL #endif +/* OpenSSL 3.0 ****************************************************************/ + +#ifndef OPENSSL_VERSION_PREREQ +#define OPENSSL_VERSION_PREREQ(maj,min) 0 +#endif + + /* OpenSSL ********************************************************************/ void HsOpenSSL_init(); void HsOpenSSL_OPENSSL_free(void* ptr); @@ -48,6 +49,8 @@ /* DH *************************************************************************/ DH* HsOpenSSL_DHparams_dup(DH* dh); +const BIGNUM *HsOpenSSL_DH_get_pub_key(DH *dh); +int HsOpenSSL_DH_length(DH *dh); /* EVP ************************************************************************/ int HsOpenSSL_EVP_MD_size(EVP_MD* md); @@ -71,6 +74,10 @@ const ASN1_TIME* HsOpenSSL_X509_CRL_get_nextUpdate(const 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); +void HsOpenSSL_X509_ref(X509* x509); +void HsOpenSSL_X509_CRL_ref(X509_CRL* crl); +X509* HsOpenSSL_X509_STORE_CTX_get0_current_issuer(X509_STORE_CTX *ctx); +X509_CRL* HsOpenSSL_X509_STORE_CTX_get0_current_crl(X509_STORE_CTX *ctx); /* PKCS#7 *********************************************************************/ long HsOpenSSL_PKCS7_is_detached(PKCS7* pkcs7); @@ -98,5 +105,7 @@ long HsOpenSSL_SSL_set_options(SSL* ssl, long options); long HsOpenSSL_SSL_clear_options(SSL* ssl, long options); long HsOpenSSL_SSL_set_tlsext_host_name(SSL* ssl, char* host_name); + +int HsOpenSSL_enable_hostname_validation(SSL* ssl, char* host_name, size_t host_len); #endif diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs --- a/examples/HelloWorld.hs +++ b/examples/HelloWorld.hs @@ -15,9 +15,9 @@ main = withOpenSSL $ - do putStrLn "cipher: DES-CBC" - des <- liftM fromJust $ getCipherByName "DES-CBC" - + do putStrLn "cipher: DES3" + des <- liftM fromJust $ getCipherByName "DES3" + putStrLn "generating RSA keypair..." rsa <- generateRSAKey 512 65537 Nothing