Subject: tcl and c client

From: [email-masked] (Ian Smith)
Date: Tue, 1 Mar 1994 12:06:35 +0500

I thought people might be interested in this. Here is a TCL API to the
C-Client mail toolkit by Mark Crispin (anon ftp to cac.washington.edu
to snarf it up).  Very useful for scripting repeated mail tasks or
writing mail 'bots.

PowerMail is based on this and works pretty well so this API is
"quasi-tested." It is by no means a full interface to C Client, but
its a start. Its good enough to do most mail reading, but PowerMail
does its own mail writing so I haven't built much towards that end.

Naturally, there is no do doc other than source file comments. :-)

Big thanks to Mark Crispin for writing the excellent C Client toolkit.

Hope it helps you out,
ian

/*
 * TCL to CClient API
 * 
 * Ian E. Smith
 * [email-masked]
 *
 * Version 1.0 
 * Cleaned up March 1, 1994
 */

/* TCL CClient API 
 * 
 * TCL API: CClientInstallDriver drivername
 * TCL API: CClientMailOpen mailboxname [oldstream]
 * TCL API: CClientMailClose stream
 * TCL API: CClientFetchBodyRaw stream msgnumber
 * TCL API: CClientFetchHeadersRaw stream msgnumber
 * TCL API: CClientFetchHeaders stream msgNumber
 * TCL API: CClientFetchBodyInfo stream msgNumber
 * TCL API: CClientFetchBodyPart stream messageNumber part
 * TCL API: CClientMoveMessage stream sequence mailbox
 * TCL API: CClientCopyMessage stream sequence mailbox
 * TCL API: CClientSetFlag stream sequence flag
 * TCL API: CClientExpungeMessages stream
 * TCL API: CClientScanMessages stream lowerbound upperbound numcolumns
 * TCL API: CClientSearchMessages stream searchSpec
 * TCL API: CClientMailCheck stream
 * TCL API: CClientStoreMessagePart stream message part encoding filename
 * TCL API: CClientFindMailboxes [[stream] [searchSpec]]
 * 
 * TCL CClient Callbacks:
 *
 * TCL CALLBACK: CClientSearched stream msgnumber
 * TCL CALLBACK: CClientFlags stream msgNumber
 * TCL CALLBACK:  CClientExists stream msgNumber
 * TCL CALLBACK:  CClientExpunged stream msgNumber
 * TCL CALLBACK: CClientMailbox mailboxName
 * TCL CALLBACK: CClientBBoard bboardName [*pseudo-dead*]
 * TCL CALLBACK: CClientNotify stream msgString severity
 * TCL CALLBACK: CClientLog msgString interestingness
 * TCL CALLBACK: CClientDlog msgString 
 * TCL CALLBACK: CClientCritical stream
 * TCL CALLBACK: CClientNoCritical stream
 * TCL CALLBACK: CClientLogin [NOT IMPLEMENTED]
 * TCL CALLBACK: CClientDiskError stream errcode serious|notserious 
 *               return value is used to determine whether to abort or not
 * TCL CALLBACK: CClientFatal message
 */

/*
 * In general this code is replicated too many times. We could be ALOT
 * smarter in condensing functions together (perhaps even down to just
 * one function) and checking argv[0].  I wrote it this way because it
 * is easier to understand by looking it. I only grouped TCL functions 
 * together (and checked argv[0] for which behavior to use) 
 * when it was clear that these functions had similar uses, e.g.
 * CClient_fetch_raw maps to two TCL functions CClientFetchBodyRaw and
 * CClientFetchHeadersRaw 
 */

/* 
 * The TCL API uses strings to represent streams in the CClient API (since
 * that is all TCL has) . I sprintf the hex value of the pointer to
 * the stream into the string before I hand it to TCL. If you wanted to
 * do other hackery involving streams in your own C code, you can just 
 * sscanf the string passed to you by TCL to get the MAILSTREAM * back.
 * I do it left and right and it works fine...
 */

/* 
 * The CClient has particular conventions about memory mgt. that have to
 * be followed VERY carefully. If you hack this API follow these basic
 * guidelines if you are so silly as to not read the CClient documentation:
 * Don't muck with memory that is given to you by fetch-type functions.
 * Do fs_give (free) memory which is converted for you by the rfc822
 * conversion code. Note: fs_give takes a void ** not a void * like you would
 * expect. Finally, if you use a "create" funtion to make one of the objects
 * in the API, you should fs_give it back when you are done. 
 */

/*
 * The strings returned from CClient contain cr/lf pairs and you'll need 
 * to convert them to your local preference IN TCL. I don't do the 
 * conversion for you. If you want to do this on unix, a good approach is 
 * the TCL regsub command. Try:
 if {[regsub -all [format "\015"] "$line" "" new]==1} {
 set line $new
 }
 */

/* 
 * The 'sequences' in this document are IMAP spec sequences. See RFC1176
 * for details but basically I just use comma separated lists of message
 * numbers... ie:
 * set sequence [split $msglist ","]
 */

/* This is the CClient API */
#include "mail.h"
/* CClient RFC822 support functions */
#include "rfc822.h"

