*** dist/Makefile.dist Sat Jun 23 18:57:59 2001 --- Makefile Sat Oct 27 17:35:41 2001 *************** *** 50,51 **** --- 50,52 ---- vm-version.elc \ + vm-crypto.elc \ vm-delete.elc vm-digest.elc vm-easymenu.elc vm-edit.elc vm-folder.elc \ *************** *** 62,63 **** --- 63,65 ---- vm-version.el \ + vm-crypto.el \ vm-delete.el vm-digest.el vm-easymenu.el vm-edit.el vm-folder.el \ *************** *** 142,143 **** --- 144,149 ---- @$(EMACS) $(BATCHFLAGS) -l $(BYTEOPTS) -f batch-byte-compile vm-autoload.el + + vm-crypto.elc: vm-crypto.el $(CORE) + @echo compiling vm-crypto.el... + @$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-crypto.el *** dist/vm-crypto.el.dist Sun Oct 28 21:44:30 2001 --- vm-crypto.el Sun Oct 28 22:05:22 2001 *************** *** 0 **** --- 1,166 ---- + ;;; Encryption and related functions for VM + ;;; Copyright (C) 2001 Kyle E. Jones + ;;; + ;;; This program is free software; you can redistribute it and/or modify + ;;; it under the terms of the GNU General Public License as published by + ;;; the Free Software Foundation; either version 1, or (at your option) + ;;; any later version. + ;;; + ;;; This program is distributed in the hope that it will be useful, + ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;;; GNU General Public License for more details. + ;;; + ;;; You should have received a copy of the GNU General Public License + ;;; along with this program; if not, write to the Free Software + ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ;; compatibility + (fset 'vm-pop-md5 'vm-md5-string) + + (defun vm-md5-region (start end) + (if (fboundp 'md5) + (md5 (current-buffer) start end) + (let ((buffer nil) + (retval nil) + (curbuf (current-buffer))) + (unwind-protect + (save-excursion + (setq buffer (vm-make-work-buffer)) + (set-buffer buffer) + (insert-buffer-substring curbuf start end) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (setq selective-display nil) + (setq retval + (call-process-region (point-min) (point-max) + vm-pop-md5-program + t buffer nil)) + (if (not (equal retval 0)) + (progn + (error "%s failed: exited with code %s" + vm-pop-md5-program retval))) + (goto-char (point-min)) + (if (or (re-search-forward "[^0-9a-f\n]" nil t) + (< (point-max) 32)) + (error "%s produced bogus MD5 digest '%s'" + vm-pop-md5-program + (vm-buffer-substring-no-properties (point-min) + (point-max)))) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32))) + (and buffer (kill-buffer buffer)))))) + + ;; output is in hex + (defun vm-md5-string (string) + (if (fboundp 'md5) + (md5 string) + (vm-with-string-as-temp-buffer + string (function + (lambda () + (goto-char (point-min)) + (insert (vm-md5-region (point-min) (point-max))) + (delete-region (point) (point-max))))))) + + ;; output is the raw digest bits, not hex + (defun vm-md5-raw-string (s) + (setq s (vm-md5-string s)) + (let ((raw (make-string 16 0)) + (i 0) n + (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) + (?C . 12) (?D . 13) (?E . 14) (?F . 15) + ;; some mailer uses lower-case hex + ;; digits despite this being forbidden + ;; by the MIME spec. + (?a . 10) (?b . 11) (?c . 12) (?d . 13) + (?e . 14) (?f . 15)))) + (while (< i 32) + (setq n (+ (* (cdr (assoc (aref s i) hex-digit-alist)) 16) + (cdr (assoc (aref s (1+ i)) hex-digit-alist)))) + (aset raw (/ i 2) n) + (setq i (+ i 2))) + raw )) + + (defun vm-xor-string (s1 s2) + (let ((len (length s1)) + result (i 0)) + (if (/= len (length s2)) + (error "strings not of equal length")) + (setq result (make-string len 0)) + (while (< i len) + (aset result i (logxor (aref s1 i) (aref s2 i))) + (setq i (1+ i))) + result )) + + (defun vm-setup-ssh-tunnel (host port) + (let (local-port process done) + (while (not done) + (setq local-port (+ 1025 (random (- 65536 1025))) + process nil) + (condition-case nil + (progn + (setq process + (open-network-stream "TEST-CONNECTION" nil + "127.0.0.1" local-port)) + (process-kill-without-query process)) + (error nil)) + (cond ((null process) + (setq process + (apply 'start-process + (format "SSH tunnel to %s:%s" host port) + nil + vm-ssh-program + (nconc + (list "-L" + (format "%d:%s:%s" local-port host port)) + vm-ssh-program-switches + (list host) + (list vm-ssh-remote-command))) + done t) + (process-kill-without-query process)) + (t + (delete-process process)))) + ;; give ssh time to establish the connection. + ;; probably should have the remote command output something + ;; back thorugh the connection and run accept-process-output + ;; until we see it on this end. + (sleep-for 1) + local-port )) + + (defun vm-generate-random-data-file (n-octets) + (let ((file (vm-make-tempfile)) + work-buffer (i n-octets)) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (while (> i 0) + (insert-char (random 256) 1) + (setq i (1- i))) + (write-region (point-min) (point-max) file nil 0)) + (and work-buffer (kill-buffer work-buffer))) + file )) + + (defun vm-setup-stunnel-random-data-if-needed () + (cond ((null vm-stunnel-random-data-method) nil) + ((eq vm-stunnel-random-data-method 'generate) + (if (and (stringp vm-stunnel-random-data-file) + (file-readable-p vm-stunnel-random-data-file)) + nil + (setq vm-stunnel-random-data-file + (vm-generate-random-data-file (* 4 1024))))))) + + (defun vm-tear-down-stunnel-random-data () + (if (stringp vm-stunnel-random-data-file) + (vm-error-free-call 'delete-file vm-stunnel-random-data-file)) + (setq vm-stunnel-random-data-file nil)) + + (defun vm-stunnel-random-data-args () + (cond ((null vm-stunnel-random-data-method) nil) + ((eq vm-stunnel-random-data-method 'generate) + (list "-R" vm-stunnel-random-data-file)) + (t nil))) *** dist/vm-folder.el.dist Wed Sep 5 22:28:03 2001 --- vm-folder.el Fri Oct 26 11:40:50 2001 *************** *** 3522,3523 **** --- 3522,3525 ---- (vm-imap-ok-to-ask interactive) + ;; for string-match calls below + (case-fold-search nil) this-buffer crash in maildrop meth *************** *** 3572,3573 **** --- 3574,3577 ---- (vm-imap-ok-to-ask interactive) + ;; for string-match calls below + (case-fold-search nil) non-file-maildrop crash in safe-maildrop maildrop popdrop *************** *** 3668,3673 **** (defun vm-safe-popdrop-string (drop) ! (or (and (string-match "^\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop) ! (concat (substring drop (match-beginning 2) (match-end 2)) "@" ! (substring drop (match-beginning 1) (match-end 1)))) "???")) --- 3672,3677 ---- (defun vm-safe-popdrop-string (drop) ! (or (and (string-match "^\\(pop:\\|pop-ssl:\\|pop-ssh:\\)?\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop) ! (concat (substring drop (match-beginning 3) (match-end 3)) "@" ! (substring drop (match-beginning 2) (match-end 2)))) "???")) *************** *** 3675,3682 **** (defun vm-safe-imapdrop-string (drop) ! (or (and (string-match "^imap:\\([^:]+\\):[^:]+:\\([^:]+\\):[^:]+:\\([^:]+\\):[^:]+" drop) ! (concat (substring drop (match-beginning 3) (match-end 3)) "@" - (substring drop (match-beginning 1) (match-end 1)) - " [" (substring drop (match-beginning 2) (match-end 2)) "]")) --- 3679,3686 ---- (defun vm-safe-imapdrop-string (drop) ! (or (and (string-match "^\\(imap\\|imap-ssl\\|imap-ssh\\):\\([^:]+\\):[^:]+:\\([^:]+\\):[^:]+:\\([^:]+\\):[^:]+" drop) ! (concat (substring drop (match-beginning 4) (match-end 4)) "@" (substring drop (match-beginning 2) (match-end 2)) + " [" + (substring drop (match-beginning 3) (match-end 3)) "]")) *** dist/vm-imap.el.dist Wed Sep 5 22:28:03 2001 --- vm-imap.el Sun Oct 28 21:47:25 2001 *************** *** 395,396 **** --- 395,400 ---- (coding-system-for-write (vm-binary-coding-system)) + (use-ssl nil) + (use-ssh nil) + (session-name "IMAP") + (process-connection-type nil) greeting timestamp *************** *** 410,411 **** --- 414,425 ---- (vm-imapdrop-sans-password-and-mailbox source)) + (cond ((equal "imap-ssl" (car source-list)) + (setq use-ssl t + session-name "IMAP over SSL") + (if (null vm-stunnel-program) + (error "vm-stunnel-program must be non-nil to use IMAP over SSL."))) + ((equal "imap-ssh" (car source-list)) + (setq use-ssh t + session-name "IMAP over SSH") + (if (null vm-ssh-program) + (error "vm-ssh-program must be non-nil to use IMAP over SSH.")))) ;; carp if parts are missing *************** *** 447,449 **** (setq process-buffer ! (vm-make-work-buffer (format "trace of IMAP session to %s" host))) --- 461,464 ---- (setq process-buffer ! (vm-make-work-buffer (format "trace of %s session to %s" ! session-name host))) *************** *** 452,453 **** --- 467,469 ---- (buffer-disable-undo process-buffer) + (make-local-variable 'vm-imap-read-point) ;; clear the trace buffer of old output *************** *** 464,475 **** (set-process-buffer process (current-buffer)) ! (insert "starting IMAP session " (current-time-string) "\n") (insert (format "connecting to %s:%s\n" host port)) ;; open the connection to the server ! (setq process (open-network-stream "IMAP" process-buffer ! host port)) (and (null process) (throw 'end-of-session nil)) ! (insert "connected\n")) ! (process-kill-without-query process) ! (make-local-variable 'vm-imap-read-point) (setq vm-imap-read-point (point)) (if (null (setq greeting (vm-imap-read-greeting process))) --- 480,507 ---- (set-process-buffer process (current-buffer)) ! (insert "starting " session-name ! " session " (current-time-string) "\n") (insert (format "connecting to %s:%s\n" host port)) ;; open the connection to the server ! (cond (use-ssl ! (vm-setup-stunnel-random-data-if-needed) ! (setq process ! (apply 'start-process session-name process-buffer ! vm-stunnel-program ! (nconc (vm-stunnel-random-data-args) ! (list "-W" "-c" "-r" ! (format "%s:%s" host port)) ! vm-stunnel-program-switches)))) ! (use-ssh ! (setq process (open-network-stream ! session-name process-buffer ! "127.0.0.1" ! (vm-setup-ssh-tunnel host port)))) ! (t ! (setq process (open-network-stream session-name ! process-buffer ! host port)))) (and (null process) (throw 'end-of-session nil)) ! (insert-before-markers "connected\n")) (setq vm-imap-read-point (point)) + (process-kill-without-query process) (if (null (setq greeting (vm-imap-read-greeting process))) *************** *** 550,552 **** (if process-to-shutdown ! (vm-imap-end-session process-to-shutdown t))))) --- 582,585 ---- (if process-to-shutdown ! (vm-imap-end-session process-to-shutdown t)) ! (vm-tear-down-stunnel-random-data)))) *************** *** 623,625 **** (vm-imap-stat-y-got o)) ! " (stalled)" ""))))) --- 656,661 ---- (vm-imap-stat-y-got o)) ! (cond ((>= (vm-imap-stat-x-got o) ! (vm-imap-stat-x-need o)) ! "(post processing)") ! (t " (stalled)")) ""))))) *************** *** 926,929 **** (defun vm-imap-cleanup-region (start end) - (if (> (- end start) 30000) - (message "CRLF conversion and char unstuffing...")) (setq end (vm-marker end)) --- 962,963 ---- *************** *** 934,937 **** (replace-match "\n" t t))) - (if (> (- end start) 30000) - (message "CRLF conversion and char unstuffing... done")) (set-marker end nil)) --- 968,969 ---- *** dist/vm-mime.el.dist Wed Sep 5 22:28:04 2001 --- vm-mime.el Sat Oct 27 16:11:31 2001 *************** *** 809,815 **** type (vm-get-header-contents m "Content-Type:") qtype (vm-mime-parse-content-header type ?\; t) type (vm-mime-parse-content-header type ?\;) ! encoding (or (vm-get-header-contents ! m "Content-Transfer-Encoding:") ! "7bit") encoding (or (car --- 809,823 ---- type (vm-get-header-contents m "Content-Type:") + version (if (or version + vm-mime-require-mime-version-header) + version + (if type "1.0" nil)) qtype (vm-mime-parse-content-header type ?\; t) type (vm-mime-parse-content-header type ?\;) ! encoding (vm-get-header-contents ! m "Content-Transfer-Encoding:") ! version (if (or version ! vm-mime-require-mime-version-header) ! version ! (if encoding "1.0" nil)) ! encoding (or encoding "7bit") encoding (or (car *************** *** 1117,1120 **** (use-local-map vm-mode-map) ! (and (vm-toolbar-support-possible-p) vm-use-toolbar ! (vm-toolbar-install-toolbar)) (and (vm-menu-support-possible-p) --- 1125,1127 ---- (use-local-map vm-mode-map) ! (vm-toolbar-install-or-uninstall-toolbar) (and (vm-menu-support-possible-p) *************** *** 2400,2427 **** (image-type-available-p image-type)) ! (let ((start (point-marker)) end tempfile ! (coding-system-for-write (vm-binary-coding-system)) (selective-display nil) (buffer-read-only nil)) ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (vm-mime-transfer-decode-region layout start end) ! (setq tempfile (vm-make-tempfile-name)) ! ;; Write an empty tempfile out to disk and set its ! ;; permissions to 0600, then write the actual buffer ! ;; contents to tempfile. ! (write-region start start tempfile nil 0) ! (set-file-modes tempfile 384) ! (write-region start end tempfile nil 0) ! ;; keep one char so we can attach the image to it. ! (delete-region start (1- end)) ! (put-text-property (1- end) end 'display ! (list 'image ! ':type image-type ! ':file tempfile)) ! (save-excursion ! (vm-select-folder-buffer) ! (setq vm-folder-garbage-alist ! (cons (cons tempfile 'delete-file) ! vm-folder-garbage-alist))) ! (if (not (save-excursion (goto-char start) (bolp))) (insert-char ?\n 2) --- 2407,2447 ---- (image-type-available-p image-type)) ! (let (start end tempfile image work-buffer (selective-display nil) (buffer-read-only nil)) ! (if (setq image (cdr (assq 'vm-mime-display-internal-image-xxxx ! (vm-mm-layout-cache layout)))) ! nil ! (unwind-protect ! (progn ! (save-excursion ! (setq work-buffer (vm-make-work-buffer)) ! (set-buffer work-buffer) ! (setq start (point)) ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (vm-mime-transfer-decode-region layout start end) ! (setq tempfile (vm-make-tempfile-name)) ! (let ((coding-system-for-write (vm-binary-coding-system))) ! ;; Write an empty tempfile out to disk and set its ! ;; permissions to 0600, then write the actual buffer ! ;; contents to tempfile. ! (write-region start start tempfile nil 0) ! (set-file-modes tempfile 384) ! (write-region start end tempfile nil 0)) ! (setq image (list 'image ':type image-type ':file tempfile)) ! (vm-set-mm-layout-cache ! layout ! (nconc (vm-mm-layout-cache layout) ! (list (cons 'vm-mime-display-internal-image-xxxx ! image))))) ! (save-excursion ! (vm-select-folder-buffer) ! (setq vm-folder-garbage-alist ! (cons (cons tempfile 'delete-file) ! vm-folder-garbage-alist)))) ! (and work-buffer (kill-buffer work-buffer)))) ! ;; insert one char so we can attach the image to it. ! (insert "z") ! (put-text-property (1- (point)) (point) 'display image) ! (if (not (save-excursion (goto-char (1- (point))) (bolp))) (insert-char ?\n 2) *************** *** 3103,3107 **** (let ((filename (or (vm-mime-get-disposition-parameter layout "filename") ! (and (vm-mime-types-match ! "application" (car (vm-mm-layout-type layout))) ! (vm-mime-get-parameter layout "name")))) (suffix nil) i) --- 3123,3125 ---- (let ((filename (or (vm-mime-get-disposition-parameter layout "filename") ! (vm-mime-get-parameter layout "name"))) (suffix nil) i) *************** *** 3815,3823 **** (interactive) ! (cond (vm-xemacs-p ! (vm-mime-xemacs-encode-composition)) ! (vm-fsfemacs-p ! (vm-mime-fsfemacs-encode-composition)) ! (t ! (error "don't know how to MIME encode composition for %s" ! (emacs-version))))) --- 3833,3850 ---- (interactive) ! (buffer-enable-undo) ! (let ((unwind-needed t) ! (mybuffer (current-buffer))) ! (unwind-protect ! (progn ! (cond (vm-xemacs-p ! (vm-mime-xemacs-encode-composition)) ! (vm-fsfemacs-p ! (vm-mime-fsfemacs-encode-composition)) ! (t ! (error "don't know how to MIME encode composition for %s" ! (emacs-version)))) ! (setq unwind-needed nil)) ! (and unwind-needed (consp buffer-undo-list) ! (eq mybuffer (current-buffer)) ! (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))))) *************** *** 4808,4811 **** (vm-mime-get-disposition-parameter layout "filename") ! (and (vm-mime-types-match "application" (car (vm-mm-layout-type layout))) ! (vm-mime-get-parameter layout "name")) "")) --- 4835,4837 ---- (vm-mime-get-disposition-parameter layout "filename") ! (vm-mime-get-parameter layout "name") "")) *** dist/vm-misc.el.dist Wed Sep 5 22:28:04 2001 --- vm-misc.el Sat Oct 27 18:21:06 2001 *************** *** 607,608 **** --- 607,620 ---- + (defun vm-make-tempfile (&optional filename-suffix) + (let ((modes (default-file-modes)) + (file (vm-make-tempfile-name filename-suffix))) + (unwind-protect + (progn + ;; mode 600 + (set-default-file-modes (* 6 8 8)) + (vm-error-free-call 'delete-file file) + (write-region (point) (point) file nil 0)) + (set-default-file-modes modes)) + file )) + (defun vm-make-tempfile-name (&optional filename-suffix) *************** *** 611,615 **** (setq filename (convert-standard-filename ! (expand-file-name (format "vm%d%s" vm-tempfile-counter ! (or filename-suffix "")) vm-temp-file-directory)) --- 623,628 ---- (setq filename (convert-standard-filename ! (expand-file-name (format "vm%d%d%s" vm-tempfile-counter ! (random 100000000) ! (or filename-suffix "")) vm-temp-file-directory)) *************** *** 853,933 **** (delete-region (- (point) 1) (- (point) 4)))))) - - (defun vm-md5-region (start end) - (if (fboundp 'md5) - (md5 (current-buffer) start end) - (let ((buffer nil) - (retval nil) - (curbuf (current-buffer))) - (unwind-protect - (save-excursion - (setq buffer (vm-make-work-buffer)) - (set-buffer buffer) - (insert-buffer-substring curbuf start end) - ;; call-process-region calls write-region. - ;; don't let it do CR -> LF translation. - (setq selective-display nil) - (setq retval - (call-process-region (point-min) (point-max) - (or shell-file-name "/bin/sh") - t buffer nil - shell-command-switch - vm-pop-md5-program)) - (if (not (equal retval 0)) - (progn - (error "%s failed: exited with code %s" - vm-pop-md5-program retval))) - (goto-char (point-min)) - (if (or (re-search-forward "[^0-9a-f\n]" nil t) - (< (point-max) 32)) - (error "%s produced bogus MD5 digest '%s'" - vm-pop-md5-program - (vm-buffer-substring-no-properties (point-min) - (point-max)))) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32))) - (and buffer (kill-buffer buffer)))))) - - ;; output is in hex - (defun vm-md5-string (string) - (if (fboundp 'md5) - (md5 string) - (vm-with-string-as-temp-buffer - string (function - (lambda () - (goto-char (point-min)) - (insert (vm-md5-region (point-min) (point-max))) - (delete-region (point) (point-max))))))) - - ;; output is the raw digest bits, not hex - (defun vm-md5-raw-string (s) - (setq s (vm-md5-string s)) - (let ((raw (make-string 16 0)) - (i 0) n - (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) - (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) - (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) - (?C . 12) (?D . 13) (?E . 14) (?F . 15) - ;; some mailer uses lower-case hex - ;; digits despite this being forbidden - ;; by the MIME spec. - (?a . 10) (?b . 11) (?c . 12) (?d . 13) - (?e . 14) (?f . 15)))) - (while (< i 32) - (setq n (+ (* (cdr (assoc (aref s i) hex-digit-alist)) 16) - (cdr (assoc (aref s (1+ i)) hex-digit-alist)))) - (aset raw (/ i 2) n) - (setq i (+ i 2))) - raw )) - - (defun vm-xor-string (s1 s2) - (let ((len (length s1)) - result (i 0)) - (if (/= len (length s2)) - (error "strings not of equal length")) - (setq result (make-string len 0)) - (while (< i len) - (aset result i (logxor (aref s1 i) (aref s2 i))) - (setq i (1+ i))) - result )) --- 866 ---- *** dist/vm-pop.el.dist Wed Sep 5 22:28:04 2001 --- vm-pop.el Sat Oct 27 18:43:32 2001 *************** *** 347,349 **** (coding-system-for-write (vm-binary-coding-system)) ! greeting timestamp host port auth user pass source-list process-buffer source-nopwd) --- 347,353 ---- (coding-system-for-write (vm-binary-coding-system)) ! (use-ssl nil) ! (use-ssh nil) ! (session-name "POP") ! (process-connection-type nil) ! greeting timestamp ssh-process host port auth user pass source-list process-buffer source-nopwd) *************** *** 352,355 **** ;; parse the maildrop ! (setq source-list (vm-parse source "\\([^:]+\\):?") ! host (nth 0 source-list) port (nth 1 source-list) --- 356,374 ---- ;; parse the maildrop ! (setq source-list (vm-parse source "\\([^:]+\\):?")) ! ;; remove pop or pop-ssl from beginning of list if ! ;; present. ! (if (= 6 (length source-list)) ! (progn ! (cond ((equal "pop-ssl" (car source-list)) ! (setq use-ssl t ! session-name "POP over SSL") ! (if (null vm-stunnel-program) ! (error "vm-stunnel-program must be non-nil to use POP over SSL."))) ! ((equal "pop-ssh" (car source-list)) ! (setq use-ssh t ! session-name "POP over SSH") ! (if (null vm-ssh-program) ! (error "vm-ssh-program must be non-nil to use POP over SSH.")))) ! (setq source-list (cdr source-list)))) ! (setq host (nth 0 source-list) port (nth 1 source-list) *************** *** 397,399 **** (setq process-buffer ! (vm-make-work-buffer (format "trace of POP session to %s" host))) --- 416,419 ---- (setq process-buffer ! (vm-make-work-buffer (format "trace of %s session to %s" ! session-name host))) *************** *** 402,403 **** --- 422,424 ---- (buffer-disable-undo process-buffer) + (make-local-variable 'vm-pop-read-point) ;; clear the trace buffer of old output *************** *** 407,417 **** (set-buffer-file-coding-system (vm-binary-coding-system) t)) ! (insert "starting POP session " (current-time-string) "\n") (insert (format "connecting to %s:%s\n" host port)) ;; open the connection to the server ! (setq process (open-network-stream "POP" process-buffer host port)) (and (null process) (throw 'done nil)) ! (insert "connected\n") ! (process-kill-without-query process) ! (make-local-variable 'vm-pop-read-point) (setq vm-pop-read-point (point)) (if (null (setq greeting (vm-pop-read-response process t))) --- 428,455 ---- (set-buffer-file-coding-system (vm-binary-coding-system) t)) ! (insert "starting " session-name ! " session " (current-time-string) "\n") (insert (format "connecting to %s:%s\n" host port)) ;; open the connection to the server ! (cond (use-ssl ! (vm-setup-stunnel-random-data-if-needed) ! (setq process ! (apply 'start-process session-name process-buffer ! vm-stunnel-program ! (nconc (vm-stunnel-random-data-args) ! (list "-W" "-c" "-r" ! (format "%s:%s" host port)) ! vm-stunnel-program-switches)))) ! (use-ssh ! (setq process (open-network-stream ! session-name process-buffer ! "127.0.0.1" ! (vm-setup-ssh-tunnel host port)))) ! (t ! (setq process (open-network-stream session-name ! process-buffer ! host port)))) (and (null process) (throw 'done nil)) ! (insert-before-markers "connected\n") (setq vm-pop-read-point (point)) + (process-kill-without-query process) (if (null (setq greeting (vm-pop-read-response process t))) *************** *** 473,475 **** (if process-to-shutdown ! (vm-pop-end-session process-to-shutdown t))))) --- 511,514 ---- (if process-to-shutdown ! (vm-pop-end-session process-to-shutdown t)) ! (vm-tear-down-stunnel-random-data)))) *************** *** 558,560 **** (vm-pop-stat-y-got o)) ! " (stalled)" ""))))) --- 597,602 ---- (vm-pop-stat-y-got o)) ! (cond ((>= (vm-pop-stat-x-got o) ! (vm-pop-stat-x-need o)) ! "(post processing)") ! (t " (stalled)")) ""))))) *************** *** 729,731 **** (goto-char opoint))) - (vm-set-pop-stat-x-got statblob nil) (setq vm-pop-read-point (point-marker)) --- 771,772 ---- *************** *** 734,735 **** --- 775,777 ---- (vm-pop-cleanup-region start end) + (vm-set-pop-stat-x-got statblob nil) ;; Some POP servers strip leading and trailing message *************** *** 773,776 **** (defun vm-pop-cleanup-region (start end) - (if (> (- end start) 30000) - (message "CRLF conversion and char unstuffing...")) (setq end (vm-marker end)) --- 815,816 ---- *************** *** 786,815 **** (forward-char))) - (if (> (- end start) 30000) - (message "CRLF conversion and char unstuffing... done")) (set-marker end nil)) - (defun vm-pop-md5 (string) - (let ((buffer nil)) - (unwind-protect - (save-excursion - (setq buffer (vm-make-work-buffer)) - (set-buffer buffer) - ;; call-process-region calls write-region. - ;; don't let it do CR -> LF translation. - (setq selective-display nil) - (insert string) - (if (fboundp 'md5) - (progn - (goto-char (point-min)) - (insert (md5 buffer (point-min) (point-max))) - (delete-region (point) (point-max))) - (call-process-region (point-min) (point-max) - (or shell-file-name "/bin/sh") t buffer nil - shell-command-switch vm-pop-md5-program)) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32))) - (and buffer (kill-buffer buffer))))) - (defun vm-popdrop-sans-password (source) --- 826,829 ---- *************** *** 817,818 **** --- 831,834 ---- (setq source-list (vm-parse source "\\([^:]+\\):?")) + (if (= 6 (length source-list)) + (setq source-list (cdr source-list))) (concat (nth 0 source-list) ":" *** dist/vm-reply.el.dist Wed Sep 5 22:28:04 2001 --- vm-reply.el Sun Oct 21 21:46:02 2001 *************** *** 1093,1095 **** --- 1093,1100 ---- + ;;;###autoload (defun vm-mail-to-mailto-url (url) + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (vm-check-for-killed-summary) (let ((list (vm-parse url "^mailto:\\([^?]+\\)\\??\\|\\([^&]+\\)&?" *************** *** 1114,1117 **** (setq list (cdr list))) - (vm-select-folder-buffer) - (vm-check-for-killed-summary) (vm-mail-internal nil to subject in-reply-to cc references newsgroups) --- 1119,1120 ---- *************** *** 1264,1265 **** --- 1267,1269 ---- (mail-position-on-field "To")) + (add-hook 'post-command-hook 'vm-update-composition-buffer-name t) (run-hooks 'mail-setup-hook))) *************** *** 1456,1457 **** --- 1460,1486 ---- (and temp-buffer (kill-buffer temp-buffer))))) + + (defun vm-update-composition-buffer-name () + (if (and (eq major-mode 'mail-mode) + (save-match-data (string-match "^\\(mail\\|reply\\) to " + (buffer-name)))) + (let ((to (mail-fetch-field "To")) + (cc (mail-fetch-field "Cc")) + (curbufname (buffer-name)) + (deactivate-mark) + fmt newbufname + (ellipsis "")) + (cond (vm-reply-list (setq fmt "reply to %s%s")) + (t (setq fmt "mail to %s%s"))) + (setq to (vm-parse-addresses to) + cc (vm-parse-addresses cc)) + (if (or (cdr to) + (and (car to) (car cc))) + (setq ellipsis ", ...")) + (setq newbufname (or (car to) (car cc) "foo (?)") + newbufname (funcall vm-chop-full-name-function newbufname) + newbufname (or (car newbufname) (car (cdr newbufname))) + newbufname (format fmt newbufname ellipsis)) + (if (equal newbufname curbufname) + nil + (rename-buffer newbufname t))))) *** dist/vm-startup.el.dist Wed Sep 5 22:28:04 2001 --- vm-startup.el Sun Oct 28 22:12:02 2001 *************** *** 230,237 **** ;; toolbar sets frame-specific height and width specifiers. ! (and (vm-toolbar-support-possible-p) vm-use-toolbar ! (progn ! (message "Initializing toolbar...") ! (vm-toolbar-install-toolbar) ! (message "Initializing toolbar... done") ! (vm-toolbar-update-toolbar))) --- 230,232 ---- ;; toolbar sets frame-specific height and width specifiers. ! (vm-toolbar-install-or-uninstall-toolbar) *************** *** 344,346 **** ! This is VM 6.96. --- 339,341 ---- ! This is VM 6.97. *************** *** 884,887 **** (vm-display nil nil (list this-command) (list this-command 'startup)) ! (and (vm-toolbar-support-possible-p) vm-use-toolbar ! (vm-toolbar-install-toolbar)) (if first-time --- 879,881 ---- (vm-display nil nil (list this-command) (list this-command 'startup)) ! (vm-toolbar-install-or-uninstall-toolbar) (if first-time *************** *** 1068,1071 **** (set-buffer vm-folders-summary-buffer) ! (and (vm-toolbar-support-possible-p) vm-use-toolbar ! (vm-toolbar-install-toolbar))) (vm-display nil nil '(vm-folders-summarize) --- 1062,1064 ---- (set-buffer vm-folders-summary-buffer) ! (vm-toolbar-install-or-uninstall-toolbar)) (vm-display nil nil '(vm-folders-summarize) *************** *** 1121,1124 **** (require 'reporter) ! (require 'vm-version) ! (require 'vm-vars) ;; Use VM to send the bug report. Could be trouble if vm-mail --- 1114,1116 ---- (require 'reporter) ! (vm-session-initialization) ;; Use VM to send the bug report. Could be trouble if vm-mail *** dist/vm-summary.el.dist Wed Sep 5 22:28:04 2001 --- vm-summary.el Sat Oct 27 15:00:52 2001 *************** *** 92,95 **** (set-buffer vm-summary-buffer) ! (and (vm-toolbar-support-possible-p) vm-use-toolbar ! (vm-toolbar-install-toolbar))) (vm-display nil nil '(vm-summarize vm-summarize-other-frame) --- 92,94 ---- (set-buffer vm-summary-buffer) ! (vm-toolbar-install-or-uninstall-toolbar)) (vm-display nil nil '(vm-summarize vm-summarize-other-frame) *** dist/vm-thread.el.dist Wed Sep 5 22:28:04 2001 --- vm-thread.el Sun Oct 28 21:41:44 2001 *************** *** 224,227 **** (setq id-sym (aref (symbol-value subject-sym) 0) ! loop-recovery-point (or loop-recovery-point ! thread-list) loop-sym (intern (symbol-name id-sym) --- 224,229 ---- (setq id-sym (aref (symbol-value subject-sym) 0) ! ;; seems to cause more trouble than it fixes ! ;; revisit this later. ! ;; loop-recovery-point (or loop-recovery-point ! ;; thread-list) loop-sym (intern (symbol-name id-sym) *************** *** 313,318 **** (or (car (vm-last (vm-th-references m))) ! (let (in-reply-to) ! (setq in-reply-to (vm-get-header-contents m "In-Reply-To:" " ")) ! (and in-reply-to ! (car (vm-parse in-reply-to "[^<]*\\(<[^>]+>\\)")))))))) --- 315,326 ---- (or (car (vm-last (vm-th-references m))) ! (let (in-reply-to ids id) ! (setq in-reply-to (vm-get-header-contents m "In-Reply-To:" " ") ! ids (and in-reply-to (vm-parse in-reply-to ! "[^<]*\\(<[^>]+>\\)"))) ! (while ids ! (if (< (length id) (length (car ids))) ! (setq id (car ids))) ! (setq ids (cdr ids))) ! (and id (vm-set-references-of m (list id))) ! id ))))) *** dist/vm-toolbar.el.dist Wed Sep 5 22:28:05 2001 --- vm-toolbar.el Sat Oct 27 17:56:21 2001 *************** *** 327,329 **** --- 327,341 ---- + (defun vm-toolbar-install-or-uninstall-toolbar () + (and (vm-toolbar-support-possible-p) vm-use-toolbar + (vm-toolbar-install-toolbar)) + (if (and vm-fsfemacs-p (not vm-use-toolbar)) + (vm-toolbar-fsfemacs-uninstall-toolbar))) + (defun vm-toolbar-install-toolbar () + ;; drag these in now instead of waiting for them to be + ;; autoloaded. the "loading..." messages could come at a bad + ;; moment and wipe an important echo area message, like "Auto + ;; save file is newer..." + (require 'vm-save) + (require 'vm-summary) (if vm-fsfemacs-p *************** *** 416,423 **** (defun vm-toolbar-initialize () - ;; drag these in now instead of waiting for them to be - ;; autoloaded. the "loading..." messages could come at a bad - ;; moment and wipe an important echo area message, like "Auto - ;; save file is newer..." - (require 'vm-save) - (require 'vm-summary) (cond --- 428,429 ---- *************** *** 492,493 **** --- 498,503 ---- + (defun vm-toolbar-fsfemacs-uninstall-toolbar () + (define-key vm-mode-map [toolbar] nil) + (setq vm-fsfemacs-toolbar-installed-p nil)) + (defun vm-toolbar-fsfemacs-install-toolbar () *************** *** 530,532 **** (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir)) (setq item --- 540,543 ---- (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir ! (if (eq sym 'mime) nil 'heuristic))) (setq item *************** *** 543,545 **** (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir)) (setq item --- 554,556 ---- (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir 'heuristic)) (setq item *************** *** 556,558 **** (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir)) (setq item --- 567,569 ---- (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir 'heuristic)) (setq item *************** *** 571,573 **** (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir)) (setq item --- 582,584 ---- (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir 'heuristic)) (setq item *************** *** 583,585 **** (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir)) (setq item --- 594,596 ---- (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir 'heuristic)) (setq item *************** *** 596,598 **** (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir)) (setq item --- 607,609 ---- (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir 'heuristic)) (setq item *************** *** 611,613 **** (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir)) (setq item --- 622,624 ---- (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec ! name extension dir nil)) (setq item *************** *** 625,627 **** ! (defun vm-toolbar-make-fsfemacs-toolbar-image-spec (name extension dir) (if (string= extension "xpm") --- 636,638 ---- ! (defun vm-toolbar-make-fsfemacs-toolbar-image-spec (name extension dir mask) (if (string= extension "xpm") *************** *** 630,632 **** ':type (intern extension) ! ':mask 'heuristic ':file (expand-file-name --- 641,643 ---- ':type (intern extension) ! ':mask mask ':file (expand-file-name *************** *** 637,639 **** ':type (intern extension) ! ':mask 'heuristic ':file (expand-file-name --- 648,650 ---- ':type (intern extension) ! ':mask mask ':file (expand-file-name *************** *** 644,646 **** ':type (intern extension) ! ':mask 'heuristic ':file (expand-file-name --- 655,657 ---- ':type (intern extension) ! ':mask mask ':file (expand-file-name *************** *** 651,653 **** ':type (intern extension) ! ':mask 'heuristic ':file (expand-file-name --- 662,664 ---- ':type (intern extension) ! ':mask mask ':file (expand-file-name *************** *** 659,661 **** ':type (intern extension) ! ':mask 'heuristic ':file (expand-file-name --- 670,672 ---- ':type (intern extension) ! ':mask mask ':file (expand-file-name *************** *** 666,668 **** ':type (intern extension) ! ':mask 'heuristic ':file (expand-file-name --- 677,679 ---- ':type (intern extension) ! ':mask mask ':file (expand-file-name *************** *** 673,675 **** ':type (intern extension) ! ':mask 'heuristic ':file (expand-file-name --- 684,686 ---- ':type (intern extension) ! ':mask mask ':file (expand-file-name *************** *** 680,682 **** ':type (intern extension) ! ':mask 'heuristic ':file (expand-file-name --- 691,693 ---- ':type (intern extension) ! ':mask mask ':file (expand-file-name *** dist/vm-vars.el.dist Wed Sep 5 22:28:05 2001 --- vm-vars.el Sun Oct 28 22:09:21 2001 *************** *** 113,115 **** ! \"HOST:PORT:AUTH:USER:PASSWORD\" --- 113,124 ---- ! \"pop:HOST:PORT:AUTH:USER:PASSWORD\" ! or ! \"pop-ssl:HOST:PORT:AUTH:USER:PASSWORD\" ! or ! \"pop-ssh:HOST:PORT:AUTH:USER:PASSWORD\" ! ! The second form is used to speak POP over a SSL connection. ! You must have the stunnel program installed and the variable ! vm-stunnel-program naming it in order for IMAP over SSL to ! work. *************** *** 143,144 **** --- 152,167 ---- \"imap:HOST:PORT:MAILBOX:AUTH:USER:PASSWORD\" + or + \"imap-ssl:HOST:PORT:MAILBOX:AUTH:USER:PASSWORD\" + or + \"imap-ssh:HOST:PORT:MAILBOX:AUTH:USER:PASSWORD\" + + The second form is used to speak IMAP over a SSL connection. + You must have the stunnel program installed and the variable + vm-stunnel-program naming it in order for IMAP over SSL to + work. + + The third form is used to speak IMAP over a SSH connection. + You must have the ssh program installed and the variable + `vm-ssh-program' must name it in order for IMAP over SSH to + work. *************** *** 305,307 **** ! (defvar vm-recognize-pop-maildrops "^[^:]+:[^:]+:[^:]+:[^:]+:[^:]+" "*Value if non-nil should be a regular expression that matches --- 328,330 ---- ! (defvar vm-recognize-pop-maildrops "^\\(pop:\\|pop-ssl:\\|pop-ssh:\\)?[^:]+:[^:]+:[^:]+:[^:]+:[^:]+" "*Value if non-nil should be a regular expression that matches *************** *** 367,369 **** ! (defvar vm-recognize-imap-maildrops "^imap:[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:[^:]+" "*Value if non-nil should be a regular expression that matches --- 390,392 ---- ! (defvar vm-recognize-imap-maildrops "^\\(imap\\|imap-ssl\\|imap-ssh\\):[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:[^:]+" "*Value if non-nil should be a regular expression that matches *************** *** 534,538 **** ! (defvar vm-use-lucid-highlighting ! ;; (not (not ...)) to avoid the confusing value of 6. ! (not (not (string-match "XEmacs" emacs-version))) "*Non-nil means to use the `highlight-headers' package in XEmacs. --- 557,563 ---- ! (defvar vm-use-lucid-highlighting (condition-case nil ! (progn ! (require 'highlight-headers) ! t ) ! (error nil)) "*Non-nil means to use the `highlight-headers' package in XEmacs. *************** *** 548,550 **** This variable is ignored under XEmacs if `vm-use-lucid-highlighting' is ! nil. XEmacs' highlight-headers package is used instead. See the documentation for the function `highlight-headers' to find out how to --- 573,575 ---- This variable is ignored under XEmacs if `vm-use-lucid-highlighting' is ! non-nil. XEmacs' highlight-headers package is used instead. See the documentation for the function `highlight-headers' to find out how to *************** *** 576,578 **** "*Column beyond which automatic line-wrapping should happen when ! doing re-filling lines longer than the value of `vm-fill-paragraphs-containing-long-lines'.") --- 601,603 ---- "*Column beyond which automatic line-wrapping should happen when ! re-filling lines longer than the value of `vm-fill-paragraphs-containing-long-lines'.") *************** *** 594,596 **** ;; this is t because at this time (11 April 1997) Solaris is ! ;; generated too many mangled MIME version headers. For the same ;; reason vm-mime-avoid-folding-content-type is also set to t. --- 619,621 ---- ;; this is t because at this time (11 April 1997) Solaris is ! ;; generating too many mangled MIME version headers. For the same ;; reason vm-mime-avoid-folding-content-type is also set to t. *************** *** 604,605 **** --- 629,637 ---- + (defvar vm-mime-require-mime-version-header t + "Non-nil means a message must contain MIME-Version to be considered MIME. + The MIME standard requires that MIME messages contain a MIME-Version, + but some mailers ignore the standard and do not send the header. Set + this variable to nil if you want VM to be lax and parse such messages + as MIME anyway.") + (defvar vm-send-using-mime t *************** *** 3064,3065 **** --- 3096,3134 ---- + (defvar vm-stunnel-program "stunnel" + "*Name of program to use to run stunnel. + This is used to make SSL connections to POP and IMAP servers that + support SSL. Set this to nil and VM will not use it.") + + (defvar vm-stunnel-program-switches nil + "*List of command line switches to pass to stunnel.") + + (defvar vm-stunnel-random-data-method 'generate + "*Specifies what VM should do about sending the PRNG. + The stunnel program uses the OpenSSL library which requires a + certain amount of random data to seed its pseudo-random number + generator. VM can generate this data using Emacs' random number + generator or it can rely on stunnel to find the data by itself + somehow. Some systems have a /dev/urandom device that stunnel + can use. Some system have a entropy gathering daemon that can be + tapped for random data. If sufficient random data cannot be + found, the OpenSSL library will refuse wto work and stunnel will + not be able to estaible an SSL connection. + + Setting `vm-stunnel-random-data-method' to the symbol `generate' + tells VM to generate the random data. + + A nil value tells VM to do nothing and let stunnel find the data + if it can.") + + (defvar vm-ssh-program "ssh" + "*Name of program to use to run SSH. + This is used to build an SSH tunnel to remote POP and IMAP servers. + Set this to nil and VM will not use it.") + + (defvar vm-ssh-program-switches nil + "*List of command line switches to pass to SSH.") + + (defvar vm-ssh-remote-command "sleep 15" + "*Shell command to run to hold open the SSH connection.") + (defvar vm-temp-file-directory *************** *** 4064 **** --- 4133,4134 ---- (defvar shell-command-switch "-c")) + (defvar vm-stunnel-random-data-file nil) *** dist/vm-version.el.dist Wed Sep 5 22:28:05 2001 --- vm-version.el Sun Oct 28 22:12:02 2001 *************** *** 4,6 **** ! (defconst vm-version "6.96" "Version number of VM.") --- 4,6 ---- ! (defconst vm-version "6.97" "Version number of VM.")