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
|
||||
|
||||
(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