From: keith.harp@East.Sun.COM (Keith Harp)
Newsgroups: gnu.emacs.vm.info
Subject: Re: Sun's mailtool attatchements
Date: 06 Oct 92 14:20:19 GMT
Organization: Sun Microsystems, RTP, NC
Distribution: gnu
NNTP-Posting-Host: string-beans.east.sun.com
In-reply-to: kuro@cachaca.Eng.Sun.Com's message of 5 Oct 92 12:04:24

In article <KURO.92Oct5120424@cachaca.Eng.Sun.Com> kuro@cachaca.Eng.Sun.Com (Teruhiko Kurosaka) writes:

   Is there a patch to vm so that vm would understand "attatchment" from
   Sun's mailtool ?

It is not EXACTLY what you want, but here is what I do:

You can either vm-extract-attachment or vm-run-attachment.
You need the C program at the end of this file to actually run them.
If anyone would like to build onto this to make a nicer interface, feel free.

********************************************************

;; extract the MailTool attachments and put them in a file
;;  Automatically puts the attachments in a subdirectory "attach" or
;; can run them.

(defvar vm-extract-directory "" 
"*the default directory to extract attachments to")

(defvar vm-run-directory nil
"*if set, then extract to this directory and dont delete on a vm-run-attachment")

(defvar vm-run-file "runfile"
"*the program used to execute attachments")

