unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
* Making HTTP requests over TLS from multiple threads
@ 2021-03-18  9:27 Christopher Baines
  2021-04-02 21:52 ` Christopher Baines
  0 siblings, 1 reply; 2+ messages in thread
From: Christopher Baines @ 2021-03-18  9:27 UTC (permalink / raw)
  To: guile-user


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

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


[-- Attachment #1.2: threaded-https-connections-test.scm --]
[-- Type: text/plain, Size: 4018 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 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)

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


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>

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

^ permalink raw reply	[flat|nested] 2+ messages in thread

* Re: Making HTTP requests over TLS from multiple threads
  2021-03-18  9:27 Making HTTP requests over TLS from multiple threads Christopher Baines
@ 2021-04-02 21:52 ` Christopher Baines
  0 siblings, 0 replies; 2+ messages in thread
From: Christopher Baines @ 2021-04-02 21:52 UTC (permalink / raw)
  To: guile-user


[-- 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 --]

^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2021-04-02 21:52 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-03-18  9:27 Making HTTP requests over TLS from multiple threads Christopher Baines
2021-04-02 21:52 ` Christopher Baines

unofficial mirror of guile-user@gnu.org 

This inbox may be cloned and mirrored by anyone:

	git clone --mirror https://yhetil.org/guile-user/0 guile-user/git/0.git

	# If you have public-inbox 1.1+ installed, you may
	# initialize and index your mirror using the following commands:
	public-inbox-init -V2 guile-user guile-user/ https://yhetil.org/guile-user \
		guile-user@gnu.org
	public-inbox-index guile-user

Example config snippet for mirrors.
Newsgroups are available over NNTP:
	nntp://news.yhetil.org/yhetil.lisp.guile.user
	nntp://news.gmane.io/gmane.lisp.guile.user


AGPL code for this site: git clone http://ou63pmih66umazou.onion/public-inbox.git