/* normal includes */
#include <tcl.h>
#include <stdlib.h>
#include <malloc.h>
#include <string.h>
#include <stdio.h>
#include <fcntl.h>
#include <signal.h>

extern DRIVER mhdriver;
extern DRIVER imapdriver;
extern DRIVER nntpdriver;
extern DRIVER mtxdriver;
extern DRIVER tenexdriver;
extern DRIVER bezerkdriver;
extern DRIVER newsdriver;
extern DRIVER philedriver;
extern DRIVER dummydriver;

/* These are temporary storage while constructing results */
static char tclBuf[0x2000];
static char tmpbuf[0x2000];
static Tcl_Interp *localinterp;

static char *MIMEtypeName[10];
static char *MIMEencodingName[10];

/*
 * This is the call that TCL programs should use to install a driver
 * TCL API: CClientInstallDriver drivername
 * NB: Linking in some drivers (Berkeley) will require that you link
 *     in the dummy driver as well.   I.e.
 *     CClientInstallDriver berkeley
 *     CClientInstallDriver dummy
 *  
 * My reading of the CClient code says that the order you link in 
 * drivers matters in terms of which driver is given preference if
 * a mailbox could be opended by two drivers.
 */
int CClient_install_driver(ClientData clientData, Tcl_Interp *interp, int argc,
			   char **argv)
{
  if (argc!=2) {
    Tcl_AppendResult(interp,"CClientInstallDriver: usage CClientInstallDriver drivername\n",NULL);
    return TCL_ERROR;
  }
  if (strncasecmp(argv[1],"mh",strlen("mh"))==0) {
    mail_link(&mhdriver);
    return TCL_OK;
  }
  if (strncasecmp(argv[1],"berkeley",strlen("berkeley"))==0) {
    mail_link(&bezerkdriver);
    return TCL_OK;
  }
  if (strncasecmp(argv[1],"imap",strlen("imap"))==0) {
    mail_link(&imapdriver);
    return TCL_OK;
  }
  if (strncasecmp(argv[1],"nntp",strlen("nntp"))==0) {
    mail_link(&nntpdriver);
    return TCL_OK;
  }
  if (strncasecmp(argv[1],"tenex",strlen("tenex"))==0) {
    mail_link(&tenexdriver);
    return TCL_OK;
  }
  if (strncasecmp(argv[1],"mtx",strlen("mxt"))==0) {
    mail_link(&mtxdriver);
    return TCL_OK;
  }
  if (strncasecmp(argv[1],"news",strlen("news"))==0) {
    mail_link(&newsdriver);
    return TCL_OK;
  }
  if (strncasecmp(argv[1],"phile",strlen("phile"))==0) {
    mail_link(&philedriver);
    return TCL_OK;
  }
  if (strncasecmp(argv[1],"dummy",strlen("dummy"))==0) {
    mail_link(&dummydriver);
    return TCL_OK;
  }
  Tcl_AppendResult(interp,"CClientInstallDriver:unknown driver ", argv[1],
		   "\n",NULL);
  return TCL_ERROR;
}

/* 
 * Callbacks from the C-Client toolkit 
 * 
 * All these callbacks are "recalledback" into TCL code. If the TCL code
 * doesn't exist or returns an error of some other sort and DEBUG is turned 
 * on, you get an error message. 

 * In any case it is not an option to "abort" some action based on TCL code 
 * (or even C code for that matter), except in the special cases noted in
 * the comments. Generally, these callbacks are ONLY informational. 
 * 
 * In all TCL level callbacks, the original arguments to the C call are
 * replicated and converted into meaningful strings from their numerical
 * values when necessary.
 * 
 * Note that during all of these callbacks (most?) you cannot do 
 * CClient operations (the streams are locked). 
 */

/* 
 * Called during searches to indicate a hit
 * 
 * TCL CALLBACK: CClientSearched stream msgnumber
 */
void mm_searched(MAILSTREAM *stream,long number)
{
  sprintf(tclBuf,"CClientSearched %x %d",stream,number);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}

/*
 * This is called (I think) when flags changed, but only by some drivers.
 * I found that MH and Berkeley don't use this, and the only references
 * in the CClient source to it are in the imap2, mtx, and tenex drivers 
 * 
 * TCL CALLBACK: CClientFlags stream msgNumber
 */
void mm_flags(MAILSTREAM *stream,long number)
{
  sprintf(tclBuf,"CClientFlags %x %d",stream,number);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}

/*
 * This is called to inform you that a mailbox exists and how many
 * messages are in it.
 * 
 * TCL CALLBACK:  CClientExists stream msgNumber
 */
void mm_exists(MAILSTREAM *stream,long number)
{
  sprintf(tclBuf,"CClientExists %x %d",stream,number);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",interp->result);
#endif

}

/*
 * This is called to tell you that a mail message is now expunged. It
 * also means renumbering of all higher messages has now happened.
 *
 * TCL CALLBACK:  CClientExpunged stream msgNumber
 *
 */
void mm_expunged(MAILSTREAM *stream,long number)
{
  sprintf(tclBuf,"CClientExpunged %x %d",stream,number);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}

