1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
(define-module (gemini-client)
#:use-module (gnutls)
#:use-module (ice-9 format)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (web uri)
#:export (gemini-client
gemini-client-host-name
gemini-client-fetch-uri))
(define %gemini-port 1965)
;; Connection to a single Gemini server.
(define-record-type <gemini-client>
(%gemini-client host-name session)
gemini-client?
(host-name gemini-client-host-name)
(session gemini-client-gnutls-session))
(define* (gemini-client host-name
#:optional (port %gemini-port))
"Connect to a Gemini server located at HOST-NAME on PORT."
(let* ((session (make-session connection-end/client))
(ai (car (getaddrinfo host-name (number->string port) PF_UNSPEC)))
(sock (socket (addrinfo:fam ai)
(addrinfo:socktype ai)
(addrinfo:protocol ai))))
(connect sock (addrinfo:fam ai)
(sockaddr:addr (addrinfo:addr ai))
port)
(set-session-default-priority! session)
(set-session-credentials! session (make-certificate-credentials))
(set-session-dh-prime-bits! session 1024)
(set-session-transport-fd! session (fileno sock))
(handshake session)
(%gemini-client host-name session)))
(define (read-response mime port)
"Read content according to MIME from PORT."
(unless (eqv? mime 'text/gemini)
(error "unsupported mime type" mime))
(read-line port)
(let loop ((response '()))
(let ((line (read-line port)))
(if (eof-object? line)
(reverse! response)
(loop (cons (string-trim-right line char-set:whitespace)
response))))))
(define (gemini-client-fetch-uri client uri)
"Return a list of the form (mime-type content) where mime-type is a symbol
representing the content type, and content is the contents of the parsed
response. For 'text/gemini, this is a list of strings."
(unless (eqv? (uri-scheme uri) 'gemini)
(error "invalid uri scheme"))
(let* ((session (gemini-client-gnutls-session client))
(port (session-record-port session)))
(format port "~a\r\n" (uri->string uri))
(let ((initial-line (read-line port)))
(match (string-split initial-line #\tab)
((status meta)
(let ((meta (string->symbol
(string-trim-right meta char-set:whitespace))))
(unless (> (string-length status) 0)
(error "server error" status))
(match (string-ref status 0)
(#\1 (error "input requested, which library does not support"))
(#\2 (list meta (read-response meta port)))
(#\3 (gemini-client-fetch-uri client (string->uri meta)))
(#\4 (error "temporary server failure" meta))
(#\5 (error "permanent server failure" meta))
(#\6 (error "client certificate required, which library does not support"))
(_ (error "server error" status)))))
(else (error "invalid response from server" initial-line))))))