bug#10535: 23.3; starttls-negotiate-gnutls erases random buffer

[Walter C. Pelissero]

This bug report will be sent to the Free Software Foundation,
not to your local site managers!
Please write in English if possible, because the Emacs maintainers
usually do not have translators to read other languages for them.

Your report will be posted to the bug-gnu-emacs@gnu.org mailing list
and the gnu.emacs.bug news group, and at http://debbugs.gnu.org.

Please describe exactly what actions triggered the bug
and the precise symptoms of the bug.  If you can, give
a recipe starting from `emacs -Q':

starttls-negotiate-gnutls obliterates the contents of the second
buffer in the buffers list.

For instance a form like this may expose the bug:

(jabber-starttls-connect '(:fsm jabber-connection :state :connecting 
:state-data (:send-function jabber-ssl-send :username "me" :server "jabme.de" 
:password "secret" :registerp nil :connection-type starttls :encrypted nil 
:network-server nil :port nil) :sleep 3 :deferred nil) "jabber.host" nil nil)

I've noticed that the local variable `buffer' in
starttls-negotiate-gnutls may contain a killed buffer, which I guessed
it might be the source of the problem.

In fact the following code erases the content of any writable buffer
happening to be second in the buffers list:

(let ((buffer (generate-new-buffer "foobar")))
   (with-current-buffer buffer (kill-buffer buffer) (erase-buffer)))

Although I don't know if the behaviour above is to be expected, the
following patch seems to fix the problem at least in starttls.  The
patch, despite it's length, just checks that the buffer is still
alive.

diff -c -L /usr/local/share/emacs/23.3/lisp/gnus/starttls.el.gz -L 
/tmp/buffer-content-4772M2i /tmp/jka-com4772ZAp /tmp/buffer-content-4772M2i
*** /usr/local/share/emacs/23.3/lisp/gnus/starttls.el.gz
--- /tmp/buffer-content-4772M2i
***************
*** 201,232 ****
  This should typically only be done once.  It typically returns a
  multi-line informational message with information about the
  handshake, or nil on failure."
