Re: Making HTTP requests over TLS from multiple threads

[Christopher Baines <mail@cbaines.net>]

[-- Attachment #1.1: Type: text/plain, Size: 151 bytes --]


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.


[-- Attachment #1.2: threaded-https-connections-test-guile-ports-crash.scm --]
[-- Type: text/plain, Size: 3674 bytes --]

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

[-- Attachment #1.3: Type: text/plain, Size: 4902 bytes --]


;;; 
;;; ((
;;; ;;; ;;; (((#<#<<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

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]