+ (when mime-type-string
+ (insert "MIME type specified by server: '" mime-type-string "'\n"))
+ (insert data)
+ (goto-char (point-min)))
+ (message "Displaying raw server response. Reload or redraw to return to standard view.")))
+
+;; File save "rendering"
+
+(defun elpher-render-download (data &optional _mime-type-string)
+ "Save DATA to file. MIME-TYPE-STRING is unused."
+ (if (not data)
+ nil
+ (let* ((address (elpher-page-address elpher-current-page))
+ (selector (if (elpher-address-gopher-p address)
+ (elpher-gopher-address-selector address)
+ (elpher-address-filename address))))
+ (elpher-visit-previous-page) ; Do first in case of non-local exits.
+ (let* ((filename-proposal (file-name-nondirectory selector))
+ (filename (read-file-name "Download complete. Save file as: "
+ nil nil nil
+ (if (> (length filename-proposal) 0)
+ filename-proposal
+ "download.file"))))
+ (let ((coding-system-for-write 'binary))
+ (with-temp-file filename
+ (insert data)))
+ (message (format "Saved to file %s." filename))))))
+
+;; HTML rendering
+
+(defun elpher-render-html (data &optional _mime-type-string)
+ "Render DATA as HTML using shr. MIME-TYPE-STRING is unused."
+ (elpher-with-clean-buffer
+ (if (not data)
+ t
+ (let ((dom (with-temp-buffer
+ (insert data)
+ (libxml-parse-html-region (point-min) (point-max)))))
+ (shr-insert-document dom)))))
+
+;; Gemini page retrieval
+
+(defvar elpher-gemini-redirect-chain)
+
+(defun elpher-get-gemini-response (address renderer)
+ "Get response string from gemini server at ADDRESS and render using RENDERER."
+ (elpher-get-host-response address 1965
+ (concat (elpher-address-to-url address) "\r\n")
+ (lambda (response-string)
+ (elpher-process-gemini-response response-string renderer))
+ 'gemini))
+
+(defun elpher-parse-gemini-response (response)
+ "Parse the RESPONSE string and return a list of components.
+The list is of the form (code meta body). A response of nil implies
+that the response was malformed."
+ (let ((header-end-idx (string-match "\r\n" response)))
+ (if header-end-idx
+ (let ((header (string-trim (substring response 0 header-end-idx)))
+ (body (substring response (+ header-end-idx 2))))
+ (if (>= (length header) 2)
+ (let ((code (substring header 0 2))
+ (meta (string-trim (substring header 2))))
+ (list code meta body))
+ (error "Malformed response: No response status found in header %s" header)))
+ (error "Malformed response: No CRLF-delimited header found in response %s" response))))
+
+(defun elpher-process-gemini-response (response-string renderer)
+ "Process the gemini response RESPONSE-STRING and pass the result to RENDERER."
+ (let ((response-components (elpher-parse-gemini-response response-string)))
+ (let ((response-code (elt response-components 0))
+ (response-meta (elt response-components 1))
+ (response-body (elt response-components 2)))
+ (pcase (elt response-code 0)
+ (?1 ; Input required
+ (elpher-with-clean-buffer
+ (insert "Gemini server is requesting input."))
+ (let* ((query-string
+ (if (eq (elt response-code 1) ?1)
+ (read-passwd (concat response-meta ": "))
+ (read-string (concat response-meta ": "))))
+ (query-address (seq-copy (elpher-page-address elpher-current-page)))
+ (old-fname (url-filename query-address)))
+ (setf (url-filename query-address)
+ (concat old-fname "?" (url-build-query-string `((,query-string)))))
+ (elpher-get-gemini-response query-address renderer)))
+ (?2 ; Normal response
+ (funcall renderer response-body response-meta))
+ (?3 ; Redirect
+ (message "Following redirect to %s" response-meta)
+ (if (>= (length elpher-gemini-redirect-chain) 5)
+ (error "More than 5 consecutive redirects followed"))
+ (let ((redirect-address (elpher-address-from-gemini-url response-meta)))
+ (if (member redirect-address elpher-gemini-redirect-chain)
+ (error "Redirect loop detected"))
+ (if (not (string= (elpher-address-protocol redirect-address)
+ "gemini"))
+ (error "Server tried to automatically redirect to non-gemini URL: %s"
+ response-meta))
+ (elpher-page-set-address elpher-current-page redirect-address)
+ (add-to-list 'elpher-gemini-redirect-chain redirect-address)
+ (elpher-get-gemini-response redirect-address renderer)))
+ (?4 ; Temporary failure
+ (error "Gemini server reports TEMPORARY FAILURE for this request: %s %s"
+ response-code response-meta))
+ (?5 ; Permanent failure
+ (error "Gemini server reports PERMANENT FAILURE for this request: %s %s"
+ response-code response-meta))
+ (?6 ; Client certificate required
+ (elpher-with-clean-buffer
+ (if elpher-client-certificate
+ (insert "Gemini server does not recognise the provided TLS certificate:\n\n")
+ (insert "Gemini server is requesting a valid TLS certificate:\n\n"))
+ (auto-fill-mode 1)
+ (elpher-gemini-insert-text response-meta))
+ (let ((chosen-certificate (elpher-choose-client-certificate)))
+ (unless chosen-certificate
+ (error "Gemini server requires a client certificate and none was provided"))
+ (setq elpher-client-certificate chosen-certificate))
+ (elpher-with-clean-buffer)
+ (elpher-get-gemini-response (elpher-page-address elpher-current-page) renderer))
+ (_other
+ (error "Gemini server response unknown: %s %s"
+ response-code response-meta))))))
+
+(defun elpher--read-answer-polyfill (question answers)
+ "Polyfill for `read-answer' in Emacs 26.1.
+QUESTION is a string containing a question, and ANSWERS
+is a list of possible answers."
+ (completing-read question (mapcar 'identity answers)))
+
+(if (fboundp 'read-answer)
+ (defalias 'elpher-read-answer 'read-answer)
+ (defalias 'elpher-read-answer 'elpher--read-answer-polyfill))
+
+(defun elpher-choose-client-certificate ()
+ "Prompt for a client certificate to use to establish a TLS connection."
+ (let* ((read-answer-short t))
+ (pcase (read-answer "What do you want to do? "
+ '(("throwaway" ?t
+ "generate and use throw-away certificate")
+ ("persistent" ?p
+ "generate new or use existing persistent certificate")
+ ("abort" ?a
+ "stop immediately")))
+ ("throwaway"
+ (setq elpher-client-certificate (elpher-generate-throwaway-certificate)))
+ ("persistent"
+ (let* ((existing-certificates (elpher-list-existing-certificates))
+ (file-base (completing-read
+ "Nickname for new or existing certificate (autocompletes, empty response aborts): "
+ existing-certificates)))
+ (if (string-empty-p (string-trim file-base))
+ nil
+ (if (member file-base existing-certificates)
+ (setq elpher-client-certificate
+ (elpher-get-existing-certificate file-base))
+ (pcase (read-answer "Generate new certificate or install externally-generated one? "
+ '(("new" ?n
+ "generate new certificate")
+ ("install" ?i
+ "install existing certificate")
+ ("abort" ?a
+ "stop immediately")))
+ ("new"
+ (let ((common-name (read-string "Common Name field for new certificate: "
+ file-base)))
+ (message "New key and self-signed certificate written to %s"
+ elpher-certificate-directory)
+ (elpher-generate-persistent-certificate file-base common-name)))
+ ("install"
+ (let* ((cert-file (read-file-name "Certificate file: " nil nil t))
+ (key-file (read-file-name "Key file: " nil nil t)))
+ (message "Key and certificate installed in %s for future use"
+ elpher-certificate-directory)
+ (elpher-install-and-use-existing-certificate key-file
+ cert-file
+ file-base)))
+ ("abort" nil))))))
+ ("abort" nil))))
+
+(defun elpher-get-gemini-page (renderer)
+ "Getter which retrieves and renders a Gemini page and renders it using RENDERER."
+ (let* ((address (elpher-page-address elpher-current-page))
+ (content (elpher-get-cached-content address)))
+ (condition-case the-error
+ (if (and content (funcall renderer nil))
+ (elpher-with-clean-buffer
+ (insert content)
+ (elpher-restore-pos))
+ (elpher-with-clean-buffer
+ (insert "LOADING GEMINI... (use 'u' to cancel)\n"))
+ (setq elpher-gemini-redirect-chain nil)
+ (elpher-get-gemini-response address renderer))
+ (error
+ (elpher-network-error address the-error)))))
+
+(defun elpher-render-gemini (body &optional mime-type-string)
+ "Render gemini response BODY with rendering MIME-TYPE-STRING."
+ (if (not body)
+ t
+ (let* ((mime-type-string* (if (or (not mime-type-string)
+ (string-empty-p mime-type-string))
+ "text/gemini; charset=utf-8"
+ mime-type-string))
+ (mime-type-split (split-string mime-type-string* ";" t))
+ (mime-type (string-trim (car mime-type-split)))
+ (parameters (mapcar (lambda (s)
+ (let ((key-val (split-string s "=")))
+ (list (downcase (string-trim (car key-val)))
+ (downcase (string-trim (cadr key-val))))))
+ (cdr mime-type-split))))
+ (when (string-prefix-p "text/" mime-type)
+ (setq body (decode-coding-string
+ body
+ (if (assoc "charset" parameters)
+ (intern (cadr (assoc "charset" parameters)))
+ 'utf-8)))
+ (setq body (replace-regexp-in-string "\r" "" body)))
+ (pcase mime-type
+ ((or "text/gemini" "")
+ (elpher-render-gemini-map body parameters))
+ ("text/html"
+ (elpher-render-html body))
+ ((pred (string-prefix-p "text/"))
+ (elpher-render-gemini-plain-text body parameters))
+ ((pred (string-prefix-p "image/"))
+ (elpher-render-image body))
+ (_other
+ (elpher-render-download body))))))
+
+(defun elpher-gemini-get-link-url (link-line)
+ "Extract the url portion of LINK-LINE, a gemini map file link line.
+Returns nil in the event that the contents of the line following the
+=> prefix are empty."
+ (let ((l (split-string (substring link-line 2))))
+ (if l
+ (string-trim (elt l 0))
+ nil)))
+
+(defun elpher-gemini-get-link-display-string (link-line)
+ "Extract the display string portion of LINK-LINE, a gemini map file link line.
+Returns the url portion in the event that the display-string portion is empty."
+ (let* ((rest (string-trim (elt (split-string link-line "=>") 1)))
+ (idx (string-match "[ \t]" rest)))
+ (string-trim (if idx
+ (substring rest (+ idx 1))
+ rest))))
+
+(defun elpher-collapse-dot-sequences (filename)
+ "Collapse dot sequences in FILENAME.
+For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
+ (let* ((path (split-string filename "/"))
+ (path-reversed-normalized
+ (seq-reduce (lambda (a b)
+ (cond ((and a (equal b "..") (cdr a)))
+ ((and (not a) (equal b "..")) a) ;leading .. are dropped
+ ((equal b ".") a)
+ (t (cons b a))))
+ path nil)))
+ (string-join (reverse path-reversed-normalized) "/")))
+
+(defun elpher-address-from-gemini-url (url)
+ "Extract address from URL with defaults as per gemini map files.
+While there's obviously some redundancy here between this function and
+`elpher-address-from-url', gemini map file URLs require enough special
+treatment that a separate function is warranted."
+ (let ((address (url-generic-parse-url url))
+ (current-address (elpher-page-address elpher-current-page)))
+ (unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls
+ (setf (url-fullness address) t)
+ (if (url-host address) ;if there is an explicit host, filenames are absolute
+ (if (string-empty-p (url-filename address))
+ (setf (url-filename address) "/")) ;ensure empty filename is marked as absolute
+ (setf (url-host address) (url-host current-address))
+ (setf (url-port address) (url-port current-address))
+ (unless (string-prefix-p "/" (url-filename address)) ;deal with relative links
+ (setf (url-filename address)
+ (concat (file-name-directory (url-filename current-address))
+ (url-filename address)))))
+ (unless (url-type address)
+ (setf (url-type address) "gemini"))
+ (when (equal (url-type address) "gemini")
+ (setf (url-filename address)
+ (elpher-collapse-dot-sequences (url-filename address)))))
+ (elpher-remove-redundant-ports address)))
+
+(defun elpher-gemini-insert-link (link-line)
+ "Insert link described by LINK-LINE into a text/gemini document."
+ (let* ((url (elpher-gemini-get-link-url link-line))
+ (display-string (elpher-gemini-get-link-display-string link-line))
+ (address (elpher-address-from-gemini-url url))
+ (type (if address (elpher-address-type address) nil))
+ (type-map-entry (cdr (assoc type elpher-type-map))))
+ (when display-string
+ (insert elpher-gemini-link-string)
+ (if type-map-entry
+ (let* ((face (elt type-map-entry 3))
+ (filtered-display-string (elpher-color-filter-apply display-string))
+ (page (elpher-make-page filtered-display-string address)))
+ (elpher--insert-text-button filtered-display-string
+ 'face face
+ 'elpher-page page
+ 'action #'elpher-click-link
+ 'follow-link t
+ 'help-echo #'elpher--page-button-help))
+ (insert (propertize display-string 'face 'elpher-unknown)))
+ (insert "\n"))))
+
+(defun elpher-gemini-insert-header (header-line)
+ "Insert header described by HEADER-LINE into a text/gemini document.
+The gemini map file line describing the header is given
+by HEADER-LINE."
+ (when (string-match "^\\(#+\\)[ \t]*" header-line)
+ (let* ((level (length (match-string 1 header-line)))
+ (header (substring header-line (match-end 0)))
+ (face (pcase level
+ (1 'elpher-gemini-heading1)
+ (2 'elpher-gemini-heading2)
+ (3 'elpher-gemini-heading3)
+ (_ 'default)))
+ (fill-column (if (display-graphic-p)
+ (/ (* fill-column
+ (font-get (font-spec :name (face-font 'default)) :size))
+ (font-get (font-spec :name (face-font face)) :size)) fill-column)))
+ (setq elpher--gemini-page-headings (cons (cons header (point))
+ elpher--gemini-page-headings))
+ (unless (display-graphic-p)
+ (insert (make-string level ?#) " "))
+ (insert (propertize header 'face face))
+ (newline))))
+
+(defun elpher-gemini-insert-text (text-line)
+ "Insert a plain non-preformatted TEXT-LINE into a text/gemini document.
+This function uses Emacs' auto-fill to wrap text sensibly to a maximum
+width defined by `elpher-gemini-max-fill-width'."
+ (string-match "\\(^[ \t]*\\)\\(\\*[ \t]+\\|>[ \t]*\\)?" text-line)
+ (let* ((line-prefix (match-string 2 text-line))
+ (processed-text-line
+ (if line-prefix
+ (cond ((string-prefix-p "*" line-prefix)
+ (concat
+ (replace-regexp-in-string "\\*"
+ elpher-gemini-bullet-string
+ (match-string 0 text-line))
+ (substring text-line (match-end 0))))
+ ((string-prefix-p ">" line-prefix)
+ (propertize text-line 'face 'elpher-gemini-quoted))
+ (t text-line))
+ text-line))
+ (adaptive-fill-mode t)
+ ;; fill-prefix is important for adaptive-fill-mode: without
+ ;; it, multi-line list items are not indented correct
+ (fill-prefix (if (match-string 2 text-line)
+ (replace-regexp-in-string "[>\*]" " " (match-string 0 text-line))
+ nil)))
+ (insert (elpher-process-text-for-display processed-text-line))
+ (newline)))
+
+(defun elpher-render-gemini-map (data _parameters)
+ "Render DATA as a gemini map file, PARAMETERS is currently unused."
+ (elpher-with-clean-buffer
+ (setq elpher--gemini-page-headings nil)
+ (let ((preformatted nil))
+ (auto-fill-mode 1)
+ (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width))
+ (dolist (line (split-string data "\n"))
+ (cond
+ ((string-prefix-p "```" line) (setq preformatted (not preformatted)))
+ (preformatted (insert (elpher-process-text-for-display
+ (propertize line 'face 'elpher-gemini-preformatted))
+ "\n"))
+ ((string-prefix-p "=>" line)
+ (elpher-gemini-insert-link line))
+ ((string-prefix-p "#" line) (elpher-gemini-insert-header line))
+ (t (elpher-gemini-insert-text line)))))
+ (setq elpher--gemini-page-headings (nreverse elpher--gemini-page-headings))
+ (elpher-cache-content
+ (elpher-page-address elpher-current-page)
+ (buffer-string))))
+
+(defun elpher-render-gemini-plain-text (data _parameters)
+ "Render DATA as plain text file. PARAMETERS is currently unused."
+ (elpher-with-clean-buffer
+ (insert (elpher-process-text-for-display data))
+ (elpher-cache-content
+ (elpher-page-address elpher-current-page)
+ (buffer-string))))
+
+
+;; Finger page connection
+
+(defun elpher-get-finger-page (renderer)
+ "Opens a finger connection to the current page address.
+The result is rendered using RENDERER."
+ (let* ((address (elpher-page-address elpher-current-page))
+ (content (elpher-get-cached-content address)))
+ (if (and content (funcall renderer nil))