scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

R4RS -> R5RS

This commit is contained in:
sperber 2002-08-26 15:14:10 +00:00
parent 079ce2731a
commit e397f2520e
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
scheme/httpd/core.scm
View File

@ -1,7 +1,14 @@
;;; http server in the Scheme Shell -*- Scheme -*- ;;; http server in the Scheme Shell -*- Scheme -*-
;;; Olin Shivers <shivers@lcs.mit.edu>
;;; This file is part of the Scheme Untergrund Networking package.
;;; Copyright (c) 1994 by Brian D. Carlstrom and Olin Shivers. ;;; Copyright (c) 1994 by Brian D. Carlstrom and Olin Shivers.
;;; Copyright (c) 1996-2002 by Mike Sperber.
;;; Copyright (c) 2000-2002 by Martin Gasbichler.
;;; Copyright (c) 2002 by Andreas Bernauer.
;;; For copyright information, see the file COPYING which comes with
;;; the distribution.
;;; This file implements the core of an HTTP server: code to establish ;;; This file implements the core of an HTTP server: code to establish
;;; net connections, read and parse requests, and handler errors. ;;; net connections, read and parse requests, and handler errors.
@ -93,8 +100,8 @@
;;; standard error handlers toss us into a breakpoint. We have to catch the ;;; standard error handlers toss us into a breakpoint. We have to catch the
;;; error, send an error response back to the client if we can, and then keep ;;; error, send an error response back to the client if we can, and then keep
;;; on trucking. This means using the S48's condition system to catch and ;;; on trucking. This means using the S48's condition system to catch and
;;; handle the various errors, which introduces a major point of R4RS ;;; handle the various errors, which introduces a major point of R5RS
;;; incompatibiliy -- R4RS has no exception system. So if you were to port ;;; incompatibiliy -- R5RS has no exception system. So if you were to port
;;; this code to some other Scheme, you'd really have to sit down and think ;;; this code to some other Scheme, you'd really have to sit down and think
;;; about this issue for a minute. ;;; about this issue for a minute.
@ -274,7 +281,7 @@
(write-crlf port) (write-crlf port)
(send-http-header-fields (send-http-header-fields
(list (cons 'server sunet-version-identifier) (list (cons 'server (string-append "Scheme Untergrund " sunet-version-identifier))
(cons 'content-type (response-mime response)) (cons 'content-type (response-mime response))
(cons 'date (time->http-date-string (response-seconds response)))) (cons 'date (time->http-date-string (response-seconds response))))
port) port)