From: hd@cnplss5.cft.philips.nl (Henk Davids)
Newsgroups: comp.os.vms
Subject: Re: Alternative callable editors in MAIL? [source+question]
Date: 30 Dec 92 04:46:45 GMT
Organization: Philips Communications & Processing Services, Eindhoven


Following up on the creation of custom editor modules for MAIL,
below you will find some code designed to attach to a subprocess
that has been created earlier, presumably running EVE or GNU Emacs.
You will almost certainly have to change this. Besides that, the
editor that we will attach to will have to do something sensible
with the job logical names that are set by this routine. I will
leave that as an exercise for the reader.

So much for the warnings.

Now a question: the comment in the C module says that MAIL is an installed
module. In fact, it is not. Neither are the shareable images that MAIL will
call. How then does MAIL get its privileges (SYSPRIV) to write into other
peoples' mail files?

				Henk

Below the makefile, the .OPT files and the C source.
--start of makefile--
.ifdef DEBUG
CFLAGS=/debug/noopt/define=(TESTING
LINKFLAGS=/debug/exe=$@
.else
CFLAGS=/optim=noinline/define=(DUMMY
LINKFLAGS=/shareable=$@
.endif

GNUOBJ=gnushr.obj
GNUOPT=gnushr.opt
EVEOBJ=eveshr.obj
EVEOPT=eveshr.opt

all : gnushr.exe eveshr.exe
      ! Done.

gnushr.exe : $(GNUOBJ) $(GNUOPT)
	   link $(LINKFLAGS) $(GNUOBJ),$(GNUOPT)/opt

eveshr.exe : $(EVEOBJ) $(EVEOPT)
	   link $(LINKFLAGS) $(EVEOBJ),$(EVEOPT)/opt

gnushr.obj : editshr.c
	   cc $(CFLAGS),GNU)/object=$@ editshr.c

eveshr.obj : editshr.c
	   cc $(CFLAGS),EVE)/object=$@ editshr.c
--end of makefile--
--start of eveshr.opt
universal=EVE$EDIT
--end of eveshr.opt
--start of gnushr.opt
universal=GNU$EDIT
--end of gnushr.opt

--start of editshr.c--
/*
 EDITSHR: a shareable image that may be used by VMS MAIL as an editor.
 Both the interface to a suspended EVE and GNUEmacs can be handled
 by this source. See the accompanying makefile for the generation
 procedure.
 Define either EVE or GNU on the compiler invocation. To create a test
 version, define TESTING too (see main() at end of this file).

 After creating the GNUSHR and EVESHR shareable images, install them
 in SYS$SHARE. Since MAIL is an installed image, VMS expects these images
 to be installed as well.
 If you do not want to install the shareable image but want to use it
 anyway, define MAIL as SYS$SYSTEM:MAIL.EXE;0. This will let you use
 the non-installed version of MAIL, in which case VMS will allow you
 to use private -non-installed- versions of GNUSHR or EVESHR.

 Operation:
 1. tell MAIL to use the shareable image as editor call, by entering
       SET EDITOR GNU
     or
       SET EDITOR EVE
    This only has to be given once. MAIL will remember this setting.
    Make sure you do not have a logical MAIL$EDIT defined when running
    MAIL - this will override any setting you have given here.
 2. When MAIL decides it's time to call the editor, it will activate
    the GNUSHR/EVESHR image with appropriate parameters.
 3. GNU$EDIT/EVE$EDIT then performs the following actions:
    a. compose the processname of the editor. For Eve, this is "EVE_"
       followed by the translation of the logical "TT:". For GNU Emacs,
       this is "Emacs_" followed by the translation of the logical "TT:"
       without a trailing colon. In any case, the procedure you use to
       spawn the editor should set the process name in accordance with
       this.
    b. find the PID of that process. If the editor cannot be found,
       callable TPU will be used. Note that TPU will start with the
       section-name taken from the logical TPU$SECTION. If you did
       not supply this logical name, the default systemtable definition
       will be used. Currently (VMS 5.5) this is the standard EVE.
    c. define a few job logical names:
       <editor>_FILE_NAME         the input file to be read
       <editor>_OUTPUT_FILE_NAME  where the output should go
       <editor>_<editor_pid>      the PID of the process running MAIL
    d. attach to the editor.
    e. on return from the editor, cleanup and return to MAIL.

 Note: the fact that MAIL uses the simplified interface to a callable
 editor is just sheer luck - it's not documented. This means of course
 that future versions of MAIL may not work with this code.
*/

#include <ssdef.h>
#include <descrip.h>
#include <lib$routines.h>

/* Forward procedure definitions */
static unsigned long call_tpu(struct dsc$descriptor *inputfile,
			      struct dsc$descriptor *outputfile);
static void longtohex(char *ptr, unsigned long value);
static void strcpy(char *to, char *from);
static void strncpy(char *to, char *from, int length);
static unsigned long find_process(struct dsc$descriptor_s *name,
				  unsigned long *pid_ptr);
