$ sv = 'f$verify(0)'
$ make := create /nolog
$ if sv then make := create /log
$ isvax = f$getsyi("CPU") .lt. 128
$ isaxp = f$getsyi("CPU") .ge. 128
$ make vmsstuff.h

#ifndef VMSSTUFF_DEFINED

#define VMSSTUFF_DEFINED  1

/* frequently used system headers
 */
#include <stdlib.h>
#include <stddef.h>
#include <string.h>
#include <stdio.h>
#include <time.h>
#include <stsdef.h>
#include <descrip.h>

/* someone at digital changed the case in the official header files
 * of the runtime/system calls so that they would look more "C-ish".
 * thanks for nothing, guys :-(
 *
 * these macros should be defined _before_ the prototype headers are included.
 */
#define lib$convert_date_string LIB$CONVERT_DATE_STRING
#define lib$establish           LIB$ESTABLISH
#define lib$revert              LIB$REVERT
#define lib$signal              LIB$SIGNAL
#define lib$spawn               LIB$SPAWN
#define sys$bintim              SYS$BINTIM
#define sys$brkthruw            SYS$BRKTHRUW
#define sys$cancel              SYS$CANCEL
#define sys$crembx              SYS$CREMBX
#define sys$dassgn              SYS$DASSGN
#define sys$delprc              SYS$DELPRC
#define sys$forcex              SYS$FORCEX
#define sys$qiow                SYS$QIOW
#define sys$sndjbcw             SYS$SNDJBCW

/* prototypes for the SYS$xxxxx() and LIB$xxxxx() functions
 */
#include <starlet.h>
#include <lib$routines.h>

/* macros for the "line feed" and "carriage return" characters
 */
#define LF              10
#define CRG_RET         13

/* the VMS date/time data type
 * (i use a double because it's the only eight-byte atomic value in C,
 * and i never try to examine or modify the contents directly --- YMMV)
 */
typedef double DateTime;

/* the VMS status data type (returned by all system services and
 * run-time library functions) and two macros which test the low bit therein
 */
typedef unsigned long CONDVAL;

#define IFBAD(fnc)     cv0 = (fnc); if ((cv0 & STS$M_SUCCESS) == 0)
#define IFGOOD(fnc)    cv0 = (fnc); if ((cv0 & STS$M_SUCCESS) != 0)

/* the canonical item descriptor and several macros to simplify
 * setting an itemlist entry.
 *
 * ===>>> NOTE!!! <<<===
 *
 * the "vi_lenadr" member is actually a pointer to an unsigned _long_
 * when used for the MAIL$XXXX() callable routines, but i don't use it
 * in these modules, but watch out.
 */
typedef struct VMS_ITEMDESC {
	unsigned short vi_buflen;
	unsigned short vi_code;
	void *vi_bufadr;
	unsigned short *vi_lenadr;
} VMSItemDesc;

#define ADD_FLAG_ITEM(x)  { \
	list[z].vi_code   = x; \
	list[z].vi_buflen = 0; \
	list[z].vi_bufadr = NULL; \
	list[z].vi_lenadr = NULL; \
	++z; \
}

#define ADD_NUM_ITEM(x, n)  { \
	list[z].vi_code   = x; \
	list[z].vi_buflen = sizeof(n); \
	list[z].vi_bufadr = &n; \
	list[z].vi_lenadr = NULL; \
	++z; \
}

#define ADD_TEXT_ITEM(x, p)  if (p != NULL && *p != '\0') { \
	list[z].vi_code   = x; \
	list[z].vi_buflen = strlen(p); \
	list[z].vi_bufadr = p; \
	list[z].vi_lenadr = NULL; \
	++z; \
}

#define END_ITEM_LIST()  { \
	list[z].vi_code   = 0; \
	list[z].vi_buflen = 0; \
	list[z].vi_bufadr = NULL; \
	list[z].vi_lenadr = NULL; \
}

/* the two canonical I/O Status Block:
 * the "short status" block is used by $QIO(),
 * while the "long status" block is used by most everything else.
 */
typedef struct SHORTWORD_IOSB {
	unsigned short cond;	/* the completion status of the i/o */
	unsigned short other[3];
} ShortIOStatBlock;

typedef struct LONGWORD_IOSB {
	CONDVAL cond;		/* the completion status of the i/o */
	long other;
} LongIOStatBlock;

/* a value for an Event Flag.
 *
 * ===>>> NOTE!!! <<<===
 *
 * it is poor programming practice under VMS to simply use zero for
 * the event flag number.  you should _always_ allocate a flag via the
 * LIB$GET_EF() call and release it when finished via LIB$FREE_EF().
 */
#define EFN  0

/* a macro to make a valid string descriptor point to an asciz string
 */
#define SETSD(foo, az)  { \
	foo.dsc$a_pointer = az; \
	foo.dsc$w_length = strlen(az); \
	foo.dsc$b_dtype = DSC$K_DTYPE_T; \
	foo.dsc$b_class = DSC$K_CLASS_S; \
}

/* these macros are for a bitmask used by lib$convert_date_string() ---
 * both input and output --- and they correspond to the fields in the
 * OpenVMS "timbuf" structure used by sys$numtim().
 */
