/*
 * Support routines for hpss script interface with the OSU web server
 * HPSS MST.  This code is not thread safe.
 *
 * All functions return a VMS-style condition code as their return value.
 *
 * Author: David Jones
 * Date:   7-FEB-2000
 * Revised: 6-APR-2000		automatically disconnect on next accept call.
 * Revised: 10-APR-200		Cleanly rundown nascent aio_streams on exit.
 * Revised: 19-JUL-2000		Support /POOL[=MASTER] qualifier.
 * Revised: 10-MAY-2001		Write EOF if connection disconnects with
 *				no writes.
 */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>		/* case conversion */
#include "hpss_share.h"		/* validate prototypes. */
#include "../base_code/hpss_msg.h"
#include <cmbdef.h>		/* VMS mailbox flags */
#include <iodef.h>		/* VMS QIO function codes */
#include <lnmdef.h>		/* VMS logical name services */
#include <ssdef.h>		/* VMS system service status codes */
#include <jpidef.h>		/* VMS job/process info */
#include <ossdef.h>		/* VMS Object set security service */
#include <acedef.h>		/* VMS access control list entries */
#include <lckdef.h>		/* VMS distributed lock manager */

int SYS$CREMBX(), SYS$QIOW(), SYS$CRELNM(), SYS$DELLNM(), SYS$DELMBX();
int SYS$ASSIGN(), SYS$DASSGN(), SYS$CANCEL(), SYS$SETIMR(), SYS$DCLEXH();
int SYS$CANTIM(), SYS$SETAST(), SYS$SYNCH(), SYS$QIO(), LIB$EMUL();
int SYS$WAKE(), SYS$HIBER(), SYS$ASCTOID(), SYS$SET_SECURITY();
int SYS$ENQW(), SYS$DEQ(), SYS$GETTIM(), LIB$GETJPI(), LIB$SUBX(), LIB$EDIV();
static $DESCRIPTOR(mbxlogical_table,"LNM$PROCESS_DIRECTORY");
static $DESCRIPTOR(mbxlogical_destination,"LNM$TEMPORARY_MAILBOX");
#define TEMP_MAILBOX_TABLE "LNM$GROUP"
#define SHARED_MAILBOX_TABLE "HPSS_SERVICE_TABLE"
/*
 * Define structures to manage the asynchronous output stream.  In general
 * the aio_stream structures must be accessed from AST level or with ASTs
 * disabled.
 */
struct aio_buffer {
    struct aio_buffer *next;
    int length;				/* number of bytes to write */
    char buffer[HPSS_MAX_OUT_MSGSIZE];
};
struct aio_stream {
    struct aio_stream *next;
    int total_count;			/* bytes transferred */
    struct { unsigned short status, count; long pid; } iosb;
    int channel;			/* channel assigned to mailbox */
    int unit;				/* mailbox unit number */
    int abort;				/* Set if last write failed */
    int detached;			/* If set rundown when no pending i/o */
    struct aio_buffer *first;		/* Null if no pending */
    struct aio_buffer *last;
};
static int stream_limit = 0;		/* set to 1/2 AST limit */
static int stream_count;
static int stream_alloc_pending = 0;
static struct aio_stream *free_stream;
static struct aio_buffer *free_buffer;

/*
 * An hpss_context structure holds the persistent state for a context
 * number between calls.
 */
struct sym_table_def {
    int nlen;
    int vlen;
    char *name;
    char *value;
};
struct sym_table {
    int allocation;			/* size allocated, number of entries */
    int size;				/* currently used */
    struct sym_table_def *def;          /* dynamically allocated */
};
struct hpss_context {
    struct hpss_context *next;
    int id;			/* context number given to application */
    int channel;		/* VMS channel to input mailbox */
    int outchan;		/* output channel */
    int msglen;			/* length of current message */
    int connection_active;	/* true until disconnect: 1-nascent, 2-written */
    int accept_timer_active;
    int accept_timer_fired;
    union hpss_mbxmsg msg;
    struct aio_stream *out_stream;
    struct aio_buffer *outbuf;
    struct sym_table var;	/* expands cgi var table in msg buffer */
    struct sym_table form;	/* form data */
    int content_alloc;
    int content_used;
    int content_pos;
    char *content;
    /*
     * Extension for dynamic pool.
     */
    int dynamic_pool;		/* non-zero if dynamic pool support enabled, */
			        /* 1-child, 2-master */
    long lock_id;
    struct {
	unsigned short status, reserved;
	int id;
	int governor_pid;	/* process ID to notify of shortage */
	int short_wait_threshold;	/* milliseconds */
	int short_waits;
	int accepts;		/* statistic updated by worker */
    } lksb;
};
static struct hpss_context *context_list = (struct hpss_context *) 0;
static int exit_reason;
static int final_rundown ( int *reason );
static struct exit_block {
    struct exit_block *next;		/* forward link (VMS only) */
    int (*handler)(int *);
    int argc;				/* set to 1 */
    int *reason_ptr;
} context_exit = { 0, final_rundown, 1, &exit_reason };
/***************************************************************************/
/*  The following set of routines manage the locks and structures used
 * for dynamic process pool support.  If the pool is active, hpss_initialize
 * acquires low-level lock with a resource name the same as the mailbox
 * name.  For each accept, it times how long it waited for the next
 * connection, it below min_delay then increment the short_waits value in
 * the lock value block.
 */
static int setup_dyn_pool ( struct hpss_context *ctx, int flag,
	struct dsc$descriptor_s *lock_name )
{
    int status, code, my_pid, mode, enq_flags;
    /*
     * Get initial lock.
     */
    if ( flag == 2 ) {		/* we are master */
        mode = LCK$K_PWMODE;		/* Prepare for initial valblk update */
	enq_flags = 0;
    } else {
	mode = LCK$K_CRMODE;
	enq_flags = LCK$M_VALBLK;
    }