static unsigned long translate_logical_name(struct dsc$descriptor_s *logical_name,
					    struct dsc$descriptor_s *string);
static unsigned long define_logical_name(struct dsc$descriptor_s *logical_name,
					 struct dsc$descriptor_s *string);
static unsigned long delete_logical_name(struct dsc$descriptor_s* logical_name);

/* Selection of constants that differ between GNUEmacs and EVE */
#ifdef EVE
#define EDITOR_FILE_NAME "EVE_FILE_NAME"
#define EDITOR_OUTPUT_FILE_NAME "EVE_OUTPUT_FILE_NAME"
#define NAME_PREFIX "EVE"
#define PID_PREFIX "EVE_"
#define EDITOR_PID_LOGNAM "EVE_XXXXXXXX"
#define ENTRYNAME EVE$EDIT
#define NO_COLON 0
#else	/* GNU */
#define EDITOR_FILE_NAME "EMACS_FILE_NAME"
#define EDITOR_OUTPUT_FILE_NAME "EMACS_OUTPUT_FILE_NAME"
#define NAME_PREFIX "Emacs"
#define PID_PREFIX "EMACS_"
#define EDITOR_PID_LOGNAM "EMACS_XXXXXXXX"
#define ENTRYNAME GNU$EDIT
#define NO_COLON 1
#endif

/* Common constants */
/* maximum length of a process name */
#define MAXPROCESSNAM 32
/* maximum length of the translation of a logical name */
#define MAXTRANSLATION 1024

/* Macro to test the result of a status value */
#define OK(i) ((i) & 1)

/*
  This is the procedure that will be called by MAIL.
  At the time of the call, MAIL will have exported
  any message that is needed from the MAIL-file to the
  file system.
  ENTRYNAME can be GNU$EDIT or EVE$EDIT, as specified above.
  Return value is a VMS status longword (always SS$_NORMAL).
  Errors preventing proper operation will be signalled.
*/

unsigned long ENTRYNAME(struct dsc$descriptor *inputfile,
			struct dsc$descriptor *outputfile)
{
    $DESCRIPTOR(inputfile_lognam, EDITOR_FILE_NAME);
    $DESCRIPTOR(outputfile_lognam, EDITOR_OUTPUT_FILE_NAME);
    $DESCRIPTOR(tt_lognam_dsc, "TT");
    char tt_translation[MAXTRANSLATION+1];
    $DESCRIPTOR(tt_translation_dsc, tt_translation);
    char editor_name[MAXPROCESSNAM+1];
    $DESCRIPTOR(editor_name_dsc, editor_name);
    char editor_pid_lognam[] = EDITOR_PID_LOGNAM;
    $DESCRIPTOR(editor_pid_dsc, editor_pid_lognam);
    char editor_pid_def_lognam[] = "XXXXXXXX";
    $DESCRIPTOR(editor_pid_def_dsc, editor_pid_def_lognam);
    unsigned long editor_pid;
    unsigned long my_pid;
    unsigned long status, ignore;
    int i;

    /* generate the process name of the editor */
    status = translate_logical_name(&tt_lognam_dsc, &tt_translation_dsc);
    if (!OK(status))
	lib$signal(status);
    /* processname = prefix + f$logical("TT") */
    strcpy(editor_name, NAME_PREFIX);
    i = sizeof(NAME_PREFIX) - 1;
    if (tt_translation_dsc.dsc$w_length > 0) {
	if (tt_translation[0] != '_') {
	    editor_name[i++] = '_';
	}
	strncpy(&editor_name[i], tt_translation,
		tt_translation_dsc.dsc$w_length);
	i += tt_translation_dsc.dsc$w_length;
    }
    if (i > 0 && NO_COLON && editor_name[i-1] == ':')
	i--;
    editor_name_dsc.dsc$w_length = i;
	
    /* find the PID of the editor process */
    status = find_process(&editor_name_dsc, &editor_pid);
    if (!OK(status)) {
	/* could not find kept editor, print warning message */
	/* activate callable TPU */
	status = call_tpu(inputfile, outputfile);
	if (!OK(status))
	    lib$signal(status);
	return(SS$_NORMAL);
	/*NOTREACHED*/
    }

    if (inputfile && inputfile->dsc$w_length) {
	status = define_logical_name(&inputfile_lognam, inputfile);
	if (!OK(status))
	    lib$signal(status);
    }
    if (outputfile && outputfile->dsc$w_length) {
	status = define_logical_name(&outputfile_lognam, outputfile);
	if (!OK(status))
	    lib$signal(status);
    }
    /* define "<editor>_pid"="my_pid" to get back here after suspend */
    ignore = find_process(0, &my_pid);
    longtohex(&editor_pid_lognam[sizeof(PID_PREFIX)-1], editor_pid);
    longtohex(editor_pid_def_lognam, my_pid);
    status = define_logical_name(&editor_pid_dsc, &editor_pid_def_dsc);
    if (!OK(status))
	lib$signal(status);