#define WHENDFTL_YEAR           (1 << 0)
#define WHENDFTL_MONTH          (1 << 1)
#define WHENDFTL_DAY            (1 << 2)
#define WHENDFTL_HOUR           (1 << 3)
#define WHENDFTL_MINUTE         (1 << 4)
#define WHENDFTL_SECOND         (1 << 5)
#define WHENDFTL_CENTISECOND    (1 << 6)

#endif
$ make forkinfo.h

#ifndef FORKINFO_DEFINED

#define FORKINFO_DEFINED  1

typedef struct FORK_INFO {
	char *command;
	char *input;
	char *output;
	char *prcnam;
	char *futureptr[4];
	long futurenum[4];
	unsigned wait       : 1;
	unsigned forceSpawn : 1;
} ForkInfo;

CONDVAL ForkCommand(ForkInfo *);

#endif

$ make forkcmd.c

#include <ssdef.h>
#include <iodef.h>
#include <clidef.h>
#include "vmsstuff.h"
#include "forkinfo.h"

#define MBXDEPTH       4
#define MBXWIDTH     512
#define WRITE_FLAGS  (IO$_WRITEVBLK | IO$M_NOW | IO$M_NORSWAIT)

typedef struct PERMANENT_SUBPROCESS_DATA {
	CONDVAL sts;
	unsigned long pid;
} PermSubData;

static PermSubData SubProc;
static long ChildMbx = 0;


static CONDVAL SpawnFinished(
	PermSubData *sip
)
{
	static $DESCRIPTOR(Problem, "failed to execute a DCL command");

	CONDVAL cv0;

#define SHR$_TEXT  0x00001130

	IFBAD(sip->sts) {
		lib$signal(SHR$_TEXT, 1, &Problem, cv0, 0);
	}

	if (sip == &SubProc) {
		SubProc.pid = 0;
	}
	else {
		free(sip);
	}

	return(SS$_NORMAL);
}


static CONDVAL FORK_I_ChildExecutor(
	struct dsc$descriptor_s *cmdptr,
	struct dsc$descriptor_s *outptr,
	struct dsc$descriptor_s *namptr
)
{
	static $DESCRIPTOR(ChildOutput,  "SAMPLE_FORK.OUT");
	static $DESCRIPTOR(ChildMbxName, "SAMPLE_FORK_MBX");

	CONDVAL cv0;
	ShortIOStatBlock iosb;

	/* ensure that a command has been passed to us
	 */
	if (cmdptr == NULL) {
		return(SS$_INSFARG);
	}

	/* ensure that the mailbox exists
	 */
	if (ChildMbx == 0) {
		IFBAD(sys$crembx(0, &ChildMbx, MBXWIDTH, MBXWIDTH * MBXDEPTH, 0, 0, &ChildMbxName)) {
			return(cv0);
		}
	}

	/* ensure that the subprocess exists
	 */
	if (SubProc.pid == 0) {
		unsigned long spnflags;
		if (outptr == NULL) {
			outptr = &ChildOutput;
		}
		spnflags = CLI$M_NOWAIT;
		IFBAD(lib$spawn(NULL, &ChildMbxName, outptr, &spnflags, namptr, &SubProc.pid, &SubProc.sts, NULL, SpawnFinished, &SubProc, NULL, NULL)) {
			lib$signal(cv0, 0);
			return(cv0);
		}
	}

	/* send the command down the line
	 */
	IFGOOD(sys$qiow(EFN, ChildMbx, WRITE_FLAGS, &iosb, NULL, 0, cmdptr->dsc$a_pointer, cmdptr->dsc$w_length, 0, 0, 0, 0)) {
		IFGOOD(iosb.cond) {
			cv0 = SS$_NORMAL;
		}
	}

	return(cv0);
}


CONDVAL ForkCommand(
	ForkInfo *fip
)
{
	CONDVAL cv0;
	PermSubData *psdptr;
	struct dsc$descriptor_s *cmdptr;
	struct dsc$descriptor_s *inpptr;
	struct dsc$descriptor_s *outptr;
	struct dsc$descriptor_s *namptr;
	struct dsc$descriptor_s cmdsd;
	struct dsc$descriptor_s inpsd;
	struct dsc$descriptor_s outsd;
	struct dsc$descriptor_s namsd;
	unsigned long spnflags;

	if (fip->command == NULL) {
		cmdptr = NULL;
	}
	else {
		SETSD(cmdsd, fip->command);
		cmdptr = &cmdsd;
	}
	if (fip->input == NULL) {
		inpptr = NULL;
	}
	else {
		SETSD(inpsd, fip->input);
		inpptr = &inpsd;
	}
	if (fip->output == NULL) {
		outptr = NULL;
	}
	else {
		SETSD(outsd, fip->output);
		outptr = &outsd;
	}
	if (fip->prcnam == NULL) {
		namptr = NULL;
	}
	else {
		SETSD(namsd, fip->prcnam);
		namptr = &namsd;
	}
	if (cmdptr == NULL && inpptr == NULL) {
		cv0 = SS$_INSFARG;
	}
	else if (fip->forceSpawn) {
		spnflags = (fip->wait) ? 0 : CLI$M_NOWAIT;
		psdptr = (PermSubData *) calloc(1, sizeof(PermSubData));
		cv0 = lib$spawn(cmdptr, inpptr, outptr, &spnflags, namptr, &psdptr->pid, &psdptr->sts, NULL, SpawnFinished, psdptr, NULL, NULL);
	}
	else {
		cv0 = FORK_I_ChildExecutor(cmdptr, outptr, namptr);
	}

	return(cv0);
}


