86 lines
2.3 KiB
Racket
86 lines
2.3 KiB
Racket
#lang racket
|
|
|
|
(provide client%)
|
|
|
|
(require (prefix-in net: "net.rkt")
|
|
(prefix-in gmi: "gmi.rkt"))
|
|
|
|
(require net/url-string)
|
|
|
|
(define temporary-failures
|
|
'((40 . "temporary failure")
|
|
(41 . "server unavailable")
|
|
(42 . "CGI error")
|
|
(43 . "proxy error")
|
|
(44 . "slow down")))
|
|
|
|
(define permanent-failures
|
|
'((50 . "permanent failure")
|
|
(51 . "not found")
|
|
(52 . "gone")
|
|
(53 . "proxy request refused")
|
|
(59 . "bad request")))
|
|
|
|
(struct exn:status:input-required exn ()
|
|
#:extra-constructor-name make-exn:status:input-required
|
|
#:transparent)
|
|
|
|
(struct exn:status:redirect exn ()
|
|
#:extra-constructor-name make-exn:status:redirect
|
|
#:transparent)
|
|
|
|
(struct exn:status:temporary-failure exn (errno)
|
|
#:extra-constructor-name make-exn:status:temporary-failure
|
|
#:transparent)
|
|
|
|
(struct exn:status:permanent-failure exn (errno)
|
|
#:extra-constructor-name make-exn:status:permanent-failure
|
|
#:transparent)
|
|
|
|
(struct exn:status:certificate-required exn ()
|
|
#:extra-constructor-name make-exn:status:certificate-required
|
|
#:transparent)
|
|
|
|
(define client%
|
|
(class object%
|
|
(define document-object '())
|
|
(define document-buffer '())
|
|
(define current-url '())
|
|
|
|
(super-new)
|
|
|
|
(define/private (get-document url)
|
|
(with-handlers
|
|
;; exceptions which may be raised by net:request
|
|
([exn:fail:network? (λ (exn) (displayln (exn-message exn)))]
|
|
[net:exn:fail:response? (λ (exn) (displayln (exn-message exn)))])
|
|
|
|
(let-values ([(status meta body-port) (net:request url)])
|
|
(cond
|
|
;; clients MUST reject status codes outside of the 10-69 range
|
|
[(or (< status 10) (> status 69))
|
|
(void)]
|
|
|
|
;; 10-19 INPUT REQUIRED
|
|
[(and (>= status 10) (<= status 19))
|
|
(void)]
|
|
|
|
;; 20-29 SUCCESS
|
|
[(and (>= status 20) (<= status 29))
|
|
(void)]
|
|
|
|
;; 30-39 REDIRECT
|
|
[(and (>= status 30) (<= status 39))
|
|
(void)]
|
|
|
|
;; 40-49 TEMPORARY FAILURE
|
|
[(and (>= status 40) (<= status 49))
|
|
(void)]
|
|
|
|
;; 50-59 PERMANENT FAILURE
|
|
[(and (>= status 50) (<= status 59))
|
|
(void)]
|
|
|
|
;; 60-69 CERTIFICATE REQUIRED
|
|
[(and (>= status 60) (<= status 69))]))))
|