!   (let (buffer info old-max done-ok done-bad)
!     (if (null (setq buffer (process-buffer process)))
!       ;; XXX How to remove/extract the TLS negotiation junk?
!       (signal-process (process-id process) 'SIGALRM)
!       (with-current-buffer buffer
!       (save-excursion
!         (setq old-max (goto-char (point-max)))
!         (signal-process (process-id process) 'SIGALRM)
!         (while (and (processp process)
!                     (eq (process-status process) 'run)
!                     (save-excursion
!                       (goto-char old-max)
!                       (not (or (setq done-ok (re-search-forward
!                                               starttls-success nil t))
!                                (setq done-bad (re-search-forward
!                                                starttls-failure nil t))))))
!           (accept-process-output process 1 100)
!           (sit-for 0.1))
!         (setq info (buffer-substring-no-properties old-max (point-max)))
!         (delete-region old-max (point-max))
!         (if (or (and done-ok (not done-bad))
!                 ;; Prevent mitm that fake success msg after failure msg.
!                 (and done-ok done-bad (< done-ok done-bad)))
!             info
!           (message "STARTTLS negotiation failed: %s" info)
!           nil))))))
  
  (defun starttls-negotiate (process)
    (if starttls-use-gnutls
--- 201,233 ----
  This should typically only be done once.  It typically returns a
  multi-line informational message with information about the
  handshake, or nil on failure."
!   (let ((buffer (process-buffer process))
!       info old-max done-ok done-bad)
!     (if (and buffer (buffer-live-p buffer))
!       (with-current-buffer buffer
!         (save-excursion
!           (setq old-max (goto-char (point-max)))
!           (signal-process (process-id process) 'SIGALRM)
!           (while (and (processp process)
!                       (eq (process-status process) 'run)
!                       (save-excursion
!                         (goto-char old-max)
!                         (not (or (setq done-ok (re-search-forward
!                                                 starttls-success nil t))
!                                  (setq done-bad (re-search-forward
!                                                  starttls-failure nil t))))))
!             (accept-process-output process 1 100)
!             (sit-for 0.1))
!           (setq info (buffer-substring-no-properties old-max (point-max)))
!           (delete-region old-max (point-max))
!           (if (or (and done-ok (not done-bad))
!                   ;; Prevent mitm that fake success msg after failure msg.
!                   (and done-ok done-bad (< done-ok done-bad)))
!               info
!             (message "STARTTLS negotiation failed: %s" info)
!             nil)))
!       ;; XXX How to remove/extract the TLS negotiation junk?
!       (signal-process (process-id process) 'SIGALRM))))
  
  (defun starttls-negotiate (process)
    (if starttls-use-gnutls



If Emacs crashed, and you have the Emacs process in the gdb debugger,
please include the output from the following gdb commands:
    `bt full' and `xbacktrace'.
For information about debugging Emacs, please read the file
/usr/local/share/emacs/23.3/etc/DEBUG.


In GNU Emacs 23.3.1 (amd64-portbld-freebsd8.2, GTK+ Version 2.24.6)
 of 2012-01-04 on scylla.home.lan
Windowing system distributor `The X.Org Foundation', version 11.0.10707000
configured using `configure  '--localstatedir=/var' '--with-x-toolkit=gtk' 
'--x-libraries=/usr/local/lib' '--x-includes=/usr/local/include' 
'--prefix=/usr/local' '--mandir=/usr/local/man' '--infodir=/usr/local/info/' 
'--build=amd64-portbld-freebsd8.2' 'build_alias=amd64-portbld-freebsd8.2' 
'CC=cc' 'CFLAGS=-O2 -pipe -fno-strict-aliasing' 'LDFLAGS= -L/usr/local/lib 
-rpath=/usr/local/lib' 'CPPFLAGS=-I/usr/local/include' 'CPP=cpp''

Important settings:
  value of $LC_ALL: nil
  value of $LC_COLLATE: nil
  value of $LC_CTYPE: en_GB.ISO8859-15
  value of $LC_MESSAGES: nil
  value of $LC_MONETARY: nil
  value of $LC_NUMERIC: nil
  value of $LC_TIME: nil
  value of $LANG: en_GB.ISO8859-15
  value of $XMODIFIERS: nil
  locale-coding-system: iso-latin-9-unix
  default enable-multibyte-characters: t

Major mode: Text

Minor modes in effect:
  flyspell-mode: t
  show-paren-mode: t
  iswitchb-mode: t
  tooltip-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  line-number-mode: t
  transient-mark-mode: t

Recent input:
M-f M-f M-f s <down> <down> <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <down> <down> <up> 
<up> <up> <up> <next> <prior> M-< M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-f M-f M-f M-f <up> <up> <up> 
<up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <down> 
<backspace> , SPC w h i c h SPC m a y SPC b e SPC t 
h e SPC o <backspace> s o u r c e SPC o f SPC t h e 
SPC p r o b l e m . M-b C-s C-w <up> <up> <up> <up> 
<up> <up> <up> C-e <left> <M-backspace> b u g <down> 
<down> C-s C-s <help-echo> <down-mouse-1> <mouse-1> 
SPC t h e M-q C-x C-s M-x r e p o <tab> r t <tab> 
<return>

Recent messages:
Mark set
Auto-saving...done
call-interactively: Beginning of buffer
Mark set [2 times]
Auto-saving...done
Mark saved where search started [2 times]
Saving file /usr/home/wcp/tmp/bug-report...
Wrote /usr/home/wcp/tmp/bug-report
Making completion list...
Scanning for dabbrevs...99%

Load-path shadows:
/usr/home/wcp/emacs/slime/contrib/bridge hides /usr/home/wcp/emacs/ilisp/bridge
/usr/local/share/emacs/site-lisp/CJK/emacs/cjk-enc hides 
/usr/local/share/emacs/site-lisp/CJK/mule-2.3/cjk-enc
/usr/local/share/emacs/23.3/site-lisp/semi/pgg-gpg hides 
/usr/local/share/emacs/23.3/lisp/pgg-gpg
/usr/local/share/emacs/23.3/site-lisp/semi/pgg-parse hides 
/usr/local/share/emacs/23.3/lisp/pgg-parse
/usr/local/share/emacs/23.3/site-lisp/flim/md4 hides 
/usr/local/share/emacs/23.3/lisp/md4
/usr/local/share/emacs/23.3/site-lisp/flim/sha1 hides 
/usr/local/share/emacs/23.3/lisp/sha1
/usr/local/share/emacs/23.3/site-lisp/semi/pgg-pgp5 hides 
/usr/local/share/emacs/23.3/lisp/pgg-pgp5
/usr/home/wcp/emacs/desktop hides /usr/local/share/emacs/23.3/lisp/desktop
/usr/local/share/emacs/23.3/site-lisp/semi/pgg hides 
/usr/local/share/emacs/23.3/lisp/pgg
/usr/local/share/emacs/23.3/site-lisp/flim/hex-util hides 
/usr/local/share/emacs/23.3/lisp/hex-util
/usr/local/share/emacs/23.3/site-lisp/semi/pgg-pgp hides 
/usr/local/share/emacs/23.3/lisp/pgg-pgp
/usr/local/share/emacs/23.3/site-lisp/semi/pgg-def hides 
/usr/local/share/emacs/23.3/lisp/pgg-def
/usr/home/wcp/emacs/url/lisp/vc-dav hides 
/usr/local/share/emacs/23.3/lisp/vc-dav
/usr/home/wcp/emacs/url/lisp/url-nfs hides 
/usr/local/share/emacs/23.3/lisp/url/url-nfs
/usr/home/wcp/emacs/url/lisp/url-dired hides 
/usr/local/share/emacs/23.3/lisp/url/url-dired
/usr/home/wcp/emacs/url/lisp/url-cookie hides 
/usr/local/share/emacs/23.3/lisp/url/url-cookie
/usr/home/wcp/emacs/url/lisp/url-file hides 
/usr/local/share/emacs/23.3/lisp/url/url-file
/usr/home/wcp/emacs/url/lisp/url-gw hides 
/usr/local/share/emacs/23.3/lisp/url/url-gw
/usr/home/wcp/emacs/url/lisp/url-news hides 
/usr/local/share/emacs/23.3/lisp/url/url-news
/usr/home/wcp/emacs/url/lisp/url-history hides 
/usr/local/share/emacs/23.3/lisp/url/url-history
/usr/home/wcp/emacs/url/lisp/url hides /usr/local/share/emacs/23.3/lisp/url/url
/usr/home/wcp/emacs/url/lisp/url-handlers hides 
/usr/local/share/emacs/23.3/lisp/url/url-handlers
/usr/home/wcp/emacs/url/lisp/url-misc hides 
/usr/local/share/emacs/23.3/lisp/url/url-misc
/usr/home/wcp/emacs/url/lisp/url-cid hides 
/usr/local/share/emacs/23.3/lisp/url/url-cid
/usr/home/wcp/emacs/url/lisp/url-http hides 
/usr/local/share/emacs/23.3/lisp/url/url-http
/usr/home/wcp/emacs/url/lisp/url-proxy hides 
/usr/local/share/emacs/23.3/lisp/url/url-proxy
/usr/home/wcp/emacs/url/lisp/url-methods hides 
/usr/local/share/emacs/23.3/lisp/url/url-methods
/usr/home/wcp/emacs/url/lisp/url-util hides 
/usr/local/share/emacs/23.3/lisp/url/url-util
/usr/home/wcp/emacs/url/lisp/url-cache hides 
/usr/local/share/emacs/23.3/lisp/url/url-cache
/usr/home/wcp/emacs/url/lisp/url-expand hides 
/usr/local/share/emacs/23.3/lisp/url/url-expand
/usr/home/wcp/emacs/url/lisp/url-ftp hides 
/usr/local/share/emacs/23.3/lisp/url/url-ftp
/usr/home/wcp/emacs/url/lisp/url-ns hides 
/usr/local/share/emacs/23.3/lisp/url/url-ns
/usr/home/wcp/emacs/url/lisp/url-dav hides 
/usr/local/share/emacs/23.3/lisp/url/url-dav
/usr/home/wcp/emacs/url/lisp/url-vars hides 
/usr/local/share/emacs/23.3/lisp/url/url-vars
/usr/home/wcp/emacs/url/lisp/url-parse hides 
/usr/local/share/emacs/23.3/lisp/url/url-parse
/usr/home/wcp/emacs/url/lisp/url-ldap hides 
/usr/local/share/emacs/23.3/lisp/url/url-ldap
/usr/home/wcp/emacs/url/lisp/url-imap hides 
/usr/local/share/emacs/23.3/lisp/url/url-imap
/usr/home/wcp/emacs/url/lisp/url-auth hides 
/usr/local/share/emacs/23.3/lisp/url/url-auth
/usr/home/wcp/emacs/url/lisp/url-about hides 
/usr/local/share/emacs/23.3/lisp/url/url-about
/usr/home/wcp/emacs/url/lisp/url-mailto hides 
/usr/local/share/emacs/23.3/lisp/url/url-mailto
/usr/home/wcp/emacs/url/lisp/url-privacy hides 
/usr/local/share/emacs/23.3/lisp/url/url-privacy
/usr/home/wcp/emacs/url/lisp/url-irc hides 
/usr/local/share/emacs/23.3/lisp/url/url-irc
/usr/local/share/emacs/23.3/site-lisp/flim/sasl-ntlm hides 
/usr/local/share/emacs/23.3/lisp/net/sasl-ntlm
/usr/local/share/emacs/23.3/site-lisp/flim/hmac-def hides 
/usr/local/share/emacs/23.3/lisp/net/hmac-def
/usr/local/share/emacs/23.3/site-lisp/flim/sasl-digest hides 
/usr/local/share/emacs/23.3/lisp/net/sasl-digest
/usr/local/share/emacs/23.3/site-lisp/flim/sasl hides 
/usr/local/share/emacs/23.3/lisp/net/sasl
/usr/local/share/emacs/23.3/site-lisp/flim/ntlm hides 
/usr/local/share/emacs/23.3/lisp/net/ntlm
/usr/local/share/emacs/23.3/site-lisp/flim/sasl-cram hides 
/usr/local/share/emacs/23.3/lisp/net/sasl-cram
/usr/local/share/emacs/23.3/site-lisp/flim/hmac-md5 hides 
/usr/local/share/emacs/23.3/lisp/net/hmac-md5
/usr/local/share/emacs/site-lisp/CJK/emacs/thai-word hides 
/usr/local/share/emacs/23.3/lisp/language/thai-word
/usr/local/share/emacs/23.3/site-lisp/semi/smime hides 
/usr/local/share/emacs/23.3/lisp/gnus/smime

Features:
(shadow emacsbug debug multi-isearch dabbrev dictionary link
connection mail-utils newcomment quail mailalias flyspell ispell
vm-reply help-mode view time-stamp vm-virtual vm-delete bbdb-gui
vm-save vm-rfaddons vm-menu vm-window vm-toolbar vm-folder vm-mime
vm-undo vm-mouse vm-page vm-minibuf vm-message vm-misc vm-macro
bbdb-vm vm-summary vm-motion vm-autoload bbdb-snarf mail-extr bbdb-com
mailabbrev vm arc-mode archive-mode make-mode css-mode sh-script eldoc
face-remap copyright darcsum executable pcomplete pcmpl-darcs compile
slime-asdf warnings slime-fancy slime-fontifying-fu slime-package-fu
slime-references slime-scratch slime-presentations slime-fuzzy
slime-fancy-inspector slime-c-p-c slime-editing-commands slime-autodoc
advice advice-preload slime-parse slime-repl slime byte-opt bytecomp
byte-compile derived apropos help-fns edmacro kmacro easy-mmode
hideshow pp hyperspec thingatpt gobbol submit-cv mailcrypt rfc822
comint ring html-extensions sgml-mode autoinsert skeleton jabber-chat
ewoc jabber-menu jabber-history jabber-chatbuffer jabber-keymap
jabber-core jabber-sasl sasl sasl-anonymous sasl-login sasl-plain fsm
jabber-conn srv dns starttls tls jabber-logon sha1 sha1-el hex-util
jabber-xml xml jabber-util mail-parse rfc2231 rfc2047 rfc2045 qp
ietf-drums mm-util time-date mail-prsvr smtpmail sendmail server
jka-compr desktop reporter dired regexp-opt info paren avoid iswitchb
cus-start cus-load bbdb-autoloads bbdb timezone color-theme easymenu
wid-edit tapestry vm-autoloads vm-vars vm-version browse-url vc
vc-dispatcher cl cl-19 jabber-autoloads tooltip ediff-hook vc-hooks
lisp-float-type mwheel x-win x-dnd font-setting tool-bar dnd fontset
image fringe lisp-mode register page menu-bar rfn-eshadow timer select
scroll-bar mldrag mouse jit-lock font-lock syntax facemenu font-core
frame cham georgian utf-8-lang misc-lang vietnamese tibetan thai
tai-viet lao korean japanese hebrew greek romanian slovak czech
european ethiopic indian cyrillic chinese case-table epa-hook
jka-cmpr-hook help simple abbrev loaddefs button minibuffer faces
cus-face files text-properties overlay md5 base64 format env
code-pages mule custom widget hashtable-print-readable backquote
make-network-process dbusbind system-font-setting font-render-setting
gtk x-toolkit x multi-tty emacs)

-- 
http://pelissero.de