void TerminateFork(
	void
)
{
	static $DESCRIPTOR(KillChild, "LOGOUT /FULL");

	CONDVAL cv0;

	if (SubProc.pid != 0) {
		FORK_I_ChildExecutor(&KillChild, NULL, NULL);
		SubProc.pid = 0;
	}

	if (ChildMbx != 0) {
		sys$cancel(ChildMbx);
		IFBAD(sys$dassgn(ChildMbx)) {
			lib$signal(cv0, 0);
		}
		ChildMbx = 0;
	}

	return;
}

$ make submitinfo.h

#ifndef SUBMITINFO_DEFINED

#define SUBMITINFO_DEFINED  1

#define MAX_SUBMIT_PARAMS   8

typedef struct SUBMIT_FILE_INFO {
	char *job;
	char *username;
	char *queue;
	char *logfs;
	char *params[MAX_SUBMIT_PARAMS];
	char *logQueue;
	char *whentostart;
	char *timetowait;
	void *futureptr[4];
	long futurenum[4];
	unsigned hold        :  1;
	unsigned keep        :  1;
	unsigned notify      :  1;
	unsigned noprint     :  1;
	unsigned deleteFile  :  1;
	unsigned futureflag  : 27;
} SubmitInfo;

CONDVAL SubmitFile(char *, SubmitInfo *);

#endif
$ make submitfile.c

	/* queue a text file to a printer */

#include <ssdef.h>
#include <sjcdef.h>
#include "vmsstuff.h"
#include "submitinfo.h"

#define MAX_SUBMIT_ITEMS   20

static long DateConvFlags =
	WHENDFTL_YEAR   |
	WHENDFTL_MONTH  |
	WHENDFTL_DAY    |
	WHENDFTL_HOUR   |
	WHENDFTL_MINUTE |
	WHENDFTL_SECOND |
	WHENDFTL_CENTISECOND;

CONDVAL SubmitFile(
	char *filespec,
	SubmitInfo *sip
)
{
	int z;
	char *qname;
	CONDVAL cv0;
	LongIOStatBlock iosb;
	DateTime tmpad;
	struct dsc$descriptor_s tmpsd;
	VMSItemDesc list[MAX_SUBMIT_ITEMS];

	/* the name of the .COM to be submitted, and the name of the queue
	 * in which it should be submitted, are both required
	 */
	z = 0;
	qname = (sip == NULL || sip->queue == NULL || *sip->queue == '\0') ? "SYS$BATCH" : sip->queue;
	ADD_TEXT_ITEM(SJC$_FILE_SPECIFICATION, filespec);
	ADD_TEXT_ITEM(SJC$_QUEUE, qname);

	/* begin optional items
	 */
	if (sip != NULL) {

		/* optional string items
		 */
		ADD_TEXT_ITEM(SJC$_PARAMETER_1,       sip->params[0]);
		ADD_TEXT_ITEM(SJC$_PARAMETER_2,       sip->params[1]);
		ADD_TEXT_ITEM(SJC$_PARAMETER_3,       sip->params[2]);
		ADD_TEXT_ITEM(SJC$_PARAMETER_4,       sip->params[3]);
		ADD_TEXT_ITEM(SJC$_PARAMETER_5,       sip->params[4]);
		ADD_TEXT_ITEM(SJC$_PARAMETER_6,       sip->params[5]);
		ADD_TEXT_ITEM(SJC$_PARAMETER_7,       sip->params[6]);
		ADD_TEXT_ITEM(SJC$_PARAMETER_8,       sip->params[7]);
		ADD_TEXT_ITEM(SJC$_USERNAME,          sip->username);
		ADD_TEXT_ITEM(SJC$_JOB_NAME,          sip->job);
		ADD_TEXT_ITEM(SJC$_LOG_SPECIFICATION, sip->logfs);

		/* optional flag items
		 */
		if (sip->hold)       ADD_FLAG_ITEM(SJC$_HOLD);
		if (sip->keep)       ADD_FLAG_ITEM(SJC$_NO_LOG_DELETE);
		if (sip->notify)     ADD_FLAG_ITEM(SJC$_NOTIFY);
		if (sip->deleteFile) ADD_FLAG_ITEM(SJC$_DELETE_FILE);
		if (sip->noprint) {
			ADD_FLAG_ITEM(SJC$_NO_LOG_SPOOL);
		}
		else if (sip->logQueue != NULL) {
			ADD_TEXT_ITEM(SJC$_LOG_QUEUE, sip->logQueue);
		}

		/* optional date-time items
		 */
		if (sip->whentostart != NULL && *sip->whentostart != '\0') {
			SETSD(tmpsd, sip->whentostart);
			IFGOOD(lib$convert_date_string(&tmpsd, &tmpad, NULL, &DateConvFlags, NULL, NULL)) {
				ADD_NUM_ITEM(SJC$_AFTER_TIME, tmpad);
			}
		}
		else if (sip->timetowait != NULL && *sip->timetowait != '\0') {
			SETSD(tmpsd, sip->timetowait);
			IFGOOD(sys$bintim(&tmpsd, &tmpad)) {
				ADD_NUM_ITEM(SJC$_AFTER_TIME, tmpad);
			}
		}
	}

	END_ITEM_LIST();

	IFGOOD(sys$sndjbcw(EFN, (unsigned short) SJC$_ENTER_FILE, NULL, &list[0], &iosb, NULL, 0)) {
		IFGOOD(iosb.cond) {
			cv0 = SS$_NORMAL;
		}
	}

	return(cv0);
}
$ make printinfo.h