/* 
 * This is called in response to mailFind requests. I have had limited
 * success with this function (or is it with MailFind?). I don't think
 * that it works right in MH, but I'm not sure.
 * 
 * TCL CALLBACK: CClientMailbox mailboxName
 */
void mm_mailbox(char *string)
{
  sprintf(tclBuf,"CClientMailbox %s",string);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}
/*
 * This is called in response to a FindBBoardS request, but there currently
 * is no TCL API to that, so this is pseudo-dead code. 
 * 
 * TCL CALLBACK: CClientBBoard bboardName [*pseudo-dead*]
 */
void mm_bboard(char *string)
{
  sprintf(tclBuf,"CClientBBoard %s",string);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}
/*
 * This function is called in response to IMAP protocol problems. 
 * I don't use IMAP so I'm not sure how it works.
 * 
 * TCL CALLBACK: CClientNotify stream msgString severity
 */
void mm_notify(MAILSTREAM *stream,char *string,long errflag)
{
  switch (errflag) {
  case NIL:
    sprintf(tclBuf,"CClientNotify %x \"%s\" NIL",stream,string);
    break;
  case WARN:
    sprintf(tclBuf,"CClientNotify %x \"%s\" WARN",stream,string);
    break;
  case ERROR:
    sprintf(tclBuf,"CClientNotify %x \"%s\" ERROR",stream,string);
    break;
  default:
    fprintf(stderr,"internal error in tcl-c-client: unkown error type %d\n",
	    errflag);
    return;
  }
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}
/*
 * This is called when CClient wants to tell you something of various
 * levels of interestingness.
 *
 * TCL CALLBACK: CClientLog msgString interestingness
 */
void mm_log(char *string, long errflg)
{
  switch (errflg) {
  case NIL:
    sprintf(tclBuf,"CClientLog \"%s\" NIL",string);
    break;
  case WARN:
    sprintf(tclBuf,"CClientLog \"%s\" WARN",string);
    break;
  case ERROR:
    sprintf(tclBuf,"CClientLog \"%s\" ERROR",string);
    break;
  case PARSE:
    sprintf(tclBuf,"CClientLog \"%s\" PARSE",string);
    break;
  default:
    fprintf(stderr,"internal error in tcl-c-client: unkown error type %d\n",
	    errflg);
    return;
  }
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}

/*
 * This is called if you are using debugging on a stream (probably and
 * IMAP stream?) ... it gives you "telemetry info." I don't have any
 * interface to turning on debugging on a stream, but I should. 
 *
 * TCL CALLBACK: CClientDlog msgString 
 */
void mm_dlog(char *string)
{
  sprintf(tclBuf,"CClientDlog %s",string);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}

/* 
 * This is a crucial bit. This is called just before anything dangerous
 * is done to a mailfile (destructively).  I turn off signals that might
 * be coming from the user during this period, although what I should
 * be doing is "deferring" them. Also, I don't put back the values of
 * signal handlers when I'm done... so sue me.
 * 
 * TCL CALLBACK: CClientCritical stream
 */
void mm_critical(MAILSTREAM *stream)
{
  sprintf(tclBuf,"CClientCritical %x",stream);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif

  /* avoid problems before they happen */
  signal(SIGINT,SIG_IGN);
  signal(SIGHUP,SIG_IGN);
  signal(SIGQUIT,SIG_IGN);
}

/*
 * This is the opposite of mm_critical, called when we are done with a 
 * critical section.  Again, my signal handling is really bogus. 
 *
 * TCL CALLBACK: CClientNoCritical stream
 */
void mm_nocritical(MAILSTREAM *stream)
{
  /* ok, let the problems happen again */
  signal(SIGINT,SIG_DFL);
  signal(SIGHUP,SIG_DFL);
  signal(SIGQUIT,SIG_DFL);

  sprintf(tclBuf,"CClientNoCritical %x",stream);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
}

/* 
 * This is called when IMAP logins are necessary. This should
 * get password and user info, but it isn't implemented yet.
 *  
 * TCL CALLBACK: CClientLogin [NOT IMPLEMENTED]
 */
void mm_login(char *host,char *user,char *pwd,long trials)
{
  fprintf(stderr,"CClientLogin not implemented\n");
  return;
}

/* 
 * This is hairy. This is called in response to a diskerrr 
 * situation. If serious is zero and your tcl client returns
 * non-zero, operation will abort, otherwise you get retry.
 * If serious is non-zero you always get retry. I don't understand
 * why this is. 
 *
 * TCL CALLBACK: CClientDiskError stream errcode serious|notserious 
 *               return value is used to determine whether to abort or not
 * 
 */
long mm_diskerror(MAILSTREAM *stream,long errcode, long serious)
{
  int ret=0;

  if (serious) {
    sprintf(tclBuf,"CClientDiskError %x %d serious",stream,errcode);
  } else {
    sprintf(tclBuf,"CClientDiskError %x %d notserious",stream,errcode);
  }
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    ret=atoi(localinterp->result);
    return ret;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
  return ret;
}
/*
 * This is called when a fatal error occurs. You are basically hosed.
 * 
 * TCL CALLBACK: CClientFatal message
 */
