Hey, I think I'm having some issues with making HTTP requests over TLS with Guile, I'm using the open-socket-for-uri procedure from (web client) for the port.
I've attached a small test program that reliably reproduces the issue for me, and I've included the output I typically get below [1]. At the start, a few requests are made from a single thread, and that works fine. As soon as there are two threads though, some uses of the port raise an error/again exception, at which point the program waits a second and retries (I guess that's sensible). Other errors that don't look more serious then happen. I've read the GnuTLS and GnuTLS Guile documentation, but the only things I've found that look relevant are suggestions in the GnuTLS documentation that using multiple threads should be OK. I have tried copying large amounts of the relevant Guile procedures so that I can access and tweak the GnuTLS related code, but that didn't reveal anything obvious to me at least. One other interesting thing is that if the different threads connect to different sites, that doesn't seem to break. Could there be some shared state somewhere for the connections that's leading to things going wrong? Thanks, Chris
(use-modules (web uri)
(web request)
(web response)
(web client)
(web http)
(srfi srfi-1)
(ice-9 threads)
(ice-9 match)
(rnrs bytevectors)
(srfi srfi-11)
(srfi srfi-9)
(srfi srfi-9 gnu)
(srfi srfi-26)
(gnutls)
(ice-9 binary-ports)
((ice-9 ftw) #:select (scandir))
((rnrs io ports)
#:prefix rnrs-ports:))
(define* (call-with-streaming-http-request uri callback
#:key (headers '()))
(let* ((port (open-socket-for-uri uri))
(request
(build-request
uri
#:method 'PUT
#:version '(1 . 1)
#:headers `((connection close)
(Transfer-Encoding . "chunked")
(Content-Type . "application/octet-stream")
,@headers)
#:port port)))
(set-port-encoding! port "ISO-8859-1")
(let ((request (write-request request port)))
(let ((chunked-output-port
(make-chunked-output-port
port
#:buffering 128
#:keep-alive? #t)))
;; A SIGPIPE will kill Guile, so ignore it
(sigaction SIGPIPE
(lambda (arg)
(simple-format (current-error-port) "warning: SIGPIPE\n")))
(set-port-encoding! chunked-output-port "ISO-8859-1")
(callback chunked-output-port)
(retry-gnutls-resource-temporarily-unavailable
(lambda ()
(close-port chunked-output-port)))
(display "\r\n" port)
(force-output port))
(let ((response (read-response port)))
(let ((body (read-response-body response)))
(close-port port)
(values response
body))))))
(define (retry-gnutls-resource-temporarily-unavailable thunk)
(catch 'gnutls-error
thunk
(lambda (key err proc . rest)
(if (eq? error/again err)
(begin
(simple-format (current-error-port)
"error/again\n")
(sleep 1)
(thunk))
(throw key (cons* err proc rest))))))
(define (start-thread thread-index)
(call-with-new-thread
(lambda ()
(for-each
(lambda (request-index)
(with-throw-handler #t
(lambda ()
(call-with-streaming-http-request
;; The URL doesn't realy matter as the response to the
;; request doesn't matter.
(peek (string->uri (if (= thread-index 1)
"https://guix.cbaines.net/test";
"https://www.cbaines.net/test";)))
(lambda (port)
(simple-format (current-error-port)
"thread ~A making request\n"
thread-index)
(let* ((buffer-size 1024)
(buffer (make-bytevector buffer-size)))
(for-each (lambda (index)
;; (usleep 10)
(retry-gnutls-resource-temporarily-unavailable
(lambda ()
(put-bytevector port buffer 0 buffer-size))))
(iota 512))))))
(lambda (key . args)
(simple-format #t "thread ~A: exception: ~A ~A\n"
thread-index key args)
(backtrace))))
(iota 2 1)))))
;; (define threads
;; (list (start-thread 1)))
;; (for-each join-thread threads)
;; (define threads
;; (list (start-thread 1)))
;; (for-each join-thread threads)
;; (define threads
;; (list (start-thread 1)))
;; (for-each join-thread threads)
;; (simple-format (current-error-port)
;; "\ntrying concurrent threads\n\n")
(define threads
(map start-thread
(iota 2 1)))
(for-each join-thread threads)
1:
thread 1 making request
thread 1 making request
thread 1 making request
thread 1 making request
thread 1 making request
thread 1 making request
trying concurrent threads
thread 1 making request
thread 2 making request
error/again
error/again
error/again
thread 1: exception: gnutls-error (#<gnutls-error-enum Error in the push
function.> write_to_session_record_port)
Backtrace:
In srfi/srfi-1.scm:
634:9 12 (for-each #<procedure 7f70c6cf0e60 at ice-9/eval.scm:3…> …)
In ice-9/boot-9.scm:
1736:10 11 (with-exception-handler _ _ #:unwind? _ # _)
In ice-9/eval.scm:
619:8 10 (_ #(#(#(#(#(#<directory (guile-user) 7f70…>) …) …) …) …))
619:8 9 (_ #(#(#(#(#(#(#<directory (guile-user)…>) …) …) …) …) …))
In srfi/srfi-1.scm:
634:9 8 (for-each #<procedure 7f70c6cf0260 at ice-9/eval.scm:3…> …)
In unknown file:
7 (put-bytevector #<output: string 7f70c4c105b0> #vu8(0 …) …)
In web/http.scm:
2029:35 6 (flush)
In unknown file:
5 (put-char #<input-output: string 7f70c4c10620> #\nul)
In web/client.scm:
267:8 4 (write! #vu8(0 53 55 97 13 10 0 0 0 0 0 0 0 0 0 0 0 0 …) …)
In unknown file:
3 (put-bytevector #<input-output: string 7f70c4c10690> # 0 …)
In ice-9/boot-9.scm:
1669:16 2 (raise-exception _ #:continuable? _)
1764:13 1 (_ #<&compound-exception components: (#<&error> #<&irri…>)
In unknown file:
0 (backtrace #<undefined>)
In srfi/srfi-1.scm:
634:9 11 (for-each #<procedure 7f70c6cf0e60 at ice-9/eval.scm:3…> …)
In ice-9/boot-9.scm:
1736:10 10 (with-exception-handler _ _ #:unwind? _ # _)
In ice-9/eval.scm:
619:8 9 (_ #(#(#(#(#(#<directory (guile-user) 7f70…>) …) …) …) …))
619:8 8 (_ #(#(#(#(#(#(#<directory (guile-user)…>) …) …) …) …) …))
In srfi/srfi-1.scm:
634:9 7 (for-each #<procedure 7f70c6cf0260 at ice-9/eval.scm:3…> …)
In unknown file:
6 (put-bytevector #<output: string 7f70c4c105b0> #vu8(0 …) …)
In web/http.scm:
2029:35 5 (flush)
In unknown file:
4 (put-char #<input-output: string 7f70c4c10620> #\nul)
In web/client.scm:
267:8 3 (write! _ _ 1024)
In unknown file:
2 (put-bytevector #<input-output: string 7f70c4c10690> # 0 …)
In ice-9/boot-9.scm:
1669:16 1 (raise-exception _ #:continuable? _)
1669:16 0 (raise-exception _ #:continuable? _)
ice-9/boot-9.scm:1669:16: In procedure raise-exception:
Throw to key `gnutls-error' with args `(#<gnutls-error-enum Error in the push
function.> write_to_session_record_port)'.
warning: SIGPIPE
thread 2 making request
In procedure write_to_session_record_port: Wrong type argument in position 1:
#<finalized smob 7f70c56c3fe0>
signature.asc
Description: PGP signature