#ifndef PRINTINFO_DEFINED

#define PRINTINFO_DEFINED  1

typedef struct PRINT_FILE_INFO {
	char *jobname;
	char *formname;
	char *queuename;
	char *note;
	char *username;
	char *whentostart;
	char *timetowait;
	char *futureptr[4];
	long copies;
	long startPage;
	long endPage;
	long futurenum[4];
	unsigned hold        :  1;
	unsigned notify      :  1;
	unsigned header      :  1;
	unsigned noflag      :  1;
	unsigned oneflag     :  1;
	unsigned allflag     :  1;
	unsigned burstJob    :  1;
	unsigned burstFile   :  1;
	unsigned deleteFile  :  1;
	unsigned doubleSpace :  1;
	unsigned trailer     :  1;
	unsigned             : 21;
} PrintInfo;

CONDVAL PrintFile(char *, PrintInfo *);

#endif
$ make printfile.c

	/* queue a text file to a printer */

#include <ssdef.h>
#include <sjcdef.h>
#include "vmsstuff.h"
#include "printinfo.h"

#define MAX_PRINT_ITEMS  12

static long DateConvFlags =
	WHENDFTL_YEAR   |
	WHENDFTL_MONTH  |
	WHENDFTL_DAY    |
	WHENDFTL_HOUR   |
	WHENDFTL_MINUTE |
	WHENDFTL_SECOND |
	WHENDFTL_CENTISECOND;

CONDVAL PrintFile(
	char *filespec,
	PrintInfo *pip
)
{
	char *qname;
	int z;
	CONDVAL cv0;
	LongIOStatBlock iosb;
	DateTime tmpad;
	struct dsc$descriptor_s tmpsd;
	VMSItemDesc list[MAX_PRINT_ITEMS];

	z = 0;
	qname = (pip == NULL || pip->queuename == NULL || *pip->queuename == '\0') ? "SYS$PRINT" : pip->queuename;
	ADD_TEXT_ITEM(SJC$_FILE_SPECIFICATION, filespec);
	ADD_TEXT_ITEM(SJC$_QUEUE, qname);

	/* begin optional items
	 */
	if (pip != NULL) {

		/* optional string items
		 */
		ADD_TEXT_ITEM(SJC$_NOTE,      pip->note);
		ADD_TEXT_ITEM(SJC$_JOB_NAME,  pip->jobname);
		ADD_TEXT_ITEM(SJC$_FORM_NAME, pip->formname);

		/* optional flag items
		 */
		if (pip->hold)        ADD_FLAG_ITEM(SJC$_HOLD);
		if (pip->notify)      ADD_FLAG_ITEM(SJC$_NOTIFY);
		if (pip->burstFile)   ADD_FLAG_ITEM(SJC$_FILE_BURST);
		if (pip->deleteFile)  ADD_FLAG_ITEM(SJC$_DELETE_FILE);
		if (pip->doubleSpace) ADD_FLAG_ITEM(SJC$_DOUBLE_SPACE);

		/* optional numeric items
		 */
		if (pip->copies > 1)  ADD_NUM_ITEM(SJC$_FILE_COPIES, pip->copies);

		/* optional date-time items
		 */
		if (pip->whentostart != NULL && *pip->whentostart != '\0') {
			SETSD(tmpsd, pip->whentostart);
			IFGOOD(lib$convert_date_string(&tmpsd, &tmpad, NULL, &DateConvFlags, NULL, NULL)) {
				ADD_NUM_ITEM(SJC$_AFTER_TIME, tmpad);
			}
		}
		else if (pip->timetowait != NULL && *pip->timetowait != '\0') {
			SETSD(tmpsd, pip->timetowait);
			IFGOOD(sys$bintim(&tmpsd, &tmpad)) {
				ADD_NUM_ITEM(SJC$_AFTER_TIME, tmpad);
			}
		}
	}

	END_ITEM_LIST();

	IFGOOD(sys$sndjbcw(EFN, (unsigned short) SJC$_ENTER_FILE, NULL, &list[0], &iosb, NULL, 0)) {
		IFGOOD(iosb.cond) {
			cv0 = SS$_NORMAL;
		}
	}

	return(cv0);
}
$ make mailinfo.h

#ifndef MAILINFO_DEFINED

#define MAILINFO_DEFINED  1

typedef struct MAIL_SEND_DESCRIPTOR {
	char *to;
	char *cc;
	char *subject;
	CONDVAL (*baduserhnd)();
	CONDVAL (*trapper)();
	char *futureptr[4];
	long futurenum[4];
	unsigned echosends :  1;
	unsigned           : 31;
} MailInfo;

/* prototypes for the MAIL callable interface
 */
CONDVAL mail$send_add_attribute();
CONDVAL mail$send_add_address();
CONDVAL mail$send_add_bodypart();
CONDVAL mail$send_message();
CONDVAL mail$send_begin();
CONDVAL mail$send_end();

CONDVAL MAIL_SendFile(char *, MailInfo *);
CONDVAL MAIL_SendText(char **, int, MailInfo *);

#endif
$ make mailrtns.c

	/* interface between DSC software and operating system's MAIL */

