[ prog / sol / mona ]

prog


Running SchemeBBS using MIT Scheme 11.2

9 2022-05-29 14:58

>>5
Thank you. To see the errors, I had to remove one dynamic-wind:

--- a/deps/server.scm
+++ b/deps/server.scm
@@ -44,10 +44,7 @@ Initializes our web server.
         (lambda ()
           (do () ((channel-closed? socket))
             (let ((port (tcp-server-connection-accept socket #t #f)))
-              (dynamic-wind
-                (lambda () unspecific)
-                (lambda () (ignore-errors (lambda () (serve-request port))))
-                (lambda () (ignore-errors (lambda () (close-port port))))))))
+              (serve-request port))))
         (lambda () (channel-close socket)))))
 
   ;;; Private helper procedures

It turns out that the hidden error was:

;Unbound variable: guarantee-http-token-string

Apparently, many things in MIT Scheme's runtime/httpio.scm file have changed (the file has been renamed to runtime/http-io.scm). Many variables are gone, and many new ones added. So, I removed runtime/httpio.scm from SchemeBBS:

--- a/bbs.scm
+++ b/bbs.scm
@@ -11,7 +11,6 @@
 (load "lib/utils")
 (load "deps/irregex")
 (load "deps/srfi-26")
-(load "deps/httpio")
 (load "deps/server")
 (load "lib/html")
 (load "lib/parameters")
@@ -414,4 +413,4 @@
                     (decode-formdata message)
                     (cdr validation)))))
 
-(listen server (string->number (car (command-line))))
+(listen server (string->number (car (command-line-arguments))))

At this point we have another error:

;The object #[textual-i/o-port 14 for channel: #[channel 15]], passed as an argument to #[compiled-procedure 16 ("binary-port" #x2) #x1c #x2f1f6f4], is not the correct type.

This error is caused by the use of read-http-request in deps/server.scm. read-http-request expects a binary port, but it is given a textual port created by tcp-server-connection-accept. Maybe we should replace tcp-server-connection-accept with tcp-server-binary-connection-accept, which creates a binary port:

--- a/deps/server.scm
+++ b/deps/server.scm
@@ -43,11 +43,8 @@ Initializes our web server.
         (lambda () unspecific)
         (lambda ()
           (do () ((channel-closed? socket))
-            (let ((port (tcp-server-connection-accept socket #t #f)))
-              (dynamic-wind
-                (lambda () unspecific)
-                (lambda () (ignore-errors (lambda () (serve-request port))))
-                (lambda () (ignore-errors (lambda () (close-port port))))))))
+            (let ((port (tcp-server-binary-connection-accept socket #t #f)))
+              (serve-request port))))
         (lambda () (channel-close socket)))))
 
   ;;; Private helper procedures

Oops, another error:

;The object 3, passed as the second argument to vector-ref, is not in the correct range.

It turns out that we still need the modifications made to deps/httpio.scm. We can include those modifications by adding these lines to the beginning of bbs.scm using a technique similar to https://textboard.org/prog/140/88-89 :

(ge '(runtime http-i/o))

(load-option '*parser)

(define parse-request-line
  (*parser
    (seq (match (+ (char-set char-set:http-token)))
         " "
         (alt (map intern (match "*"))
              parse-uri
              parse-uri-authority)
         " "
         parse-http-version)))

(define (read-http-request port)
  (let ((line (read-ascii-line port)))
    (if (eof-object? line)
      line
      (receive (method uri version)
        (parse-line parse-request-line line "HTTP request line")
        (let ((headers (read-http-headers port)))
          (let ((b.t (or (%read-chunked-body headers port)
                         (%read-delimited-body headers port)
                         '())))
            (if (null? b.t)
              (make-http-request method uri version headers (bytevector))
              (make-http-request method uri version
                                 (append! headers (cdr b.t))
                                 (car b.t)))))))))

(ge '(user))

At this point, we get yet another error:

;Error while parsing RFC 2822 headers: Illegal character: peek-ascii-char

This error is caused by peek-ascii-char in runtime/rfc2822-headers.scm when it peeks at a carriage return character. peek-ascii-char only considers ASCII decimal 32 to 126 (inclusive) to be valid ASCII characters. So, let's try to patch it by adding this to the beginning of bbs.scm:

(ge '(runtime rfc2822-headers))

(define (peek-ascii-char port)
  (let ((byte (peek-u8 port)))
    (cond ((eof-object? byte)
           byte)
          ((and (fix:<= 0 byte) (fix:<= byte 127))
           (integer->char byte))
          (else (parse-error port "Illegal character:" 'peek-ascii-char)))))

Now, we get another error:

;The object "site root", passed as an argument to make-http-response, is not the correct type

This is easy to fix in bbs.scm:

     ;(pp (http-header 'host headers #f))
     (cond ((equal? method "GET")
 	   (match path
-	     (() () '(200 () "site root"))
+	     (() () `(200 () ,(string->utf8 "site root")))
 	     ((,board) () (view-index board))
 	     ((,board "list") () (view-list board))
 	     ((,board "preferences") () (set-preferences board query-string))

Then, we get another error:

;The object #[binary-i/o-port 35], passed as an argument to write-char, is not the correct type.

This error is raised in the string->tokens procedure in runtime/http-syntax.scm. write-char expects a textual port but we have a binary port.

I am going to take a break at this point. It seems that HTTP functionality is broken in MIT Scheme. For HTTP, some internal procedures expect a binary port while others expect a textual port.

56


VIP:

do not edit these