Ticket #688: default-reason-phrases.patch

File default-reason-phrases.patch, 4.1 KB (added by Moritz Heidkamp, 11 years ago)
  • tests/run.scm

     
    933933            (update-response
    934934             res
    935935             headers: (headers `((transfer-encoding chunked))))
    936             "foo" "1234567890")))))
     936            "foo" "1234567890"))))
     937  (test-group "Reason phrase"
     938    (let ((res (make-response major: 1 minor: 1)))
     939      (test "is added implicitly for known codes when not set"
     940            "HTTP/1.1 409 Conflict\r\n\r\ntest"
     941            (test-write-response
     942             (update-response res code: 409)
     943             "test"))
     944      (test-error "when not set an error is raised for unknown status codes"
     945                  (test-write-response
     946                   (update-response res code: 999)
     947                   "test"))
     948      (test "unknown status can still be used when a reason is given"
     949            "HTTP/1.1 999 No Way\r\n\r\ntest"
     950            (test-write-response
     951             (update-response res code: 999 reason: "No Way")
     952             "test"))
     953      (test "defaults can be parameterized"
     954            "HTTP/1.1 999 Say What\r\n\r\ntest"
     955            (parameterize ((http-status-codes (alist-cons 999 "Say What" (http-status-codes))))
     956              (test-write-response
     957               (update-response res code: 999)
     958               "test"))))))
    937959
    938960(test-group "Etag comparison procedures"
    939961  (test-group "Weak comparison"
  • intarweb.scm

     
    6161   write-response response-parsers response-unparsers read-response
    6262   http-0.9-response-parser http-1.x-response-parser
    6363   http-0.9-response-unparser http-1.x-response-unparser
     64   http-status-codes
    6465
    6566   ;; http-header-parsers
    6667   header-contents header-values header-value header-params header-param
     
    557558;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    558559
    559560(defstruct response
    560   (code 200) (reason "OK") (major 1) (minor 1) (headers (make-headers '())) port)
     561  (code 200) reason (major 1) (minor 1) (headers (make-headers '())) port)
    561562
     563(define http-status-codes
     564  (make-parameter
     565   `((100 . "Continue")
     566     (101 . "Switching Protocols")
     567     (200 . "OK")
     568     (201 . "Created")
     569     (202 . "Accepted")
     570     (203 . "Non-Authoritative Information")
     571     (204 . "No Content")
     572     (205 . "Reset Content")
     573     (206 . "Partial Content")
     574     (300 . "Multiple Choices")
     575     (301 . "Moved Permanently")
     576     (302 . "Found")
     577     (303 . "See Other")
     578     (304 . "Not Modified")
     579     (305 . "Use Proxy")
     580     (307 . "Temporary Redirect")
     581     (400 . "Bad Request")
     582     (401 . "Unauthorized")
     583     (402 . "Payment Required")
     584     (403 . "Forbidden")
     585     (404 . "Not Found")
     586     (405 . "Method Not Allowed")
     587     (406 . "Not Acceptable")
     588     (407 . "Proxy Authentication Required")
     589     (408 . "Request Time-out")
     590     (409 . "Conflict")
     591     (410 . "Gone")
     592     (411 . "Length Required")
     593     (412 . "Precondition Failed")
     594     (413 . "Request Entity Too Large")
     595     (414 . "Request-URI Too Large")
     596     (415 . "Unsupported Media Type")
     597     (416 . "Requested range not satisfiable")
     598     (417 . "Expectation Failed")
     599     (500 . "Internal Server Error")
     600     (501 . "Not Implemented")
     601     (502 . "Bad Gateway")
     602     (503 . "Service Unavailable")
     603     (504 . "Gateway Time-out")
     604     (505 . "HTTP Version not supported"))))
     605
    562606(define (http-0.9-response-unparser response)
    563607  response) ;; The response-body will just follow
    564608
     
    568612           (response-major response)
    569613           (response-minor response)
    570614           (response-code response)
    571            (response-reason response)))
     615           (or (response-reason response)
     616               (alist-ref (response-code response) (http-status-codes))
     617               (signal-http-condition "Unknown status code" 'unknown-status-code
     618                                      'code (response-code response)))))
    572619
    573620(define (http-1.0-response-unparser response)
    574621  (and-let* (((= (response-major response) 1))