#include <ssdef.h>
#include <maildef.h>
#include "vmsstuff.h"
#include "mailinfo.h"

#define METHOD_FILE  0
#define METHOD_TEXT  1

#define MAIL$_OPENIN                    8290802
#define MAIL$_NOSUCHUSR                 8290346

#ifndef MAIL$C_MAX_LINE_LEN
#  define MAIL$C_MAX_LINE_LEN  255
#endif
#define PARSING_CC_NAMES   MAIL$_CC
#define PARSING_TO_NAMES   MAIL$_TO

typedef unsigned long MailContext;

static char TheMethod;
static CONDVAL FailureReason;

static char CRandLF[] = { CRG_RET, LF, '\0' };
static VMSItemDesc EmptyList = { 0, 0, NULL, NULL };

static char *ExtractFromCommaList(
	char *startptr,
	char *bufptr
)
{
	int n;
	char *tmpptr;

	if (startptr == NULL) return(NULL);

	if ((tmpptr = strchr(startptr, ',')) == NULL) {
		strcpy(bufptr, startptr);
		return(NULL);
	}

	n = (int) tmpptr - (int) startptr;
	memcpy(bufptr, startptr, n);
	*(bufptr + n) = '\0';

	return(tmpptr + 1);
}

static CONDVAL MAIL_I_SendHandler(
	CONDVAL sigargs[],
	CONDVAL mechargs[]
)
{
	/* the only action we need to take is for MAILSHR's failure to read in
	 * the file to be sent.  in that case, we want to return the actual
	 * RMS condition value (such as RMS$_FNF or RMS$_PRV) instead of the
	 * rather useless "%MAIL-E-OPENIN, error opening !AS as input"
	 */
	if (sigargs[1] == MAIL$_OPENIN) {
		FailureReason = sigargs[3 + sigargs[2]];
	}

	return(SS$_CONTINUE);
}

static CONDVAL MAIL_I_GoodSend(
	struct dsc$descriptor_s *recepient,
	CONDVAL sigargs[],
	MailInfo *sendinfo
)
{
	if (sendinfo != NULL && sendinfo->echosends) {
		fprintf(stdout, "\nmessage was sent to %*.*s!",
			recepient->dsc$w_length, recepient->dsc$w_length,
			recepient->dsc$a_pointer);
	}

	return(SS$_NORMAL);
}

static CONDVAL MAIL_I_BadSend(
	struct dsc$descriptor_s *recepient,
	CONDVAL sigargs[],
	MailInfo *sendinfo
)
{
	if (sendinfo != NULL && sendinfo->echosends) {
		fprintf(stdout, "\nmessage NOT was sent to %*.*s (%d)!",
			recepient->dsc$w_length, recepient->dsc$w_length,
			recepient->dsc$a_pointer, sigargs[1]);
	}
	FailureReason = sigargs[1];

	return(SS$_NORMAL);
}

