I've come up with a slight variant of the original script now, which for me reliably causes Guile to crash. I've included some example output below.
(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 128)
(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 20000))))))
(lambda (key . args)
(simple-format #t "thread ~A: exception: ~A ~A\n"
thread-index key args)
(backtrace))))
(iota 1 1)))))
(define threads
(map start-thread
(iota 6 1)))
(for-each join-thread threads)
;;;
;;; ((
;;; ;;; ;;; (((#<#<<uri><uri><uri><uri><uri><uri> scheme: : scheme: https
httpshttps : uhttpsnfouseri: erinfo :: #fuserinfo#f: # fh osth:
sthohost"guix.cbaii: n": e"wsww.wwn.wec.tbc"ab iapnorti:e n#sfe .spnath.:e
n"te/"t
tt "eport ssort :t#<p#f"frt"f:<u #fri>p aquer : erys: pathme"a: th#: / ht
"ttpst f//e;;; entu:t eris erinfo( :#fe>tf##fs )f""th
osti>"ost ::q uschem": hemequery: :htw#fwftps#f f wuffragment.ragment:
agment:: c #f##fbf>f >a)h
)iost
::n neewsw.wn.ectb"a iportn: esfs .pathn: e"t/"teesorts: t" queryquery#f:
papath : fragment": /#ft>e)s
t" query: #f fragment: #f>)
;;; (#<<uri> scheme: https userinfo: #f host: "www.cbaines.net" port: #f path:
"/test" query: #f fragment: #f>)
thread 4 making request
thread 3 making request
thread 6 making request
thread 5 making request
thread 2 making request
error/again
error/again
error/again
thread 1 making request
error/again
error/again
error/again
warning: SIGPIPE
thread 4: exception: gnutls-error ((#<gnutls-error-enum Error in the push
function.> write_to_session_record_port))
Backtrace:
error/again
thread 6: exception: gnutls-error ((#<gnutls-error-enum Error in the push
function.> write_to_session_record_port))
Backtrace:
IInnn srfi/srfi-1.scmsrfi/srfi-1.scmsrfi/srfi-1.scm::
634:9 634:9 7 7 (for-each #<program 7f40d1542f00 7f40d317edf0> (1))
(for-each #<procedure 7f40d1537d40 at
/home/chris/threaded-https-connections-test-guile-ports-crash.scm:77:6
(request-index)> (1))
In ice-9/boot-9.scm:
In ice-9/boot-9.scm:
1736:10 6 (with-exception-handler _ _ #:unwind? _ #:unwind-for-type _)
1736:10 6
(with-exception-handler _ _ #:unwind? _ #:unwind-for-type _)
In /home/chris/threaded-https-connections-test-guile-ports-crash.scm:
In /home/chris/threaded-https-connections-test-guile-ports-crash.scm:
48:848:8 48:8 5 5 (call-with-streaming-http-request _ _ #:headers
_)
(call-with-streaming-http-request _ _ #:headers _)
In srfi/srfi-1.scm:
In srfi/srfi-1.scm:
634:9 4 634:9 4 (for-each #<program 7f40d1542a20 7f40d317f1bc> _)
(for-each #<procedure 7f40d1537480 at
/home/chris/threaded-https-connections-test-guile-ports-crash.scm:92:27
(index)> _)
In /home/chris/threaded-https-connections-test-guile-ports-crash.scm:
In /home/chris/threaded-https-connections-test-guile-ports-crash.scm :
71:10 3 (_ gnutls-error _ _)
71:10 3 (_ gnutls-error _ _)
In ice-9/boot-9.scm:
In ice-9/boot-9.scm:
1669:16 2 (raise-exception _ #:continuable? _)
1669:16 2 (raise-exception _ #:continuable? _)
1764:13 1 1764:13 1 (_ #<&compound-exception components: (#<&error>
#<&irritants irritants: ((#<gnutls-error-enum Error in the push function.>
write_to_session_record_port))…>)
(_ #<&compound-exception components: (#<&error> #<&irritants irritants:
((#<gnutls-error-enum Error in the push function.> write_to_session_…>)
In
unknown file::n unknown file:
0 0 (backtrace #<undefined>)
(backtrace #<undefined>)(backtrace #<undefined>)
IIInn srfi/srfi-1.scmsrfi/srfi-1.scm::
634:9634:9 66 6 (for-each #<program 7f40d1537d40 7f40d317edf0>
(1))
(for-each #<procedure 7f40d1542f00 at
/home/chris/threaded-https-connections-test-guile-ports-crash.scm:77:6
(request-index)> (1))
In ice-9/boot-9.scm:
In ice-9/boot-9.scm:
1736:10 5 (with-exception-handler _ _ #:unwind? _ #:unwind-for-type _)
1736:10 5 (with-exception-handler _ _ #:unwind? _ #:unwind-for-type _)
In /home/chris/threaded-https-connections-test-guile-ports-crash.scm:
In /home/chris/threaded-https-connections-test-guile-ports-crash.scm:
48:8 4 48:8 4 (call-with-streaming-http-request _ _ #:headers _)
(call-with-streaming-http-request _ _ #:headers _)
IIInn srfi/srfi-1.scmsrfi/srfi-1.scm:srfi/srfi-1.scm:
:
634:9 634:9634:9 3 3 (for-each #<program 7f40d1542a20 7f40d317f1bc> _)
In /home/chris/threaded-https-connections-test-guile-ports-crash.scm:
(for-each #<procedure 7f40d1537480 at
/home/chris/threaded-https-connections-test-guile-ports-crash.scm:92:27
(index)> _)
71:10 2 (_ gnutls-error _ _)
In /home/chris/threaded-https-connections-test-guile-ports-crash.scm:
71:10 2 (_ gnutls-error _ _)
In ice-9/boot-9.scm:
In ice-9/boot-9.scm:
1669:16 1 (raise-exception _ #:continuable? _)
1669:16 1 (raise-exception _ #:continuable? _)
1669:16 0 (raise-exception _ #:continuable? _)
1669:16 0 (raise-exception _ #:continuable? _)
ice-9/boot-9.scm:1669:16: In prooice-9/boot-9.scmc:e16691669d:urr16e:
raise-exception:
Throw to key `gnutls-error' withhI na rpgrso c`edure raise-exception:
Throw tto' .kee
y `gnutls-error' with args `((#<gnutls-error-enum Error in the push function.>
write_to_session_record_port))'.
guile: ports.c:2900: scm_i_write_bytes: Assertion `written == count' failed.
Aborted
signature.asc
Description: PGP signature