void mm_fatal(char *string)
{
  sprintf(tclBuf,"CClientFatal %s",string);
  if (Tcl_Eval(localinterp,tclBuf)==TCL_OK) {
    return ;
  }
#ifdef DEBUG
  fprintf(stderr,"tcl callback error: %s\n",localinterp->result);
#endif
  
}

/* 
 * This opens a mail stream, and returns a handle to it as a string 
 * (see above on why this is a hack).
 *
 * TCL API: CClientMailOpen mailboxname [oldstream]
 */

int CClient_mail_open(ClientData clientData,Tcl_Interp *interp,
		      int argc,char **argv) 
{
  MAILSTREAM *stream=NULL;
  MAILSTREAM *newstream;

  if ((argc!=2)  && (argc!=3)) {
    Tcl_AppendResult(interp,"CClientMailOpen: usage CClientMailOpen mailboxname [oldstream]\n",NULL);
    return TCL_ERROR;
  }
  if (argc==3) {
    sscanf(argv[2],"%x",&stream);
  }
  newstream=mail_open(stream,argv[1],NIL);
  if (!newstream) {
    Tcl_AppendResult(interp,"CClientMailOpen: error creating stream\n",NULL);
    return TCL_ERROR;
  }
  sprintf(tclBuf,"%x",newstream);
  Tcl_AppendResult(interp,tclBuf);
  return TCL_OK;
}

/* 
 * This closes a mail stream, and returns nothing.
 *
 * TCL API: CClientMailClose stream
 */