static CONDVAL MAIL_I_ReallySend(
	MailContext *ctxptr,
	MailInfo *sendinfo,
	void *someptr,
	int somecount
)
{
	int j;
	int usercnt;
	unsigned short usertype;
	char *curptr;
	char *userptr;
	char **linearray;
	CONDVAL cv0;
	char userbuf[100];
	int linelen;
	char *eolptr;
	/* note that this structure is not exact */
	VMSItemDesc inlist[4];

	if (sendinfo->subject != NULL) {
		inlist[0].vi_code   = MAIL$_SEND_SUBJECT;
		inlist[0].vi_buflen = strlen(sendinfo->subject);
		inlist[0].vi_bufadr = sendinfo->subject;
		inlist[0].vi_lenadr = NULL;
		inlist[1].vi_code   = 0;
		inlist[1].vi_buflen = 0;
		if (inlist[0].vi_buflen > MAIL$C_MAX_LINE_LEN) {
			inlist[0].vi_buflen = MAIL$C_MAX_LINE_LEN;
		}
		IFBAD(mail$send_add_attribute(ctxptr, &inlist[0], &EmptyList)) {
			return(cv0);
		}
	}

	usercnt  = 0;
	usertype = PARSING_TO_NAMES;
	if ((userptr = sendinfo->to) == NULL) {
		return(SS$_NOSUCHUSER);
	}
	inlist[0].vi_code   = MAIL$_SEND_USERNAME;
/* 	inlist[0].vi_buflen gets set within the loop for each name */
	inlist[0].vi_bufadr = userbuf;
	inlist[0].vi_lenadr = NULL;
	inlist[1].vi_code   = MAIL$_SEND_USERNAME_TYPE;
	inlist[1].vi_buflen = sizeof(usertype);
	inlist[1].vi_bufadr = &usertype;
	inlist[1].vi_lenadr = NULL;
	inlist[2].vi_code   = 0;
	inlist[2].vi_buflen = 0;
	for (;;) {
		userptr = ExtractFromCommaList(userptr, userbuf);
		inlist[0].vi_buflen = strlen(userbuf);
		IFGOOD(mail$send_add_address(ctxptr, &inlist[0], &EmptyList)) {
			++usercnt;
		}
		else if (cv0 == MAIL$_NOSUCHUSR && sendinfo->baduserhnd != NULL) {
			if ((*sendinfo->baduserhnd)(userbuf) != SS$_NORMAL) return(cv0);
		}
		else {
			return(cv0);
		}
		if (userptr == NULL) {
			if (usertype == PARSING_CC_NAMES) break;
			usertype = PARSING_CC_NAMES;
			if (sendinfo->cc == NULL) break;
			if (*sendinfo->cc == '\0') break;
			userptr = sendinfo->cc;
		}
	}
	if (usercnt == 0) {
		return(SS$_NOSUCHUSER);
	}

	if (TheMethod == METHOD_FILE) {
		inlist[0].vi_code   = MAIL$_SEND_FILENAME;
		inlist[0].vi_buflen = strlen((char *) someptr);
		inlist[0].vi_bufadr = someptr;
		inlist[0].vi_lenadr = NULL;
		inlist[1].vi_code   = 0;
		inlist[1].vi_buflen = 0;
		FailureReason = 0;
		IFBAD(mail$send_add_bodypart(ctxptr, &inlist[0], &EmptyList)) {
			if (cv0 == MAIL$_OPENIN && FailureReason != 0) {
				cv0 = FailureReason;
			}
			return(cv0);
		}
	}
	else if (TheMethod == METHOD_TEXT) {
		inlist[0].vi_code   = MAIL$_SEND_RECORD;
/* 		inlist[0].vi_buflen gets set within the loop for each line */
/* 		inlist[0].vi_bufadr gets set within the loop for each line */
		inlist[0].vi_lenadr = NULL;
		inlist[1].vi_code   = 0;
		inlist[1].vi_buflen = 0;
		linearray = (char **) someptr;
		for (j = 0; j < somecount; j++) {
			curptr = linearray[j];
			while (curptr != NULL) {
				inlist[0].vi_bufadr = (void *) curptr;
				if ((eolptr = strpbrk(curptr, CRandLF)) == NULL) {
					inlist[0].vi_buflen = strlen(curptr);
					curptr = NULL;
				}
				else {
					inlist[0].vi_buflen = (int) eolptr - (int) curptr;
					curptr = eolptr + 1;
					if (*eolptr == CRG_RET && *curptr == LF) {
						++curptr;
					}
					if (*curptr == '\0') {
						curptr = NULL;
					}
				}
				if ((linelen = inlist[0].vi_buflen) > MAIL$C_MAX_LINE_LEN) {
					/* truncated! */
				}
				for (;;) {
					if (linelen > MAIL$C_MAX_LINE_LEN) {
						inlist[0].vi_buflen = MAIL$C_MAX_LINE_LEN;
					}
					IFBAD(mail$send_add_bodypart(ctxptr, &inlist[0], &EmptyList)) {
						return(cv0);
					}
					linelen -= inlist[0].vi_buflen;
					if (linelen <= 0) break;
					inlist[0].vi_bufadr = (void *) ((char *) inlist[0].vi_bufadr + MAIL$C_MAX_LINE_LEN);
				}
			}
		}
	}

	/* let our handlers trap the true reason
	 */
	inlist[0].vi_code   = MAIL$_SEND_SUCCESS_ENTRY;
	inlist[0].vi_buflen = sizeof(void *);
	inlist[0].vi_bufadr = (void *) MAIL_I_GoodSend;
	inlist[0].vi_lenadr = NULL;
	inlist[1].vi_code   = MAIL$_SEND_ERROR_ENTRY;
	inlist[1].vi_buflen = sizeof(void *);
	inlist[1].vi_bufadr = (void *) MAIL_I_BadSend;
	inlist[1].vi_lenadr = NULL;
	inlist[2].vi_code   = MAIL$_SEND_USER_DATA;
	inlist[2].vi_buflen = sizeof(void *);
	inlist[2].vi_bufadr = (void *) sendinfo;
	inlist[2].vi_lenadr = NULL;
	inlist[3].vi_code   = 0;
	inlist[3].vi_buflen = 0;
	FailureReason = 0;
	cv0 = mail$send_message(ctxptr, &inlist[0], &EmptyList);
	if (FailureReason != 0) return(FailureReason);
	IFGOOD(cv0) {
		cv0 = SS$_NORMAL;
	}

	return(cv0);
}

static CONDVAL MAIL_I_SendSomething(
	MailInfo *sendinfo,
	void *someptr,
	int somecount
)
{
	MailContext sendctx;
	CONDVAL cv0;
	CONDVAL result;
	CONDVAL (*fncptr)();

	/* the default behavior for all MAILSHR routines is to signal any
	 * problems they encounter.  i don't like that, but i decided to
	 * simply trap the exceptions with my own (or the caller's) handler
	 * rather than constantly passing the MAIL$_NOSIGNAL input code.
	 */
	if ((fncptr = sendinfo->trapper) == NULL) {
		fncptr = MAIL_I_SendHandler;
	}
	lib$establish(fncptr);

	/* invoke a function to do the actual work.  if one of the
	 * MAIL$XXXXX() routines fails, we want to return that status
	 * to the caller, but we also want to cleanup before returning.
	 */
	sendctx = 0;
	IFGOOD(mail$send_begin(&sendctx, &EmptyList, &EmptyList)) {
		result = MAIL_I_ReallySend(&sendctx, sendinfo, someptr, somecount);
		IFGOOD(mail$send_end(&sendctx, &EmptyList, &EmptyList)) {
			cv0 = SS$_NORMAL;
		}
		if (result != SS$_NORMAL) cv0 = result;
	}
	lib$revert();

	return(cv0);
}


