Path: utzoo!utgpu!watmath!uunet!cme!durer!klm From: klm@goon.cme.nbs.gov (Ken Manheimer) Newsgroups: gnu.emacs Subject: Re: BABYL to unix mail format converter? Message-ID: Date: 17 Aug 89 15:03:17 GMT References: <31142@cornell.UUCP> Sender: news@cme.nbs.gov Organization: Nat'l Institute of Standards and Technology Lines: 362 In-reply-to: patrick@cs.cornell.edu's message of 16 Aug 89 19:45:05 GMT I developed this script a few weeks ago, made some major changes last week, and was getting ready to post to the world (beyond my site) today, and then someone lets me know about the current activity on just this topic in this newsgroup. Below is a set of functions that provide a fairly thorough means to generate vm versions of rmail files in your directory hierarchy. The function you probably want to use, if you're like me and have a lot of rmail files in some directory hierarchy (or scattered around your general directory hierarchy), is the function 'rmail-hierarchy-to-vm'. You can do the conversion on a folder-by-folder basis with the function 'rmail-folder-to-vm'. (See comments at the top of the code for more details about operation and customization.) The folder and hierarchy functions move the original, rmail version of the folder to a file with the suffix ".rmail" appended to their name, and leave the original name assigned to the vm-translation of the folder. Once you've run it and have satisfied yourself that it worked ok you can use, eg, find to identify and delete the ".rmail" files. I was careful to preserve the sundry message characteristics (like replied, filed, etc) in the translation, though some of the mapping was inferred by reverse engineering and may not be exactly right. (I'm inclined to think it is, though - anyone who feels otherwise please let me know.) One other caution - i added some code to prevent the programs from following symbolic links only to discover that pretty much everyone at my sight who needed to do the conversion had already used my previous release, and so i had no one to test the fairly simple mods. I did some complicated-case tests but couldn't do anything really extensive, as i did with the prior release. Once again, i'm fairly assured about the code but if you have any problems (or comments) please let me know and i'll look into it asap... Ken Manheimer Nat'l Inst of Standards and Technology (301) 975-3539 (Formerly "National Bureau of Standards") klm@cme.nist.gov CME, Factory Automation Systems Division or ..!uunet!cme-durer!klm Integrated Systems Group "Gadzooks," he said stupidly as he jumped into his convertible lemon and drove off with his egg-shaped wife. - Mad Libs, published example. ; Translate rmail entities (folders residing in a directory hierarchy, folder, ; buffer, and message) into a vm equivalent. ; ; THERE IS NO EXPLICIT OR IMPLICIT WARRANTY ON THIS CODE. I, the author, ; intend for everyone to have the right to share this code as stated in the ; GNU EMACS GENERAL PUBLIC LICENSE (as stated in a version on or after 11 Feb ; 1988). In particular, i permit everyone to use it free of charge, and to ; redistribute it in whole or in part free of charge, with the condition that ; no one redistributing it charge for the code itself. ; ; Ken Manheimer 10-Aug-1989 Nat'l Inst of Standards and Technology ; (301) 975-3539 (Formerly "National Bureau of Standards") ; klm@cme.nist.gov CME, Factory Automation Systems Division ; or ..!uunet!cme-durer!klm Integrated Systems Group ; ; The functions fall into two levels. At the base are rmail-message-to-vm ; and rmail-buffer-to-vm, which do the actual text conversion from rmail to vm. ; They operate on the current buffer and have nothing to do with the business ; of visiting or saving files. (rmail-buffer-to-vm takes care of the rmail ; file header and then dispatches rmail-message-to-vm to take care of the ; individual messages.) Above them are the functions that deal with the file- ; system business. ; ; rmail-folder-to-vm actually creates a vm file for a designated rmail file and ; moves the rmail file to ".rmail", leaving the vm translation as ; . Though the original file is renamed, it is not otherwise ; affected. ; ; Finally, rmail-hierarchy-to-vm will traverse an rmail directory ; hierarchy, starting at a source directory you specify, applying ; rmail-folder-to-vm to every rmail folder it finds. It reports ; each directory that it completes. This is the one you probably ; want to use if you have a bunch of files to convert. Symbolic ; links are not be traversed. Iff 'rmail-to-vm-ignore-src-backups' ; (default t) is t then backup versions of rmail files (as determined by ; the elisp function 'backup-file-name-p') are skipped. Iff the variable ; rmail-to-vm-dont-redo (default t) is t then previously processed ; rmail files (as indicated by their having an ".rmail" extension and a ; corresponding file whose name lacks that extension) will not be ; reprocessed. ; ; interactive functions: perform translation: ; --------------------- ------------------- ; rmail-hierarchy-to-vm - create vm versions of any rmail files located in ; hierarchy designated by directory argument. A few ; variable (see below) affects whether rmail backup ; versions are processed. ; rmail-folder-to-vm - create vm version of rmail file, moving original ; rmail file to same name with ".rmail" appended and ; leaving the vm version with the original name. ; rmail-buffer-to-vm - transform contents of current buffer. The contents ; must start with rmail (ie, "Babyl") header. ; rmail-message-to-vm - transform next rmail message somewhere after point in ; current buffer. Need not have rmail header. ; ; Customization variables - after loading the file you can do an ; ----------------------- 'ESC-x set-variable CR' to alter them. ; rmail-to-vm-ignore-src-backups - default t ; if t, rmail-hierarchy-to-vm won't create corresponding vm versions for ; backups of rmail files (ie, won't process backup files). ; rmail-to-vm-dont-redo - default t ; iff t, rmail-folder-to-vm won't process rmail files when they already ; have a ".rmail" extension and another file exists whose name is the ; same excluding the ".rmail" suffix ; ; NOTE for all you recursion buffs out there - some of these functions are ; iterative where recursion looks appropriate - it turns out there are some ; stack limits that can be circumvented, but it seemed more expedient (for ; a few reasons) to just unravel some of the recursion to iteration. (I ; happen to prefer reading and writing recursive code myself... klm.) (defconst r-to-v-notice "rmail-to-vm" "Preface for rmail-to-vm utility prompts") (defvar rmail-to-vm-ignore-src-backups t "If true, rmail-hierarchy-to-vm skips translating rmail backup files") (defvar rmail-to-vm-dont-redo t "If true, don't process rmail files in hierarchy scan that already have existing vm versions") (defconst rmail-file-head-line "^BABYL OPTIONS:$" "First line in rmail file") (defconst rmail-entry-start "\^L\n") (defconst rmail-entry-end "^\^_") (defconst rmail-entry-msg-delim "^\\*\\*\\* EOOH \\*\\*\\*\n") (defconst rmail-attrs "[01],.*\n") (defconst rmail-attrs-line (concat "^" rmail-attrs)) (defconst rmail-summary-line "^Summary-line:.*$") (defconst vm-attr-start "X-VM-Attributes: [") (defconst rtv-done-suffix ".rmail") (defun rmail-hierarchy-to-vm (srcDir) "Apply rmail-folder-to-vm to all rmail folders in hierarchy rooted at SRCDIR. Non-rmail files in hierarchy ignored. Original rmail files are renamed to '.rmail' (but otherwise unaffected) and new vm versions are given original name ''. If rmail-to-vm-ignore-src-backups t then backup versions aren't translated." (interactive "Drmail-to-vm on hierarchy: ") ; ensure srcDir is directory format (if (file-directory-p srcDir) (setq srcDir (file-name-as-directory srcDir)) (error "rmail-hierarchy-to-vm: %s not a directory" srcDir)) ; iterate through current dir entries (let ((dirEntries (directory-files srcDir))) (while dirEntries (let ((entry (car dirEntries))) (cond ; skip . and ..: ((or (string= entry ".")(string= entry ".."))) ; skip backups if indicated: ((and rmail-to-vm-ignore-src-backups (backup-file-name-p entry))) ; skip already done files if indicated: ((and rmail-to-vm-dont-redo (rtv-already-did (concat srcDir entry)))) ; don't follow symlinks: ((file-symlink-p (concat srcDir entry)) (message "%s: symlink %s disregarded" r-to-v-notice (concat srcDir entry))) ; disregard unfathomable nonsense: ((not (file-exists-p (concat srcDir entry)))) ((file-directory-p (concat srcDir entry)) ; recurse on dirs (rmail-hierarchy-to-vm (concat srcDir entry "/"))) (t ; translate files (condition-case failure (rmail-folder-to-vm (concat srcDir entry)) (file-error (if (not (y-or-n-p (format "can't access %s, continue onwards? " (concat srcDir entry)))) (error "rmail-hierarchy-to-vm foiled on %s" (concat srcDir entry)))) (error (if (not (y-or-n-p (format "ignoring %s; bad rmail format, continue on? " (concat srcDir entry)))) (error "rmail-hierarchy-to-vm foiled on %s" (concat srcDir entry)))))))) (setq dirEntries (cdr dirEntries)))) (message "%s %s done." r-to-v-notice srcDir) ) (defun rtv-already-did (fn) (if (file-exists-p (concat fn ".rmail")) t (let ((fnlen (length fn)) (sufflen (length rtv-done-suffix))) (if (string= (substring fn (- fnlen sufflen) fnlen) rtv-done-suffix) (file-exists-p (substring fn 0 (- fnlen sufflen))))))) (defun rmail-folder-to-vm (src) "create vm version of rmail file, leaving original rmail version with '.rmail' appended on name and leaving the vm version with the original name." (interactive "fRmail source folder: ") (cond ; validate: ((file-directory-p src) (error "Rmail source must not be a directory")) ((not (file-exists-p src)) (error "Rmail source %s not found" src)) ((not (file-readable-p src)) (error "Rmail source %s unreadable" src))) (let ((dstBuf (create-file-buffer src))) (save-excursion (set-buffer dstBuf) ; Obtain rmail folder in dstBuf: (condition-case failure (insert-file-contents src t) (error (progn (set-buffer-modified-p nil) (kill-buffer dstBuf) (error "can't read %s; %s" src failure)))) (if (looking-at rmail-file-head-line) ; Do cursory verify of rmail format (progn (condition-case failure (rmail-buffer-to-vm) ; Do translation (error (set-buffer-modified-p nil) (kill-buffer dstBuf) (error "%s bad format, giving up..." src))) (goto-char (point-min)) (if (looking-at "From ") ; good enough... (condition-case failure (progn ; mv rmail file aside: (rename-file src (concat src ".rmail") 1) (write-file src)) ; save vm version (error (progn (set-buffer-modified-p nil) (kill-buffer dstBuf) (error "can't write %s; %s" src failure))))))) (set-buffer-modified-p nil) (kill-buffer dstBuf))) ; free up buffer ) (defun rmail-amt-entries () (let ((count 0) opoint) (save-excursion (goto-char (point-min)) (while (and (not (eobp)) (re-search-forward rmail-entry-start nil t)) (setq count (1+ count)))) count)) (defun current-match (ord) (buffer-substring (match-beginning ord) (match-end ord))) (defun rmail-buffer-to-vm () "Translate rmail-format contents of current buffer to vm format." (interactive) (let ((delFrom (point))) ; Delete Babyl header (re-search-forward rmail-entry-end) (kill-region delFrom (point))) (message "%s buffer %s" r-to-v-notice (buffer-file-name)) (let ((amt-done 0) (total-amt (rmail-amt-entries))) ; Massage messages to vm format ; while we have more messages: (while (rmail-message-to-vm) (setq amt-done (1+ amt-done)) (message "%s buffer %s: %d of %d done" r-to-v-notice (buffer-file-name) amt-done total-amt) ) ) ) (defun rmail-message-to-vm () "Convert message following point in current buffer from rmail to vm format, or return nil if no message following." (interactive) (if (re-search-forward (concat rmail-entry-start rmail-attrs) (1+ (buffer-size)) t) (progn (goto-char (match-beginning 0)) (looking-at rmail-entry-start) (delete-region (match-beginning 0)(match-end 0)) ; dispose of delimiter ; Determine and insert standard ; mail-entry initial line and vm attrs: (let* ((eocm ; End-Of-Current-Message (save-excursion (re-search-forward rmail-entry-end) (point))) (rmail-attrs-string (if (re-search-forward rmail-attrs-line eocm t) (prog1 (current-match 0) (delete-region (match-beginning 0) (match-end 0))) "1,,")) (eocm ; End-Of-Current-Message (save-excursion (re-search-forward rmail-entry-end) (point))) ; toggled-header indicates whether ; stuff after "***EOOH***" is full ; header or not: (toggled-header (string-match "0," rmail-attrs-string)) (new-attr "nil") (unseen-attr (if (string-match "unseen" rmail-attrs-string) "t" "nil")) (unread-attr new-attr) (deleted-attr "nil") ; ignore saved "deleted" flags (filed-attr (if (string-match "filed" rmail-attrs-string) "t" "nil")) (replied-attr (if (string-match "answered"rmail-attrs-string)"t" "nil")) ; insert mail-format line: ; "From " (From-addr-field (save-excursion ; Two main forms - ; "^From: ProperNm .. " ; or "^From: actual@address stuff..." ; then progressively less likely forms (cond ((re-search-forward "^From: .*<\\(.*\\)>" eocm t)) ((re-search-forward "^From: \\([^ \n]*\\)" eocm t)) ((re-search-forward "^Really-From: \\([^ \n]*\\)"eocm t)) ((re-search-forward "^Sender: .*<\\(.*\\)>" eocm t)) ((re-search-forward "^Sender: \\([^ \n]*\\)" eocm t))) (current-match 1))) (From-date-field (save-excursion (cond ((re-search-forward ; Suitable for the mailer at my site - ; u may need to revise it for yours... ; klm 19-Jul-1989 (concat ; prelim vv weekday vv monthday vv "^\^Iid [^ ]* " "\\([^,]*\\), " "\\([^ ]*\\) " ; month vv year vv clock time vv "\\([^ ]*\\) " "\\([^ ]*\\) " "\\([^ ]*\\)") eocm t) (concat (current-match 1) " " ; weekday (current-match 3) " " ; month (current-match 2) " " ; monthday (current-match 5) " " ; clock time "19" (current-match 4))) ; year ((re-search-forward "Date: \\(.*\\)$" eocm t) (current-match 1)) (t "Previously")))) ) ; Insert mail-entry initial line: (insert-string (concat "From " From-addr-field " " From-date-field "\n")) ; Insert vm attributes line: (insert-string (concat "X-VM-Attributes: [" new-attr " " unseen-attr " " deleted-attr " " filed-attr " " replied-attr "]\n")) ; deal with digested/uprocessed header: (let* ((eocm ; Recompute End-Of-Current-Message (save-excursion (re-search-forward rmail-entry-end) (point)))) (re-search-forward rmail-entry-msg-delim eocm t) (delete-region (1- (match-beginning 0)) (1- (match-end 0))) (if (not toggled-header) (delete-region (1- (point)) (progn (re-search-forward "^$") (point))))) ) ; Delete entry-end delim, loop to next: (re-search-forward rmail-entry-end) (delete-backward-char 1) t ) ) )