commit 0f494760d3344201f0c01723c246ba0ad2d15d90 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sun Apr 11 09:35:09 2021 +0300 ; * lisp/net/shr.el (shr-insert-document): Fix last change. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index d154476440..7c15eb1ca0 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -316,8 +316,9 @@ DOM should be a parse tree as generated by ;; `bidi-display-reordering' is supposed to be only used for ;; debugging purposes, but Shr's naïve filling algorithm ;; cannot cope with the complexity of RTL text in an LTR - ;; paragraph, when a long line has been continued, so... - ;; this is the best we could do :-( + ;; paragraph, when a long line has been continued, and for + ;; most scripts the character metrics don't change when they + ;; are reordered, so... this is the best we could do :-( bidi-display-reordering) ;; Adjust for max width specification. (when (and shr-max-width commit d55d07af701d7e082a729c6dc69448f32f3935bc Author: Stefan Monnier Date: Sat Apr 10 20:06:21 2021 -0400 * lisp/net/shr.el (shr-insert-document): Explain why bidi-display-reordering diff --git a/lisp/net/shr.el b/lisp/net/shr.el index c122a19e90..d154476440 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -313,6 +313,11 @@ DOM should be a parse tree as generated by (* (frame-char-width) 2)) 1)))) (max-specpdl-size max-specpdl-size) + ;; `bidi-display-reordering' is supposed to be only used for + ;; debugging purposes, but Shr's naïve filling algorithm + ;; cannot cope with the complexity of RTL text in an LTR + ;; paragraph, when a long line has been continued, so... + ;; this is the best we could do :-( bidi-display-reordering) ;; Adjust for max width specification. (when (and shr-max-width commit 5761e9004aa73d3aa7c34be9a064a1e768c3129c Author: Gregory Heytings Date: Sat Apr 10 11:47:45 2021 +0100 Add new icomplete-vertical-mode Co-authored-by: João Távora * lisp/icomplete.el (icomplete-completions): Consider icomplete-vertical-mode. (icomplete-vertical-mode-minibuffer-map): New map. (icomplete--vertical-minibuffer-setup): New helper. (icomplete-vertical-mode): New minor mode. * doc/emacs/buffers.texi (Icomplete): Mention icomplete-vertical-mode. * etc/NEWS: Mention icomplete-vertical-mode diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 3a166e404a..bec7f37547 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -765,6 +765,15 @@ your initialization file (@pxref{Init File}): the variable @code{fido-mode} to @code{t} (@pxref{Easy Customization}). +@findex icomplete-vertical-mode +@cindex Icomplete vertical mode + + Icomplete mode and Fido mode display the possible completions on the +same line as the prompt by default. To display the completion candidates +vertically under the prompt, type @kbd{M-x icomplete-vertical-mode}, or +customize the variable @code{icomplete-vertical-mode} to @code{t} +(@pxref{Easy Customization}). + @node Buffer Menus @subsection Customizing Buffer Menus diff --git a/etc/NEWS b/etc/NEWS index 5e37b38b90..aaf38022c5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -494,6 +494,13 @@ documented. SMIE is now always enabled and 'ruby-use-smie' only controls whether indentation is done using SMIE or with the old ad-hoc code. +** Icomplete + ++++ +*** New minor mode Icomplete-Vertical mode. +This mode is intended to be used with Icomplete or Fido, to display the +list of completions candidates vertically instead of horizontally. + --- ** Specific warnings can now be disabled from the warning buffer. When a warning is displayed to the user, the resulting buffer now has diff --git a/lisp/icomplete.el b/lisp/icomplete.el index da589c0064..d5b6f76d7b 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -562,6 +562,37 @@ Usually run by inclusion in `minibuffer-setup-hook'." (completion--cache-all-sorted-completions beg end (cons comp all)))) finally return all))) +(defvar icomplete-vertical-mode-minibuffer-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-n") 'icomplete-forward-completions) + (define-key map (kbd "C-p") 'icomplete-backward-completions) + map) + "Keymap used by `icomplete-vertical-mode' in the minibuffer.") + +(defun icomplete--vertical-minibuffer-setup () + "Setup the minibuffer for vertical display of completion candidates." + (use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map + (current-local-map))) + (setq-local icomplete-separator "\n" + icomplete-hide-common-prefix nil + ;; Ask `icomplete-completions' to return enough completions candidates. + icomplete-prospects-height 25 + redisplay-adhoc-scroll-in-resize-mini-windows nil)) + +;;;###autoload +(define-minor-mode icomplete-vertical-mode + "Toggle vertical candidate display in `icomplete-mode' or `fido-mode'. + +As many completion candidates as possible are displayed, depending on +the value of `max-mini-window-height', and the way the mini-window is +resized depends on `resize-mini-windows'." + :global t + (remove-hook 'icomplete-minibuffer-setup-hook + #'icomplete--vertical-minibuffer-setup) + (when icomplete-vertical-mode + (add-hook 'icomplete-minibuffer-setup-hook + #'icomplete--vertical-minibuffer-setup))) + @@ -784,10 +815,13 @@ matches exist." (if last (setcdr last base-size)) (if prospects (concat determ - "{" - (mapconcat 'identity prospects icomplete-separator) - (and limit (concat icomplete-separator ellipsis)) - "}") + (if icomplete-vertical-mode " \n" "{") + (mapconcat 'identity prospects (if icomplete-vertical-mode + "\n" + icomplete-separator)) + (unless icomplete-vertical-mode + (concat (and limit (concat icomplete-separator ellipsis)) + "}"))) (concat determ " [Matched]")))))) ;;; Iswitchb compatibility commit ffd12743bd8ef6e10cf0d96bc1ae08992075cbf1 Author: Stefan Monnier Date: Sat Apr 10 18:07:37 2021 -0400 * lisp/misearch.el (multi-isearch-read-buffers): Fix last change These are not buffers but buffer names. diff --git a/lisp/misearch.el b/lisp/misearch.el index 8b6238a826..1f0dd31550 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -238,7 +238,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'." (while (not (string-equal (setq buf (read-buffer (multi-occur--prompt) nil t)) "")) - (cl-pushnew buf bufs) + (cl-pushnew buf bufs :test #'equal) (setq ido-ignore-item-temp-list bufs)) (nreverse bufs))) commit d6aa50f74c65c96846c774cb8f949387bf07a9ed Author: Philipp Stephani Date: Mon Dec 14 21:25:11 2020 +0100 * src/emacs.c (read_full): Add a few assertions. diff --git a/src/emacs.c b/src/emacs.c index 92f6bfe636..9d7b21cc76 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -973,6 +973,9 @@ emacs_seccomp (unsigned int operation, unsigned int flags, void *args) static ptrdiff_t read_full (int fd, void *buffer, ptrdiff_t size) { + eassert (0 <= fd); + eassert (buffer != NULL); + eassert (0 <= size); enum { /* See MAX_RW_COUNT in sysdep.c. */ commit 56e8d969f545446c00a82af6f2e5bc7ad535a359 Author: Stefan Monnier Date: Sat Apr 10 17:11:58 2021 -0400 * lisp/cus-dep.el: Use lexical-binding diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index f0b108b77d..c14a45ca77 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -1,4 +1,4 @@ -;;; cus-dep.el --- find customization dependencies +;;; cus-dep.el --- find customization dependencies -*- lexical-binding: t; -*- ;; ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. ;; @@ -131,7 +131,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" 'custom-where name) ;; Eval to get the 'custom-group, -tag, ;; -version, group-documentation etc properties. - (eval expr)) + (eval expr t)) ;; Eval failed for some reason. Eg maybe the ;; defcustom uses something defined earlier ;; in the file (we haven't loaded the file). @@ -163,7 +163,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (let ((members (get symbol 'custom-group)) where found) (when members - (dolist (member (mapcar 'car members)) + (dolist (member (mapcar #'car members)) (setq where (get member 'custom-where)) (unless (or (null where) (member where found)) commit 26e1d854d1d40a63896272162f299a90e5a31043 Author: Stefan Monnier Date: Sat Apr 10 17:07:58 2021 -0400 * lisp/misearch.el: Use lexical-binding (multi-isearch-read-buffers, multi-isearch-read-files): Replace `add-to-list` with `cl-pushnew` for use on a local variable. diff --git a/lisp/misearch.el b/lisp/misearch.el index 668c711922..8b6238a826 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -1,4 +1,4 @@ -;;; misearch.el --- isearch extensions for multi-buffer search +;;; misearch.el --- isearch extensions for multi-buffer search -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -28,6 +28,8 @@ ;;; Code: +(require 'cl-lib) + ;;; Search multiple buffers ;;;###autoload (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -40,8 +42,7 @@ (defcustom multi-isearch-search t "Non-nil enables searching multiple related buffers, in certain modes." :type 'boolean - :version "23.1" - :group 'multi-isearch) + :version "23.1") (defcustom multi-isearch-pause t "A choice defining where to pause the search. @@ -53,8 +54,7 @@ If t, pause in all buffers that contain the search string." (const :tag "Don't pause" nil) (const :tag "Only in initial buffer" initial) (const :tag "All buffers" t)) - :version "23.1" - :group 'multi-isearch) + :version "23.1") ;;;###autoload (defvar multi-isearch-next-buffer-function nil @@ -119,10 +119,10 @@ Intended to be added to `isearch-mode-hook'." (default-value 'isearch-wrap-function) multi-isearch-orig-push-state (default-value 'isearch-push-state-function)) - (setq-default isearch-search-fun-function 'multi-isearch-search-fun - isearch-wrap-function 'multi-isearch-wrap - isearch-push-state-function 'multi-isearch-push-state) - (add-hook 'isearch-mode-end-hook 'multi-isearch-end))) + (setq-default isearch-search-fun-function #'multi-isearch-search-fun + isearch-wrap-function #'multi-isearch-wrap + isearch-push-state-function #'multi-isearch-push-state) + (add-hook 'isearch-mode-end-hook #'multi-isearch-end))) (defun multi-isearch-end () "Clean up the multi-buffer search after terminating isearch." @@ -133,7 +133,7 @@ Intended to be added to `isearch-mode-hook'." (setq-default isearch-search-fun-function multi-isearch-orig-search-fun isearch-wrap-function multi-isearch-orig-wrap isearch-push-state-function multi-isearch-orig-push-state) - (remove-hook 'isearch-mode-end-hook 'multi-isearch-end)) + (remove-hook 'isearch-mode-end-hook #'multi-isearch-end)) (defun multi-isearch-search-fun () "Return the proper search function, for isearch in multiple buffers." @@ -238,7 +238,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'." (while (not (string-equal (setq buf (read-buffer (multi-occur--prompt) nil t)) "")) - (add-to-list 'bufs buf) + (cl-pushnew buf bufs) (setq ido-ignore-item-temp-list bufs)) (nreverse bufs))) @@ -322,7 +322,7 @@ Every next/previous file in the defined sequence is visited by default-directory default-directory)) default-directory)) - (add-to-list 'files file)) + (cl-pushnew file files :test #'equal)) (nreverse files))) ;; A regexp is not the same thing as a file glob - does this matter? @@ -381,7 +381,7 @@ whose file names match the specified wildcard." (defun multi-isearch-unload-function () "Remove autoloaded variables from `unload-function-defs-list'. Also prevent the feature from being reloaded via `isearch-mode-hook'." - (remove-hook 'isearch-mode-hook 'multi-isearch-setup) + (remove-hook 'isearch-mode-hook #'multi-isearch-setup) (let ((defs (list (car unload-function-defs-list))) (auto '(multi-isearch-next-buffer-function multi-isearch-next-buffer-current-function @@ -395,7 +395,7 @@ Also prevent the feature from being reloaded via `isearch-mode-hook'." ;; . nil)) -(defalias 'misearch-unload-function 'multi-isearch-unload-function) +(defalias 'misearch-unload-function #'multi-isearch-unload-function) (provide 'multi-isearch) commit 2db03e3e53af3ce5c87f64d163ab2be96aee2c0f Author: Philipp Stephani Date: Sat Apr 10 21:21:08 2021 +0200 * src/emacs.c (load_seccomp): Add a useful assertion. diff --git a/src/emacs.c b/src/emacs.c index 1fecf1fa4b..92f6bfe636 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1060,6 +1060,7 @@ load_seccomp (const char *file) emacs_perror ("read"); goto out; } + eassert (read <= SIZE_MAX); if (read != size) { fprintf (stderr, commit 496a46b32db9a3c32a846b8a3c872891303a1ec4 Author: Philipp Stephani Date: Sat Apr 10 21:19:50 2021 +0200 * src/emacs.c (load_seccomp): Fix condition. diff --git a/src/emacs.c b/src/emacs.c index cb1361fe46..1fecf1fa4b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1091,7 +1091,7 @@ load_seccomp (const char *file) success = true; out: - if (fd < 0) + if (0 <= fd) emacs_close (fd); free (buffer); return success; commit 8b92897633e8c3630c4f4a9f8840e8a4bf973dec Author: Stefan Monnier Date: Sat Apr 10 17:03:11 2021 -0400 * lisp/ps-bdf.el: Use lexical-binding diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index 7bf2f71822..72cbcf8bd6 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -1,4 +1,4 @@ -;;; ps-bdf.el --- BDF font file handler for ps-print +;;; ps-bdf.el --- BDF font file handler for ps-print -*- lexical-binding: t; -*- ;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, @@ -138,7 +138,7 @@ See the documentation of the function `bdf-read-font-info' for more detail." (defun bdf-initialize () "Initialize `bdf' library." (and (bdf-read-cache) - (add-hook 'kill-emacs-hook 'bdf-write-cache))) + (add-hook 'kill-emacs-hook #'bdf-write-cache))) (defun bdf-compact-code (code code-range) (if (or (< code (aref code-range 4)) commit edf8497ce3dc0fe0a137c37ca279528b46185ed5 Author: Stefan Monnier Date: Sat Apr 10 17:01:01 2021 -0400 * lisp/informat.el: Use lexical-binding diff --git a/lisp/informat.el b/lisp/informat.el index 3da2351633..bac09752b7 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -1,4 +1,4 @@ -;;; informat.el --- info support functions package for Emacs +;;; informat.el --- info support functions package for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc. @@ -140,7 +140,7 @@ (or (bolp) (newline)) (insert "\^_\f\nTag table:\n") - (if (eq major-mode 'info-mode) + (if (derived-mode-p 'info-mode) (move-marker Info-tag-table-marker (point))) (setq tag-list (nreverse tag-list)) (while tag-list commit 5ad3893ebaf8190e1e262caf33bc736e79a0d07b Author: Stefan Monnier Date: Sat Apr 10 16:58:11 2021 -0400 * lisp/loadup.el: Use lexical-binding diff --git a/lisp/loadup.el b/lisp/loadup.el index 4a0b8f508c..d6cfcd6fc8 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -1,4 +1,4 @@ -;;; loadup.el --- load up standardly loaded Lisp files for Emacs +;;; loadup.el --- load up standardly loaded Lisp files for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software ;; Foundation, Inc. @@ -112,7 +112,7 @@ (if (eq t purify-flag) ;; Hash consing saved around 11% of pure space in my tests. - (setq purify-flag (make-hash-table :test 'equal :size 80000))) + (setq purify-flag (make-hash-table :test #'equal :size 80000))) (message "Using load-path %s" load-path) @@ -134,7 +134,7 @@ ;; Do it after subr, since both after-load-functions and add-hook are ;; implemented in subr.el. -(add-hook 'after-load-functions (lambda (f) (garbage-collect))) +(add-hook 'after-load-functions (lambda (_) (garbage-collect))) (load "version") @@ -151,7 +151,7 @@ ;; variable its advertised default value (it starts as nil, see ;; xdisp.c). (setq resize-mini-windows 'grow-only) -(setq load-source-file-function 'load-with-code-conversion) +(setq load-source-file-function #'load-with-code-conversion) (load "files") ;; Load-time macro-expansion can only take effect after setting @@ -186,7 +186,7 @@ ;; In case loaddefs hasn't been generated yet. (file-error (load "ldefs-boot.el"))) -(let ((new (make-hash-table :test 'equal))) +(let ((new (make-hash-table :test #'equal))) ;; Now that loaddefs has populated definition-prefixes, purify its contents. (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) definition-prefixes) @@ -399,7 +399,7 @@ lost after dumping"))) emacs-repository-branch (ignore-errors (emacs-repository-get-branch))) ;; A constant, so we shouldn't change it with `setq'. (defconst emacs-build-number - (if versions (1+ (apply 'max versions)) 1)))) + (if versions (1+ (apply #'max versions)) 1)))) (message "Finding pointers to doc strings...") @@ -429,11 +429,11 @@ lost after dumping"))) ;; We keep the load-history data in PURE space. ;; Make sure that the spine of the list is not in pure space because it can ;; be destructively mutated in lread.c:build_load_history. -(setq load-history (mapcar 'purecopy load-history)) +(setq load-history (mapcar #'purecopy load-history)) (set-buffer-modified-p nil) -(remove-hook 'after-load-functions (lambda (f) (garbage-collect))) +(remove-hook 'after-load-functions (lambda (_) (garbage-collect))) (if (boundp 'load--prefer-newer) (progn @@ -540,7 +540,7 @@ lost after dumping"))) ;; Otherwise, it breaks a lot of code which does things like ;; (or load-file-name byte-compile-current-file). (setq load-file-name nil) -(eval top-level) +(eval top-level t) ;; Local Variables: commit cb6b810dfd721894cb8843e8b2a96b93ae4edce4 Author: Stefan Monnier Date: Sat Apr 10 16:25:28 2021 -0400 * lisp/jka-compr.el: Use lexical-binding Prefer #' to quote function names. diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 8aebcd0ec4..a6223646c1 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -1,7 +1,6 @@ -;;; jka-compr.el --- reading/writing/loading compressed files +;;; jka-compr.el --- reading/writing/loading compressed files -*- lexical-binding: t; -*- -;; Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1993-2021 Free Software Foundation, Inc. ;; Author: Jay K. Adams ;; Maintainer: emacs-devel@gnu.org @@ -120,7 +119,7 @@ data appears to be compressed already.") (widen) (erase-buffer) (insert (format "Error while executing \"%s %s < %s\"\n\n" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") infile)) (and errfile @@ -170,7 +169,7 @@ to keep: LEN chars starting BEG chars from the beginning." (format "%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") err-file jka-compr-dd-program jka-compr-dd-blocksize @@ -218,7 +217,7 @@ to keep: LEN chars starting BEG chars from the beginning." "-c" (format "%s %s 2> %s %s" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") err-file (if (stringp output) (concat "> " output) @@ -227,7 +226,7 @@ to keep: LEN chars starting BEG chars from the beginning." (jka-compr-error prog args infile message err-file)) (delete-file err-file))) (or (eq 0 - (apply 'call-process + (apply #'call-process prog infile (if (stringp output) temp output) nil args)) (jka-compr-error prog args infile message)) @@ -622,12 +621,12 @@ There should be no more than seven characters after the final `/'." (substring file 0 (string-match (jka-compr-info-regexp info) file))) file))) -(put 'write-region 'jka-compr 'jka-compr-write-region) -(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents) -(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy) -(put 'load 'jka-compr 'jka-compr-load) +(put 'write-region 'jka-compr #'jka-compr-write-region) +(put 'insert-file-contents 'jka-compr #'jka-compr-insert-file-contents) +(put 'file-local-copy 'jka-compr #'jka-compr-file-local-copy) +(put 'load 'jka-compr #'jka-compr-load) (put 'byte-compiler-base-file-name 'jka-compr - 'jka-compr-byte-compiler-base-file-name) + #'jka-compr-byte-compiler-base-file-name) ;;;###autoload (defvar jka-compr-inhibit nil @@ -649,7 +648,7 @@ It is not recommended to set this variable permanently to anything but nil.") ;; to prevent the primitive from calling our handler again. (defun jka-compr-run-real-handler (operation args) (let ((inhibit-file-name-handlers - (cons 'jka-compr-handler + (cons #'jka-compr-handler (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation)) @@ -674,7 +673,7 @@ by `jka-compr-installed'." (last fnha)) (while (cdr last) - (if (eq (cdr (car (cdr last))) 'jka-compr-handler) + (if (eq (cdr (car (cdr last))) #'jka-compr-handler) (setcdr last (cdr (cdr last))) (setq last (cdr last)))) commit 1d474ad69d19d01b047012734530fb4c5eb82144 Author: Philipp Stephani Date: Sat Apr 10 21:54:12 2021 +0200 * etc/NEWS: Extend paragraph about &define form and backtracking diff --git a/etc/NEWS b/etc/NEWS index 328c38c118..5e37b38b90 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2535,8 +2535,11 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', ** The 'values' variable is now obsolete. -** The '&define' keyword in an Edebug specification now disables -backtracking. ++++ +** The '&define' keyword in an Edebug specification now disables backtracking. +The implementation was buggy, and multiple &define forms in an &or +form should be exceedingly rare. See the Info node 'Backtracking' in +the Emacs Lisp reference manual for background. * Lisp Changes in Emacs 28.1 commit 81ffc433838ce43a12e3629adaefafc6413dd126 Author: Glenn Morris Date: Sat Apr 10 12:24:09 2021 -0700 ; Fix copyright years diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index 9918fb025e..eeca75fddf 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -1,6 +1,6 @@ /* Generate a Secure Computing filter definition file. -Copyright (C) 2020 Free Software Foundation, Inc. +Copyright (C) 2020-2021 Free Software Foundation, Inc. This file is part of GNU Emacs. commit 3f5fe0cdfc77b537d2faf148c614d9f8043bf33d Author: Alan Mackenzie Date: Sat Apr 10 19:18:28 2021 +0000 Convert CC Mode to lexical binding in Emacs lisp/progmodes/cc-align.el, lisp/progmodes/cc-awk.el, lisp/progmodes/cc-bytecomp.el, lisp/progmodes/cc-cmds.el, lisp/progmodes/cc-defs.el, lisp/progmodes/cc-engine.el, lisp/progmodes/cc-fonts.el, lisp/progmodes/cc-guess.el, lisp/progmodes/cc-langs.el, lisp/progmodes/cc-menus.el, lisp/progmodes/cc-mode.el, lisp/progmodes/cc-styles.el, lisp/progmodes/cc-subword.el, lisp/progmodes/cc-vars.el: Mark these files with a `lexical-binding' setting in line 1. lisp/progmodes/cc-align.el, lisp/progmodes/cc-engine.el, lisp/progmodes/cc-vars.el (c-syntactic-context, c-syntactic-element): Declare these as special variables. lisp/progmodes/cc-bytecomp.el (cc-bytecomp-debug-msg): prefix the parameter ARGS with a _, and remove an `ignore' call. lisp/progmodes/cc-cmds.el (c-where-wrt-brace-construct): Remove `kluge-start', an unused variable. (c-while-widening-to-decl-block): Add an extra parameter, which suppresses the generation of a setting of variable `where'. (c-defun-name-and-limits): Remove variable `where' from the function and use the new argument to the previous macro. lisp/progmodes/cc-engine.el (c-cache-to-parse-ps-state): Remove two unneeded variables, `last' and `intermediate'. lisp/progmodes/cc-fonts.el (c-font-lock-c++-using): Remove unused variable. lisp/progmodes/cc-langs.el (c-vsemi-status-unknown-p-fn): Replace the doc string with the more precise one from stand-alone CC Mode. lisp/progmodes/cc-styles.el (c-set-offset): Give the `ignored' parameter a leading _. diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 51d51deef7..9234d0b19b 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -1,4 +1,4 @@ -;;; cc-align.el --- custom indentation functions for CC Mode +;;; cc-align.el --- custom indentation functions for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -44,6 +44,9 @@ (cc-require 'cc-vars) (cc-require 'cc-engine) +(defvar c-syntactic-context) +(defvar c-syntactic-element) + ;; Standard line-up functions ;; diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 3228944372..84cc5b115e 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -1,4 +1,4 @@ -;;; cc-awk.el --- AWK specific code within cc-mode. +;;; cc-awk.el --- AWK specific code within cc-mode. -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index 3f7caf3c2e..29f4b81637 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -1,4 +1,4 @@ -;;; cc-bytecomp.el --- compile time setup for proper compilation +;;; cc-bytecomp.el --- compile time setup for proper compilation -*- lexical-binding: t -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -85,8 +85,7 @@ (defvar cc-bytecomp-environment-set nil) -(defmacro cc-bytecomp-debug-msg (&rest args) - (ignore args) +(defmacro cc-bytecomp-debug-msg (&rest _args) ; Change to ARGS when needed. ;;`(message ,@args) ) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index c894944827..bee87b6849 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1,4 +1,4 @@ -;;; cc-cmds.el --- user level commands for CC Mode +;;; cc-cmds.el --- user level commands for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -49,12 +49,11 @@ ; which looks at this. (cc-bytecomp-defun electric-pair-post-self-insert-function) (cc-bytecomp-defvar c-indent-to-body-directives) +(defvar c-syntactic-context) ;; Indentation / Display syntax functions (defvar c-fix-backslashes t) -(defvar c-syntactic-context) - (defun c-indent-line (&optional syntax quiet ignore-point-pos) "Indent the current line according to the syntactic context, if `c-syntactic-indentation' is non-nil. Optional SYNTAX is the @@ -1220,9 +1219,9 @@ numeric argument is supplied, or the point is inside a literal." (self-insert-command (prefix-numeric-value arg))) (setq final-pos (point)) -;;;; 2010-01-31: There used to be code here to put a syntax-table text -;;;; property on the new < or > and its mate (if any) when they are template -;;;; parens. This is now done in an after-change function. +;;;; 2010-01-31: There used to be code here to put a syntax-table text +;;;; property on the new < or > and its mate (if any) when they are template +;;;; parens. This is now done in an after-change function. (when (and (not arg) (not literal)) ;; Have we got a delimiter on a #include directive? @@ -1639,9 +1638,8 @@ No indentation or other \"electric\" behavior is performed." ;; ;; This function might do hidden buffer changes. (save-excursion - (let* (kluge-start - knr-start knr-res - decl-result brace-decl-p + (let* (knr-start knr-res + decl-result (start (point)) (paren-state (c-parse-state)) (least-enclosing (c-least-enclosing-brace paren-state))) @@ -1676,7 +1674,6 @@ No indentation or other \"electric\" behavior is performed." (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>" (not (c-looking-at-non-alphnumspace))) (forward-char)) - (setq kluge-start (point)) (if (and least-enclosing (eq (char-after least-enclosing) ?\()) @@ -1827,12 +1824,14 @@ No indentation or other \"electric\" behavior is performed." nil))) (eval-and-compile - (defmacro c-while-widening-to-decl-block (condition) + (defmacro c-while-widening-to-decl-block (condition &optional no-where) ;; Repeatedly evaluate CONDITION until it returns nil. After each ;; evaluation, if `c-defun-tactic' is set appropriately, widen to innards ;; of the next enclosing declaration block (e.g. namespace, class), or the ;; buffer's original restriction. ;; + ;; If NO-WHERE is non-nil, don't compile in a `(setq where ....)'. + ;; ;; This is a very special purpose macro, which assumes the existence of ;; several variables. It is for use only in c-beginning-of-defun and ;; c-end-of-defun. @@ -1843,7 +1842,8 @@ No indentation or other \"electric\" behavior is performed." (setq paren-state (c-whack-state-after lim paren-state)) (setq lim (c-widen-to-enclosing-decl-scope paren-state orig-point-min orig-point-max)) - (setq where 'in-block)))) + ,@(if (not no-where) + `((setq where 'in-block)))))) (def-edebug-spec c-while-widening-to-decl-block t) @@ -2324,11 +2324,11 @@ with a brace block, at the outermost level of nesting." (c-save-buffer-state ((paren-state (c-parse-state)) (orig-point-min (point-min)) (orig-point-max (point-max)) - lim name limits where) + lim name limits) (setq lim (c-widen-to-enclosing-decl-scope paren-state orig-point-min orig-point-max)) (and lim (setq lim (1- lim))) - (c-while-widening-to-decl-block (not (setq name (c-defun-name-1)))) + (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))) t) (when name (setq limits (c-declaration-limits-1 near)) (cons name limits))) @@ -2944,10 +2944,13 @@ function does not require the declaration to contain a brace block." (c-looking-at-special-brace-list))) (or allow-early-stop (/= here last)) (save-excursion ; Is this a check that we're NOT at top level? -;;;; NO! This seems to check that (i) EITHER we're at the top level; OR (ii) The next enclosing -;;;; level of bracketing is a '{'. HMM. Doesn't seem to make sense. -;;;; 2003/8/8 This might have something to do with the GCC extension "Statement Expressions", e.g. -;;;; while ({stmt1 ; stmt2 ; exp ;}). This form excludes such Statement Expressions. +;;;; NO! This seems to check that (i) EITHER we're at the top level; +;;;; OR (ii) The next enclosing level of bracketing is a '{'. HMM. +;;;; Doesn't seem to make sense. +;;;; 2003/8/8 This might have something to do with the GCC extension +;;;; "Statement Expressions", e.g. +;;;; while ({stmt1 ; stmt2 ; exp ;}). +;;;; This form excludes such Statement Expressions. (or (not (c-safe (up-list -1) t)) (= (char-after) ?{)))) (goto-char last) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 536e676626..20dc97db5d 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1,4 +1,4 @@ -;;; cc-defs.el --- compile time definitions for CC Mode +;;; cc-defs.el --- compile time definitions for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index cc9833a434..747a6fd4ed 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1,4 +1,4 @@ -;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*- +;;; cc-engine.el --- core syntax guessing engine for CC mode -*- lexical-binding:t; coding: utf-8 -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -163,6 +163,8 @@ (defvar c-doc-line-join-re) (defvar c-doc-bright-comment-start-re) (defvar c-doc-line-join-end-ch) +(defvar c-syntactic-context) +(defvar c-syntactic-element) (cc-bytecomp-defvar c-min-syn-tab-mkr) (cc-bytecomp-defvar c-max-syn-tab-mkr) (cc-bytecomp-defun c-clear-syn-tab) @@ -2717,9 +2719,9 @@ comment at the start of cc-engine.el for more info." ;; two char construct (such as a comment opener or an escaped character).) (if (and (consp elt) (>= (length elt) 3)) ;; Inside a string or comment - (let ((depth 0) (containing nil) (last nil) + (let ((depth 0) (containing nil) in-string in-comment - (min-depth 0) com-style com-str-start (intermediate nil) + (min-depth 0) com-style com-str-start (char-1 (nth 3 elt)) ; first char of poss. 2-char construct (pos (car elt)) (type (cadr elt))) @@ -2736,14 +2738,13 @@ comment at the start of cc-engine.el for more info." (1- pos) pos)) (if (memq 'pps-extended-state c-emacs-features) - (list depth containing last + (list depth containing nil in-string in-comment nil min-depth com-style com-str-start - intermediate nil) - (list depth containing last + nil nil) + (list depth containing nil in-string in-comment nil - min-depth com-style com-str-start - intermediate))) + min-depth com-style com-str-start nil))) ;; Not in a string or comment. (if (memq 'pps-extended-state c-emacs-features) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 4e283764ce..433b4dcf4a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1,4 +1,4 @@ -;;; cc-fonts.el --- font lock support for CC Mode +;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -2287,7 +2287,7 @@ need for `c-font-lock-extra-types'.") ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; fontification". - (let (pos after-name) + (let (pos) (while (c-syntactic-re-search-forward c-using-key limit 'end) (while ; Do one declarator of a comma separated list, each time around. (progn @@ -2295,7 +2295,6 @@ need for `c-font-lock-extra-types'.") (setq pos (point)) ; token after "using". (when (and (c-on-identifier) (c-forward-name)) - (setq after-name (point)) (cond ((eq (char-after) ?=) ; using foo = ; (goto-char pos) @@ -2305,7 +2304,8 @@ need for `c-font-lock-extra-types'.") (c-go-up-list-backward) (eq (char-after) ?{) (eq (car (c-beginning-of-decl-1 - (c-determine-limit 1000))) 'same) + (c-determine-limit 1000))) + 'same) (looking-at c-colon-type-list-re))) ;; Inherited protected member: leave unfontified ) diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index 1b852ec491..0824af66b4 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -1,4 +1,4 @@ -;;; cc-guess.el --- guess indentation values by scanning existing code +;;; cc-guess.el --- guess indentation values by scanning existing code -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software ;; Foundation, Inc. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index fa4e73087e..28a1565427 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1,4 +1,4 @@ -;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*- +;;; cc-langs.el --- language specific settings for CC Mode -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -579,14 +579,12 @@ don't have EOL terminated statements. " (c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn)) (c-lang-defconst c-vsemi-status-unknown-p-fn - "Contains a predicate regarding the presence of virtual semicolons. -More precisely, the function answers the question, \"are we unsure whether a -virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of -such a function is to prevent an infinite recursion in -`c-beginning-of-statement-1' when point starts at a `while' token. The function -MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even -indirectly. This variable contains nil for languages which don't have EOL -terminated statements." + "A function \"are we unsure whether there is a virtual semicolon on this line?\". +The (admittedly kludgy) purpose of such a function is to prevent an infinite +recursion in c-beginning-of-statement-1 when point starts at a `while' token. +The function MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', +even indirectly. This variable contains nil for languages which don't have +EOL terminated statements." t nil (c c++ objc) 'c-macro-vsemi-status-unknown-p awk 'c-awk-vsemi-status-unknown-p) diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index 0ff6efb7d3..a099ec1de9 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -1,4 +1,4 @@ -;;; cc-menus.el --- imenu support for CC Mode +;;; cc-menus.el --- imenu support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index cfb23d0d45..dae0062efb 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1,4 +1,4 @@ -;;; cc-mode.el --- major mode for editing C and similar languages +;;; cc-mode.el --- major mode for editing C and similar languages -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 29cbe54c3b..77cad77711 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -1,4 +1,4 @@ -;;; cc-styles.el --- support for styles in CC Mode +;;; cc-styles.el --- support for styles in CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -464,7 +464,7 @@ STYLE using `c-set-style' if the optional SET-P flag is non-nil." offset)) ;;;###autoload -(defun c-set-offset (symbol offset &optional ignored) +(defun c-set-offset (symbol offset &optional _ignored) "Change the value of a syntactic element symbol in `c-offsets-alist'. SYMBOL is the syntactic element symbol to change and OFFSET is the new offset for that syntactic element. The optional argument is not used diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 88ee092da7..b33fea0b48 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1,4 +1,4 @@ -;;; cc-vars.el --- user customization variables for CC Mode +;;; cc-vars.el --- user customization variables for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -42,6 +42,9 @@ (cc-require 'cc-defs) +(defvar c-syntactic-context) +(defvar c-syntactic-element) + (cc-eval-when-compile (require 'custom) (require 'widget)) commit 1060289f51ee1bf269bb45940892eb272d35af97 Author: Philipp Stephani Date: Thu Dec 17 11:20:55 2020 +0100 Add a helper binary to create a basic Secure Computing filter. The binary uses the 'seccomp' helper library. The library isn't needed to load the generated Secure Computing filter. * configure.ac: Check for 'seccomp' header and library. * lib-src/seccomp-filter.c: New helper binary to generate a generic Secure Computing filter for GNU/Linux. * lib-src/Makefile.in (DONT_INSTALL): Add 'seccomp-filter' helper binary if possible. (all): Add Secure Computing filter file if possible. (seccomp-filter$(EXEEXT)): Compile helper binary. (seccomp-filter.bpf seccomp-filter.pfc): Generate filter files. * test/src/emacs-tests.el (emacs-tests/seccomp/allows-stdout) (emacs-tests/seccomp/forbids-subprocess): New unit tests. * test/Makefile.in (src/emacs-tests.log): Add dependency on the helper binary. diff --git a/.gitignore b/.gitignore index b653ef215b..ecf768dc4d 100644 --- a/.gitignore +++ b/.gitignore @@ -188,6 +188,7 @@ lib-src/make-docfile lib-src/make-fingerprint lib-src/movemail lib-src/profile +lib-src/seccomp-filter lib-src/test-distrib lib-src/update-game-score nextstep/Cocoa/Emacs.base/Contents/Info.plist @@ -301,3 +302,7 @@ nt/emacs.rc nt/emacsclient.rc src/gdb.ini /var/ + +# Seccomp filter files. +lib-src/seccomp-filter.bpf +lib-src/seccomp-filter.pfc diff --git a/configure.ac b/configure.ac index 684788a4d3..0c4772a2b9 100644 --- a/configure.ac +++ b/configure.ac @@ -4181,6 +4181,11 @@ AC_SUBST([LIBS_MAIL]) AC_CHECK_HEADERS([linux/seccomp.h], [HAVE_SECCOMP=yes]) +LIBSECCOMP= +AC_CHECK_HEADER([seccomp.h], + [AC_CHECK_LIB([seccomp], [seccomp_init], [LIBSECCOMP=-lseccomp])]) +AC_SUBST([LIBSECCOMP]) + OLD_LIBS=$LIBS LIBS="$LIB_PTHREAD $LIB_MATH $LIBS" AC_CHECK_FUNCS(accept4 fchdir gethostname \ diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 05eb524d19..1942882004 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -189,6 +189,12 @@ LIB_WSOCK32=@LIB_WSOCK32@ ## Extra libraries for etags LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM) +LIBSECCOMP=@LIBSECCOMP@ + +ifneq ($(LIBSECCOMP),) +DONT_INSTALL += seccomp-filter$(EXEEXT) +endif + ## Extra libraries to use when linking movemail. LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \ $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS) @@ -218,6 +224,10 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h all: ${EXE_FILES} ${SCRIPTS} +ifneq ($(LIBSECCOMP),) +all: seccomp-filter.bpf +endif + .PHONY: all need-blessmail maybe-blessmail LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM) @@ -400,4 +410,13 @@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h) emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico $(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $< +ifneq ($(LIBSECCOMP),) +seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h) + $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $< $(LIBSECCOMP) -o $@ + +seccomp-filter.bpf seccomp-filter.pfc: seccomp-filter$(EXEEXT) + $(AM_V_GEN)./seccomp-filter$(EXEEXT) \ + seccomp-filter.bpf seccomp-filter.pfc +endif + ## Makefile ends here. diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c new file mode 100644 index 0000000000..9918fb025e --- /dev/null +++ b/lib-src/seccomp-filter.c @@ -0,0 +1,321 @@ +/* Generate a Secure Computing filter definition file. + +Copyright (C) 2020 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see +. */ + +/* This program creates a small Secure Computing filter usable for a +typical minimal Emacs sandbox. See the man page for `seccomp' for +details about Secure Computing filters. This program requires the +`libseccomp' library. However, the resulting filter file requires +only a Linux kernel supporting the Secure Computing extension. + +Usage: + + seccomp-filter out.bpf out.pfc + +This writes the raw `struct sock_filter' array to out.bpf and a +human-readable representation to out.pfc. */ + +#include "config.h" + +#include +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "verify.h" + +static ATTRIBUTE_FORMAT_PRINTF (2, 3) _Noreturn void +fail (int error, const char *format, ...) +{ + va_list ap; + va_start (ap, format); + if (error == 0) + vfprintf (stderr, format, ap); + else + { + char buffer[1000]; + vsnprintf (buffer, sizeof buffer, format, ap); + errno = error; + perror (buffer); + } + va_end (ap); + fflush (NULL); + exit (EXIT_FAILURE); +} + +/* This binary is trivial, so we use a single global filter context + object that we release using `atexit'. */ + +static scmp_filter_ctx ctx; + +static void +release_context (void) +{ + seccomp_release (ctx); +} + +/* Wrapper functions and macros for libseccomp functions. We exit + immediately upon any error to avoid error checking noise. */ + +static void +set_attribute (enum scmp_filter_attr attr, uint32_t value) +{ + int status = seccomp_attr_set (ctx, attr, value); + if (status < 0) + fail (-status, "seccomp_attr_set (ctx, %u, %u)", attr, value); +} + +/* Like `seccomp_rule_add (ACTION, SYSCALL, ...)', except that you + don't have to specify the number of comparator arguments, and any + failure will exit the process. */ + +#define RULE(action, syscall, ...) \ + do \ + { \ + const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \ + enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \ + int status = seccomp_rule_add_array (ctx, (action), (syscall), \ + arg_cnt, arg_array); \ + if (status < 0) \ + fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \ + #action, #syscall, arg_cnt, #__VA_ARGS__); \ + } \ + while (false) + +static void +export_filter (const char *file, + int (*function) (const scmp_filter_ctx, int), + const char *name) +{ + int fd = TEMP_FAILURE_RETRY ( + open (file, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC, + 0644)); + if (fd < 0) + fail (errno, "open %s", file); + int status = function (ctx, fd); + if (status < 0) + fail (-status, "%s", name); + if (close (fd) != 0) + fail (errno, "close"); +} + +#define EXPORT_FILTER(file, function) \ + export_filter ((file), (function), #function) + +int +main (int argc, char **argv) +{ + if (argc != 3) + fail (0, "usage: %s out.bpf out.pfc", argv[0]); + + /* Any unhandled syscall should abort the Emacs process. */ + ctx = seccomp_init (SCMP_ACT_KILL_PROCESS); + if (ctx == NULL) + fail (0, "seccomp_init"); + atexit (release_context); + + /* We want to abort immediately if the architecture is unknown. */ + set_attribute (SCMP_FLTATR_ACT_BADARCH, SCMP_ACT_KILL_PROCESS); + set_attribute (SCMP_FLTATR_CTL_NNP, 1); + set_attribute (SCMP_FLTATR_CTL_TSYNC, 1); + set_attribute (SCMP_FLTATR_CTL_LOG, 0); + + verify (CHAR_BIT == 8); + verify (sizeof (int) == 4 && INT_MIN == INT32_MIN + && INT_MAX == INT32_MAX); + verify (sizeof (void *) == 8); + verify ((uintptr_t) NULL == 0); + + /* Allow a clean exit. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit_group)); + + /* Allow `mmap' and friends. This is necessary for dynamic loading, + reading the portable dump file, and thread creation. We don't + allow pages to be both writable and executable. */ + verify (MAP_PRIVATE != 0); + verify (MAP_SHARED != 0); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_WRITE)), + /* Only support known flags. MAP_DENYWRITE is ignored, but + some versions of the dynamic loader still use it. Also + allow allocating thread stacks. */ + SCMP_A3_32 (SCMP_CMP_MASKED_EQ, + ~(MAP_PRIVATE | MAP_FILE | MAP_ANONYMOUS + | MAP_FIXED | MAP_DENYWRITE | MAP_STACK + | MAP_NORESERVE), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_EXEC)), + /* Only support known flags. MAP_DENYWRITE is ignored, but + some versions of the dynamic loader still use it. */ + SCMP_A3_32 (SCMP_CMP_MASKED_EQ, + ~(MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED + | MAP_DENYWRITE), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (munmap)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mprotect), + /* Don't allow making pages executable. */ + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_WRITE), 0)); + + /* Futexes are used everywhere. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex), + SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE)); + + /* Allow basic dynamic memory management. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (brk)); + + /* Allow some status inquiries. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (uname)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp)); + + /* Allow operations on open file descriptors. File descriptors are + capabilities, and operating on them shouldn't cause security + issues. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (read)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (write)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (close)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lseek)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup2)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstat)); + + /* Allow read operations on the filesystem. If necessary, these + should be further restricted using mount namespaces. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (access)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlink)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getcwd)); + + /* Allow opening files, assuming they are only opened for + reading. */ + verify (O_WRONLY != 0); + verify (O_RDWR != 0); + verify (O_CREAT != 0); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (open), + SCMP_A1_32 (SCMP_CMP_MASKED_EQ, + ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH + | O_DIRECTORY), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (openat), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH + | O_DIRECTORY), + 0)); + + /* Allow `tcgetpgrp'. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (ioctl), + SCMP_A0_32 (SCMP_CMP_EQ, STDIN_FILENO), + SCMP_A1_32 (SCMP_CMP_EQ, TIOCGPGRP)); + + /* Allow reading (but not setting) file flags. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl), + SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl64), + SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL)); + + /* Allow reading random numbers from the kernel. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrandom)); + + /* Changing the umask is uncritical. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (umask)); + + /* Allow creation of pipes. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe2)); + + /* Allow reading (but not changing) resource limits. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prlimit64), + SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, + SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */); + + /* Block changing resource limits, but don't crash. */ + RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64), + SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, + SCMP_A2_64 (SCMP_CMP_NE, 0) /* new_limit != NULL */); + + /* Emacs installs signal handlers, which is harmless. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaction)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask)); + + /* Allow timer support. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create)); + + /* Allow thread creation. See the NOTES section in the manual page + for the `clone' function. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone), + SCMP_A0_64 (SCMP_CMP_MASKED_EQ, + /* Flags needed to create threads. See + create_thread in libc. */ + ~(CLONE_VM | CLONE_FS | CLONE_FILES + | CLONE_SYSVSEM | CLONE_SIGHAND | CLONE_THREAD + | CLONE_SETTLS | CLONE_PARENT_SETTID + | CLONE_CHILD_CLEARTID), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list)); + + /* Allow setting the process name for new threads. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl), + SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NAME)); + + /* Allow some event handling functions used by glib. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (wait4)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (poll)); + + /* Don't allow creating sockets (network access would be extremely + dangerous), but also don't crash. */ + RULE (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket)); + + EXPORT_FILTER (argv[1], seccomp_export_bpf); + EXPORT_FILTER (argv[2], seccomp_export_pfc); +} diff --git a/test/Makefile.in b/test/Makefile.in index ba354289e2..91a8ea141c 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -276,6 +276,8 @@ $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h $(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c endif +src/emacs-tests.log: ../lib-src/seccomp-filter.c + ## Check that there is no 'automated' subdirectory, which would ## indicate an incomplete merge from an older version of Emacs where ## the tests were arranged differently. diff --git a/test/src/emacs-resources/seccomp-filter.bpf b/test/src/emacs-resources/seccomp-filter.bpf new file mode 120000 index 0000000000..b3d603d0ae --- /dev/null +++ b/test/src/emacs-resources/seccomp-filter.bpf @@ -0,0 +1 @@ +../../../lib-src/seccomp-filter.bpf \ No newline at end of file diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el index 7618a9c675..89d811f8b4 100644 --- a/test/src/emacs-tests.el +++ b/test/src/emacs-tests.el @@ -25,7 +25,9 @@ (require 'cl-lib) (require 'ert) +(require 'ert-x) (require 'rx) +(require 'subr-x) (ert-deftest emacs-tests/seccomp/absent-file () (skip-unless (string-match-p (rx bow "SECCOMP" eow) @@ -128,4 +130,51 @@ to `make-temp-file', which see." (concat "--seccomp=" filter)) 0))))) +(ert-deftest emacs-tests/seccomp/allows-stdout () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter.bpf")) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + (with-temp-buffer + (let ((status (call-process + emacs nil t nil + "--quick" "--batch" + (concat "--seccomp=" filter) + (format "--eval=%S" '(message "Hi"))))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should (eql status 0))) + (should (equal (string-trim (buffer-string)) "Hi")))))) + +(ert-deftest emacs-tests/seccomp/forbids-subprocess () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter.bpf")) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + (with-temp-buffer + (let ((status + (call-process + emacs nil t nil + "--quick" "--batch" + (concat "--seccomp=" filter) + (format "--eval=%S" `(call-process ,emacs nil nil nil + "--version"))))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should-not (eql status 0))))))) + ;;; emacs-tests.el ends here commit 2d17e0124e4232db6344b18cec466eb31920e675 Author: Philipp Stephani Date: Sat Apr 10 20:35:06 2021 +0200 * src/emacs.c (load_seccomp): Fix condition. diff --git a/src/emacs.c b/src/emacs.c index 8658b1886e..cb1361fe46 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1060,7 +1060,7 @@ load_seccomp (const char *file) emacs_perror ("read"); goto out; } - if (read != count) + if (read != size) { fprintf (stderr, "seccomp filter %s changed size while reading\n", commit 8a84f97abed548e4a254a9b855c3f79dac8c3d5d Author: Philipp Stephani Date: Mon Dec 14 21:25:11 2020 +0100 Read file in a loop if necessary. This allows for short reads from 'emacs_read'. * src/emacs.c (read_full): New helper function. (load_seccomp): Use it. diff --git a/src/emacs.c b/src/emacs.c index b956e9ca34..8658b1886e 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -967,6 +967,43 @@ emacs_seccomp (unsigned int operation, unsigned int flags, void *args) #endif } +/* Read SIZE bytes into BUFFER. Return the number of bytes read, or + -1 if reading failed altogether. */ + +static ptrdiff_t +read_full (int fd, void *buffer, ptrdiff_t size) +{ + enum + { + /* See MAX_RW_COUNT in sysdep.c. */ +#ifdef MAX_RW_COUNT + max_size = MAX_RW_COUNT +#else + max_size = INT_MAX >> 18 << 18 +#endif + }; + if (PTRDIFF_MAX < size || max_size < size) + { + errno = EFBIG; + return -1; + } + char *ptr = buffer; + ptrdiff_t read = 0; + while (size != 0) + { + ptrdiff_t n = emacs_read (fd, ptr, size); + if (n < 0) + return -1; + if (n == 0) + break; /* Avoid infinite loop on encountering EOF. */ + eassert (n <= size); + size -= n; + ptr += n; + read += n; + } + return read; +} + /* Attempt to load Secure Computing filters from FILE. Return false if that doesn't work for some reason. */ @@ -993,18 +1030,9 @@ load_seccomp (const char *file) fprintf (stderr, "seccomp file %s is not regular\n", file); goto out; } - enum - { - /* See MAX_RW_COUNT in sysdep.c. */ -#ifdef MAX_RW_COUNT - max_read_size = MAX_RW_COUNT -#else - max_read_size = INT_MAX >> 18 << 18 -#endif - }; struct sock_fprog program; if (stat.st_size <= 0 || SIZE_MAX <= stat.st_size - || PTRDIFF_MAX <= stat.st_size || max_read_size < stat.st_size + || PTRDIFF_MAX <= stat.st_size || stat.st_size % sizeof *program.filter != 0) { fprintf (stderr, "seccomp filter %s has invalid size %ld\n", @@ -1026,7 +1054,7 @@ load_seccomp (const char *file) emacs_perror ("malloc"); goto out; } - ptrdiff_t read = emacs_read (fd, buffer, size + 1); + ptrdiff_t read = read_full (fd, buffer, size + 1); if (read < 0) { emacs_perror ("read"); commit 15122b31040f8945d0998510abd52c7735b36bc7 Author: Eli Zaretskii Date: Sat Apr 10 21:17:09 2021 +0300 ; * etc/NEWS: Fix the wording of a recently added entry. diff --git a/etc/NEWS b/etc/NEWS index 0956084fc1..328c38c118 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -90,14 +90,15 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit true color by setting 'COLORTERM=truecolor' in the environment. This is useful on systems such as FreeBSD which ships only with "etc/termcap". -** On GNU/Linux systems, Emacs now supports loading a Secure Computing -filter. To use this, you can pass a --seccomp=FILE command-line -option to Emacs. FILE must name a binary file containing an array of -'struct sock_filter' structures. Emacs will then install that list of -Secure Computing filters into its own process early during the startup -process. You can use this functionality to put an Emacs process in a -sandbox to avoid security issues when executing untrusted code. See -the manual page for 'seccomp' for details about Secure Computing +** Emacs now supports loading a Secure Computing filter. +This is supported only on capable GNU/Linux systems. To use this, +use the '--seccomp=FILE' command-line option when starting Emacs. +FILE must name a binary file containing an array of 'struct sock_filter' +structures. Emacs will then install that list of Secure Computing +filters into its own process early during the startup process. You +can use this functionality to put an Emacs process in a sandbox to +avoid security issues when executing untrusted code. See the manual +page for 'seccomp' system call, for details about Secure Computing filters. commit be8328acf9aa464f848e682e63e417a18529af9e Author: Philipp Stephani Date: Mon Dec 14 21:25:11 2020 +0100 Add support for --seccomp command-line option. When passing this option on GNU/Linux, Emacs installs a Secure Computing kernel system call filter. See Bug#45198. * configure.ac: Check for seccomp header. * src/emacs.c (usage_message): Document --seccomp option. (emacs_seccomp): New wrapper for 'seccomp' syscall. (load_seccomp, maybe_load_seccomp): New helper functions. (main): Potentially load seccomp filters during startup. (standard_args): Add --seccomp option. * lisp/startup.el (command-line): Detect and ignore --seccomp option. * test/src/emacs-tests.el (emacs-tests/seccomp/absent-file) (emacs-tests/seccomp/empty-file) (emacs-tests/seccomp/file-too-large) (emacs-tests/seccomp/invalid-file-size): New unit tests. (emacs-tests--with-temp-file): New helper macro. * etc/NEWS: Document new --seccomp option. diff --git a/configure.ac b/configure.ac index 2c62a9fe6f..684788a4d3 100644 --- a/configure.ac +++ b/configure.ac @@ -4179,6 +4179,8 @@ fi AC_SUBST([BLESSMAIL_TARGET]) AC_SUBST([LIBS_MAIL]) +AC_CHECK_HEADERS([linux/seccomp.h], [HAVE_SECCOMP=yes]) + OLD_LIBS=$LIBS LIBS="$LIB_PTHREAD $LIB_MATH $LIBS" AC_CHECK_FUNCS(accept4 fchdir gethostname \ @@ -5672,7 +5674,8 @@ optsep= emacs_config_features= for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ - M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND THREADS TIFF \ + M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP SOUND \ + THREADS TIFF \ TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \ ZLIB; do diff --git a/etc/NEWS b/etc/NEWS index 9ae3740482..0956084fc1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -90,6 +90,16 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit true color by setting 'COLORTERM=truecolor' in the environment. This is useful on systems such as FreeBSD which ships only with "etc/termcap". +** On GNU/Linux systems, Emacs now supports loading a Secure Computing +filter. To use this, you can pass a --seccomp=FILE command-line +option to Emacs. FILE must name a binary file containing an array of +'struct sock_filter' structures. Emacs will then install that list of +Secure Computing filters into its own process early during the startup +process. You can use this functionality to put an Emacs process in a +sandbox to avoid security issues when executing untrusted code. See +the manual page for 'seccomp' for details about Secure Computing +filters. + * Changes in Emacs 28.1 diff --git a/lisp/startup.el b/lisp/startup.el index b173d61973..4d4c65e6c4 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1097,7 +1097,7 @@ please check its value") ("--no-x-resources") ("--debug-init") ("--user") ("--iconic") ("--icon-type") ("--quick") ("--no-blinking-cursor") ("--basic-display") - ("--dump-file") ("--temacs"))) + ("--dump-file") ("--temacs") ("--seccomp"))) (argi (pop args)) (orig-argi argi) argval) @@ -1149,7 +1149,8 @@ please check its value") (push '(visibility . icon) initial-frame-alist)) ((member argi '("-nbc" "-no-blinking-cursor")) (setq no-blinking-cursor t)) - ((member argi '("-dump-file" "-temacs")) ; Handled in C + ((member argi '("-dump-file" "-temacs" "-seccomp")) + ;; Handled in C (or argval (pop args)) (setq argval nil)) ;; Push the popped arg back on the list of arguments. diff --git a/src/emacs.c b/src/emacs.c index fd08667f3f..b956e9ca34 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -61,6 +61,13 @@ along with GNU Emacs. If not, see . */ # include #endif +#ifdef HAVE_LINUX_SECCOMP_H +# include +# include +# include +# include +#endif + #ifdef HAVE_WINDOW_SYSTEM #include TERM_HEADER #endif /* HAVE_WINDOW_SYSTEM */ @@ -240,6 +247,11 @@ Initialization options:\n\ "\ --dump-file FILE read dumped state from FILE\n\ ", +#endif +#ifdef HAVE_LINUX_SECCOMP_H + "\ +--sandbox=FILE read Seccomp BPF filter from FILE\n\ +" #endif "\ --no-build-details do not add build details such as time stamps\n\ @@ -938,6 +950,149 @@ load_pdump (int argc, char **argv) } #endif /* HAVE_PDUMPER */ +#ifdef HAVE_LINUX_SECCOMP_H + +/* Wrapper function for the `seccomp' system call on GNU/Linux. This + system call usually doesn't have a wrapper function. See the + manual page of `seccomp' for the signature. */ + +static int +emacs_seccomp (unsigned int operation, unsigned int flags, void *args) +{ +#ifdef SYS_seccomp + return syscall (SYS_seccomp, operation, flags, args); +#else + errno = ENOSYS; + return -1; +#endif +} + +/* Attempt to load Secure Computing filters from FILE. Return false + if that doesn't work for some reason. */ + +static bool +load_seccomp (const char *file) +{ + bool success = false; + void *buffer = NULL; + int fd + = emacs_open_noquit (file, O_RDONLY | O_CLOEXEC | O_BINARY, 0); + if (fd < 0) + { + emacs_perror ("open"); + goto out; + } + struct stat stat; + if (fstat (fd, &stat) != 0) + { + emacs_perror ("fstat"); + goto out; + } + if (! S_ISREG (stat.st_mode)) + { + fprintf (stderr, "seccomp file %s is not regular\n", file); + goto out; + } + enum + { + /* See MAX_RW_COUNT in sysdep.c. */ +#ifdef MAX_RW_COUNT + max_read_size = MAX_RW_COUNT +#else + max_read_size = INT_MAX >> 18 << 18 +#endif + }; + struct sock_fprog program; + if (stat.st_size <= 0 || SIZE_MAX <= stat.st_size + || PTRDIFF_MAX <= stat.st_size || max_read_size < stat.st_size + || stat.st_size % sizeof *program.filter != 0) + { + fprintf (stderr, "seccomp filter %s has invalid size %ld\n", + file, (long) stat.st_size); + goto out; + } + size_t size = stat.st_size; + size_t count = size / sizeof *program.filter; + eassert (0 < count && count < SIZE_MAX); + if (USHRT_MAX < count) + { + fprintf (stderr, "seccomp filter %s is too big\n", file); + goto out; + } + /* Try reading one more byte to detect file size changes. */ + buffer = malloc (size + 1); + if (buffer == NULL) + { + emacs_perror ("malloc"); + goto out; + } + ptrdiff_t read = emacs_read (fd, buffer, size + 1); + if (read < 0) + { + emacs_perror ("read"); + goto out; + } + if (read != count) + { + fprintf (stderr, + "seccomp filter %s changed size while reading\n", + file); + goto out; + } + if (emacs_close (fd) < 0) + emacs_perror ("close"); /* not a fatal error */ + fd = -1; + program.len = count; + program.filter = buffer; + + /* See man page of `seccomp' why this is necessary. Note that we + intentionally don't check the return value: a parent process + might have made this call before, in which case it would fail; + or, if enabling privilege-restricting mode fails, the `seccomp' + syscall will fail anyway. */ + prctl (PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0); + /* Install the filter. Make sure that potential other threads can't + escape it. */ + if (emacs_seccomp (SECCOMP_SET_MODE_FILTER, + SECCOMP_FILTER_FLAG_TSYNC, &program) + != 0) + { + emacs_perror ("seccomp"); + goto out; + } + success = true; + + out: + if (fd < 0) + emacs_close (fd); + free (buffer); + return success; +} + +/* Load Secure Computing filter from file specified with the --seccomp + option. Exit if that fails. */ + +static void +maybe_load_seccomp (int argc, char **argv) +{ + int skip_args = 0; + char *file = NULL; + while (skip_args < argc - 1) + { + if (argmatch (argv, argc, "-seccomp", "--seccomp", 9, &file, + &skip_args) + || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args)) + break; + ++skip_args; + } + if (file == NULL) + return; + if (! load_seccomp (file)) + fatal ("cannot enable seccomp filter from %s", file); +} + +#endif /* HAVE_LINUX_SECCOMP_H */ + int main (int argc, char **argv) { @@ -945,6 +1100,13 @@ main (int argc, char **argv) for pointers. */ void *stack_bottom_variable; + /* First, check whether we should apply a seccomp filter. This + should come at the very beginning to allow the filter to protect + the initialization phase. */ +#ifdef HAVE_LINUX_SECCOMP_H + maybe_load_seccomp (argc, argv); +#endif + bool no_loadup = false; char *junk = 0; char *dname_arg = 0; @@ -2133,12 +2295,15 @@ static const struct standard_args standard_args[] = { "-color", "--color", 5, 0}, { "-no-splash", "--no-splash", 3, 0 }, { "-no-desktop", "--no-desktop", 3, 0 }, - /* The following two must be just above the file-name args, to get + /* The following three must be just above the file-name args, to get them out of our way, but without mixing them with file names. */ { "-temacs", "--temacs", 1, 1 }, #ifdef HAVE_PDUMPER { "-dump-file", "--dump-file", 1, 1 }, #endif +#ifdef HAVE_LINUX_SECCOMP_H + { "-seccomp", "--seccomp", 1, 1 }, +#endif #ifdef HAVE_NS { "-NSAutoLaunch", 0, 5, 1 }, { "-NXAutoLaunch", 0, 5, 1 }, diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el new file mode 100644 index 0000000000..7618a9c675 --- /dev/null +++ b/test/src/emacs-tests.el @@ -0,0 +1,131 @@ +;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Unit tests for src/emacs.c. + +;;; Code: + +(require 'cl-lib) +(require 'ert) +(require 'rx) + +(ert-deftest emacs-tests/seccomp/absent-file () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (should-not (file-exists-p "/does-not-exist.bpf")) + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + "--seccomp=/does-not-exist.bpf") + 0)))) + +(cl-defmacro emacs-tests--with-temp-file + (var (prefix &optional suffix text) &rest body) + "Evaluate BODY while a new temporary file exists. +Bind VAR to the name of the file. Pass PREFIX, SUFFIX, and TEXT +to `make-temp-file', which see." + (declare (indent 2) (debug (symbolp (form form form) body))) + (cl-check-type var symbol) + ;; Use an uninterned symbol so that the code still works if BODY + ;; changes VAR. + (let ((filename (make-symbol "filename"))) + `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text))) + (unwind-protect + (let ((,var ,filename)) + ,@body) + (delete-file ,filename))))) + +(ert-deftest emacs-tests/seccomp/empty-file () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf") + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; According to the Seccomp man page, a filter must have at + ;; least one element, so Emacs should reject an empty file. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/file-too-large () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil) + ;; This value should be correct on all supported systems. + (ushort-max #xFFFF) + ;; Either 8 or 16, but 16 should be large enough in all cases. + (filter-size 16)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file + filter ("seccomp-too-large-" ".bpf" + (make-string (* (1+ ushort-max) filter-size) ?a)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; The filter count must fit into an `unsigned short'. A bigger + ;; file should be rejected. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/invalid-file-size () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf" + "123456") + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; The Seccomp filter file must have a file size that's a + ;; multiple of the size of struct sock_filter, which is 8 or 16, + ;; but never 6. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +;;; emacs-tests.el ends here commit 53dfd85a7f971875e716a55f010ee508bce89eed Author: Philipp Stephani Date: Thu Mar 18 12:40:08 2021 +0100 Edebug: Disable backtracking when hitting a &define keyword. Edebug doesn't deal well with backtracking out of definitions, see Bug#41988. Rather than trying to support this rare situation (e.g. by implementing a multipass parser), prevent it by adding an implicit gate. * lisp/emacs-lisp/edebug.el (edebug--match-&-spec-op): Disable backtracking when hitting a &define keyword. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-duplicate-&define): New unit test. (edebug-tests--duplicate-&define): New helper macro. * doc/lispref/edebug.texi (Backtracking): Mention &define in the list of constructs that disable backtracking. * etc/NEWS: Document new behavior. diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 8942f55aff..323130f237 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1510,11 +1510,11 @@ form specifications (that is, @code{form}, @code{body}, @code{def-form}, and must be in the form itself rather than at a higher level. Backtracking is also disabled after successfully matching a quoted -symbol or string specification, since this usually indicates a -recognized construct. But if you have a set of alternative constructs that -all begin with the same symbol, you can usually work around this -constraint by factoring the symbol out of the alternatives, e.g., -@code{["foo" &or [first case] [second case] ...]}. +symbol, string specification, or @code{&define} keyword, since this +usually indicates a recognized construct. But if you have a set of +alternative constructs that all begin with the same symbol, you can +usually work around this constraint by factoring the symbol out of the +alternatives, e.g., @code{["foo" &or [first case] [second case] ...]}. Most needs are satisfied by these two ways that backtracking is automatically disabled, but occasionally it is useful to explicitly diff --git a/etc/NEWS b/etc/NEWS index a0f05d8cf1..9ae3740482 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2524,6 +2524,9 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', ** The 'values' variable is now obsolete. +** The '&define' keyword in an Edebug specification now disables +backtracking. + * Lisp Changes in Emacs 28.1 diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f1455ffe73..365bc74874 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1942,14 +1942,16 @@ a sequence of elements." ;; Normally, &define is interpreted specially other places. ;; This should only be called inside of a spec list to match the remainder ;; of the current list. e.g. ("lambda" &define args def-body) - (edebug-make-form-wrapper - cursor - (edebug-before-offset cursor) - ;; Find the last offset in the list. - (let ((offsets (edebug-cursor-offsets cursor))) - (while (consp offsets) (setq offsets (cdr offsets))) - offsets) - specs)) + (prog1 (edebug-make-form-wrapper + cursor + (edebug-before-offset cursor) + ;; Find the last offset in the list. + (let ((offsets (edebug-cursor-offsets cursor))) + (while (consp offsets) (setq offsets (cdr offsets))) + offsets) + specs) + ;; Stop backtracking here (Bug#41988). + (setq edebug-gate t))) (cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs) "Compute the name for `&name SPEC FUN` spec operator. diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index dcb261c2eb..7d45432e57 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -1061,5 +1061,30 @@ backtracking (Bug#42701)." "edebug-anon10001" "edebug-tests-duplicate-symbol-backtrack")))))) +(defmacro edebug-tests--duplicate-&define (_arg) + "Helper macro for the ERT test `edebug-tests-duplicate-&define'. +The Edebug specification is similar to the one used by `cl-flet' +previously; see Bug#41988." + (declare (debug (&or (&define name function-form) (defun))))) + +(ert-deftest edebug-tests-duplicate-&define () + "Check that Edebug doesn't backtrack out of `&define' forms. +This avoids potential duplicate definitions (Bug#41988)." + (with-temp-buffer + (print '(defun edebug-tests-duplicate-&define () + (edebug-tests--duplicate-&define + (edebug-tests-duplicate-&define-inner () nil))) + (current-buffer)) + (let* ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop) + (instrumented-names ()) + (edebug-new-definition-function + (lambda (name) + (when (memq name instrumented-names) + (error "Duplicate definition of `%s'" name)) + (push name instrumented-names) + (edebug-new-definition name)))) + (should-error (eval-buffer) :type 'invalid-read-syntax)))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here commit b72571ca49dd16be174f02ed14b460c136c9aaf2 Author: Stefan Monnier Date: Sat Apr 10 12:19:16 2021 -0400 * lisp/gnus/nnagent.el: Fix spurious empty line at BOB diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 56ca2e14b6..76a7e21567 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -1,4 +1,3 @@ - ;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. commit 6b81f7c1ddd3c00ad74a82584a3bc2c3743eddd5 Author: Stefan Monnier Date: Sat Apr 10 12:18:22 2021 -0400 * lisp/edmacro.el: Use lexical-binding (edmacro-finish-edit, edmacro-parse-keys): Use `match-string`. diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 3d7db44a86..84de69a2ce 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -1,4 +1,4 @@ -;;; edmacro.el --- keyboard macro editor +;;; edmacro.el --- keyboard macro editor -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. @@ -74,8 +74,8 @@ Default nil means to write characters above \\177 in octal notation." (defvar edmacro-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'edmacro-finish-edit) - (define-key map "\C-c\C-q" 'edmacro-insert-key) + (define-key map "\C-c\C-c" #'edmacro-finish-edit) + (define-key map "\C-c\C-q" #'edmacro-insert-key) map)) (defvar edmacro-store-hook) @@ -177,8 +177,8 @@ With a prefix argument, format the macro in a more concise way." (set-buffer-modified-p nil)) (run-hooks 'edmacro-format-hook))))) -;;; The next two commands are provided for convenience and backward -;;; compatibility. +;; The next two commands are provided for convenience and backward +;; compatibility. ;;;###autoload (defun edit-last-kbd-macro (&optional prefix) @@ -237,8 +237,7 @@ or nil, use a compact 80-column format." ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$") (when edmacro-store-hook (error "\"Command\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq cmd (and (not (equal str "none")) (intern str))) @@ -253,8 +252,7 @@ or nil, use a compact 80-column format." (when edmacro-store-hook (error "\"Key\" line not allowed in this context")) (let ((key (edmacro-parse-keys - (buffer-substring (match-beginning 1) - (match-end 1))))) + (match-string 1)))) (unless (equal key "") (if (equal key "none") (setq no-keys t) @@ -274,16 +272,14 @@ or nil, use a compact 80-column format." ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$") (when edmacro-store-hook (error "\"Counter\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq mac-counter (string-to-number str)))) t) ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$") (when edmacro-store-hook (error "\"Format\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq mac-format str))) t) @@ -475,7 +471,7 @@ doubt, use whitespace." (and (not (memq (aref rest-mac i) pkeys)) (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ") (cl-callf cl-subseq rest-mac i))))))) - (bind-len (apply 'max 1 + (bind-len (apply #'max 1 (cl-loop for map in maps for b = (lookup-key map rest-mac) when b collect b))) @@ -506,7 +502,7 @@ doubt, use whitespace." finally return i)) desc) (if (stringp bind) (setq bind nil)) - (cond ((and (eq bind 'self-insert-command) (not prefix) + (cond ((and (eq bind #'self-insert-command) (not prefix) (> text 1) (integerp first) (> first 32) (<= first maxkey) (/= first 92) (progn @@ -520,11 +516,11 @@ doubt, use whitespace." desc)))) (when (or (string-match "^\\^.$" desc) (member desc res-words)) - (setq desc (mapconcat 'char-to-string desc " "))) + (setq desc (mapconcat #'char-to-string desc " "))) (when verbose (setq bind (format "%s * %d" bind text))) (setq bind-len text)) - ((and (eq bind 'execute-extended-command) + ((and (eq bind #'execute-extended-command) (> text bind-len) (memq (aref rest-mac text) '(return 13)) (progn @@ -667,10 +663,8 @@ This function assumes that the events can be stored in a string." (substring word 2 -2) "\r"))) ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) (progn - (setq word (concat (substring word (match-beginning 1) - (match-end 1)) - (substring word (match-beginning 3) - (match-end 3)))) + (setq word (concat (match-string 1 word) + (match-string 3 word))) (not (string-match "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" word)))) commit 3c051db646b34995c144327ed462a92ffbb41f86 Author: Stefan Monnier Date: Sat Apr 10 12:08:36 2021 -0400 * lisp/files-x.el: Use lexical-binding diff --git a/lisp/files-x.el b/lisp/files-x.el index 23e4562f4b..9e1954256a 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -1,4 +1,4 @@ -;;; files-x.el --- extended file handling commands +;;; files-x.el --- extended file handling commands -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. @@ -602,7 +602,7 @@ PROFILES is a list of connection profiles (symbols).") "Normalize plist CRITERIA according to properties. Return a reordered plist." (apply - 'append + #'append (mapcar (lambda (property) (when (and (plist-member criteria property) (plist-get criteria property)) commit 649e5c26edc89373778016898652faaaf9a7275c Author: Stefan Monnier Date: Sat Apr 10 09:52:09 2021 -0400 * lisp/ps-mule.el: Use lexical-binding (ps-mule-encode-header-string, ps-mule-begin-job): Use `pcase`. diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index db86f9400e..a8b5210e96 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1,4 +1,4 @@ -;;; ps-mule.el --- provide multi-byte character facility to ps-print +;;; ps-mule.el --- provide multi-byte character facility to ps-print -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -612,7 +612,7 @@ f2, f3, h0, h1, and H0 respectively." (push (/ code 256) code-list) (push (% code 256) code-list)))) (forward-char 1))) - (apply 'unibyte-string (nreverse code-list)))) + (apply #'unibyte-string (nreverse code-list)))) (defun ps-mule-plot-composition (composition font-spec-table) "Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE." @@ -1041,10 +1041,11 @@ Any other value is treated as \"/H0\"." (list (ps-mule-encode-region (point-min) (point-max) (aref ps-mule-font-spec-tables (aref ps-mule-font-number-to-type - (cond ((string= fonttag "/h0") 4) - ((string= fonttag "/h1") 5) - ((string= fonttag "/L0") 6) - (t 0)))))))) + (pcase fonttag + ("/h0" 4) + ("/h1" 5) + ("/L0" 6) + (_ 0)))))))) ;;;###autoload (defun ps-mule-begin-job (from to) @@ -1055,20 +1056,17 @@ It checks if all multi-byte characters in the region are printable or not." (goto-char from) (= (skip-chars-forward "\x00-\x7F" to) to))) ;; All characters can be printed by normal PostScript fonts. - (setq ps-basic-plot-string-function 'ps-basic-plot-string + (setq ps-basic-plot-string-function #'ps-basic-plot-string ;; FIXME: Doesn't ps-encode-header-string-function take 2 args? - ps-encode-header-string-function 'identity) - (setq ps-basic-plot-string-function 'ps-mule-plot-string - ps-encode-header-string-function 'ps-mule-encode-header-string + ps-encode-header-string-function #'identity) + (setq ps-basic-plot-string-function #'ps-mule-plot-string + ps-encode-header-string-function #'ps-mule-encode-header-string ps-mule-font-info-database - (cond ((eq ps-multibyte-buffer 'non-latin-printer) - ps-mule-font-info-database-ps) - ((eq ps-multibyte-buffer 'bdf-font) - ps-mule-font-info-database-bdf) - ((eq ps-multibyte-buffer 'bdf-font-except-latin) - ps-mule-font-info-database-ps-bdf) - (t - ps-mule-font-info-database-default))) + (pcase ps-multibyte-buffer + ('non-latin-printer ps-mule-font-info-database-ps) + ('bdf-font ps-mule-font-info-database-bdf) + ('bdf-font-except-latin ps-mule-font-info-database-ps-bdf) + (_ ps-mule-font-info-database-default))) ;; Be sure to have font information for Latin-1. (or (assq 'iso-8859-1 ps-mule-font-info-database) @@ -1112,10 +1110,12 @@ It checks if all multi-byte characters in the region are printable or not." id-max (1+ id-max)) (if (ps-mule-check-font font-spec) (aset font-spec-vec - (cond ((eq (car e) 'normal) 0) - ((eq (car e) 'bold) 1) - ((eq (car e) 'italic) 2) - (t 3)) font-spec))) + (pcase (car e) + ('normal 0) + ('bold 1) + ('italic 2) + (_ 3)) + font-spec))) (when (aref font-spec-vec 0) (or (aref font-spec-vec 3) (aset font-spec-vec 3 (or (aref font-spec-vec 1) @@ -1182,7 +1182,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n" (let ((output-head (list t)) (ps-mule-output-list (list t))) (dotimes (i 4) - (map-char-table 'ps-mule-prepare-glyph + (map-char-table #'ps-mule-prepare-glyph (aref ps-mule-font-spec-tables i))) (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head) (ps-output-prologue (cdr output-head))) commit 84c1940d42d2b25fa5e2f88d93780a3ffc4d041e Author: Gregory Heytings Date: Sat Apr 10 12:35:06 2021 +0000 Autoload list-colors-display. * lisp/facemenu.el (list-colors-display): Autoload, it is mentioned in (info "(emacs)Colors for Faces"), and to be generally available. diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 2d06658b55..8db1b42db4 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -539,6 +539,7 @@ filter out the color from the output." This is installed as a `revert-buffer-function' in the *Colors* buffer." (list-colors-display nil (buffer-name) list-colors-callback)) +;;;###autoload (defun list-colors-display (&optional list buffer-name callback) "Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of commit ca1ddef2627e2d71539467c9042f78d9d560ea9d Author: Michael Albinus Date: Sat Apr 10 14:46:58 2021 +0200 Tramp: fix location of files on W32 * lisp/net/tramp.el: * lisp/net/tramp-sh.el: Use (eq system-type 'windows-nt) where appropriate. (tramp-completion-function-alist-ssh): Fix location of files on W32. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8db9dd9d82..0e6a2bb04a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -401,16 +401,34 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (defconst tramp-completion-function-alist-ssh - '((tramp-parse-rhosts "/etc/hosts.equiv") + `((tramp-parse-rhosts "/etc/hosts.equiv") (tramp-parse-rhosts "/etc/shosts.equiv") - (tramp-parse-shosts "/etc/ssh_known_hosts") - (tramp-parse-sconfig "/etc/ssh_config") + ;; On W32 systems, the ssh directory is located somewhere else. + (tramp-parse-shosts ,(expand-file-name + "ssh/ssh_known_hosts" + (or (and (eq system-type 'windows-nt) + (getenv "ProgramData")) + "/etc/"))) + (tramp-parse-sconfig ,(expand-file-name + "ssh/ssh_config" + (or (and (eq system-type 'windows-nt) + (getenv "ProgramData")) + "/etc/"))) (tramp-parse-shostkeys "/etc/ssh2/hostkeys") (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") (tramp-parse-rhosts "~/.rhosts") (tramp-parse-rhosts "~/.shosts") - (tramp-parse-shosts "~/.ssh/known_hosts") - (tramp-parse-sconfig "~/.ssh/config") + ;; On W32 systems, the .ssh directory is located somewhere else. + (tramp-parse-shosts ,(expand-file-name + ".ssh/known_hosts" + (or (and (eq system-type 'windows-nt) + (getenv "USERPROFILE")) + "~/"))) + (tramp-parse-sconfig ,(expand-file-name + ".ssh/config" + (or (and (eq system-type 'windows-nt) + (getenv "USERPROFILE")) + "~/"))) (tramp-parse-shostkeys "~/.ssh2/hostkeys") (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") @@ -433,7 +451,7 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (defconst tramp-completion-function-alist-putty `((tramp-parse-putty - ,(if (memq system-type '(windows-nt)) + ,(if (eq system-type 'windows-nt) "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions" "~/.putty/sessions"))) "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") @@ -5764,7 +5782,7 @@ function cell is returned to be applied on a buffer." ;; slashes as directory separators. (cond ((and (string-match-p "local" prop) - (memq system-type '(windows-nt))) + (eq system-type 'windows-nt)) "(%s | \"%s\")") ((string-match-p "local" prop) "(%s | %s)") (t "(%s | %s >%%s)")) @@ -5775,7 +5793,7 @@ function cell is returned to be applied on a buffer." ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. (if (and (string-match-p "local" prop) - (memq system-type '(windows-nt))) + (eq system-type 'windows-nt)) "(%s <%%s | \"%s\")" "(%s <%%s | %s)") compress coding)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 578fa148a2..8da94ec9d9 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -488,7 +488,7 @@ interpreted as a regular expression which always matches." ;; either lower case or upper case letters. See ;; . (defcustom tramp-restricted-shell-hosts-alist - (when (memq system-type '(windows-nt)) + (when (eq system-type 'windows-nt) (list (format "\\`\\(%s\\|%s\\)\\'" (regexp-quote (downcase tramp-system-name)) (regexp-quote (upcase tramp-system-name))))) @@ -558,7 +558,7 @@ usually suffice.") the remote shell.") (defcustom tramp-local-end-of-line - (if (memq system-type '(windows-nt)) "\r\n" "\n") + (if (eq system-type 'windows-nt) "\r\n" "\n") "String used for end of line in local processes." :version "24.1" :type 'string) @@ -3138,7 +3138,7 @@ User may be nil." (defun tramp-parse-putty (registry-or-dirname) "Return a list of (user host) tuples allowed to access. User is always nil." - (if (memq system-type '(windows-nt)) + (if (eq system-type 'windows-nt) (with-tramp-connection-property nil "parse-putty" (with-temp-buffer (when (zerop (tramp-call-process @@ -4990,7 +4990,7 @@ VEC is used for tracing." (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) locale) (with-temp-buffer - (unless (or (memq system-type '(windows-nt)) + (unless (or (eq system-type 'windows-nt) (not (zerop (tramp-call-process nil "locale" nil t nil "-a")))) (while candidates commit c975258abf346fcc0186892b84ae32ebce8b70d2 Author: Jim Porter Date: Sat Apr 10 13:16:13 2021 +0200 Further fix of hostname completion on MS Windows * lisp/net/tramp.el (tramp-completion-file-name-regexp-simplified) (tramp-completion-file-name-regexp-separate): Fix W32 hostname/method completion for simplified and separate syntaxes (same as the previous change to default syntax). Copyright-paperwork-exempt: yes diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e61c3b1e44..578fa148a2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1103,7 +1103,13 @@ On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-simplified (concat - "\\`/\\(" + "\\`" + ;; Allow the volume letter at the beginning of the path. See the + ;; comment in `tramp-completion-file-name-regexp-default' for more + ;; details. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(" ;; Optional multi hop. "\\([^/|:]*|\\)*" ;; Last hop. @@ -1119,7 +1125,14 @@ See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-separate - "\\`/\\(\\[[^]]*\\)?\\'" + (concat + "\\`" + ;; Allow the volume letter at the beginning of the path. See the + ;; comment in `tramp-completion-file-name-regexp-default' for more + ;; details. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(\\[[^]]*\\)?\\'") "Value for `tramp-completion-file-name-regexp' for separate remoting. See `tramp-file-name-structure' for more explanations.") commit c50b5907e0113f7dbb2cc501c54dc365fd01a12b Author: João Távora Date: Sat Apr 10 11:19:26 2021 +0100 Fail earlier if stale Flymake report functions called If a Flymake backend calls a "stale" report function, flymake--handle-report might be called for a backend function that is no longer in the flymake--backend-state hash table. This patch makes that erroneous situation slightly more explicit. * lisp/progmodes/flymake.el (flymake--handle-report): Improve error reporting. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 8481a27775..e10602ab08 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -741,7 +741,10 @@ to handle a report even if TOKEN was not expected. REGION is a (BEG . END) pair of buffer positions indicating that this report applies to that region." (let* ((state (gethash backend flymake--backend-state)) - (first-report (not (flymake--backend-state-reported-p state)))) + first-report) + (unless state + (error "Can't find state for %s in `flymake--backend-state'" backend)) + (setf first-report (not (flymake--backend-state-reported-p state))) (setf (flymake--backend-state-reported-p state) t) (let (expected-token new-diags)