emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: bug#40248: 27.0.90; Failure open .authinfo.gpg from Gnus


From: Robert Pluim
Subject: Re: bug#40248: 27.0.90; Failure open .authinfo.gpg from Gnus
Date: Tue, 31 Mar 2020 11:20:17 +0200

(dropping the bug, redirecting to emacs-devel)

>>>>> On Sun, 29 Mar 2020 16:49:03 +0300, Eli Zaretskii <address@hidden> said:
    >> Yes, that's unfortunate -- the "bind variables as a way of passing in
    >> parameters" thing that Emacs does a lot is a really bad one.  I think
    >> the fix here would be to change open-network-stream, at least, to have a
    >> :coding parameter (and pass it on).

    Eli> Yes, let's do that on master.

Having resisted the strong urge to rip out the gnutls-cli support in
open-network-stream, this turned out to be surprisingly invasive. It
works for nnimap with Gnus for me when passing :coding 'binary instead
of binding coding-system-for-{read-write}, but more testing is
definitely required.

diff --git c/doc/lispref/processes.texi i/doc/lispref/processes.texi
index 4a4f51474c..7d9ca46d94 100644
--- c/doc/lispref/processes.texi
+++ i/doc/lispref/processes.texi
@@ -2462,6 +2462,12 @@ Network
 @item :nowait @var{boolean}
 If non-@code{nil}, try to make an asynchronous connection.
 
+@item :coding @var{coding}
+Use this to set the coding systems used by the network process, in
+preference to binding @code{coding-system-for-read} or
+@code{coding-system-for-write}.  @xref{Network Processes} for
+details.
+
 @item :type @var{type}
 The type of connection.  Options are:
 
diff --git c/etc/NEWS i/etc/NEWS
index 8bbe2aee0b..14bdae3ea7 100644
--- c/etc/NEWS
+++ i/etc/NEWS
@@ -274,6 +274,11 @@ optional argument specifying whether to follow symbolic 
links.
 ** 'parse-time-string' can now parse ISO 8601 format strings,
 such as "2020-01-15T16:12:21-08:00".
 
+** 'open-network-stream' now accepts a :coding argument.
+This allows specifying the coding systems used by a network process
+for encoding and decoding without having to bind
+coding-system-for-{read,write} or call 'set-process-coding-system'.
+
 
 * Changes in Emacs 28.1 on Non-Free Operating Systems
 
diff --git c/lisp/net/gnutls.el i/lisp/net/gnutls.el
index 459156e6d2..171a829f5b 100644
--- c/lisp/net/gnutls.el
+++ i/lisp/net/gnutls.el
@@ -169,8 +169,9 @@ open-gnutls-stream
 Fourth arg SERVICE is the name of the service desired, or an integer
 specifying a port number to connect to.
 Fifth arg PARAMETERS is an optional list of keyword/value pairs.
-Only :client-certificate and :nowait keywords are recognized, and
-have the same meaning as for `open-network-stream'.
+Only :client-certificate, :nowait, and :coding keywords are
+recognized, and have the same meaning as for
+`open-network-stream'.
 For historical reasons PARAMETERS can also be a symbol, which is
 interpreted the same as passing a list containing :nowait and the
 value of that symbol.
@@ -199,16 +200,19 @@ open-gnutls-stream
          (cert (network-stream-certificate host service parameters))
          (keylist (and cert (list cert)))
          (nowait (plist-get parameters :nowait))