    status = SYS$ENQW ( 0, mode, &ctx->lksb, enq_flags, lock_name,
	0, 0, 0, 0, 0, 0, 0 );
    if ( (status&1) == 0 ) return status;
    status = ctx->lksb.status;
    if ( status == SS$_VALNOTVALID ) {
	/*
	 * Serious error, value block should be valid.
	 */
	ctx->lksb.governor_pid = -1;
    }
    /*
     * Fill in LKSB's value and writeback if we are master.
     */
    ctx->lock_id = ctx->lksb.id;
    if ( flag == 2 ) {
	code = JPI$_PID;
	status = LIB$GETJPI ( &code, 0, 0, &ctx->lksb.governor_pid, 0, 0 );
	ctx->lksb.short_wait_threshold = 0;
	ctx->lksb.short_waits = 0;
	ctx->lksb.accepts = 0;

	status = SYS$ENQW ( 0, LCK$K_CRMODE, &ctx->lksb,
	    LCK$M_CONVERT|LCK$M_VALBLK, 0, 0, 0, 0, 0, 0, 0 );
	if ( (status&1) == 1 ) status = ctx->lksb.status;
    }
    /*
     * Mark context if everything went OK
     */
    ctx->dynamic_pool = (status&1) ? flag : 0;
printf("Status of dyn pool setup: %d, flag: %d\n", status, ctx->dynamic_pool);
    return status;
}
static int update_dyn_pool_info ( struct hpss_context *ctx, long start_time[2] )
{
    int status;
    long now[2], delta_time[2], ticks_per_msec, remainder, delta_msec;
    /*
     * Determine milliseconds between start_time and the current time.
     */
    SYS$GETTIM ( now );
    LIB$SUBX ( now, start_time, delta_time );
    if ( delta_time[1] < 0 ) {
	/* system clock went backwards, assume a long wait. */
	delta_msec = 3600000;
    } else if ( delta_time[1] >= 4225 ) {
	/* Wait is longer than 21 days (our of millisecond range) */
	delta_msec = 2000000;
    } else {
	/*
	 * Convert 100-nanosecond tick value of VMS time to milliseconds.
	 */
	ticks_per_msec = 10000;
	LIB$EDIV ( &ticks_per_msec, delta_time, &delta_msec, &remainder );
    }
    /*
     * Convert from CR to PW mode lock in order to get the latest copy
     * of the lock value block.
     */
    status = SYS$ENQW ( 0, LCK$K_PWMODE, &ctx->lksb,
	    LCK$M_CONVERT|LCK$M_VALBLK, 0, 0, 0, 0, 0, 0, 0 );
    if ( (status&1) == 1 ) status = ctx->lksb.status;
    if ( status&1 ) {
	/*
	 * Increment counters and lower lock back to CR to update the value
	 * block.
	 */
	if ( delta_msec <= ctx->lksb.short_wait_threshold )
		ctx->lksb.short_waits++;
	ctx->lksb.accepts++;
	status = SYS$ENQW ( 0, LCK$K_CRMODE, &ctx->lksb,
	    LCK$M_CONVERT|LCK$M_VALBLK, 0, 0, 0, 0, 0, 0, 0 );
	if ( (status&1) == 1 ) status = ctx->lksb.status;
    }
    return 1;
}
/***************************************************************************/
/* The following set of routines manage the asynchronous writes to the
 * output mailboxes.  If the application issues writes to the output mailbox
 * faster than the web server reads them, the buffers are queued and
 * resent at AST layer.
 */
static void aio_stream_ast ( struct aio_stream *stream )
{
    int status;
    struct aio_buffer *cur;
    /*
     * Dequeue the I/O buffer and check completion status of the I/O.
     */
    cur = stream->first;
    if ( !cur ) {
	fprintf(stderr,"BUGCHECK, aio_stream_ast sees null current buffer\n");
	return;
    }
    stream->first = cur->next;
    status = stream->iosb.status;
    if ( (status&1) == 0 ) {
	/*
	 * Error occured, kill the stream, cancelling pending I/O's.
	 */
	stream->last->next = free_buffer;
	free_buffer = cur;
	stream->first = (struct aio_buffer *) 0;
	stream->abort = 1;
	return;
    } else {
	/*
	 * Succesful completion, keep track of total bytes transferred.
	 */
	stream->total_count += stream->iosb.count;
	cur->next = free_buffer;
	free_buffer = cur;
    }
    /*
     * Start new I/O if another buffer present.
     */
    if ( stream->first ) {
	status = SYS$QIO ( 0, stream->channel, IO$_WRITEVBLK|IO$M_READERCHECK,
		&stream->iosb, aio_stream_ast, stream,
		stream->first->buffer, stream->first->length, 0, 0, 0, 0 );
	if ( (status&1) == 0 ) {
	    stream->last->next = free_buffer;
	    free_buffer = stream->first;
	    stream->first = (struct aio_buffer *) 0;
	    stream->abort = 1;
	}
    } else if ( stream->detached ) {
	/*
	 * Main thread no longer referencing this stream, run it down.
	 */
	SYS$DASSGN ( stream->channel );
	stream->next = free_stream;
	free_stream = stream;
	stream_count--;
	if ( stream_alloc_pending ) SYS$WAKE ( 0, 0 );
    }
}

static struct aio_buffer *allocate_aio_buffer ( )
{
    struct aio_buffer *buf;
    SYS$SETAST(0);
    buf = free_buffer;
    if ( buf ) free_buffer = buf->next;
    SYS$SETAST(1);
    if ( !buf ) {
	int i;
	buf = (struct aio_buffer *) malloc ( sizeof(struct aio_buffer)*4 );
	if ( !buf ) return buf;

	for ( i = 1; i < 3; i++ ) buf[i].next = &buf[i+1];
	SYS$SETAST(0);
	buf[3].next = free_buffer;
	free_buffer = &buf[1];
	SYS$SETAST(1);
    }
    return buf;
}

static int write_to_aio_stream ( struct aio_buffer *buffer,
	struct aio_stream *stream,
	struct aio_buffer **next_buffer ) 
{
    int status;
    struct aio_buffer *pending_buf, *next_buf;
    /*
     * Queue buffer to AST level and pre-allocate next buffer while
     * we have ASTs disabled.
     */
    SYS$SETAST(0);
    if ( stream->abort ) {
	/*
	 * I/O to stream has been aborted by AST layer.
	 */
	status = stream->iosb.status;
	SYS$SETAST(1);
	if ( ((status&1)==1) || (status==0) ) status = SS$_ABORT;
	if ( next_buffer ) *next_buffer = (struct aio_buffer *) 0;
	return status;
    }
    buffer->next = (struct aio_buffer *) 0;
    pending_buf = stream->first;
    if ( pending_buf ) {	/* I/O pending */
	stream->last->next = buffer;
    } else {
	stream->first = buffer;
    }
    stream->last = buffer;
    if ( next_buffer ) {
        next_buf = free_buffer;
        if ( next_buf ) free_buffer = next_buf->next;
    }
    SYS$SETAST(1);
    /*
     * Start I/O if queue was previously empty.
     */
    if ( !pending_buf ) {
        status = SYS$QIO ( 0, stream->channel, IO$_WRITEVBLK|IO$M_READERCHECK,
		&stream->iosb, aio_stream_ast, stream,
		stream->first->buffer, stream->first->length, 0, 0, 0, 0 );
	if ( (status&1) == 0 ) {
	    stream->abort = 1;
	    if ( next_buf ) {
		SYS$SETAST(0);
		next_buf->next = free_buffer;
		free_buffer = next_buf;
		SYS$SETAST(1);
		*next_buffer = (struct aio_buffer *) 0;
		return status;
	    }
	}
    } else {
	status = 1;
    }
    /*
     * Allocate next buffer if free list was empty and user requested one.
     */
    if ( next_buffer ) {
        if ( !next_buf ) next_buf = allocate_aio_buffer();
	*next_buffer = next_buf;
    }
    return status;
}

static void detach_aio_stream ( struct aio_stream *stream )
{
    int channel;
    SYS$SETAST(0);
    if ( stream->first ) {	/* I/O pending */
	channel = -1;
	stream->detached = 1;
    } else {
	/* No pending I/O, rundown directly */
	channel = stream->channel;
	stream->next = free_stream;
	free_stream = stream;
	stream_count--;
    }
    SYS$SETAST(1);
    if ( channel != -1 ) SYS$DASSGN ( channel );
}

