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