Adding (ice-9 suspendable-ports) support to https / custom ports

Adding (ice-9 suspendable-ports) support to https / custom ports

[Christopher Allan Webber]

Hiya,

For the project I'm working on, I'll need to have (ice-9
suspendable-ports) work with https.  This is a bit more urgent than I
realized.  I'm willing to attempt the work, but I don't even know where
to start.

Could someone give me pointers as to where to begin spelunking?  I'm
guessing I have to both follow the lead of the suspendable-ports
adjustments to normal ports and also enable fnctl support for custom
ports?  Specifically, I imagine that this needs to be supported:

     (let ((flags (fcntl socket F_GETFL)))
       (fcntl socket F_SETFL (logior O_NONBLOCK flags)))

Either that or we need some generalized procedure that can either do
this to a port which does set fnctl or... I don't know what it would do
for something which doesn't need to run that operation.

Advice appreciated!
 - Chris

Re: Adding (ice-9 suspendable-ports) support to https / custom ports

[Christopher Allan Webber]

So since writing this initial email I had a conversation with Wingo and
have done a lot more research.  I'm a lot more informed about what needs
to happen, but unfortunately, I'm also very stuck.  This is unfortunate
because this is basically blocking the release of the test suite
relating to the standards work I'm doing, which was due out this
Tuesday!  So any help is *greatly* appreciated.

So here's the situation:
 - We have suspendable-ports which make asynchronous I/O work nicely and
   cooperatively, yay
 - HTTPS requests now work because we wrap underlying ports in gnutls
   using custom-binary-i/o-ports, yay
 - Oh no but the gnutls-wrapped ports aren't suspendable and block
 - Oh no the ActivityPub test suite sends out a request to a foreign
   server and the foreign server sends its own request to the test suite
   before it gives a response but the test suite is blocked on its
   initial request and oh no the whole thing is deadlocked oops, take
   that cooperative model!
 - To make things more complicated, when we call C code that calls into
   Scheme code, we can no longer abort to a prompt, which is how
   suspendable ports works.  (For more on that see Wingo's blogposts
   on delimited continuations and the Scheme/C stacks.)

Wingo gave some helpful advice on IRC:

<wingo> there are two general options.  one is, if this port is always
	operated on from scheme, *and* you arrange for it to implement the
	read/write functions via the scm_read / scm_write members and not the
	c_read/c_write --
<wingo> then in that case, the read/write functions written in scheme can
	themselves use suspendable ports, transparently blocking.
<wingo> the second option is to change the read/write functions to allow them
	to return -1 when they would block, and in that case you implement the
	read_wait_fd / write_wait_fd methods.
<wingo> i suspect the latter is going to be easier but i don't know

I've been looking into solutions.

1. The first option would be the nicest if it were possible; we could
   simply do the "set the port nonblocking with fcntl" dance on the
   wrapped port, and when we try to write to the wrapped port, it should
   automatically suspend.

   Unfortunately there are problems with this route afaict:
    - It wouldn't be possible to use custom-binary-i/o-ports anyway,
      because scm_read/scm_write are properties not of the port instance
      itself but of its port type, as far as I can tell.  The whole
      point of custom-binary-i/o-ports is to be able to set up
      procedures on the instance, so I'm not sure how to get around
      this.
    - Even if we didn't do this, the low-level port-read/port-write
      procedures in ports.c are, well, in C.  So I'm afraid we're going
      to pass through C anyway.

2. Okay, well let's add the read_wait_fd and write_wait_fd methods
   (which would really just wrap the wrapped port's file descriptors)
   and allow the existing read/write functions from the current
   tls-wrapping port thing we've got to just return -1, indicating that
   they'd like to suspend please so as to not block.  In theory, this
   would just be passed along from the underlying port.  Okay, sounds
   great!  Except... well let's look at how the current tls-wrapping
   code looks:

   #+BEGIN_SRC scheme
   (define (tls-wrap port server)
     "Return PORT wrapped in a TLS connection to SERVER.  SERVER must be a DNS
   host name without trailing dot."

       ;; **** gnutls setup stuff here ***

       ;; @@: Not sure if this comment would help

       ;; FIXME: It appears that session-record-port is entirely
       ;; sufficient; it's already a port.  The only value of this code is
       ;; to keep a reference on "port", to keep it alive!  To fix this we
       ;; need to arrange to either hand GnuTLS its own fd to close, or to
       ;; arrange a reference from the session-record-port to the
       ;; underlying socket.
       (let ((record (session-record-port session)))
         (define (read! bv start count)
           (define read-bv (get-bytevector-some record))
           (if (eof-object? read-bv)
               0  ; read! returns 0 on eof-object
               (let ((read-bv-len (bytevector-length read-bv)))
                 (bytevector-copy! read-bv 0 bv start (min read-bv-len count))
                 (when (< count read-bv-len)
                   (unget-bytevector record bv count (- read-bv-len count)))
                 read-bv-len)))
         (define (write! bv start count)
           (put-bytevector record bv start count)
           (force-output record)
           count)
         ;; **** Some more stuff for close, etc here ****
         (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
                                               get-position set-position!
                                               close))))
   #+END_SRC

   Okay, so what are the issues here?

    - In order to pass along whether or not these operations should
      return -1 or not, we couldn't just call put-bytevector and
      get-bytevector-some as we are now, since those would themselves
      call code that looks like:

      #+BEGIN_SRC scheme
      (define (wait-for-readable port) ((current-read-waiter) port))
      (define (read-bytes port dst start count)
        (cond
         (((port-read port) port dst start count)
          => (lambda (read)
               (unless (<= 0 read count)
                 (error "bad return from port read function" read))
               read))
         (else
          (wait-for-readable port)
          (read-bytes port dst start count))))
      #+END_SRC

      We'd basically want to call port-read ourselves so we could see
      whether or not to return -1.  However,
      put-bytevector/get-bytevector-some are pretty large, and that's a
      lot of code to copy-pasta-and-kludgify just for this.

    - Also, as you can see in the code above called by put-bytevector
      and get-bytevector-some, that code itself (aside from doing
      buffering and etc) is taking advantage of suspending to the
      agenda.

    - But maybe it's even possible to pull it off without put-bytevector
      and friends, just by calling the low-level port-read/port-write
      ourselves?  Maybe we can do that, I'm not sure about that one?

Anyway, that's where I'm at.  I have this sneaking suspicion there's a
more obvious answer sitting right in front of me, but I'm pretty new to
this side of Guile's guts.  Any guidance welcome!

 - Chris