Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-pop.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 05472e90ae02
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; Simple POP (RFC 1939) client for VM 1 ;;; Simple POP (RFC 1460) client for VM
2 ;;; Copyright (C) 1993, 1994, 1997 Kyle E. Jones 2 ;;; Copyright (C) 1993, 1994 Kyle E. Jones
3 ;;; 3 ;;;
4 ;;; This program is free software; you can redistribute it and/or modify 4 ;;; This program is free software; you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by 5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation; either version 1, or (at your option) 6 ;;; the Free Software Foundation; either version 1, or (at your option)
7 ;;; any later version. 7 ;;; any later version.
22 ;; just as if we were using movemail on a spool file. 22 ;; just as if we were using movemail on a spool file.
23 (defun vm-pop-move-mail (source destination) 23 (defun vm-pop-move-mail (source destination)
24 (let ((process nil) 24 (let ((process nil)
25 (folder-type vm-folder-type) 25 (folder-type vm-folder-type)
26 (saved-password t) 26 (saved-password t)
27 (m-per-session vm-pop-messages-per-session)
28 (b-per-session vm-pop-bytes-per-session)
29 (handler (and (fboundp 'find-file-name-handler) 27 (handler (and (fboundp 'find-file-name-handler)
30 (condition-case () 28 (condition-case ()
31 (find-file-name-handler source 'vm-pop-move-mail) 29 (find-file-name-handler source 'vm-pop-move-mail)
32 (wrong-number-of-arguments 30 (wrong-number-of-arguments
33 (find-file-name-handler source))))) 31 (find-file-name-handler source)))))
34 (popdrop (vm-safe-popdrop-string source)) 32 (popdrop (vm-safe-popdrop-string source))
35 (statblob nil) 33 greeting timestamp n message-count
36 mailbox-count mailbox-size message-size response 34 host port auth user pass source-list process-buffer)
37 n retrieved retrieved-bytes process-buffer)
38 (unwind-protect 35 (unwind-protect
39 (catch 'done 36 (catch 'done
40 (if handler 37 (if handler
41 (throw 'done 38 (throw 'done
42 (funcall handler 'vm-pop-move-mail source destination))) 39 (funcall handler 'vm-pop-move-mail source destination)))
43 (setq process (vm-pop-make-session source))
44 (or process (throw 'done nil))
45 (setq process-buffer (process-buffer process))
46 (save-excursion
47 (set-buffer process-buffer)
48 (setq vm-folder-type (or folder-type vm-default-folder-type))
49 ;; find out how many messages are in the box.
50 (vm-pop-send-command process "STAT")
51 (setq response (vm-pop-read-stat-response process)
52 mailbox-count (nth 0 response)
53 mailbox-size (nth 1 response))
54 ;; forget it if the command fails
55 ;; or if there are no messages present.
56 (if (or (null mailbox-count)
57 (< mailbox-count 1))
58 (throw 'done nil))
59 ;; loop through the maildrop retrieving and deleting
60 ;; messages as we go.
61 (setq n 1 retrieved 0 retrieved-bytes 0)
62 (setq statblob (vm-pop-start-status-timer))
63 (vm-set-pop-stat-x-box statblob popdrop)
64 (vm-set-pop-stat-x-maxmsg statblob mailbox-count)
65 (while (and (<= n mailbox-count)
66 (or (not (natnump m-per-session))
67 (< retrieved m-per-session))
68 (or (not (natnump b-per-session))
69 (< retrieved-bytes b-per-session)))
70 (vm-set-pop-stat-x-currmsg statblob n)
71 (vm-pop-send-command process (format "LIST %d" n))
72 (setq message-size (vm-pop-read-list-response process))
73 (vm-set-pop-stat-x-need statblob message-size)
74 (if (and (integerp vm-pop-max-message-size)
75 (> message-size vm-pop-max-message-size)
76 (progn
77 (setq response
78 (if vm-pop-ok-to-ask
79 (vm-pop-ask-about-large-message process
80 message-size
81 n)
82 'skip))
83 (not (eq response 'retrieve))))
84 (if (eq response 'delete)
85 (progn
86 (message "Deleting message %d..." n)
87 (vm-pop-send-command process (format "DELE %d" n))
88 (and (null (vm-pop-read-response process))
89 (throw 'done (not (equal retrieved 0)))))
90 (if vm-pop-ok-to-ask
91 (message "Skipping message %d..." n)
92 (message "Skipping message %d in %s, too large (%d > %d)..."
93 n popdrop message-size vm-pop-max-message-size)))
94 (message "Retrieving message %d (of %d) from %s..."
95 n mailbox-count popdrop)
96 (vm-pop-send-command process (format "RETR %d" n))
97 (and (null (vm-pop-read-response process))
98 (throw 'done (not (equal retrieved 0))))
99 (and (null (vm-pop-retrieve-to-crashbox process destination
100 statblob))
101 (throw 'done (not (equal retrieved 0))))
102 (vm-increment retrieved)
103 (and b-per-session
104 (setq retrieved-bytes (+ retrieved-bytes message-size)))
105 (vm-pop-send-command process (format "DELE %d" n))
106 ;; DELE can't fail but Emacs or this code might
107 ;; blow a gasket and spew filth down the
108 ;; connection, so...
109 (and (null (vm-pop-read-response process))
110 (throw 'done (not (equal retrieved 0)))))
111 (vm-increment n))
112 (not (equal retrieved 0)) ))
113 (and statblob (vm-pop-stop-status-timer statblob))
114 (if process
115 (vm-pop-end-session process)))))
116
117 (defun vm-pop-check-mail (source)
118 (let ((process nil)
119 (handler (and (fboundp 'find-file-name-handler)
120 (condition-case ()
121 (find-file-name-handler source 'vm-pop-check-mail)
122 (wrong-number-of-arguments
123 (find-file-name-handler source)))))
124 response)
125 (unwind-protect
126 (save-excursion
127 (catch 'done
128 (if handler
129 (throw 'done
130 (funcall handler 'vm-pop-check-mail source)))
131 (setq process (vm-pop-make-session source))
132 (or process (throw 'done nil))
133 (set-buffer (process-buffer process))
134 (vm-pop-send-command process "STAT")
135 (setq response (vm-pop-read-stat-response process))
136 (if (null response)
137 nil
138 (not (equal 0 (car response))))))
139 (and process (vm-pop-end-session process)))))
140
141 (defun vm-pop-make-session (source)
142 (let ((process-to-shutdown nil)
143 process
144 (saved-password t)
145 (popdrop (vm-safe-popdrop-string source))
146 greeting timestamp
147 host port auth user pass source-list process-buffer)
148 (unwind-protect
149 (catch 'done
150 ;; parse the maildrop 40 ;; parse the maildrop
151 (setq source-list (vm-parse source "\\([^:]+\\):?") 41 (setq source-list (vm-parse source "\\([^:]+\\):?")
152 host (nth 0 source-list) 42 host (nth 0 source-list)
153 port (nth 1 source-list) 43 port (nth 1 source-list)
154 auth (nth 2 source-list) 44 auth (nth 2 source-list)
175 source)) 65 source))
176 (if (equal pass "*") 66 (if (equal pass "*")
177 (progn 67 (progn
178 (setq pass (car (cdr (assoc source vm-pop-passwords)))) 68 (setq pass (car (cdr (assoc source vm-pop-passwords))))
179 (if (null pass) 69 (if (null pass)
180 (if (null vm-pop-ok-to-ask) 70 (setq pass
181 (progn (message "Need password for %s" popdrop) 71 (vm-read-password
182 (throw 'done nil)) 72 (format "POP password for %s: "
183 (setq pass 73 popdrop))
184 (vm-read-password 74 vm-pop-passwords (cons (list source pass)
185 (format "POP password for %s: " 75 vm-pop-passwords)
186 popdrop)) 76 saved-password t))))
187 vm-pop-passwords (cons (list source pass)
188 vm-pop-passwords)
189 saved-password t)))))
190 ;; get the trace buffer 77 ;; get the trace buffer
191 (setq process-buffer 78 (setq process-buffer
192 (get-buffer-create (format "trace of POP session to %s" host))) 79 (get-buffer-create (format "trace of POP session to %s" host)))
193 ;; Tell XEmacs/MULE not to mess with the text.
194 (and vm-xemacs-mule-p
195 (set-buffer-file-coding-system 'binary t))
196 ;; clear the trace buffer of old output 80 ;; clear the trace buffer of old output
197 (save-excursion 81 (save-excursion
198 (set-buffer process-buffer) 82 (set-buffer process-buffer)
199 (buffer-disable-undo)
200 (erase-buffer)) 83 (erase-buffer))
201 ;; open the connection to the server 84 ;; open the connection to the server
202 (setq process (open-network-stream "POP" process-buffer host port)) 85 (setq process (open-network-stream "POP" process-buffer host port))
203 (and (null process) (throw 'done nil)) 86 (and (null process) (throw 'done nil))
204 (process-kill-without-query process) 87 (set-process-filter process 'vm-pop-process-filter)
205 (save-excursion 88 (save-excursion
206 (set-buffer process-buffer) 89 (set-buffer process-buffer)
207 (make-local-variable 'vm-pop-read-point) 90 (make-local-variable 'vm-pop-read-point)
208 (setq vm-pop-read-point (point-min)) 91 (setq vm-pop-read-point (point-min)
209 (if (null (setq greeting (vm-pop-read-response process t))) 92 vm-folder-type (or folder-type vm-default-folder-type))
210 (progn (delete-process process) 93 (and (null (setq greeting (vm-pop-read-response process t)))
211 (throw 'done nil))) 94 (throw 'done nil))
212 (setq process-to-shutdown process)
213 ;; authentication 95 ;; authentication
214 (cond ((equal auth "pass") 96 (cond ((equal auth "pass")
215 (vm-pop-send-command process (format "USER %s" user)) 97 (vm-pop-send-command process (format "USER %s" user))
216 (and (null (vm-pop-read-response process)) 98 (and (null (vm-pop-read-response process))
217 (throw 'done nil)) 99 (throw 'done nil))
234 (setq timestamp (vm-parse greeting "[^<]+\\(<[^>]+>\\)") 116 (setq timestamp (vm-parse greeting "[^<]+\\(<[^>]+>\\)")
235 timestamp (car timestamp)) 117 timestamp (car timestamp))
236 (if (null timestamp) 118 (if (null timestamp)
237 (progn 119 (progn
238 (goto-char (point-max)) 120 (goto-char (point-max))
239 (insert-before-markers "<<< ooops, no timestamp found in greeting! >>>\n") 121 (insert "<<< ooops, no timestamp found in greeting! >>>\n")
240 (throw 'done nil))) 122 (throw 'done nil)))
241 (vm-pop-send-command 123 (vm-pop-send-command
242 process 124 process
243 (format "APOP %s %s" 125 (format "APOP %s %s"
244 user 126 user
245 (vm-pop-md5 (concat timestamp pass)))) 127 (vm-pop-md5 (concat timestamp pass))))
246 (and (null (vm-pop-read-response process)) 128 (and (null (vm-pop-read-response process))
247 (throw 'done nil))) 129 (throw 'done nil)))
248 (t (error "Don't know how to authenticate using %s" auth))) 130 (t (error "Don't know how to authenticate with %s" auth)))
249 (setq process-to-shutdown nil) 131 ;; find out how many messages are in the box.
250 process )) 132 (vm-pop-send-command process "STAT")
251 (if process-to-shutdown 133 (setq message-count (vm-pop-read-stat-response process))
252 (vm-pop-end-session process-to-shutdown))))) 134 ;; forget it if the command fails
253 135 ;; or if there are no messages present.
254 (defun vm-pop-end-session (process) 136 (if (or (null message-count)
137 (< message-count 1))
138 (throw 'done nil))
139 ;; loop through the maildrop retrieving and deleting
140 ;; messages as we go.
141 (setq n 1)
142 (while (<= n message-count)
143 (vm-unsaved-message "Retrieving message %d (of %d) from %s..."
144 n message-count popdrop)
145 (vm-pop-send-command process (format "RETR %d" n))
146 (and (null (vm-pop-read-response process))
147 (throw 'done (not (equal n 1))))
148 (and (null (vm-pop-retrieve-to-crashbox process destination))
149 (throw 'done (not (equal n 1))))
150 (vm-pop-send-command process (format "DELE %d" n))
151 ;; DELE can't fail but Emacs or this code might
152 ;; blow a gasket and spew filth down the
153 ;; connection, so...
154 (and (null (vm-pop-read-response process))
155 (throw 'done (not (equal n 1))))
156 (vm-increment n))
157 t ))
158 (if process
159 (save-excursion
160 (set-buffer (process-buffer process))
161 (vm-pop-send-command process "QUIT")
162 (vm-pop-read-response process)
163 (delete-process process))))))
164
165 (defun vm-pop-process-filter (process output)
255 (save-excursion 166 (save-excursion
256 (set-buffer (process-buffer process)) 167 (set-buffer (process-buffer process))
257 (vm-pop-send-command process "QUIT") 168 (goto-char (point-max))
258 (vm-pop-read-response process) 169 (insert output)))
259 (if (fboundp 'add-async-timeout)
260 (add-async-timeout 2 'delete-process process)
261 (run-at-time 2 nil 'delete-process process))))
262
263 (defun vm-pop-stat-timer (o) (aref o 0))
264 (defun vm-pop-stat-x-box (o) (aref o 1))
265 (defun vm-pop-stat-x-currmsg (o) (aref o 2))
266 (defun vm-pop-stat-x-maxmsg (o) (aref o 3))
267 (defun vm-pop-stat-x-got (o) (aref o 4))
268 (defun vm-pop-stat-x-need (o) (aref o 5))
269 (defun vm-pop-stat-y-box (o) (aref o 6))
270 (defun vm-pop-stat-y-currmsg (o) (aref o 7))
271 (defun vm-pop-stat-y-maxmsg (o) (aref o 8))
272 (defun vm-pop-stat-y-got (o) (aref o 9))
273 (defun vm-pop-stat-y-need (o) (aref o 10))
274
275 (defun vm-set-pop-stat-timer (o val) (aset o 0 val))
276 (defun vm-set-pop-stat-x-box (o val) (aset o 1 val))
277 (defun vm-set-pop-stat-x-currmsg (o val) (aset o 2 val))
278 (defun vm-set-pop-stat-x-maxmsg (o val) (aset o 3 val))
279 (defun vm-set-pop-stat-x-got (o val) (aset o 4 val))
280 (defun vm-set-pop-stat-x-need (o val) (aset o 5 val))
281 (defun vm-set-pop-stat-y-box (o val) (aset o 6 val))
282 (defun vm-set-pop-stat-y-currmsg (o val) (aset o 7 val))
283 (defun vm-set-pop-stat-y-maxmsg (o val) (aset o 8 val))
284 (defun vm-set-pop-stat-y-got (o val) (aset o 9 val))
285 (defun vm-set-pop-stat-y-need (o val) (aset o 10 val))
286
287 (defun vm-pop-start-status-timer ()
288 (let ((blob (make-vector 11 nil))
289 timer)
290 (setq timer (add-timeout 5 'vm-pop-report-retrieval-status blob 5))
291 (vm-set-pop-stat-timer blob timer)
292 blob ))
293
294 (defun vm-pop-stop-status-timer (status-blob)
295 (if (fboundp 'disable-timeout)
296 (disable-timeout (vm-pop-stat-timer status-blob))
297 (cancel-timer (vm-pop-stat-timer status-blob))))
298
299 (defun vm-pop-report-retrieval-status (o)
300 (cond ((null (vm-pop-stat-x-got o)) t)
301 ;; should not be possible, but better safe...
302 ((not (eq (vm-pop-stat-x-box o) (vm-pop-stat-y-box o))) t)
303 ((not (eq (vm-pop-stat-x-currmsg o) (vm-pop-stat-y-currmsg o))) t)
304 (t (message "Retrieving message %d (of %d) from %s, %s..."
305 (vm-pop-stat-x-currmsg o)
306 (vm-pop-stat-x-maxmsg o)
307 (vm-pop-stat-x-box o)
308 (format "%d%s of %d%s"
309 (vm-pop-stat-x-got o)
310 (if (> (vm-pop-stat-x-got o)
311 (vm-pop-stat-x-need o))
312 "!"
313 "")
314 (vm-pop-stat-x-need o)
315 (if (eq (vm-pop-stat-x-got o)
316 (vm-pop-stat-y-got o))
317 " (stalled)"
318 "")))))
319 (vm-set-pop-stat-y-box o (vm-pop-stat-x-box o))
320 (vm-set-pop-stat-y-currmsg o (vm-pop-stat-x-currmsg o))
321 (vm-set-pop-stat-y-maxmsg o (vm-pop-stat-x-maxmsg o))
322 (vm-set-pop-stat-y-got o (vm-pop-stat-x-got o))
323 (vm-set-pop-stat-y-need o (vm-pop-stat-x-need o)))
324 170
325 (defun vm-pop-send-command (process command) 171 (defun vm-pop-send-command (process command)
326 (goto-char (point-max)) 172 (goto-char (point-max))
327 (if (= (aref command 0) ?P) 173 (if (= (aref command 0) ?P)
328 (insert-before-markers "PASS <omitted>\r\n") 174 (insert "PASS <omitted>\r\n")
329 (insert-before-markers command "\r\n")) 175 (insert command "\r\n"))
330 (setq vm-pop-read-point (point)) 176 (setq vm-pop-read-point (point))
331 (process-send-string process command) 177 (process-send-string process command)
332 (process-send-string process "\r\n")) 178 (process-send-string process "\r\n"))
333 179
334 (defun vm-pop-read-response (process &optional return-response-string) 180 (defun vm-pop-read-response (process &optional return-response-string)
345 (setq vm-pop-read-point match-end) 191 (setq vm-pop-read-point match-end)
346 (if return-response-string 192 (if return-response-string
347 (buffer-substring (point) match-end) 193 (buffer-substring (point) match-end)
348 t )))) 194 t ))))
349 195
350 (defun vm-pop-read-past-dot-sentinel-line (process)
351 (let ((case-fold-search nil))
352 (goto-char vm-pop-read-point)
353 (while (not (re-search-forward "^\\.\r\n" nil 0))
354 (beginning-of-line)
355 ;; save-excursion doesn't work right
356 (let ((opoint (point)))
357 (accept-process-output process)
358 (goto-char opoint)))
359 (setq vm-pop-read-point (point))))
360
361 (defun vm-pop-read-stat-response (process) 196 (defun vm-pop-read-stat-response (process)
362 (let ((response (vm-pop-read-response process t))
363 list)
364 (setq list (vm-parse response "\\([^ ]+\\) *"))
365 (list (string-to-int (nth 1 list)) (string-to-int (nth 2 list)))))
366
367 (defun vm-pop-read-list-response (process)
368 (let ((response (vm-pop-read-response process t))) 197 (let ((response (vm-pop-read-response process t)))
369 (string-to-int (nth 2 (vm-parse response "\\([^ ]+\\) *"))))) 198 (string-to-int (nth 1 (vm-parse response "\\([^ ]+\\) *")))))
370 199
371 (defun vm-pop-ask-about-large-message (process size n) 200 (defun vm-pop-retrieve-to-crashbox (process crash)
372 (let ((work-buffer nil)
373 (pop-buffer (current-buffer))
374 start end)
375 (unwind-protect
376 (save-excursion
377 (save-window-excursion
378 (vm-pop-send-command process (format "TOP %d %d" n 0))
379 (if (vm-pop-read-response process)
380 (progn
381 (setq start vm-pop-read-point)
382 (vm-pop-read-past-dot-sentinel-line process)
383 (setq end vm-pop-read-point)
384 (setq work-buffer (generate-new-buffer "*pop-glop*"))
385 (set-buffer work-buffer)
386 (insert-buffer-substring pop-buffer start end)
387 (forward-line -1)
388 (delete-region (point) (point-max))
389 (vm-pop-cleanup-region (point-min) (point-max))
390 (vm-display-buffer work-buffer)
391 (setq minibuffer-scroll-window (selected-window))
392 (goto-char (point-min))
393 (if (re-search-forward "^Received:" nil t)
394 (progn
395 (goto-char (match-beginning 0))
396 (vm-reorder-message-headers
397 nil vm-visible-headers
398 vm-invisible-header-regexp)))
399 (set-window-point (selected-window) (point))))
400 (if (y-or-n-p (format "Message %d, size = %d, retrieve? " n size))
401 'retrieve
402 (if (y-or-n-p (format "Delete message %d from popdrop? " n size))
403 'delete
404 'skip))))
405 (and work-buffer (kill-buffer work-buffer)))))
406
407 (defun vm-pop-retrieve-to-crashbox (process crash statblob)
408 (let ((start vm-pop-read-point) end) 201 (let ((start vm-pop-read-point) end)
409 (goto-char start) 202 (goto-char start)
410 (vm-set-pop-stat-x-got statblob 0) 203 (while (not (re-search-forward "^\\.\r\n" nil t))
411 (while (not (re-search-forward "^\\.\r\n" nil 0)) 204 (accept-process-output process)
412 (beginning-of-line) 205 (goto-char start))
413 ;; save-excursion doesn't work right
414 (let* ((opoint (point))
415 (func
416 (function
417 (lambda (beg end len)
418 (if vm-pop-read-point
419 (progn
420 (vm-set-pop-stat-x-got statblob (- end start))
421 (if (zerop (% (random) 10))
422 (vm-pop-report-retrieval-status statblob)))))))
423 (after-change-functions (cons func after-change-functions)))
424 (accept-process-output process)
425 (goto-char opoint)))
426 (vm-set-pop-stat-x-got statblob nil)
427 (setq vm-pop-read-point (point-marker)) 206 (setq vm-pop-read-point (point-marker))
428 (goto-char (match-beginning 0)) 207 (goto-char (match-beginning 0))
429 (setq end (point-marker)) 208 (setq end (point-marker))
430 (vm-pop-cleanup-region start end) 209 (vm-pop-cleanup-region start end)
431 ;; Some POP servers strip leading and trailing message 210 ;; Some POP servers strip leading and trailing message
454 ;; for the Content-Length stuff counting from eob is 233 ;; for the Content-Length stuff counting from eob is
455 ;; the same thing in this case. 234 ;; the same thing in this case.
456 (vm-convert-folder-type-headers nil vm-folder-type) 235 (vm-convert-folder-type-headers nil vm-folder-type)
457 (goto-char end) 236 (goto-char end)
458 (insert-before-markers (vm-trailing-message-separator)))) 237 (insert-before-markers (vm-trailing-message-separator))))
459 ;; Set file type to binary for DOS/Windows. I don't know if 238 (write-region start end crash t 0)
460 ;; this is correct to do or not; it depends on whether the
461 ;; the CRLF or the LF newline convention is used on the inbox
462 ;; associated with this crashbox. This setting assumes the LF
463 ;; newline convention is used.
464 (let ((buffer-file-type t))
465 (write-region start end crash t 0))
466 (delete-region start end) 239 (delete-region start end)
467 t )) 240 t ))
468 241
469 (defun vm-pop-cleanup-region (start end) 242 (defun vm-pop-cleanup-region (start end)
470 (if (> (- end start) 30000)
471 (message "CRLF conversion and char unstuffing..."))
472 (setq end (vm-marker end)) 243 (setq end (vm-marker end))
473 (save-excursion 244 (save-excursion
474 (goto-char start) 245 (goto-char start)
475 ;; CRLF -> LF 246 ;; CRLF -> LF
476 (while (and (< (point) end) (search-forward "\r\n" end t)) 247 (while (and (< (point) end) (search-forward "\r\n" end t))
478 (goto-char start) 249 (goto-char start)
479 ;; chop leading dots 250 ;; chop leading dots
480 (while (and (< (point) end) (re-search-forward "^\\." end t)) 251 (while (and (< (point) end) (re-search-forward "^\\." end t))
481 (replace-match "" t t) 252 (replace-match "" t t)
482 (forward-char))) 253 (forward-char)))
483 (if (> (- end start) 30000)
484 (message "CRLF conversion and dot unstuffing... done"))
485 (set-marker end nil)) 254 (set-marker end nil))
486 255
487 (defun vm-pop-md5 (string) 256 (defun vm-pop-md5 (string)
488 (let ((buffer nil)) 257 (let ((buffer nil))
489 (unwind-protect 258 (unwind-protect
491 (setq buffer (generate-new-buffer "*vm-work*")) 260 (setq buffer (generate-new-buffer "*vm-work*"))
492 (set-buffer buffer) 261 (set-buffer buffer)
493 (insert string) 262 (insert string)
494 (call-process-region (point-min) (point-max) 263 (call-process-region (point-min) (point-max)
495 "/bin/sh" t buffer nil 264 "/bin/sh" t buffer nil
496 shell-command-switch vm-pop-md5-program) 265 "-c" vm-pop-md5-program)
497 ;; MD5 digest is 32 chars long 266 ;; MD5 digest is 32 chars long
498 ;; mddriver adds a newline to make neaten output for tty 267 ;; mddriver adds a newline to make neaten output for tty
499 ;; viewing, make sure we leave it behind. 268 ;; viewing, make sure we leave it behind.
500 (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32))) 269 (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32)))
501 (and buffer (kill-buffer buffer))))) 270 (and buffer (kill-buffer buffer)))))