static struct aio_stream *allocate_aio_stream ( int unit, int channel )
{
    struct aio_stream *stream;
    if ( stream_limit == 0 ) {
	/*
	 * First call.
	 */
	int code, status;
	code = JPI$_ASTLM;
	status = LIB$GETJPI ( &code, 0, 0, &stream_limit, 0, 0 );
	stream_count = 0;
	stream_limit = stream_limit / 2;
    }
    /*
     * Allocate the structure, synchronize with AST layer.
     */
    SYS$SETAST(0);
    while ( stream_count >= stream_limit ) {
	/*
	 * No more  streams available, wait for a detached stream to
	 * rundown.
	 */
	stream_alloc_pending = 1;
	SYS$SETAST(1);
	SYS$HIBER();
	SYS$SETAST(0);
    }
    stream_alloc_pending = 0;
    stream = free_stream;
    if ( stream ) {
	free_stream = stream->next;
	stream_count++;
    }
    SYS$SETAST(1);
    if ( !stream ) {
	/*
	 * Allocate new set of stream structures, use the first and put
	 * remaining 15 on free list.
	 */
	stream = (struct aio_stream *) malloc ( 16*sizeof(struct aio_stream) );
	if ( stream ) {
	    int i;
	    for ( i = 1; i < 15; i++ ) stream[i].next = &stream[i+1];
	    SYS$SETAST(0);
	    stream[15].next = free_stream;
	    free_stream = &stream[1];
	    stream_count++;
	    SYS$SETAST(1);
	} else return stream;
    }
    /*
     * Initialize the allocated block and return to caller.
     */
    stream->next = (struct aio_stream *) 0;
    stream->total_count = 0;
    stream->channel = channel;
    stream->unit = unit;
    stream->abort = 0;
    stream->detached = 0;
    stream->first = (struct aio_buffer *) 0;
    stream->last = (struct aio_buffer *) 0;
    return stream;
}
/***************************************************************************/
/*
 * Define support routines for managing context list.
 */
static struct hpss_context *lookup_context ( int id )
{
    /*
     * Return context structure corresponding to the id argument.
     */
    struct hpss_context *ctx;
    if ( id == 0 ) return (struct hpss_context *) 0;
    for ( ctx = context_list; ctx; ctx = ctx->next ) {
	if ( ctx->id == id ) break;
    }
    return ctx;
}

static struct hpss_context *create_context ( int channel, INTEGER context )
{
    /*
     * Allocate new context and give it new ID.
     */
    struct hpss_context *ctx;
    ctx = (struct hpss_context *) malloc ( sizeof(struct hpss_context) );
    if ( !ctx ) return ctx;
    if ( context_list ) {
	/* prepend to existing, first element will always have highest id */
	ctx->id = context_list->id + 1;
	ctx->next = context_list;
    } else {
	/* Start new list */
	ctx->id = 1;
	ctx->next = (struct hpss_context *) 0;
	/*
	 * Add exit handler.
	 */
	SYS$DCLEXH ( &context_exit );
    }
    context_list = ctx;
    /*
     * Initialize the rest of the context.
     */
    ctx->channel = channel;
    ctx->msglen = 0;			/* no current message */
    ctx->var.allocation = 30;
    ctx->var.size = 0;
    ctx->var.def = (struct sym_table_def *) malloc (
	ctx->var.allocation*sizeof(struct sym_table_def) );
    if ( !ctx->var.def ) ctx->var.allocation = 0;
    ctx->form.allocation = 0;		/* only allocate as needed. */
    ctx->form.size = 0;
    ctx->form.def = (struct sym_table_def *) 0;
    ctx->content_alloc = 0;
    ctx->content_used = 0;
    ctx->content_pos = 0;
    ctx->content = (char *) 0;
    ctx->connection_active = 0;
    ctx->dynamic_pool = 0;
    /*
     * Return handle to caller.
     */
    *context = ctx->id;
    return ctx;
}
/*
 * Exit handler to ensure nascent connections terminate cleanly.
 * The problem is to avoid a race the partner (server) must do the first
 * read of the output mailbox without a nowriter's check.  If the HPSS
 * application (us) crashes before sending the first response the
 * read by the server hangs forever.
 */
static int final_rundown ( int *reason )
{
    struct hpss_context *ctx;
    struct aio_stream *out;
    int status;
    /*
     * Scan the contexts looking for aio_streams that haven't written
     * any bytes yet.
     */
    for ( ctx = context_list; ctx; ctx = ctx->next ) {
	/*
	 * Each context can have multiple output streams active asynchronously
	 * Writing output.
	 */
	for ( out = ctx->out_stream; out; out = out->next ) {
	    SYS$SETAST(0);
	    if ( out->total_count == 0 ) {
		/*
		 * Kill pending I/O (so we don't hang) and write EOF.
		 */
		struct { unsigned short status,count; long pid; } iosb;
		SYS$CANCEL ( out->channel );
		status = SYS$QIOW ( 0, out->channel, 
			IO$_WRITEOF|IO$M_NOW|IO$M_READERCHECK, &iosb,
			0, 0, 0, 0, 0, 0, 0, 0 );
	    }
	    SYS$SETAST(1);
	}
    }
    return 1;
}
/*
 * Ensure content region big enough to hold n addition bytes.
 */
static int check_content_allocation ( struct hpss_context *ctx, int extra )
{
    if ( (ctx->content_used + extra) > ctx->content_alloc ) {
	if ( ctx->content_alloc == 0 ) {	/* initial allocation */
	    ctx->content_alloc = extra + 60000;
	    ctx->content = malloc ( ctx->content_alloc );
	} else {
	    /* grow buffer */
	    ctx->content_alloc += (extra+120000);
	    ctx->content = realloc ( ctx->content, ctx->content_alloc );
	}
    }
    return 1;
}
/*
 * Read content.
 */
static int load_content_via_mailbox ( int mbx_unit, struct hpss_context *ctx )
{
    static char mbx_name[32];
    static $DESCRIPTOR(mbx_name_dx,mbx_name);
    struct { unsigned short status, count; long pid; } iosb;
    int status, chan;
    /*
     * Assign channel to the mailbox, only read from it.
     */
    sprintf ( mbx_name, "_MBA%d:", mbx_unit );
    mbx_name_dx.dsc$w_length = strlen ( mbx_name );
    chan = 0;
    status = SYS$ASSIGN ( &mbx_name_dx, &chan, 0, 0, CMB$M_READONLY );
    if ( (status&1) == 0 ) return status;
    /*
     * Read data.
     */
    for ( ; ; ) {
	check_content_allocation ( ctx, 4096 );
	status = SYS$QIOW ( 0, chan, IO$_READVBLK|IO$M_WRITERCHECK, &iosb,
	    0, 0, &ctx->content[ctx->content_used], 4096, 0, 0, 0, 0 );
	if ( (status&1)== 1 ) status = iosb.status;
	if ( (status&1) == 0 ) break;	/* read error */
	ctx->content_used += iosb.count;
    }
    /*
     * Rundown.
     */
    SYS$DASSGN ( chan );
    return status;
}
/*
 * Add ACL to mailbox to permitted named user to access.
 */
static int set_mailbox_access ( int channel, char *username )
{
    static $DESCRIPTOR(user_dx,"");
    static $DESCRIPTOR(security_class,"DEVICE");
    int status, attrib;
    unsigned long uic;
    struct { short length, code; void *buffer; int *retlen;} item[2];
    struct {
	unsigned char length, type;
	unsigned short flags;
	unsigned long access;
	unsigned long identifier;
    } ace;
    /*
     * Translate username to UIC.
     */
    user_dx.dsc$w_length = strlen ( username );
    user_dx.dsc$a_pointer = username;
    status = SYS$ASCTOID ( &user_dx, &uic, &attrib );
    if ( (status&1) == 0 ) {
	fprintf(stderr,"Error %d translating identifier '%s' to UIC\n",
	    status, username );
	return status;
    }
    /*
     * Build ACE
     */
    ace.type = ACE$C_KEYID;
    ace.length = sizeof(ace);
    ace.flags = 0;
    ace.access = 15;			/* full access */
    ace.identifier = uic;
    /*
     * Update the security profile.
     */
    item[0].length = sizeof(ace);
    item[0].code = OSS$_ACL_ADD_ENTRY;
    item[0].buffer = (void *) &ace;
    item[0].retlen = (int *) 0;
    item[1].length = item[1].code = 0;

    status = SYS$SET_SECURITY ( &security_class, 0, &channel, 0, &item, 0, 0 );
    if ( (status&1) == 0 ) {
	fprintf(stderr,"Error %d adding ACE to mailbox\n", status );
    }
    
    return status;
}
/***************************************************************************/
/* Copy source string to destination string descriptor, padding with spaces.
 */
