diff --git a/openssl.scm b/openssl.scm index 0c8819d..d276801 100644 --- a/openssl.scm +++ b/openssl.scm @@ -276,6 +276,22 @@ EOF (ssl-result-or-abort 'ssl-shutdown ssl ret #t) ret))) +(define (ssl-read! ssl buffer offset size) + (ssl-clear-error) + (let ((ret + ((foreign-lambda* + scheme-object ((c-pointer ssl) (scheme-pointer buf) (int offset) (int size)) + "int ret;\n" + "switch (ret = SSL_read((SSL *)ssl, (char *)buf + offset, size)) {\n" + "case 0: return(SSL_get_error((SSL *)ssl, 0) == SSL_ERROR_ZERO_RETURN ?\n" + " C_SCHEME_END_OF_FILE : C_fix(0));\n" + "default: return(C_fix(ret));\n" + "}\n") + ssl buffer offset size))) + (cond ((eof-object? ret) 0) + ((fx> ret 0) ret) + (else (ssl-result-or-abort 'ssl-read! ssl ret #t))))) + (define (ssl-get-char ssl) (ssl-clear-error) (let ((ret @@ -294,6 +310,24 @@ EOF (ssl-result-or-abort 'ssl-get-char ssl ret #t) ret))) +(define (ssl-peek-char ssl) + (ssl-clear-error) + (let ((ret + ((foreign-lambda* + scheme-object ((c-pointer ssl)) + "unsigned char ch;\n" + "int ret;\n" + "switch (ret = SSL_peek((SSL *)ssl, &ch, 1)) {\n" + "case 0: return(SSL_get_error((SSL *)ssl, 0) == SSL_ERROR_ZERO_RETURN ?\n" + " C_SCHEME_END_OF_FILE : C_fix(0));\n" + "case 1: return(C_make_character(ch));\n" + "default: return(C_fix(ret));\n" + "}\n") + ssl))) + (if (fixnum? ret) + (ssl-result-or-abort 'ssl-peek-char ssl ret #t) + ret))) + (define (ssl-write ssl buffer offset size) (ssl-clear-error) (ssl-result-or-abort @@ -429,27 +463,19 @@ EOF ;; read (lambda () (startup) - (unless buffer - (set! buffer - (ssl-call/timeout 'ssl-get-char - (lambda () (ssl-get-char ssl)) - fd (tcp-read-timeout) - "SSL read timed out"))) - (let ((ch buffer)) - (unless (eof-object? buffer) - (set! buffer #f)) - ch)) + (ssl-call/timeout 'ssl-get-char + (lambda () (ssl-get-char ssl)) + fd (tcp-read-timeout) + "SSL read timed out")) ;; ready? (lambda () (startup) - (or buffer - (let ((ret (ssl-get-char ssl))) - (case ret - ((want-read want-write) - #f) - (else - (set! buffer ret) - #t))))) + (let ((ret (ssl-peek-char ssl))) + (case ret + ((want-read want-write) + #f) + (else + #t)))) ;; close (lambda () (when (startup #t) @@ -458,12 +484,17 @@ EOF ;; peek (lambda () (startup) - (unless buffer - (set! buffer (ssl-call/timeout 'ssl-peek-char - (lambda () (ssl-get-char ssl)) - fd (tcp-read-timeout) - "SSL read timed out"))) - buffer)))) + (ssl-call/timeout 'ssl-peek-char + (lambda () (ssl-peek-char ssl)) + fd (tcp-read-timeout) + "SSL read timed out")) + ;; read-string! + (lambda (port size buf offset) + (startup) + (ssl-call/timeout 'ssl-read! + (lambda () (ssl-read! ssl buf offset size)) + fd (tcp-read-timeout) + "SSL read timed out"))))) (out (let* ((outbufmax (tcp-buffer-size)) (outbuf (and outbufmax (fx> outbufmax 0) (make-string outbufmax)))