int CClient_mail_close(ClientData clientData,Tcl_Interp *interp,
		      int argc,char **argv) 
{
  MAILSTREAM *stream=0;

  if (argc!=2) {
    Tcl_AppendResult(interp,
		     "CClientMailClose: usage CClientMailClose stream\n",
		     NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  mail_close(stream);
  return TCL_OK;
}

/* 
 * This fetches headers or bodies of mail messages (raw, no decoding) as
 * (big) strings. 
 *
 * TCL API: CClientFetchBodyRaw stream msgnumber
 * TCL API: CClientFetchHeadersRaw stream msgnumber
 */
int CClient_fetch_raw(ClientData clientData,Tcl_Interp *interp,
			  int argc,char **argv)
{
  MAILSTREAM *stream=0;
  long number;

  if (argc!=3) {
    Tcl_AppendResult(interp,argv[0],": usage ", argv[0],
		     " stream messageNumber \n",NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  if (Tcl_GetInt(interp,argv[2],(int *)&number)==TCL_ERROR) {
    Tcl_AppendResult(interp,argv[0],": bad message number: ",
		     interp->result,"\n",NULL);
    return TCL_ERROR;
  }
  if (strcmp(argv[0],"CClientFetchBodyRaw")==0) {
    Tcl_SetResult(interp,mail_fetchtext(stream,number),TCL_VOLATILE);
    return TCL_OK;
  } else {
    /* must be FetchHeadersRaw */
    Tcl_SetResult(interp,mail_fetchheader(stream,number),TCL_VOLATILE);
    return TCL_OK;
  }
}

/* 
 * This function grabs the header values out of the CClient cache and
 * parses them into a TCL list. Each element is a sublist of two elements
 * with the first (lindex 0) being the header field name and the second
 * the value.
 *
 * TCL API: CClientFetchHeaders stream msgNumber
 */
int CClient_fetch_headers(ClientData clientData,Tcl_Interp *interp,
			  int argc,char **argv)
{
  MAILSTREAM *stream=0;
  long number;
  ENVELOPE *env;
  char *headers[14];
  char *pair[2],*tmp;

  if (argc!=3) {
    Tcl_AppendResult(interp,
		     "CClientFetchHeaders: usage CClientFetchHeaders stream messageNumber \n",
		     NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  if (Tcl_GetInt(interp,argv[2],(int *)&number)==TCL_ERROR) {
    Tcl_AppendResult(interp,"CClientFetchHeaders: bad message number: ",
		     interp->result,"\n",NULL);
    return TCL_ERROR;
  }
  env=mail_fetchstructure(stream,number,NIL);
  /* ok, parse the envelope */
  
  /* remail */
  pair[0]="Remail";
  pair[1]=env->remail;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  free(tmp);

  /* return path */
  rfc822_write_address(tmpbuf,env->return_path);
  pair[0]="Return Path";
  pair[1]=tmpbuf;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  sprintf(tmpbuf,"");
  free(tmp);

  /* date */
  pair[0]="Date";
  pair[1]=env->date;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  free(tmp);

  /* from  */
  rfc822_write_address(tmpbuf,env->from);
  pair[0]="From";
  pair[1]=tmpbuf;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  sprintf(tmpbuf,"");
  free(tmp);

  /* sender  */
  rfc822_write_address(tmpbuf,env->sender);
  pair[0]="Sender";
  pair[1]=tmpbuf;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  sprintf(tmpbuf,"");
  free(tmp);

  /* reply_to  */
  rfc822_write_address(tmpbuf,env->reply_to);
  pair[0]="Reply To";
  pair[1]=tmpbuf;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  sprintf(tmpbuf,"");
  free(tmp);

  /* subject */
  pair[0]="Subject";
  pair[1]=env->subject;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  free(tmp);

  /* to  */
  rfc822_write_address(tmpbuf,env->to);
  pair[0]="To";
  pair[1]=tmpbuf;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  sprintf(tmpbuf,"");
  free(tmp);

  /* cc */
  rfc822_write_address(tmpbuf,env->cc);
  pair[0]="CC";
  pair[1]=tmpbuf;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  sprintf(tmpbuf,"");
  free(tmp);

  /* bcc */
  rfc822_write_address(tmpbuf,env->bcc);
  pair[0]="BCC";
  pair[1]=tmpbuf;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  sprintf(tmpbuf,"");
  free(tmp);

  /* in_reply_to */
  pair[0]="In Reply To";
  pair[1]=env->in_reply_to;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  free(tmp);

  /* message id */
  pair[0]="Message Id";
  pair[1]=env->message_id;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  free(tmp);

  /* newsgroups */
  pair[0]="Newsgroups";
  pair[1]=env->newsgroups;
  tmp=Tcl_Merge(2,pair);
  Tcl_AppendElement(interp,tmp);
  free(tmp);

  return TCL_OK;
}

/* 
 * This function is for internal use only. It is called recursively to
 * decode the (potentially  recursively nested) multipart mail messages.
 * 
 * Used by: CClient_fetch_body_info
 */
char* CClient_recurse_body(BODY *body,char *currentPart,
			 int call)
{
  /* allow 20 part max */
  char *info[26];
  char buf[80],*tmp;
  PART *head;
  int counter,i;

  switch (body->type) {
  case TYPETEXT:
    if (strcmp(currentPart,"")==0) 
      sprintf(buf,"%d",call);
    else
      sprintf(buf,"%s.%d",currentPart,call);
    info[0]=buf;
    info[1]=MIMEtypeName[body->type];
    /* Its not clear that the value body->subtype is right for subtypes
        of text */
    if ((strncasecmp(body->subtype,"richtext",strlen("richtext"))==0)||
	(strncasecmp(body->subtype,"enriched",strlen("enriched"))==0) ||
	(strncasecmp(body->subtype,"plain",strlen("plain"))==0)) {
      info[2]=body->subtype;
      info[3]=body->description;
      info[4]=body->id;
      info[5]=MIMEencodingName[body->encoding];
    } else {
      info[2]="plain";
      info[3]="";
      info[4]="";
      info[5]="";
    }
    /* caller must free this */
    tmp=Tcl_Merge(6,info);
    return tmp;
  case TYPEMESSAGE:
  case TYPEAPPLICATION:
  case TYPEIMAGE:
  case TYPEAUDIO:
  case TYPEVIDEO:
  case TYPEOTHER:
    if (strcmp(currentPart,"")==0) 
      sprintf(buf,"%d",call);
    else
      sprintf(buf,"%s.%d",currentPart,call);
    info[0]=buf;
    info[1]=MIMEtypeName[body->type];
    info[2]=body->subtype;
    info[3]=body->description;
    info[4]=body->id;
    info[5]=MIMEencodingName[body->encoding];
    /* caller must free this */
    tmp=Tcl_Merge(6,info);
    return tmp;
  case TYPEMULTIPART:
    if (strcmp(currentPart,"")==0) 
      sprintf(buf,"%d",call);
    else
      sprintf(buf,"%s.%d",currentPart,call);
    info[0]=MIMEtypeName[body->type];
    info[1]=body->subtype;
    info[2]=body->description;
    info[3]=body->id;
    info[4]=MIMEencodingName[body->encoding];
    counter=5;
    head=body->contents.part;
    if (strcmp(currentPart,"")==0)  {
      if (call==1)
	sprintf(buf,"");
      else 
	sprintf(buf,"%d",call);
    }
    else 
      sprintf(buf,"%s.%d",currentPart,call);
    while (head) {
      info[counter]=CClient_recurse_body(&head->body,buf,counter-4);
      ++counter;
      if (counter==26) {
	fprintf(stderr,"recurse body: overflow on mime parts! max is 20! stopping recursion!\n");
	head=NULL;
      }
      head=head->next;
    }
    /* now make a string of the whole thing */
    tmp=Tcl_Merge(counter,info);
    /* got a copy ... free the temporaries */
    for (i=5; i<counter;++i) free(info[i]);
    return tmp;
  }
  /* not reached */
}

/* 
 * This function should be called to get info about a mail message. It 
 * returns a list which has information about body parts. If the mail
 * message is non-MIME or MIME non-multipart you just a list describing 
 * the sole part. This list is of the form:
 * { partNumber maintype subtype description id encoding }
 * 
 * If the message is MIME multipart you get a list of the form:
 * { maintype subtype description id encoding SUBPARTS} and each subpart
 * is a list of the forms described here.
 * 
 * TCL API: CClientFetchBodyInfo stream msgNumber
 */
int CClient_fetch_body_info(ClientData clientData,Tcl_Interp *interp,
			    int argc, char **argv) 
{
  MAILSTREAM *stream=0;
  long number;
  char *currentPart=strdup("");
  int done=0;
  BODY *body;
  LONGCACHE *msglcache;
  if (argc!=3) {
    Tcl_AppendResult(interp,
		     "CClientFetchBodyInfo: usage CClientFetchHeaders stream messageNumber \n",
		     NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  if (Tcl_GetInt(interp,argv[2],(int *)&number)==TCL_ERROR) {
    Tcl_AppendResult(interp,"CClientFetchBodyInfo: bad message number: ",
		     interp->result,"\n",NULL);
    return TCL_ERROR;
  }
  if (!mail_fetchstructure(stream,number,&body)) {
    Tcl_AppendResult(interp,"CClientFetchBodyInfo: error fetching mail body!\n");
    return TCL_ERROR;
  }
  if (!body) {
    fprintf(stderr,"HM. No body.\n");
  }
  Tcl_SetResult(interp,CClient_recurse_body(body,currentPart,1),
		TCL_DYNAMIC);
  return TCL_OK;
  
}

/* 
 * This function is called to get info about a specific message part.
 * It assumes you know what part you want (and call it correctly) 
 * via CClientGetBodyInfo.  It returns the text as a string. If you
 * call this on a part that is non-textual you are not guaranteed
 * anything, and thus I wouldn't advise it. See below for what to
 * do if the part is non-textual.
 *
 * TCL API: CClientFetchBodyPart stream messageNumber part
 */
int CClient_fetch_body_part(ClientData clientData,Tcl_Interp *interp,
			    int argc, char **argv) 
{
  MAILSTREAM *stream;
  int number;
  unsigned long length;
  char *ret;
  if (argc!=4) {
    Tcl_AppendResult(interp,argv[0],": usage ", argv[0]," stream messageNumber part\n",NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (Tcl_GetInt(interp,argv[2],(int *)&number)==TCL_ERROR) {
    Tcl_AppendResult(interp,argv[0],": bad message number: ",
		     interp->result,"\n",NULL);
    return TCL_ERROR;
  }
  if (argv[3]=="") {
    Tcl_AppendResult(interp,argv[0],": bad message part\n",NULL);
    return TCL_ERROR;
  }
  if (!(ret = mail_fetchbody(stream,number,argv[3],&length))) {
    Tcl_AppendResult(interp,argv[0],": unable to fetch body of message ", argv[2], " part ", argv[3],"\n",NULL);
    return TCL_ERROR;
  }
  Tcl_SetResult(interp,ret,TCL_VOLATILE);
  return TCL_OK;
}

/* 
 * This function is used to move messages to other folders. It assumes that
 * that the target mailbox is the same format (same driver) as the source
 * stream. It will move or copy, based on how its called.   The mailbox
 * argument is a fully specificed pathname as far as I can tell.
 *
 * TCL API: CClientMoveMessage stream sequence mailbox
 * TCL API: CClientCopyMessage stream sequence mailbox
 */

int CClient_move_message(ClientData clientData, Tcl_Interp *interp,
			 int argc,char **argv) 
{
  MAILSTREAM *stream=0;

  if (argc!=4) {
    Tcl_AppendResult(interp,argv[0],": usage ",argv[0],
		     " stream sequence mailbox\n",NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  if (strcmp(argv[0],"CClientMoveMessage")==0) { 
    mail_move(stream,argv[2],argv[3]);
  } else {
    mail_copy(stream,argv[2],argv[3]);
  }
  return TCL_OK;
}

/* 
 * This function is called to set or clear message flags.  This function 
 * just marks them with the flags, it doesn't seem to call any callbacks,
 * so you need to implement a search to find out about results, since
 * there doesn't appear to be any CClient API call to *get* the flags.
 * 
 * Note that one MAY NOT mark with arbitrary flags as you might want.
 * The only flags that are recognized are (in tcl read syntax) \\SEEN,
 * \\RECENT, \\ANSWERED, \\FLAGGED, \\DELETED.  I find this irritating.
 *
 * TCL API: CClientSetFlag stream sequence flag
 */
int CClient_flag(ClientData clientData,Tcl_Interp *interp,
		     int argc, char **argv) 
{
  MAILSTREAM *stream=0;

  if (argc!=4) {
    Tcl_AppendResult(interp,argv[0],": usage ",argv[0],
		     " stream sequence flag\n",NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  if ((strcmp(argv[3],"")==0) || (strcmp(argv[2],"")==0)) {
    Tcl_AppendResult(interp,argv[0],": bad sequence or flag\n",NULL);
    return TCL_ERROR;
  }
  if (strcmp(argv[0],"CClientSetFlag")==0) {
    mail_setflag(stream,argv[2],argv[3]);
  } else {
    mail_clearflag(stream,argv[2],argv[3]);
  }
  return TCL_OK;
}

/* 
 * This function is used to ACTUALLY DELETE mail messages which have
 * been marked for deletion (see above).  It causes a destructive mod
 * of the mailfiles so it usually ends up calling CClientCritical and
 * CCLientNoCritical when starting and finishing respectively.
 * 
 * TCL API: CClientExpungeMessages stream
 */
int CClient_expunge_messages(ClientData clientData,Tcl_Interp *interp,
			  int argc,char **argv) 
{
  MAILSTREAM *stream=0;
  if (argc!=2) {
    Tcl_AppendResult(interp,argv[0],": usage ",argv[0],
		     "stream\n",NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  mail_expunge(stream);
  return TCL_OK;
}

/* 
 * This is my own call, not really part of the CClient API proper, but 
 * built on the mail_fetchsubject and mail_fetchfrom commands to make 
 * life easy. This should really be implemented by using a callback into
 * TCL to do the per-line formatting to allow easier customization.
 * 
 * This function will produce a reasonably nicely formatted list of the
 * messages in a stream.  It takes a stream, lower and upper bounds and
 * the number of columns you want in the output.  It returns a string 
 * ready for printing on the screen. It contains embedded carriage returns
 * to separate messages.
 * 
 * TCL API: CClientScanMessages stream lowerbound upperbound numcolumns
 */
int CClient_scan_messages(ClientData clientData,Tcl_Interp *interp,
			  int argc,char **argv) 
{
  MAILSTREAM *stream=0;
  long lower,upper,i,cols;
  char *s;

  if (argc!=5) {
    Tcl_AppendResult(interp,"CClientScanMessages: usage CClientScanMessages stream lowerbound upperbound cols\n",NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  if (Tcl_GetInt(interp,argv[2],(int *)&lower)==TCL_ERROR) {
    Tcl_AppendResult(interp,"CClientScanMessages: bad lower bound number: ",
		     interp->result,"\n",NULL);
    return TCL_ERROR;
  }
  if (Tcl_GetInt(interp,argv[3],(int *)&upper )==TCL_ERROR) {
    Tcl_AppendResult(interp,"CClientScanMessagest: bad upper bound number: ",
		     interp->result,"\n",NULL);
    return TCL_ERROR;
  }
  if (Tcl_GetInt(interp,argv[4],(int *)&cols )==TCL_ERROR) {
    Tcl_AppendResult(interp,"CClientScanMessagest: bad number of columns: ",
		     interp->result,"\n",NULL);
    return TCL_ERROR;
  }
  for (i=lower; i<=upper; ++i) {
    s=tmpbuf;
    sprintf(s,"%-4d ",i);
    s+=5;
    mail_fetchfrom(s,stream,i,25);
    s+=25;
    sprintf(s," ");
    s++;
    mail_fetchsubject(s,stream,i,cols-31);
    Tcl_AppendElement(interp,tmpbuf);
  }
  return TCL_OK;
}

/* 
 * This function is used to start a search. It will call back to the 
 * CClientSearched function on each hit. The search spec should be in
 * IMAP format, see RFC 1176. 
 *  
 * TCL API: CClientSearchMessages stream searchSpec
 *
 */
int CClient_search_messages(ClientData clientData,Tcl_Interp *interp,
			  int argc,char **argv) 
{
  MAILSTREAM *stream=0;

  if (argc!=3) {
    Tcl_AppendResult(interp,argv[0],": usage ",argv[0]," stream search spec\n",
		     NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  strcpy(tmpbuf,argv[2]);  
  mail_search(stream,tmpbuf);
  return TCL_OK;
}

/* 
 * This function is used to check for new mail. It will callback to
 * CClientExists if it succeeds.   I really wish it returned a value
 * that I could return to TCL.
 *
 * TCL API: CClientMailCheck stream
 */
int CClient_mail_check(ClientData clientData,Tcl_Interp *interp,
		       int argc,char **argv) 
{
  MAILSTREAM *stream=0;

  if (argc!=2) {
    Tcl_AppendResult(interp,argv[0],": usage ",argv[0]," stream\n",
		     NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  mail_check(stream);
  return TCL_OK;
}

/* 
 * This is a function I built to support mime mail in TCL.  
 * 
 * If you get a messgae part that you know is non-textual (non 7-bit) via 
 * CClientGetMessageInfo (look at the [lindex $part 5] which is the
 * encoding field) you should use this to decode it and store it
 * into a file.  This function takes a stream, a message part, an encoding,
 * and a filename and stores the specified message DECODED into
 * the filename. It currently only knows about base64 and 
 * quoted-printable encodings.
 * 
 * TCL API: CClientStoreMessagePart stream message part encoding filename
 */

int CClient_store_message_part(ClientData clientData,Tcl_Interp *interp,
			       int argc,char **argv) 
{
  MAILSTREAM *stream=0;
  int number;
  int len,extralen;
  char *body,*extra=NULL;
  int fd;

  if (argc!=6) {
    Tcl_AppendResult(interp,argv[0],": usage ",argv[0]," stream message part encoding filename\n",
		     NULL);
    return TCL_ERROR;
  }
  sscanf(argv[1],"%x",&stream);
  if (stream==0) {
    Tcl_AppendResult(interp,argv[0],": stream not open, unable to perform operation\n",NULL);
    return TCL_ERROR;
  }
  if (Tcl_GetInt(interp,argv[2],(int *)&number)==TCL_ERROR) {
    Tcl_AppendResult(interp,argv[0],": bad message number: ",
		     interp->result,"\n",NULL);
    return TCL_ERROR;
  }
  body=mail_fetchbody(stream,number,argv[3],&len);
  if (strcmp("base64",argv[4])==0) {
    extra=rfc822_base64(body,len,&extralen);
  } 
  if (strcmp("quoted-printable",argv[4])==0) {
    extra=rfc822_qprint(body,len,&extralen);
  }
  fd=open(argv[5],O_WRONLY | O_CREAT, 0700);
  if (fd<0) {
    Tcl_AppendResult(interp,argv[0],": error opening file ", argv[5],"\n",
		     NULL);
    return TCL_ERROR;
  }
  if (extra) {
    write(fd,extra,extralen);
    /* not this is a void **, not a void */
    fs_give(&extra);
  } else {
    write(fd,body,len);
  }
  close(fd);
  return TCL_OK;
}

/* 
 * I don't exactly understand how to use this function, I have had
 * trouble getting it to do much of anything. 
 *
 * This function takes an option stream and search spec and calls 
 * back into CClientMailbox to inform you of the mailboxes it has
 * found. I find it works better if you pass in an existing although 
 * I don't know why.  The search spec appears to be a glob style 
 * pattern.
 *
 * TCL API: CClientFindMailboxes [[stream] [searchSpec]]
 */
int CClient_find_mailboxes(ClientData clientData,Tcl_Interp *interp,
		       int argc,char **argv) 
{
  MAILSTREAM *stream=0;

  if ((argc!=3)  && (argc!=2) && (argc!=1)) {
    Tcl_AppendResult(interp,argv[0],": usage ",argv[0]," [[stream] [search spec]] \n",
		     NULL);
    return TCL_ERROR;
  }
  if (argc!=3) {
    strcpy(tmpbuf,"*");
  } else {
    strcpy(tmpbuf,argv[2]);
  }
  if (argc>1) {
    sscanf(argv[1],"%x",&stream);
  }
  mail_find_all(stream,tmpbuf); 
  return TCL_OK;
}

/*
 * This function initialized the TCL CClient API. Use it from C code to
 * set everything up.
 */
CClient_Init(Tcl_Interp *interp)
{
  localinterp=interp;

  Tcl_CreateCommand(interp,"CClientInstallDriver",
		    CClient_install_driver,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientMailOpen",
		    CClient_mail_open,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientMailClose",
		    CClient_mail_close,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientFetchHeaders",
		    CClient_fetch_headers,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientFetchHeadersRaw",
		    CClient_fetch_raw,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientFetchBodyRaw",
		    CClient_fetch_raw,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientFetchBodyInfo",
		    CClient_fetch_body_info,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientFetchBodyPart",
		    CClient_fetch_body_part,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientScanMessages",
		    CClient_scan_messages ,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientClearFlag",
		    CClient_flag ,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientSetFlag",
		    CClient_flag ,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientExpungeMessages",
		    CClient_expunge_messages ,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientSearchMessages",
		    CClient_search_messages ,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientMailCheck",
		    CClient_mail_check ,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientFindMailboxes",
		    CClient_find_mailboxes ,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientStoreMessagePart",
		    CClient_store_message_part ,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientMoveMessage",
		    CClient_move_message,NULL,NULL);
  Tcl_CreateCommand(interp,"CClientCopyMessage",
		    CClient_move_message,NULL,NULL);
  /* setup my arrays */
  MIMEtypeName[TYPETEXT]="text";
  MIMEtypeName[TYPEMULTIPART]="multipart";
  MIMEtypeName[TYPEMESSAGE]="message";
  MIMEtypeName[TYPEAPPLICATION]="application";
  MIMEtypeName[TYPEAUDIO]="audio";
  MIMEtypeName[TYPEIMAGE]="image";
  MIMEtypeName[TYPEVIDEO]="video";
  MIMEtypeName[TYPEOTHER]="unknown"; /* shouldn't happen */

  MIMEencodingName[ENC7BIT]="7bit";
  MIMEencodingName[ENC8BIT]="8bit";
  MIMEencodingName[ENCBINARY]="binary";
  MIMEencodingName[ENCBASE64]="base64";
  MIMEencodingName[ENCQUOTEDPRINTABLE]="quoted-printable";
  MIMEencodingName[ENCOTHER]="unknown";

#ifdef MALLOC_DEBUG
  malloc_debug(2);
#endif 
  return TCL_OK;
}

---

From: [email-masked] (Mark Roseman)
Date: Tue, 1 Mar 1994 20:31:28 -0700

> to snarf it up).  Very useful for scripting repeated mail tasks or

excellent!  we're using tcl inside ecsmail and i can see what
you've done being handy for us. :-)  there's also another
tcl/c-client system available done by angel li at one of
the universities in florida.. the system is called palm and
puts a tcl/tk interface over c-client.

cheers
mark
(who's very much on a campaign to have tcl take over the world..!)