static void copy_string ( char *source, int slen, STRING dest, INTEGER dlen )
{
    int i, seg;
    seg = slen;
    if ( seg >= dest->dsc$w_length ) {
	/* String truncated */
	seg = dest->dsc$w_length;
	memcpy ( dest->dsc$a_pointer, source, seg );
    } else {
	/* String padded */
	memcpy ( dest->dsc$a_pointer, source, seg );
	memset ( &dest->dsc$a_pointer[seg], ' ', dest->dsc$w_length - seg );
    }
    *dlen = seg;
}
/***************************************************************************/
/* Initialize context's cgi variable table from the message structure.
 * This function must be closely coordinated with the message encode function
 * of hpss_mst.c.
 */
static int expand_mailbox_message ( struct hpss_context *ctx, STRING subfunc )
{
    union hpss_mbxmsg *msg;
    int ndx, i, j, ndx_limit, dpos, status;
    char *cl_str;

    msg = &ctx->msg;
    i = 0;
    ndx_limit = ctx->msglen / sizeof(msg->def[0]);
    /*
     * Scan the table to find number of entries.
     */
    for ( ndx = 2; msg->def[ndx].nlen > 0; ndx++ ) {
	if ( ndx >= ndx_limit ) {
	    /* Ran off end of table */
	    return SS$_FORMAT;
	}
    }
    /*
     * Ensure enough entries in var table.
     */
    if ( ndx > ctx->var.allocation ) {
	ctx->var.allocation = (ndx*2);
	ctx->var.def = (struct sym_table_def *) realloc ( ctx->var.def,
		ndx * sizeof(struct sym_table_def) );
    }
    /*
     * Compute start of text area and copy subfunc argument if present.
     */
    dpos = (ndx+1) * sizeof(msg->def[0]);  /* current text position */
    if ( subfunc ) {
	int sf_len;
	copy_string ( &msg->data[dpos], msg->comhdr.func, subfunc, &sf_len );
    }
    dpos += (msg->comhdr.func+msg->comhdr.method);
    for ( j = 0, i = 2; i < ndx; i++ ) {
	/*
	 * Initialize structure to point to data in message buffer.
	 */
	ctx->var.def[j].nlen = msg->def[i].nlen;
	ctx->var.def[j].vlen = msg->def[i].vlen;
	ctx->var.def[j].name = &msg->data[dpos];
	dpos += (msg->def[i].nlen);
	ctx->var.def[j].value = &msg->data[dpos];
	dpos += (msg->def[i].vlen);
	j++;
    }
    ctx->var.size = j;
    /*
     * See if content present in rest of message.
     */
    if ( msg->def[ndx].vlen > 0 ) {
	/*
	 * The content is stored between the end the CGI var text and
	 * the end of buffer.
	 */
	if ( (msg->def[ndx].vlen + dpos) != ctx->msglen ) {
	    fprintf(stderr,
		"BUGCHECK, content size mismatch with mailbox message EOB/n");
	}
	if ( (msg->def[ndx].vlen + dpos) > ctx->msglen ) {
	    msg->def[ndx].vlen = ctx->msglen - dpos;
	}
	status = check_content_allocation ( ctx, msg->def[ndx].vlen );
	memcpy ( &ctx->content[ctx->content_used], &msg->data[dpos],
		msg->def[ndx].vlen );
	ctx->content_used += msg->def[ndx].vlen;
    }
    /*
     * See if content to be sent via mailbox.
     */
    if ( msg->comhdr.in_mbx != msg->comhdr.out_mbx ) {
	load_content_via_mailbox ( msg->comhdr.in_mbx, ctx );
    }
    return 1;
}
/***************************************************************************/
/*
 * Initialize function creates a mailbox that the web server writes
 * service requests to.  The service request is a single message that
 * contains:
 *    Mailbox unit to recieve additional content (if needed).
 *    Mailbox unit to write CGI response to.
 *    prologue strings.
 *    CGI variables.
 *    First segment of content (as much as will fit in remainder of 8K message
 *       limit).
 */
int hpss_initialize ( STRING mbx_logical,	
	INTEGER mbx_type,		/* 0-group table, 1-system table */
	INTEGER context )		/* return value */
{
    int status, pflag, channel, i, nlen, dyn_pool_flag;
    struct {
	short length, code;
	char *buf;
	int *retlen;
    } item[4];
    static char up_logical[512];
    static $DESCRIPTOR(up_logical_dx,up_logical);
    char *access_user;
    /*
     * Fixup logical name, make all upper case and look for /access=user
     */
    nlen = mbx_logical->dsc$w_length;
    if ( nlen > sizeof(up_logical) ) nlen = sizeof(up_logical);
    memcpy ( up_logical, mbx_logical->dsc$a_pointer, nlen );
    up_logical_dx.dsc$w_length = nlen;
    for ( i = 0; i < nlen; i++ ) {
	up_logical[i] = toupper(up_logical[i]);
	if ( (up_logical[i] == '/') && (up_logical_dx.dsc$w_length == nlen) ) {
	    up_logical_dx.dsc$w_length = i;
	}
    }
    access_user = (char *) 0;
    dyn_pool_flag = 0;
    if ((up_logical_dx.dsc$w_length != nlen) && (nlen < sizeof(up_logical))) {
	/*
	 * User supplied options.  Only option recongized is /access=
	 */
	int list_length, j;
	char *olist, *ostr, *vstr, *next_opt;
	/*
	 * Parse out next /option=value pair  (This is not as robust as
	 * a DCL parse - e.g no spaces allowed.
	 */
	list_length = nlen - up_logical_dx.dsc$w_length;
	up_logical[nlen] = '/';		/* sentinel */
	olist = &up_logical[up_logical_dx.dsc$w_length+1];
	ostr = olist;
	for ( i = 0; i < list_length; i++ ) if ( olist[i] == '/' ) {
	    /*
	     * Parse out =value if present, j ends with length of option.
	     */
	    olist[i] = '\0';
	    vstr = (char *) 0;
	    for ( j = 0; ostr[j]; j++ ) if ( ostr[j] == '=' ) {
		ostr[j] = '\0';
		vstr = &ostr[j+1];
		break;
	    }
	    /*
	     * Interpret option.
	     */
	    /* printf("Mailbox option: %s\n", ostr ); */
	    if ( j == 0 ) {
		fprintf(stderr, "Null mailbox option string ignored\n");
	    } else if ( 0 == strncmp(ostr,"POOL",j) ) {
		/*
		 * /POOL=MASTER or /POOL=WORKER
		 */
		dyn_pool_flag = 1;
		if ( vstr ) if (strncmp(vstr,"MASTER",6) == 0) dyn_pool_flag = 2;
		/* printf("dyn pool flag: %d\n", dyn_pool_flag ); */

	    } else if ( 0 == strncmp(ostr,"ACCESS",j) ) {
		/*
		 * /ACCESS=username option specified username of web
		 * server that will be sending us requests.
		 */
		if ( !vstr || !(*vstr) ) {
		    fprintf(stderr, "Missing username on ACCESS option\n");
		} else {
		    access_user = vstr;
		    if ( *mbx_type == 0 ) fprintf ( stderr,
			"Warning, mailbox logical in GROUP table, %s.\n",
			"may not be visible to HTTP server" );
		}
	    }
	    /*
	     * Set up for next option.
	     */
	    ostr = &olist[i+1];
	}
    }
    /*
     * Temporarily define lnm$temporary_mailbox if needed so name goes into
     */
    *context = 0;
    if ( *mbx_type != 1 ) {
	pflag = 0;
	item[0].code = LNM$_STRING;
	item[0].buf = (*mbx_type == 0) ? 
		TEMP_MAILBOX_TABLE : SHARED_MAILBOX_TABLE;
	item[0].length = strlen ( item[0].buf );
	item[0].retlen = (int *) 0;
	item[1].length = item[1].code = 0;	/* terminate list */

	status = SYS$CRELNM ( 0, &mbxlogical_table, &mbxlogical_destination,
		0, item );
    } else pflag = 1;
    /*
     * Create mailbox with specified logical name.  Protections is
     *    system:rwlp owner:rwlp group: world:wrlp
     */
    channel = 0;
    status = SYS$CREMBX ( pflag, &channel, HPSS_MAX_MSGSIZE, HPSS_MAX_MSGSIZE,
	0x0FF00, 0, &up_logical_dx, 
	(dyn_pool_flag != 2) ? CMB$M_READONLY : 0, 0 );
    if ( (status&1) == 1 ) {
	/*
	 * Mailbox successfully created add ACL if hpss_username
	 */
	if ( access_user ) set_mailbox_access ( channel, access_user );
        if ( pflag == 1 ) {
	    /*
	     * Mark delete pending on mailbox so it effectively becomes 
	     * temporary.
	     */
	    SYS$DELMBX ( channel );		/* make it goe away */
	}
    }
    if ( pflag == 0 ) {
	/*
	 * Remove logical used to force into group table.
	 */
	SYS$DELLNM ( &mbxlogical_table, &mbxlogical_destination, 0 );
    }
    /*
     * Allocate context and return handle to it.
     */
    if ( (status&1) == 1 ) {

	if ( !create_context(channel, context ) ) status = SS$_ABORT;
	else if ( dyn_pool_flag > 0 ) {
	    setup_dyn_pool ( lookup_context ( *context ),
		dyn_pool_flag, &up_logical_dx );
	}
    }
    return status;
}
/*
 * The accept function waits up to timeout seconds for the next message
 * to arrive and initialize the connext for calls to read/write/getenv/etc.
 * A timeout of zero means no timeout.
 * The disconnect function runs down the current request and prepares the
 * context for the next accept call.
 */
