|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-vm.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
42
|
6 ;; Version: #Revision: 1.1 $
|
|
22
|
7 ;; RCS:
|
|
|
8 ;; Description: Allows the VM mail reader to access folders using efs.
|
|
|
9 ;; If you are looking for support for VM/CMS, see efs-cms.el.
|
|
|
10 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
11 ;; Created: Mon Nov 9 23:49:18 1992 by sandy on riemann
|
|
|
12 ;; Modified: Sun Nov 27 18:44:07 1994 by sandy on gandalf
|
|
|
13 ;;
|
|
|
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
15
|
|
|
16 ;; If vm-get-new-mail (usually bound to "g") is given a prefix, it
|
|
|
17 ;; will prompt for a folder from which to collect mail. With
|
|
|
18 ;; efs-vm, this folder can be in efs syntax. As is usual
|
|
|
19 ;; with VM, this folder will not be deleted. If at the folder prompt,
|
|
|
20 ;; you give "/user@host:", efs-vm will collect mail from the
|
|
|
21 ;; spool file on the remote machine. The spool file will be deleted if
|
|
|
22 ;; the mail is successfully collected. It is not necessary for
|
|
|
23 ;; movemail, nor even emacs, to be installed on the remote machine.
|
|
|
24 ;; The functionality of movemail is mimicked with FTP commands. Both
|
|
|
25 ;; local and remote crashboxes are used, so that mail will not be lost
|
|
|
26 ;; if the FTP connection is lost.
|
|
|
27 ;;
|
|
|
28 ;; To use efs-vm, put (require 'efs-vm) in your .vm file.
|
|
|
29 ;;
|
|
|
30 ;; Works for vm 5.56 through 5.72. May not work with older versions.
|
|
|
31 ;; If vm grows some file-name-handler-alist support, we should use it.
|
|
|
32 ;; Actually it has. I just haven't gotten around to this yet.
|
|
|
33
|
|
|
34 ;;; Known Bugs:
|
|
|
35 ;;
|
|
|
36 ;; 1. efs-vm will not be able to collect mail from a spool file if
|
|
|
37 ;; you do not have write permission in the spool directory.
|
|
|
38 ;; I think that this precludes HP-UX.
|
|
|
39 ;; I hope to do something about this.
|
|
|
40 ;;
|
|
|
41 ;; 2. efs-vm is as clever as at can be about spool file locking.
|
|
|
42 ;; i.e. not very clever at all. At least it uses a rename command
|
|
|
43 ;; to minimize the window for problems. Use POP if you want to
|
|
|
44 ;; be careful.
|
|
|
45 ;;
|
|
|
46
|
|
|
47 ;;; Provisions, requirements, and autoloads
|
|
|
48
|
|
|
49 (provide 'efs-vm)
|
|
|
50 (require 'efs-cu)
|
|
|
51 (require 'efs-ovwrt)
|
|
|
52 (require 'vm)
|
|
|
53 ;(require 'vm-folder) ; not provided
|
|
|
54 (if (or (not (fboundp 'vm-get-new-mail))
|
|
|
55 (eq (car-safe (symbol-function 'vm-get-new-mail)) 'autoload))
|
|
|
56 (load-library "vm-folder"))
|
|
|
57 (autoload 'efs-make-tmp-name "efs")
|
|
|
58 (autoload 'efs-del-tmp-name "efs")
|
|
|
59 (autoload 'efs-send-cmd "efs")
|
|
|
60 (autoload 'efs-re-read-dir "efs")
|
|
|
61 (autoload 'efs-copy-file-internal "efs")
|
|
|
62
|
|
|
63 ;;; User variables
|
|
|
64
|
|
|
65 (defvar efs-vm-spool-files nil
|
|
|
66 "Association list of \( USER@MACHINE . SPOOLFILES \) pairs that
|
|
|
67 specify the location of the default remote spool file for MACHINE. SPOOLFILES
|
|
|
68 is a list of remote spool files.")
|
|
|
69
|
|
|
70 (defvar efs-vm-crash-box "~/EFS.INBOX.CRASH"
|
|
|
71 "Local file where efs keeps its local crash boxes.")
|
|
|
72
|
|
|
73 ;;; Internal variables
|
|
|
74
|
|
|
75 (defconst efs-vm-version
|
|
|
76 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
77 "/"
|
|
42
|
78 (substring "#Revision: 1.1 $" 11 -2)))
|
|
22
|
79
|
|
|
80
|
|
|
81 (defun efs-vm-get-new-mail (&optional arg)
|
|
|
82 "Documented as original"
|
|
|
83 (interactive "P")
|
|
|
84 (vm-select-folder-buffer)
|
|
|
85 (vm-check-for-killed-summary)
|
|
|
86 (vm-error-if-virtual-folder)
|
|
|
87 (vm-error-if-folder-read-only)
|
|
|
88 (cond
|
|
|
89 ((null arg)
|
|
|
90 (if (not (eq major-mode 'vm-mode))
|
|
|
91 (vm-mode))
|
|
|
92 (if (consp (car (vm-spool-files)))
|
|
|
93 (message "Checking for new mail for %s..." buffer-file-name)
|
|
|
94 (message "Checking for new mail..."))
|
|
|
95 (let (new-messages totals-blurb)
|
|
|
96 (if (and (vm-get-spooled-mail)
|
|
|
97 (setq new-messages (vm-assimilate-new-messages t)))
|
|
|
98 (progn
|
|
|
99 (if vm-arrived-message-hook
|
|
|
100 (while new-messages
|
|
|
101 (vm-run-message-hook (car new-messages)
|
|
|
102 'vm-arrived-message-hook)
|
|
|
103 (setq new-messages (cdr new-messages))))
|
|
|
104 ;; say this NOW, before the non-previewers read
|
|
|
105 ;; a message, alter the new message count and
|
|
|
106 ;; confuse themselves.
|
|
|
107 (setq totals-blurb (vm-emit-totals-blurb))
|
|
|
108 (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
|
|
|
109 (if (vm-thoughtfully-select-message)
|
|
|
110 (vm-preview-current-message)
|
|
|
111 (vm-update-summary-and-mode-line))
|
|
|
112 (message totals-blurb))
|
|
|
113 (if (consp (car (vm-spool-files)))
|
|
|
114 (message "No new mail for %s" buffer-file-name)
|
|
|
115 (message "No new mail."))
|
|
|
116 (sit-for 4)
|
|
|
117 (message ""))))
|
|
|
118 (t
|
|
|
119 (let* ((buffer-read-only nil)
|
|
|
120 (folder (read-file-name "Gather mail from folder: "
|
|
|
121 vm-folder-directory t))
|
|
|
122 (parsed (efs-ftp-path folder))
|
|
|
123 mcount new-messages totals-blurb)
|
|
|
124 (if parsed
|
|
|
125 (if (string-equal (nth 2 parsed) "")
|
|
|
126 ;; a spool file
|
|
|
127 (if (not (and (efs-vm-get-remote-spooled-mail folder)
|
|
|
128 (setq new-messages
|
|
|
129 (vm-assimilate-new-messages t))))
|
|
|
130 (progn
|
|
|
131 (message
|
|
|
132 "No new mail, or mail couldn't be retrieved by ftp.")
|
|
|
133 ;; don't let this message stay up forever...
|
|
|
134 (sit-for 4)
|
|
|
135 (message ""))
|
|
|
136 (if vm-arrived-message-hook
|
|
|
137 (while new-messages
|
|
|
138 (vm-run-message-hook (car new-messages)
|
|
|
139 'vm-arrived-message-hook)
|
|
|
140 (setq new-messages (cdr new-messages))))
|
|
|
141 ;; say this NOW, before the non-previewers read
|
|
|
142 ;; a message, alter the new message count and
|
|
|
143 ;; confuse themselves.
|
|
|
144 (setq totals-blurb (vm-emit-totals-blurb))
|
|
|
145 (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
|
|
|
146 (if (vm-thoughtfully-select-message)
|
|
|
147 (vm-preview-current-message)
|
|
|
148 (vm-update-summary-and-mode-line))
|
|
|
149 (message totals-blurb))
|
|
|
150
|
|
|
151 ;; a remote folder
|
|
|
152 (let ((tmp-file (car (efs-make-tmp-name nil (car parsed))))
|
|
|
153 (folder (expand-file-name folder)))
|
|
|
154 (unwind-protect
|
|
|
155 (progn
|
|
|
156 (efs-copy-file-internal
|
|
|
157 folder parsed tmp-file nil t nil
|
|
|
158 (format "Getting %s" folder)
|
|
|
159 ;; asynch worries me here
|
|
|
160 nil nil)
|
|
|
161 (if (and vm-check-folder-types
|
|
|
162 (not (vm-compatible-folder-p tmp-file)))
|
|
|
163 (error
|
|
|
164 "Folder %s is not the same format as this folder."
|
|
|
165 folder))
|
|
|
166 (save-excursion
|
|
|
167 (vm-save-restriction
|
|
|
168 (widen)
|
|
|
169 (goto-char (point-max))
|
|
|
170 (insert-file-contents tmp-file)))
|
|
|
171 (setq mcount (length vm-message-list))
|
|
|
172 (if (setq new-messages (vm-assimilate-new-messages))
|
|
|
173 (progn
|
|
|
174 (if vm-arrived-message-hook
|
|
|
175 (while new-messages
|
|
|
176 (vm-run-message-hook (car new-messages)
|
|
|
177 'vm-arrived-message-hook)
|
|
|
178 (setq new-messages (cdr new-messages))))
|
|
|
179 ;; say this NOW, before the non-previewers read
|
|
|
180 ;; a message, alter the new message count and
|
|
|
181 ;; confuse themselves.
|
|
|
182 (setq totals-blurb (vm-emit-totals-blurb))
|
|
|
183 (vm-display nil nil '(vm-get-new-mail)
|
|
|
184 '(vm-get-new-mail))
|
|
|
185 (if (vm-thoughtfully-select-message)
|
|
|
186 (vm-preview-current-message)
|
|
|
187 (vm-update-summary-and-mode-line))
|
|
|
188 (message totals-blurb)
|
|
|
189 ;; The gathered messages are actually still on disk
|
|
|
190 ;; unless the user deletes the folder himself.
|
|
|
191 ;; However, users may not understand what happened if
|
|
|
192 ;; the messages go away after a "quit, no save".
|
|
|
193 (setq vm-messages-not-on-disk
|
|
|
194 (+ vm-messages-not-on-disk
|
|
|
195 (- (length vm-message-list)
|
|
|
196 mcount))))
|
|
|
197 (message "No messages gathered."))
|
|
|
198 (efs-del-tmp-name tmp-file)))))
|
|
|
199
|
|
|
200 ;; local
|
|
|
201
|
|
|
202 (if (and vm-check-folder-types
|
|
|
203 (not (vm-compatible-folder-p folder)))
|
|
|
204 (error "Folder %s is not the same format as this folder."
|
|
|
205 folder))
|
|
|
206 (save-excursion
|
|
|
207 (vm-save-restriction
|
|
|
208 (widen)
|
|
|
209 (goto-char (point-max))
|
|
|
210 (insert-file-contents folder)))
|
|
|
211 (setq mcount (length vm-message-list))
|
|
|
212 (if (setq new-messages (vm-assimilate-new-messages))
|
|
|
213 (progn
|
|
|
214 (if vm-arrived-message-hook
|
|
|
215 (while new-messages
|
|
|
216 (vm-run-message-hook (car new-messages)
|
|
|
217 'vm-arrived-message-hook)
|
|
|
218 (setq new-messages (cdr new-messages))))
|
|
|
219 ;; say this NOW, before the non-previewers read
|
|
|
220 ;; a message, alter the new message count and
|
|
|
221 ;; confuse themselves.
|
|
|
222 (setq totals-blurb (vm-emit-totals-blurb))
|
|
|
223 (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
|
|
|
224 (if (vm-thoughtfully-select-message)
|
|
|
225 (vm-preview-current-message)
|
|
|
226 (vm-update-summary-and-mode-line))
|
|
|
227 (message totals-blurb)
|
|
|
228 ;; The gathered messages are actually still on disk
|
|
|
229 ;; unless the user deletes the folder himself.
|
|
|
230 ;; However, users may not understand what happened if
|
|
|
231 ;; the messages go away after a "quit, no save".
|
|
|
232 (setq vm-messages-not-on-disk
|
|
|
233 (+ vm-messages-not-on-disk
|
|
|
234 (- (length vm-message-list)
|
|
|
235 mcount))))
|
|
|
236 (message "No messages gathered.")))))))
|
|
|
237
|
|
|
238 (defun efs-vm-gobble-remote-crash-box (remote-crash-box)
|
|
|
239 (let ((remote-crash-box (expand-file-name remote-crash-box))
|
|
|
240 (crash-box (expand-file-name efs-vm-crash-box))
|
|
|
241 lsize)
|
|
|
242 (if (file-exists-p vm-crash-box)
|
|
|
243 (progn
|
|
|
244 ;; This should never happen, but let's make sure that we never
|
|
|
245 ;; clobber mail.
|
|
|
246 (message "Recovering messages from local crash box...")
|
|
|
247 (vm-gobble-crash-box efs-vm-crash-box)
|
|
|
248 (message "Recovering messages from local crash box... done")))
|
|
|
249 (efs-copy-file-internal remote-crash-box (efs-ftp-path remote-crash-box)
|
|
|
250 crash-box nil nil nil
|
|
|
251 (format "Getting %s" remote-crash-box)
|
|
|
252 ;; asynch worries me here
|
|
|
253 nil nil)
|
|
|
254 ;; only delete the remote crash box if we are sure that we have everything
|
|
|
255 (if (and (setq lsize (nth 7 (file-attributes crash-box)))
|
|
|
256 (eq lsize (nth 7 (file-attributes remote-crash-box)))
|
|
|
257 (vm-compatible-folder-p crash-box))
|
|
|
258 (progn
|
|
|
259 (vm-gobble-crash-box crash-box)
|
|
|
260 (delete-file remote-crash-box))
|
|
|
261 ;; don't leave garbage in the local crash box
|
|
|
262 (condition-case () (delete-file crash-box) (error nil))
|
|
|
263 (error "Problem reading remote crash box %s" remote-crash-box))))
|
|
|
264
|
|
|
265 (defun efs-vm-get-remote-spooled-mail (remote-path)
|
|
|
266 ;; remote-path is usually of the form /user@machine:
|
|
|
267 ;; Usually vm sets inhibit-quit to t for this. This is probably
|
|
|
268 ;; a bad idea if there is ftp activity.
|
|
|
269 ;; I don't want to assume that the remote machine has movemail.
|
|
|
270 ;; Try to mimic movemail with ftp commands as best as possible.
|
|
|
271 ;; For this to work, we need to be able to create a subdirectory
|
|
|
272 ;; in the spool directory.
|
|
|
273 (if vm-block-new-mail
|
|
|
274 (error "Can't get new mail until you save this folder."))
|
|
|
275 (let* ((parsed (efs-ftp-path remote-path))
|
|
|
276 (host (car parsed))
|
|
|
277 (user (nth 1 parsed))
|
|
|
278 (spool-files
|
|
|
279 (or (cdr (assoc (concat user "@" host)
|
|
|
280 efs-vm-spool-files))
|
|
|
281 (list (concat "/usr/spool/mail/" user))))
|
|
|
282 got-mail)
|
|
|
283 (while spool-files
|
|
|
284 (let* ((s-file (car spool-files))
|
|
|
285 (spool-file (format efs-path-format-string user host s-file))
|
|
|
286 ;; rmdir and mkdir bomb if this path ends in a /.
|
|
|
287 (c-dir (concat s-file ".CRASHBOX"))
|
|
|
288 (rc-file (concat c-dir "/CRASHBOX"))
|
|
|
289 (crash-dir (concat spool-file ".CRASHBOX/"))
|
|
|
290 (remote-crash-file (concat crash-dir "CRASHBOX"))
|
|
|
291 (crash-box (expand-file-name efs-vm-crash-box)))
|
|
|
292 (if (file-exists-p crash-box)
|
|
|
293 (progn
|
|
|
294 (message "Recovering messages from crash box...")
|
|
|
295 (vm-gobble-crash-box crash-box)
|
|
|
296 (message "Recovering messages from crash box... done")
|
|
|
297 (setq got-mail t)))
|
|
|
298 (if (let ((efs-allow-child-lookup nil))
|
|
|
299 (file-exists-p remote-crash-file))
|
|
|
300 (progn
|
|
|
301 (message "Recovering messages from remote crash box...")
|
|
|
302 (efs-vm-gobble-remote-crash-box remote-crash-file)
|
|
|
303 (message "Recovering messages from remote crash box... done")
|
|
|
304 (setq got-mail t)))
|
|
|
305 (if (file-exists-p crash-box)
|
|
|
306 (progn
|
|
|
307 (message "Recovering messages from crash box...")
|
|
|
308 (vm-gobble-crash-box crash-box)
|
|
|
309 (message "Recovering messages from crash box... done")
|
|
|
310 (setq got-mail t)))
|
|
|
311 (unwind-protect
|
|
|
312 (if (car
|
|
|
313 (efs-send-cmd
|
|
|
314 host user (list 'mkdir c-dir)
|
|
|
315 (format "Making crash directory %s" crash-dir)))
|
|
|
316 (progn
|
|
|
317 (efs-re-read-dir crash-dir)
|
|
|
318 (message "Unable to make crash directory %s" crash-dir)
|
|
|
319 (ding))
|
|
|
320 (or (car
|
|
|
321 (efs-send-cmd host user (list 'rename s-file rc-file)
|
|
|
322 (format "Checking spool file %s" spool-file)))
|
|
|
323 (progn
|
|
|
324 (message "Getting new mail from %s..." spool-file)
|
|
|
325 ;; The rename above wouldn't have updated the cash.
|
|
|
326 (efs-re-read-dir crash-dir)
|
|
|
327 (efs-vm-gobble-remote-crash-box remote-crash-file)
|
|
|
328 (message "Getting new mail from %s... done" spool-file)
|
|
|
329 (setq got-mail t))))
|
|
|
330 (condition-case nil
|
|
|
331 (efs-send-cmd
|
|
|
332 host user (list 'rmdir c-dir)
|
|
|
333 "Removing crash directory")
|
|
|
334 (error nil))))
|
|
|
335 (setq spool-files (cdr spool-files)))
|
|
|
336 got-mail))
|
|
|
337
|
|
|
338 ;;; Overwrite existing functions
|
|
|
339
|
|
|
340 (efs-overwrite-fn "efs" 'vm-get-new-mail)
|
|
|
341
|
|
|
342 ;;; end of efs-vm.el
|