CONDVAL MAIL_SendFile(
	char *filespec,
	MailInfo *sendinfo
)
{
	if (filespec == NULL) {
		return(SS$_ACCVIO);
	}

	TheMethod = METHOD_FILE;
	return(MAIL_I_SendSomething(sendinfo, (void *) filespec, 0));
}


CONDVAL MAIL_SendText(
	char **lines,
	int linecount,
	MailInfo *sendinfo
)
{
	if (lines == NULL && linecount > 0) {
		return(SS$_ACCVIO);
	}

	TheMethod = METHOD_TEXT;
	return(MAIL_I_SendSomething(sendinfo, (void *) lines, linecount));
}
$ make beepinfo.h

#ifndef BEEPINFO_DEFINED

#define BEEPINFO_DEFINED  1

typedef struct BEEP_INFO {
	char *messageptr;
	char *username;
	char *terminal;
	char *futureptr[4];
	long reqid;
	unsigned long timout;
	long futurenum[4];
	unsigned allusers  : 1;
	unsigned allterms  : 1;
	unsigned localonly : 1;
	unsigned refresh   : 1;
	unsigned           : 4;
} BeepInfo;

typedef struct BEEP_RESULTS {
	long brkattempts;
	long successCount;
	long timeoutCount;
	long blockedCount;
	long delfails;
	long queuefails;
} BeepResults;

CONDVAL BeepSomeone(BeepInfo *, BeepResults *);

#endif
$ make beeprtns.c

	/* broadcast a string to one or more {users}{terminals} */

#include <ssdef.h>
#include <brkdef.h>
#include "vmsstuff.h"
#include "beepinfo.h"

CONDVAL BeepSomeone(
	BeepInfo *smip,
	BeepResults *smrp
)
{
	CONDVAL retcond;
	CONDVAL cv0;
	unsigned long flags;
	unsigned long carcon;
	unsigned long sndtyp;
	char *listptr;
	char *delimptr;
	struct dsc$descriptor_s *sendto;
	struct dsc$descriptor_s msgbuf;
	struct dsc$descriptor_s senddsc;
	BeepResults dummy;
	struct BREAKTHRU_IO_STATUS_BLOCK {
		unsigned short cond;		/* the completion status of the i/o --- a SS$_XXXXX value */
		unsigned short beeped;		/* the number of terminals and mailboxes which successfully received the message */
		unsigned short timedout;	/* the number of failures due the write timing out (probably ^S) */
		unsigned short blocked;		/* the number of failures due to $ SET TERMINAL /NOBROADCAST */
	} iosb;

	if (smrp == NULL) smrp = &dummy;
	smrp->brkattempts  = 0;
	smrp->successCount = 0;
	smrp->timeoutCount = 0;
	smrp->blockedCount = 0;
	smrp->delfails     = 0;
	smrp->queuefails   = 0;

	if (smip == NULL) {
		return(SS$_ACCVIO);
	}
	if ((msgbuf.dsc$a_pointer = smip->messageptr) == NULL) {
		return(SS$_ACCVIO);
	}
	msgbuf.dsc$w_length = strlen(smip->messageptr);
	msgbuf.dsc$b_dtype = DSC$K_DTYPE_T;
	msgbuf.dsc$b_class = DSC$K_CLASS_S;

	if (smip->allusers) {
		sndtyp = BRK$C_ALLUSERS;
		sendto = NULL;
	}
	else if (smip->allterms) {
		sndtyp = BRK$C_ALLTERMS;
		sendto = NULL;
	}
	else {
		if ((listptr = smip->username) != NULL) {
			sndtyp = BRK$C_USERNAME;
		}
		else if ((listptr = smip->terminal) != NULL) {
			sndtyp = BRK$C_DEVICE;
		}
		else {
			return(SS$_BADPARAM);
		}
		senddsc.dsc$b_dtype = DSC$K_DTYPE_T;
		senddsc.dsc$b_class = DSC$K_CLASS_S;
		sendto = &senddsc;
	}

	carcon = 0x00000020;
	flags  = 0;
	if (  smip->refresh)   flags |= BRK$M_NOREFRESH;
	if (! smip->localonly) flags |= BRK$M_CLUSTER;

	/* what the hell
	 */
	if (smip->reqid < BRK$C_GENERAL || smip->reqid > BRK$C_USER16) {
		smip->reqid = BRK$C_GENERAL;
	}

	/* i don't want to allow <infinite> waits (which is what "timout == 0" means)
	 * and the book says values of 1 through 4 are not allowed.  plus i throw in
	 * a pretty random ceiling of half a minute.
	 */
	if (smip->timout < 5) {
		smip->timout = 5;
	}
	else if (smip->timout > 30) {
		smip->timout = 30;
	}

	retcond = SS$_NORMAL;
	for (;;) {
		if (sendto != NULL) {
			if ((delimptr = strchr(listptr, ',')) != NULL) {
				senddsc.dsc$w_length = (int) delimptr - (int) listptr;
			}
			else {
				senddsc.dsc$w_length = strlen(listptr);
			}
			senddsc.dsc$a_pointer = listptr;
		}
		IFGOOD(sys$brkthruw(EFN, &msgbuf, sendto, sndtyp, &iosb, carcon, flags, smip->reqid, smip->timout, NULL, 0)) {
			IFGOOD(iosb.cond) {
				++smrp->brkattempts;
				smrp->successCount += iosb.beeped;
				smrp->timeoutCount += iosb.timedout;
				smrp->blockedCount += iosb.blocked;
			}
			else {
				++smrp->delfails;
				retcond = cv0;
			}
		}
		else {
			++smrp->queuefails;
			retcond = cv0;
		}
		if (sendto == NULL || delimptr == NULL) {
			break;
		}
		listptr = delimptr + 1;
	}

	return(retcond);
}
$ make killinfo.h

