70 lines
2.2 KiB
Racket
70 lines
2.2 KiB
Racket
#lang racket
|
|
|
|
(provide (contract-out
|
|
[request (-> url? (values integer? string? input-port?))])
|
|
(struct-out exn:fail:response))
|
|
|
|
(require openssl)
|
|
(require net/url-string)
|
|
|
|
;; ssl-connect may raise (by way of tcp-connect) exn:fail:network
|
|
;; read-response may raise exn:fail:network:gemini
|
|
(define (request url)
|
|
(define-values (c-in c-out)
|
|
(ssl-connect (url-host url)
|
|
(or (url-port url) 1965)))
|
|
|
|
(write-string (url->string url) c-out)
|
|
(write-string "\r\n" c-out)
|
|
|
|
(define-values (status header)
|
|
(read-response c-in))
|
|
|
|
(values status header c-in))
|
|
|
|
(struct exn:fail:response exn:fail ()
|
|
#:extra-constructor-name make-exn:fail:response
|
|
#:transparent)
|
|
|
|
(define (raise-response-error name message response)
|
|
(raise (make-exn:fail:response
|
|
(format (string-append "~a: ~a~n"
|
|
" response: ~a")
|
|
(symbol->string name)
|
|
message
|
|
(if (> (string-length response) 20)
|
|
(format "~a... (truncated)" (substring response 0 20))
|
|
response))
|
|
(current-continuation-marks))))
|
|
|
|
(define (read-response (c-in (current-input-port)))
|
|
(define maxlen 1027)
|
|
|
|
(let ([header (peek-string maxlen 0 c-in)])
|
|
|
|
(if (not (string-contains? header "\r\n"))
|
|
(raise-response-error 'read-response
|
|
"header exceeds maximum length"
|
|
header)
|
|
|
|
(let ([header (read-line c-in 'return-linefeed)])
|
|
(define-values (status meta)
|
|
(let ([status-meta (string-split header " ")])
|
|
(values (car status-meta)
|
|
(string-join (cdr status-meta)))))
|
|
|
|
(cond
|
|
[(> (string-length status) 2)
|
|
(raise-response-error 'read-response
|
|
"status code exceeds maximum length"
|
|
header)]
|
|
|
|
|
|
[(andmap (compose not char-numeric?) (string->list status))
|
|
(raise-response-error 'read-response
|
|
"status code not numeric"
|
|
header)]
|
|
|
|
[else
|
|
(values (string->number status) meta)])))))
|