Replace integer HTTP status codes by finite record type instances.

scheme/httpd/access-control.scm

@@ -36,7 +36,7 @@
     (if (eq?
 	 (control (host-info (socket-remote-address (request-socket req))))
 	 'deny)
-	(http-error http-status/forbidden req)
+	(http-error (status-code forbidden) req)
 	(ph path req))))
 
 (define (address->list address)

scheme/httpd/cgi-server.scm

@@ -91,13 +91,13 @@
       (lambda (path req)
 	(if (pair? path)	; Got to have at least one elt.
 	    (compute-cgi path req bin-dir request-invariant-cgi-env)
-	    (make-http-error-response http-status/bad-request req "Empty CGI script"))))))
+	    (make-http-error-response (status-code bad-request) req "Empty CGI script"))))))
 
 (define (compute-cgi path req bin-dir request-invariant-cgi-env)
   (let* ((prog (car path))
 
 	 (filename (or (dotdot-check bin-dir (list prog))
-		       (http-error http-status/bad-request req 
+		       (http-error (status-code bad-request) req 
 				   "CGI scripts may not contain \"..\" elements.")))
 
 	 (nph? (string-prefix? "nph-" prog))	; PROG starts with "nph-" ? 
@@ -125,22 +125,22 @@
 	    (let ((stat (wait (fork doit))))
 	      (if (not (zero? stat))
 		  (make-http-error-response 
-		   http-status/bad-request req
+		   (status-code bad-request) req
 		   (format #f "Could not execute CGI script ~a." 
 			   filename)) 
 		  stat))		;; FIXME! must return http-response object!
 	    (case (file-not-executable? filename)
 	      ((search-denied permission)
-	       (make-http-error-response http-status/forbidden req
+	       (make-http-error-response (status-code forbidden) req
 					 "Permission denied."))
 	      ((no-directory nonexistent)
-	       (make-http-error-response http-status/not-found req
+	       (make-http-error-response (status-code not-found) req
 					 "File or directory doesn't exist."))
 	      (else
 	       (cgi-make-response (run/port* doit) path req)))))
        
        (else 
-	(make-http-error-response http-status/method-not-allowed req request-method))))))
+	(make-http-error-response (status-code method-not-allowed) req request-method))))))
 
 
 (define (split-and-decode-search-spec s)
@@ -222,7 +222,7 @@
 			   (cl-len (string-length cl)))
 		       (if first-digit
 			   `(("CONTENT_LENGTH" . ,(substring cl first-digit cl-len)))
-			   (http-error http-status/bad-request req 
+			   (http-error (status-code bad-request) req 
 				       "Illegal `Content-length:' header.")))))
 		  
 		  (else '()))
@@ -260,7 +260,7 @@
 
     (if loc
 	(if (uri-has-protocol? (string-trim loc))
-	    (make-http-error-response http-status/moved-perm req
+	    (make-http-error-response (status-code moved-perm) req
 				      loc loc)
 	    (make-redirect-response (string-trim loc)))
 	;; Send the response header back to the client
@@ -284,11 +284,11 @@
 (define (extract-status-code-and-text stat-lines req)
   (cond 
    ((not (pair? stat-lines))	    ; No status header.
-    (cons http-status/ok "The idiot CGI script left out the status line."))
+    (cons (status-code ok) "The idiot CGI script left out the status line."))
    ((null? (cdr stat-lines)) 	    ; One line status header.
     (with-fatal-error-handler*
        (lambda (c d)
-	 (http-error http-status/bad-gateway req
+	 (http-error (status-code bad-gateway) req
 		     "CGI script generated an invalid status header."
 		     (car stat-lines) c))
        (lambda ()
@@ -296,5 +296,5 @@
 	   (cons (string->number (substring status 0 3))	; number
 		 (substring/shared status 4))))))		; text
    (else			    ; Vas ist das?
-    (http-error http-status/bad-gateway req
+    (http-error (status-code bad-gateway) req
 		"CGI script generated multi-line status header."))))

scheme/httpd/core.scm

@@ -148,7 +148,7 @@
 		    (condition-stuff c)))
 	    ((fatal-syntax-error? c)
 	     (values #f
-		     (apply make-http-error-response http-status/bad-request
+		     (apply make-http-error-response (status-code bad-request)
 			    #f		; No request yet.	
 			    "Request parsing error -- report to client maintainer."
 			    (condition-stuff c))))
@@ -158,7 +158,7 @@
 
 	     ;; try to send bug report to client
 	     (values #f
-		     (apply make-http-error-response http-status/internal-error 
+		     (apply make-http-error-response (status-code internal-error) 
 			    #f		; don't know
 			    "Internal error occured while processing request"
 			    c)))
@@ -171,7 +171,7 @@
 				(http-url-path (request-url req))
 				req)))
 	       (if (eq? (response-code response) 
-			http-status/redirect)
+			(status-code redirect))
 		   (redirect-loop (redirect-request req response sock options))
 		   (values req response))))))))
       (lambda (req response)
@@ -187,7 +187,7 @@
 	 (url (with-fatal-error-handler*
 	       (lambda (c decline)
 		 (if (fatal-syntax-error? c)
-		     (http-error http-status/internal-error req
+		     (http-error (status-code internal-error) req
 				 (format #f "Bad redirection out from CGI program: ~%~a"
 					 (cdr c)))
 		     (decline c)))
@@ -315,9 +315,11 @@
 (define (send-http-headers response port)
   (display server/protocol port)
   (write-char #\space port)
-  (display (response-code response) port)
+  (display (status-code-number (response-code response)) port)
   (write-char #\space port)
-  (display (response-message response) port)
+  (display (or (response-message response)
+	       (status-code-message (response-code response)))
+	   port)
   (write-crlf port)
 
   (send-http-header-fields

scheme/httpd/file-dir-handler.scm

@@ -25,7 +25,7 @@
 (define (home-dir-handler user-public-dir)
   (lambda (path req)		
     (if (null? path)
-	(make-http-error-response http-status/bad-request
+	(make-http-error-response (status-code bad-request)
 				  req
 				  "Path contains no home directory.")
 	(make-rooted-file-path-response (string-append (http-homedir (car path) req)
@@ -113,13 +113,13 @@
 
 (define (make-rooted-file-path-response root file-path file-serve-response req)
   (if (http-url-search (request-url req))
-      (make-http-error-response http-status/bad-request req
+      (make-http-error-response (status-code bad-request) req
 				"Indexed search not provided for this URL.")
       (cond ((dotdot-check root file-path) =>
 	     (lambda (fname)
 	       (file-serve-response fname file-path req)))
 	    (else
-	     (make-http-error-response http-status/bad-request req
+	     (make-http-error-response (status-code bad-request) req
 				       "URL contains unresolvable ..'s.")))))
 
 
@@ -129,9 +129,9 @@
   (with-errno-handler 
    ((errno packet)
     ((errno/noent)
-     (http-error http-status/not-found req))
+     (http-error (status-code not-found) req))
     ((errno/acces)
-     (http-error http-status/forbidden req)))
+     (http-error (status-code forbidden) req)))
    (file-info fname #t)))
 
 ;;; A basic file request handler -- ship the dude the file. No fancy path
@@ -154,15 +154,15 @@
 	      
 	      ((directory)		; Send back a redirection "foo" -> "foo/"
 	       (make-http-error-response
-		http-status/moved-perm req
+		(status-code moved-perm) req
 		(string-append (request-uri req) "/")
 		(string-append (http-url->string (request-url req))
 			       "/")))
 
-	      (else (make-http-error-response http-status/forbidden req)))))
+	      (else (make-http-error-response (status-code forbidden) req)))))
 	 
 	 (else 
-	  (make-http-error-response http-status/method-not-allowed req 
+	  (make-http-error-response (status-code method-not-allowed) req 
 				    request-method))))))
 
 (define (directory-index-serve-response fname file-path req)
@@ -360,10 +360,10 @@
 	  
       (if (not (eq? 'directory 
 		    (file-info:type (file-info fname #t))))
-	  (make-http-error-response http-status/forbidden req)
+	  (make-http-error-response (status-code forbidden) req)
 	  (make-response
-	   http-status/ok
+	   (status-code ok)
-	   (status-code->text http-status/ok)
+	   #f
 	   (time)
 	   "text/html"
 	   '()
@@ -405,7 +405,7 @@
 			  (emit-tag port 'hr)
 			  (format port "~d files" n-files))))))))))))
      (else
-      (make-http-error-response http-status/method-not-allowed req 
+      (make-http-error-response (status-code method-not-allowed) req 
 				request-method)))))
 
 (define (index-or-directory-serve-response fname file-path req)
@@ -422,7 +422,7 @@
 
 (define (http-homedir username req)
   (with-fatal-error-handler (lambda (c decline)
-			      (apply http-error http-status/bad-request req
+			      (apply http-error (status-code bad-request) req
 				     "Couldn't find user's home directory."
 				     (condition-stuff c)))
 
@@ -431,11 +431,11 @@
 
 (define (send-file-response filename info req)
   (if (file-not-readable? filename)	; #### double stats are no good
-      (make-http-error-response http-status/not-found req)
+      (make-http-error-response (status-code not-found) req)
       (receive (stripped-filename content-encoding)
 	  (file-extension->content-encoding filename)
-	(make-response http-status/ok
+	(make-response (status-code ok)
-		       (status-code->text http-status/ok)
+		       #f
 		       (time)
 		       (file-extension->content-type stripped-filename)
 		       (append (if content-encoding

scheme/httpd/handlers.scm

@@ -85,4 +85,4 @@
 ;;; Can be useful as the default in table-driven request handlers.
 
 (define (null-request-handler path req)
-  (make-http-error-response http-status/not-found req))
+  (make-http-error-response (status-code not-found) req))

scheme/httpd/info-gateway.scm

@@ -141,7 +141,7 @@
 	   (lambda (c decline)
 	     (cond
 	      ((info-gateway-error? c)
-	       (apply http-error http-status/bad-gateway req
+	       (apply http-error (status-code bad-gateway) req
 		      (condition-stuff c)))
 	      ((http-error? c)
 	       (apply http-error (car (condition-stuff c)) req
@@ -150,8 +150,8 @@
 	       (decline))))
 
 	   (make-response
-	    http-status/ok
+	    (status-code ok)
-	    (status-code->text http-status/ok)
+	    #f
 	    (time)
 	    "text/html"
 	    '()
@@ -168,7 +168,7 @@
 		 (write-string address out)))))))
 
 	 (else 
-	  (make-http-error-response http-status/method-not-allowed req 
+	  (make-http-error-response (status-code method-not-allowed) req 
 				    request-method)))))))
 
 (define split-header-line
@@ -520,7 +520,7 @@
       (if (eof-object? line)
 	  (info-gateway-error "invalid info file"))
       (if (regexp-exec node-epilogue-regexp line)
-	  (http-error http-status/not-found #f "node not found"))
+	  (http-error (status-code not-found) #f "node not found"))
       (receive (entry-node file seek) (parse-tag line)
         (if (string=? node entry-node)
 	    (cons file seek)
@@ -529,7 +529,7 @@
 (define (find-indirection-entry seek-pos indirection-table)
   (let loop ((table indirection-table))
     (if (null? table)
-	(http-error http-status/not-found #f "node not found"))
+	(http-error (status-code not-found) #f "node not found"))
     (let* ((entry (car table))
 	   (pos (cdr entry)))
       (if (and (>= seek-pos pos)
@@ -573,7 +573,7 @@
 
 (define (find-node file node find-file)
   (if (not file)
-      (http-error http-status/not-found #f
+      (http-error (status-code not-found) #f
 		  "no file in info node specification"))
 
   (let* ((fname (find-file file))
@@ -581,7 +581,7 @@
     (let loop ((port port))
       (let ((line (read-line port)))
 	(if (eof-object? line)
-	    (http-error http-status/not-found #f "info node not found"))
+	    (http-error (status-code not-found) #f "info node not found"))
 	(if (node-prologue? line)
 	    (let ((header (read-line port)))
 	      (if (eof-object? header)
@@ -644,7 +644,7 @@
   (let ((alts (info-file-alternative-names file)))
     (let path-loop ((path info-path))
       (if (null? path)
-	  (http-error http-status/not-found #f "info file not found"))
+	  (http-error (status-code not-found) #f "info file not found"))
       (let alt-loop ((alts alts))
 	(if (null? alts)
 	    (path-loop (cdr path))

scheme/httpd/logging.scm

@@ -126,7 +126,7 @@
 		      (uri-path-list->path 
 		       (http-url-path (request-url req))) ; requested file
 		      (version->string (request-version req)) ; protocol version
-		      status-code
+		      (status-code-number status-code)
 		      23		; filesize (unknown)
 		      (get-header (request-headers req) 'referer)
 		      (get-header (request-headers req) 'user-agent))

scheme/httpd/response.scm

@@ -37,50 +37,47 @@
    ((reader-writer-body? body)
     ((reader-writer-body-proc body) iport oport options))))
 
+(define-finite-type status-code :http-status-code
+  (number message)
+  status-code?
+  status-codes
+  status-code-name
+  status-code-index
+  (number status-code-number)
+  (message status-code-message)
+  (
+   (ok			200 "OK")
+   (created		201 "Created")
+   (accepted		202 "Accepted")
+   (prov-info		203 "Provisional Information")
+   (no-content		204 "No Content")
 
-(define-syntax define-http-status-codes
+   (mult-choice		300 "Multiple Choices")
-  (syntax-rules ()
+   (moved-perm		301 "Moved Permanently")
-    ((define-http-status-codes table set (name val msg) ...)
+   (moved-temp		302 "Moved Temporarily")
-     (begin (define table '((val . msg) ...))
+   (method		303 "Method (obsolete)")
-	    (define-enum-constant set name val)
+   (not-mod		304 "Not Modified")
-	    ...))))
 
-(define-http-status-codes http-status-text-table http-status
+   (bad-request		400 "Bad Request")
-  (ok			200 "OK")
+   (unauthorized	401 "Unauthorized")
-  (created		201 "Created")
+   (payment-req		402 "Payment Required")
-  (accepted		202 "Accepted")
+   (forbidden		403 "Forbidden")
-  (prov-info		203 "Provisional Information")
+   (not-found		404 "Not Found")
-  (no-content		204 "No Content")
+   (method-not-allowed	405 "Method Not Allowed")
+   (none-acceptable	406 "None Acceptable")
+   (proxy-auth-required	407 "Proxy Authentication Required")
+   (timeout		408 "Request Timeout")
+   (conflict		409 "Conflict")
+   (gone			410 "Gone")
 
-  (mult-choice		300 "Multiple Choices")
+   (internal-error	500 "Internal Server Error")
-  (moved-perm		301 "Moved Permanently")
+   (not-implemented	501 "Not Implemented")
-  (moved-temp		302 "Moved Temporarily")
+   (bad-gateway		502 "Bad Gateway")
-  (method		303 "Method (obsolete)")
+   (service-unavailable	503 "Service Unavailable")
-  (not-mod		304 "Not Modified")
+   (gateway-timeout	504 "Gateway Timeout")
-
-  (bad-request		400 "Bad Request")
-  (unauthorized		401 "Unauthorized")
-  (payment-req		402 "Payment Required")
-  (forbidden		403 "Forbidden")
-  (not-found		404 "Not Found")
-  (method-not-allowed	405 "Method Not Allowed")
-  (none-acceptable	406 "None Acceptable")
-  (proxy-auth-required	407 "Proxy Authentication Required")
-  (timeout		408 "Request Timeout")
-  (conflict		409 "Conflict")
-  (gone			410 "Gone")
-
-  (internal-error	500 "Internal Server Error")
-  (not-implemented	501 "Not Implemented")
-  (bad-gateway		502 "Bad Gateway")
-  (service-unavailable	503 "Service Unavailable")
-  (gateway-timeout	504 "Gateway Timeout")
   
-  (redirect             -301 "Internal redirect"))
+   (redirect             -301 "Internal redirect")))
 	
-(define (status-code->text code)
-  (cdr (assv code http-status-text-table)))
-
 ;;; (make-http-error-response status-code req [message . extras])
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Take an http-error condition, and format it into a response to the client.
@@ -89,15 +86,13 @@
 ;;; even had a chance to parse and construct the request. This is only used
 ;;; for 400 BAD-REQUEST error report.
 
-(define (make-http-error-response status-code req . args)
+(define (make-http-error-response code req . args)
-  (http-log req status-code)
-
   (let* ((message (and (pair? args) (car args)))
 	 (extras  (if (pair? args) (cdr args) '()))
 
 	 (generic-title (lambda (port)
 			  (title-html port
-				      (status-code->text status-code))))
+				      (status-code-message code))))
 	 (send-message (lambda (port)
 			 (if message 
 			     (format port "<BR>~%Further Information: ~A<BR>~%" message))))
@@ -107,8 +102,8 @@
 			
 	 (create-response
 	  (lambda (headers writer-proc)
-	    (make-response status-code
+	    (make-response code
-			   (status-code->text status-code)
+			   #f
 			   (time)
 			   "text/html"
 			   headers
@@ -117,8 +112,8 @@
     (cond
      ;; This error response requires two args: message is the new URI: field,
      ;; and the first EXTRA is the older Location: field.
-     ((or (= status-code http-status/moved-temp)
+     ((or (eq? code (status-code moved-temp))
-	  (= status-code http-status/moved-perm))
+	  (eq? code (status-code moved-perm)))
       (create-response
        (list (cons 'uri message)
 	     (cons 'location (car extras)))
@@ -126,11 +121,13 @@
 	 (title-html port "Document moved")
 	 (format port
 		 "This document has ~A moved to a <A HREF=\"~A\">new location</A>.~%"
-		 (if (= status-code http-status/moved-temp) "temporarily" "permanently")
+		 (if (eq? code (status-code moved-temp))
+		     "temporarily"
+		     "permanently")
 		 message)
 	 (close-html port))))
 
-     ((= status-code http-status/bad-request)
+     ((eq? code (status-code bad-request))
       (create-response
        '()
        (lambda (port options)
@@ -140,7 +137,7 @@
 	 (send-message port)
 	 (close-html port))))
 
-     ((= status-code http-status/unauthorized)
+     ((eq? code (status-code unauthorized))
       (create-response
        (list (cons 'WWW-Authenticate message)) ; Vas is das? 
        ;; Vas das is? See: http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.47
@@ -152,7 +149,7 @@
 	 (send-message port)
 	 (close-html port))))
 
-     ((= status-code http-status/forbidden)
+     ((eq? code (status-code forbidden))
       (create-response
        '()
        (lambda (port options)
@@ -164,7 +161,7 @@
 	 (send-message port)
 	 (close-html port))))
        
-     ((= status-code http-status/not-found)
+     ((eq? code (status-code not-found))
       (create-response
        '()
        (lambda (port options)
@@ -175,8 +172,7 @@
 	 (send-message port)
 	 (close-html port))))
 
-     ((= status-code http-status/internal-error)
+     ((eq? code (status-code internal-error))
-      (http-syslog (syslog-level error) "internal-error: ~A" message)
       (create-response
        '()
        (lambda (port options)
@@ -191,7 +187,7 @@ the error, and time it occured.~%"
 	 (send-message port)
 	 (close-html port))))
       
-     ((= status-code http-status/not-implemented)
+     ((eq? code (status-code not-implemented))
       (create-response
        '()
        (lambda (port options)
@@ -202,22 +198,13 @@ the requested method (~A).~%"
 	 (send-message port)
 	 (close-html port))))
 
-     ((= status-code http-status/bad-gateway)
+     ((eq? code (status-code bad-gateway))
       (create-response
        '()
        (lambda (port options)
 	 (generic-title port)
 	 (format port "An error occured while waiting for the 
 response of a gateway.~%")
-	 (send-message port)
-	 (close-html port))))
-
-     (else 
-      (http-syslog (syslog-level info) "Skipping unhandled status code ~A.~%" status-code)
-      (create-response
-       '()
-       (lambda (port options)
-	 (generic-title port)
 	 (send-message port)
 	 (close-html port)))))))
 
@@ -233,8 +220,8 @@ response of a gateway.~%")
 ;; NEW-LOCATION. NEW-LOCATION must be uri-encoded and begin with a slash.
 (define (make-redirect-response new-location)
   (make-response
-   http-status/redirect
+   (status-code redirect)
-   (status-code->text http-status/redirect)
+   #f
    (time)
    ""
    '()

scheme/httpd/rman-gateway.scm

@@ -49,8 +49,8 @@
 	       (decline))))
 	   
 	   (make-response
-	    http-status/ok
+	    (status-code ok)
-	    (status-code->text http-status/ok)
+	    #f
 	    (time)
 	    "text/html"
 	    '()
@@ -65,7 +65,7 @@
 	       (with-tag out address ()
 		 (display address out)))))))
 	 (else 
-	  (make-http-error-response http-status/method-not-allowed req 
+	  (make-http-error-response (status-code method-not-allowed) req 
 				    request-method)))))))
 
 (define (cat-man-page key section out)
@@ -128,7 +128,7 @@
 	      (with-env (("MANPATH" . ,(string-join man-path ":")))
 			(run (,man-binary "-man" ,@(if section `(,section) '()) ,key)
 		     stdports))))
-	(http-error http-status/not-found #f "man page not found")))))
+	(http-error (status-code not-found) #f "man page not found")))))
 
 (define man-default-sections
   '("1" "2" "3" "4" "5" "6" "7" "8" "9" "o" "l" "n" "p"))
@@ -187,4 +187,4 @@
 			    (with-cwd (file->man-directory file)
 				      (exec-epf (,nroff-binary "-man")))))
 		       stdports)))
-      (http-error http-status/not-found #f "man page not found")))
+      (http-error (status-code not-found) #f "man page not found")))

scheme/httpd/seval.scm

@@ -47,12 +47,12 @@
      ((string=? request-method "POST")	; Could do others also.
       (seval path req))
      (else
-      (make-http-error-response http-status/method-not-allowed req request-method)))))
+      (make-http-error-response (status-code method-not-allowed) req request-method)))))
 
 (define (seval path req)
     (make-response
-     http-status/ok
+     (status-code ok)
-     (status-code->text http-status/ok)
+     #f
      (time)
      "text/html"
      '()

scheme/httpd/surflets/surflet-handler.scm

@@ -92,15 +92,15 @@
 	      (if (resume-url? path-string)
 		  (resume-url path-string servlet-path req)
 		  (launch-new-session path-string servlet-path req))
-	      (make-http-error-response http-status/method-not-allowed req 
+	      (make-http-error-response (status-code method-not-allowed) req 
 					request-method)))
-	(make-http-error-response http-status/bad-request req 
+	(make-http-error-response (status-code bad-request) req 
 				  (format #f "Bad path: ~s" path)))))
 
 (define (launch-new-session path-string servlet-path req)
   (cond 
    ((file-not-exists? (absolute-file-name path-string servlet-path))
-    (make-http-error-response http-status/not-found req path-string))
+    (make-http-error-response (status-code not-found) req path-string))
    ((string=? (file-name-extension path-string) ".scm")
     (obtain-lock *session-table-lock*)
     ;; no access to session table until new session-id is saved
@@ -147,7 +147,7 @@
 ;      (send-file-response full-file-name
 ;			  (file-info full-file-name)
 ;			  req))
-    (make-http-error-response http-status/forbidden req
+    (make-http-error-response (status-code forbidden) req
 			      "Can't serve other than Scheme files."
 			      path-string))
    ))
@@ -188,7 +188,7 @@
   (let ((bad-request 
 	 (lambda (path-string req)
 	   (make-http-error-response
-	    http-status/bad-request req
+	    (status-code bad-request) req
 	    (format #f 
 		    "<br>
 <p>There may be several reasons, why your request for a servlet was denied:
@@ -247,7 +247,7 @@
 						     continuation-counter
 						     continuation-id)))
 		       (response-maker new-url)))))
-	       (make-http-error-response http-status/not-found #f
+	       (make-http-error-response (status-code not-found) #f
 					 "The URL refers to a servlet, whose session is no longer alive.")))))
 
 (define (send/finish response)
@@ -558,7 +558,7 @@
 
 (define (bad-gateway-error-response req path-string condition)
   (make-http-error-response 
-   http-status/bad-gateway req
+   (status-code bad-gateway) req
    (format #f "Error in servlet ~s." path-string)
    condition))
 

scheme/httpd/surflets/surflets.scm

@@ -23,8 +23,8 @@
 
 (define (make-usual-html-response writer-proc)
   (make-response
-   http-status/ok
+   (status-code ok)
-   (status-code->text http-status/ok)
+   #f
    (time)
    "text/html"
    '()
@@ -99,7 +99,7 @@
 	     (if first-digit
 		 (string->number (substring content-length first-digit 
 					    content-length-len))
-		 ;; http-status/bad-request req 
+		 ;; (status-code bad-request) req 
 		 `(error "Illegal `Content-length:' header.")))))
 	(else 
 	 (error "No Content-length specified for POST data."))))

scheme/httpd/surflets/web-server/root/surflets/add-html.scm

@@ -50,7 +50,7 @@
 			    (a (@ (href ,new-url)) "close this session")))))))
 	;; How to clear session data and go to another HTML page:
 	(send/finish
-	 (make-http-error-response http-status/moved-temp req 
+	 (make-http-error-response (status-code moved-temp) req 
 				   "/" "/"))
 	))
 ;	))

scheme/httpd/surflets/web-server/root/surflets/add-raw.scm

@@ -49,8 +49,8 @@
 			       )))
 
 	  (make-response
-	   http-status/ok
+	   (status-code ok)
-	   (status-code->text http-status/ok)
+	   #f
 	   (time)
 	   "text/html"
 	   '()
@@ -77,8 +77,8 @@
 			       (number->string (+ (get-number1) (get-number2)))
 			       new-url)))
       (make-response
-       http-status/ok
+       (status-code ok)
-       (status-code->text http-status/ok)
+       #f
        (time)
        "text/html"
        '()
@@ -109,7 +109,7 @@
       ;; This finishes the session and does a redirect to the root
       ;; page.
       (send/finish
-       (make-http-error-response http-status/moved-temp req 
+       (make-http-error-response (status-code moved-temp) req 
 				 "/" "/")))
 
     ))

scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm

@@ -78,7 +78,7 @@
 
 
     (define (return-to-main-page req)
-      (send/finish (make-http-error-response http-status/moved-perm req
+      (send/finish (make-http-error-response (status-code moved-perm) req
 					     "admin.scm" "admin.scm")))
 
     (define (main req)

scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm

@@ -204,7 +204,7 @@ plot '~a' title 'Servlet Profiling ~a' with lines"
       (return-to-main-page req))
 
     (define (return-to-main-page req)
-      (send/finish (make-http-error-response http-status/moved-perm req
+      (send/finish (make-http-error-response (status-code moved-perm) req
 					     "admin.scm" "admin.scm")))
 
     (define (main req)

scheme/httpd/surflets/web-server/root/surflets/admin-servlets-cb.scm

@@ -295,7 +295,7 @@
 		  (map car continuations))))
 
     (define (return-to-main-page req)
-      (send/finish (make-http-error-response http-status/moved-perm req
+      (send/finish (make-http-error-response (status-code moved-perm) req
 					     "admin.scm" "admin.scm")))
     
     (define (main req)

scheme/httpd/surflets/web-server/root/surflets/admin-servlets.scm

@@ -307,7 +307,7 @@
 		  (map car continuations))))
 
     (define (return-to-main-page req)
-      (send/finish (make-http-error-response http-status/moved-perm req
+      (send/finish (make-http-error-response (status-code moved-perm) req
 					     "admin.scm" "admin.scm")))
     
     (define (main req)

scheme/packages.scm

@@ -278,35 +278,10 @@
 	  make-redirect-body redirect-body? redirect-body-location
 	  display-http-body
 
-	  ;; Integer reply codes
+	  status-code?
-	  status-code->text
+	  status-code-number
-	  http-status/ok
+	  status-code-message
-	  http-status/created
+	  status-code
-	  http-status/accepted
-	  http-status/prov-info
-	  http-status/no-content
-	  http-status/mult-choice
-	  http-status/moved-perm
-	  http-status/moved-temp
-	  http-status/method
-	  http-status/not-mod
-	  http-status/bad-request
-	  http-status/unauthorized
-	  http-status/payment-req
-	  http-status/forbidden
-	  http-status/not-found
-	  http-status/method-not-allowed
-	  http-status/none-acceptable
-	  http-status/proxy-auth-required
-	  http-status/timeout
-	  http-status/conflict
-	  http-status/gone
-	  http-status/internal-error
-	  http-status/not-implemented
-	  http-status/bad-gateway
-	  http-status/service-unavailable
-	  http-status/gateway-timeout
-	  http-status/redirect		; used internally
 
 	  make-http-error-response
 	  make-redirect-response
@@ -617,6 +592,7 @@
 	uri				; uri-path-list->path
 	url				; http-url-path
 	httpd-requests			; request record
+	httpd-responses
 	formats
 	format-net			; format-internet-host-address
 	(subset srfi-13 (string-join string-trim))
@@ -640,10 +616,9 @@
 	(subset scsh (format-date write-string time date))
 	syslog
 	define-record-types
-	defenum-package
+	finite-types
 	formats
 	httpd-requests
-	httpd-logging
 	httpd-read-options)
   (files (httpd response)))