commit 93d54ba104bf85d487eb8e90a4857789e0c9a210 (HEAD, refs/remotes/origin/master) Author: Lars Magne Ingebrigtsen Date: Tue Apr 5 10:28:09 2016 +0200 Inhibit querying for the encoding of the headers when resending * lisp/gnus/message.el (message-resend): Inhibit querying for the encoding of the headers when resending. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index d4313e0..14d8d30 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -7637,6 +7637,9 @@ is for the internal use." (let ((case-fold-search t)) (re-search-forward "^mime-version:" nil t))) (message-inhibit-ecomplete t) + ;; We don't want smtpmail.el to encode anything, either. + (sendmail-coding-system 'raw-text) + (select-safe-coding-system-function nil) message-required-mail-headers message-generate-hashcash rfc2047-encode-encoded-words) commit e11b41ec61e8857f0a0c925dd000a0bad9e124b3 Author: Paul Eggert Date: Mon Apr 4 22:34:01 2016 -0700 ; Fix typo in previous patch. diff --git a/src/coding.c b/src/coding.c index bcedd7f..17cb77e 100644 --- a/src/coding.c +++ b/src/coding.c @@ -8420,7 +8420,7 @@ Lisp_Object from_unicode_buffer (const wchar_t *wstr) { /* We get one of the two final null bytes for free. */ - prtdiff_t len = 1 + sizeof (wchar_t) * wcslen (wstr); + ptrdiff_t len = 1 + sizeof (wchar_t) * wcslen (wstr); AUTO_STRING_WITH_LEN (str, (char *) wstr, len); return from_unicode (str); } commit b4c7869e5e1bb0bb33379b25ff830e721761a7bf Author: Paul Eggert Date: Mon Apr 4 17:04:58 2016 -0700 Prefer AUTO_STRING_WITH_LEN to make_formatted_string * src/buffer.c (Fgenerate_new_buffer_name): * src/filelock.c (get_boot_time): * src/minibuf.c (get_minibuffer): * src/process.c (make_process): * src/xdisp.c (ensure_echo_area_buffers): Prefer AUTO_STRING_WITH_LEN + sprintf to make_formatted_string when either will do. diff --git a/src/buffer.c b/src/buffer.c index 62b0bc8..0e5e64f 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1051,44 +1051,36 @@ it is in the sequence to be tried) even if a buffer with that name exists. If NAME begins with a space (i.e., a buffer that is not normally visible to users), then if buffer NAME already exists a random number is first appended to NAME, to speed up finding a non-existent buffer. */) - (register Lisp_Object name, Lisp_Object ignore) + (Lisp_Object name, Lisp_Object ignore) { - register Lisp_Object gentemp, tem, tem2; - ptrdiff_t count; - char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"]; + Lisp_Object genbase; CHECK_STRING (name); - tem = Fstring_equal (name, ignore); - if (!NILP (tem)) - return name; - tem = Fget_buffer (name); - if (NILP (tem)) + if (!NILP (Fstring_equal (name, ignore)) || NILP (Fget_buffer (name))) return name; - if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */ + if (SREF (name, 0) != ' ') /* See bug#1229. */ + genbase = name; + else { /* Note fileio.c:make_temp_name does random differently. */ - tem2 = concat2 (name, make_formatted_string - (number, "-%"pI"d", - XFASTINT (Frandom (make_number (999999))))); - tem = Fget_buffer (tem2); - if (NILP (tem)) - return tem2; + char number[sizeof "-999999"]; + int i = XFASTINT (Frandom (make_number (999999))); + AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i)); + genbase = concat2 (name, lnumber); + if (NILP (Fget_buffer (genbase))) + return genbase; } - else - tem2 = name; - count = 1; - while (1) + for (ptrdiff_t count = 1; ; count++) { - gentemp = concat2 (tem2, make_formatted_string - (number, "<%"pD"d>", ++count)); - tem = Fstring_equal (gentemp, ignore); - if (!NILP (tem)) - return gentemp; - tem = Fget_buffer (gentemp); - if (NILP (tem)) + char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"]; + AUTO_STRING_WITH_LEN (lnumber, number, + sprintf (number, "<%"pD"d>", count)); + Lisp_Object gentemp = concat2 (genbase, lnumber); + if (!NILP (Fstring_equal (gentemp, ignore)) + || NILP (Fget_buffer (gentemp))) return gentemp; } } diff --git a/src/filelock.c b/src/filelock.c index 4c5d72d..c58484a 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -191,14 +191,11 @@ get_boot_time (void) /* If we did not find a boot time in wtmp, look at wtmp, and so on. */ for (counter = 0; counter < 20 && ! boot_time; counter++) { + Lisp_Object filename = Qnil; + bool delete_flag = false; char cmd_string[sizeof WTMP_FILE ".19.gz"]; - Lisp_Object tempname, filename; - bool delete_flag = 0; - - filename = Qnil; - - tempname = make_formatted_string - (cmd_string, "%s.%d", WTMP_FILE, counter); + AUTO_STRING_WITH_LEN (tempname, cmd_string, + sprintf (cmd_string, "%s.%d", WTMP_FILE, counter)); if (! NILP (Ffile_exists_p (tempname))) filename = tempname; else @@ -218,7 +215,7 @@ get_boot_time (void) CALLN (Fcall_process, build_string ("gzip"), Qnil, list2 (QCfile, filename), Qnil, build_string ("-cd"), tempname); - delete_flag = 1; + delete_flag = true; } } diff --git a/src/minibuf.c b/src/minibuf.c index 41814c2..644e527 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -742,27 +742,25 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, } /* Return a buffer to be used as the minibuffer at depth `depth'. - depth = 0 is the lowest allowed argument, and that is the value - used for nonrecursive minibuffer invocations. */ + depth = 0 is the lowest allowed argument, and that is the value + used for nonrecursive minibuffer invocations. */ Lisp_Object get_minibuffer (EMACS_INT depth) { - Lisp_Object tail, num, buf; - char name[sizeof " *Minibuf-*" + INT_STRLEN_BOUND (EMACS_INT)]; - - XSETFASTINT (num, depth); - tail = Fnthcdr (num, Vminibuffer_list); + Lisp_Object tail = Fnthcdr (make_number (depth), Vminibuffer_list); if (NILP (tail)) { tail = list1 (Qnil); Vminibuffer_list = nconc2 (Vminibuffer_list, tail); } - buf = Fcar (tail); + Lisp_Object buf = Fcar (tail); if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf))) { - buf = Fget_buffer_create - (make_formatted_string (name, " *Minibuf-%"pI"d*", depth)); + static char const name_fmt[] = " *Minibuf-%"pI"d*"; + char name[sizeof name_fmt + INT_STRLEN_BOUND (EMACS_INT)]; + AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, depth)); + buf = Fget_buffer_create (lname); /* Although the buffer's name starts with a space, undo should be enabled in it. */ diff --git a/src/process.c b/src/process.c index 399cd8a..a006ca6 100644 --- a/src/process.c +++ b/src/process.c @@ -675,12 +675,7 @@ allocate_process (void) static Lisp_Object make_process (Lisp_Object name) { - register Lisp_Object val, tem, name1; - register struct Lisp_Process *p; - char suffix[sizeof "<>" + INT_STRLEN_BOUND (printmax_t)]; - printmax_t i; - - p = allocate_process (); + struct Lisp_Process *p = allocate_process (); /* Initialize Lisp data. Note that allocate_process initializes all Lisp data to nil, so do it only for slots which should not be nil. */ pset_status (p, Qrun); @@ -690,7 +685,7 @@ make_process (Lisp_Object name) non-Lisp data, so do it only for slots which should not be zero. */ p->infd = -1; p->outfd = -1; - for (i = 0; i < PROCESS_OPEN_FDS; i++) + for (int i = 0; i < PROCESS_OPEN_FDS; i++) p->open_fd[i] = -1; #ifdef HAVE_GNUTLS @@ -700,17 +695,22 @@ make_process (Lisp_Object name) /* If name is already in use, modify it until it is unused. */ - name1 = name; - for (i = 1; ; i++) + Lisp_Object name1 = name; + for (printmax_t i = 1; ; i++) { - tem = Fget_process (name1); - if (NILP (tem)) break; - name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i)); + Lisp_Object tem = Fget_process (name1); + if (NILP (tem)) + break; + char const suffix_fmt[] = "<%"pMd">"; + char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)]; + AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i)); + name1 = concat2 (name, lsuffix); } name = name1; pset_name (p, name); pset_sentinel (p, Qinternal_default_process_sentinel); pset_filter (p, Qinternal_default_process_filter); + Lisp_Object val; XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; diff --git a/src/xdisp.c b/src/xdisp.c index 9b7ac3c..4f33c0d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10528,25 +10528,21 @@ update_echo_area (void) static void ensure_echo_area_buffers (void) { - int i; - - for (i = 0; i < 2; ++i) + for (int i = 0; i < 2; i++) if (!BUFFERP (echo_buffer[i]) || !BUFFER_LIVE_P (XBUFFER (echo_buffer[i]))) { - char name[30]; - Lisp_Object old_buffer; - int j; - - old_buffer = echo_buffer[i]; - echo_buffer[i] = Fget_buffer_create - (make_formatted_string (name, " *Echo Area %d*", i)); + Lisp_Object old_buffer = echo_buffer[i]; + static char const name_fmt[] = " *Echo Area %d*"; + char name[sizeof name_fmt + INT_STRLEN_BOUND (int)]; + AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, i)); + echo_buffer[i] = Fget_buffer_create (lname); bset_truncate_lines (XBUFFER (echo_buffer[i]), Qnil); /* to force word wrap in echo area - it was decided to postpone this*/ /* XBUFFER (echo_buffer[i])->word_wrap = Qt; */ - for (j = 0; j < 2; ++j) + for (int j = 0; j < 2; j++) if (EQ (old_buffer, echo_area_buffer[j])) echo_area_buffer[j] = echo_buffer[i]; } commit 3c623c26ae7d695746e05d8a2e16a67a6256b024 Author: Tao Fang Date: Mon Apr 4 22:21:21 2016 +0200 Allow URL using HTTPS proxies using CONNECT * lisp/url/url-http.el (url-http-find-free-connection): Allow using proxies (bug#11788). (url-http-end-of-document-sentinel): Ditto. (url-http): The protocol may change from http to https and vice versa. (url-https-proxy-connect): Allow using CONNECT proxies for https. diff --git a/etc/NEWS b/etc/NEWS index e6b18bf..6cc1c5a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1225,6 +1225,8 @@ plist will contain a :peer element that has the output of programmatically delete all cookies, or cookies from a specific domain. +*** The URL package now support https over proxies supporting CONNECT. + ** Tramp +++ diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 33f6d11..1fe9ac2 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -27,6 +27,7 @@ (require 'cl-lib) (require 'puny) +(require 'nsm) (eval-when-compile (require 'subr-x)) @@ -136,6 +137,8 @@ request.") (507 insufficient-storage "Insufficient storage")) "The HTTP return codes and their text.") +(defconst url-https-default-port 443 "Default HTTPS port.") + ;(eval-when-compile ;; These are all macros so that they are hidden from external sight ;; when the file is byte-compiled. @@ -197,7 +200,14 @@ request.") ;; `url-open-stream' needs a buffer in which to do things ;; like authentication. But we use another buffer afterwards. (unwind-protect - (let ((proc (url-open-stream host buf host port gateway-method))) + (let ((proc (url-open-stream host buf + (if url-using-proxy + (url-host url-using-proxy) + host) + (if url-using-proxy + (url-port url-using-proxy) + port) + gateway-method))) ;; url-open-stream might return nil. (when (processp proc) ;; Drop the temp buffer link before killing the buffer. @@ -477,6 +487,7 @@ work correctly." ) (declare-function gnutls-peer-status "gnutls.c" (proc)) +(declare-function gnutls-negotiate "gnutls.el") (defun url-http-parse-headers () "Parse and handle HTTP specific headers. @@ -925,7 +936,13 @@ should be shown to the user." (erase-buffer) (let ((url-request-method url-http-method) (url-request-extra-headers url-http-extra-headers) - (url-request-data url-http-data)) + (url-request-data url-http-data) + (url-using-proxy (url-find-proxy-for-url + url-current-object + (url-host url-current-object)))) + (when url-using-proxy + (setq url-using-proxy + (url-generic-parse-url url-using-proxy))) (url-http url-current-object url-callback-function url-callback-arguments (current-buffer))))) ((url-http-parse-headers) @@ -1209,17 +1226,20 @@ The return value of this function is the retrieval buffer." (nsm-noninteractive (or url-request-noninteractive (and (boundp 'url-http-noninteractive) url-http-noninteractive))) - (connection (url-http-find-free-connection host port gateway-method)) + (connection (url-http-find-free-connection (url-host url) + (url-port url) + gateway-method)) (mime-accept-string url-mime-accept-string) (buffer (or retry-buffer (generate-new-buffer - (format " *http %s:%d*" host port))))) + (format " *http %s:%d*" (url-host url) (url-port url)))))) (if (not connection) ;; Failed to open the connection for some reason (progn (kill-buffer buffer) (setq buffer nil) - (error "Could not create connection to %s:%d" host port)) + (error "Could not create connection to %s:%d" (url-host url) + (url-port url))) (with-current-buffer buffer (mm-disable-multibyte) (setq url-current-object url @@ -1275,13 +1295,72 @@ The return value of this function is the retrieval buffer." (set-process-sentinel connection 'url-http-async-sentinel)) (`failed ;; Asynchronous connection failed - (error "Could not create connection to %s:%d" host port)) + (error "Could not create connection to %s:%d" (url-host url) + (url-port url))) (_ - (set-process-sentinel connection - 'url-http-end-of-document-sentinel) - (process-send-string connection (url-http-create-request)))))) + (if (and url-http-proxy (string= "https" + (url-type url-current-object))) + (url-https-proxy-connect connection) + (set-process-sentinel connection + 'url-http-end-of-document-sentinel) + (process-send-string connection (url-http-create-request))))))) buffer)) +(defun url-https-proxy-connect (connection) + (setq url-http-after-change-function 'url-https-proxy-after-change-function) + (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n" + "Host: %s\r\n" + "\r\n") + (url-host url-current-object) + (or (url-port url-current-object) + url-https-default-port) + (url-host url-current-object)))) + +(defun url-https-proxy-after-change-function (st nd length) + (let* ((process-buffer (current-buffer)) + (proc (get-buffer-process process-buffer))) + (goto-char (point-min)) + (when (re-search-forward "^\r?\n" nil t) + (backward-char 1) + ;; Saw the end of the headers + (setq url-http-end-of-headers (set-marker (make-marker) (point))) + (url-http-parse-response) + (cond + ((null url-http-response-status) + ;; We got back a headerless malformed response from the + ;; server. + (url-http-activate-callback) + (error "Malformed response from proxy, fail!")) + ((= url-http-response-status 200) + (if (gnutls-available-p) + (condition-case e + (let ((tls-connection (gnutls-negotiate + :process proc + :hostname (url-host url-current-object) + :verify-error nil))) + ;; check certificate validity + (setq tls-connection + (nsm-verify-connection tls-connection + (url-host url-current-object) + (url-port url-current-object))) + (with-current-buffer process-buffer (erase-buffer)) + (set-process-buffer tls-connection process-buffer) + (setq url-http-after-change-function + 'url-http-wait-for-headers-change-function) + (set-process-filter tls-connection 'url-http-generic-filter) + (process-send-string tls-connection + (url-http-create-request))) + (gnutls-error + (url-http-activate-callback) + (error "gnutls-error: %s" e)) + (error + (url-http-activate-callback) + (error "error: %s" e))) + (error "error: gnutls support needed!"))) + (t + (url-http-activate-callback) + (message "error response: %d" url-http-response-status)))))) + (defun url-http-async-sentinel (proc why) ;; We are performing an asynchronous connection, and a status change ;; has occurred. @@ -1293,11 +1372,13 @@ The return value of this function is the retrieval buffer." (url-http-end-of-document-sentinel proc why)) ((string= (substring why 0 4) "open") (setq url-http-connection-opened t) - (condition-case error - (process-send-string proc (url-http-create-request)) - (file-error - (setq url-http-connection-opened nil) - (message "HTTP error: %s" error)))) + (if (and url-http-proxy (string= "https" (url-type url-current-object))) + (url-https-proxy-connect proc) + (condition-case error + (process-send-string proc (url-http-create-request)) + (file-error + (setq url-http-connection-opened nil) + (message "HTTP error: %s" error))))) (t (setf (car url-callback-arguments) (nconc (list :error (list 'error 'connection-failed why @@ -1458,7 +1539,6 @@ p3p ;; with url-http.el on systems with 8-character file names. (require 'tls) -(defconst url-https-default-port 443 "Default HTTPS port.") (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") ;; FIXME what is the point of this alias being an autoload? commit 17cb263adb7c37803140604f0a2e4df8a38fbcff Author: Paul Eggert Date: Mon Apr 4 10:30:41 2016 -0700 New C macro AUTO_STRING_WITH_LEN Put a bit less pressure on the garbage collector by defining a macro that is like AUTO_STRING but also allows null bytes in strings, and by extending AUTO_STRING to work with any unibyte string. * src/alloc.c (verify_ascii): Remove; all uses removed. AUTO_STRING can now be used on non-ASCII unibyte strings. * src/lisp.h (AUTO_STRING): Now allows non-ASCII unibyte strings. (AUTO_STRING_WITH_LEN): New macro. * src/coding.c (from_unicode_buffer): * src/editfns.c (format_time_string): * src/emacs-module.c (module_make_string, module_format_fun_env): * src/fileio.c (Fexpand_file_name): * src/font.c (font_parse_family_registry): * src/ftfont.c (ftfont_get_charset): * src/keymap.c (silly_event_symbol_error): * src/menu.c (single_menu_item): * src/sysdep.c (system_process_attributes): Use AUTO_STRING_WITH_LEN if possible. * src/emacs-module.c (module_make_function): * src/fileio.c (report_file_errno, report_file_notify_error): * src/fns.c (Flocale_info): * src/sysdep.c (system_process_attributes): Use AUTO_STRING if possible. This is doable more often now that AUTO_STRING works on any unibyte string. diff --git a/src/alloc.c b/src/alloc.c index 56a5354..c5a4f42 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7216,21 +7216,6 @@ die (const char *msg, const char *file, int line) #if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS -/* Debugging check whether STR is ASCII-only. */ - -const char * -verify_ascii (const char *str) -{ - const unsigned char *ptr = (unsigned char *) str, *end = ptr + strlen (str); - while (ptr < end) - { - int c = STRING_CHAR_ADVANCE (ptr); - if (!ASCII_CHAR_P (c)) - emacs_abort (); - } - return str; -} - /* Stress alloca with inconveniently sized requests and check whether all allocated areas may be used for Lisp_Object. */ diff --git a/src/coding.c b/src/coding.c index e72d7b7..bcedd7f 100644 --- a/src/coding.c +++ b/src/coding.c @@ -8419,11 +8419,10 @@ from_unicode (Lisp_Object str) Lisp_Object from_unicode_buffer (const wchar_t *wstr) { - return from_unicode ( - make_unibyte_string ( - (char *) wstr, - /* we get one of the two final 0 bytes for free. */ - 1 + sizeof (wchar_t) * wcslen (wstr))); + /* We get one of the two final null bytes for free. */ + prtdiff_t len = 1 + sizeof (wchar_t) * wcslen (wstr); + AUTO_STRING_WITH_LEN (str, (char *) wstr, len); + return from_unicode (str); } wchar_t * diff --git a/src/editfns.c b/src/editfns.c index 664a59e..a2d5673 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2042,7 +2042,6 @@ format_time_string (char const *format, ptrdiff_t formatlen, char *buf = buffer; ptrdiff_t size = sizeof buffer; size_t len; - Lisp_Object bufstring; int ns = t.tv_nsec; USE_SAFE_ALLOCA; @@ -2074,9 +2073,11 @@ format_time_string (char const *format, ptrdiff_t formatlen, } xtzfree (tz); - bufstring = make_unibyte_string (buf, len); + AUTO_STRING_WITH_LEN (bufstring, buf, len); + Lisp_Object result = code_convert_string_norecord (bufstring, + Vlocale_coding_system, 0); SAFE_FREE (); - return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0); + return result; } DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, diff --git a/src/emacs-module.c b/src/emacs-module.c index b57636e..724d24a 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -395,11 +395,13 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, envptr->data = data; Lisp_Object envobj = make_save_ptr (envptr); - Lisp_Object doc - = (documentation - ? code_convert_string_norecord (build_unibyte_string (documentation), - Qutf_8, false) - : Qnil); + Lisp_Object doc = Qnil; + if (documentation) + { + AUTO_STRING (unibyte_doc, documentation); + doc = code_convert_string_norecord (unibyte_doc, Qutf_8, false); + } + /* FIXME: Use a bytecompiled object, or even better a subr. */ Lisp_Object ret = list4 (Qlambda, list2 (Qand_rest, Qargs), @@ -537,7 +539,7 @@ static emacs_value module_make_string (emacs_env *env, const char *str, ptrdiff_t length) { MODULE_FUNCTION_BEGIN (module_nil); - Lisp_Object lstr = make_unibyte_string (str, length); + AUTO_STRING_WITH_LEN (lstr, str, length); return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false)); } @@ -992,10 +994,12 @@ module_format_fun_env (const struct module_fun_env *env) ? exprintf (&buf, &bufsize, buffer, -1, "#", sym, path) : sprintf (buffer, noaddr_format, env->subr)); - Lisp_Object unibyte_result = make_unibyte_string (buffer, size); + AUTO_STRING_WITH_LEN (unibyte_result, buffer, size); + Lisp_Object result = code_convert_string_norecord (unibyte_result, + Qutf_8, false); if (buf != buffer) xfree (buf); - return code_convert_string_norecord (unibyte_result, Qutf_8, false); + return result; } diff --git a/src/fileio.c b/src/fileio.c index dfab3de..0a14d64 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -187,9 +187,9 @@ report_file_errno (char const *string, Lisp_Object name, int errorno) Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name); synchronize_system_messages_locale (); char *str = strerror (errorno); + AUTO_STRING (unibyte_str, str); Lisp_Object errstring - = code_convert_string_norecord (build_unibyte_string (str), - Vlocale_coding_system, 0); + = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0); Lisp_Object errdata = Fcons (errstring, data); if (errorno == EEXIST) @@ -217,9 +217,9 @@ report_file_notify_error (const char *string, Lisp_Object name) Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name); synchronize_system_messages_locale (); char *str = strerror (errno); + AUTO_STRING (unibyte_str, str); Lisp_Object errstring - = code_convert_string_norecord (build_unibyte_string (str), - Vlocale_coding_system, 0); + = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0); Lisp_Object errdata = Fcons (errstring, data); xsignal (Qfile_notify_error, Fcons (build_string (string), errdata)); @@ -1015,11 +1015,9 @@ filesystem tree, not (expand-file-name ".." dirname). */) /* Drive must be set, so this is okay. */ if (strcmp (nm - 2, SSDATA (name)) != 0) { - char temp[] = " :"; - name = make_specified_string (nm, -1, p - nm, multibyte); - temp[0] = DRIVE_LETTER (drive); - AUTO_STRING (drive_prefix, temp); + char temp[] = { DRIVE_LETTER (drive), ':', 0 }; + AUTO_STRING_WITH_LEN (drive_prefix, temp, 2); name = concat2 (drive_prefix, name); } #ifdef WINDOWSNT diff --git a/src/fns.c b/src/fns.c index 114a556..1ace3bb 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2999,7 +2999,6 @@ The data read from the system are decoded using `locale-coding-system'. */) { char *str = NULL; #ifdef HAVE_LANGINFO_CODESET - Lisp_Object val; if (EQ (item, Qcodeset)) { str = nl_langinfo (CODESET); @@ -3015,7 +3014,7 @@ The data read from the system are decoded using `locale-coding-system'. */) for (i = 0; i < 7; i++) { str = nl_langinfo (days[i]); - val = build_unibyte_string (str); + AUTO_STRING (val, str); /* Fixme: Is this coding system necessarily right, even if it is consistent with CODESET? If not, what to do? */ ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system, @@ -3035,7 +3034,7 @@ The data read from the system are decoded using `locale-coding-system'. */) for (i = 0; i < 12; i++) { str = nl_langinfo (months[i]); - val = build_unibyte_string (str); + AUTO_STRING (val, str); ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system, 0)); } diff --git a/src/font.c b/src/font.c index 2519599..6dbda40 100644 --- a/src/font.c +++ b/src/font.c @@ -1771,7 +1771,8 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec p1 = strchr (p0, '-'); if (! p1) { - AUTO_STRING (extra, (&"*-*"[len && p0[len - 1] == '*'])); + bool asterisk = len && p0[len - 1] == '*'; + AUTO_STRING_WITH_LEN (extra, &"*-*"[asterisk], 3 - asterisk); registry = concat2 (registry, extra); } registry = Fdowncase (registry); diff --git a/src/ftfont.c b/src/ftfont.c index 7285aee..1ae3f88 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -568,7 +568,6 @@ ftfont_get_charset (Lisp_Object registry) char *str = SSDATA (SYMBOL_NAME (registry)); USE_SAFE_ALLOCA; char *re = SAFE_ALLOCA (SBYTES (SYMBOL_NAME (registry)) * 2 + 1); - Lisp_Object regexp; int i, j; for (i = j = 0; i < SBYTES (SYMBOL_NAME (registry)); i++, j++) @@ -582,13 +581,13 @@ ftfont_get_charset (Lisp_Object registry) re[j] = '.'; } re[j] = '\0'; - regexp = make_unibyte_string (re, j); - SAFE_FREE (); + AUTO_STRING_WITH_LEN (regexp, re, j); for (i = 0; fc_charset_table[i].name; i++) if (fast_c_string_match_ignore_case (regexp, fc_charset_table[i].name, strlen (fc_charset_table[i].name)) >= 0) break; + SAFE_FREE (); if (! fc_charset_table[i].name) return -1; if (! fc_charset_table[i].fc_charset) diff --git a/src/keymap.c b/src/keymap.c index 8ab4c6c..eef1dcd 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1303,7 +1303,7 @@ silly_event_symbol_error (Lisp_Object c) *p = 0; c = reorder_modifiers (c); - AUTO_STRING (new_mods_string, new_mods); + AUTO_STRING_WITH_LEN (new_mods_string, new_mods, p - new_mods); keystring = concat2 (new_mods_string, XCDR (assoc)); error ("To bind the key %s, use [?%s], not [%s]", diff --git a/src/lisp.h b/src/lisp.h index 65335fb..170da67 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4609,27 +4609,29 @@ enum STACK_CONS (d, Qnil)))) \ : list4 (a, b, c, d)) -/* Check whether stack-allocated strings are ASCII-only. */ +/* Declare NAME as an auto Lisp string if possible, a GC-based one if not. + Take its unibyte value from the null-terminated string STR, + an expression that should not have side effects. + STR's value is not necessarily copied. The resulting Lisp string + should not be modified or made visible to user code. */ -#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS -extern const char *verify_ascii (const char *); -#else -# define verify_ascii(str) (str) -#endif +#define AUTO_STRING(name, str) \ + AUTO_STRING_WITH_LEN (name, str, strlen (str)) /* Declare NAME as an auto Lisp string if possible, a GC-based one if not. - Take its value from STR. STR is not necessarily copied and should - contain only ASCII characters. The resulting Lisp string should - not be modified or made visible to user code. */ + Take its unibyte value from the null-terminated string STR with length LEN. + STR may have side effects and may contain null bytes. + STR's value is not necessarily copied. The resulting Lisp string + should not be modified or made visible to user code. */ -#define AUTO_STRING(name, str) \ +#define AUTO_STRING_WITH_LEN(name, str, len) \ Lisp_Object name = \ (USE_STACK_STRING \ ? (make_lisp_ptr \ ((&(union Aligned_String) \ - {{strlen (str), -1, 0, (unsigned char *) verify_ascii (str)}}.s), \ - Lisp_String)) \ - : build_string (verify_ascii (str))) + {{len, -1, 0, (unsigned char *) (str)}}.s), \ + Lisp_String)) \ + : make_unibyte_string (str, len)) /* Loop over all tails of a list, checking for cycles. FIXME: Make tortoise and n internal declarations. diff --git a/src/menu.c b/src/menu.c index 9504cee..737f2b5 100644 --- a/src/menu.c +++ b/src/menu.c @@ -408,7 +408,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk if (prefix) { - AUTO_STRING (prefix_obj, prefix); + AUTO_STRING_WITH_LEN (prefix_obj, prefix, 4); item_string = concat2 (prefix_obj, item_string); } } diff --git a/src/sysdep.c b/src/sysdep.c index 67c9bd9..1e3b9f1 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3050,7 +3050,7 @@ system_process_attributes (Lisp_Object pid) struct timespec tnow, tstart, tboot, telapsed, us_time; double pcpu, pmem; Lisp_Object attrs = Qnil; - Lisp_Object cmd_str, decoded_cmd; + Lisp_Object decoded_cmd; ptrdiff_t count; CHECK_NUMBER_OR_FLOAT (pid); @@ -3107,7 +3107,7 @@ system_process_attributes (Lisp_Object pid) else q = NULL; /* Command name is encoded in locale-coding-system; decode it. */ - cmd_str = make_unibyte_string (cmd, cmdsize); + AUTO_STRING_WITH_LEN (cmd_str, cmd, cmdsize); decoded_cmd = code_convert_string_norecord (cmd_str, Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); @@ -3240,7 +3240,7 @@ system_process_attributes (Lisp_Object pid) sprintf (cmdline, "[%.*s]", cmdsize, cmd); } /* Command line is encoded in locale-coding-system; decode it. */ - cmd_str = make_unibyte_string (q, nread); + AUTO_STRING_WITH_LEN (cmd_str, q, nread); decoded_cmd = code_convert_string_norecord (cmd_str, Vlocale_coding_system, 0); unbind_to (count, Qnil); @@ -3375,13 +3375,13 @@ system_process_attributes (Lisp_Object pid) make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), attrs); - decoded_cmd = (code_convert_string_norecord - (build_unibyte_string (pinfo.pr_fname), - Vlocale_coding_system, 0)); + AUTO_STRING (fname, pinfo.pr_fname); + decoded_cmd = code_convert_string_norecord (fname, + Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); - decoded_cmd = (code_convert_string_norecord - (build_unibyte_string (pinfo.pr_psargs), - Vlocale_coding_system, 0)); + AUTO_STRING (psargs, pinfo.pr_psargs); + decoded_cmd = code_convert_string_norecord (psargs, + Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); } unbind_to (count, Qnil); @@ -3446,9 +3446,8 @@ system_process_attributes (Lisp_Object pid) if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); - decoded_comm = (code_convert_string_norecord - (build_unibyte_string (proc.ki_comm), - Vlocale_coding_system, 0)); + AUTO_STRING (comm, proc.ki_comm); + decoded_comm = code_convert_string_norecord (comm, Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs); { @@ -3559,10 +3558,9 @@ system_process_attributes (Lisp_Object pid) args[i] = ' '; } - decoded_comm = - (code_convert_string_norecord - (build_unibyte_string (args), - Vlocale_coding_system, 0)); + AUTO_STRING (comm, args); + decoded_comm = code_convert_string_norecord (comm, + Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qargs, decoded_comm), attrs); } commit 0322457e2bec0b9409a03887a8235dbe14e357f4 Author: Paul Eggert Date: Mon Apr 4 09:42:58 2016 -0700 Port redirect-debugging-output to MS-Windows Suggested by Eli Zaretskii in: http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00037.html * src/print.c [WINDOWSNT]: Include sys/socket.h. * src/w32.c (sys_dup2): Work around problem with MS-Windows _dup2. diff --git a/src/print.c b/src/print.c index db2918f..83edbb6 100644 --- a/src/print.c +++ b/src/print.c @@ -38,6 +38,10 @@ along with GNU Emacs. If not, see . */ #include #include +#ifdef WINDOWSNT +# include /* for F_DUPFD_CLOEXEC */ +#endif + struct terminal; /* Avoid actual stack overflow in print. */ diff --git a/src/w32.c b/src/w32.c index 3f4ac88..94aa7d8 100644 --- a/src/w32.c +++ b/src/w32.c @@ -8181,17 +8181,33 @@ sys_dup2 (int src, int dst) return -1; } - /* make sure we close the destination first if it's a pipe or socket */ - if (src != dst && fd_info[dst].flags != 0) + /* MS _dup2 seems to have weird side effect when invoked with 2 + identical arguments: an attempt to fclose the corresponding stdio + stream after that hangs (we do close standard streams in + init_ntproc). Attempt to avoid that by not calling _dup2 that + way: if SRC is valid, we know that dup2 should be a no-op, so do + nothing and return DST. */ + if (src == dst) + { + if ((HANDLE)_get_osfhandle (src) == INVALID_HANDLE_VALUE) + { + errno = EBADF; + return -1; + } + return dst; + } + + /* Make sure we close the destination first if it's a pipe or socket. */ + if (fd_info[dst].flags != 0) sys_close (dst); rc = _dup2 (src, dst); if (rc == 0) { - /* duplicate our internal info as well */ + /* Duplicate our internal info as well. */ fd_info[dst] = fd_info[src]; } - return rc; + return rc == 0 ? dst : rc; } int commit 6bccb19c9bef1189c8e853ff7cc16b889a3a57e3 Author: Paul Eggert Date: Mon Apr 4 09:36:30 2016 -0700 Port redirect-debugging-output to non-GNU/Linux Problem reported by Kylie McClain for musl in: http://lists.gnu.org/archive/html/emacs-devel/2016-03/msg01592.html * etc/DEBUG, etc/NEWS: Mention this. * src/callproc.c (child_setup) [!MSDOS]: * src/dispnew.c (init_display): * src/emacs.c (main, Fdaemon_initialized): * src/minibuf.c (read_minibuf_noninteractive): * src/regex.c (xmalloc, xrealloc): Prefer symbolic names like STDERR_FILENO to magic numbers like 2, to make file-descriptor manipulation easier to follow. * src/emacs.c (relocate_fd) [!WINDOWSNT]: Remove; no longer needed now that we make sure stdin, stdout and stderr are open. All uses removed. (main): Make sure standard FDs are OK. Prefer symbolic names like EXIT_FAILURE to magic numbers like 1. Use bool for boolean. * src/lisp.h (init_standard_fds): New decl. * src/print.c (WITH_REDIRECT_DEBUGGING_OUTPUT) [GNU_LINUX]: Remove; no longer needed. (Fredirect_debugging_output): Define on all platforms, not just GNU/Linux. Redirect file descriptor, not stream, so that the code works even if stderr is not an lvalue. Report an error if the file arg is neither a string nor nil. (syms_of_print): Always define redirect-debugging-output. * src/sysdep.c (force_open, init_standard_fds): New functions. diff --git a/etc/DEBUG b/etc/DEBUG index eef67da..d5d5829 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -144,8 +144,8 @@ These are displayed as integer values (or structures, if you used the "--enable-check-lisp-object-type" option at configure time) that are hard to interpret, especially if they represent long lists. You can use the 'pp' command to display them in their Lisp form. That command -displays its output on the standard error stream (on GNU/Linux, you -can redirect that to a file using "M-x redirect-debugging-output"). +displays its output on the standard error stream, which you +can redirect to a file using "M-x redirect-debugging-output". This means that if you attach GDB to a running Emacs that was invoked from a desktop icon, chances are you will not see the output at all, or it will wind up in an obscure place (check the documentation of @@ -250,8 +250,8 @@ To see the current value of a Lisp Variable, use 'pv variable'. These commands send their output to stderr; if that is closed or redirected to some file you don't know, you won't see their output. This is particularly so for Emacs invoked on MS-Windows from the -desktop shortcut. On GNU/Linux, you can use the command -'redirect-debugging-output' to redirect stderr to a file. +desktop shortcut. You can use the command 'redirect-debugging-output' +to redirect stderr to a file. Note: It is not a good idea to try 'pr', 'pp', or 'pv' if you know that Emacs is in deep trouble: its stack smashed (e.g., if it encountered SIGSEGV diff --git a/etc/NEWS b/etc/NEWS index 6ef196a..e6b18bf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -208,6 +208,9 @@ permanent and documented, and may be used by Lisp programs. Its value is a list of currently open parenthesis positions, starting with the outermost parenthesis. +** The function 'redirect-debugging-output' now works on platforms +other than GNU/Linux. + * Changes in Emacs 25.2 on Non-Free Operating Systems diff --git a/src/callproc.c b/src/callproc.c index db602f5..8578556 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1078,10 +1078,6 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r return unbind_to (count, val); } -#ifndef WINDOWSNT -static int relocate_fd (int fd, int minfd); -#endif - static char ** add_env (char **env, char **new_env, char *string) { @@ -1310,37 +1306,14 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, return cpid; #else /* not WINDOWSNT */ - /* Make sure that in, out, and err are not actually already in - descriptors zero, one, or two; this could happen if Emacs is - started with its standard in, out, or error closed, as might - happen under X. */ - { - int oin = in, oout = out; - - /* We have to avoid relocating the same descriptor twice! */ - - in = relocate_fd (in, 3); - - if (out == oin) - out = in; - else - out = relocate_fd (out, 3); - - if (err == oin) - err = in; - else if (err == oout) - err = out; - else - err = relocate_fd (err, 3); - } #ifndef MSDOS /* Redirect file descriptors and clear the close-on-exec flag on the redirected ones. IN, OUT, and ERR are close-on-exec so they need not be closed explicitly. */ - dup2 (in, 0); - dup2 (out, 1); - dup2 (err, 2); + dup2 (in, STDIN_FILENO); + dup2 (out, STDOUT_FILENO); + dup2 (err, STDERR_FILENO); setpgid (0, 0); tcsetpgrp (0, pid); @@ -1359,31 +1332,6 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, #endif /* not WINDOWSNT */ } -#ifndef WINDOWSNT -/* Move the file descriptor FD so that its number is not less than MINFD. - If the file descriptor is moved at all, the original is closed on MSDOS, - but not elsewhere as the caller will close it anyway. */ -static int -relocate_fd (int fd, int minfd) -{ - if (fd >= minfd) - return fd; - else - { - int new = fcntl (fd, F_DUPFD_CLOEXEC, minfd); - if (new == -1) - { - emacs_perror ("while setting up child"); - _exit (EXIT_CANCELED); - } -#ifdef MSDOS - emacs_close (fd); -#endif - return new; - } -} -#endif /* not WINDOWSNT */ - static bool getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value, ptrdiff_t *valuelen, Lisp_Object env) diff --git a/src/dispnew.c b/src/dispnew.c index 3a0532a..51caa5b 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6038,7 +6038,7 @@ init_display (void) #endif /* If no window system has been specified, try to use the terminal. */ - if (! isatty (0)) + if (! isatty (STDIN_FILENO)) fatal ("standard input is not a tty"); #ifdef WINDOWSNT diff --git a/src/emacs.c b/src/emacs.c index 95d1905..c21c9e3 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -721,6 +721,7 @@ main (int argc, char **argv) unexec_init_emacs_zone (); #endif + init_standard_fds (); atexit (close_output_streams); #ifdef HAVE_MODULES @@ -899,24 +900,25 @@ main (int argc, char **argv) char *term; if (argmatch (argv, argc, "-t", "--terminal", 4, &term, &skip_args)) { - int result; - emacs_close (0); - emacs_close (1); - result = emacs_open (term, O_RDWR, 0); - if (result < 0 || fcntl (0, F_DUPFD_CLOEXEC, 1) < 0) + emacs_close (STDIN_FILENO); + emacs_close (STDOUT_FILENO); + int result = emacs_open (term, O_RDWR, 0); + if (result != STDIN_FILENO + || (fcntl (STDIN_FILENO, F_DUPFD_CLOEXEC, STDOUT_FILENO) + != STDOUT_FILENO)) { char *errstring = strerror (errno); fprintf (stderr, "%s: %s: %s\n", argv[0], term, errstring); - exit (1); + exit (EXIT_FAILURE); } - if (! isatty (0)) + if (! isatty (STDIN_FILENO)) { fprintf (stderr, "%s: %s: not a tty\n", argv[0], term); - exit (1); + exit (EXIT_FAILURE); } fprintf (stderr, "Using %s\n", term); #ifdef HAVE_WINDOW_SYSTEM - inhibit_window_system = 1; /* -t => -nw */ + inhibit_window_system = true; /* -t => -nw */ #endif } else @@ -1209,7 +1211,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem /* Started from GUI? */ /* FIXME: Do the right thing if getenv returns NULL, or if chdir fails. */ - if (! inhibit_window_system && ! isatty (0) && ! ch_to_dir) + if (! inhibit_window_system && ! isatty (STDIN_FILENO) && ! ch_to_dir) chdir (getenv ("HOME")); if (skip_args < argc) { @@ -2357,9 +2359,9 @@ from the parent process and its tty file descriptors. */) /* Get rid of stdin, stdout and stderr. */ nfd = emacs_open ("/dev/null", O_RDWR, 0); err |= nfd < 0; - err |= dup2 (nfd, 0) < 0; - err |= dup2 (nfd, 1) < 0; - err |= dup2 (nfd, 2) < 0; + err |= dup2 (nfd, STDIN_FILENO) < 0; + err |= dup2 (nfd, STDOUT_FILENO) < 0; + err |= dup2 (nfd, STDERR_FILENO) < 0; err |= emacs_close (nfd) != 0; /* Closing the pipe will notify the parent that it can exit. diff --git a/src/lisp.h b/src/lisp.h index 7c8b452..65335fb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4248,6 +4248,7 @@ struct tty_display_info; struct terminal; /* Defined in sysdep.c. */ +extern void init_standard_fds (void); extern char *emacs_get_current_dir_name (void); extern void stuff_char (char c); extern void init_foreground_group (void); diff --git a/src/minibuf.c b/src/minibuf.c index 238a04a..41814c2 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -194,7 +194,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, int c; unsigned char hide_char = 0; struct emacs_tty etty; - bool etty_valid; + bool etty_valid IF_LINT (= false); /* Check, whether we need to suppress echoing. */ if (CHARACTERP (Vread_hide_char)) @@ -203,10 +203,10 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, /* Manipulate tty. */ if (hide_char) { - etty_valid = emacs_get_tty (fileno (stdin), &etty) == 0; + etty_valid = emacs_get_tty (STDIN_FILENO, &etty) == 0; if (etty_valid) - set_binary_mode (fileno (stdin), O_BINARY); - suppress_echo_on_tty (fileno (stdin)); + set_binary_mode (STDIN_FILENO, O_BINARY); + suppress_echo_on_tty (STDIN_FILENO); } fwrite (SDATA (prompt), 1, SBYTES (prompt), stdout); @@ -240,8 +240,8 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, fprintf (stdout, "\n"); if (etty_valid) { - emacs_set_tty (fileno (stdin), &etty, 0); - set_binary_mode (fileno (stdin), O_TEXT); + emacs_set_tty (STDIN_FILENO, &etty, 0); + set_binary_mode (STDIN_FILENO, O_TEXT); } } diff --git a/src/print.c b/src/print.c index 2b53d75..db2918f 100644 --- a/src/print.c +++ b/src/print.c @@ -775,15 +775,6 @@ debug_output_compilation_hack (bool x) print_output_debug_flag = x; } -#if defined (GNU_LINUX) - -/* This functionality is not vitally important in general, so we rely on - non-portable ability to use stderr as lvalue. */ - -#define WITH_REDIRECT_DEBUGGING_OUTPUT 1 - -static FILE *initial_stderr_stream = NULL; - DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output, 1, 2, "FDebug output file: \nP", @@ -793,30 +784,38 @@ Optional arg APPEND non-nil (interactively, with prefix arg) means append to existing target file. */) (Lisp_Object file, Lisp_Object append) { - if (initial_stderr_stream != NULL) - { - block_input (); - fclose (stderr); - unblock_input (); - } - stderr = initial_stderr_stream; - initial_stderr_stream = NULL; + /* If equal to STDERR_FILENO, stderr has not been duplicated and is OK as-is. + Otherwise, this is a close-on-exec duplicate of the original stderr. */ + static int stderr_dup = STDERR_FILENO; + int fd = stderr_dup; - if (STRINGP (file)) + if (! NILP (file)) { file = Fexpand_file_name (file, Qnil); - initial_stderr_stream = stderr; - stderr = emacs_fopen (SSDATA (file), NILP (append) ? "w" : "a"); - if (stderr == NULL) + + if (stderr_dup == STDERR_FILENO) { - stderr = initial_stderr_stream; - initial_stderr_stream = NULL; - report_file_error ("Cannot open debugging output stream", file); + int n = fcntl (STDERR_FILENO, F_DUPFD_CLOEXEC, STDERR_FILENO + 1); + if (n < 0) + report_file_error ("dup", file); + stderr_dup = n; } + + fd = emacs_open (SSDATA (ENCODE_FILE (file)), + (O_WRONLY | O_CREAT + | (! NILP (append) ? O_APPEND : O_TRUNC)), + 0666); + if (fd < 0) + report_file_error ("Cannot open debugging output stream", file); } + + fflush (stderr); + if (dup2 (fd, STDERR_FILENO) < 0) + report_file_error ("dup2", file); + if (fd != stderr_dup) + emacs_close (fd); return Qnil; } -#endif /* GNU_LINUX */ /* This is the interface for debugging printing. */ @@ -2305,9 +2304,7 @@ priorities. */); defsubr (&Sprint); defsubr (&Sterpri); defsubr (&Swrite_char); -#ifdef WITH_REDIRECT_DEBUGGING_OUTPUT defsubr (&Sredirect_debugging_output); -#endif DEFSYM (Qprint_escape_newlines, "print-escape-newlines"); DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte"); diff --git a/src/regex.c b/src/regex.c index d5c58ae..af37936 100644 --- a/src/regex.c +++ b/src/regex.c @@ -215,7 +215,7 @@ xmalloc (size_t size) void *val = malloc (size); if (!val && size) { - write (2, "virtual memory exhausted\n", 25); + write (STDERR_FILENO, "virtual memory exhausted\n", 25); exit (1); } return val; @@ -233,7 +233,7 @@ xrealloc (void *block, size_t size) val = realloc (block, size); if (!val && size) { - write (2, "virtual memory exhausted\n", 25); + write (STDERR_FILENO, "virtual memory exhausted\n", 25); exit (1); } return val; diff --git a/src/sysdep.c b/src/sysdep.c index 6154c13..67c9bd9 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -130,6 +130,35 @@ static const int baud_convert[] = 1800, 2400, 4800, 9600, 19200, 38400 }; +/* If FD is not already open, arrange for it to be open with FLAGS. */ +static void +force_open (int fd, int flags) +{ + if (dup2 (fd, fd) < 0 && errno == EBADF) + { + int n = open (NULL_DEVICE, flags); + if (n < 0 || (fd != n && (dup2 (n, fd) < 0 || emacs_close (n) != 0))) + { + emacs_perror (NULL_DEVICE); + exit (EXIT_FAILURE); + } + } +} + +/* Make sure stdin, stdout, and stderr are open to something, so that + their file descriptors are not hijacked by later system calls. */ +void +init_standard_fds (void) +{ + /* Open stdin for *writing*, and stdout and stderr for *reading*. + That way, any attempt to do normal I/O will result in an error, + just as if the files were closed, and the file descriptors will + not be reused by later opens. */ + force_open (STDIN_FILENO, O_WRONLY); + force_open (STDOUT_FILENO, O_RDONLY); + force_open (STDERR_FILENO, O_RDONLY); +} + /* Return the current working directory. The result should be freed with 'free'. Return NULL on errors. */ char *