Changeset 34564 in project


Ignore:
Timestamp:
09/17/17 16:39:28 (3 months ago)
Author:
chust
Message:

[openssl] Improved block I/O patch thanks to TheLemonMan?

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/openssl/trunk/openssl.scm

    r34423 r34564  
    277277        ret)))
    278278
     279(define (ssl-read! ssl buffer offset size)
     280  (ssl-clear-error)
     281  (let ((ret
     282          ((foreign-lambda*
     283             scheme-object ((c-pointer ssl) (scheme-pointer buf) (int offset) (int size))
     284             "int ret;\n"
     285             "switch (ret = SSL_read((SSL *)ssl, (char *)buf + offset, size)) {\n"
     286             "case 0: return(SSL_get_error((SSL *)ssl, 0) == SSL_ERROR_ZERO_RETURN ?\n"
     287             "               C_SCHEME_END_OF_FILE : C_fix(0));\n"
     288             "default: return(C_fix(ret));\n"
     289             "}\n")
     290             ssl buffer offset size)))
     291    (cond ((eof-object? ret) 0)
     292          ((fx> ret 0) ret)
     293          (else (ssl-result-or-abort 'ssl-read! ssl ret #t)))))
     294
    279295(define (ssl-get-char ssl)
    280296  (ssl-clear-error)
     
    293309    (if (fixnum? ret)
    294310        (ssl-result-or-abort 'ssl-get-char ssl ret #t)
     311        ret)))
     312
     313(define (ssl-peek-char ssl)
     314  (ssl-clear-error)
     315  (let ((ret
     316         ((foreign-lambda*
     317           scheme-object ((c-pointer ssl))
     318           "unsigned char ch;\n"
     319           "int ret;\n"
     320           "switch (ret = SSL_peek((SSL *)ssl, &ch, 1)) {\n"
     321           "case 0: return(SSL_get_error((SSL *)ssl, 0) == SSL_ERROR_ZERO_RETURN ?\n"
     322           "               C_SCHEME_END_OF_FILE : C_fix(0));\n"
     323           "case 1: return(C_make_character(ch));\n"
     324           "default: return(C_fix(ret));\n"
     325           "}\n")
     326          ssl)))
     327    (if (fixnum? ret)
     328        (ssl-result-or-abort 'ssl-peek-char ssl ret #t)
    295329        ret)))
    296330
     
    425459              (net-close-socket fd)))))
    426460    (let ((in
    427            (let ((buffer #f))
    428              (make-input-port
     461            (make-input-port
    429462              ;; read
    430463              (lambda ()
    431                 (startup)
    432                 (unless buffer
    433                   (set! buffer
    434                         (ssl-call/timeout 'ssl-get-char
    435                                           (lambda () (ssl-get-char ssl))
    436                                           fd (tcp-read-timeout)
    437                                           "SSL read timed out")))
    438                 (let ((ch buffer))
    439                   (unless (eof-object? buffer)
    440                     (set! buffer #f))
    441                   ch))
     464                (startup)
     465                (ssl-call/timeout 'ssl-get-char
     466                                  (lambda () (ssl-get-char ssl))
     467                                  fd (tcp-read-timeout)
     468                                  "SSL read timed out"))
    442469              ;; ready?
    443470              (lambda ()
    444                 (startup)
    445                 (or buffer
    446                     (let ((ret (ssl-get-char ssl)))
    447                       (case ret
    448                         ((want-read want-write)
    449                          #f)
    450                         (else
    451                          (set! buffer ret)
    452                          #t)))))
     471                (startup)
     472                (let ((ret (ssl-peek-char ssl)))
     473                  (case ret
     474                    ((want-read want-write)
     475                     #f)
     476                    (else
     477                      #t))))
    453478              ;; close
    454479              (lambda ()
    455                 (when (startup #t)
    456                   (set! in-open? #f)
    457                   (shutdown)))
     480                (when (startup #t)
     481                  (set! in-open? #f)
     482                  (shutdown)))
    458483              ;; peek
    459484              (lambda ()
    460                 (startup)
    461                 (unless buffer
    462                   (set! buffer (ssl-call/timeout 'ssl-peek-char
    463                                                  (lambda () (ssl-get-char ssl))
    464                                                  fd (tcp-read-timeout)
    465                                                  "SSL read timed out")))
    466                 buffer))))
     485                (startup)
     486                (ssl-call/timeout 'ssl-peek-char
     487                                  (lambda () (ssl-peek-char ssl))
     488                                  fd (tcp-read-timeout)
     489                                  "SSL read timed out"))
     490              ;; read-string!
     491              (lambda (port size buf offset)
     492                (startup)
     493                (ssl-call/timeout 'ssl-read!
     494                                  (lambda () (ssl-read! ssl buf offset size))
     495                                  fd (tcp-read-timeout)
     496                                  "SSL read timed out"))))
    467497    (out
    468498      (let* ((outbufmax  (tcp-buffer-size))
Note: See TracChangeset for help on using the changeset viewer.