From: plugd <plugd@thelambdalab.xyz>
Date: Thu, 5 May 2022 08:21:55 +0000 (+0200)
Subject: Adding spartan support.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=87b89f4cf8ee9d6cfe0b189115b64a816e7227e2;p=elpher.git

Adding spartan support.
---

diff --git a/elpher.el b/elpher.el
index 9236228..2a115e7 100644
--- a/elpher.el
+++ b/elpher.el
@@ -91,6 +91,7 @@
     ((gopher ?s) elpher-get-gopher-page elpher-render-download "snd" elpher-binary)
     ((gopher ?h) elpher-get-gopher-page elpher-render-html "htm" elpher-html)
     (gemini elpher-get-gemini-page elpher-render-gemini "gem" elpher-gemini)
+    (spartan elpher-get-spartan-page elpher-render-spartan "spt" elpher-spartan)
     (finger elpher-get-finger-page elpher-render-text "txt" elpher-text)
     (telnet elpher-get-telnet-page nil "tel" elpher-telnet)
     (other-url elpher-get-other-url-page nil "url" elpher-other-url)
@@ -274,6 +275,10 @@ meaningfully."
   '((t :inherit font-lock-constant-face))
   "Face used for Gemini type directory records.")
 
+(defface elpher-spartan
+  '((t :inherit font-lock-constant-face))
+  "Face used for Spartan type directory records.")
+
 (defface elpher-other-url
   '((t :inherit font-lock-comment-face))
   "Face used for other URL type links records.")
@@ -1691,6 +1696,92 @@ can be used to toggle the display of the preformatted text."
               headers))
       (reverse headers))))
 
+;; Spartan page retrieval
+
+(defun elpher-get-spartan-page (renderer)
+  "Getter which retrieves and renders a Spartan 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-spartan-response address renderer))
+      (error
+       (elpher-network-error address the-error)))))
+
+(defun elpher-get-spartan-response (address renderer)
+  "Get response string from spartan server at ADDRESS and render using RENDERER."
+  (elpher-get-host-response address 300
+                            (concat (elpher-address-host address) " "
+                                    (elpher-address-filename address) " "
+                                    "0\r\n") ; No uploads for now
+                            (lambda (response-string)
+                              (elpher-process-spartan-response response-string renderer))))
+
+(defun elpher-parse-spartan-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 1))
+                    (meta (string-trim (substring header 1))))
+                (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-spartan-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)
+        (?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 (eq (elpher-address-type 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))))))
 
 ;; Finger page connection