# gemini-client.scm -rw-r--r-- 2.7 KiB View raw
                                                                                
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
(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 mime)
         (let ((mime (string->symbol
                      (string-trim-right mime char-set:whitespace))))
           (unless (and (> (string-length status) 0)
                        (char=? (string-ref status 0) #\2))
             (error "server error" status))
           (list mime
                 (read-response mime port))))
        (else (error "invalid response from server" initial-line))))))