From d186dab8051d2c1415dd108d71def798d283974c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 21 Apr 2006 03:34:38 +0000 Subject: [PATCH] getting close to a working replacement for mzssl svn: r2730 --- collects/openssl/mzssl2.ss | 530 ++++++++++++++++++++++++++----------- 1 file changed, 375 insertions(+), 155 deletions(-) diff --git a/collects/openssl/mzssl2.ss b/collects/openssl/mzssl2.ss index bdaa6e93ea..87208c4fab 100644 --- a/collects/openssl/mzssl2.ss +++ b/collects/openssl/mzssl2.ss @@ -2,39 +2,71 @@ ;; This is a re-implementation of "mzssl.c" using `(lib "foreign.ss")'. ;; It will soon replace "mzssl.c". +;; Warn clients: even when a (non-blocking) write fails to write all +;; the data, the stream is committed to writing the given data in +;; the future. (This requirement comes from the SSL library.) + (module mzssl2 mzscheme (require (lib "foreign.ss") (lib "port.ss") (lib "etc.ss")) - (provide ssl-make-client-context - ports->ssl-ports) + (provide ssl-available? + + ssl-make-client-context + ssl-make-server-context + ssl-client-context? + ssl-server-context? + ssl-context? + + ssl-load-certificate-chain! + ssl-load-private-key! + ssl-load-verify-root-certificates! + ssl-load-suggested-certificate-authorities! + ssl-set-verify! + + ports->ssl-ports + + ssl-listen + ssl-close + ssl-accept + ssl-accept/enable-break + ssl-connect + ssl-connect/enable-break) (unsafe!) - (define libssl (ffi-lib "libssl")) + (define libssl (with-handlers ([exn:fail? (lambda (x) #f)]) + (ffi-lib "libssl"))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SSL bindings and constants (define-syntax define-define-X (syntax-rules () - [(_ id lib) + [(_ id chk lib) (define-syntax (id stx) (syntax-case stx () [(_ id type) (with-syntax ([str (symbol->string (syntax-e #'id))]) #'(define id - (get-ffi-obj str lib (_fun . type))))]))])) + (and chk + (get-ffi-obj str lib (_fun . type)))))]))])) - (define-define-X define-ssl libssl) - (define-define-X define-mzscheme #f) + (define-define-X define-ssl libssl libssl) + (define-define-X define-mzscheme #t #f) + + (define-syntax typedef + (syntax-rules () + [(_ id t) + (define-fun-syntax id (syntax-id-rules () [_ t]))])) - (define-fun-syntax _BIO_METHOD* (syntax-id-rules () [_ _pointer])) - (define-fun-syntax _BIO* (syntax-id-rules () [_ _pointer])) - (define-fun-syntax _SSL_METHOD* (syntax-id-rules () [_ _pointer])) - (define-fun-syntax _SSL_CTX* (syntax-id-rules () [_ _pointer])) - (define-fun-syntax _SSL* (syntax-id-rules () [_ _pointer])) + (typedef _BIO_METHOD* _pointer) + (typedef _BIO* _pointer) + (typedef _SSL_METHOD* _pointer) + (typedef _SSL_CTX* _pointer) + (typedef _SSL* _pointer) + (typedef _X509_NAME* _pointer) (define-ssl SSLv2_client_method (-> _SSL_METHOD*)) (define-ssl SSLv2_server_method (-> _SSL_METHOD*)) @@ -58,6 +90,14 @@ (define-ssl SSL_CTX_new (_SSL_METHOD* -> _SSL_CTX*)) (define-ssl SSL_CTX_free (_SSL_CTX* -> _void)) + (define-ssl SSL_CTX_set_verify (_SSL_CTX* _int _pointer -> _void)) + (define-ssl SSL_CTX_use_certificate_chain_file (_SSL_CTX* _bytes -> _int)) + (define-ssl SSL_CTX_load_verify_locations (_SSL_CTX* _bytes -> _int)) + (define-ssl SSL_CTX_set_client_CA_list (_SSL_CTX* _X509_NAME* -> _int)) + (define-ssl SSL_CTX_use_RSAPrivateKey_file (_SSL_CTX* _bytes _int -> _int)) + (define-ssl SSL_CTX_use_PrivateKey_file (_SSL_CTX* _bytes _int -> _int)) + (define-ssl SSL_load_client_CA_file (_bytes -> _X509_NAME*)) + (define-ssl SSL_new (_SSL_CTX* -> _SSL*)) (define-ssl SSL_set_bio (_SSL* _BIO* _BIO* -> _void)) (define-ssl SSL_connect (_SSL* -> _int)) @@ -82,6 +122,13 @@ (define BIO_C_SET_BUF_MEM_EOF_RETURN 130) + (define SSL_FILETYPE_PEM 1) + (define SSL_FILETYPE_ASN1 2) + + (define SSL_VERIFY_NONE #x00) + (define SSL_VERIFY_PEER #x01) + (define SSL_VERIFY_FAIL_IF_NO_PEER_CERT #x02) + (define-mzscheme scheme_start_atomic (-> _void)) (define-mzscheme scheme_end_atomic (-> _void)) @@ -120,8 +167,19 @@ (lambda () (scheme_end_atomic)))])) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Structs - (define-struct ssl-client-context (ctx)) + (define-struct ssl-context (ctx)) + (define-struct (ssl-client-context ssl-context) ()) + (define-struct (ssl-server-context ssl-context) ()) + + (define-struct ssl-listener (l mzctx)) + + ;; internal: + (define-struct mzssl (ssl i o r-bio w-bio pipe-r pipe-w buffer lock refcount)) + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Contexts, certificates, etc. (define default-encrypt 'sslv2-or-v3) @@ -144,21 +202,101 @@ (string-append also-expect "'sslv2-or-v3, 'sslv2, 'sslv3, or 'tls") e)]))) + (define make-context + (opt-lambda (who protocol-symbol also-expected client?) + (let ([meth (encrypt->method who also-expected protocol-symbol client?)]) + (atomically ; so we reliably register the finalizer + (let ([ctx (SSL_CTX_new meth)]) + (check-valid ctx who "context creation") + (register-finalizer ctx (lambda (v) (SSL_CTX_free v))) + ((if client? make-ssl-client-context make-ssl-server-context) ctx)))))) + (define ssl-make-client-context (opt-lambda ([protocol-symbol default-encrypt]) - (let ([meth (encrypt->method 'ssl-make-client-context "" protocol-symbol #t)]) - (atomically ; so we reliably regsiter the finalizer - (let ([ctx (SSL_CTX_new meth)]) - (check-valid ctx 'ssl-make-client-context "context creation") - (register-finalizer ctx (lambda (v) (SSL_CTX_free v))) - (make-ssl-client-context ctx)))))) + (make-context 'ssl-make-client-context protocol-symbol "" #t))) - (define (get-context who context-or-encrypt-method) - (if (ssl-client-context? context-or-encrypt-method) - (ssl-client-context-ctx context-or-encrypt-method) - (SSL_CTX_new (encrypt->method who "client context, " context-or-encrypt-method #t)))) + (define ssl-make-server-context + (opt-lambda ([protocol-symbol default-encrypt]) + (make-context 'ssl-make-server-context protocol-symbol "" #f))) - (define-struct mzssl (ssl i o r-bio w-bio pipe-r pipe-w buffer lock refcount)) + (define (get-context who context-or-encrypt-method client?) + (if (ssl-context? context-or-encrypt-method) + (ssl-context-ctx context-or-encrypt-method) + (SSL_CTX_new (encrypt->method who "context" context-or-encrypt-method client?)))) + + (define (get-context/listener who ssl-context-or-listener) + (cond + [(ssl-context? ssl-context-or-listener) + (ssl-context-ctx ssl-context-or-listener)] + [(ssl-listener? ssl-context-or-listener) + (ssl-context-ctx (ssl-listener-mzctx ssl-context-or-listener))] + [else + (raise-type-error who + "SSL context or listener" + ssl-context-or-listener)])) + + (define (ssl-load-... who load-it ssl-context-or-listener pathname) + (let ([ctx (get-context/listener 'ssl-load-certificate-chain! + ssl-context-or-listener)]) + (unless (path-string? pathname) + (raise-type-error 'ssl-load-certificate-chain! + "path or string" + pathname)) + (let ([path (path->bytes + (path->complete-path (expand-path pathname) + (current-directory)))]) + (let ([n (load-it ctx path)]) + (unless (= n 1) + (error who "load failed from: ~e ~a" + pathname + (get-error-message (ERR_get_error)))))))) + + (define (ssl-load-certificate-chain! ssl-context-or-listener pathname) + (ssl-load-... 'ssl-load-certificate-chain! + SSL_CTX_use_certificate_chain_file + ssl-context-or-listener pathname)) + + (define (ssl-load-verify-root-certificates! ssl-context-or-listener pathname) + (ssl-load-... 'ssl-load-verify-root-certificates! + SSL_CTX_load_verify_locations + ssl-context-or-listener pathname)) + + (define (ssl-load-suggested-certificate-authorities! ssl-listener pathname) + (ssl-load-... 'ssl-load-suggested-certificate-authorities! + (lambda (ctx path) + (let ([stk (SSL_load_client_CA_file path)]) + (if (ptr-equal? stk #f) + 0 + (begin + (SSL_CTX_set_client_CA_list ctx stk) + 1)))) + ssl-listener pathname)) + + (define ssl-load-private-key! + (opt-lambda (ssl-context-or-listener pathname [rsa? #t] [asn1? #f]) + (ssl-load-... 'ssl-load-private-key! + (lambda (ctx path) + ((if rsa? + SSL_CTX_use_RSAPrivateKey_file + SSL_CTX_use_PrivateKey_file) + ctx path + (if asn1? + SSL_FILETYPE_ASN1 + SSL_FILETYPE_PEM))) + ssl-context-or-listener pathname))) + + (define (ssl-set-verify! ssl-context-or-listener on?) + (let ([ctx (get-context/listener 'ssl-set-verify! + ssl-context-or-listener)]) + (SSL_CTX_set_verify ctx + (if on? + (bitwise-ior SSL_VERIFY_PEER + SSL_VERIFY_FAIL_IF_NO_PEER_CERT) + SSL_VERIFY_NONE) + #f))) + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; SSL ports (define (mzssl-release mzssl) (call-with-semaphore @@ -183,7 +321,7 @@ (error 'pump-input-once "couldn't write all bytes to BIO!")) m)])))) - (define (pump-output-once mzssl need-progress?) + (define (pump-output-once mzssl need-progress? output-blocked-result) (let ([buffer (mzssl-buffer mzssl)] [pipe-r (mzssl-pipe-r mzssl)] [pipe-w (mzssl-pipe-w mzssl)] @@ -199,16 +337,17 @@ #f) (begin (write-bytes buffer pipe-w 0 n) - (pump-output-once mzssl need-progress?)))) + (pump-output-once mzssl need-progress? + output-blocked-result)))) (let ([n ((if need-progress? write-bytes-avail write-bytes-avail*) buffer o 0 n)]) (if (zero? n) - #f + output-blocked-result (begin (port-commit-peeked n (port-progress-evt pipe-r) always-evt pipe-r) #t))))))) (define (pump-output mzssl) - (when (pump-output-once mzssl #f) + (when (pump-output-once mzssl #f #f) (pump-output mzssl))) (define (make-ssl-input-port mzssl) @@ -233,7 +372,7 @@ (wrap-evt (mzssl-i mzssl) (lambda (x) 0)) (do-read buffer)))] [(= err SSL_ERROR_WANT_WRITE) - (if (pump-output-once mzssl #f) + (if (pump-output-once mzssl #f #f) (do-read buffer) (wrap-evt (mzssl-o mzssl) (lambda (x) 0)))] [else @@ -254,137 +393,218 @@ (mzssl-release mzssl)))) (define (make-ssl-output-port mzssl) - (make-output-port - (format "SSL ~a" (object-name (mzssl-o mzssl))) - (mzssl-o mzssl) - ;; write proc: - (letrec ([do-write - (lambda (buffer s e block-ok? enable-break?) - (pump-output mzssl) - (if (= s e) - 0 - (let ([n (SSL_write (mzssl-ssl mzssl) - (if (zero? s) - buffer - (subbytes buffer s e)) - (- e s))]) - (if (n . > . 0) - n - (let ([err (SSL_get_error (mzssl-ssl mzssl) n)]) - (cond - [(= err SSL_ERROR_WANT_READ) - (let ([n (pump-input-once mzssl #f)]) - (if (eq? n 0) - (wrap-evt (mzssl-i mzssl) (lambda (x) #f)) - (do-write buffer s e block-ok? enable-break?)))] - [(= err SSL_ERROR_WANT_WRITE) - (if (pump-output-once mzssl #f) - (do-write buffer s e block-ok? enable-break?) - (wrap-evt (mzssl-o mzssl) (lambda (x) #f)))] - [else - (error 'read-bytes "SSL read failed ~a" - (get-error-message (ERR_get_error)))]))))))] - [lock-unavailable - (lambda () (wrap-evt (mzssl-lock mzssl) (lambda (x) #f)))]) - (lambda (buffer s e block-ok? enable-break?) - (call-with-semaphore - (mzssl-lock mzssl) - do-write - lock-unavailable - buffer s e block-ok? enable-break?))) - ;; close proc: - (lambda () - ;; issue shutdown (i.e., EOF on read end) - (let loop () - (pump-output mzssl) - (let ([n (SSL_shutdown (mzssl-ssl mzssl))]) - (unless (= n 1) - (let ([err (SSL_get_error (mzssl-ssl mzssl) n)]) - (cond - [(= err SSL_ERROR_WANT_READ) - (pump-input-once mzssl #t) - (loop)] - [(= err SSL_ERROR_WANT_WRITE) - (pump-output-once mzssl #t) - (loop)] - [else - (error 'read-bytes "SSL shutdown failed ~a" - (get-error-message (ERR_get_error)))]))))) - (mzssl-release mzssl)))) + ;; Need a consistent buffer to use with SSL_write + ;; across calls to the port's write function. + (let ([xfer-buffer (make-bytes 512)]) + (make-output-port + (format "SSL ~a" (object-name (mzssl-o mzssl))) + (mzssl-o mzssl) + ;; write proc: + (letrec ([do-write + (lambda (len block-ok? enable-break?) + (pump-output mzssl) + (if (zero? len) + ;; Flush request; all data is in the the SSL + ;; stream, but how do we know that it's gone + ;; through the ports (which may involve both + ;; output and input)? It seems that making + ;; sure all output is gone is sufficient. + ;; We've already pumped output, but maybe some + ;; is stuck in the bio... + (parameterize-break + enable-break? + (let loop () + (flush-output (mzssl-o mzssl)) + (when (pump-output-once mzssl #f #t) + (loop))) + 0) + ;; Write request; even if blocking is ok, we treat + ;; it as non-blocking and let MzScheme handle blocking + (let ([n (SSL_write (mzssl-ssl mzssl) xfer-buffer len)]) + (if (n . > . 0) + n + (let ([err (SSL_get_error (mzssl-ssl mzssl) n)]) + (cond + [(= err SSL_ERROR_WANT_READ) + (let ([n (pump-input-once mzssl #f)]) + (if (eq? n 0) + (wrap-evt (mzssl-i mzssl) (lambda (x) #f)) + (do-write len block-ok? enable-break?)))] + [(= err SSL_ERROR_WANT_WRITE) + (if (pump-output-once mzssl #f #f) + (do-write len block-ok? enable-break?) + (wrap-evt (mzssl-o mzssl) (lambda (x) #f)))] + [else + (error 'read-bytes "SSL read failed ~a" + (get-error-message (ERR_get_error)))]))))))] + [top-write + (lambda (buffer s e block-ok? enable-break?) + (bytes-copy! xfer-buffer 0 buffer s e) + (do-write (- e s) block-ok? enable-break?))] + [lock-unavailable + (lambda () (wrap-evt (mzssl-lock mzssl) (lambda (x) #f)))]) + (lambda (buffer s e block-ok? enable-break?) + (call-with-semaphore + (mzssl-lock mzssl) + top-write + lock-unavailable + buffer s e block-ok? enable-break?))) + ;; close proc: + (lambda () + ;; issue shutdown (i.e., EOF on read end) + (let loop ([cnt 1]) + (pump-output mzssl) + (let ([n (SSL_shutdown (mzssl-ssl mzssl))]) + (if (= n 0) + ;; 0 seems to be the result in many cases because the socket + ;; is non-blocking, and then neither of the WANTs is returned. + ;; We address this by simply trying 10 times and then giving + ;; up. The two-step shutdown is optional, anyway. + (unless (cnt . >= . 10) + (loop (add1 cnt))) + (unless (= n 1) + (let ([err (SSL_get_error (mzssl-ssl mzssl) n)]) + (cond + [(= err SSL_ERROR_WANT_READ) + (pump-input-once mzssl #t) + (loop)] + [(= err SSL_ERROR_WANT_WRITE) + (pump-output-once mzssl #t #f) + (loop)] + [else + (error 'read-bytes "SSL shutdown failed ~a" + (get-error-message (ERR_get_error)))])))))) + (mzssl-release mzssl))))) (define (ports->ssl-ports i o context-or-encrypt-method connect/accept close?) - (let ([who 'input-port->ssl-input-port]) - (unless (input-port? i) - (raise-type-error who "input port" i)) - (unless (output-port? o) - (raise-type-error who "output port" o)) - (let ([ctx (get-context who context-or-encrypt-method)]) - (check-valid ctx who "context creation") - (with-failure - (lambda () (when (and ctx - (symbol? context-or-encrypt-method)) - (SSL_CTX_free ctx))) - (let ([connect? (case connect/accept - [(connect) #t] - [(accept) #f] - [else - (raise-type-error who "'connect or 'accept" - connect/accept)])] - [r-bio (BIO_new (BIO_s_mem))] - [w-bio (BIO_new (BIO_s_mem))] - [free-bio? #t]) - (with-failure - (lambda () (when free-bio? - (BIO_free r-bio) - (BIO_free w-bio))) - (let ([ssl (SSL_new ctx)]) - (check-valid ssl who "ssl setup") - ;; ssl has a ref count on ctx, so release: - (when (symbol? context-or-encrypt-method) - (SSL_CTX_free ctx) - (set! ctx #f)) - (with-failure - (lambda () (SSL_free ssl)) - (SSL_set_bio ssl r-bio w-bio) - ;; ssl has r-bio & w-bio (no ref count?), so drop it: - (set! free-bio? #f) - ;; connect/accept: - (let-values ([(buffer) (make-bytes 512)] - [(pipe-r pipe-w) (make-pipe)]) - (let ([mzssl (make-mzssl ssl i o r-bio w-bio pipe-r pipe-w buffer (make-semaphore 1) 2)]) - (let loop () - (let ([status (if connect? - (SSL_connect ssl) - (SSL_accept ssl))]) - (pump-output mzssl) - (when (status . < . 1) - (let ([err (SSL_get_error ssl status)]) - (cond - [(= err SSL_ERROR_WANT_READ) - (let ([n (pump-input-once mzssl #t)]) - (when (eof-object? n) - (error who "~a failed (input terminated prematurely)" - (if connect? "connect" "accept")))) - (loop)] - [(= err SSL_ERROR_WANT_WRITE) - (pump-output-once mzssl #t) - (loop)] - [else - (error who "~a failed ~a" - (if connect? "connect" "accept") - (get-error-message (ERR_get_error)))]))))) - ;; Connection complete; make ports - (values (make-ssl-input-port mzssl) - (make-ssl-output-port mzssl)))))))))))) + (wrap-ports 'port->ssl-ports i o context-or-encrypt-method connect/accept close?)) + + (define (wrap-ports who i o context-or-encrypt-method connect/accept close?) + (unless (input-port? i) + (raise-type-error who "input port" i)) + (unless (output-port? o) + (raise-type-error who "output port" o)) + (let ([ctx (get-context who context-or-encrypt-method (eq? connect/accept 'connect))]) + (check-valid ctx who "context creation") + (with-failure + (lambda () (when (and ctx + (symbol? context-or-encrypt-method)) + (SSL_CTX_free ctx))) + (let ([connect? (case connect/accept + [(connect) #t] + [(accept) #f] + [else + (raise-type-error who "'connect or 'accept" + connect/accept)])] + [r-bio (BIO_new (BIO_s_mem))] + [w-bio (BIO_new (BIO_s_mem))] + [free-bio? #t]) + (with-failure + (lambda () (when free-bio? + (BIO_free r-bio) + (BIO_free w-bio))) + (unless (or (symbol? context-or-encrypt-method) + (if connect? + (ssl-client-context? context-or-encrypt-method) + (ssl-server-context? context-or-encrypt-method))) + (error who + "'~a mode requires a ~a context, given: ~e" + (if connect? 'connect 'accept) + (if connect? "client" "server") + context-or-encrypt-method)) + (let ([ssl (SSL_new ctx)]) + (check-valid ssl who "ssl setup") + ;; ssl has a ref count on ctx, so release: + (when (symbol? context-or-encrypt-method) + (SSL_CTX_free ctx) + (set! ctx #f)) + (with-failure + (lambda () (SSL_free ssl)) + (SSL_set_bio ssl r-bio w-bio) + ;; ssl has r-bio & w-bio (no ref count?), so drop it: + (set! free-bio? #f) + ;; connect/accept: + (let-values ([(buffer) (make-bytes 512)] + [(pipe-r pipe-w) (make-pipe)]) + (let ([mzssl (make-mzssl ssl i o r-bio w-bio pipe-r pipe-w buffer (make-semaphore 1) 2)]) + (let loop () + (let ([status (if connect? + (SSL_connect ssl) + (SSL_accept ssl))]) + (pump-output mzssl) + (when (status . < . 1) + (let ([err (SSL_get_error ssl status)]) + (cond + [(= err SSL_ERROR_WANT_READ) + (let ([n (pump-input-once mzssl #t)]) + (when (eof-object? n) + (error who "~a failed (input terminated prematurely)" + (if connect? "connect" "accept")))) + (loop)] + [(= err SSL_ERROR_WANT_WRITE) + (pump-output-once mzssl #t #f) + (loop)] + [else + (error who "~a failed ~a" + (if connect? "connect" "accept") + (get-error-message (ERR_get_error)))]))))) + ;; Connection complete; make ports + (values (make-ssl-input-port mzssl) + (make-ssl-output-port mzssl))))))))))) + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; SSL listen + + (define ssl-listen + (opt-lambda (port-k [queue-k 5] [reuse? #f] [hostname-or-#f #f] [protocol-symbol-or-context default-encrypt]) + (let ([ctx (cond + [(ssl-server-context? protocol-symbol-or-context) protocol-symbol-or-context] + [else (make-context 'ssl-listen protocol-symbol-or-context "server context, " #f)])]) + (let ([l (tcp-listen port-k queue-k reuse? hostname-or-#f)]) + (make-ssl-listener l ctx))))) + + (define (ssl-close l) + (unless (ssl-listener? l) + (raise-type-error 'ssl-close "SSL listener" l)) + (tcp-close (ssl-listener-l l))) + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; SSL accept + + (define (do-ssl-accept who tcp-accept ssl-listener) + (let-values ([(i o) (tcp-accept (ssl-listener-l ssl-listener))]) + (wrap-ports who i o (ssl-listener-mzctx ssl-listener) 'accept #t))) + + (define (ssl-accept ssl-listener) + (do-ssl-accept 'ssl-accept tcp-accept ssl-listener)) + + (define (ssl-accept/enable-break ssl-listener) + (do-ssl-accept 'ssl-accept/enable-break tcp-accept/enable-break ssl-listener)) + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; SSL connect + + (define (do-ssl-connect who tcp-connect hostname port-k client-context-or-protocol-symbol) + (let-values ([(i o) (tcp-connect hostname port-k)]) + (wrap-ports who i o client-context-or-protocol-symbol 'connect #t))) + + (define ssl-connect + (opt-lambda (hostname port-k [client-context-or-protocol-symbol default-encrypt]) + (do-ssl-connect 'ssl-connect tcp-connect hostname port-k + client-context-or-protocol-symbol))) + + (define ssl-connect/enable-break + (opt-lambda (hostname port-k [client-context-or-protocol-symbol default-encrypt]) + (do-ssl-connect 'ssl-connect/enable-break tcp-connect/enable-break hostname port-k + client-context-or-protocol-symbol))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Initialization - (SSL_library_init) - (SSL_load_error_strings) + (define ssl-available? (and libssl #t)) + + (when ssl-available? + (SSL_library_init) + (SSL_load_error_strings)) ) - - - - \ No newline at end of file