commit ccb3efffc5a41353abb6ae223a7dcff1ea20e5fb (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Wed Dec 23 18:31:28 2020 -0500 * src/dispnew.c (sit_for): Fix bug#45292 When reading, prefer staying in the selected-window over preserving the current-buffer. diff --git a/src/dispnew.c b/src/dispnew.c index 89dd32ad0f..e0a6476190 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6057,6 +6057,8 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) intmax_t sec; int nsec; bool do_display = display_option > 0; + bool curbuf_eq_winbuf + = (current_buffer == XBUFFER (XWINDOW (selected_window)->contents)); swallow_events (do_display); @@ -6111,6 +6113,13 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display, Qnil, NULL, 0); + if (reading && curbuf_eq_winbuf) + /* Timers and process filters/sentinels may have changed the selected + window (e.g. in response to a connection from emacsclient), in which + case we should follow it (unless we weren't in the selected-window's + buffer to start with). */ + set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents)); + return detect_input_pending () ? Qnil : Qt; } commit b68d52c81b53ebe993620e1b80a1c923987b089b Author: Stefan Monnier Date: Sun Dec 20 23:21:51 2020 -0500 * lisp/emacs-lisp/lisp-mnt.el (lm-section-end): Stop at the right heading `lisp-outline-level` assumes the match-data is that set by `outline-regexp`. diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 0d57bc16a3..f190156342 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -208,6 +208,7 @@ a section." (when start (save-excursion (goto-char start) + (looking-at outline-regexp) (let ((level (lisp-outline-level)) (case-fold-search t) next-section-found) @@ -218,6 +219,7 @@ a section." nil t)) (> (save-excursion (beginning-of-line) + (looking-at outline-regexp) (lisp-outline-level)) level))) (min (if next-section-found commit 3be0dc659fd1a5bc976a545c0bdeda9a3d39e084 Author: TEC Date: Wed Dec 23 22:34:35 2020 +0100 authinfo-mode: add option to not hide any elements (and add font-lock) * lisp/auth-source.el (authinfo-hide-elements): New user option. (authinfo--keywords): New variable. (authinfo-mode): Use it. (authinfo--hide-passwords): Use doc-face instead of warning for the passwords. (authinfo--toggle-display): Ditto. diff --git a/etc/NEWS b/etc/NEWS index bbd372c199..b155ff9d42 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1460,6 +1460,10 @@ that makes it a valid button. ** Miscellaneous +--- +*** New user option 'authinfo-hide-elements'. +This can be set to nil to inhibit hiding passwords in .authinfo files. + +++ *** A number of new string manipulation functions have been added. 'string-clean-whitespace', 'string-fill', 'string-limit', diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 50795ce794..27cf94d378 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -2408,23 +2408,51 @@ MODE can be \"login\" or \"password\"." (list user password auth-info))) ;;; Tiny mode for editing .netrc/.authinfo modes (that basically just -;;; hides passwords). +;;; hides passwords and adds basic syntax highlighting). (defcustom authinfo-hidden "password" "Regexp matching elements in .authinfo/.netrc files that should be hidden." :type 'regexp :version "27.1") +(defcustom authinfo-hide-elements t + "Whether to use `authinfo-hidden' to hide elements in authinfo files." + :type 'boolean + :version "28.1") + +(defvar authinfo--keywords + '(("^#.*" . font-lock-comment-face) + ("^\\(machine\\)[ \t]+\\([^ \t\n]+\\)" + (1 font-lock-variable-name-face) + (2 font-lock-builtin-face)) + ("\\(login\\)[ \t]+\\([^ \t\n]+\\)" + (1 font-lock-comment-delimiter-face) + (2 font-lock-keyword-face)) + ("\\(password\\)[ \t]+\\([^ \t\n]+\\)" + (1 font-lock-comment-delimiter-face) + (2 font-lock-doc-face)) + ("\\(port\\)[ \t]+\\([^ \t\n]+\\)" + (1 font-lock-comment-delimiter-face) + (2 font-lock-type-face)) + ("\\([^ \t\n]+\\)[, \t]+\\([^ \t\n]+\\)" + (1 font-lock-constant-face) + (2 nil)))) + ;;;###autoload (define-derived-mode authinfo-mode fundamental-mode "Authinfo" "Mode for editing .authinfo/.netrc files. -This is just like `fundamental-mode', but hides passwords. The -passwords are revealed when point moved into the password. +This is just like `fundamental-mode', but has basic syntax +highlighting and hides passwords. Passwords are revealed when +point is moved into the passwords (see `authinfo-hide-elements'). \\{authinfo-mode-map}" - (authinfo--hide-passwords (point-min) (point-max)) - (reveal-mode)) + (font-lock-add-keywords nil authinfo--keywords) + (setq-local comment-start "#") + (setq-local comment-end "") + (when authinfo-hide-elements + (authinfo--hide-passwords (point-min) (point-max)) + (reveal-mode))) (defun authinfo--hide-passwords (start end) (save-excursion @@ -2436,14 +2464,15 @@ passwords are revealed when point moved into the password. nil t) (when (auth-source-netrc-looking-at-token) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) - (overlay-put overlay 'display (propertize "****" - 'face 'warning)) + (overlay-put overlay 'display + (propertize "****" 'face 'font-lock-doc-face)) (overlay-put overlay 'reveal-toggle-invisible #'authinfo--toggle-display))))))) (defun authinfo--toggle-display (overlay hide) (if hide - (overlay-put overlay 'display (propertize "****" 'face 'warning)) + (overlay-put overlay 'display + (propertize "****" 'face 'font-lock-doc-face)) (overlay-put overlay 'display nil))) (provide 'auth-source) commit 33210c8dc07fe8e1aed302aff09cac9ba798a221 Author: Adam Porter Date: Sun Dec 13 05:54:28 2020 +0000 * lisp/tab-line.el: New options, faces, and functions * lisp/tab-line.el: (tab-line-tab-face-functions): New option. (tab-line-tab-inactive-alternate): New face. (tab-line-tab-special): New face. (tab-line-tab-face-inactive-alternating): New function. (tab-line-tab-face-special): New function. (tab-line-format-template): Use them. * etc/NEWS: Update. With thanks to Juri Linkov and Eli Zaretskii for their guidance. diff --git a/etc/NEWS b/etc/NEWS index dee0a37727..bbd372c199 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -383,6 +383,18 @@ value of 'tab-bar-show'. If your mouse or trackpad supports it, you can now scroll tabs when the mouse pointer is in the tab line by scrolling left or right. +--- +*** New tab-line faces and options +The face 'tab-line-tab-special' is used for tabs whose buffers are +special, i.e. not file-backed. The face +'tab-line-tab-inactive-alternate' is used to display inactive tabs +with an alternating background color, making them easier to +distinguish between, especially if the face 'tab-line-tab' is +configured to not display with a box; this alternate face is only +applied when the option 'tab-line-tab-face-functions' is +so-configured. That option may also be used to customize tab-line +faces in other ways. + ** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and 'previous-error-no-select' bound to 'p'. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 46bf89f14e..c944471853 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -27,6 +27,7 @@ ;;; Code: +(require 'cl-lib) (require 'seq) ; tab-line.el is not pre-loaded so it's safe to use it here @@ -35,6 +36,18 @@ :group 'convenience :version "27.1") +(defcustom tab-line-tab-face-functions '(tab-line-tab-face-special) + "Functions called to modify tab faces. +Each function is called with five arguments: the tab, a list of +all tabs, the face returned by the previously called modifier, +whether the tab is a buffer, and whether the tab is selected." + :type '(repeat + (choice (function-item tab-line-tab-face-special) + (function-item tab-line-tab-face-inactive-alternating) + (function :tag "Custom function"))) + :group 'tab-line + :version "28.1") + (defgroup tab-line-faces '((tab-line custom-face)) ; tab-line is defined in faces.el "Faces used in the tab line." :group 'tab-line @@ -63,6 +76,25 @@ :version "27.1" :group 'tab-line-faces) +(defface tab-line-tab-inactive-alternate + `((t (:inherit tab-line-tab-inactive :background "grey65"))) + "Alternate face for inactive tab-line tabs. +Applied to alternating tabs when option +`tab-line-tab-face-functions' includes function +`tab-line-tab-face-inactive-alternating'." + :version "28.1" + :group 'tab-line-faces) + +(defface tab-line-tab-special + '((default (:weight bold)) + (((supports :slant italic)) + (:slant italic :weight normal))) + "Face for special (i.e. non-file-backed) tabs. +Applied when option `tab-line-tab-face-functions' includes +function `tab-line-tab-face-special'." + :version "28.1" + :group 'tab-line-faces) + (defface tab-line-tab-current '((default :inherit tab-line-tab) @@ -412,7 +444,14 @@ variable `tab-line-tabs-function'." (cdr (assq 'selected tab)))) (name (if buffer-p (funcall tab-line-tab-name-function tab tabs) - (cdr (assq 'name tab))))) + (cdr (assq 'name tab)))) + (face (if selected-p + (if (eq (selected-window) (old-selected-window)) + 'tab-line-tab-current + 'tab-line-tab) + 'tab-line-tab-inactive))) + (dolist (fn tab-line-tab-face-functions) + (setf face (funcall fn tab tabs face buffer-p selected-p))) (concat separator (apply 'propertize @@ -425,11 +464,7 @@ variable `tab-line-tabs-function'." `( tab ,tab ,@(if selected-p '(selected t)) - face ,(if selected-p - (if (eq (selected-window) (old-selected-window)) - 'tab-line-tab-current - 'tab-line-tab) - 'tab-line-tab-inactive) + face ,face mouse-face tab-line-highlight))))) tabs)) (hscroll-data (tab-line-auto-hscroll strings hscroll))) @@ -453,6 +488,24 @@ variable `tab-line-tabs-function'." tab-line-new-button) (list tab-line-new-button))))) +(defun tab-line-tab-face-inactive-alternating (tab tabs face _buffer-p selected-p) + "Return FACE for TAB in TABS with alternation. +When TAB is an inactive buffer and is even-numbered, make FACE +inherit from `tab-line-tab-inactive-alternate'. For use in +`tab-line-tab-face-functions'." + (when (and (not selected-p) (cl-evenp (cl-position tab tabs))) + (setf face `(:inherit (tab-line-tab-inactive-alternate ,face)))) + face) + +(defun tab-line-tab-face-special (tab _tabs face buffer-p _selected-p) + "Return FACE for TAB according to whether it's special. +When TAB is a non-file-backed buffer, make FACE inherit from +`tab-line-tab-special'. For use in +`tab-line-tab-face-functions'." + (when (and buffer-p (not (buffer-file-name tab))) + (setf face `(:inherit (tab-line-tab-special ,face)))) + face) + (defvar tab-line-auto-hscroll) (defun tab-line-format () commit 40bc77d9a6b8d824690fb6ee3003d74951bb3ae5 Author: Philipp Stephani Date: Wed Dec 23 17:40:18 2020 +0100 Declare argument vector as char *const *. This matches the signature of execve. * src/callproc.c (child_setup): Declare NEW_ARGV as char *const *. diff --git a/src/callproc.c b/src/callproc.c index bd8442ce2b..c7f560ac3d 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1222,8 +1222,8 @@ exec_failed (char const *name, int err) On MS-DOS, either return an exit status or signal an error. */ CHILD_SETUP_TYPE -child_setup (int in, int out, int err, char **new_argv, char *const *env, - const char *current_dir) +child_setup (int in, int out, int err, char *const *new_argv, + char *const *env, const char *current_dir) { #ifdef WINDOWSNT int cpid; diff --git a/src/lisp.h b/src/lisp.h index 07ba2bcbba..1a214a3cbf 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4500,8 +4500,8 @@ extern void setup_process_coding_systems (Lisp_Object); # define CHILD_SETUP_ERROR_DESC "Doing vfork" #endif -extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, char *const *, - const char *); +extern CHILD_SETUP_TYPE child_setup (int, int, int, char *const *, + char *const *, const char *); extern char *const *make_environment_block (Lisp_Object); extern void init_callproc_1 (void); extern void init_callproc (void); commit 773f9eb4673c20a218d42ec89dd08a1e45f77041 Author: Philipp Stephani Date: Wed Dec 23 17:34:26 2020 +0100 * .clang-format (ColumnLimit): Fix line length. diff --git a/.clang-format b/.clang-format index 7895ada36d..9ab09a86ff 100644 --- a/.clang-format +++ b/.clang-format @@ -4,7 +4,7 @@ AlignEscapedNewlinesLeft: true AlwaysBreakAfterReturnType: TopLevelDefinitions BreakBeforeBinaryOperators: All BreakBeforeBraces: GNU -ColumnLimit: 80 +ColumnLimit: 70 ContinuationIndentWidth: 2 ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE] IncludeCategories: commit bdcea81a2f906be3c573c42276dbfd35ccb432f9 Author: Philipp Stephani Date: Wed Dec 23 16:26:57 2020 +0100 Pass C string pointer to current directory to 'child_setup'. This avoids the impression that 'child_setup' could do anything Lisp-related. * src/callproc.c (child_setup): Pass C pointer to current directory name. (call_process): Adapt callers. * src/process.c (create_process): Adapt callers. diff --git a/src/callproc.c b/src/callproc.c index 93a8bb8641..bd8442ce2b 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -544,8 +544,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, char *const *env = make_environment_block (current_dir); #ifdef MSDOS /* MW, July 1993 */ - status - = child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir); + status = child_setup (filefd, fd_output, fd_error, new_argv, env, + SSDATA (current_dir)); if (status < 0) { @@ -592,7 +592,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, block_child_signal (&oldset); #ifdef WINDOWSNT - pid = child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir); + pid = child_setup (filefd, fd_output, fd_error, new_argv, env, + SSDATA (current_dir)); #else /* not WINDOWSNT */ /* vfork, and prevent local vars from being clobbered by the vfork. */ @@ -651,7 +652,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, signal (SIGPROF, SIG_DFL); #endif - child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir); + child_setup (filefd, fd_output, fd_error, new_argv, env, + SSDATA (current_dir)); } #endif /* not WINDOWSNT */ @@ -1221,7 +1223,7 @@ exec_failed (char const *name, int err) CHILD_SETUP_TYPE child_setup (int in, int out, int err, char **new_argv, char *const *env, - Lisp_Object current_dir) + const char *current_dir) { #ifdef WINDOWSNT int cpid; @@ -1243,13 +1245,13 @@ child_setup (int in, int out, int err, char **new_argv, char *const *env, should only return an error if the directory's permissions are changed between the check and this chdir, but we should at least check. */ - if (chdir (SSDATA (current_dir)) < 0) + if (chdir (current_dir) < 0) _exit (EXIT_CANCELED); #endif #ifdef WINDOWSNT prepare_standard_handles (in, out, err, handles); - set_process_dir (SSDATA (current_dir)); + set_process_dir (current_dir); /* Spawn the child. (See w32proc.c:sys_spawnve). */ cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env); reset_standard_handles (in, out, err, handles); diff --git a/src/lisp.h b/src/lisp.h index d20e69ff89..07ba2bcbba 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4501,7 +4501,7 @@ extern void setup_process_coding_systems (Lisp_Object); #endif extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, char *const *, - Lisp_Object); + const char *); extern char *const *make_environment_block (Lisp_Object); extern void init_callproc_1 (void); extern void init_callproc (void); diff --git a/src/process.c b/src/process.c index c579078c1c..15b4a23784 100644 --- a/src/process.c +++ b/src/process.c @@ -2259,9 +2259,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (forkerr < 0) forkerr = forkout; #ifdef WINDOWSNT - pid = child_setup (forkin, forkout, forkerr, new_argv, env, current_dir); + pid = child_setup (forkin, forkout, forkerr, new_argv, env, + SSDATA (current_dir)); #else /* not WINDOWSNT */ - child_setup (forkin, forkout, forkerr, new_argv, env, current_dir); + child_setup (forkin, forkout, forkerr, new_argv, env, + SSDATA (current_dir)); #endif /* not WINDOWSNT */ } commit 95334ee79ab60c0910a5528e586a24d11f91743b Author: Philipp Stephani Date: Wed Dec 23 15:55:23 2020 +0100 Allocate environment block before forking. While 'child_setup' carefully avoids calls to async-signal-unsafe functions like 'malloc', it seems simpler and less brittle to use normal allocation outside the critical section between 'fork' and 'exec'. * src/callproc.c (make_environment_block): New function to create the environment block for subprocesses. Code largely extracted from 'child_setup' and adapted to use 'xmalloc' instead of 'alloca'. (child_setup): Remove environment block allocation in favor of passing the environment block as command-line argument. (call_process): Adapt to new calling convention. * src/process.c (create_process): Adapt to new calling convention. diff --git a/src/callproc.c b/src/callproc.c index 5c5a2bb892..93a8bb8641 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -541,8 +541,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, callproc_fd[CALLPROC_STDERR] = fd_error; } + char *const *env = make_environment_block (current_dir); + #ifdef MSDOS /* MW, July 1993 */ - status = child_setup (filefd, fd_output, fd_error, new_argv, current_dir); + status + = child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir); if (status < 0) { @@ -589,7 +592,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, block_child_signal (&oldset); #ifdef WINDOWSNT - pid = child_setup (filefd, fd_output, fd_error, new_argv, current_dir); + pid = child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir); #else /* not WINDOWSNT */ /* vfork, and prevent local vars from being clobbered by the vfork. */ @@ -604,6 +607,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, ptrdiff_t volatile sa_avail_volatile = sa_avail; ptrdiff_t volatile sa_count_volatile = sa_count; char **volatile new_argv_volatile = new_argv; + char *const *volatile env_volatile = env; int volatile callproc_fd_volatile[CALLPROC_FDS]; for (i = 0; i < CALLPROC_FDS; i++) callproc_fd_volatile[i] = callproc_fd[i]; @@ -620,6 +624,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, sa_avail = sa_avail_volatile; sa_count = sa_count_volatile; new_argv = new_argv_volatile; + env = env_volatile; for (i = 0; i < CALLPROC_FDS; i++) callproc_fd[i] = callproc_fd_volatile[i]; @@ -646,7 +651,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, signal (SIGPROF, SIG_DFL); #endif - child_setup (filefd, fd_output, fd_error, new_argv, current_dir); + child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir); } #endif /* not WINDOWSNT */ @@ -1215,11 +1220,9 @@ exec_failed (char const *name, int err) On MS-DOS, either return an exit status or signal an error. */ CHILD_SETUP_TYPE -child_setup (int in, int out, int err, char **new_argv, - Lisp_Object current_dir) +child_setup (int in, int out, int err, char **new_argv, char *const *env, + Lisp_Object current_dir) { - char **env; - char *pwd_var; #ifdef WINDOWSNT int cpid; HANDLE handles[3]; @@ -1233,24 +1236,6 @@ child_setup (int in, int out, int err, char **new_argv, src/alloca.c) it is safe because that changes the superior's static variables as if the superior had done alloca and will be cleaned up in the usual way. */ - { - char *temp; - ptrdiff_t i; - - i = SBYTES (current_dir); -#ifdef MSDOS - /* MSDOS must have all environment variables malloc'ed, because - low-level libc functions that launch subsidiary processes rely - on that. */ - pwd_var = xmalloc (i + 5); -#else - if (MAX_ALLOCA - 5 < i) - exec_failed (new_argv[0], ENOMEM); - pwd_var = alloca (i + 5); -#endif - temp = pwd_var + 4; - memcpy (pwd_var, "PWD=", 4); - lispstpcpy (temp, current_dir); #ifndef DOS_NT /* We can't signal an Elisp error here; we're in a vfork. Since @@ -1258,97 +1243,9 @@ child_setup (int in, int out, int err, char **new_argv, should only return an error if the directory's permissions are changed between the check and this chdir, but we should at least check. */ - if (chdir (temp) < 0) + if (chdir (SSDATA (current_dir)) < 0) _exit (EXIT_CANCELED); -#else /* DOS_NT */ - /* Get past the drive letter, so that d:/ is left alone. */ - if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2])) - { - temp += 2; - i -= 2; - } -#endif /* DOS_NT */ - - /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */ - while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1])) - temp[--i] = 0; - } - - /* Set `env' to a vector of the strings in the environment. */ - { - register Lisp_Object tem; - register char **new_env; - char **p, **q; - register int new_length; - Lisp_Object display = Qnil; - - new_length = 0; - - for (tem = Vprocess_environment; - CONSP (tem) && STRINGP (XCAR (tem)); - tem = XCDR (tem)) - { - if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0 - && (SDATA (XCAR (tem)) [7] == '\0' - || SDATA (XCAR (tem)) [7] == '=')) - /* DISPLAY is specified in process-environment. */ - display = Qt; - new_length++; - } - - /* If not provided yet, use the frame's DISPLAY. */ - if (NILP (display)) - { - Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay); - if (!STRINGP (tmp) && CONSP (Vinitial_environment)) - /* If still not found, Look for DISPLAY in Vinitial_environment. */ - tmp = Fgetenv_internal (build_string ("DISPLAY"), - Vinitial_environment); - if (STRINGP (tmp)) - { - display = tmp; - new_length++; - } - } - - /* new_length + 2 to include PWD and terminating 0. */ - if (MAX_ALLOCA / sizeof *env - 2 < new_length) - exec_failed (new_argv[0], ENOMEM); - env = new_env = alloca ((new_length + 2) * sizeof *env); - /* If we have a PWD envvar, pass one down, - but with corrected value. */ - if (egetenv ("PWD")) - *new_env++ = pwd_var; - - if (STRINGP (display)) - { - if (MAX_ALLOCA - sizeof "DISPLAY=" < SBYTES (display)) - exec_failed (new_argv[0], ENOMEM); - char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display)); - lispstpcpy (stpcpy (vdata, "DISPLAY="), display); - new_env = add_env (env, new_env, vdata); - } - - /* Overrides. */ - for (tem = Vprocess_environment; - CONSP (tem) && STRINGP (XCAR (tem)); - tem = XCDR (tem)) - new_env = add_env (env, new_env, SSDATA (XCAR (tem))); - - *new_env = 0; - - /* Remove variable names without values. */ - p = q = env; - while (*p != 0) - { - while (*q != 0 && strchr (*q, '=') == NULL) - q++; - *p = *q++; - if (*p != 0) - p++; - } - } - +#endif #ifdef WINDOWSNT prepare_standard_handles (in, out, err, handles); @@ -1511,6 +1408,119 @@ egetenv_internal (const char *var, ptrdiff_t len) return 0; } +/* Create a new environment block. You can pass the returned pointer + to `execve'. Add unwind protections for all newly-allocated + objects. Don't call any Lisp code or the garbage collector while + the block is active. */ + +char *const * +make_environment_block (Lisp_Object current_dir) +{ + char **env; + char *pwd_var; + + { + char *temp; + ptrdiff_t i; + + i = SBYTES (current_dir); + pwd_var = xmalloc (i + 5); + record_unwind_protect_ptr (xfree, pwd_var); + temp = pwd_var + 4; + memcpy (pwd_var, "PWD=", 4); + lispstpcpy (temp, current_dir); + +#ifdef DOS_NT + /* Get past the drive letter, so that d:/ is left alone. */ + if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2])) + { + temp += 2; + i -= 2; + } +#endif /* DOS_NT */ + + /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */ + while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1])) + temp[--i] = 0; + } + + /* Set `env' to a vector of the strings in the environment. */ + + { + register Lisp_Object tem; + register char **new_env; + char **p, **q; + register int new_length; + Lisp_Object display = Qnil; + + new_length = 0; + + for (tem = Vprocess_environment; + CONSP (tem) && STRINGP (XCAR (tem)); + tem = XCDR (tem)) + { + if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0 + && (SDATA (XCAR (tem)) [7] == '\0' + || SDATA (XCAR (tem)) [7] == '=')) + /* DISPLAY is specified in process-environment. */ + display = Qt; + new_length++; + } + + /* If not provided yet, use the frame's DISPLAY. */ + if (NILP (display)) + { + Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay); + if (!STRINGP (tmp) && CONSP (Vinitial_environment)) + /* If still not found, Look for DISPLAY in Vinitial_environment. */ + tmp = Fgetenv_internal (build_string ("DISPLAY"), + Vinitial_environment); + if (STRINGP (tmp)) + { + display = tmp; + new_length++; + } + } + + /* new_length + 2 to include PWD and terminating 0. */ + env = new_env = xnmalloc (new_length + 2, sizeof *env); + record_unwind_protect_ptr (xfree, env); + /* If we have a PWD envvar, pass one down, + but with corrected value. */ + if (egetenv ("PWD")) + *new_env++ = pwd_var; + + if (STRINGP (display)) + { + char *vdata = xmalloc (sizeof "DISPLAY=" + SBYTES (display)); + record_unwind_protect_ptr (xfree, vdata); + lispstpcpy (stpcpy (vdata, "DISPLAY="), display); + new_env = add_env (env, new_env, vdata); + } + + /* Overrides. */ + for (tem = Vprocess_environment; + CONSP (tem) && STRINGP (XCAR (tem)); + tem = XCDR (tem)) + new_env = add_env (env, new_env, SSDATA (XCAR (tem))); + + *new_env = 0; + + /* Remove variable names without values. */ + p = q = env; + while (*p != 0) + { + while (*q != 0 && strchr (*q, '=') == NULL) + q++; + *p = *q++; + if (*p != 0) + p++; + } + } + + return env; +} + /* This is run before init_cmdargs. */ diff --git a/src/lisp.h b/src/lisp.h index 6e18433eaf..d20e69ff89 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4500,7 +4500,9 @@ extern void setup_process_coding_systems (Lisp_Object); # define CHILD_SETUP_ERROR_DESC "Doing vfork" #endif -extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, Lisp_Object); +extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, char *const *, + Lisp_Object); +extern char *const *make_environment_block (Lisp_Object); extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); diff --git a/src/process.c b/src/process.c index b82942d42d..c579078c1c 100644 --- a/src/process.c +++ b/src/process.c @@ -2124,8 +2124,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (!EQ (p->command, Qt)) add_process_read_fd (inchannel); + ptrdiff_t count = SPECPDL_INDEX (); + /* This may signal an error. */ setup_process_coding_systems (process); + char *const *env = make_environment_block (current_dir); block_input (); block_child_signal (&oldset); @@ -2139,6 +2142,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) int volatile forkout_volatile = forkout; int volatile forkerr_volatile = forkerr; struct Lisp_Process *p_volatile = p; + char *const *volatile env_volatile = env; #ifdef DARWIN_OS /* Darwin doesn't let us run setsid after a vfork, so use fork when @@ -2163,6 +2167,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) forkout = forkout_volatile; forkerr = forkerr_volatile; p = p_volatile; + env = env_volatile; pty_flag = p->pty_flag; @@ -2254,9 +2259,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (forkerr < 0) forkerr = forkout; #ifdef WINDOWSNT - pid = child_setup (forkin, forkout, forkerr, new_argv, current_dir); + pid = child_setup (forkin, forkout, forkerr, new_argv, env, current_dir); #else /* not WINDOWSNT */ - child_setup (forkin, forkout, forkerr, new_argv, current_dir); + child_setup (forkin, forkout, forkerr, new_argv, env, current_dir); #endif /* not WINDOWSNT */ } @@ -2271,6 +2276,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) unblock_child_signal (&oldset); unblock_input (); + /* Environment block no longer needed. */ + unbind_to (count, Qnil); + if (pid < 0) report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, vfork_errno); else commit 3cbd4169d6dd370b4fa8180fc2adfbf426f57837 Author: Philipp Stephani Date: Wed Dec 23 12:00:46 2020 +0100 Reject filenames containing NUL bytes. Such filenames are dangerous, as Emacs would silently only use the part up to the first NUL byte. Reject them explicitly instead. * src/coding.c (encode_file_name_1): New helper function. (encode_file_name): Check that encoded filename doesn't contain a NUL byte. (syms_of_coding): Define 'filenamep' symbol. * test/src/fileio-tests.el (fileio-tests/null-character): New unit test. * etc/NEWS: Document change. diff --git a/etc/NEWS b/etc/NEWS index 92493b70a0..dee0a37727 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2212,6 +2212,10 @@ presented to users or passed on to other applications. ** 'start-process-shell-command' and 'start-file-process-shell-command' do not support the old calling conventions any longer. +** Functions operating on local filenames now check that the filenames +don't contain any NUL bytes. This avoids subtle bugs caused by +silently using only the part of the filename until the first NUL byte. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/src/coding.c b/src/coding.c index 1afa4aa474..8c2443889d 100644 --- a/src/coding.c +++ b/src/coding.c @@ -10354,8 +10354,8 @@ decode_file_name (Lisp_Object fname) #endif } -Lisp_Object -encode_file_name (Lisp_Object fname) +static Lisp_Object +encode_file_name_1 (Lisp_Object fname) { /* This is especially important during bootstrap and dumping, when file-name encoding is not yet known, and therefore any non-ASCII @@ -10380,6 +10380,19 @@ encode_file_name (Lisp_Object fname) #endif } +Lisp_Object +encode_file_name (Lisp_Object fname) +{ + Lisp_Object encoded = encode_file_name_1 (fname); + /* No system accepts NUL bytes in filenames. Allowing them can + cause subtle bugs because the system would silently use a + different filename than expected. Perform this check after + encoding to not miss NUL bytes introduced through encoding. */ + CHECK_TYPE (memchr (SSDATA (encoded), '\0', SBYTES (encoded)) == NULL, + Qfilenamep, fname); + return encoded; +} + DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string, 2, 4, 0, doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result. @@ -11780,6 +11793,7 @@ syms_of_coding (void) DEFSYM (Qignored, "ignored"); DEFSYM (Qutf_8_string_p, "utf-8-string-p"); + DEFSYM (Qfilenamep, "filenamep"); defsubr (&Scoding_system_p); defsubr (&Sread_coding_system); diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index ed381d151e..8d46abf342 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -155,3 +155,9 @@ Also check that an encoding error can appear in a symlink." (write-region "hello\n" nil f nil 'silent) (should-error (insert-file-contents f) :type 'circular-list) (delete-file f))) + +(ert-deftest fileio-tests/null-character () + (should-error (file-exists-p "/foo\0bar") + :type 'wrong-type-argument)) + +;;; fileio-tests.el ends here commit 3edc4fd53ff9e1355da2371400aac4d5897ca190 Author: Philipp Stephani Date: Wed Dec 23 11:43:37 2020 +0100 Remove an unused parameter from 'child_setup' function. * src/callproc.c (child_setup): Remove unused SET_PGRP parameter. * src/callproc.c (call_process): * src/process.c (create_process): Fix all callers. diff --git a/src/callproc.c b/src/callproc.c index 4bca1e5ebd..5c5a2bb892 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -542,7 +542,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, } #ifdef MSDOS /* MW, July 1993 */ - status = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + status = child_setup (filefd, fd_output, fd_error, new_argv, current_dir); if (status < 0) { @@ -589,7 +589,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, block_child_signal (&oldset); #ifdef WINDOWSNT - pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + pid = child_setup (filefd, fd_output, fd_error, new_argv, current_dir); #else /* not WINDOWSNT */ /* vfork, and prevent local vars from being clobbered by the vfork. */ @@ -646,7 +646,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, signal (SIGPROF, SIG_DFL); #endif - child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + child_setup (filefd, fd_output, fd_error, new_argv, current_dir); } #endif /* not WINDOWSNT */ @@ -1205,8 +1205,6 @@ exec_failed (char const *name, int err) Initialize inferior's priority, pgrp, connected dir and environment. then exec another program based on new_argv. - If SET_PGRP, put the subprocess into a separate process group. - CURRENT_DIR is an elisp string giving the path of the current directory the subprocess should have. Since we can't really signal a decent error from within the child, this should be verified as an @@ -1217,7 +1215,7 @@ exec_failed (char const *name, int err) On MS-DOS, either return an exit status or signal an error. */ CHILD_SETUP_TYPE -child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, +child_setup (int in, int out, int err, char **new_argv, Lisp_Object current_dir) { char **env; diff --git a/src/lisp.h b/src/lisp.h index e83304462f..6e18433eaf 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4500,7 +4500,7 @@ extern void setup_process_coding_systems (Lisp_Object); # define CHILD_SETUP_ERROR_DESC "Doing vfork" #endif -extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, bool, Lisp_Object); +extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, Lisp_Object); extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); diff --git a/src/process.c b/src/process.c index 9efefb1de7..b82942d42d 100644 --- a/src/process.c +++ b/src/process.c @@ -2254,9 +2254,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (forkerr < 0) forkerr = forkout; #ifdef WINDOWSNT - pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir); + pid = child_setup (forkin, forkout, forkerr, new_argv, current_dir); #else /* not WINDOWSNT */ - child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir); + child_setup (forkin, forkout, forkerr, new_argv, current_dir); #endif /* not WINDOWSNT */ }