basic protocol
This commit is contained in:
parent
42f2eb864f
commit
1565ce19b8
|
@ -0,0 +1,7 @@
|
||||||
|
.PHONY: nothing setup
|
||||||
|
|
||||||
|
nothing:
|
||||||
|
@echo nothing to do here...
|
||||||
|
|
||||||
|
setup:
|
||||||
|
raco pkg install gemini/
|
|
@ -1,5 +1,95 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(provide helloworld)
|
(require racket/match racket/function racket/port racket/string
|
||||||
|
net/url net/url-structs net/url-string)
|
||||||
|
|
||||||
|
(provide (struct-out gmi-rsp)
|
||||||
|
(struct-out gmi-rsp:success)
|
||||||
|
gemini-request-read
|
||||||
|
gemini-parse-success-meta
|
||||||
|
gemini-response-read
|
||||||
|
gemini-request-write
|
||||||
|
gemini-response-write
|
||||||
|
gemini-make-success-meta)
|
||||||
|
|
||||||
|
;; protocol
|
||||||
|
|
||||||
|
(define gmi-codes
|
||||||
|
(hash 'input 10
|
||||||
|
'sensitive-input 11
|
||||||
|
'success 20
|
||||||
|
'redirect-temp 30
|
||||||
|
'redirect-perm 31
|
||||||
|
'failure-temp 40
|
||||||
|
'server-unavailable 41
|
||||||
|
'cgi-error 42
|
||||||
|
'proxy-error 43
|
||||||
|
'slow-down 44
|
||||||
|
'failure-perm 50
|
||||||
|
'not-found 51
|
||||||
|
'gone 52
|
||||||
|
'proxy-fail 53
|
||||||
|
'bad-request 59
|
||||||
|
'cert-required 60
|
||||||
|
'cert-not-authorized 61
|
||||||
|
'cert-not-valid 62))
|
||||||
|
(define gmi-rev-codes
|
||||||
|
(for/hash ([(k v) (in-hash gmi-codes)])
|
||||||
|
(values v k)))
|
||||||
|
|
||||||
|
;; Int Str
|
||||||
|
(struct gmi-rsp [status meta-line] #:transparent)
|
||||||
|
;; Str Hash Port
|
||||||
|
(struct gmi-rsp:success gmi-rsp [mime extra-fields body] #:transparent)
|
||||||
|
|
||||||
|
;; port -> url
|
||||||
|
;; reads a gemini request (returns the URL)
|
||||||
|
(define (gemini-request-read [port (current-input-port)])
|
||||||
|
(let ([line (read-line port 'any)])
|
||||||
|
(string->url port)))
|
||||||
|
|
||||||
|
;; util: parse success meta text
|
||||||
|
;; str -> mimetype fields-hash
|
||||||
|
(define (gemini-parse-success-meta meta)
|
||||||
|
(match (regexp-split #px"; *" meta)
|
||||||
|
[(list meta rst ...)
|
||||||
|
(values meta (for/hash ([item (in-list rst)])
|
||||||
|
(match (regexp-match-positions "=" item)
|
||||||
|
[(list (cons pos _)) (values (substring item 0 pos) (substring item (add1 pos)))]
|
||||||
|
[_ (values item #t)])))]
|
||||||
|
['() (raise (exn:fail:network "gmi protocol error" (current-continuation-marks)))]))
|
||||||
|
|
||||||
|
;; port -> gmi-rsp
|
||||||
|
(define (gemini-response-read [port (current-input-port)])
|
||||||
|
(let ([line (read-line port 'any)])
|
||||||
|
(match (regexp-match #px"^([0-9]{2}) (.*?)$" line)
|
||||||
|
[(list _ status-str meta)
|
||||||
|
(let ([status (string->number status-str)])
|
||||||
|
(match status
|
||||||
|
[(? (curry = (hash-ref gmi-codes 'success)))
|
||||||
|
(let-values ([(mime extra-fields) (gemini-parse-success-meta meta)])
|
||||||
|
(gmi-rsp:success status meta mime extra-fields port))]
|
||||||
|
[_
|
||||||
|
(close-input-port port)
|
||||||
|
(gmi-rsp status meta)]))]
|
||||||
|
[_ (raise (exn:fail:network "gmi protocol error" (current-continuation-marks)))])))
|
||||||
|
|
||||||
|
;; url port ->
|
||||||
|
(define (gemini-request-write req-url [port (current-output-port)])
|
||||||
|
(write-string (format "~a\r\n" (url->string req-url)) port))
|
||||||
|
|
||||||
|
;; gmi-rsp port ->
|
||||||
|
(define (gemini-response-write resp [port (current-output-port)])
|
||||||
|
(write-string (format "~a ~a\r\n" (gmi-rsp-status resp) (gmi-rsp-meta-line resp)) port))
|
||||||
|
|
||||||
|
;; string hash -> string
|
||||||
|
(define (gemini-make-success-meta mime extra-fields)
|
||||||
|
(string-join (cons mime (for/list ([(k v) (in-hash extra-fields)])
|
||||||
|
(match v
|
||||||
|
[#t k]
|
||||||
|
[_ (string-append k "=" v)])))
|
||||||
|
"; "))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit))
|
||||||
|
|
||||||
(define (helloworld) (displayln "hello world"))
|
|
||||||
|
|
Loading…
Reference in New Issue