X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=9540cee55e5e4110a882389c1c446d2a84bb297d;hp=e7b37ba017457101db6e648ea9aa7de11ffb17b8;hb=ca8d8fbb4c3c2909944f77590b4953ae65195d34;hpb=aa75538a7139278c120ccc4361fff634d1b2a715

diff --git a/elpher.el b/elpher.el
index e7b37ba..9540cee 100644
--- a/elpher.el
+++ b/elpher.el
@@ -5,7 +5,7 @@
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 3.4.0
+;; Version: 3.4.1
 ;; Keywords: comm gopher
 ;; Homepage: https://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "27.1"))
@@ -70,7 +70,7 @@
 ;;; Global constants
 ;;
 
-(defconst elpher-version "3.4.0"
+(defconst elpher-version "3.4.1"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -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-gemini "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.")
@@ -419,6 +424,7 @@ address refers to, via the table `elpher-type-map'."
                ?1
              (string-to-char (substring (url-filename address) 1)))))
     ("gemini" 'gemini)
+    ("spartan" 'spartan)
     ("telnet" 'telnet)
     ("finger" 'finger)
     ("file" 'file)
@@ -1691,6 +1697,85 @@ can be used to toggle the display of the preformatted text."
               headers))
       (reverse headers))))
 
+;; Spartan page retrieval
+
+(defvar elpher-spartan-redirect-chain)
+
+(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-spartan-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-spartan-redirect-chain) 5)
+             (error "More than 5 consecutive redirects followed"))
+         (let* ((current-address (elpher-page-address current-page))
+                (redirect-address (elpher-address-from-url
+                                   (concat "spartan://"
+                                           (elpher-address-host current-address)
+                                           ":"
+                                           (elpher-address-port current-address)
+                                           "/"
+                                           response-meta))))
+           (if (member redirect-address elpher-spartan-redirect-chain)
+               (error "Redirect loop detected"))
+           (elpher-page-set-address elpher-current-page redirect-address)
+           (add-to-list 'elpher-gemini-redirect-chain redirect-address)
+           (elpher-get-spartan-response redirect-address renderer)))
+        (?4 ; Temporary failure
+         (error "Spartan server reports CLIENT ERROR for this request: %s %s"
+                response-code response-meta))
+        (?5 ; Permanent failure
+         (error "Spartan server reports SERVER ERROR for this request: %s %s"
+                response-code response-meta))
+        (_other
+         (error "Spartan server response unknown: %s %s"
+                response-code response-meta))))))
 
 ;; Finger page connection