static void accept_timeout ( struct hpss_context *ctx )
{
    if ( ctx->accept_timer_active == 0 ) return;	/* nothing to do */
    ctx->accept_timer_fired = 1;
    SYS$CANCEL ( ctx->channel );
}
int hpss_accept ( INTEGER context,
	INTEGER timeout,		/* timeout in seconds, neg. for none */
	INTEGER PID,			/* process ID of web server */
	STRING function )		/* script server invocation method */
{
    struct hpss_context *ctx;
    int flags, status, tsec;
    long wait_start[2];
    struct { unsigned short status, count; long pid; } iosb;
    /*
     * dereference the handle
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) return SS$_BADPARAM;	/* invalid context */
    /*
     * Cleanup if caller forogt to disconnect the previous accept.
     */
    if ( ctx->connection_active ) {
	status = hpss_disconnect ( context );
	if ( (status&1) == 0 ) return status;
    }
    /*
     * Read next message from mailbox.
     */
    if ( ctx->dynamic_pool ) SYS$GETTIM ( wait_start );
    tsec = *timeout;
    if ( tsec <= 0 ) {
	/*
	 * no timeout.
	 */
	/* flags = (tsec == 0) ? IO$M_WRITERCHECK | IO$M_NOW : 0; */
	flags = 0;
	status = SYS$QIOW ( 0, ctx->channel, IO$_READVBLK|flags, &iosb,
		0, 0, &ctx->msg, sizeof(ctx->msg), 0, 0, 0, 0 );
	if ( status&1 ) status = iosb.status;
    } else {
	static long ticks_per_sec = -10000000;
	static long offset = 0;
	long interval[2];
        /*
	 * start async QIO.
	 */
	status = SYS$QIO ( 0, ctx->channel, IO$_READVBLK, 
		&iosb, 0, 0, 
		&ctx->msg, sizeof(ctx->msg), 0, 0, 0, 0 );
	if ( (status&1) == 0 ) return status;
	/*
	 * Start timer for timeout.
	 */
	LIB$EMUL ( &ticks_per_sec,  timeout, &offset, interval );
	ctx->accept_timer_active = 1;
	ctx->accept_timer_fired = 0;
	SYS$SETIMR ( 5, interval, accept_timeout, ctx, 0 );
	/*
	 * Wait for I/O to complete and convert cancel status to SS$_TIMEOUT.
	 */
	status = SYS$SYNCH ( 5, &iosb );
	SYS$CANTIM ( ctx, 0 );		/* cancel timer */
	SYS$SETAST ( 0 );
	ctx->accept_timer_active = 0;
	if ( (ctx->accept_timer_fired == 1) && ((iosb.status&1)== 0) )
	    iosb.status = SS$_TIMEOUT;
	SYS$SETAST ( 1 );

	status = iosb.status;
    }
    /*
     * Update counters if we are part of a dynamic pool.
     */
    if ( ctx->dynamic_pool ) {
	if ( status &1 ) update_dyn_pool_info ( ctx, wait_start );
	else if ( (status == SS$_ENDOFFILE) && 
		(iosb.pid ==ctx->lksb.governor_pid) ) {
	    /*
	     * Pool master sent us an EOF, return a shutdown status to
	     * encourage caller to exit.
	     */
	    status = SS$_SHUT;
	}
    }
    if ( (status&1) == 0 ) {
	ctx->outchan = -1;
	*PID = 0;
	return status;
    }
    *PID = iosb.pid;
    /*
     * Setup the context for processing the message, do sanity checks on size.
     */
    ctx->msglen = iosb.count;
    if ( ctx->msglen < sizeof(ctx->msg.comhdr) ) {
	/* message too short */
    }
    ctx->out_stream = (struct aio_stream *) 0;
    ctx->outbuf = (struct aio_buffer *) 0;
    ctx->content_used = 0;
    ctx->content_pos = 0;
    ctx->var.size = 0;
    ctx->form.size = 0;
    status = expand_mailbox_message ( ctx, function );
    if ( status&1 ) {
	/*
	 * Attempt to assign channel to output mailbox.
	 */
	static char mbxname[64];
	static $DESCRIPTOR(mbxname_dx,mbxname);

	sprintf ( mbxname, "MBA%d:", ctx->msg.comhdr.out_mbx );
	mbxname_dx.dsc$w_length = strlen ( mbxname );
	ctx->outchan = 0;
	status = SYS$ASSIGN ( &mbxname_dx, &ctx->outchan, 0, 0, 
		CMB$M_WRITEONLY );
	if ( (status&1) == 0 ) fprintf(stderr,
		"Status of assign to outmbx '%s': %d\n", mbxname, status );
    } else {
	ctx->outchan = -1;
    }
    /*
     * Allocate the output stream to the mailbox.
     */
    if ( (status&1) == 1 ) {
        ctx->out_stream = allocate_aio_stream ( ctx->msg.comhdr.out_mbx, 
		ctx->outchan );
        if ( !ctx->out_stream ) {
        }
        ctx->outbuf = allocate_aio_buffer ( );
	ctx->outbuf->length = 0;
	ctx->connection_active = 1;
    }
    return status;
}
int hpss_disconnect ( INTEGER context )
{
    struct hpss_context *ctx;
    struct { unsigned short status, count; long pid; } iosb;
    int status, connection_active;
    /*
     * dereference the handle and see if valid.
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) return SS$_BADPARAM;	/* invalid context */
    if ( ctx->outchan == -1 ) return SS$_ABORT;
    /*
     * Run down the connection.
     */
    ctx->msglen = 0;
    ctx->content_used = 0;
    connection_active = ctx->connection_active;		/* save orig. state */
    ctx->connection_active = 0;
    if ( ctx->outbuf && (ctx->outbuf->length > 0) ) {
	/*
	 * Flush final buffer.
	 */
	if ( connection_active == 1 ) connection_active = 2;
	status = write_to_aio_stream ( ctx->outbuf, ctx->out_stream,
		(struct aio_buffer **) 0 );
    } else if ( ctx->outbuf ) {
	/*
	 * Free the io buffer.
	 */
	SYS$SETAST ( 0 );
	ctx->outbuf->next = free_buffer;
	free_buffer = ctx->outbuf;
	SYS$SETAST ( 1 );
	status = 1;
    }
    /*
     * The server side of the HPSS connection doesn't do a writercheck
     * when reading our outbound mailbox the first time to avoid the
     * race with us getting the channel assigned.  If we accept and
     * disconnect without any writes we cause a hang since the server
     * won't detect the disconnect.  To avoid this, force and EOF to
     * the mailbox if hpss_write has never been called on this
     * connection (ctx->connection_active == 1)
     */
    if ( connection_active == 1 ) {
	struct { unsigned short status, count; long pid; } iosb;
	status = SYS$QIOW ( 0, ctx->outchan, 
		IO$_WRITEOF|IO$M_NOW|IO$M_READERCHECK, &iosb,
		0, 0, 0, 0, 0, 0, 0, 0 );
    }
    /*
     * Deassign channel or mark to deassignment when asynch I/O done.
     */
    detach_aio_stream ( ctx->out_stream );
    ctx->out_stream = (struct aio_stream *) 0;
    ctx->outbuf = (struct aio_buffer *) 0;
    return status;
}
/*
 * Build comma-separated list of names in a table.
 */
