Dear all,
As part of some of the work I am doing, I have written a patch for the OpenSSL
egg to provide buffering for packets, similar to the tcp egg.
If you inspect a Spiffy webserver in SSL mode using Wireshark, you will notice
that a single request has many packets, in some cases one packet per HTTP
header. With buffering support, these are reduced down to, in many cases, one
packet per request. As the underlying TCP protocol requires acknowledgement of
every request, this leads to an incredibly large number of packets in both
direction, so there should be a reduction in bandwidth used by use of this
patch.
As a convenience for people who implement both unencrypted TCP and SSL in their
software, the buffer size is taken from the tcp-buffer-size parameter.
I would very much appreciate any feedback or comments that people have to offer.
Many thanks,
Philip Kent
Philip Kent
Software Engineering Intern
Knodium
--- openssl/openssl.scm 2013-07-02 17:52:17.369403454 +0100
+++ openssl2/openssl.scm 2013-07-02 17:34:32.194484359 +0100
@@ -441,24 +442,43 @@ EOF
fd (tcp-read-timeout)
"SSL read timed out")))
buffer))))
- (out
- (make-output-port
- ;; write
- (lambda (buffer)
- (startup)
- (when (> (##sys#size buffer) 0) ; Undefined behaviour for 0 bytes!
- (let loop ((offset 0) (size (##sys#size buffer)))
- (let ((ret (ssl-call/timeout
- 'ssl-write
- (lambda () (ssl-write ssl buffer offset size))
- fd (tcp-write-timeout) "SSL write timed out")))
- (when (fx< ret size) ; Partial write
- (loop (fx+ offset ret) (fx- size ret)))))))
- ;; close
- (lambda ()
- (when (startup #t)
- (set! out-open? #f)
- (shutdown))))))
+ (out
+ (let* ((buffer #f)
+ (outbufsize (tcp-buffer-size))
+ (outbuf (and outbufsize (fx> outbufsize 0) ""))
+ (output
+ (lambda (buffer)
+ (startup)
+ (when (> (##sys#size buffer) 0) ; Undefined behaviour for 0 bytes!
+ (let loop ((offset 0) (size (##sys#size buffer)))
+ (let ((ret (ssl-call/timeout
+ 'ssl-write
+ (lambda () (ssl-write ssl buffer offset size))
+ fd (tcp-write-timeout) "SSL write timed out")))
+ (when (fx< ret size) ; Partial write
+ (loop (fx+ offset ret) (fx- size ret)))))))))
+ (make-output-port
+ ;; write
+ (lambda (buffer)
+ (if outbuf
+ (begin(set! outbuf (string-append outbuf buffer))
+ (when (fx>= (string-length outbuf) outbufsize)
+ (output outbuf)
+ (set! outbuf "")))
+ (output buffer)))
+ ;; close
+ (lambda ()
+ (when (startup #t)
+ (if outbuf
+ (begin (output outbuf)
+ (set! outbuf "")))
+ (set! out-open? #f)
+ (shutdown)))
+ ;; flush
+ (lambda ()
+ (if outbuf
+ (begin (output outbuf)
+ (set! outbuf ""))))))))
(##sys#setslot in 3 "(ssl)")
(##sys#setslot out 3 "(ssl)")
;; first "reserved" slot
_______________________________________________
Chicken-users mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-users
