65 lines
1.9 KiB
Scheme
65 lines
1.9 KiB
Scheme
;;; This file is part of the Scheme Untergrund Networking package.
|
|
|
|
;;; Copyright (c) 2002 by Mike Sperber.
|
|
;;; For copyright information, see the file COPYING which comes with
|
|
;;; the distribution.
|
|
|
|
(define-record-type :http-response
|
|
(make-response code message seconds mime extras body)
|
|
response?
|
|
(code response-code)
|
|
(message response-message)
|
|
(seconds response-seconds)
|
|
(mime response-mime)
|
|
(extras response-extras)
|
|
(body response-body))
|
|
|
|
(define-record-type :http-writer-body
|
|
(make-writer-body proc)
|
|
writer-body?
|
|
(proc writer-body-proc))
|
|
|
|
(define (display-http-body body port options)
|
|
((writer-body-proc body) port options))
|
|
|
|
|
|
(define-syntax define-http-status-codes
|
|
(syntax-rules ()
|
|
((define-http-status-codes table set (name val msg) ...)
|
|
(begin (define table '((val . msg) ...))
|
|
(define-enum-constant set name val)
|
|
...))))
|
|
|
|
(define-http-status-codes http-status-text-table http-status
|
|
(ok 200 "OK")
|
|
(created 201 "Created")
|
|
(accepted 202 "Accepted")
|
|
(prov-info 203 "Provisional Information")
|
|
(no-content 204 "No Content")
|
|
|
|
(mult-choice 300 "Multiple Choices")
|
|
(moved-perm 301 "Moved Permanently")
|
|
(moved-temp 302 "Moved Temporarily")
|
|
(method 303 "Method (obsolete)")
|
|
(not-mod 304 "Not Modified")
|
|
|
|
(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"))
|
|
|
|
(define (status-code->text code)
|
|
(cdr (assv code http-status-text-table))) |