static int display_table ( struct sym_table *table, STRING value, 
	INTEGER ret_length )
{
    struct sym_table_def *def;
    int i, j, vsize, length;
    char *out;

    def = table->def;
    vsize = value->dsc$w_length;
    out = value->dsc$a_pointer;
    length = 0;
    for ( i = 0; i < table->size; i++ ) {
	if ( length > 0 ) {
	    if  ( length >= vsize ) {
		*ret_length = vsize;
		return SS$_DATAOVERUN;
	    }
	    out[length++] = ',';
	}
	for ( j = 0; j < def[i].nlen; j++ ) {
	    if ( length >= vsize ) {
		*ret_length = vsize;
		return SS$_DATAOVERUN;
	    }
	    out[length++] = def[i].name[j];
	}
    }
    *ret_length = length;
    for ( i = length; i < vsize; i++ ) out[i] = ' ';	/* pad with spaces */
    return 1;
}
/*
 * The getenv function returns the value of a standard CGI variable
 * that was included in the initialze CGI message.
 */
static struct sym_table_def *table_search ( struct sym_table *table,
	char *name, int nlen )
{
     /*
      * internal function for scanning table for given name, returning
      * pointer to table entry or null.
      */
     int i, size;
     struct sym_table_def *def;
     def = table->def;
     size = table->size;
     for ( i = 0; i < size; i++ ) {
	if ( def->nlen == nlen ) {
	    if ( 0 == strncmp ( def->name, name, nlen ) ) return def;
	}
	def++;
     }
     return (struct sym_table_def *) 0;
}

int hpss_getenv ( INTEGER context,
	STRING name,			/* CGI variable name (no WWW_ prefix)*/
	STRING value,
	INTEGER ret_length )
{
    struct hpss_context *ctx;
    struct sym_table_def *def;
    int i;
    /*
     * Retrieve context from handle.
     */
    ctx = lookup_context ( *context );
     if ( !ctx ) return SS$_BADPARAM;
    /*
     * Scan table.
     */
    def = table_search (&ctx->var, name->dsc$a_pointer, name->dsc$w_length);
    if ( def ) {
	copy_string ( def->value, def->vlen, value, ret_length );
	return 1;
    }
    /*
     * Search failed, see if it is special pseudo-variable %SYMBOL_LIST
     */
    if ( name->dsc$w_length == 12 ) {
	if ( 0 == strncmp ( "%SYMBOL_LIST", name->dsc$a_pointer, 12 ) ) {
	    /*
	     * Return value is list of variables names in the table.
	     */
	    return display_table ( &ctx->var, value, ret_length );
	}
    }
    *ret_length = 0;
    return 0;
}
/*
 * The getform function references a table of name/value pairs, which it
 * initializes when needed by reading and decoding the request content.
 * Format of content: name=value&name=value... with escaping of special chars.
 */
static int add_form_symbol ( int *context, char *name, int nlen,
	char *value, int vlen )
{
    struct hpss_context *ctx;
    struct sym_table_def *def;
    /*
     * dereference the handle
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) return SS$_BADPARAM;	/* invalid context */
    /*
     * Expand table if needed.
     */
    if ( ctx->form.size >= ctx->form.allocation ) {
	if ( ctx->form.allocation == 0 ) {	/* initial allocation */
	    ctx->form.allocation = 20;
	    ctx->form.def = (struct sym_table_def *) malloc (
		sizeof(struct sym_table_def) * ctx->form.allocation );
	} else {
	    ctx->form.allocation += 20;
	    ctx->form.def = (struct sym_table_def *) realloc ( ctx->form.def,
		sizeof(struct sym_table_def) * ctx->form.allocation );
	}
	if ( !ctx->form.def ) {
	    ctx->form.allocation = 0;
	    return 0;		/* failure */
	}
    }
    /*
     * Append entry.
     */
    def = &ctx->form.def[ctx->form.size++];
    def->nlen = nlen;
    def->vlen = vlen;
    def->name = name;
    def->value = value;

    return 1;
}

static void load_form_table ( struct hpss_context *ctx )
{
    char *fdata;
    struct sym_table_def *ctype;
    int length, ct_len, i;
    char *clause, content_type[256];
    int hpss_parse_form_content ( );
    /*
     * Make a copy of the content-type and uppercase the portion up to
     * the first sem-colon.
     */
    ctype = table_search(&ctx->var, "CONTENT_TYPE", 12 );
    clause = (char *) 0;
    if ( ctype ) {
	/*
	 * ensure content type is application.
	 */
	ct_len = ctype->vlen;
	if ( ct_len > sizeof(content_type) ) ct_len = sizeof(content_type)-1;
	for ( i = 0; i < ct_len; i++ ) {
	    if ( clause ) content_type[i] = ctype->value[i];
	    else {
	       content_type[i] = toupper(ctype->value[i]);
		if ( content_type[i] == ';' ) clause = &content_type[i+1];
	    }
	}
	content_type[ct_len] = 0;
    } else {
	strcpy ( content_type, "" );	/* content type missing */
    }
    /*
     * fallback to query string if method is get.
     */
    fdata = ctx->content;
    length = ctx->content_used;
    ctx->content_pos = length;
    if ( length == 0 ) {
	/*
	 * use QUERY_STRING variable if present.  Note that the
	 * string gets modified.
	 */
	struct sym_table_def *qstring, *method;
	qstring = table_search(&ctx->var, "QUERY_STRING", 12);
	method = table_search(&ctx->var, "REQUEST_METHOD", 14);
	if ( method ) {
	    /* only use query string if method is GET */
	    if ( method->vlen != 3 ) qstring = (struct sym_table_def *) 0;
	    else if ( strncmp ( "GET", method->value, 3 ) != 0 )
		qstring = (struct sym_table_def *) 0;
	} else qstring = (struct sym_table_def *) 0;
	length = 0;
	if ( qstring ) {
	    length = qstring->vlen;
	    fdata = qstring->value;
	    strcpy ( content_type, "APPLICATION/X-WWW-FORM-URLENCODED" );
	}
    }
    /*
     * Hand off to separate module to handle the grungy details of
     * form data parsing.  Use callback parameter to add the table
     * entries.
     */
    hpss_parse_form_content ( &ctx->id, content_type, fdata, length,
	add_form_symbol );
}