-         (process (open-network-stream
-                   name buffer host service
-                   :nowait nowait
-                   :tls-parameters
-                   (and nowait
-                        (cons 'gnutls-x509pki
-                              (gnutls-boot-parameters
-                               :type 'gnutls-x509pki
-                               :keylist keylist
-                               :hostname (puny-encode-domain host)))))))
+         (coding-p (plist-member parameters :coding))
+         (coding-val (plist-get parameters :coding))
+         (args (append (list name buffer host service
+                             :nowait nowait
+                             :tls-parameters
+                             (and nowait
+                                  (cons 'gnutls-x509pki
+                                        (gnutls-boot-parameters
+                                         :type 'gnutls-x509pki
+                                         :keylist keylist
+                                         :hostname (puny-encode-domain 
host)))))
+                       (when coding-p (list :coding coding-val))))
+         (process (apply #'open-network-stream args)))
     (if nowait
         process
       (gnutls-negotiate :process process
diff --git c/lisp/net/network-stream.el i/lisp/net/network-stream.el
index e99d7a372c..d7d0aedada 100644
--- c/lisp/net/network-stream.el
+++ i/lisp/net/network-stream.el
@@ -113,6 +113,10 @@ open-network-stream
   `ssl'      -- Equivalent to `tls'.
   `shell'    -- A shell connection.
 
+:coding is a symbol or a cons used to specify the coding systems
+used to decode and encode the data which the process reads and
+writes.  See `make-network-process' for details.
+
 :return-list specifies this function's return value.
   If omitted or nil, return a process object.  A non-nil means to
   return (PROC . PROPS), where PROC is a process object and PROPS
@@ -178,18 +182,21 @@ open-network-stream
   (unless (featurep 'make-network-process)
     (error "Emacs was compiled without networking support"))
   (let ((type (plist-get parameters :type))
-       (return-list (plist-get parameters :return-list)))
+       (return-list (plist-get parameters :return-list))
+        (coding-p (plist-member parameters :coding)))
     (if (and (not return-list)
             (or (eq type 'plain)
                 (and (memq type '(nil network))
                      (not (and (plist-get parameters :success)
                                (plist-get parameters :capability-command))))))
        ;; The simplest case: wrapper around `make-network-process'.
-       (make-network-process :name name :buffer buffer
-                             :host (puny-encode-domain host) :service service
-                             :nowait (plist-get parameters :nowait)
-                              :tls-parameters
-                              (plist-get parameters :tls-parameters))
+        (let ((args (append (list :name name :buffer buffer
+                                  :host (puny-encode-domain host) :service 
service
+                                  :nowait (plist-get parameters :nowait)
+                                  :tls-parameters
+                                  (plist-get parameters :tls-parameters))
+                            (when coding-p (list :coding (plist-get parameters 
:coding))))))
+         (apply #'make-network-process args))
       (let ((work-buffer (or buffer
                             (generate-new-buffer " *stream buffer*")))
            (fun (cond ((and (eq type 'plain)
@@ -245,11 +252,15 @@ 'open-protocol-stream
   "26.1")
 
 (defun network-stream-open-plain (name buffer host service parameters)
-  (let ((start (with-current-buffer buffer (point)))
-       (stream (make-network-process :name name :buffer buffer
-                                     :host (puny-encode-domain host)
-                                      :service service
-                                     :nowait (plist-get parameters :nowait))))
+  (let* ((start (with-current-buffer buffer (point)))
+         (coding-p (plist-member parameters :coding))
+         (coding-val (plist-get parameters :coding))
+         (args (append (list :name name :buffer buffer
+                             :host (puny-encode-domain host)
+                             :service service
+                             :nowait (plist-get parameters :nowait))
+                       (when coding-p (list :coding coding-val))))
+        (stream (apply #'make-network-process args)))
     (when (plist-get parameters :warn-unless-encrypted)
       (setq stream (nsm-verify-connection stream host service nil t)))
     (list stream
@@ -267,10 +278,14 @@ network-stream-open-starttls
         (eoc                (plist-get parameters :end-of-command))
         (eo-capa            (or (plist-get parameters :end-of-capability)
                                 eoc))
+         (coding-p (plist-member parameters :coding))
+         (coding-val (plist-get parameters :coding))
+         (args (append (list :name name :buffer buffer
+                             :host (puny-encode-domain host)
+                             :service service)
+                       (when coding-p (list :coding coding-val))))
         ;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
-        (stream (make-network-process :name name :buffer buffer
-                                      :host (puny-encode-domain host)
-                                       :service service))
+         (stream (apply #'make-network-process args))
         (greeting (and (not (plist-get parameters :nogreeting))
                        (network-stream-get-response stream start eoc)))
         (capabilities (network-stream-command stream capability-command
@@ -348,9 +363,7 @@ network-stream-open-starttls
          ;; isn't demanded, reopen an unencrypted connection.
          (unless require-tls
            (setq stream
-                 (make-network-process :name name :buffer buffer
-                                       :host (puny-encode-domain host)
-                                        :service service))
+                 (apply #'make-network-process args))
            (network-stream-get-response stream start eoc)))
         (unless (process-live-p stream)
           (error "Unable to negotiate a TLS connection with %s/%s"
@@ -453,6 +466,8 @@ network-stream-open-shell
   (let* ((capability-command (plist-get parameters :capability-command))
         (eoc                (plist-get parameters :end-of-command))
         (start (with-current-buffer buffer (point)))
+         (coding-p (plist-member parameters :coding))
+         (coding-val (plist-get parameters :coding))
         (stream (let ((process-connection-type nil))
                   (start-process name buffer shell-file-name
                                  shell-command-switch
@@ -461,6 +476,13 @@ network-stream-open-shell
                                   (format-spec-make
                                    ?s host
                                    ?p service))))))
+    (when coding-p (if (consp coding-val)
+                       (set-process-coding-system stream
+                                                  (car coding-val)
+                                                  (cdr coding-val))
+                     (set-process-coding-system stream
+                                                coding-val
+                                                coding-val)))
     (list stream
          (network-stream-get-response stream start eoc)
          (network-stream-command stream capability-command



reply via email to

[Prev in Thread] Current Thread [Next in Thread]