    status = lib$attach(&editor_pid);
    if (!OK(status)) {
	ignore = delete_logical_name(&inputfile_lognam);
	ignore = delete_logical_name(&outputfile_lognam);
	ignore = delete_logical_name(&editor_pid_dsc);
	lib$signal(status);
    }
    status = delete_logical_name(&inputfile_lognam);
    status = delete_logical_name(&outputfile_lognam);
    status = delete_logical_name(&editor_pid_dsc);

    return(SS$_NORMAL);
}

/* call_tpu: find and start the callable TPU. This is only done
 * if a kept editor could not be found.
*/
static unsigned long call_tpu(struct dsc$descriptor *inputfile,
			      struct dsc$descriptor *outputfile)
{
    $DESCRIPTOR(tpu_file_name_dsc, "TPUSHR");
    $DESCRIPTOR(tpu_symbol_name_dsc, "TPU$EDIT");
    unsigned long (*symbol_value)();
    unsigned long status;
	
    status = lib$find_image_symbol(&tpu_file_name_dsc,
				   &tpu_symbol_name_dsc,
				   &symbol_value);
    if (OK(status)) {
	status = (*symbol_value)(inputfile, outputfile);
    }
    return(status);
}
			      
/* Private utility functions to avoid having to link against
 * the VAXCRTL library
 */
static void strcpy(char *to, char *from)
{
    do {
	*to++ = *from;
    } while (*from++);
}	

static void strncpy(char *to, char *from, int length)
{
    do {
	*to++ = *from;
    } while (*from++ && --length > 0);
}	

static void longtohex(char *ptr, unsigned long value)
{
    char hextab[] = "0123456789ABCDEF";
    int i;

    for (i=28; i>=0; i-=4) {
	*ptr++ = hextab[value>>i & 0xf];
    }
}

#include <jpidef.h>
/*
 * Given a process name, find the PID of that process
 * If the process name is not given (i.e. NULL is passed),
 * the PID of the current process is returned.
 */
static unsigned long find_process(struct dsc$descriptor_s *name,
				  unsigned long *pid_ptr)
{
    unsigned short code = JPI$_PID;
    unsigned long status;

    status = lib$getjpi(&code, 0, name, pid_ptr, 0, 0);
    return(status);
}

/*
 * Job logical name handling.
 */

#include lnmdef

#define TABLE_NAME "LNM$JOB"

typedef union {
    unsigned long terminator;
    struct {
	short length;
	short code;
	void *buffer;
	long ret_length;
    }item;
} ITEM;

/*
 * Translate a logical name
 */
static unsigned long translate_logical_name(struct dsc$descriptor_s *logical_name,
					    struct dsc$descriptor_s *string)
{
  unsigned long status;
  short length;

  status = lib$sys_trnlog(logical_name, &length, string);
  if (OK(status)) {
      if (status == SS$_NOTRAN) {
	  string->dsc$w_length = 0;
      } else {
	  string->dsc$w_length = length;
      }
  }
  return(status);
}

/*
 * Define a supervisor mode logical name in TABLE_NAME
 * Return status is the VMS return code from lib$set_logical.
 * 
 * Note: using lowercase for the logical name itself will succeed, but
 *	 you will not be able to use that name for anything useful.
 */
static unsigned long define_logical_name(struct dsc$descriptor_s *logical_name,
					 struct dsc$descriptor_s *string)
{
    ITEM item_list[2];
    struct dsc$descriptor_s table_dsc =
	{sizeof(TABLE_NAME)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, TABLE_NAME};

    item_list[0].item.buffer = string->dsc$a_pointer;
    item_list[0].item.length = string->dsc$w_length;
    item_list[0].item.code = LNM$_STRING;
    item_list[0].item.ret_length = 0;
    
    item_list[1].terminator = 0;

    /* Use 0 i.s.o. &table_dsc for a process logical name */
    return lib$set_logical(logical_name, 0, &table_dsc, 0, item_list);
}

/*
 * Delete a supervisor mode logical name from TABLE_NAME
 */
static unsigned long delete_logical_name(struct dsc$descriptor_s *lnm_dsc)
{
    struct dsc$descriptor_s table_dsc =
      {sizeof(TABLE_NAME)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, TABLE_NAME};

    return lib$delete_logical(lnm_dsc, &table_dsc);
}

#ifdef TESTING
main()
{
    $DESCRIPTOR(inputfile_dsc,"INPUT");
    $DESCRIPTOR(outputfile_dsc,"OUTPUT");
    unsigned long status;

    status = ENTRYNAME(&inputfile_dsc, &outputfile_dsc);
}
#endif
--end of editshr.c--