int hpss_getform ( INTEGER context,
    STRING name,
    STRING value,
    INTEGER ret_length )
{
    struct hpss_context *ctx;
    struct sym_table_def *def;
    int i, nlen;
    char match_name[128];
    /*
     * dereference the handle
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) return SS$_BADPARAM;	/* invalid context */
    /*
     * Build the form table if we haven't done so yet.
     */
    if ( ctx->form.size == 0 ) load_form_table ( ctx );
    /*
     * upcase the caller's argument.
     */
    nlen = name->dsc$w_length;
    if ( nlen >= sizeof(match_name) ) nlen = sizeof(match_name) - 1;
    for ( i = 0; i < nlen; i++ ) match_name[i] = 
		_toupper(name->dsc$a_pointer[i]);
    match_name[nlen] = '\0';
    /*
     * Scan table and return value to caller.
     */
    def = table_search ( &ctx->form, match_name, nlen );
    if ( def ) {
	copy_string ( def->value, def->vlen, value, ret_length );
	return 1;
    }
    /*
     * Search failed, see if it is special pseudo-variable %SYMBOL_LIST
     */
    if ( nlen == 12 ) {
	if ( 0 == strncmp ( "%SYMBOL_LIST", name->dsc$a_pointer, nlen ) ) {
	    /*
	     * Return value is list of variables names in the table.
	     */
	    return display_table ( &ctx->form, value, ret_length );
	}
    }
    *ret_length = 0;
    return 0;
}
/*
 * The read function reads the raw request content.  This function is mutually
 * exclusive with the getform function.
 */
int hpss_read ( INTEGER context,
    STRING buffer,			/* receives content. */
    INTEGER ret_length )		/* number of bytes returned */
{
    struct hpss_context *ctx;
    int status, remainder, seg, ctl_flags, count;
    char *ptr;
    /*
     * dereference the handle
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) return SS$_BADPARAM;	/* invalid context */
    /*
     * Consume the bytes in the content block.
     */
    if ( ctx->content_used > ctx->content_pos ) {
	count = ctx->content_used - ctx->content_pos;
	if ( count > buffer->dsc$w_length ) count = buffer->dsc$w_length;
	copy_string ( &ctx->content[ctx->content_pos], count, buffer, 
		ret_length );
	ctx->content_pos += count;
    } else {
	return SS$_ENDOFFILE;
    }
    return SS$_NORMAL;
}
/*
 * The write function sends CGI response data to the server.  For
 * efficiency the data is bufferred until a disconnect or explicit flush flag
 * is set.  The data path to the web server is treated as a byte stream,
 * you must set flag bit 0 if you want a record delimiter inserted.
 *
 * Flag bits:
 *    0  	If set, append CRLF to end of data.
 *    1		If set flush buffer after appending current data.
 */
int hpss_write ( INTEGER context,
    STRING buffer,
    INTEGER flags )
{
    struct hpss_context *ctx;
    int status, remainder, seg, ctl_flags;
    struct { unsigned short status, count; long pid; } iosb;
    char *ptr;
    /*
     * dereference the handle
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) return SS$_BADPARAM;	/* invalid context */
    /*
     * Move caller's arguments into local variables.
     */
    status = SS$_NORMAL;		/* default return status */
    ctl_flags = *flags;
    remainder = buffer->dsc$w_length;
    ptr = buffer->dsc$a_pointer;
    if ( (remainder == 0) && (ctl_flags&1) ) {
	/* null string with implied CRLF, synthesize a buffer. */
	ptr = "\r\n";
	remainder = 2;
	ctl_flags ^= 1;		/* only do once. */
    }
    /*
     * Mark context to indicate at least 1 write was done.
     */
    if ( (remainder > 0) && (ctx->connection_active==1) ) 
	ctx->connection_active = 2;
    /*
     * Process the buffer to be sent in chunks.
     */
    for ( ; remainder > 0; remainder -= seg ) {
	/*
	 * Move as much as we can into buffer.
	 */
	seg = sizeof(ctx->outbuf->buffer) - ctx->outbuf->length;
	if ( seg > remainder ) seg = remainder;
	memcpy ( &ctx->outbuf->buffer[ctx->outbuf->length], ptr, seg );
	ptr += seg;
	ctx->outbuf->length += seg;
	/*
	 * Flush buffer if now full.
	 */
	if ( ctx->outbuf->length >= sizeof(ctx->outbuf->buffer) ) {
	    /*
	     * Queue buffer to output stream and get new buffer.
	     */
	    status = write_to_aio_stream ( ctx->outbuf, ctx->out_stream,
		&ctx->outbuf );
	    if ( ctx->outbuf ) ctx->outbuf->length = 0;
	    if ( (status&1) == 0 ) return status;	/* error */
	}
	/*
	 * Reset buffer to append CRLF if requested.
	 */
	if ( (remainder == seg) && (ctl_flags&1) ) {
	    remainder = 2;
	    seg = 0;
	    ptr = "\r\n";
	    ctl_flags ^= 1;		/* clear bit so we only do this once */
	}
    }
    /*
     * See if caller requested a forced flush.
     */
    if ( (ctl_flags&2) && (ctx->outbuf->length > 0) ) {
	status = write_to_aio_stream ( ctx->outbuf, ctx->out_stream,
		&ctx->outbuf );
	if ( ctx->outbuf ) ctx->outbuf->length = 0;
    }
    return status;
}
/***************************************************************************/
/* Debug routine, format and write current state to sys$error
 * Flag bits:
 *    0		Show service mailbox message (encodes CGI symbol table and
 *		content).
 *    1		Show loaded content (raw)
 *    2		Show CGI variable table.
 */
