From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Christopher Allan Webber Newsgroups: gmane.lisp.guile.bugs Subject: bug#24075: tls/https support in Guile (through r6rs binary ports?) Date: Sun, 21 Aug 2016 10:58:29 -0500 Message-ID: <878tvqqfkq.fsf@dustycloud.org> References: <8760rss8al.fsf@dustycloud.org> <87a8gstgn6.fsf@pobox.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1471795162 977 195.159.176.226 (21 Aug 2016 15:59:22 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 21 Aug 2016 15:59:22 +0000 (UTC) User-Agent: mu4e 0.9.16; emacs 24.5.1 Cc: 24075@debbugs.gnu.org To: Andy Wingo Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Sun Aug 21 17:59:17 2016 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bbV9Y-0008Lt-SC for guile-bugs@m.gmane.org; Sun, 21 Aug 2016 17:59:17 +0200 Original-Received: from localhost ([::1]:37311 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bbV9W-0005of-8d for guile-bugs@m.gmane.org; Sun, 21 Aug 2016 11:59:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:42273) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bbV9P-0005oV-7j for bug-guile@gnu.org; Sun, 21 Aug 2016 11:59:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bbV9K-0006ek-3N for bug-guile@gnu.org; Sun, 21 Aug 2016 11:59:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:38269) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bbV9J-0006ef-UP for bug-guile@gnu.org; Sun, 21 Aug 2016 11:59:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1bbV9J-0000Nw-PH for bug-guile@gnu.org; Sun, 21 Aug 2016 11:59:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Christopher Allan Webber Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Sun, 21 Aug 2016 15:59:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 24075 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 24075-submit@debbugs.gnu.org id=B24075.14717951141446 (code B ref 24075); Sun, 21 Aug 2016 15:59:01 +0000 Original-Received: (at 24075) by debbugs.gnu.org; 21 Aug 2016 15:58:34 +0000 Original-Received: from localhost ([127.0.0.1]:35981 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bbV8r-0000NF-VX for submit@debbugs.gnu.org; Sun, 21 Aug 2016 11:58:34 -0400 Original-Received: from dustycloud.org ([50.116.34.160]:55634) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bbV8p-0000N7-UN for 24075@debbugs.gnu.org; Sun, 21 Aug 2016 11:58:32 -0400 Original-Received: from oolong (localhost [127.0.0.1]) by dustycloud.org (Postfix) with ESMTPS id 2A0B3266EB; Sun, 21 Aug 2016 11:58:30 -0400 (EDT) In-reply-to: <87a8gstgn6.fsf@pobox.com> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.org gmane.lisp.guile.bugs:8383 Archived-At: --=-=-= Content-Type: text/plain Andy Wingo writes: > On Tue 26 Jul 2016 17:55, Christopher Allan Webber writes: > >> I've been told on IRC that the "right solution" is to add r6rs style >> binary ports: >> >> http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-9.html >> >> So maybe that's what should be done? > > I did this :) Missing some tests though and indeed completely > untested. Please give it a go then we can see about implementing TLS > ports on top of that. > > Andy Here's two patches. The first fixes some of the section names in the r6rs-ports.test file, and can be applied to master immediately. The second patch is the tests. I ported tests in the most naive way possible: copy/pasting the custom-binary-input-port and custom-binary-output-port tests and adjusting for the custom-binary-input/output-port. It's not ideal, a bit spaghetti'ish, but maybe that's okay? I'm not sure. However, two are not working: one fails and one errors, with the following: FAIL: r6rs-ports.test: 8.2.13 Input/output ports: custom binary input/output port supports `port-position', not `set-port-position!' - arguments: (expected-value 42 actual-value #f) ERROR: r6rs-ports.test: 8.2.13 Input/output ports: custom binary input/output port unbuffered & 'port-position' - arguments: ((misc-error "seek" "port is not seekable" (#) #f)) I'm not sure if this is an error on my side, features not supported by the new ports, or legitimate test failures. I'll try to do more research, but if someone who's more knowledgable knows what's going on, maybe that would speed things up. - Chris --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Correct-section-number-for-Input-Ports-tests.patch >From 1f9d6ea0ae18557789c39342d04aec33d2156207 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Thu, 11 Aug 2016 17:06:10 -0500 Subject: [PATCH 1/2] Correct section number for "Input Ports" tests. * test-suite/tests/r6rs-ports.test: Correct "Input Ports" section heading from "7.2.7" -> "8.2.7", "7.2.5" -> "8.2.5", "7.2.8" -> "8.2.8", and "7.2.11" -> "8.2.11". --- test-suite/tests/r6rs-ports.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index b3f11bb..9aa605b 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -74,7 +74,7 @@ receiver)))) -(with-test-prefix "7.2.5 End-of-File Object" +(with-test-prefix "8.2.5 End-of-File Object" (pass-if "eof-object" (and (eqv? (eof-object) (eof-object)) @@ -84,7 +84,7 @@ (port-eof? (open-input-string "")))) -(with-test-prefix "7.2.8 Binary Input" +(with-test-prefix "8.2.8 Binary Input" (pass-if "get-u8" (let ((port (open-input-string "A"))) @@ -236,7 +236,7 @@ (lambda () #t)) ;; close-port "rw"))) -(with-test-prefix "7.2.11 Binary Output" +(with-test-prefix "8.2.11 Binary Output" (pass-if "put-u8" (let ((port (make-soft-output-port))) @@ -328,7 +328,7 @@ (delete-file filename)) -(with-test-prefix "7.2.7 Input Ports" +(with-test-prefix "8.2.7 Input Ports" (with-test-prefix "open-file-input-port" (test-input-file-opener open-file-input-port (test-file))) -- 2.9.2 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0002-Add-tests-for-make-custom-binary-input-output-port.patch Content-Transfer-Encoding: 8bit >From 297dc06f1bfbb49f636018944f0a1c114d6778ea Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 20 Aug 2016 16:20:53 -0500 Subject: [PATCH 2/2] Add tests for make-custom-binary-input/output-port * test-suite/tests/r6rs-ports.test ("8.2.13 Input/output ports"): Add tests for custom binary input/output ports, copied from existing binary input and binary output tests. --- test-suite/tests/r6rs-ports.test | 383 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 382 insertions(+), 1 deletion(-) diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 9aa605b..94d9fc0 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -1059,11 +1059,392 @@ not `set-port-position!'" values)) (delete-file filename))) +;; Used for a lot of the make-custom-input/output tests to stub out +;; the read/write section for whatever part we're ignoring +(define dummy-write! (const 0)) +(define dummy-read! (const 0)) + (with-test-prefix "8.2.13 Input/output ports" (with-test-prefix "open-file-input/output-port [output]" (test-output-file-opener open-file-input/output-port (test-file))) (with-test-prefix "open-file-input/output-port [input]" - (test-input-file-opener open-file-input/output-port (test-file)))) + (test-input-file-opener open-file-input/output-port (test-file))) + + ;; Custom binary input/output tests. Most of these are simple + ;; ports of the custom-binary-input-port tests or custom-binary-ouput-port + ;; tests, simply ported to use a custom-binary-input/output port. + ;; The copy-pasta is strong here; a diet lighter in spaghetti may wish + ;; to make the previous tests more reusable. + (pass-if "make-custom-binary-input/output-port" + (let* ((source (make-bytevector 7777)) + (read! (let ((pos 0) + (len (bytevector-length source))) + (lambda (bv start count) + (let ((amount (min count (- len pos)))) + (if (> amount 0) + (bytevector-copy! source pos + bv start amount)) + (set! pos (+ pos amount)) + amount)))) + (write! (lambda (x y z) 0)) + (port (make-custom-binary-input/output-port + "the port" read! write! + #f #f #f))) + (and (binary-port? port) + (input-port? port) + (output-port? port) + (bytevector=? (get-bytevector-all port) source) + (not (port-has-port-position? port)) + (not (port-has-set-port-position!? port))))) + + (pass-if-equal "make-custom-binary-input/output-port uses ISO-8859-1 (Guile \ +extension) [input]" + "©©" + (with-fluids ((%default-port-encoding "UTF-8")) + (let* ((source #vu8(194 169 194 169)) + (read! (let ((pos 0) + (len (bytevector-length source))) + (lambda (bv start count) + (let ((amount (min count (- len pos)))) + (if (> amount 0) + (bytevector-copy! source pos + bv start amount)) + (set! pos (+ pos amount)) + amount)))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + #f #f #f))) + (get-string-all port)))) + + (pass-if "custom binary input/output port does not support `port-position'" + (let* ((str "Hello Port!") + (source (open-bytevector-input-port + (u8-list->bytevector + (map char->integer (string->list str))))) + (read! (lambda (bv start count) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + #f #f #f))) + (not (or (port-has-port-position? port) + (port-has-set-port-position!? port))))) + + (pass-if-exception "custom binary input/output port 'read!' returns too much" + exception:out-of-range + ;; In Guile <= 2.0.9 this would segfault. + (let* ((read! (lambda (bv start count) + (+ count 4242))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + #f #f #f))) + (get-bytevector-all port))) + + (pass-if-equal "custom binary input/output port supports `port-position', \ +not `set-port-position!'" + 42 + (let ((port (make-custom-binary-input/output-port + "the port" (const 0) dummy-write! + (const 42) #f #f))) + (and (port-has-port-position? port) + (not (port-has-set-port-position!? port)) + (port-position port)))) + + (pass-if "custom binary input/output port supports `port-position'" + (let* ((str "Hello Port!") + (source (open-bytevector-input-port + (u8-list->bytevector + (map char->integer (string->list str))))) + (read! (lambda (bv start count) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (get-pos (lambda () + (port-position source))) + (set-pos! (lambda (pos) + (set-port-position! source pos))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + get-pos set-pos! #f))) + + (and (port-has-port-position? port) + (= 0 (port-position port)) + (port-has-set-port-position!? port) + (begin + (set-port-position! port 6) + (= 6 (port-position port))) + (bytevector=? (get-bytevector-all port) + (u8-list->bytevector + (map char->integer (string->list "Port!"))))))) + + (pass-if-equal "custom binary input/output port buffered partial reads" + "Hello Port!" + ;; Check what happens when READ! returns less than COUNT bytes. + (let* ((src (string->utf8 "Hello Port!")) + (chunks '(2 4 5)) ; provide 2 bytes, then 4, etc. + (offset 0) + (read! (lambda (bv start count) + (match chunks + ((count rest ...) + (bytevector-copy! src offset bv start count) + (set! chunks rest) + (set! offset (+ offset count)) + count) + (() + 0)))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + #f #f #f))) + (get-string-all port))) + + (pass-if-equal "custom binary input/output port unbuffered & 'port-position'" + '(0 2 5 11) + ;; Check that the value returned by 'port-position' is correct, and + ;; that each 'port-position' call leads one call to the + ;; 'get-position' method. + (let* ((str "Hello Port!") + (output (make-bytevector (string-length str))) + (source (with-fluids ((%default-port-encoding "UTF-8")) + (open-string-input-port str))) + (read! (lambda (bv start count) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (pos '()) + (get-pos (lambda () + (let ((p (port-position source))) + (set! pos (cons p pos)) + p))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + get-pos #f #f))) + (setvbuf port 'none) + (and (= 0 (port-position port)) + (begin + (get-bytevector-n! port output 0 2) + (= 2 (port-position port))) + (begin + (get-bytevector-n! port output 2 3) + (= 5 (port-position port))) + (let ((bv (string->utf8 (get-string-all port)))) + (bytevector-copy! bv 0 output 5 (bytevector-length bv)) + (= (string-length str) (port-position port))) + (bytevector=? output (string->utf8 str)) + (reverse pos)))) + + (pass-if-equal "custom binary input/output port unbuffered & 'read!' calls" + `((2 "He") (3 "llo") (42 " Port!")) + (let* ((str "Hello Port!") + (source (with-fluids ((%default-port-encoding "UTF-8")) + (open-string-input-port str))) + (reads '()) + (read! (lambda (bv start count) + (set! reads (cons count reads)) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + #f #f #f))) + + (setvbuf port 'none) + (let ((ret (list (get-bytevector-n port 2) + (get-bytevector-n port 3) + (get-bytevector-n port 42)))) + (zip (reverse reads) + (map (lambda (obj) + (if (bytevector? obj) + (utf8->string obj) + obj)) + ret))))) + + (pass-if-equal "custom binary input/output port unbuffered & 'get-string-all'" + (make-string 1000 #\a) + ;; In Guile 2.0.11 this test would lead to a buffer overrun followed + ;; by an assertion failure. See . + (let* ((input (with-fluids ((%default-port-encoding #f)) + (open-input-string (make-string 1000 #\a)))) + (read! (lambda (bv index count) + (let ((n (get-bytevector-n! input bv index + count))) + (if (eof-object? n) 0 n)))) + (port (make-custom-binary-input/output-port + "foo" read! dummy-write! + #f #f #f))) + (setvbuf port 'none) + (get-string-all port))) + + (pass-if-equal "custom binary input/output port unbuffered UTF-8 & \ +'get-string-all'" + (make-string 1000 #\λ) + ;; In Guile 2.0.11 this test would lead to a buffer overrun followed + ;; by an assertion failure. See . + (let* ((input (with-fluids ((%default-port-encoding "UTF-8")) + (open-input-string (make-string 1000 #\λ)))) + (read! (lambda (bv index count) + (let ((n (get-bytevector-n! input bv index + count))) + (if (eof-object? n) 0 n)))) + (port (make-custom-binary-input/output-port + "foo" read! dummy-write! + #f #f #f))) + (setvbuf port 'none) + (set-port-encoding! port "UTF-8") + (get-string-all port))) + + (pass-if-equal "custom binary input/output port, unbuffered then buffered" + `((6 "Lorem ") (12 "ipsum dolor ") (777 "sit amet, consectetur…") + (777 ,(eof-object))) + (let* ((str "Lorem ipsum dolor sit amet, consectetur…") + (source (with-fluids ((%default-port-encoding "UTF-8")) + (open-string-input-port str))) + (reads '()) + (read! (lambda (bv start count) + (set! reads (cons count reads)) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + #f #f #f))) + + (setvbuf port 'none) + (let ((ret (list (get-bytevector-n port 6) + (get-bytevector-n port 12) + (begin + (setvbuf port 'block 777) + (get-bytevector-n port 42)) + (get-bytevector-n port 42)))) + (zip (reverse reads) + (map (lambda (obj) + (if (bytevector? obj) + (utf8->string obj) + obj)) + ret))))) + + (pass-if-equal "custom binary input/output port, buffered then unbuffered" + `((18 + 42 14 ; scm_c_read tries to fill the 42-byte buffer + 42) + ("Lorem " "ipsum dolor " "sit amet, consectetur bla…" ,(eof-object))) + (let* ((str "Lorem ipsum dolor sit amet, consectetur bla…") + (source (with-fluids ((%default-port-encoding "UTF-8")) + (open-string-input-port str))) + (reads '()) + (read! (lambda (bv start count) + (set! reads (cons count reads)) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + #f #f #f))) + + (setvbuf port 'block 18) + (let ((ret (list (get-bytevector-n port 6) + (get-bytevector-n port 12) + (begin + (setvbuf port 'none) + (get-bytevector-n port 42)) + (get-bytevector-n port 42)))) + (list (reverse reads) + (map (lambda (obj) + (if (bytevector? obj) + (utf8->string obj) + obj)) + ret))))) + + (pass-if "custom binary input/output port `close-proc' is called" + (let* ((closed? #f) + (read! (lambda (bv start count) 0)) + (get-pos (lambda () 0)) + (set-pos! (lambda (pos) #f)) + (close! (lambda () (set! closed? #t))) + (port (make-custom-binary-input/output-port + "the port" read! dummy-write! + get-pos set-pos! close!))) + + (close-port port) + (gc) ; Test for marking a closed port. + closed?)) + + (pass-if "make-custom-binary-input/output-port [partial writes]" + (let* ((source (uint-list->bytevector (iota 333) + (native-endianness) 2)) + (sink (make-bytevector (bytevector-length source))) + (sink-pos 0) + (eof? #f) + (write! (lambda (bv start count) + (if (= 0 count) + (begin + (set! eof? #t) + 0) + (let ((u8 (bytevector-u8-ref bv start))) + ;; Get one byte at a time. + (bytevector-u8-set! sink sink-pos u8) + (set! sink-pos (+ 1 sink-pos)) + 1)))) + (port (make-custom-binary-input/output-port + "cbop" dummy-read! write! + #f #f #f))) + (put-bytevector port source) + (force-output port) + (and (= sink-pos (bytevector-length source)) + (not eof?) + (bytevector=? sink source)))) + + (pass-if "make-custom-binary-input/output-port [full writes]" + (let* ((source (uint-list->bytevector (iota 333) + (native-endianness) 2)) + (sink (make-bytevector (bytevector-length source))) + (sink-pos 0) + (eof? #f) + (write! (lambda (bv start count) + (if (= 0 count) + (begin + (set! eof? #t) + 0) + (begin + (bytevector-copy! bv start + sink sink-pos + count) + (set! sink-pos (+ sink-pos count)) + count)))) + (port (make-custom-binary-input/output-port + "cbop" dummy-read! write! + #f #f #f))) + (put-bytevector port source) + (force-output port) + (and (= sink-pos (bytevector-length source)) + (not eof?) + (bytevector=? sink source)))) + + (pass-if-equal "custom-binary-output-port uses ISO-8859-1 (Guile extension)\ + [output]" + '(194 169 194 169) + (with-fluids ((%default-port-encoding "UTF-8")) + (let* ((sink '()) + (write! (lambda (bv start count) + (if (= 0 count) ; EOF + 0 + (let ((u8 (bytevector-u8-ref bv start))) + ;; Get one byte at a time. + (set! sink (cons u8 sink)) + 1)))) + (port (make-custom-binary-input/output-port + "cbop" dummy-read! write! + #f #f #f))) + (put-string port "©©") + (force-output port) + (reverse sink)))) + ) (define exception:encoding-error '(encoding-error . "")) -- 2.9.2 --=-=-=--