Let's try to port SchemeBBS to MIT Scheme 11.2.
First, we need a patch to fix this error:
1 ]=> (listen server (string->number (car (command-line))))
;The object #f, passed as an argument to string-length, is not the correct type.This is the patch:
--- bbs.scm.orig
+++ bbs.scm
@@ -414,4 +414,4 @@
(decode-formdata message)
(cdr validation)))))
-(listen server (string->number (car (command-line))))
+(listen server (string->number (car (command-line-arguments))))There are no more error messages after applying the patch, but I am unable to view the webpage at localhost:8080. In Firefox, I get "The connection was reset". Does anyone know why?
>>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 proceduresIt turns out that the hidden error was:
;Unbound variable: guarantee-http-token-stringApparently, 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 proceduresOops, 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-charThis 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 typeThis 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.
Addenda for >>9:
* To be clear, the errors appear after trying to access localhost:8080 through a web browser.
* The patched read-http-request procedure above differs from that in deps/httpio.scm. In deps/httpio.scm, we pass an empty string to make-http-request. Here, we pass it an empty bytevector.
Errata for >>9:
So, I removed runtime/httpio.scm from SchemeBBS
This is supposed to be:
"So, I removed deps/httpio.scm from SchemeBBS"
Perhaps a different write-char call is involved.
Yes, you are right. I was mistaken.
The error is raised in the write-http-response procedure in runtime/http-io.scm. The error is caused by the use of newline to write to a binary port. newline can only write to a textual port.
Fix:
--- src/runtime/http-io.scm.orig
+++ src/runtime/http-io.scm
@@ -188,7 +188,8 @@
(write-ascii (write-to-string (http-response-status response)) port)
(write-u8 (char->integer #\space) port)
(write-ascii (http-response-reason response) port)
- (newline port)
+ (write-u8 (char->integer #\return) port)
+ (write-u8 (char->integer #\newline) port)
(write-http-headers (http-response-headers response) port)))
(write-bytevector (http-response-body response) port)
(flush-output-port port))>>13
Add that fix to the beginning of bbs.scm:
(ge '(runtime http-i/o))
(define (write-http-response response port)
(if (http-response-version response)
(begin
(write-http-version (http-response-version response) port)
(write-u8 (char->integer #\space) port)
(write-ascii (write-to-string (http-response-status response)) port)
(write-u8 (char->integer #\space) port)
(write-ascii (http-response-reason response) port)
(write-u8 (char->integer #\return) port)
(write-u8 (char->integer #\newline) port)
(write-http-headers (http-response-headers response) port)))
(write-bytevector (http-response-body response) port)
(flush-output-port port))
(ge '(user))At this point, localhost:8080 should successfully display "site root"!
One more thing: I should have closed the port after serving each request.
--- a/deps/server.scm
+++ b/deps/server.scm
@@ -43,11 +43,9 @@ 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)
+ (close-port port)))) ;; <- CLOSE PORT!
(lambda () (channel-close socket)))))Now that we have successfully displayed the site root, it's time to fix the board indexes, board lists, new thread creation, etc.
Now, let's try to fix board indexes, board lists, and new thread creation.
All HTTP bodies are now represented using bytevectors, not strings. Fix:
--- a/deps/server.scm
+++ b/deps/server.scm
@@ -287,10 +285,10 @@ Initializes our web server.
;;; reads the string content at the given file path:
(define (read-file filename)
- (call-with-input-file filename
- (lambda (port)
- (read-string (char-set) port))))
-
+ (string->utf8
+ (call-with-input-file filename
+ (lambda (port)
+ (read-string (char-set) port)))))(alternative fix: open file using open-binary-input-file, read file using call-with-port and read-bytevector)
and also:
--- a/bbs.scm
+++ b/bbs.scm
@@ -79,7 +79,7 @@
;(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))
@@ -102,11 +102,11 @@
;;; errors
(define bad-request
- `(400 () "Bad Request"))
+ `(400 () ,(string->utf8 "Bad Request")))
(define not-found
- `(404 () "Not found"))
+ `(404 () ,(string->utf8 "Not found")))
(define method-not-allowed
- '(405 () "Method not allowed"))
+ `(405 () ,(string->utf8 "Method not allowed")))
(define (title board)
(string-append "/" board "/ - SchemeBBS"))
@@ -215,7 +215,7 @@
(let* ((t (call-with-input-file path read))
(posts (lookup-def 'posts t))
(post-number (+ 1 (car (last posts))))
- (body (http-request-body req))
+ (body (utf8->string (http-request-body req)))
(params (parameters->alist body))
(frontpage (lookup-def 'frontpage params))
(message (decode-formdata (lookup-def 'epistula params)))
@@ -252,11 +252,11 @@
(if newthread?
(add-query-string (string-append "/" board) query-string)
(string-append (add-query-string (string-append "/" board) query-string) "#t" thread "p" post))))
- "That was SICP quality!")
+ ,(string->utf8 "That was SICP quality!"))
`(303 ,(list (make-http-header
'location
(string-append (add-query-string (string-append "/" board "/" thread) query-string) "#t" thread "p" post)))
- "That was SICP quality")))
+ ,(string->utf8 "That was SICP quality"))))
(define (update-post-count board thread date post-count)
(let ((cache (make-path *html* board "list")))
@@ -316,7 +316,7 @@
(threads (if (file-exists? list-path)
(call-with-input-file list-path read)
'()))
- (body (http-request-body req))
+ (body (utf8->string (http-request-body req)))
(params (parameters->alist body))
(message (decode-formdata (lookup-def 'epistula params)))
(headline (decode-formdata (lookup-def 'titulus params)))Then, to make redirections work correctly when creating new threads and messages, we need to add this fix to the beginning of bbs.scm: https://textboard.org/prog/140/88
SchemeBBS now works on MIT Scheme 11.2!
There's one problem left: multi-byte characters. If you try to submit "一二三" through the textarea, you will get something like "ä¸äºä¸". Not sure how to fix this.