>>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.