openssl: more little fixes

Fix an error message broken by earlier debugging, and also
fix long-standing shutdown problems. Move basic tests to more
standard location.

collects/meta/props

@@ -1849,7 +1849,6 @@ path/s is either such a string or a list of them.
 "collects/tests/racket/object-old.rktl" drdr:command-line #f
 "collects/tests/racket/object.rktl" drdr:command-line #f
 "collects/tests/racket/oe.rktl" drdr:command-line (racket "-f" *)
-"collects/tests/racket/openssl.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/racket/optimize.rktl" drdr:command-line #f
 "collects/tests/racket/pack.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/racket/package-gen.rktl" drdr:command-line (racket "-f" *) drdr:timeout 600

collects/openssl/mzssl.rkt

@@ -315,6 +315,7 @@
      (define e (if (positive? v)
                    0
                    (SSL_get_error ssl v)))
+     (define unknown "(unknown error)")
      (define estr
        (cond
         [(= e SSL_ERROR_SSL)
@@ -322,9 +323,9 @@
         [(= e SSL_ERROR_SYSCALL)
          (define v (ERR_get_error))
          (if (zero? v)
-             (get-error-message v)
+             unknown
-             #f)]
+             (get-error-message v))]
-        [else #f]))
+        [else unknown]))
      (values v e estr)))
 
   (define-syntax-rule (save-errors e ssl)
@@ -649,7 +650,7 @@
 			      [else
                                (set! must-read-len #f)
 			       ((mzssl-error mzssl) 'read-bytes 
-                                "SSL read failed ~a ~a"
+                                "SSL read failed ~a"
                                 estr)]))))))]
 		[top-read
 		 (lambda (buffer)
@@ -879,14 +880,17 @@
 		     ;; issue shutdown (i.e., EOF on read end)
 		     (when (mzssl-shutdown-on-close? mzssl)
 		       (let loop ([cnt 0])
-			 (let ([out-blocked? (flush-ssl mzssl #f)])
+			 (let ()
+                           (flush-ssl mzssl #f)
 			   (let-values ([(n err estr) (save-errors (SSL_shutdown (mzssl-ssl mzssl))
                                                                    (mzssl-ssl mzssl))])
-			     (unless (= n 1)
+                             
-			       (let ()
+                             (if (= n 1)
+                                 (flush-ssl mzssl #f)
                                  (cond
                                   [(= err SSL_ERROR_WANT_READ)
-				   (pump-input-once mzssl (if out-blocked? (mzssl-o mzssl) #t))
+                                   (let ([out-blocked? (pump-output mzssl)])
+                                     (pump-input-once mzssl (if out-blocked? (mzssl-o mzssl) #t)))
                                    (loop cnt)]
                                   [(= err SSL_ERROR_WANT_WRITE)
                                    (pump-output-once mzssl #t #f)
@@ -900,7 +904,7 @@
                                          (loop (add1 cnt)))
                                        ((mzssl-error mzssl) 'read-bytes 
                                         "SSL shutdown failed ~a"
-                                        estr))])))))))
+                                        estr))]))))))
 		     (set-mzssl-w-closed?! mzssl #t)
 		     (mzssl-release mzssl)
 		     #f]))]

collects/tests/openssl/basic.rkt

@@ -1,13 +1,22 @@
-
+#lang racket
-(load-relative "loadtest.rktl")
-
-(Section 'openssl)
-
 (require openssl/mzssl)
 
 (define pem (build-path (collection-path "openssl")
 			"test.pem"))
 
+(define errs? #f)
+(define (test expect f . args)
+  (printf "~s ~s => " f args)
+  (define v (apply f args))
+  (printf "~s\n" v)
+  (unless (equal? expect v)
+    (printf "BUT EXPECTED ~s\n" expect)
+    (set! errs? #t)))
+
+(define-syntax-rule (err/rt-test e exn?)
+  (test 'ok values (with-handlers ([exn? (lambda (x) 'ok)])
+                     e)))
+
 (define (test-ssl limit buffer? close?)
   ;; Test SSL communication using a limited pipe.
   ;; (Using a pipe limited to a small buffer helps make sure
@@ -47,7 +56,7 @@
 		  (close-output-port w)))))
     (thread-wait t1)
     (thread-wait t2)
-    ;; Check that ports were closed not:
+    ;; Check that ports were closed or not:
     (if close?
 	(begin
 	  (err/rt-test (read-byte r1) exn:fail?)
@@ -70,5 +79,7 @@
 (test-ssl 100 #t #f)
 (test-ssl 100 #f #f)
 
-
+(newline)
-(report-errs)
+(when errs?
+  (error "There were test failures"))
+(printf "All tests passed.\n")

collects/tests/openssl/https.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require net/url)
 
+;; try a basic HTTPS connection:
 (unless (input-port? (get-pure-port (string->url "https://api.github.com/")))
   (error "failed for https://api.github.com/"))