Welcome to the chicken scheme pasting service

Patch of openssl pasted by LemonBoy on Thu Aug 24 23:09:10 2017

diff --git a/openssl.scm b/openssl.scm
index 0c8819d..2f92125 100644
--- a/openssl.scm
+++ b/openssl.scm
@@ -276,6 +276,17 @@ 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))
+	     "return(C_fix(SSL_read((SSL *)ssl, (char *)buf + offset, size)));\n")
+	     ssl buffer offset size)))
+    (if (fx< ret 0)
+	(ssl-result-or-abort 'ssl-read! ssl ret #t)
+	ret)))
+
 (define (ssl-get-char ssl)
   (ssl-clear-error)
   (let ((ret
@@ -294,6 +305,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 +458,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 +479,18 @@ 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)))

v2 pasted by LemonBoy on Fri Aug 25 14:04:45 2017

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)))

v3 added by LemonBoy on Sun Aug 27 16:48:37 2017

diff --git a/openssl.scm b/openssl.scm
index 0c8819d..56c1e74 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
@@ -424,46 +458,42 @@ EOF
 	      (ssl-free ssl)
 	      (net-close-socket fd)))))
     (let ((in
-	   (let ((buffer #f))
-	     (make-input-port
+	    (make-input-port
 	      ;; 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))
+		(startup)
+		(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)))))
+		(startup)
+		(let ((ret (ssl-peek-char ssl)))
+		  (case ret
+		    ((want-read want-write)
+		     #f)
+		    (else
+		      #t))))
 	      ;; close
 	      (lambda ()
-                (when (startup #t)
-                  (set! in-open? #f)
-                  (shutdown)))
+		(when (startup #t)
+		  (set! in-open? #f)
+		  (shutdown)))
 	      ;; 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))))
+		(startup)
+		(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)))

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
Type in the text below:
                                        
 _ __ ___ _ __ ___  _ __ ___  ___  ___  
| '__/ _ \ '_ ` _ \| '_ ` _ \/ __|/ _ \ 
| | |  __/ | | | | | | | | | \__ \ (_) |
|_|  \___|_| |_| |_|_| |_| |_|___/\___/ 
                                        
Visually impaired? Let me spell it for you (wav file) download WAV