#ifndef KILLINFO_DEFINED

#define KILLINFO_DEFINED  1

typedef struct KILL_INFO {
	char *prcnam;
	char *futureptr[4];
	CONDVAL whydie;
	unsigned long prcpid;
	long futurenum[4];
	unsigned justabort : 1;
	unsigned           : 7;
} KillInfo;

CONDVAL KillSomeone(KillInfo *);

#endif

$ make killrtns.c

#include <ssdef.h>
#include "vmsstuff.h"
#include "killinfo.h"

CONDVAL KillSomeone(
	KillInfo *kip
)
{
	CONDVAL cv0;
	unsigned long *pidptr;
	struct dsc$descriptor_s *sdptr;
	struct dsc$descriptor_s tmpsd;

	if (kip->prcnam != NULL) {
		SETSD(tmpsd, kip->prcnam);
		sdptr = &tmpsd;
		pidptr = NULL;
	}
	else {
		sdptr = NULL;
		pidptr = &kip->prcpid;
	}
	if (kip->justabort) {
		IFGOOD(sys$forcex(pidptr, sdptr, kip->whydie)) {
			cv0 = SS$_NORMAL;
		}
	}
	else {
		IFGOOD(sys$delprc(pidptr, sdptr)) {
			cv0 = SS$_NORMAL;
		}
	}

	return(cv0);
}
$ make sample.c
#include <ssdef.h>
#include "vmsstuff.h"
#include "beepinfo.h"
#include "forkinfo.h"
#include "killinfo.h"
#include "mailinfo.h"
#include "printinfo.h"
#include "submitinfo.h"

int main(
	int argc,
	char *argv[]
)
{
	int j;
	CONDVAL cv0;

	cv0 = SS$_INSFARG;
	if (strcmp(argv[1], "mail") == 0) {
		if (argc >= 4) {
			MailInfo mi;
			memset(&mi, 0, sizeof(mi));
			mi.to = argv[3];
			cv0 = MAIL_SendFile(argv[2], &mi);
		}
	}
	else if (strcmp(argv[1], "print") == 0) {
		if (argc >= 3) {
			PrintInfo pi;
			memset(&pi, 0, sizeof(pi));
			pi.hold = TRUE;		/* for test purposes only */
			cv0 = PrintFile(argv[2], &pi);
		}
	}
	else if (strcmp(argv[1], "submit") == 0) {
		if (argc >= 3) {
			SubmitInfo si;
			memset(&si, 0, sizeof(si));
			cv0 = SubmitFile(argv[2], &si);
		}
	}
	else if (strcmp(argv[1], "beep") == 0) {
		if (argc >= 4) {
			BeepInfo bi;
			BeepResults br;
			memset(&bi, 0, sizeof(bi));
			bi.username = argv[2];
			bi.messageptr = argv[3];
			cv0 = BeepSomeone(&bi, &br);
		}
	}
	else if (strcmp(argv[1], "fork") == 0) {
		if (argc >= 4) {
			ForkInfo fi;
			memset(&fi, 0, sizeof(fi));
			fi.command = argv[2];
			fi.output  = argv[3];
			fi.wait    = TRUE;
			cv0 = ForkCommand(&fi);
		}
	}
	else if (strcmp(argv[1], "abort") == 0) {
		if (argc >= 3) {
			KillInfo ki;
			memset(&ki, 0, sizeof(ki));
			ki.justabort = TRUE;
			sscanf(argv[2], "%X", &ki.prcpid);
			if (argc >= 4) {
				sscanf(argv[3], "%X", &ki.whydie);
			}
			else {
				ki.whydie = SS$_ABORT;
			}
			cv0 = KillSomeone(&ki);
		}
	}
	else if (strcmp(argv[1], "stop") == 0) {
		if (argc >= 3) {
			KillInfo ki;
			memset(&ki, 0, sizeof(ki));
			sscanf(argv[2], "%X", &ki.prcpid);
			cv0 = KillSomeone(&ki);
		}
	}
	else {
		printf("unknown command <%s>", argv[1]);
		cv0 = SS$_NORMAL;
	}

	if (cv0 != SS$_NORMAL) {
		lib$signal(cv0, 0);
	}

	exit(EXIT_SUCCESS);
}
$ make sample.opt
$ open /append chan sample.opt
$ write chan "	sample.obj"
$ write chan "	beeprtns.obj"
$ write chan "	forkcmd.obj"
$ write chan "	killrtns.obj"
$ write chan "	mailrtns.obj"
$ write chan "	printfile.obj"
$ write chan "	submitfile.obj"
$ if isvax then write chan "	sys$share:vaxcrtl/shareable"
$ close chan
$ if sv then set verify
$ cc sample
$ cc beeprtns
$ cc forkcmd
$ cc killrtns
$ cc mailrtns
$ cc printfile
$ cc submitfile
$ link /notrace /map /full /cross sample.opt/options
$ sample := $'f$search("SAMPLE.EXE")'
$ sample print sample.c
$ show entry /full
$ exit 1