;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 2.9.1
+;; Version: 2.10.2
;; Keywords: comm gopher
;; Homepage: http://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "26.2"))
(require 'ansi-color)
(require 'nsm)
(require 'gnutls)
+(require 'socks)
;;; Global constants
;;
-(defconst elpher-version "2.9.1"
+(defconst elpher-version "2.10.2"
"Current version of elpher.")
(defconst elpher-margin-width 6
some servers which do not support IPv6 can take a long time to time-out."
:type '(boolean))
+(defcustom elpher-socks-always nil
+ "If non-nil, elpher will establish network connections over a SOCKS proxy.
+Otherwise, the SOCKS proxy is only used for connections to onion services."
+ :type '(boolean))
+
;; Face customizations
(defgroup elpher-faces nil
"Face used for html type directory records.")
(defface elpher-gemini
- '((t :inherit font-lock-regexp-grouping-backslash))
+ '((t :inherit font-lock-constant-face))
"Face used for Gemini type directory records.")
(defface elpher-other-url
(condition-case nil
(let* ((kill-buffer-query-functions nil)
(port (elpher-address-port address))
+ (service (if (> port 0) port default-port))
(host (elpher-address-host address))
+ (socks (or elpher-socks-always (string-suffix-p ".onion" host)))
(response-string-parts nil)
(bytes-received 0)
(hkbytes-received 0)
- (proc (make-network-process :name "elpher-process"
- :host host
- :family (and force-ipv4 'ipv4)
- :service (if (> port 0) port default-port)
- :buffer nil
- :coding 'binary
- :noquery t
- :nowait t
- :tls-parameters
- (and use-tls
- (cons 'gnutls-x509pki
- (gnutls-boot-parameters
- :type 'gnutls-x509pki
- :hostname host
- :keylist
- (elpher-get-current-keylist address))))))
(timer (run-at-time elpher-connection-timeout nil
(lambda ()
(elpher-process-cleanup)
(cond
; Try again with IPv4
- ((not force-ipv4)
+ ((not (or force-ipv4 socks))
(message "Connection timed out. Retrying with IPv4.")
(elpher-get-host-response address default-port
query-string
response-processor
nil force-ipv4))
(t
- (elpher-network-error address "Connection time-out.")))))))
+ (elpher-network-error address "Connection time-out."))))))
+ (gnutls-params (list :type 'gnutls-x509pki :hostname host
+ :keylist (elpher-get-current-keylist address)))
+ (proc (if socks (socks-open-network-stream "elpher-process" nil host service)
+ (make-network-process :name "elpher-process"
+ :host host
+ :family (and force-ipv4 'ipv4)
+ :service service
+ :buffer nil
+ :nowait t
+ :tls-parameters
+ (and use-tls
+ (cons 'gnutls-x509pki
+ (apply #'gnutls-boot-parameters
+ gnutls-params)))))))
(setq elpher-network-timer timer)
+ (set-process-coding-system proc 'binary 'binary)
+ (set-process-query-on-exit-flag proc nil)
(elpher-buffer-message (concat "Connecting to " host "..."
" (press 'u' to abort)"))
(set-process-filter proc
(process-send-string proc query-string)))
((string-prefix-p "deleted" event)) ; do nothing
((and (not response-string-parts)
- (not (or elpher-ipv4-always force-ipv4)))
+ (not (or elpher-ipv4-always force-ipv4 socks)))
; Try again with IPv4
(message "Connection failed. Retrying with IPv4.")
(elpher-get-host-response address default-port
(t
(error "No response from server")))
(error
- (elpher-network-error address the-error))))))
+ (elpher-network-error address the-error)))))
+ (when socks
+ (if use-tls (apply #'gnutls-negotiate :process proc gnutls-params))
+ (funcall (process-sentinel proc) proc "open\n")))
(error
(error "Error initiating connection to server")))))
(cert-file (concat temporary-file-directory file-base ".crt")))
(elpher-generate-certificate file-base key-file cert-file t)))
-(defun elpher-generate-permanent-certificate (file-base common-name)
- "Generate and return details of a persistant certificate.
+(defun elpher-generate-persistent-certificate (file-base common-name)
+ "Generate and return details of a persistent certificate.
The argument FILE-BASE is used as the base for the key and certificate
files, while COMMON-NAME specifies the common name field of the
certificate.
(expand-file-name cert-file))))
(defun elpher-list-existing-certificates ()
- "Return a list of the persistant certificates in `elpher-certificate-directory'."
+ "Return a list of the persistent certificates in `elpher-certificate-directory'."
+ (unless (file-directory-p elpher-certificate-directory)
+ (make-directory elpher-certificate-directory))
(mapcar
(lambda (file)
(file-name-sans-extension file))
(pcase (read-answer "What do you want to do? "
'(("throwaway" ?t
"generate and use throw-away certificate")
- ("persistant" ?p
- "generate new or use existing persistant certificate")
+ ("persistent" ?p
+ "generate new or use existing persistent certificate")
("abort" ?a
"stop immediately")))
("throwaway"
(setq elpher-client-certificate (elpher-generate-throwaway-certificate)))
- ("persistant"
+ ("persistent"
(let* ((existing-certificates (elpher-list-existing-certificates))
(file-base (completing-read
"Nickname for new or existing certificate (autocompletes, empty response aborts): "
file-base)))
(message "New key and self-signed certificate written to %s"
elpher-certificate-directory)
- (elpher-generate-permanent-certificate file-base common-name)))
+ (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)))
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))))
+ (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 (/ (* fill-column
+ (font-get (font-spec :name (face-font 'default)) :size))
+ (font-get (font-spec :name (face-font face)) :size))))
(unless (display-graphic-p)
(insert (make-string level ?#) " "))
- (insert (propertize header 'face
- (pcase level
- (1 'elpher-gemini-heading1)
- (2 'elpher-gemini-heading2)
- (3 'elpher-gemini-heading3)
- (_ 'default)))
- "\n"))))
+ (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.
The Lambda Lab / projects / elpher.git / blobdiff