static void dump_table ( char *title, struct sym_table *table );
static void hex_dump ( char *title, char *data, int size );
int hpss_dump ( INTEGER context, INTEGER flags )
{
    struct hpss_context *ctx;
    int status, remainder, seg, ctl_flags;
    struct { unsigned short status, count; long pid; } iosb;
    char *ptr;
    /*
     * dereference the handle
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) {
	fprintf(stderr,"hpss_dump called with bad context (addr=%x)\n",context);
        return SS$_BADPARAM;	/* invalid context */
    }
    ctl_flags = *flags;
    /*
     * Dump context block values.
     */
    fprintf(stderr, "Context %d, dump:\n", ctx->id );
    if ( ctx->msglen < sizeof(ctx->msg.comhdr) ) {
	fprintf ( stderr, "  Warning, current message length too short\n");
    } else {
	/*
	 * Display the communication header data
	 */
	char subfunc[64], method[64], *text;
	int length, off, k;
        fprintf(stderr, "  out mbx: MBA%d:, in mbx: MBA%d: (%s),",
	    ctx->msg.comhdr.out_mbx, ctx->msg.comhdr.in_mbx, 
	   (ctx->msg.comhdr.out_mbx == ctx->msg.comhdr.in_mbx) ? "none" : "valid" );
	text = (char *) 0;
	for ( k = 2; k < (ctx->msglen/4); k++ ) {
	    if ( ctx->msg.def[k].nlen == 0 ) {
		text = &ctx->msg.data[(k+1)*sizeof(ctx->msg.def[0])];
	    }
	}
	if ( text ) {
	    length = ctx->msg.comhdr.func;
	    if ( length > 63 ) length = 63;
	    strncpy ( subfunc, text, length );
	    subfunc[length] = '\0';
	    length = ctx->msg.comhdr.method;
	    if ( length > 63 ) length = 63;
	    strncpy ( method, &text[ctx->msg.comhdr.func], length );
	    method[length] = '\0';
	    fprintf(stderr, "  Sub-func: '%s' (%d), method: '%s' (%d)\n",
	       subfunc, ctx->msg.comhdr.func, method, ctx->msg.comhdr.method );

	} else fprintf(stderr," invalid def table!\n" );
    }
    if ( ctl_flags&1 ) {
	fprintf(stderr,"  current msglen = %d\n", ctx->msglen );
        hex_dump ( "  raw message buffer", ctx->msg.data, ctx->msglen );
    }
    if ( ctl_flags&2 ) {
	fprintf(stderr,"  current content_used = %d, alloc=%d, pos=%d\n", 
		ctx->content_used, ctx->content_alloc, ctx->content_pos );
	if ( ctx->content_used > 0 ) hex_dump ( "  raw content",
		ctx->content, ctx->content_used );
    }
    if ( ctl_flags&4 ) {
	dump_table ( "  CGI variable table", &ctx->var );
    }
    if ( ctl_flags&8 ) {
        if ( ctx->form.size == 0 ) {
	    load_form_table ( ctx );
        }
	if ( ctx->form.size == 0 ) fprintf(stderr,
		"No content to decode form data from\n");
	else dump_table ( "  Decoded form table", &ctx->form );
    }
    return 1;
}
/*
 * list table entries.
 */
 static void dump_table ( char *title, struct sym_table *table )
{
    int i, length;
    fprintf(stderr,"%s, alloc=%d entries, size=%d entries, addr: %x\n", title,
	table->allocation, table->size, table->def );
    for ( i = 0; i < table->size; i++ ) {
	char sym_name[256], sym_val[2048];
	length = table->def[i].nlen;
	if ( length >= sizeof(sym_name) ) length = sizeof(sym_name)-1;
	strncpy ( sym_name, table->def[i].name, length );
	sym_name[length] = '\0';
	length = table->def[i].vlen;
	if ( length >= sizeof(sym_val) ) length = sizeof(sym_val)-1;
	strncpy ( sym_val, table->def[i].value, length );
	sym_val[length] = '\0';
	fprintf ( stderr, "    %s (%d) = '%s' (%d)\n", sym_name, 
	   table->def[i].nlen, sym_val, table->def[i].vlen );
    }
}
/*
 * Display the contents of a buffer is hex form and ascii (displaying
 * non-printable chars to '.'.
 *
 * Line format:
 *    00 01 ... 16 "................" 0000
 */
#define HX_START 52
static void hex_dump ( char *title, char *data, int size )
{
     char line[120];
     int i, j, count, start;
     fprintf(stderr, "%s, %d bytes starting at %x\n", title, size, data );

     for ( i = 0; i < size; i += 16 ) {
	memset ( line, ' ', 80 );	/* blank the line */
	count = 16;			/* number to show */
	if ( (i+count) > size ) count = size-i;
	start = HX_START - (count*3);
	for ( j = i+count-1; j >= i; j-- ) {
	    sprintf ( &line[start], " %02x", data[j] );
	    start += 3;
	}
	strcpy ( &line[HX_START], " \"................\"" );
	for ( j = 0; j < count; j++ ) {
	    if ( (data[i+j] >= ' ') && (data[i+j] <= '~') )
		line[HX_START+2+j] = data[i+j];
	}
	fprintf ( stderr, "%s %04x\n", line, i );
     }  
}
/****************************************************************************/
/* Pool manager functions.
 *
 * Special functions for use by a dynamic pool manager, a SS$_BADPARAM status
 * will be returned if the hpps context is not the pool master (/POOL=MASTER).
 * 
 * reset_pool_lock clears the counters in the lock value block and returns
 * the previous setting for waits and accepts (automatically incremented
 * by the worker process's hpss_accept calls).  A worker increments short_waits
 * if the time it waited for a new connection is less than or equal to
 * the short_wait_threshold value in milliseconds.  The manager uses this
 * routine to determine the rate at which the workers are servicing requests
 * and if the HPSS client is being slowed by lack of available workers.
 *
 * Reduce_pool_workers signals the next count number of workers that call
 * hpss_accept to rundown themselve.  The pool manager uses this function
 * to winnow out extra workers created in response to a temporary increase
 * in demand.
 */
int hpss_reset_pool_lock ( INTEGER context, 
	INTEGER short_wait_threshold, INTEGER short_waits, INTEGER accepts )
{
    struct hpss_context *ctx;
    int status;
    /*
     * dereference the handle and check we are in right mode.
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) return SS$_BADPARAM;	/* invalid context */
    if ( ctx->dynamic_pool != 2 ) return SS$_BADPARAM;
    /*
     * Read current value of lock value block.
     */
    status = SYS$ENQW ( 0, LCK$K_PWMODE, &ctx->lksb,
	    LCK$M_CONVERT|LCK$M_VALBLK, 0, 0, 0, 0, 0, 0, 0 );
    if ( (status&1) == 1 ) status = ctx->lksb.status;
    if ( status&1 ) {
	/*
	 * Read and clear old values.
	 */
	ctx->lksb.short_wait_threshold = *short_wait_threshold;
	*short_waits = ctx->lksb.short_waits;
	ctx->lksb.short_waits = 0;
	*accepts = ctx->lksb.accepts;
	ctx->lksb.accepts = 0;
	/*
	 * Lower lock back to CR to update the value block.
	 */
	status = SYS$ENQW ( 0, LCK$K_CRMODE, &ctx->lksb,
	    LCK$M_CONVERT|LCK$M_VALBLK, 0, 0, 0, 0, 0, 0, 0 );
	if ( (status&1) == 1 ) status = ctx->lksb.status;
    }
}
int hpss_reduce_pool_workers ( INTEGER context, INTEGER count )
{
    int i, status;
    struct hpss_context *ctx;
    /*
     * dereference the handle and check we are in right mode.
     */
    ctx = lookup_context ( *context );
    if ( !ctx ) return SS$_BADPARAM;	/* invalid context */
    if ( ctx->dynamic_pool != 2 ) return SS$_BADPARAM;
    /*
     * Simply write EOF messages to mailbox.  CAUTION, deadlock is possible.
     */
    for ( status = 1, i = *count; (i > 0) && (status&1); --i ) {
	struct { unsigned short status, count; long pid; } iosb;
	status = SYS$QIOW ( 0, ctx->channel, IO$_WRITEOF|IO$M_NOW, &iosb,
		0, 0, 0, 0, 0, 0, 0, 0 );
	if ( status&1 ) status = iosb.status;
    }
    return status;
}
