From 84089fd5c210ae6858ea45cfcbc2aae022d70750 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Wed, 11 Sep 2019 00:02:50 +0200 Subject: [PATCH] Added support for mime-specified gemini charset. --- NOTES.org | 3 ++- elpher.el | 81 ++++++++++++++++++++++++++++++++++--------------------- 2 files changed, 52 insertions(+), 32 deletions(-) diff --git a/NOTES.org b/NOTES.org index ec141f3..f4c616e 100644 --- a/NOTES.org +++ b/NOTES.org @@ -28,7 +28,7 @@ the bookmark page are available everywhere else. But expanding and collapsing bookmark groups sounds like it might need more specific bindings. -** IN-PROGRESS Implement Gemini support [62%] +** IN-PROGRESS Implement Gemini support [66%] Here is the checklist of features required before release: - [X] basic genimi transactions @@ -37,6 +37,7 @@ Here is the checklist of features required before release: - [X] gemini map files (text/gemini) - [X] Support for plain text responses (text/*) - [X] Support for image responses (text/image) +- [X] Support for mime-specified character encodeing - [ ] Saving responses to disk - [ ] Viewing raw responses diff --git a/elpher.el b/elpher.el index 669ed55..c716d0c 100644 --- a/elpher.el +++ b/elpher.el @@ -204,12 +204,7 @@ allows switching from an encrypted channel back to plain text without user input (setf (url-filename url) "")) (when (or (equal (url-filename url) "") (equal (url-filename url) "/")) - (setf (url-filename url) "/1")) - (unless (> (url-port url) 0) - (setf (url-port url) 70))) - (when is-gemini - (unless (> (url-port url) 0) - (setf (url-port url) 1965)))) + (setf (url-filename url) "/1")))) url) (set-match-data data)))) @@ -243,7 +238,10 @@ attributes: TYPE, SELECTOR, HOST and PORT." (let ((protocol (url-type address))) (cond ((or (equal protocol "gopher") (equal protocol "gophers")) - (list 'gopher (string-to-char (substring (url-filename address) 1)))) + (list 'gopher + (if (member (url-filename address) '("" "/")) + ?1 + (string-to-char (substring (url-filename address) 1))))) ((equal protocol "gemini") 'gemini) (t 'other-url))))) @@ -277,7 +275,9 @@ attributes: TYPE, SELECTOR, HOST and PORT." (defun elpher-gopher-address-selector (address) "Retrieve gopher selector from ADDRESS object." - (substring (url-filename address) 2)) + (if (member (url-filename address) '("" "/")) + "" + (substring (url-filename address) 2))) ;; Node @@ -548,7 +548,9 @@ up to the calling function." (proc (open-network-stream "elpher-process" nil (elpher-address-host address) - (elpher-address-port address) + (if (> (elpher-address-port address) 0) + (elpher-address-port address) + 70) :type (if elpher-use-tls 'tls 'plain)))) (set-process-coding-system proc 'binary) (set-process-filter proc @@ -603,7 +605,7 @@ up to the calling function." ;; Text retrieval (defconst elpher-url-regex - "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\|\[[a-zA-Z0-9:]+\]\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?" + "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\|\[[a-zA-Z0-9:]+\]\\)\\(?3::[0-9]+\\)?\\(?4:/[^<> \r\n\t(),]*\\)?" "Regexp used to locate and buttinofy URLs in text files loaded by elpher.") (defun elpher-buttonify-urls (string) @@ -807,7 +809,9 @@ up to the calling function." (proc (open-network-stream "elpher-process" nil (elpher-address-host address) - (elpher-address-port address) + (if (> (elpher-address-port address) 0) + (elpher-address-port address) + 1965) :type 'tls))) (set-process-coding-system proc 'binary) (set-process-filter proc @@ -827,16 +831,34 @@ up to the calling function." (process-send-string proc (concat (elpher-address-to-url address) "\r\n"))))) -(defun elpher-render-gemini-response (mime-type-raw) - (let* ((mime-type-full (if (string-empty-p mime-type-raw) - "text/gemini; charset=utf-8" - mime-type-raw)) - (mime-type-split (split-string mime-type-full ";")) - (mime-type (string-trim (elt mime-type-split 0))) - (parameters (if (> (length mime-type-split) 1) - (string-trim (elt mime-type-split 1)) - ""))) - ;; (message "MIME type %S with parameters %S" mime-type parameters) +(defun elpher-process-mime-type-string (mime-type-string) + (let ((mime-type-split (split-string mime-type-string ";")) + (mime-type (string-trim (car mime-type-split))) + (parameter-strings (cdr mime-type-split))) + ())) + + +(defun elpher-render-gemini-response (mime-type-string) + (let* ((mime-type-string* (if (string-empty-p mime-type-string) + "text/gemini; charset=utf-8" + mime-type-string)) + (mime-type-split (split-string mime-type-string* ";")) + (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)))) + (if (and (equal "text/gemini" mime-type) + (not (assoc "charset" parameters))) + (setq parameters (cons (list "charset" "utf-8") parameters))) + (when (string-prefix-p "text/" mime-type) + (if (assoc "charset" parameters) + (setq elpher-gemini-response + (decode-coding-string elpher-gemini-response + (intern (cadr (assoc "charset" parameters)))))) + (setq elpher-gemini-response + (replace-regexp-in-string "\r" "" elpher-gemini-response))) (pcase mime-type ((or "text/gemini" "") (elpher-render--mimetype-text/gemini elpher-gemini-response parameters)) @@ -858,27 +880,24 @@ up to the calling function." ""))) (defun elpher-address-from-gemini-url (url) + "Extract address from URL with defaults as per gemini map files." (let ((address (url-generic-parse-url url))) - (unless (equal (url-type address) "mailto") + (unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls (setf (url-fullness address) t) - (unless (url-host address) + (unless (url-host address) ;if there is an explicit host, filenames are explicit (setf (url-host address) (url-host (elpher-node-address elpher-current-node))) - (unless (string-prefix-p "/" (url-filename address)) + (unless (string-prefix-p "/" (url-filename address)) ;deal with relative links (setf (url-filename address) - (concat (file-name-as-directory + (concat (file-name-directory (url-filename (elpher-node-address elpher-current-node))) (url-filename address))))) (unless (url-type address) - (setf (url-type address) "gemini")) - (unless (> (url-port address) 0) - (pcase (url-type address) - ("gemini" (setf (url-port address) 1965)) - ("gopher" (setf (url-port address) 70))))) + (setf (url-type address) "gemini"))) address)) (defun elpher-render--mimetype-text/gemini (data parameters) (elpher-with-clean-buffer - (dolist (line (split-string (elpher-preprocess-text-response data) "\n")) + (dolist (line (split-string data "\n")) (if (string-prefix-p "=>" line) (let* ((url (elpher-gemini-get-link-url line)) (display-string (elpher-gemini-get-link-display-string line)) -- 2.20.1