[Chicken-users] [PATCH 3/4] openssl: invoke ERR_clear_error()

[Florian Zumbiehl]

In order to make error checking reliable, invoke ERR_clear_error() before
attempting any OpenSSL operations that might fail.
---
 openssl.scm |   13 +++++++++++++
 1 files changed, 13 insertions(+), 0 deletions(-)

diff --git a/openssl.scm b/openssl.scm
index 6aafcc9..d43b228 100644
--- a/openssl.scm
+++ b/openssl.scm
@@ -141,9 +141,12 @@ EOF
        'status
        sym)))))
 
+(define ssl-clear-error (foreign-lambda void "ERR_clear_error"))
+
 (define ssl-ctx-free (foreign-lambda void "SSL_CTX_free" c-pointer))
 
 (define (ssl-ctx-new protocol server)
+  (ssl-clear-error)
   (let ((ctx
         ((foreign-lambda*
           c-pointer ((c-pointer method))
@@ -184,6 +187,7 @@ EOF
     ctx))
 
 (define (ssl-new ctx)
+  (ssl-clear-error)
   (cond
    (((foreign-lambda c-pointer "SSL_new" c-pointer) ctx)
     => values)
@@ -226,6 +230,7 @@ EOF
        (apply ssl-abort loc sym args)))))
 
 (define (ssl-set-fd! ssl fd)
+  (ssl-clear-error)
   (ssl-result-or-abort
    'ssl-set-fd! ssl
    ((foreign-lambda int "SSL_set_fd" c-pointer int) ssl fd) #f
@@ -233,6 +238,7 @@ EOF
   (void))
 
 (define (ssl-shutdown ssl)
+  (ssl-clear-error)
   (let ((ret
         ((foreign-lambda*
           scheme-object ((c-pointer ssl))
@@ -247,6 +253,7 @@ EOF
        ret)))
 
 (define (ssl-get-char ssl)
+  (ssl-clear-error)
   (let ((ret
         ((foreign-lambda*
           scheme-object ((c-pointer ssl))
@@ -264,6 +271,7 @@ EOF
        ret)))
 
 (define (ssl-write ssl buffer offset size)
+  (ssl-clear-error)
   (ssl-result-or-abort
    'ssl-write ssl
    ((foreign-lambda*
@@ -313,6 +321,7 @@ EOF
          'type)))))
 
 (define (ssl-do-handshake ssl)
+  (ssl-clear-error)
   (ssl-result-or-abort 'ssl-do-handshake ssl
                        ((foreign-lambda int "SSL_do_handshake" c-pointer) ssl) 
#t))
 
@@ -546,6 +555,7 @@ EOF
 ;; load identifying certificate chain into SSL context
 (define (ssl-load-certificate-chain! obj pathname)
   (##sys#check-string pathname)
+  (ssl-clear-error)
   (unless (eq?
           ((foreign-lambda
             int "SSL_CTX_use_certificate_chain_file" c-pointer c-string)
@@ -556,6 +566,7 @@ EOF
 ;; load the private key for the identifying certificate chain
 (define (ssl-load-private-key! obj pathname #!optional (rsa? #t) (asn1? #f))
   (##sys#check-string pathname)
+  (ssl-clear-error)
   (unless (eq?
           ((foreign-lambda*
             int ((c-pointer ctx) (c-string path) (bool rsa) (bool asn1))
@@ -586,6 +597,7 @@ EOF
 (define (ssl-load-verify-root-certificates! obj pathname #!optional (dirname 
#f))
   (if pathname (##sys#check-string pathname))
   (if dirname (##sys#check-string dirname))
+  (ssl-clear-error)
   (unless (eq?
           ((foreign-lambda
             int "SSL_CTX_load_verify_locations" c-pointer c-string c-string)
@@ -598,6 +610,7 @@ EOF
 ;; load suggested root certificates into SSL context
 (define (ssl-load-suggested-certificate-authorities! obj pathname)
   (##sys#check-string pathname)
+  (ssl-clear-error)
   (cond
    (((foreign-lambda c-pointer "SSL_load_client_CA_file" c-string)
      (##sys#expand-home-path pathname))
-- 
1.7.2.5