From 5430d39930cee884e1434f91452241c26ae48692 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Wed, 26 Oct 2011 15:42:33 +0200 Subject: [PATCH 1/9] * lisp/term/w32-win.el (w32-default-color-map): Declare obsolete. * src/w32fns.c (w32_default_color_map): New function, extracted from Fw32_default_color_map. (Fw32_default_color_map, Fx_open_connection): Use it. --- etc/NEWS | 2 ++ lisp/ChangeLog | 4 ++++ lisp/term/w32-win.el | 1 + src/ChangeLog | 6 ++++++ src/w32fns.c | 15 ++++++++++----- 5 files changed, 23 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 58f3fa492e2..6e60f2a65f9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1351,6 +1351,8 @@ with the USER_LIBS build variable. ** New make target `dist' to create binary distribution for MS Windows. +** Function `w32-default-color-map' is now obsolete. + ** On Nextstep/OSX, the menu bar can be hidden by customizing ns-auto-hide-menu-bar. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 88248f00559..aa27ea3f97a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-10-26 Juanma Barranquero + + * term/w32-win.el (w32-default-color-map): Declare obsolete. + 2011-10-26 Michael Albinus * ido.el (ido-file-name-all-completions-1): Do not require diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index e4bf031d422..b7f2a69e77b 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -85,6 +85,7 @@ (define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1") (defvar w32-color-map) ;; defined in w32fns.c +(make-obsolete 'w32-default-color-map nil "24.1") (declare-function w32-send-sys-command "w32fns.c") (declare-function set-message-beep "w32console.c") diff --git a/src/ChangeLog b/src/ChangeLog index 854c4987be5..d68225070d7 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-10-26 Juanma Barranquero + + * w32fns.c (w32_default_color_map): New function, + extracted from Fw32_default_color_map. + (Fw32_default_color_map, Fx_open_connection): Use it. + 2011-10-25 Paul Eggert * dispextern.h (Fcontrolling_tty_p): New decl (Bug#6649 part 2). diff --git a/src/w32fns.c b/src/w32fns.c index f48e5764b4c..2ecd6e91533 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -635,9 +635,8 @@ colormap_t w32_color_map[] = {"LightGreen" , PALETTERGB (144,238,144)}, }; -DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, - 0, 0, 0, doc: /* Return the default color map. */) - (void) +static Lisp_Object +w32_default_color_map (void) { int i; colormap_t *pc = w32_color_map; @@ -658,6 +657,13 @@ DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, return (cmap); } +DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, + 0, 0, 0, doc: /* Return the default color map. */) + (void) +{ + return w32_default_color_map (); +} + static Lisp_Object w32_color_map_lookup (char *colorname) { @@ -683,7 +689,6 @@ w32_color_map_lookup (char *colorname) QUIT; } - UNBLOCK_INPUT; return ret; @@ -4768,7 +4773,7 @@ terminate Emacs if we can't open the connection. UNGCPRO; } if (NILP (Vw32_color_map)) - Vw32_color_map = Fw32_default_color_map (); + Vw32_color_map = w32_default_color_map (); /* Merge in system logical colors. */ add_system_logical_colors_to_map (&Vw32_color_map); From a7ef684b4660596dc65eca2448b8dba334122e88 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Wed, 26 Oct 2011 16:07:31 +0200 Subject: [PATCH 2/9] Fix typos. --- doc/emacs/ChangeLog | 4 ++++ doc/emacs/emacs.texi | 2 +- lisp/ChangeLog | 2 +- lisp/international/mule-conf.el | 2 +- lisp/org/ChangeLog | 2 +- lisp/textmodes/reftex.el | 2 +- src/ChangeLog | 2 +- 7 files changed, 10 insertions(+), 6 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 4b51486069c..9a501d38375 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,7 @@ +2011-10-26 Juanma Barranquero + + * emacs.texi (Top): Fix typo. + 2011-10-25 Glenn Morris * abbrevs.texi (Saving Abbrevs): diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index b25c09aa29d..55fdb9ec875 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -295,7 +295,7 @@ Help * Package Keywords:: Finding Lisp libraries by keywords (topics). * Language Help:: Help relating to international language support. * Misc Help:: Other help commands. -* Help Files:: Commands to display auxilliary help files. +* Help Files:: Commands to display auxiliary help files. * Help Echo:: Help on active text and tooltips (`balloon help'). The Mark and the Region diff --git a/lisp/ChangeLog b/lisp/ChangeLog index aa27ea3f97a..9ba25dc89ab 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,6 +1,6 @@ 2011-10-26 Juanma Barranquero - * term/w32-win.el (w32-default-color-map): Declare obsolete. + * term/w32-win.el (w32-default-color-map): Declare obsolete. (Bug#9785) 2011-10-26 Michael Albinus diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 9ba95e4d11a..870f2bece28 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -708,7 +708,7 @@ (define-charset-alias 'cp866u 'cp1125) ;; Fixme: C.f. iconv, http://czyborra.com/charsets/codepages.html -;; shows this as not ASCII comptaible, with various graphics in +;; shows this as not ASCII compatible, with various graphics in ;; 0x01-0x1F. (define-charset 'cp437 "CP437 (MS-DOS United States, Australia, New Zealand, South Africa)" diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 9fbeb9f1882..ae150621dc0 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1871,7 +1871,7 @@ * org-list.el (org-list-separating-blank-lines-number): Fix confusion between point and item beginning. Now, if no - information is avalaible, truly follow user preference when it + information is available, truly follow user preference when it inserts blank lines manually. (org-list-insert-item): Send correct argument to the preceding function. diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 6f6993980db..cef8a3d1548 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -1522,7 +1522,7 @@ Valid actions are: readable, restore, read, kill, write." ;;; (while all ;;; (when (and (eq (car (car all)) 'bof) ;;; (not (file-regular-p (nth 1 (car all))))) -;;; (message "File %s in saved parse info not avalable" (cdr (car all))) +;;; (message "File %s in saved parse info not available" (cdr (car all))) ;;; (error "File not found")) ;;; (setq all (cdr all)))) ) diff --git a/src/ChangeLog b/src/ChangeLog index d68225070d7..b3d8d4d10ca 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -2,7 +2,7 @@ * w32fns.c (w32_default_color_map): New function, extracted from Fw32_default_color_map. - (Fw32_default_color_map, Fx_open_connection): Use it. + (Fw32_default_color_map, Fx_open_connection): Use it. (Bug#9785) 2011-10-25 Paul Eggert From 6e724ca2c2e36dcd30803c314319b8faf8472e7d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 26 Oct 2011 13:27:51 -0400 Subject: [PATCH 3/9] * lisp/gnus/message.el: Don't insert TAB in headers with completion. (message-completion-function): Don't fallback on message-tab-body-function when message-completion-alist fails to find a completion. Fixes: debbugs:9158 --- lisp/gnus/ChangeLog | 8 +++++++- lisp/gnus/message.el | 6 +++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 8b4e993149e..7519252f037 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2011-10-26 Stefan Monnier + + * message.el (message-completion-function): Make sure + message-tab-body-function is not attempted if one of + message-completion-alist fails to find a completion (bug#9158). + 2011-10-26 Daiki Ueno * mml.el (mml-quote-region): Quote <#secure> tag. @@ -7,7 +13,7 @@ * gnus-cite.el (gnus-message-citation-mode): Doc fix (in Emacs 24, calling a minor mode from Lisp with nil arg enables it, so we have to - make the working a bit ambiguous here). + make the wording a bit ambiguous here). 2011-10-18 Teodor Zlatanov diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 948892d1e13..723f8fb72b5 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -7888,7 +7888,11 @@ those headers." (let ((mail-abbrev-mode-regexp (caar alist))) (not (mail-abbrev-in-expansion-header-p)))) (setq alist (cdr alist))) - (cdar alist))) + (when (cdar alist) + (lexical-let ((fun (cdar alist))) + ;; Even if completion fails, return a non-nil value, so as to avoid + ;; falling back to message-tab-body-function. + (lambda () (funcall fun) 'completion-attempted))))) (eval-and-compile (condition-case nil From 657d08d30a63536174fe9ec60b7f2cb8de541eb5 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 27 Oct 2011 02:59:21 +0200 Subject: [PATCH 4/9] src/image.c, src/w32*.c, lib-src/emacsclient.c: Silence warnings under -Wall. --- lib-src/ChangeLog | 4 ++++ lib-src/emacsclient.c | 4 ++-- src/ChangeLog | 7 +++++++ src/image.c | 2 +- src/w32.c | 6 +++--- src/w32font.c | 4 ++-- src/w32reg.c | 7 +++---- 7 files changed, 22 insertions(+), 12 deletions(-) diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 984c4d6c880..a8f9a0ac4be 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,7 @@ +2011-10-27 Juanma Barranquero + + * emacsclient.c (w32_getenv): Silence compiler warnings. + 2011-09-07 Glenn Morris * etags.c (Fortran_functions): Handle "elemental" functions. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index ece9dc65c49..76aa21884de 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -359,7 +359,7 @@ w32_getenv (char *envvar) char *value; DWORD dwType; - if (value = getenv (envvar)) + if ((value = getenv (envvar))) /* Found in the environment. strdup it, because values returned by getenv cannot be free'd. */ return xstrdup (value); @@ -382,7 +382,7 @@ w32_getenv (char *envvar) { DWORD size; - if (size = ExpandEnvironmentStrings (value, NULL, 0)) + if ((size = ExpandEnvironmentStrings (value, NULL, 0))) { char *buffer = (char *) xmalloc (size); if (ExpandEnvironmentStrings (value, buffer, size)) diff --git a/src/ChangeLog b/src/ChangeLog index b3d8d4d10ca..3caecf32049 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-10-27 Juanma Barranquero + + * image.c (x_create_x_image_and_pixmap): + * w32.c (sys_rename, w32_delayed_load): + * w32font.c (fill_in_logfont): + * w32reg.c (x_get_string_resource): Silence compiler warnings. + 2011-10-26 Juanma Barranquero * w32fns.c (w32_default_color_map): New function, diff --git a/src/image.c b/src/image.c index ef72745a72f..14c74f10607 100644 --- a/src/image.c +++ b/src/image.c @@ -2015,7 +2015,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, /* Bitmaps with a depth less than 16 need a palette. */ /* BITMAPINFO structure already contains the first RGBQUAD. */ if (depth < 16) - palette_colors = 1 << depth - 1; + palette_colors = 1 << (depth - 1); *ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD)); diff --git a/src/w32.c b/src/w32.c index 91893ddfc61..42546fc8d49 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2892,12 +2892,12 @@ sys_rename (const char * oldname, const char * newname) int i = 0; oldname = map_w32_filename (oldname, NULL); - if (o = strrchr (oldname, '\\')) + if ((o = strrchr (oldname, '\\'))) o++; else o = (char *) oldname; - if (p = strrchr (temp, '\\')) + if ((p = strrchr (temp, '\\'))) p++; else p = temp; @@ -5756,7 +5756,7 @@ w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id) for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls)) { CHECK_STRING_CAR (dlls); - if (library_dll = LoadLibrary (SDATA (XCAR (dlls)))) + if ((library_dll = LoadLibrary (SDATA (XCAR (dlls))))) { found = XCAR (dlls); break; diff --git a/src/w32font.c b/src/w32font.c index 985370c15c1..f47b7a46b1e 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -1916,10 +1916,10 @@ fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec) int spacing = XINT (tmp); if (spacing < FONT_SPACING_MONO) logfont->lfPitchAndFamily - = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH; + = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH; else logfont->lfPitchAndFamily - = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH; + = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH; } /* Process EXTRA info. */ diff --git a/src/w32reg.c b/src/w32reg.c index e1465be9e44..18374431062 100644 --- a/src/w32reg.c +++ b/src/w32reg.c @@ -147,9 +147,9 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class) { char *resource; - if (resource = w32_get_rdb_resource (rdb, name)) + if ((resource = w32_get_rdb_resource (rdb, name))) return resource; - if (resource = w32_get_rdb_resource (rdb, class)) + if ((resource = w32_get_rdb_resource (rdb, class))) return resource; } @@ -157,6 +157,5 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class) /* --quick was passed, so this is a no-op. */ return NULL; - return (w32_get_string_resource (name, class, REG_SZ)); + return w32_get_string_resource (name, class, REG_SZ); } - From 15de15c66d96905aa21f1781861067eebd68b24b Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Thu, 27 Oct 2011 11:01:40 +0800 Subject: [PATCH 5/9] Replace fundamental-mode-hook with change-major-mode-after-body-hook. * lisp/simple.el (fundamental-mode): * lisp/emacs-lisp/derived.el (define-derived-mode): Revert 2010-04-28 change introducing fundamental-mode-hook. * lisp/subr.el (change-major-mode-after-body-hook): New hook. (run-mode-hooks): Run it. * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Use change-major-mode-before-body-hook. --- etc/NEWS | 21 ++++++++++++++------- lisp/ChangeLog | 12 ++++++++++++ lisp/emacs-lisp/derived.el | 2 +- lisp/emacs-lisp/easy-mmode.el | 6 ++++-- lisp/simple.el | 3 ++- lisp/subr.el | 5 ++++- 6 files changed, 37 insertions(+), 12 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6e60f2a65f9..9e407133e8b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1218,15 +1218,22 @@ syntactic rules. ** frame-local variables cannot be let-bound any more. +** Major and minor mode changes +++ -** prog-mode is a new major-mode meant to be the parent of programming mode. -The prog-mode-hook it defines can be used to enable features for -programming modes. For example: -(add-hook 'prog-mode-hook 'flyspell-prog-mode) -enables on the fly spell checking for comments and strings for -programming modes. +*** `prog-mode' is a new major mode from which programming modes +should be derived. -** define-minor-mode accepts a new keyword :variable. +**** `prog-mode-hook' can be used to enable features for programming +modes, e.g. (add-hook 'prog-mode-hook 'flyspell-prog-mode) to enable +on-the-fly spell checking for comments and strings. + +*** New hook `change-major-mode-after-body-hook', run by +`run-mode-hooks' just before any other mode hooks. + +*** Enabled globalized minor modes can be disabled in specific modes, +by running (FOO-mode-hook 0) via a mode hook. + +*** `define-minor-mode' accepts a new keyword :variable. +++ ** `delete-file' and `delete-directory' now accept optional arg TRASH. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9ba25dc89ab..f4a0ceecf93 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2011-10-27 Chong Yidong + + * subr.el (change-major-mode-after-body-hook): New hook. + (run-mode-hooks): Run it. + + * emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Use + change-major-mode-before-body-hook. + + * simple.el (fundamental-mode): + * emacs-lisp/derived.el (define-derived-mode): Revert 2010-04-28 + change introducing fundamental-mode-hook. + 2011-10-26 Juanma Barranquero * term/w32-win.el (w32-default-color-map): Declare obsolete. (Bug#9785) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 81932f9940a..55ea102ed2a 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -230,7 +230,7 @@ No problems result if this variable is not bound. ; Run the parent. (delay-mode-hooks - (,(or parent 'fundamental-mode)) + (,(or parent 'kill-all-local-variables)) ; Identify the child mode. (setq major-mode (quote ,child)) (setq mode-name ,name) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 4b6f4d634ca..bf9f2c9d6ed 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -368,11 +368,13 @@ See `%s' for more information on %s." (progn (add-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers) - (add-hook 'fundamental-mode-hook ',MODE-enable-in-buffers) + (add-hook 'change-major-mode-after-body-hook + ',MODE-enable-in-buffers) (add-hook 'find-file-hook ',MODE-check-buffers) (add-hook 'change-major-mode-hook ',MODE-cmhh)) (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers) - (remove-hook 'fundamental-mode-hook ',MODE-enable-in-buffers) + (remove-hook 'change-major-mode-after-body-hook + ',MODE-enable-in-buffers) (remove-hook 'find-file-hook ',MODE-check-buffers) (remove-hook 'change-major-mode-hook ',MODE-cmhh)) diff --git a/lisp/simple.el b/lisp/simple.el index 79de6aea3dd..90d22c817b0 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -349,7 +349,8 @@ location." Other major modes are defined by comparison with this one." (interactive) (kill-all-local-variables) - (run-mode-hooks 'fundamental-mode-hook)) + (unless delay-mode-hooks + (run-hooks 'after-change-major-mode-hook))) ;; Special major modes to view specially formatted data rather than files. diff --git a/lisp/subr.el b/lisp/subr.el index 7ac287d2473..f3cd4dabe20 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1530,6 +1530,9 @@ if it is empty or a duplicate." (make-variable-buffer-local 'delayed-mode-hooks) (put 'delay-mode-hooks 'permanent-local t) +(defvar change-major-mode-after-body-hook nil + "Normal hook run in major mode functions, before the mode hooks.") + (defvar after-change-major-mode-hook nil "Normal hook run at the very end of major mode functions.") @@ -1546,7 +1549,7 @@ FOO-mode-hook." ;; Normal case, just run the hook as before plus any delayed hooks. (setq hooks (nconc (nreverse delayed-mode-hooks) hooks)) (setq delayed-mode-hooks nil) - (apply 'run-hooks hooks) + (apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks)) (run-hooks 'after-change-major-mode-hook))) (defmacro delay-mode-hooks (&rest body) From 9c6c6f495b8469ca5e105f5ddb02a69d1303a106 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Thu, 27 Oct 2011 14:07:09 +0800 Subject: [PATCH 6/9] Fix a memory leak in the built-in GnuTLS support. * src/gnutls.c (emacs_gnutls_deinit): New function. Deallocate credentials structures as well as calling gnutls_deinit. (Fgnutls_deinit, Fgnutls_boot): Use it. * src/process.c (make_process): Initialize GnuTLS credentials to NULL. (deactivate_process): Call emacs_gnutls_deinit. --- src/ChangeLog | 9 ++++++ src/gnutls.c | 89 +++++++++++++++++++++++++-------------------------- src/gnutls.h | 1 + src/process.c | 7 ++++ 4 files changed, 61 insertions(+), 45 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 3caecf32049..65995d0ac92 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2011-10-27 Chong Yidong + + * gnutls.c (emacs_gnutls_deinit): New function. Deallocate + credentials structures as well as calling gnutls_deinit. + (Fgnutls_deinit, Fgnutls_boot): Use it. + + * process.c (make_process): Initialize GnuTLS credentials to NULL. + (deactivate_process): Call emacs_gnutls_deinit. + 2011-10-27 Juanma Barranquero * image.c (x_create_x_image_and_pixmap): diff --git a/src/gnutls.c b/src/gnutls.c index 0743ef3f4ee..f836692198c 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -464,6 +464,42 @@ gnutls_make_error (int err) return make_number (err); } +Lisp_Object +emacs_gnutls_deinit (Lisp_Object proc) +{ + int log_level; + + CHECK_PROCESS (proc); + + if (XPROCESS (proc)->gnutls_p == 0) + return Qnil; + + log_level = XPROCESS (proc)->gnutls_log_level; + + if (XPROCESS (proc)->gnutls_x509_cred) + { + GNUTLS_LOG (2, log_level, "Deallocating x509 credentials"); + fn_gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred); + XPROCESS (proc)->gnutls_x509_cred = NULL; + } + + if (XPROCESS (proc)->gnutls_anon_cred) + { + GNUTLS_LOG (2, log_level, "Deallocating anon credentials"); + fn_gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred); + XPROCESS (proc)->gnutls_anon_cred = NULL; + } + + if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT) + { + fn_gnutls_deinit (XPROCESS (proc)->gnutls_state); + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1; + } + + XPROCESS (proc)->gnutls_p = 0; + return Qt; +} + DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0, doc: /* Return the GnuTLS init stage of process PROC. See also `gnutls-boot'. */) @@ -551,18 +587,7 @@ DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, See also `gnutls-init'. */) (Lisp_Object proc) { - gnutls_session_t state; - - CHECK_PROCESS (proc); - state = XPROCESS (proc)->gnutls_state; - - if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT) - { - fn_gnutls_deinit (state); - GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1; - } - - return Qt; + return emacs_gnutls_deinit (proc); } DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, @@ -733,9 +758,6 @@ one trustfile (usually a CA bundle). */) c_hostname = SSDATA (hostname); - state = XPROCESS (proc)->gnutls_state; - XPROCESS (proc)->gnutls_p = 1; - if (NUMBERP (loglevel)) { fn_gnutls_global_set_log_function (gnutls_log_function); @@ -749,40 +771,17 @@ one trustfile (usually a CA bundle). */) if (! NILP (Fgnutls_errorp (global_init))) return global_init; - /* deinit and free resources. */ - if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC) - { - GNUTLS_LOG (1, max_log_level, "deallocating credentials"); - - if (EQ (type, Qgnutls_x509pki)) - { - GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials"); - x509_cred = XPROCESS (proc)->gnutls_x509_cred; - fn_gnutls_certificate_free_credentials (x509_cred); - } - else if (EQ (type, Qgnutls_anon)) - { - GNUTLS_LOG (2, max_log_level, "deallocating anon credentials"); - anon_cred = XPROCESS (proc)->gnutls_anon_cred; - fn_gnutls_anon_free_client_credentials (anon_cred); - } - else - { - error ("unknown credential type"); - ret = GNUTLS_EMACS_ERROR_INVALID_TYPE; - } - - if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT) - { - GNUTLS_LOG (1, max_log_level, "deallocating x509 credentials"); - Fgnutls_deinit (proc); - } - } + /* Before allocating new credentials, deallocate any credentials + that PROC might already have. */ + emacs_gnutls_deinit (proc); + /* Mark PROC as a GnuTLS process. */ + XPROCESS (proc)->gnutls_p = 1; + XPROCESS (proc)->gnutls_x509_cred = NULL; + XPROCESS (proc)->gnutls_anon_cred = NULL; GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY; GNUTLS_LOG (1, max_log_level, "allocating credentials"); - if (EQ (type, Qgnutls_x509pki)) { GNUTLS_LOG (2, max_log_level, "allocating x509 credentials"); diff --git a/src/gnutls.h b/src/gnutls.h index e2a9bc9eaea..5ec6fb76c01 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -60,6 +60,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte); extern int emacs_gnutls_record_check_pending (gnutls_session_t state); extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); +extern Lisp_Object emacs_gnutls_deinit (Lisp_Object); extern void syms_of_gnutls (void); diff --git a/src/process.c b/src/process.c index 90ad9c21681..3daa55b259e 100644 --- a/src/process.c +++ b/src/process.c @@ -642,6 +642,8 @@ make_process (Lisp_Object name) p->gnutls_initstage = GNUTLS_STAGE_EMPTY; p->gnutls_log_level = 0; p->gnutls_p = 0; + p->gnutls_x509_cred = NULL; + p->gnutls_anon_cred = NULL; #endif /* If name is already in use, modify it until it is unused. */ @@ -3867,6 +3869,11 @@ deactivate_process (Lisp_Object proc) register int inchannel, outchannel; register struct Lisp_Process *p = XPROCESS (proc); +#ifdef HAVE_GNUTLS + /* Delete GnuTLS structures in PROC, if any. */ + emacs_gnutls_deinit (proc); +#endif /* HAVE_GNUTLS */ + inchannel = p->infd; outchannel = p->outfd; From 51bc5f8b7385d8e632add4f70ca091ebe7a32799 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 26 Oct 2011 23:38:32 -0700 Subject: [PATCH 7/9] Make set-visited-file-name reload local variables if needed. * lisp/files.el (set-visited-file-name): If the major-mode changed, reload the local variables. Fixes: debbugs:9796 --- lisp/ChangeLog | 5 +++++ lisp/files.el | 6 +++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f4a0ceecf93..cbfc662da52 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-10-27 Glenn Morris + + * files.el (set-visited-file-name): If the major-mode changed, + reload the local variables. (Bug#9796) + 2011-10-27 Chong Yidong * subr.el (change-major-mode-after-body-hook): New hook. diff --git a/lisp/files.el b/lisp/files.el index 3ed9bd5a272..40e2df14c1b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3682,7 +3682,11 @@ the old visited file has been renamed to the new name FILENAME." (get major-mode 'mode-class) ;; Don't change the mode if the local variable list specifies it. (hack-local-variables t) - (set-auto-mode t)) + ;; TODO consider making normal-mode handle this case. + (let ((old major-mode)) + (set-auto-mode t) + (or (eq old major-mode) + (hack-local-variables)))) (error nil))) (defun write-file (filename &optional confirm) From 416a2c45b3068568e47076ed089db25830117ea8 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 27 Oct 2011 00:21:00 -0700 Subject: [PATCH 8/9] Add doc-strings to some cl float parameters. * lisp/emacs-lisp/cl-extra.el (cl-float-limits): Add doc string. * lisp/emacs-lisp/cl.el (most-positive-float, most-negative-float) (least-positive-float, least-negative-float) (least-positive-normalized-float, least-negative-normalized-float) (float-epsilon, float-negative-epsilon): Add doc-strings, based on those in cl.texi. * lisp/emacs-lisp/cl-extra.el (most-positive-float, most-negative-float) (least-positive-float, least-negative-float) (least-positive-normalized-float, least-negative-normalized-float) (float-epsilon, float-negative-epsilon): Remove unnecessary declarations. --- lisp/ChangeLog | 13 +++++++++ lisp/emacs-lisp/cl-extra.el | 14 ++++------ lisp/emacs-lisp/cl.el | 54 ++++++++++++++++++++++++++++++------- 3 files changed, 63 insertions(+), 18 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cbfc662da52..6aa1bddb9f3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,18 @@ 2011-10-27 Glenn Morris + * emacs-lisp/cl-extra.el (most-positive-float, most-negative-float) + (least-positive-float, least-negative-float) + (least-positive-normalized-float, least-negative-normalized-float) + (float-epsilon, float-negative-epsilon): + Remove unnecessary declarations. + + * emacs-lisp/cl-extra.el (cl-float-limits): Add doc string. + * emacs-lisp/cl.el (most-positive-float, most-negative-float) + (least-positive-float, least-negative-float) + (least-positive-normalized-float, least-negative-normalized-float) + (float-epsilon, float-negative-epsilon): Add doc-strings, + based on those in cl.texi. + * files.el (set-visited-file-name): If the major-mode changed, reload the local variables. (Bug#9796) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 7468a0237cf..8ea58b2e07c 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -480,17 +480,13 @@ If STATE is t, return a new state object seeded from the time of day." (and (numberp res) (/= res (/ res 2)) res)) (arith-error nil))) -(defvar most-positive-float) -(defvar most-negative-float) -(defvar least-positive-float) -(defvar least-negative-float) -(defvar least-positive-normalized-float) -(defvar least-negative-normalized-float) -(defvar float-epsilon) -(defvar float-negative-epsilon) - ;;;###autoload (defun cl-float-limits () + "Initialize the Common Lisp floating-point parameters. +This sets the values of: `most-positive-float', `most-negative-float', +`least-positive-float', `least-negative-float', `float-epsilon', +`float-negative-epsilon', `least-positive-normalized-float', and +`least-negative-normalized-float'." (or most-positive-float (not (numberp '2e1)) (let ((x '2e0) y z) ;; Find maximum exponent (first two loops are optimizations) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 526475eb1bd..0b34e9f27f7 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -333,15 +333,51 @@ always returns nil." (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) -;; The following are actually set by cl-float-limits. -(defconst most-positive-float nil) -(defconst most-negative-float nil) -(defconst least-positive-float nil) -(defconst least-negative-float nil) -(defconst least-positive-normalized-float nil) -(defconst least-negative-normalized-float nil) -(defconst float-epsilon nil) -(defconst float-negative-epsilon nil) +(defconst most-positive-float nil + "The largest value that a Lisp float can hold. +If your system supports infinities, this is the largest finite value. +For IEEE machines, this is approximately 1.79e+308. +Call `cl-float-limits' to set this.") + +(defconst most-negative-float nil + "The largest negative value that a Lisp float can hold. +This is simply -`most-negative-float'. +Call `cl-float-limits' to set this.") + +(defconst least-positive-float nil + "The smallest value greater than zero that a Lisp float can hold. +For IEEE machines, it is about 4.94e-324 if denormals are supported, +or 2.22e-308 if they are not. +Call `cl-float-limits' to set this.") + +(defconst least-negative-float nil + "The smallest value less than zero that a Lisp float can hold. +This is simply -`least-positive-float'. +Call `cl-float-limits' to set this.") + +(defconst least-positive-normalized-float nil + "The smallest normalized Lisp float greater than zero. +This is the smallest value for which IEEE denormalization does not lose +precision. For IEEE machines, this value is about 2.22e-308. +For machines that do not support the concept of denormalization +and gradual underflow, this constant equals `least-positive-float'. +Call `cl-float-limits' to set this.") + +(defconst least-negative-normalized-float nil + "The smallest normalized Lisp float less than zero. +This is simply -`least-positive-normalized-float'. +Call `cl-float-limits' to set this.") + +(defconst float-epsilon nil + "The smallest positive float that adds to 1.0 to give a distinct value. +Adding a number less than this to 1.0 returns 1.0 due to roundoff. +For IEEE machines, epsilon is about 2.22e-16. +Call `cl-float-limits' to set this.") + +(defconst float-negative-epsilon nil + "The smallest positive float that subtracts from 1.0 to give a distinct value. +For IEEE machines, it is about 1.11e-16. +Call `cl-float-limits' to set this.") ;;; Sequence functions. From 435c1d6793ce358f4d2c77c9e9c1ad81fd754651 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Thu, 27 Oct 2011 16:07:28 +0800 Subject: [PATCH 9/9] More gnutls memory fixes. * src/gnutls.c (emacs_gnutls_deinit): Deinit the gnutls_state if it is non-NULL, regardless of GNUTLS_INITSTAGE. (Fgnutls_boot): Cleanups. Call emacs_gnutls_deinit if we signal an error. Set process slots as soon as we allocate them. * src/gnutls.h (GNUTLS_LOG, GNUTLS_LOG2): Fix macros. * src/process.c (make_process): Set gnutls_state to NULL. --- src/ChangeLog | 11 +++ src/gnutls.c | 230 ++++++++++++++++++++------------------------------ src/gnutls.h | 4 +- src/process.c | 1 + 4 files changed, 105 insertions(+), 141 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 65995d0ac92..c3926f6024b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2011-10-27 Chong Yidong + + * process.c (make_process): Set gnutls_state to NULL. + + * gnutls.c (emacs_gnutls_deinit): Deinit the gnutls_state if it is + non-NULL, regardless of GNUTLS_INITSTAGE. + (Fgnutls_boot): Cleanups. Call emacs_gnutls_deinit if we signal + an error. Set process slots as soon as we allocate them. + + * gnutls.h (GNUTLS_LOG, GNUTLS_LOG2): Fix macros. + 2011-10-27 Chong Yidong * gnutls.c (emacs_gnutls_deinit): New function. Deallocate diff --git a/src/gnutls.c b/src/gnutls.c index f836692198c..500f09432b1 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -490,10 +490,12 @@ emacs_gnutls_deinit (Lisp_Object proc) XPROCESS (proc)->gnutls_anon_cred = NULL; } - if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT) + if (XPROCESS (proc)->gnutls_state) { fn_gnutls_deinit (XPROCESS (proc)->gnutls_state); - GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1; + XPROCESS (proc)->gnutls_state = NULL; + if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT) + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1; } XPROCESS (proc)->gnutls_p = 0; @@ -647,7 +649,7 @@ emacs_gnutls_global_deinit (void) DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST. -Currently only client mode is supported. Returns a success/failure +Currently only client mode is supported. Return a success/failure value you can check with `gnutls-errorp'. TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'. @@ -698,23 +700,13 @@ one trustfile (usually a CA bundle). */) (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist) { int ret = GNUTLS_E_SUCCESS; - int max_log_level = 0; - /* TODO: GNUTLS_X509_FMT_DER is also an option. */ - int file_format = GNUTLS_X509_FMT_PEM; - - unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT; - gnutls_x509_crt_t gnutls_verify_cert; - unsigned int gnutls_verify_cert_list_size; - const gnutls_datum_t *gnutls_verify_cert_list; - gnutls_session_t state; - gnutls_certificate_credentials_t x509_cred; - gnutls_anon_client_credentials_t anon_cred; + gnutls_certificate_credentials_t x509_cred = NULL; + gnutls_anon_client_credentials_t anon_cred = NULL; Lisp_Object global_init; char const *priority_string_ptr = "NORMAL"; /* default priority string. */ - Lisp_Object tail; unsigned int peer_verification; char* c_hostname; @@ -726,7 +718,6 @@ one trustfile (usually a CA bundle). */) /* Lisp_Object callbacks; */ Lisp_Object loglevel; Lisp_Object hostname; - Lisp_Object verify_flags; /* Lisp_Object verify_error; */ Lisp_Object verify_hostname_error; Lisp_Object prime_bits; @@ -741,21 +732,23 @@ one trustfile (usually a CA bundle). */) return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED); } + if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon)) + { + error ("Invalid GnuTLS credential type"); + return gnutls_make_error (GNUTLS_EMACS_ERROR_INVALID_TYPE); + } + hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname); priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority); trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles); keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist); crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles); - /* callbacks = Fplist_get (proplist, QCgnutls_bootprop_callbacks); */ loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel); - verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags); - /* verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error); */ verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error); prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits); if (!STRINGP (hostname)) error ("gnutls-boot: invalid :hostname parameter"); - c_hostname = SSDATA (hostname); if (NUMBERP (loglevel)) @@ -777,53 +770,50 @@ one trustfile (usually a CA bundle). */) /* Mark PROC as a GnuTLS process. */ XPROCESS (proc)->gnutls_p = 1; + XPROCESS (proc)->gnutls_state = NULL; XPROCESS (proc)->gnutls_x509_cred = NULL; XPROCESS (proc)->gnutls_anon_cred = NULL; + XPROCESS (proc)->gnutls_cred_type = type; GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY; GNUTLS_LOG (1, max_log_level, "allocating credentials"); if (EQ (type, Qgnutls_x509pki)) { - GNUTLS_LOG (2, max_log_level, "allocating x509 credentials"); - x509_cred = XPROCESS (proc)->gnutls_x509_cred; - fn_gnutls_certificate_allocate_credentials (&x509_cred); + Lisp_Object verify_flags; + unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT; + GNUTLS_LOG (2, max_log_level, "allocating x509 credentials"); + fn_gnutls_certificate_allocate_credentials (&x509_cred); + XPROCESS (proc)->gnutls_x509_cred = x509_cred; + + verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags); if (NUMBERP (verify_flags)) { gnutls_verify_flags = XINT (verify_flags); GNUTLS_LOG (2, max_log_level, "setting verification flags"); } else if (NILP (verify_flags)) - { - /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */ - GNUTLS_LOG (2, max_log_level, "using default verification flags"); - } + GNUTLS_LOG (2, max_log_level, "using default verification flags"); else - { - /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */ - GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags"); - } + GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags"); + fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags); } - else if (EQ (type, Qgnutls_anon)) + else /* Qgnutls_anon: */ { GNUTLS_LOG (2, max_log_level, "allocating anon credentials"); - anon_cred = XPROCESS (proc)->gnutls_anon_cred; fn_gnutls_anon_allocate_client_credentials (&anon_cred); + XPROCESS (proc)->gnutls_anon_cred = anon_cred; } - else - { - error ("unknown credential type"); - ret = GNUTLS_EMACS_ERROR_INVALID_TYPE; - } - - if (ret < GNUTLS_E_SUCCESS) - return gnutls_make_error (ret); GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC; if (EQ (type, Qgnutls_x509pki)) { + /* TODO: GNUTLS_X509_FMT_DER is also an option. */ + int file_format = GNUTLS_X509_FMT_PEM; + Lisp_Object tail; + for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail)) { Lisp_Object trustfile = Fcar (tail); @@ -841,8 +831,8 @@ one trustfile (usually a CA bundle). */) } else { - error ("Sorry, GnuTLS can't use non-string trustfile %s", - SDATA (trustfile)); + emacs_gnutls_deinit (proc); + error ("Invalid trustfile"); } } @@ -854,17 +844,15 @@ one trustfile (usually a CA bundle). */) GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ", SSDATA (crlfile)); ret = fn_gnutls_certificate_set_x509_crl_file - (x509_cred, - SSDATA (crlfile), - file_format); + (x509_cred, SSDATA (crlfile), file_format); if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); } else { - error ("Sorry, GnuTLS can't use non-string CRL file %s", - SDATA (crlfile)); + emacs_gnutls_deinit (proc); + error ("Invalid CRL file"); } } @@ -879,45 +867,31 @@ one trustfile (usually a CA bundle). */) GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ", SSDATA (certfile)); ret = fn_gnutls_certificate_set_x509_key_file - (x509_cred, - SSDATA (certfile), - SSDATA (keyfile), - file_format); + (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format); if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); } else { - if (STRINGP (keyfile)) - error ("Sorry, GnuTLS can't use non-string client cert file %s", - SDATA (certfile)); - else - error ("Sorry, GnuTLS can't use non-string client key file %s", - SDATA (keyfile)); + emacs_gnutls_deinit (proc); + error (STRINGP (keyfile) ? "Invalid client cert file" + : "Invalid client key file"); } } } GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES; - GNUTLS_LOG (1, max_log_level, "gnutls callbacks"); - GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS; -#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY -#else -#endif + /* Call gnutls_init here: */ GNUTLS_LOG (1, max_log_level, "gnutls_init"); - ret = fn_gnutls_init (&state, GNUTLS_CLIENT); - + XPROCESS (proc)->gnutls_state = state; if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); - - XPROCESS (proc)->gnutls_state = state; - GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT; if (STRINGP (priority_string)) @@ -933,46 +907,25 @@ one trustfile (usually a CA bundle). */) } GNUTLS_LOG (1, max_log_level, "setting the priority string"); - ret = fn_gnutls_priority_set_direct (state, priority_string_ptr, NULL); - if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; - if (!EQ (prime_bits, Qnil)) - { - fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits)); - } - - if (EQ (type, Qgnutls_x509pki)) - { - ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred); - } - else if (EQ (type, Qgnutls_anon)) - { - ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred); - } - else - { - error ("unknown credential type"); - ret = GNUTLS_EMACS_ERROR_INVALID_TYPE; - } + if (INTEGERP (prime_bits)) + fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits)); + ret = EQ (type, Qgnutls_x509pki) + ? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred) + : fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred); if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); - XPROCESS (proc)->gnutls_anon_cred = anon_cred; - XPROCESS (proc)->gnutls_x509_cred = x509_cred; - XPROCESS (proc)->gnutls_cred_type = type; - GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET; - ret = emacs_gnutls_handshake (XPROCESS (proc)); - if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); @@ -983,69 +936,71 @@ one trustfile (usually a CA bundle). */) gnutls_x509_crt_check_hostname() against :hostname. */ ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification); - if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID) - message ("%s certificate could not be verified.", - c_hostname); + message ("%s certificate could not be verified.", c_hostname); - if (peer_verification & GNUTLS_CERT_REVOKED) - GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):", - c_hostname); + if (peer_verification & GNUTLS_CERT_REVOKED) + GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):", + c_hostname); - if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND) - GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:", - c_hostname); + if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND) + GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:", + c_hostname); - if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA) - GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:", - c_hostname); + if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA) + GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:", + c_hostname); - if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM) - GNUTLS_LOG2 (1, max_log_level, - "certificate was signed with an insecure algorithm:", - c_hostname); + if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM) + GNUTLS_LOG2 (1, max_log_level, + "certificate was signed with an insecure algorithm:", + c_hostname); - if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED) - GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:", - c_hostname); + if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED) + GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:", + c_hostname); - if (peer_verification & GNUTLS_CERT_EXPIRED) - GNUTLS_LOG2 (1, max_log_level, "certificate has expired:", - c_hostname); + if (peer_verification & GNUTLS_CERT_EXPIRED) + GNUTLS_LOG2 (1, max_log_level, "certificate has expired:", + c_hostname); - if (peer_verification != 0) - { - if (NILP (verify_hostname_error)) - { - GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", - c_hostname); - } - else - { - error ("Certificate validation failed %s, verification code %d", - c_hostname, peer_verification); - } - } + if (peer_verification != 0) + { + if (NILP (verify_hostname_error)) + GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", + c_hostname); + else + { + emacs_gnutls_deinit (proc); + error ("Certificate validation failed %s, verification code %d", + c_hostname, peer_verification); + } + } /* Up to here the process is the same for X.509 certificates and OpenPGP keys. From now on X.509 certificates are assumed. This can be easily extended to work with openpgp keys as well. */ if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) { - ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert); + gnutls_x509_crt_t gnutls_verify_cert; + const gnutls_datum_t *gnutls_verify_cert_list; + unsigned int gnutls_verify_cert_list_size; + ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert); if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); gnutls_verify_cert_list = fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); - if (NULL == gnutls_verify_cert_list) + if (gnutls_verify_cert_list == NULL) { - error ("No x509 certificate was found!\n"); + fn_gnutls_x509_crt_deinit (gnutls_verify_cert); + emacs_gnutls_deinit (proc); + error ("No x509 certificate was found\n"); } /* We only check the first certificate in the given chain. */ @@ -1062,18 +1017,15 @@ one trustfile (usually a CA bundle). */) if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname)) { if (NILP (verify_hostname_error)) - { - GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", - c_hostname); - } + GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", + c_hostname); else { fn_gnutls_x509_crt_deinit (gnutls_verify_cert); - error ("The x509 certificate does not match \"%s\"", - c_hostname); + emacs_gnutls_deinit (proc); + error ("The x509 certificate does not match \"%s\"", c_hostname); } } - fn_gnutls_x509_crt_deinit (gnutls_verify_cert); } diff --git a/src/gnutls.h b/src/gnutls.h index 5ec6fb76c01..076e9fdba9c 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -49,9 +49,9 @@ typedef enum #define GNUTLS_PROCESS_USABLE(proc) (GNUTLS_INITSTAGE(proc) >= GNUTLS_STAGE_READY) -#define GNUTLS_LOG(level, max, string) if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } +#define GNUTLS_LOG(level, max, string) do { if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } } while (0) -#define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } +#define GNUTLS_LOG2(level, max, string, extra) do { if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } } while (0) extern EMACS_INT emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte); diff --git a/src/process.c b/src/process.c index 3daa55b259e..dc37ec5f961 100644 --- a/src/process.c +++ b/src/process.c @@ -642,6 +642,7 @@ make_process (Lisp_Object name) p->gnutls_initstage = GNUTLS_STAGE_EMPTY; p->gnutls_log_level = 0; p->gnutls_p = 0; + p->gnutls_state = NULL; p->gnutls_x509_cred = NULL; p->gnutls_anon_cred = NULL; #endif