Peter S Galbraith <p...@debian.org> writes:
> The patch applies fine, and queries interactively correctly with a bug
> report against the apt package, but the info is not entered as mime
> attachments for me using mh-e.
Thanks for looking into this! Right, I've mostly used Gnus and Message
mode when testing this patch, even though initially I think I tested it
with the other MUAs too. Now I've checked with mh-e also, and I see
the two problems.
> The problem is two-fold. First, I would change:
>
> (when (and (boundp 'mml-mode) mml-mode)
> to:
> (when (boundp 'mml-mode)
>
> and " disposition=inline" to " disposition=attachment"
>
> e.g. don't limit to mml-mode, and use "attachment" instead of "inline".
>
> Any downside to that for other MUAs that you can think of?
I don't quite remember how I came up with that test, but I think the
idea was to check whether the MUA supports embedding MIME parts using
MML. Gnus and Message mode enables mml-mode by default, but apparently
mh-e doesn't even though it supports MML. So it seems not sufficient to
check if mml-mode is true.
Also, I don't perhaps think testing (boundp 'mml-mode) is robust enough,
because the mml library could be loaded, although maybe unlikely, even
when using an MUA that doesn't support MML.
So I suggest instead to also just check the value of mail-user-agent to
determine whether the MUA in use supports MML. Of the MUAs included with
Emacs, Gnus, Message and mh-e do, while the default sendmail-user-agent
apparently doesn't. (I just briefly checked the Mew and Wanderlust MUAs
which are packaged separately from Emacs, and they also don't seem to
support MML, but seem to otherwise work with debian-bug. I suppose
others can be added to list if they are found to work with MML.)
In other words:
(when (or (and (boundp 'mml-mode) mml-mode)
(memq mail-user-agent '(mh-e-user-agent
message-user-agent
gnus-user-agent)))
I don't think I've any particular preference on the type of disposition
to use, but just chose disposition=inline initially because I thought
that's more similar to how reportbug inserts the output from the bug
script in the mail.
I've attached a new patch, slightly modified according to the
above suggestion, and which uses disposition=attachment instead
of disposition=inline.
> Second, the search for mml directives is too restrictive in mh-e in
> `mh-mml-tag-present-p'. I get:
>
> Debugger entered--Lisp error: (error "Stack overflow in regexp matcher")
I see, mh-e doesn't seem to cope with text inserted between
the <#part ...> and <#/part> elements. I can't see the error
message though, but when the mail is sent the MML part is just
sent as is and not translated to MIME as it should. (Hmm, incidentally
it seems this problem only occurs when the message buffer is entirely
ASCII, since the call to mh-ascii-buffer-p in mh-send-letter ensures
that buffers with other encodings are properly MIME encoded.)
> I think just finding the beginning should be enough, and I can patch
> mh-e for that. The alternative is saving the attachment in a tmp file
> and referencing that file in the mml construct.
If you can patch mh-e I think that's the best solution, because relying
on the temporary file with the bug script output can be problematic if
the user decides to postpone sending the report. The temp file could be
gone when the user finally decides to send it, for example after a
reboot. This also means that we're unable to clean up by removing the
temporary file, because we can't easily determine when it's not needed
anymore, but that's admittedly only a minor annoyance.
--- a/elisp/debian-el/debian-bug.el 2010-04-28 21:37:18.000000000 +0000
+++ b/elisp/debian-el/debian-bug.el 2010-05-06 21:43:52.000000000 +0000
@@ -687,7 +687,193 @@
(call-process "uname" nil '(t t) nil "-a")
(forward-line -5))))
-(defun debian-bug-package (&optional package)
+(defun debian-bug-help-presubj (package)
+ "Display contents of /usr/share/bug/PACKAGE/presubj."
+ (let ((presubj (concat "/usr/share/bug/" package "/presubj")))
+ (if (file-readable-p presubj)
+ (with-output-to-temp-buffer "*Help*"
+ (with-current-buffer "*Help*"
+ (insert-file-contents presubj))))))
+
+(defun debian-bug-file-is-executable (file)
+ "Return non-nil if FILE is executable. Otherwise nil is returned."
+ (and
+ (file-regular-p file)
+ (string-match "-..x..x..x" (nth 8 (file-attributes file)))))
+
+(defun debian-bug-find-bug-script (package)
+ "Return the full path name of the bug script of PACKAGE, if such
+script exists. Otherwise nil is returned."
+ (let ((script-alt1 (concat "/usr/share/bug/" package "/script"))
+ (script-alt2 (concat "/usr/share/bug/" package)))
+ (cond
+ ((debian-bug-file-is-executable script-alt1) script-alt1)
+ ((debian-bug-file-is-executable script-alt2) script-alt2))))
+
+(defun debian-bug-script-sentinel
+ (process event package severity subject filename
+ bug-script-temp-file win-config)
+ "This function is the process sentinel for bug script processes,'
+and when called, if the process has terminated, this function cleans
+up the buffer used by the process and proceeds to the next step in the
+bug reporting process by calling `debian-bug-compose-report'. Note that
+this process sentinel is different from regular process sentinels in
+that it requires more arguments. So, it cannot be assigned to a process
+with `set-process-sentinel' directly, but requires some tweaking instead."
+ (if (memq (process-status process) '(exit signal))
+ (let* ((bug-script-buffer
+ (process-buffer process))
+ (bug-script-buffer-empty
+ (= (buffer-size bug-script-buffer) 0)))
+
+ ;; Call the process sentinel provided by the term module, to
+ ;; clean up the terminal buffer. The sentinel will print a
+ ;; message in the buffer, so we have been careful to check
+ ;; whether the buffer is empty above, before this call.
+ ;; Note, XEmacs' term module doesn't provide this sentinel.
+ (if (fboundp 'term-sentinel)
+ (term-sentinel process event))
+
+ ;; The reportbug program doesn't seem to care about the exit
+ ;; status of a bug script, so we won't do it either.
+ ;; (if (/= (process-exit-status process) 0)
+ ;; (error (concat "Error occured while collecting"
+ ;; " information about the package")))
+
+ ;; If there is a window displaying the bug script buffer,
+ ;; restore the original window configuration, because it
+ ;; might have been changed when the bug script buffer was
+ ;; displayed. Otherwise, if the buffer isn't visible,
+ ;; assume that the window configuration hasn't changed, so
+ ;; don't restore anything.
+ (if (get-buffer-window bug-script-buffer)
+ (set-window-configuration win-config))
+
+ ;; If the process output buffer still exists, kill it if it's
+ ;; empty, otherwise bury it.
+ (if (buffer-name bug-script-buffer)
+ (if bug-script-buffer-empty
+ (kill-buffer bug-script-buffer)
+ (bury-buffer bug-script-buffer)))
+
+ (debian-bug-compose-report package severity subject filename
+ bug-script-temp-file))))
+
+(defun debian-bug-run-bug-script (package severity subject filename)
+ "Run a script, if provided by PACKAGE, to collect information
+about the package which should be supplied with the bug report,
+and then proceed to the next step in the bug reporting process by
+calling `debian-bug-compose-report'."
+ (let ((handler "/usr/share/reportbug/handle_bugscript")
+ (bug-script (debian-bug-find-bug-script package)))
+ (if (and bug-script
+ (debian-bug-file-is-executable handler)
+ (if (featurep 'xemacs)
+ (or (featurep 'term) (load "term" 'noerror))
+ (require 'term nil 'noerror)))
+ (let ((bug-script-buffer
+ (get-buffer-create "*debian-bug-script*"))
+ (bug-script-temp-file
+ (cond ((fboundp 'make-temp-file) ;; XEmacs doesn't know
+ (make-temp-file "debian-bug-")) ;; make-temp-file.
+ ((fboundp 'temp-directory)
+ (make-temp-name (expand-file-name
+ "debian-bug-" (temp-directory))))
+ (t (error "Cannot create temporary file"))))
+ (bug-script-process)
+
+ ;; XEmacs' term module doesn't set the appropriate
+ ;; coding system for process output from term-exec.
+ ;; Thus the following workaround, otherwise the terminal
+ ;; displayed by XEmacs can get messed up.
+ (coding-system-for-read 'binary))
+
+ (message (concat "Collecting information about the package."
+ " This may take some time."))
+ (with-current-buffer bug-script-buffer
+ (erase-buffer)
+ (term-mode)
+ (term-exec bug-script-buffer "debian-bug-script" handler nil
+ (list bug-script bug-script-temp-file))
+ (setq bug-script-process
+ (get-buffer-process bug-script-buffer))
+
+ ;; The process sentinel should handle process termination.
+ ;; Note that we need to pass more information to the
+ ;; process sentinel than just the process object and event
+ ;; type. Ideally, the process property list seems suitable
+ ;; for this purpose, but that is only supported in GNU
+ ;; Emacs 22 and later. So, a hack is used to construct the
+ ;; process sentinel with the required data on the fly.
+ ;; However, I suspect there are better ways to do this,
+ ;; perhaps to use lexical-let.
+ (set-process-sentinel
+ bug-script-process
+ (list 'lambda '(process event)
+ (list 'debian-bug-script-sentinel 'process 'event
+ package severity subject filename
+ bug-script-temp-file
+ (current-window-configuration))))
+
+ (term-char-mode)
+
+ ;; The function set-process-query-on-exit-flag is only
+ ;; available in GNU Emacs version 22 and later.
+ (if (fboundp 'set-process-query-on-exit-flag)
+ (set-process-query-on-exit-flag bug-script-process nil)))
+
+ ;; Delay switching to the process output buffer by waiting
+ ;; for output from the process, the process to terminate or
+ ;; 200 seconds, because ideally we don't want to display the
+ ;; buffer unless the process will be requesting input, but
+ ;; it's no way to tell that in advance. If the process
+ ;; prints to stdout, it's likely it will be expecting input,
+ ;; so we display the buffer. If the process terminates with
+ ;; no output, we simply don't do anything; the process
+ ;; sentinel will kill the buffer, and proceed, upon process
+ ;; termination.
+ (accept-process-output bug-script-process 200)
+
+ ;; Short wait required here for the process-status to be
+ ;; updated. (Maybe a bug in Emacs?)
+ (sleep-for 0.050)
+ (if (not (memq (process-status bug-script-process)
+ '(exit signal)))
+ (switch-to-buffer-other-window bug-script-buffer)))
+
+ (debian-bug-compose-report package severity subject filename))))
+
+(defun debian-bug-insert-bug-script-temp-file (temp-file)
+ "Insert the output from the bug script, if any, into the current
+buffer in the appropriate place."
+ (when (and temp-file (file-readable-p temp-file))
+ (save-excursion
+ (next-line 1)
+ (insert "\n")
+ (insert "-- Package-specific info:\n")
+ (let ((beg (point))
+ (end (+ (point)
+ (nth 1 (insert-file-contents temp-file)))))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-max))
+ (beginning-of-line)
+ (when (not (looking-at "$"))
+ (end-of-line)
+ (insert "\n"))
+ (when (or (and (boundp 'mml-mode) mml-mode)
+ (memq mail-user-agent '(mh-e-user-agent
+ message-user-agent
+ gnus-user-agent)))
+ (mml-quote-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert "<#part type=\"text/plain\" disposition=attachment"
+ " description=\"Bug script output\">\n")
+ (goto-char (point-max))
+ (insert "<#/part>\n"))))
+ (delete-file temp-file))))
+
+(defun debian-bug-package (&optional package filename)
"Submit a Debian bug report about PACKAGE."
(if (or (not package) (string= "" package))
(save-window-excursion
@@ -714,50 +900,63 @@
(completing-read "Severity (default normal): "
debian-bug-severity-alist
nil t nil nil "normal")))
- (subject (read-string "(Very) brief summary of problem: ")))
-;;; (require 'reporter)
- (reporter-compose-outgoing)
- (if (and (equal mail-user-agent 'gnus-user-agent)
- (string-equal " *nntpd*" (buffer-name)))
- (set-buffer "*mail*")) ; Bug in emacs21.1? Moves to " *nntpd*"
- (goto-char (point-min))
- (when (re-search-forward "^cc:" nil t)
- (delete-region (match-beginning 0)(match-end 0))
- (insert "X-Debbugs-CC:"))
- (goto-char (point-min))
- (cond
- ((re-search-forward "To: " nil t)
- (insert debian-bug-mail-address))
- ((re-search-forward "To:" nil t)
- (insert " " debian-bug-mail-address))
- (t
- (insert "To: " debian-bug-mail-address)))
- (if (string-equal severity "minor")
- (debian-bug--set-bts-address "mainto...@bugs.debian.org"))
- (goto-char (point-min))
- (cond
- ((re-search-forward "Subject: " nil t)
- (insert package ": " subject))
- ((re-search-forward "Subject:" nil t)
- (insert " " package ": " subject))
- (t
- (insert "Subject: " package ": " subject)))
- (require 'sendmail)
- (goto-char (mail-header-end))
- (forward-line 1)
- (if (looking-at "^<#secure") ;Skip over mml directives
- (forward-line 1))
- (message "Getting package information from reportbug...")
- (debian-bug-prefill-report package severity)
- (message "Getting package information from reportbug...done")
- (if debian-bug-use-From-address
- (debian-bug--set-custom-From))
- (if debian-bug-always-CC-myself
- (debian-bug--set-CC debian-bug-From-address "X-Debbugs-CC:"))
- (set-window-start (selected-window) (point-min) t)
- (setq debian-bug-package-name package)
- (debian-bug-minor-mode 1)
- (set-buffer-modified-p nil))))
+ (subject (save-window-excursion
+ (debian-bug-help-presubj package)
+ (read-string "(Very) brief summary of problem: "))))
+ (debian-bug-run-bug-script package severity subject filename))))
+
+(defun debian-bug-compose-report
+ (package severity subject filename &optional bug-script-temp-file)
+"Compose the initial contents of the bug report and present it in
+a buffer to be completed by the user."
+;;; (require 'reporter)
+ (reporter-compose-outgoing)
+ (if (and (equal mail-user-agent 'gnus-user-agent)
+ (string-equal " *nntpd*" (buffer-name)))
+ (set-buffer "*mail*")) ; Bug in emacs21.1? Moves to " *nntpd*"
+ (goto-char (point-min))
+ (when (re-search-forward "^cc:" nil t)
+ (delete-region (match-beginning 0)(match-end 0))
+ (insert "X-Debbugs-CC:"))
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "To: " nil t)
+ (insert debian-bug-mail-address))
+ ((re-search-forward "To:" nil t)
+ (insert " " debian-bug-mail-address))
+ (t
+ (insert "To: " debian-bug-mail-address)))
+ (if (string-equal severity "minor")
+ (debian-bug--set-bts-address "mainto...@bugs.debian.org"))
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "Subject: " nil t)
+ (insert package ": " subject))
+ ((re-search-forward "Subject:" nil t)
+ (insert " " package ": " subject))
+ (t
+ (insert "Subject: " package ": " subject)))
+ (require 'sendmail)
+ (goto-char (mail-header-end))
+ (forward-line 1)
+ (if (looking-at "^<#secure") ;Skip over mml directives
+ (forward-line 1))
+ (message "Getting package information from reportbug...")
+ (debian-bug-prefill-report package severity)
+ (message "Getting package information from reportbug...done")
+ (if debian-bug-use-From-address
+ (debian-bug--set-custom-From))
+ (if debian-bug-always-CC-myself
+ (debian-bug--set-CC debian-bug-From-address "X-Debbugs-CC:"))
+ (when filename
+ (forward-char -1)
+ (insert "File: " filename "\n")
+ (forward-char 1))
+ (debian-bug-insert-bug-script-temp-file bug-script-temp-file)
+ (set-window-start (selected-window) (point-min) t)
+ (setq debian-bug-package-name package)
+ (debian-bug-minor-mode 1)
+ (set-buffer-modified-p nil))
;;; ---------
;;; WNPP interface by Peter S Galbraith <p...@debian.org>, August 4th 2001
@@ -2086,10 +2285,7 @@
(let ((answer (y-or-n-p (format "File is in package %s; continue? "
package))))
(when answer
- (debian-bug-package package)
- (save-excursion
- (forward-char -1)
- (insert "File: " filename "\n"))))))))))
+ (debian-bug-package package filename)))))))))
;;;###autoload
(defun debian-bug ()