(require 'vm)

(defun vm-do-extract-attach(dir runit deleteit)
  "extract any X attachments in the current buffer and save them to files
arg DIR is the directory to extract to.  RUNIT is whether or not to call
runfile on the file (requires executable runfile on path).  DELETEIT
is whether or not to delete the extracted file after running it."
  (message "Looking for attachments...")
  
  ;;have to be within message buffer to do the extraction
  (vm-select-folder-buffer)
  (vm-sanity-check-modification-flag)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (vm-display-current-message-buffer)
  (vm-show-current-message)
  (select-window (get-buffer-window (vm-current-message-buffer)))
  (setq old-dir default-directory)
  
  (unwind-protect 
      (progn
	(save-window-excursion 
	  (save-excursion
	    (goto-char (point-min))
	    
	    (setq fulldir (expand-file-name dir))
	    (if (not (file-directory-p fulldir))
		(shell-command (concat "mkdir " fulldir)))
	    (setq default-directory (concat fulldir "/"))
	    (setq none-found t)
	    
	    ;; find file info
	    (while (search-forward "X-Sun-Data-Name: " nil t)
	      ;;header ends after an empty line
	      (setq start (point))
	      (search-forward "\n\n")
	      (setq end-header (point))
	      (goto-char start)
	      
	      ;; extract file name
	      (skip-chars-forward "^\n")
	      (setq file (buffer-substring start (point)))
	      
	      ;; if this is the special non-attachment text field, 
	      ;; then don't extract it
	      (if (and none-found (equal file "text") 
		       (progn
			 (forward-line -2)
			 (search-forward "X-Sun-Data-Type: text
X-Sun-Data-Description: text" end-header t)))
		  (goto-char end-header)
		;; else
		
		;; currently only handles two types of encoding 
		;;  1. uuencoding
		;;  2. default-compression
		;; It also assumes that default-compression is only used if
		;; uuencoding is also used.
		(setq uudecode nil)
		(setq decompress nil)
		(if (search-forward "X-Sun-Encoding-Info:" end-header t)
		    (progn
		      (setq start (point))
		      (forward-line 1)
		      (setq end-line (point))
		      (goto-char start)
		      (setq decompress (search-forward "default-compress" end-line t))
		      (if (search-forward "uuencode" end-line t)
			  (save-excursion
			    (setq uudecode t)
			    ;;extract the uudecoded name
			    (goto-char end-header)
			    (skip-chars-forward "^\n")
			    (skip-chars-backward " \t")
			    (setq end-line (point))
			    (skip-chars-backward "^ \t")
			    (setq uudecoded-name (buffer-substring (point) end-line))
			    ))
		      ))
		
		;; find length of file
		(search-forward "X-Sun-Content-Lines: " end-header)
		(setq start (point))
		(skip-chars-forward "0-9")
		(setq lines (string-to-int (buffer-substring start (point))))
		
		;; file starts after first blank line
		(goto-char end-header)
		(forward-line lines)
		(if uudecode
		    (save-excursion
		      (shell-command-on-region end-header (point) "uudecode")
		      (if decompress
			  (shell-command 
			   (format "mv %s tmpattach; uncompress < tmpattach > %s; rm tmpattach" 
				   uudecoded-name file)))
		      (message "uudecoded %s%s" default-directory file))
		  (message "Writing %s" file)
		  (write-region end-header (point) file nil nil))
		
		(if runit
		    (progn
		      (message "Executing %s" file)
		      (if deleteit
			  (start-process "runfile" nil "nohup" vm-run-file "-d" file)
			(start-process "runfile" nil "nohup" vm-run-file file))
		      ))
		
		(setq none-found nil)
		));; end while 
	    (if none-found
		(message "No attachments found")
	      (if deleteit
		  (message "Done")
		(message "Attachments in %s" default-directory))))))
    ;; cleanup for unwind-protect
    (setq default-directory old-dir)))
      
      

(defun vm-extract-attachment(dir)
  "extract any X attachments in the current buffer and save them to files
arg DIR is the directory to extract to.  The default directory to save
to is the current directory (of the mail folder) or the value of 
vm-extract-directory"
  (interactive
   (list
    (expand-file-name (read-file-name 
		       (format "Extract to directory: (default %s) " 
			       (expand-file-name vm-extract-directory))
		       nil vm-extract-directory nil))))
  (vm-do-extract-attach dir nil nil)
)


(defun vm-run-attachment()
  "Extract any attachments and run them using the runfile program."
  (interactive)
  (if vm-run-directory
      (vm-do-extract-attach vm-run-directory t nil)
    (vm-do-extract-attach "/tmp/attach" t t))
)

*********************************************
LDFLAGS = -L${OPENWINHOME}/lib
CPPFLAGS = -I${OPENWINHOME}/include
LDLIBS = -lce -ldl

all:   runfile

DST = ../../bin/runfile

${DST} : runfile
	cp runfile ${DST}

install: all ${DST}
***********************************************
/*
 * runfile [-v] [-dryrun] [-d] filenames ...
 * execute a file like filemgr would if you clicked on it.
 *    -v      verbose
 *    -dryrun just say what you're doing, don't do it
 *    -d      destructive.  Remove the file after you execute it.
 *  all the options are toggles so that they can be used on 
 *  individual files
 */

#include <stdio.h>
#include <string.h>
#include <desktop/ce.h>
#include <desktop/ce_err.h>

/* variable definitions */
CE_NAMESPACE 	f_name_space, t_name_space;
CE_ENTRY 	ftype_ent, ttype_ent, default_ent;
CE_ATTRIBUTE 	fns_type, fns_attr, tns_attr, tns_open, default_open;

main(argc, argv)
    int argc;
    char *argv[];
{
    int  fd;
    int  verbose = 0;
    int  n;
    char *filename;
    char buf[1024];
    char cmd[1024];
    char *ptr;
    int  bufsize, status;
    int  dryrun = 0;
    int  destructive = 0;
    
    /*
     * Initialize the Classing Engine
     */
    default_open = 0;
    status = ce_begin (NULL);
    if (status)	{
	fprintf (stderr, "Error initializing Classing Engine Database - Error no: %d.\n", status);
	exit (0);
    }
    
    /* Read in Namespace Entries */
    f_name_space = ce_get_namespace_id ("Files");
    if (!f_name_space)	{
	fprintf (stderr, "Cannot find File Namespace\n");
	ce_end();
	exit(0);
    }
    
    t_name_space = ce_get_namespace_id ("Types");
    if (!t_name_space)	{
	fprintf (stderr, "Cannot find Types namespace\n");
	ce_end();
	exit(0);
    }
    
    /*
     * Get the attribute ID's that we're interested in
     */
    fns_attr = ce_get_attribute_id (f_name_space, "FNS_TYPE");
    
    if (!fns_attr)	{
	fprintf (stderr, "Cannot find FNS_ATTR in Files\n");
	ce_end();
	exit(0);
    }
    
    tns_attr = ce_get_attribute_id (t_name_space, "TYPE_OPEN");
    
    if (!tns_attr)	{
	fprintf (stderr, "Cannot find TYPE_OPEN in Types\n");
	ce_end();
	exit(0);
    }
    
    /*  
     * Start loop to read in filenames and type them
     */
    
    for (n=1; n < argc; n++) {
	
	if (!strcmp(argv[n],"-v")) {
	    verbose = !verbose;
	    continue;
	}
	
	if (!strcmp(argv[n],"-d")) {
	    destructive = !destructive;
	    continue;
	}
	
	if (!strcmp(argv[n],"-dryrun")) {
	    dryrun = !dryrun;
	    continue;
	}
	
	filename = argv[n];
	
	if ((fd = open (filename, 0)) == -1) {
	    fprintf(stderr, "Cannot open: %s\n", filename);
	    continue;
	}
	
	bufsize = read (fd, buf, sizeof (buf));
	if (bufsize <= 0) {
	    fprintf(stderr, "Empty file or Directory: %s\n", filename);
	    close (fd);
	    continue;
	}
	
	/* Get a matching entry in the files namespace */
	tns_open = 0;
	
	if (!( (ftype_ent = ce_get_entry (f_name_space, 3, filename, buf, bufsize)) &&
	    (fns_type = ce_get_attribute (f_name_space, ftype_ent, fns_attr))   &&
	    (ttype_ent = ce_get_entry (t_name_space, 1, fns_type)) 		&&
	    (tns_open = ce_get_attribute (t_name_space, ttype_ent, tns_attr)))) {

	    if (!default_open) {
		if (!(default_ent = ce_get_entry(t_name_space,1,"default"))) {
		    fprintf (stderr, "No default entry in type Namespace \n");
		    continue;
		}
		default_open = ce_get_attribute(t_name_space, default_ent, tns_attr);
	    }
	    tns_open = default_open;
	}
	
	if (!tns_open)	{
	    fprintf (stderr, "No TYPE_OPEN in Types namespace for %s\n",filename);
	    continue;
	}
	strcpy(buf, tns_open);
	while (ptr = strstr(buf,"$FILE")) 
	    memcpy(ptr,"%s   ",5);
	
	sprintf(cmd, buf, filename, filename, filename, 
		filename, filename);
	
	if (verbose)
	    printf("%s\n",cmd);
	
	if (!dryrun) {
	    switch (fork()) {
		/* child process */
	    case 0:
		{
		    system(cmd); 
		    if (destructive)
			unlink(filename);
		    exit(1);
		}
	    case -1: 
		{
		    perror();
		    fprintf(stderr,"Unable to fork\n");
		    break;
		}
	    default: /* forked OK */
		break;
	    }
	}
    }
    
    ce_end();
    exit(0);
}









 





x-gateway: rodan.UU.NET from info-vm to gnu.emacs.vm.info; Fri, 2 Oct 1992 18:08:25 EDT
From: kyle@uunet.uu.net (Kyle Jones)
Date: Fri, 2 Oct 1992 18:08:17 -0400
Subject: Considering Moving From VM 4.41 --> VM 5.32; Advice Sought
	<EEIDE.92Oct2112200@asylum.cs.utah.edu>
Newsgroups: gnu.emacs.vm.info