Hi,
... and now version (4) with the dynamic-wind in the correct place:
-----
$ diff -upr v1.6.4-andyjpb-fix-3 v1.6.4-andyjpb-fix-4
Binary files v1.6.4-andyjpb-fix-3/openssl.import.so and
v1.6.4-andyjpb-fix-4/openssl.import.so differ
diff -upr v1.6.4-andyjpb-fix-3/openssl.scm v1.6.4-andyjpb-fix-4/openssl.scm
--- v1.6.4-andyjpb-fix-3/openssl.scm 2014-11-25 15:53:35.035152667 +0000
+++ v1.6.4-andyjpb-fix-4/openssl.scm 2014-11-25 16:21:59.105377994 +0000
@@ -481,17 +481,16 @@ EOF
(unbuffered-write buffer)))
;; close
(lambda ()
- (dynamic-wind
- void
- (lambda ()
- (when (startup #t)
- (if outbuf
- (begin
- (unbuffered-write outbuf 0 outbufsize)
- (set! outbufsize 0)))))
- (lambda ()
- (set! out-open? #f)
- (shutdown))))
+ (when (startup #t)
+ (dynamic-wind
+ void
+ (lambda ()
+ (when outbuf
+ (unbuffered-write outbuf 0 outbufsize)
+ (set! outbufsize 0)))
+ (lambda ()
+ (set! out-open? #f)
+ (shutdown)))))
;; flush
(lambda ()
(when outbuf
-----
Regards,
@ndy
--
[email protected]
http://www.ashurst.eu.org/
0x7EBA75FF
diff -upr v1.6.4/openssl.import.scm v1.6.4-andyjpb-fix-4/openssl.import.scm
--- v1.6.4/openssl.import.scm 2014-11-23 02:37:31.235897645 +0000
+++ v1.6.4-andyjpb-fix-4/openssl.import.scm 2014-11-23 02:13:16.085352751 +0000
@@ -1,6 +1,6 @@
;;;; openssl.import.scm - GENERATED BY CHICKEN 4.9.0rc1 -*- Scheme -*-
-(eval '(import scheme chicken foreign ports srfi-18 tcp))
+(eval '(import scheme chicken foreign ports srfi-13 srfi-18 tcp))
(##sys#register-compiled-module
'openssl
(list)
Binary files v1.6.4/openssl.import.so and v1.6.4-andyjpb-fix-4/openssl.import.so differ
diff -upr v1.6.4/openssl.scm v1.6.4-andyjpb-fix-4/openssl.scm
--- v1.6.4/openssl.scm 2014-11-23 00:07:52.324097414 +0000
+++ v1.6.4-andyjpb-fix-4/openssl.scm 2014-11-25 16:21:59.105377994 +0000
@@ -45,7 +45,7 @@
##sys#check-string
##sys#expand-home-path))
-(use srfi-18 tcp)
+(use srfi-13 srfi-18 tcp)
#>
#include <errno.h>
@@ -442,43 +442,61 @@ EOF
"SSL read timed out")))
buffer))))
(out
- (let* ((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* ((outbufmax (tcp-buffer-size))
+ (outbuf (and outbufmax (fx> outbufmax 0) (make-string outbufmax)))
+ (outbufsize 0)
+ (unbuffered-write
+ (lambda (buffer #!optional (offset 0) (size (##sys#size buffer)))
+ (when (> size 0) ; Undefined behaviour for 0 bytes!
+ (let loop ((offset offset) (size size))
(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)))))))))
+
+ (define (buffered-write data #!optional (start 0))
+ (let* ((size (- (##sys#size data) start))
+ (to-copy (min (- outbufmax outbufsize) size))
+ (left-over (- size to-copy)))
+
+ (string-copy! outbuf outbufsize data start (+ start to-copy))
+ (set! outbufsize (+ outbufsize to-copy))
+
+ (if (= outbufsize outbufmax)
+ (begin
+ (unbuffered-write outbuf)
+ (set! outbufsize 0)))
+
+ (if (> left-over 0)
+ (buffered-write data (+ start to-copy)))))
+
(make-output-port
;; write
(lambda (buffer)
+ (startup)
(if outbuf
- (begin
- (set! outbuf (string-append outbuf buffer))
- (when (fx>= (string-length outbuf) outbufsize)
- (output outbuf)
- (set! outbuf "")))
- (output buffer)))
+ (buffered-write buffer)
+ (unbuffered-write buffer)))
;; close
(lambda ()
(when (startup #t)
- (if outbuf
- (begin
- (output outbuf)
- (set! outbuf "")))
- (set! out-open? #f)
- (shutdown)))
+ (dynamic-wind
+ void
+ (lambda ()
+ (when outbuf
+ (unbuffered-write outbuf 0 outbufsize)
+ (set! outbufsize 0)))
+ (lambda ()
+ (set! out-open? #f)
+ (shutdown)))))
;; flush
(lambda ()
(when outbuf
- (output outbuf)
- (set! outbuf "")))))))
+ (startup)
+ (unbuffered-write outbuf 0 outbufsize)
+ (set! outbufsize 0)))))))
(##sys#setslot in 3 "(ssl)")
(##sys#setslot out 3 "(ssl)")
;; first "reserved" slot
Only in v1.6.4-andyjpb-fix-4: openssl.scm~
Only in v1.6.4-andyjpb-fix-4: .openssl.scm.swp
Binary files v1.6.4/openssl.so and v1.6.4-andyjpb-fix-4/openssl.so differ
Binary files v1.6.4/openssl-static.o and v1.6.4-andyjpb-fix-4/openssl-static.o differ
_______________________________________________
Chicken-users mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-users
