commit 96e386e60de1d4ae9d702fc376ef7a9279a6aa66 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Fri Jan 25 11:14:32 2019 +0200 ; Fix recent changes in ELisp manual * doc/lispref/commands.texi (Using Interactive): Add a period at the end of a sentence. (Event Input Misc): Fix typo and leave 2 spaces between sentences. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index fb5a827ad1..bf66734157 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -256,7 +256,7 @@ It may be a Lisp expression that is not a string; then it should be a form that is evaluated to get a list of arguments to pass to the command. Usually this form will call various functions to read input from the user, most often through the minibuffer (@pxref{Minibuffers}) -or directly from the keyboard (@pxref{Reading Input}) +or directly from the keyboard (@pxref{Reading Input}). Providing point or the mark as an argument value is also common, but if you do this @emph{and} read input (whether using the minibuffer or @@ -2922,12 +2922,12 @@ this expression) remains the value of @code{last-command-event}. @defvar input-event-functions This variable holds a list of functions to call after Emacs reads an -event, but before any commands are run. Each function recieves a +event, but before any commands are run. Each function receives a single argument: the event that has been read. There are normally easier hooks to use than this; in particular @var{pre-command-hook} is run immediately before any command resulting -from an event. However, not all events result in a command, including +from an event. However, not all events result in a command, including many mouse events and some keyboard events when an input-method is active (@pxref{Reading Input}). @end defvar commit 27fffb2701c38090916e077d28a4a6b9e2bc09d2 Author: Phillip Lord Date: Fri Jan 25 08:59:06 2019 +0000 ; Document input-event-functions diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 1eb580e1e0..fb5a827ad1 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -256,7 +256,7 @@ It may be a Lisp expression that is not a string; then it should be a form that is evaluated to get a list of arguments to pass to the command. Usually this form will call various functions to read input from the user, most often through the minibuffer (@pxref{Minibuffers}) -or directly from the keyboard (@pxref{Reading Input}). +or directly from the keyboard (@pxref{Reading Input}) Providing point or the mark as an argument value is also common, but if you do this @emph{and} read input (whether using the minibuffer or @@ -2920,6 +2920,18 @@ this expression) remains the value of @code{last-command-event}. @end example @end defvar +@defvar input-event-functions +This variable holds a list of functions to call after Emacs reads an +event, but before any commands are run. Each function recieves a +single argument: the event that has been read. + +There are normally easier hooks to use than this; in particular +@var{pre-command-hook} is run immediately before any command resulting +from an event. However, not all events result in a command, including +many mouse events and some keyboard events when an input-method is +active (@pxref{Reading Input}). +@end defvar + @defmac while-no-input body@dots{} This construct runs the @var{body} forms and returns the value of the last one---but only if no input arrives. If any input arrives during diff --git a/etc/NEWS b/etc/NEWS index 4937fa0fe2..c658406bc7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1204,6 +1204,7 @@ removed. ** 'lookup-key' can take a list of keymaps as argument. ++++ ** New hook 'input-event-functions' run whenever a user-input is read. +++ commit f52de87166062934735db995d45c1bcb07faaf7f Author: Alex Branham Date: Mon Jan 21 09:50:11 2019 -0600 Make tabulated-list-mode-map inherit from special-mode-map * lisp/emacs-lisp/tabulated-list.el (tabulated-list-mode-map): Use 'make-composed-keymap'. Bug #30452 diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 6fdca2cd08..12d0151d67 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -151,8 +151,10 @@ If ADVANCE is non-nil, move forward by one line afterwards." (forward-line))) (defvar tabulated-list-mode-map - (let ((map (copy-keymap special-mode-map))) - (set-keymap-parent map button-buffer-map) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (make-composed-keymap + button-buffer-map + special-mode-map)) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) (define-key map "S" 'tabulated-list-sort) commit a2f7ed5e705f7b48e9038b5a1c9def1c45ee8fcf Author: Eli Zaretskii Date: Fri Jan 25 10:33:01 2019 +0200 ; * etc/NEWS: Mention changes in image-transform-* variables. diff --git a/etc/NEWS b/etc/NEWS index 82eab44422..4937fa0fe2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1491,6 +1491,13 @@ left to higher-level functions. some years back. It now respects 'imagemagick-types-inhibit' as a way to disable that. +--- +*** Some image-mode variables are now buffer-local. +The image parameters 'image-transform-rotation', +'image-transform-scale' and 'image-transform-resize' are now declared +buffer-local, so each buffer could have its own values for these +parameters. + ** The function 'load' now behaves correctly when loading modules. Specifically, it puts the module name into 'load-history', prints loading messages if requested, and protects against recursive loads. commit 76e454fe5f3bb288590c7bc8eca786946bb19d7c Author: Benjamin Riefenstahl Date: Sat Jan 12 15:36:24 2019 +0100 image-mode: Make parameters buffer-local Image parameters were treated as image specific, but because they actually were global variables, their behaviour transfered to new images. * lisp/image-mode.el (image-transform-resize, image-transform-scale) (image-transform-rotation): Declare with defvar-local. (Bug#33990) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 3570c7cba4..3be515d914 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -53,7 +53,7 @@ See `image-mode-winprops'.") It is called with one argument, the initial WINPROPS.") ;; FIXME this doesn't seem mature yet. Document in manual when it is. -(defvar image-transform-resize nil +(defvar-local image-transform-resize nil "The image resize operation. Its value should be one of the following: - nil, meaning no resizing. @@ -61,10 +61,10 @@ Its value should be one of the following: - `fit-width', meaning to fit the image to the window width. - A number, which is a scale factor (the default size is 1).") -(defvar image-transform-scale 1.0 +(defvar-local image-transform-scale 1.0 "The scale factor of the image being displayed.") -(defvar image-transform-rotation 0.0 +(defvar-local image-transform-rotation 0.0 "Rotation angle for the image in the current Image mode buffer.") (defvar image-transform-right-angle-fudge 0.0001 commit 7960951d5df714957bcfff82df77a94a6ee8960b Author: Michael Albinus Date: Thu Jan 24 17:40:10 2019 +0100 Some fixes in tramp-smb.el * lisp/net/tramp-smb.el (tramp-smb-errors): Add "NT_STATUS_NOT_A_DIRECTORY". (tramp-smb-maybe-open-connection): Respect ´non-essential'. Do not record smbserver-version. (tramp-smb-wait-for-output): Improve reading pending output. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 08f2f30747..7163afdcea 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -144,6 +144,7 @@ call, letting the SMB client use the default one." "NT_STATUS_NO_LOGON_SERVERS" "NT_STATUS_NO_SUCH_FILE" "NT_STATUS_NO_SUCH_USER" + "NT_STATUS_NOT_A_DIRECTORY" "NT_STATUS_OBJECT_NAME_COLLISION" "NT_STATUS_OBJECT_NAME_INVALID" "NT_STATUS_OBJECT_NAME_NOT_FOUND" @@ -1913,6 +1914,14 @@ If ARGUMENT is non-nil, use it as argument for share (tramp-get-connection-property p "smb-share" "")))) + ;; During completion, don't reopen a new connection. We + ;; check this for the process related to + ;; `tramp-buffer-name'; otherwise `start-file-process' + ;; wouldn't run ever when `non-essential' is non-nil. + (when (and (tramp-completion-mode-p) + (null (get-process (tramp-buffer-name vec)))) + (throw 'non-essential 'non-essential)) + (save-match-data ;; There might be unread output from checking for share names. (when buf (with-current-buffer buf (erase-buffer))) @@ -1977,20 +1986,22 @@ If ARGUMENT is non-nil, use it as argument for tramp-smb-actions-without-share)) ;; Check server version. - (unless argument - (with-current-buffer (tramp-get-connection-buffer vec) - (goto-char (point-min)) - (search-forward-regexp tramp-smb-server-version nil t) - (let ((smbserver-version (match-string 0))) - (unless - (string-equal - smbserver-version - (tramp-get-connection-property - vec "smbserver-version" smbserver-version)) - (tramp-flush-directory-properties vec "") - (tramp-flush-connection-properties vec)) - (tramp-set-connection-property - vec "smbserver-version" smbserver-version)))) + ;; FIXME: With recent smbclient versions, this + ;; information isn't printed anymore. + ;; (unless argument + ;; (with-current-buffer (tramp-get-connection-buffer vec) + ;; (goto-char (point-min)) + ;; (search-forward-regexp tramp-smb-server-version nil t) + ;; (let ((smbserver-version (match-string 0))) + ;; (unless + ;; (string-equal + ;; smbserver-version + ;; (tramp-get-connection-property + ;; vec "smbserver-version" smbserver-version)) + ;; (tramp-flush-directory-properties vec "") + ;; (tramp-flush-connection-properties vec)) + ;; (tramp-set-connection-property + ;; vec "smbserver-version" smbserver-version)))) ;; Set chunksize to 1. smbclient reads its input ;; character by character; if we send the string @@ -2032,7 +2043,11 @@ Removes smb prompt. Returns nil if an error message has appeared." (inhibit-read-only t)) ;; Read pending output. - (while (tramp-accept-process-output p 0.1)) + (goto-char (point-min)) + (while (not (or (re-search-forward tramp-smb-prompt nil t) + (re-search-forward tramp-smb-errors nil t))) + (while (tramp-accept-process-output p 0.1) + (goto-char (point-min)))) (tramp-message vec 6 "\n%s" (buffer-string)) ;; Remove prompt. commit 36a748091d037ec2b3f3d4de1ac4ab09d90fc168 Merge: 24f11003d2 89ec69becb Author: Michael Albinus Date: Thu Jan 24 17:39:40 2019 +0100 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 89ec69becb0f5102a26c3b66867382180b83d389 Author: Eli Zaretskii Date: Thu Jan 24 17:01:20 2019 +0200 Avoid byte-compiler warning in starttls.el * lisp/net/network-stream.el (starttls-open-stream): Declare to avoid compilation warning. diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 4b006503d8..2b3292b71b 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -48,6 +48,7 @@ (declare-function starttls-available-p "starttls" ()) (declare-function starttls-negotiate "starttls" (process)) +(declare-function starttls-open-stream "starttls" (name buffer host port)) (autoload 'gnutls-negotiate "gnutls") (autoload 'open-gnutls-stream "gnutls") commit 24f11003d27cf81ae6c844b8aed825e1ab561654 Author: Michael Albinus Date: Thu Jan 24 14:36:38 2019 +0100 ; Remove tramp-tests instrumentation diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c9532f54b7..5adc6b1a14 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3806,7 +3806,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (tramp--test-instrument-test-case 10 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) (tmp-name (tramp--test-make-temp-name nil quoted)) @@ -3864,7 +3863,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (buffer-string) "foo"))) ;; Cleanup. - (ignore-errors (delete-process proc))))))) + (ignore-errors (delete-process proc)))))) (ert-deftest tramp-test30-make-process () "Check `make-process'." @@ -3873,7 +3872,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-sh-p)) (skip-unless (tramp--test-emacs27-p)) - (tramp--test-instrument-test-case 10 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) (tmp-name (tramp--test-make-temp-name nil quoted)) @@ -3990,7 +3988,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc)) - (ignore-errors (kill-buffer stderr)))))))) + (ignore-errors (kill-buffer stderr))))))) (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." commit f3f9a3582ef2081e96d12fb92ac190ffe9c1c431 Author: Robert Pluim Date: Thu Jan 24 11:34:34 2019 +0100 Check for client certificates when using GnuTLS This fixes Bug#33780, and extends the documentation to describe how to enable use of client certificates. * lisp/net/network-stream.el (network-stream-certificate): Correct order of parameters to plist-get. (network-stream-open-tls): Pass all received parameters to open-gnutls-stream as plist, not just :nowait. * lisp/net/gnutls.el (open-gnutls-stream): Change optional nowait arg to be plist. Derive nowait and client certificate(s) and keys(s) from plist (maybe via auth-source) and pass to gnutls-boot-parameters and gnutls-negotiate. (network-stream-certificate): Add declare-function form for it. * doc/misc/auth.texi (Help for users): Describe format to use for client key/cert specification. * doc/misc/emacs-gnutls.texi (Help For Developers): Describe usage of optional plist argument. Add crossreference to description of .authinfo format for client key/cert specification. * etc/NEWS: Describe new client certificate functionality for 'open-network-stream'. * test/lisp/net/network-stream-tests.el: Add require of network-stream. (connect-to-tls-ipv4-nowait): Bind network-security-level to 'low in order to bypass nsm prompting. (connect-to-tls-ipv6-nowait): Likewise. (open-network-stream-tls-wait): New test. (open-network-stream-tls-nowait): New test. (open-network-stream-tls): New test. (open-network-stream-tls-nocert): New test. (open-gnutls-stream-new-api-default): New test. (open-gnutls-stream-new-api-wait): New test. (open-gnutls-stream-old-api-wait): New test. (open-gnutls-stream-new-api-nowait): New test. (open-gnutls-stream-old-api-nowait): New test. (open-gnutls-stream-new-api-errors): New test. The new tests exercise 'open-network-stream' and the old and new api of 'open-gnutls-stream'. diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 495d9f53e1..ddfeabcba7 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -109,6 +109,15 @@ The @code{user} is the user name. It's known as @var{:user} in @code{auth-source-search} queries. You can also use @code{login} and @code{account}. +You can also use this file to specify client certificates to use when +setting up TLS connections. The format is: +@example +machine @var{mymachine} port @var{myport} key @var{key} cert @var{cert} +@end example + +@var{key} and @var{cert} are filenames containing the key and +certificate to use respectively. + You can use spaces inside a password or other token by surrounding the token with either single or double quotes. diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index aae583c641..add79d12e4 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -179,17 +179,35 @@ Just use @code{open-protocol-stream} or @code{open-network-stream} You should not have to use the @file{gnutls.el} functions directly. But you can test them with @code{open-gnutls-stream}. -@defun open-gnutls-stream name buffer host service &optional nowait +@defun open-gnutls-stream name buffer host service &optional parameters This function creates a buffer connected to a specific @var{host} and -@var{service} (port number or service name). The parameters and their -syntax are the same as those given to @code{open-network-stream} -(@pxref{Network,, Network Connections, elisp, The Emacs Lisp Reference -Manual}). The connection process is called @var{name} (made unique if -necessary). This function returns the connection process. - -The @var{nowait} parameter means that the socket should be -asynchronous, and the connection process will be returned to the -caller before TLS negotiation has happened. +@var{service} (port number or service name). The mandatory arguments +and their syntax are the same as those given to +@code{open-network-stream} (@pxref{Network,, Network Connections, +elisp, The Emacs Lisp Reference Manual}). The connection process is +called @var{name} (made unique if necessary). This function returns +the connection process. + +The optional @var{parameters} argument is a list of keywords and +values. The only keywords which currently have any effect are +@code{:client-certificate} and @code{:nowait}. + +Passing @w{@code{:client certificate t}} triggers looking up of client +certificates matching @var{host} and @var{service} using the +@file{auth-source} library. Any resulting client certificates are passed +down to the lower TLS layers. The format used by @file{.authinfo} to +specify the per-server keys is described in @ref{Help for +users,,auth-source, auth, Emacs auth-source Library}. + +Passing @w{@code{:nowait t}} means that the socket should be asynchronous, +and the connection process will be returned to the caller before TLS +negotiation has happened. + +For historical reasons @var{parameters} can also be a symbol, which is +interpreted the same as passing a list containing @code{:nowait} and +the value of that symbol. + +Example calls: @lisp ;; open a HTTPS connection diff --git a/etc/NEWS b/etc/NEWS index fe816ef0ec..82eab44422 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -218,6 +218,13 @@ issued), you can either set 'network-security-protocol-checks' to nil, or adjust the elements in that variable to only happen on the 'high' security level (assuming you use the 'medium' level). ++++ +** Native GnuTLS connections can now use client certificates. +Previously, this support was only available when using the external +gnutls-cli command. Call 'open-network-stream' with +':client-certificate t' to trigger looking up of per-server +certificates via 'auth-source'. + +++ ** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. It blocks line breaking after a one-letter word, also in the case when diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 78ac3fe35b..61480f3587 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -38,6 +38,9 @@ (require 'cl-lib) (require 'puny) +(declare-function network-stream-certificate "network-stream" + (host service parameters)) + (defgroup gnutls nil "Emacs interface to the GnuTLS library." :version "24.1" @@ -138,7 +141,7 @@ node `(emacs) Network Security'." (integer :tag "Number of bits" 512)) :group 'gnutls) -(defun open-gnutls-stream (name buffer host service &optional nowait) +(defun open-gnutls-stream (name buffer host service &optional parameters) "Open a SSL/TLS connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. @@ -149,12 +152,15 @@ BUFFER is the buffer (or `buffer-name') to associate with the process. a filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer -Third arg is name of the host to connect to, or its IP address. -Fourth arg SERVICE is name of the service desired, or an integer +Third arg HOST is the name of the host to connect to, or its IP address. +Fourth arg SERVICE is the name of the service desired, or an integer specifying a port number to connect to. -Fifth arg NOWAIT (which is optional) means that the socket should -be opened asynchronously. The connection process will be -returned to the caller before TLS negotiation has happened. +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'. +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. Usage example: @@ -168,19 +174,33 @@ This is a very simple wrapper around `gnutls-negotiate'. See its documentation for the specific parameters you can use to open a GnuTLS connection, including specifying the credential type, trust and key files, and priority string." - (let ((process (open-network-stream - name buffer host service - :nowait nowait - :tls-parameters - (and nowait - (cons 'gnutls-x509pki - (gnutls-boot-parameters - :type 'gnutls-x509pki - :hostname (puny-encode-domain host))))))) + (let* ((parameters + (cond ((symbolp parameters) + (list :nowait parameters)) + ((not (cl-evenp (length parameters))) + (error "Malformed keyword list")) + ((consp parameters) + parameters) + (t + (error "Unknown parameter type")))) + (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))))))) (if nowait process (gnutls-negotiate :process process :type 'gnutls-x509pki + :keylist keylist :hostname (puny-encode-domain host))))) (define-error 'gnutls-error "GnuTLS error") diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 84ba0b85e7..4b006503d8 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -196,7 +196,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (car result)))))) (defun network-stream-certificate (host service parameters) - (let ((spec (plist-get :client-certificate parameters))) + (let ((spec (plist-get parameters :client-certificate))) (cond ((listp spec) ;; Either nil or a list with a key/certificate pair. @@ -389,7 +389,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (stream (if (gnutls-available-p) (open-gnutls-stream name buffer host service - (plist-get parameters :nowait)) + parameters) (require 'tls) (open-tls-stream name buffer host service))) (eoc (plist-get parameters :end-of-command))) diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index 29b92da3de..6ad0c25903 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -25,6 +25,10 @@ ;;; Code: (require 'gnutls) +(require 'network-stream) +;; The require above is needed for 'open-network-stream' to work, but +;; it pulls in nsm, which then makes the :nowait t' tests fail unless +;; we disable the nsm, which we do by binding 'network-security-level' (ert-deftest make-local-unix-server () (skip-unless (featurep 'make-network-process '(:family local))) @@ -214,6 +218,7 @@ (skip-unless (gnutls-available-p)) (let ((server (make-tls-server 44331)) (times 0) + (network-security-level 'low) proc status) (unwind-protect (progn @@ -257,6 +262,7 @@ (skip-unless (featurep 'make-network-process '(:family ipv6))) (let ((server (make-tls-server 44333)) (times 0) + (network-security-level 'low) proc status) (unwind-protect (progn @@ -294,4 +300,365 @@ (setq issuer (split-string issuer ",")) (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) +(ert-deftest open-network-stream-tls-wait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44334)) + (times 0) + (network-security-level 'low) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-network-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44334 + :type 'tls + :nowait nil)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (skip-unless (not (eq (process-status proc) 'connect)))) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + ;; This sleep-for is needed for the native MS-Windows build. If + ;; it is removed, the next test mysteriously fails because the + ;; initial part of the echo is not received. + (sleep-for 0.1) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +(ert-deftest open-network-stream-tls-nowait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44335)) + (times 0) + (network-security-level 'low) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-network-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44335 + :type 'tls + :nowait t)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (setq times 0) + (while (and (eq (process-status proc) 'connect) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (skip-unless (not (eq (process-status proc) 'connect)))) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + ;; This sleep-for is needed for the native MS-Windows build. If + ;; it is removed, the next test mysteriously fails because the + ;; initial part of the echo is not received. + (sleep-for 0.1) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +(ert-deftest open-network-stream-tls () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44336)) + (times 0) + (network-security-level 'low) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-network-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44336 + :type 'tls)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (skip-unless (not (eq (process-status proc) 'connect)))) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + ;; This sleep-for is needed for the native MS-Windows build. If + ;; it is removed, the next test mysteriously fails because the + ;; initial part of the echo is not received. + (sleep-for 0.1) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +(ert-deftest open-network-stream-tls-nocert () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44337)) + (times 0) + (network-security-level 'low) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-network-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44337 + :type 'tls + :client-certificate nil)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (skip-unless (not (eq (process-status proc) 'connect)))) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + ;; This sleep-for is needed for the native MS-Windows build. If + ;; it is removed, the next test mysteriously fails because the + ;; initial part of the echo is not received. + (sleep-for 0.1) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +(ert-deftest open-gnutls-stream-new-api-default () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44665)) + (times 0) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44665)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + ;; This sleep-for is needed for the native MS-Windows build. If + ;; it is removed, the next test mysteriously fails because the + ;; initial part of the echo is not received. + (sleep-for 0.1) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))) + +(ert-deftest open-gnutls-stream-new-api-wait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44666)) + (times 0) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44666 + (list :nowait nil))))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + ;; This sleep-for is needed for the native MS-Windows build. If + ;; it is removed, the next test mysteriously fails because the + ;; initial part of the echo is not received. + (sleep-for 0.1) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))) + +(ert-deftest open-gnutls-stream-old-api-wait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44667)) + (times 0) + nowait + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44667 + nowait)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + ;; This sleep-for is needed for the native MS-Windows build. If + ;; it is removed, the next test mysteriously fails because the + ;; initial part of the echo is not received. + (sleep-for 0.1) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))) + +(ert-deftest open-gnutls-stream-new-api-nowait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44668)) + (times 0) + (network-security-level 'low) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44668 + (list :nowait t))))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (setq times 0) + (while (and (eq (process-status proc) 'connect) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (skip-unless (not (eq (process-status proc) 'connect)))) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +(ert-deftest open-gnutls-stream-old-api-nowait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44669)) + (times 0) + (network-security-level 'low) + (nowait t) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44669 + nowait)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (setq times 0) + (while (and (eq (process-status proc) 'connect) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (skip-unless (not (eq (process-status proc) 'connect)))) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +(ert-deftest open-gnutls-stream-new-api-errors () + (skip-unless (gnutls-available-p)) + (should-error + (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44777 + (list t))) + (should-error + (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44777 + (vector :nowait t)))) + ;;; network-stream-tests.el ends here commit 0744c35307d544d960c9d7628ea91ad722ff6217 Author: Michael Albinus Date: Thu Jan 24 11:06:38 2019 +0100 Fix error in Tramp's encoding check * lisp/net/tramp-sh.el (tramp-find-inline-encoding): Use `tramp-get-connection-buffer'. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d0e7357f8f..c578a73f46 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4499,7 +4499,7 @@ Goes through the list `tramp-local-coding-commands' and t) (throw 'wont-work-remote nil)) - (with-current-buffer (tramp-get-buffer vec) + (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) (unless (looking-at-p (regexp-quote magic)) (throw 'wont-work-remote nil)))