/*
 *     H i g h   P e f o r m a n c e   S c r i p t   S e r v i c e   M S T
 *
 * This shareable image module provides an simplified interface to allow
 * continuously running applications to respond to CGI (common gateway
 * interface) script requests.  By eliminating the image activation and
 * program initialization (openning databases, etc) the HPSS application
 * can service the request much faster than a conventional CGI script.
 *
 * Use the following rules in the configuration file to load this module and 
 * bind an exec path to it:
 *
 *    ThreadPool hpss stack=120000 q_flag=1 limit=4
 *    Service hpss pool=test dynamic=(HPSS,http_hpss_mst) info=hpss_srv_*
 *    Exec /$hpss_exec/* %hpss:
 *
 * You may also use an alternate exec rule style or presentation script where
 * you 'hard-code' the application name by including it following the service 
 * name:
 *
 *    Exec /$hpss_xxx/* %hpss:hpss_srv_xxx
 *
 *    suffix .hpss application/hpss BINARY
 *    presentation application/hpss %hpss:hpss_app_xxx
 *
 * The ThreadPool rule defines a pool of MSTs (message-based service
 * threads) for servicing requests.  The service rule defines the
 * service 'hpss', assigning it to pool 'hpss' and setting it's
 * MST start routine as 'hpss' in image http_hpss_mst (image is assumed
 * to be in directory WWW_SYSTEM).  The info parameter on the service
 * rule specifies a comma-separated list of permitted application names
 * (with wildcards). The Exec rule makes it so that URL paths 
 * beginning with '/$hpss_exec/' will invoke the hpss scriptserver,
 * the percent and colon are a special syntax to indicate an MST-based
 * script rather than a DECnet-based script.
 *
 * Author: David Jones
 * Date:   4-FEB-2000
 * Revised: 9-FEB-2000		Modify fatal_abort() to rundown all resources.
 * Revised: 11-MAY-2001		Look for service mailbox logicals in
 *				HPSS_SERVICE_TABLE name table.
 */
#include "pthread_1c_np.h"
#include <stdio.h>
#include <stdlib.h>
#include <cmbdef.h>			/* VMS mailbox flags */
#include <descrip.h>			/* VMS string descriptors */
#include <dcdef.h>
#include <dvidef.h>			/* VMS device info */
#include <iodef.h>			/* QIO funciton codes */
#include <lnmdef.h>
#include <ssdef.h>
#include <ossdef.h>
#include <acedef.h>
#include "mst_share.h"
#include "tutil.h"
#include "hpss_msg.h"
int SYS$DASSGN(), SYS$CANCEL(), SYS$SET_SECURITY();
/* If the ssdef.h is out of date, hard code new values */
#ifndef SS$_NOREADER
#define SS$_NOREADER 0x024c4
#define SS$_NOWRITER 0x024cc
#endif
/*
 * Define global structures.
 */
static pthread_mutex_t mbx_list;
static pthread_mutex_t mbx_io;
struct mailbox {
    struct mailbox *next;
    unsigned short channel;
    unsigned short ef;
    struct {
	unsigned short status;
	unsigned short count;
	long pid;
    } iosb;
    pthread_cond_t done;
    unsigned long owner;
};
struct service_mbx {
    struct service_mbx *next;
    char name[64];		/* upcased for case-blind compares */
    unsigned short channel;
    unsigned short unit;
    unsigned long owner;
};
struct mailbox_name {
    struct mailbox_name *next;
    char *name;
};
static struct mailbox *free_mbx;
static struct service_mbx *known_service_mbx;
static struct mailbox_name *auto_mailboxes;
static int connect_timeout = 0;		/* timeout seconds. */
/***************************************************************************/
/* Mailbox I/O support functions.
 */
static int expand_free_mbx ( int count )
{
    /*
     * Allocate count mailbox structs and add to free_mbx list, assume
     * caller holds mbx_list mutex.
     */
    struct mailbox *new;
    int i;

    if ( count <= 0 ) return 0;
    LOCK_C_RTL
    new = (struct mailbox *) malloc ( count*sizeof(struct mailbox) );
    UNLOCK_C_RTL
    if ( !new ) return 0;
    for ( i = 0; i < count; i++ ) {
	new[i].next = &new[i+1];
	new[i].ef = 8;
	INITIALIZE_CONDITION ( &new[i].done );
	SET_COND_NAME ( &new[i].done, "OSU HPSS mailbox" )
    }
    new[count-1].next = free_mbx;
    free_mbx = new;

    return 1;		/* success */
}

/*
 * use getdvi serviceto determine unit number.
 */
static int get_mailbox_info ( struct mailbox *mbx, unsigned short *unit,
	int *is_mbx, unsigned long *uic )
{
    int SYS$GETDVI(), status, lunit, devsts;
    int iosb[2];
    /*
     * Setup for GETDVI to get unit number and status.
     */
    struct { short length, code; void *buffer; int *retlen; } item[4];
    item[0].length = sizeof(lunit);
    item[0].code = DVI$_UNIT;
    item[0].buffer = &lunit;
    item[0].retlen = 0;
    item[1].length = sizeof(devsts);
    item[1].code = DVI$_DEVCLASS;
    item[1].buffer = &devsts;
    item[1].retlen = 0;
    item[2].length = sizeof(unsigned long);
    item[2].code = DVI$_OWNUIC;
    item[2].buffer = uic;
    item[2].retlen = 0;
    item[3].length = item[3].code = 0;	/* end of list */

    pthread_mutex_lock ( &mbx_io );
    status = SYS$GETDVI ( mbx->ef, mbx->channel, 0, item, &mbx->iosb, 
	pthread_cond_signal_int_np, &mbx->done, 0 );
    if ( (status&1) == 1 ) {
	while ( mbx->iosb.status == 0 ) {
	    pthread_cond_wait ( &mbx->done, &mbx_io );
	}
    }
    pthread_mutex_unlock ( &mbx_io );
    if ( (status&1) == 1 ) {
	*unit = lunit;
	*is_mbx = (devsts == DC$_MAILBOX) ? 1 : 0;
    } else *is_mbx = 0;
    return status;
}

/*
 * Deassign channel and free mailbox structure.
 */
static void rundown_mailbox ( struct mailbox *mbx )
{
    SYS$DASSGN ( mbx->channel );
    pthread_mutex_lock ( &mbx_list );
    mbx->next = free_mbx;
    free_mbx = mbx;
    pthread_mutex_unlock ( &mbx_list );
}

static struct mailbox *get_service_mailbox ( char *name )
{
    /*
     * Lock the shared data structures and search for match.
     */
    char match_name[64];
    struct service_mbx *srv;
    struct mailbox *mbx;
    int is_new;

    tu_strnzcpy ( match_name, name, sizeof(match_name)-1 );
    pthread_mutex_lock ( &mbx_list );
    for ( srv = known_service_mbx; srv; srv = srv->next ) {
	if ( tu_strncmp(match_name, srv->name, sizeof(match_name)) == 0 ) break;
    }
    is_new = 0;
    if ( !srv ) {
	/*
	 * Name not found, attempt to assign channel to mailbox.
	 */
	int status, SYS$ASSIGN(), SYS$TRNLNM();
	unsigned short channel, unit;
	static $DESCRIPTOR(logical_name_dx,"");	  /* locked by mutex */
	static $DESCRIPTOR(service_table,"HPSS_SERVICE_TABLE");
	static char equiv_name[256];
	static int service_table_status = 0;
	static struct { short length, code; char *buffer;
		int *retlen, listend; } item_list;

	logical_name_dx.dsc$a_pointer = name;
	logical_name_dx.dsc$w_length = tu_strlen ( name );
	if ( service_table_status < 2 ) {
	    /*
	     * See if mailbox name exists in the special HPSS_SERVICE_TABLE
	     * logical name table and replace.
	     */ 
	    int flags, equiv_len;
	    flags = LNM$M_CASE_BLIND;

	    equiv_len = 0;
	    item_list.length = sizeof(equiv_name)-1;
	    item_list.code = LNM$_STRING;
	    item_list.buffer = equiv_name;
	    item_list.retlen = &equiv_len;
	    item_list.listend = 0;
	
	    status = SYS$TRNLNM ( &flags, &service_table,
		&logical_name_dx, 0, &item_list );
	    tlog_putlog ( 5,
		"Status of lookup in HPSS_SERVICE_TABLE: !SL!/", status );

	    if ( status == SS$_NORMAL ) {
		/* Found match in table, replace logical name */
		service_table_status = 1;	/* table good */
		logical_name_dx.dsc$a_pointer = equiv_name;
		logical_name_dx.dsc$w_length = equiv_len;
	    } else if ( status = SS$_IVLOGTAB ) {
		/* No table exists, stop trying. */
		service_table_status = 2;
	    } else if ( service_table_status == 0 ) {
		service_table_status = 1;
	    }
	}
	/*
	 * Assign channel writeonly so we can detect absence of readers.
	 */
	status = SYS$ASSIGN ( &logical_name_dx, &channel, 0, 0,
		CMB$M_WRITEONLY );
	if ( (status&1) ) is_new = 1;
	/*
	 * Allocate and initialize new mailbox definition if found.
	 */
	if ( (status&1) ) {
	    LOCK_C_RTL
	    srv = (struct service_mbx *) malloc ( sizeof(struct service_mbx) );
	    UNLOCK_C_RTL
	} else srv = (struct service_mbx *) 0;
	if ( srv ) {
	    tu_strcpy ( srv->name, match_name );
	    srv->next = known_service_mbx;
	    srv->channel = channel;
	    known_service_mbx = srv;
	    srv->owner = 0;
	} else {
	}
    }
    /*
     * Allocate a mailbox structure and init with service mailbox data.
     */
    if ( !free_mbx ) expand_free_mbx ( 10 );
    if ( free_mbx && srv ) {
	mbx = free_mbx;
	free_mbx = mbx->next;
	mbx->channel = srv->channel;
    } else {
	mbx = (struct mailbox *) 0;
    }
    /*
     * if this was a new assign, make sure the logical we conneted to
     * to is really a mailbox.
     */
    if ( is_new && mbx ) {
	unsigned short unit;
	int is_mbx, status;

	status = get_mailbox_info ( mbx, &unit, &is_mbx, &srv->owner );
	if ( (status&1) && !is_mbx ) {
	    /*
	     * Unhook the service, since we still have mutex we known
	     * we are still first in list.
	     */
	    tlog_putlog(0,"hpss service logical '!AZ' not a mailbox.!/",
			name );
	    known_service_mbx = srv->next;
	    LOCK_C_RTL
	    free ( srv );
	    UNLOCK_C_RTL
	    SYS$DASSGN ( mbx->channel );
	    mbx->next = free_mbx;
	    free_mbx = mbx;
	    mbx = (struct mailbox *) 0;
	}
    }
    if ( mbx ) mbx->owner = srv->owner;
    pthread_mutex_unlock ( &mbx_list );
    return mbx;
}
/*
 * Mailbox types:
 *    0 - 'output' mailbox, we read from this.
 *    1 - 'input' mailbox, we write to this.
 */
static struct mailbox *create_mailbox ( int type, unsigned short *unit,
	unsigned long uic )
{
    struct mailbox *mbx;
    int SYS$CREMBX(), status, devsts, is_mbx, bufquo;
    unsigned short channel;
    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;
    /*
     * Attempt to create mailbox and get unit number.  Set that mailbox
     * to read only (service process writes to us).
     */
    bufquo = 4096;
    status = SYS$CREMBX ( 0, &channel, bufquo, bufquo, 0x0ff00, 0, 0,
	(type == 0) ? CMB$M_READONLY : CMB$M_WRITEONLY, 0 );
    if ( (status&1) == 0 ) return (struct mailbox *) 0;
   /*
    * Allocate a mailbox structure and initialize.
    */
    pthread_mutex_lock ( &mbx_list );
    if ( !free_mbx ) expand_free_mbx ( 10 );
    mbx = free_mbx;
    if ( free_mbx ) {
	free_mbx = mbx->next;
	mbx->channel = channel;
    } else {
	SYS$DASSGN ( channel );
    }
    pthread_mutex_unlock ( &mbx_list );
    /*
     * If mailbox created, get it's unit number.
     */
    if ( mbx ) {
	unsigned long my_uic;
	status = get_mailbox_info ( mbx, unit, &is_mbx, &my_uic );
	if ( (status&1) && uic && (my_uic != uic) ) {
	    /*
	     * New mailbox is owned by different UIC than target writer,
	     * add ACL to allow it access.
	     */
	    int channel2;
	    static $DESCRIPTOR(device,"DEVICE");

	    channel2 = channel;
	    ace.type = ACE$C_KEYID;
	    ace.length = sizeof(ace);
	    ace.flags = 0;
	    ace.access = 15;
	    ace.identifier = uic;
	    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(&device, 0, &channel2, 0, &item, 0, 0);
	    if ( http_log_level > 7 ) tlog_putlog ( 8,
		"Set security on mailbox MBA!SL, status: %d!/", *unit, status );
        }
    }
    return mbx;
}
/*
 * Issue I/O and wait for completion.
 */
static int qio_and_wait ( struct mailbox *mbx, int func, void *p1, int p2 )
{
    int status, SYS$QIO();
    pthread_mutex_lock ( &mbx_io );
    status = SYS$QIO ( mbx->ef, mbx->channel, func, &mbx->iosb,
	pthread_cond_signal_int_np, &mbx->done, p1, p2, 0, 0, 0, 0 );
    if ( (status&1) == 1 ) {
	while ( mbx->iosb.status == 0 ) {
	    pthread_cond_wait ( &mbx->done, &mbx_io );
	}
	status = mbx->iosb.status;
    }
    pthread_mutex_unlock ( &mbx_io );
    return status;
}
static int qio_and_timedwait ( struct mailbox *mbx, int func, void *p1, int p2,
	struct timespec *expiration )
{
    int status, SYS$QIO();

    pthread_mutex_lock ( &mbx_io );
    status = SYS$QIO ( mbx->ef, mbx->channel, func, &mbx->iosb,
	pthread_cond_signal_int_np, &mbx->done, p1, p2, 0, 0, 0, 0 );
    if ( (status&1) == 1 ) {
	while ( mbx->iosb.status == 0 ) {
	    if (0 != pthread_cond_timedwait(&mbx->done, &mbx_io, expiration)) {
		/*
		 * Assume pthread error is timeout, abort the I/O and wait
		 * for cancelled I/O to complete.
		 */
		SYS$CANCEL ( mbx->channel );
		while ( mbx->iosb.status == 0 ) {
		    pthread_cond_wait ( &mbx->done, &mbx_io );
		}
	    }
	}
	status = mbx->iosb.status;
    }
    pthread_mutex_unlock ( &mbx_io );
    return status;
}
/***************************************************************************/
/* Build message to send to service mailbox from data in supplied envbuf.
 * The mailbox unit numbers in the comhdr section are set to zero.
 */
static int encode_envbuf ( struct mstshr_envbuf *env,
    union hpss_mbxmsg *msg, int *term_def, int *final_length )
{
     int ndx, i, length, j, dpos;
     /*
      * Buffer starts with the unit number of the output mailboxes
      * and input mailbox.  If no input mailbox needed then its unit
      * number will match the output mailbox unit number.
      */
     msg->comhdr.func = tu_strlen ( env->prolog[0] );
     msg->comhdr.method = tu_strlen ( env->prolog[1] );
     ndx = sizeof(msg->comhdr) / sizeof(msg->def[0]);
     /*
      * Following the header is the lengths for name/value CGI symbols.
      * List is terminated by a name length of zero.
      */
     for ( i = 0; i < env->count; i++ ) {
	/*
	 * parse the string pointed to by ptr[i] string into name and value
	 */
	char *s;
	s = env->ptr[i];
	for ( j = 0; s[j]; j++ ) {
	    if ( s[j] == '=' ) {
		if ( j == 0 ) continue;		/* invalid name, skip */
		msg->def[ndx].nlen = j;
		msg->def[ndx].vlen = tu_strlen ( &s[j+1] );
		ndx++;
		break;
	    }
	}
	if ( !s[j] ) {
	    /* equals not found, what to do? */
	    
	}
     }
     /*
      * Add list terminator.
      */
    *term_def = ndx;
    msg->def[ndx].nlen = 0;
    msg->def[ndx].vlen = 0;
    /*
     * Append text of 2 strings referenced in the header.
     */
    dpos = (ndx+1) * sizeof(msg->def[0]);	/* beginning offset */
    tu_strncpy ( &msg->data[dpos], env->prolog[0], msg->comhdr.func );
    dpos += msg->comhdr.func;
    tu_strncpy ( &msg->data[dpos], env->prolog[1], msg->comhdr.method );
    dpos += msg->comhdr.method;
    /*
     * Append text of the symbol table.
     */
    j = 0;
    for ( i = sizeof(msg->comhdr)/sizeof(msg->def[0]); i < ndx; i++ ) {
	tu_strncpy ( &msg->data[dpos], env->ptr[j], msg->def[i].nlen );
	dpos += msg->def[i].nlen;
	tu_strncpy ( &msg->data[dpos], &env->ptr[j][msg->def[i].nlen+1],
		msg->def[i].vlen );
	dpos += msg->def[i].vlen;
	j++;
    }
    *final_length = dpos;
    if ( dpos < sizeof(msg->data) )msg->data[dpos] = '\0';
    return 1;
}
/***************************************************************************/
/* Append request content to encoded message buffer.
 */
static int encode_content ( mst_link_t link, 
	int content_length, 
	int term_ndx,
	union hpss_mbxmsg *msg, int *msglen, 
	char **content_overflow, int *ov_len )
{
    int status, dpos, remaining, added;
    char *buffer;
    *ov_len = 0;
    /*
     * Check remaining room at tail of message buffer and either make the
     * buffer the tail part of the message buffer or allocate anew.
     */
    dpos = *msglen;		/* move into local variable */
    remaining = sizeof(msg->data) - dpos;
    if ( remaining  >= (content_length+256) ) {
	buffer = &msg->data[dpos];
    } else {
	/*
	 * Don't bother splitting into 2 pieces just yet, put all in
	 * 1 buffer.
	 */
	if ( content_length > 200000 ) content_length = 200000;
	LOCK_C_RTL
	*content_overflow = (char *) malloc ( content_length+256 );
	UNLOCK_C_RTL
	buffer = *content_overflow;
    }
    /*
     * Read client's data into the buffer we've chosen.
     */
    status = 1;
    added = 0;
    remaining = content_length;
    while ( remaining > 0 ) {
	int length;
	/*
	 * Tell server to send next bit of content and read it.
	 * We allocated an extra 256 byte so we know we can read that
	 * amount.
	 */
	status = mst_write ( link, "<DNETINPUT>", 11, &length );
	if ( (status&1) == 0 ) break;
	status = mst_read ( link, &buffer[added], 255, &length );
	if ( (status&1) == 0 ) break;
	added += length;
	remaining = remaining - length;
    }
    /*
     * Trim back the logical ammount if we overshot.
     */
    if ( remaining < 0 ) {
	added = added + remaining;    /* adding a negative subtracts */
	if ( (http_log_level > 0) || (remaining < 2) ) tlog_putlog(1,
	    "HPSS content encode trimmed !SL bytes of data, %!D!/",
		-remaining, 0 );
    }
    /*
     * Update terminating entry of var table to show appended data.
     */
    if ( buffer == &msg->data[dpos] ) {
	msg->def[term_ndx].vlen = added;
        *msglen = dpos + added;
    } else {
	*ov_len = added; 
    }
    if ( remaining > 0 ) {
	/* Not all data read. */
	return 0;
    }
    return 1;
}
/***************************************************************************/
/* Every dynamically loaded service must have an INIT routine, which is
 * called once during the processing of the Service rule to initialize
 * static structures needed by the MST.  By default the init routine
 * name is the start routine + the string _init, and 'init=name' clause
 * on the service rule will override the default.
 *
 * Arguments:
 *    mst_linkage vector  Structure containing addresses of essential
 *			items wee need from main program, such as
 *			address of putlog() routine.
 *
 *    char *info	Administrator provided argument (info=).
 *
 *    char *errmsg	Error text for log file when error status returned.
 */
int HPSS_INIT ( mst_linkage vector, char *info, char *errmsg )
{
   char *timeout_string;
   /*
    * The first thing any init routine must do is call mstshr_init() to
    * initialize global variables declared in mst_share.h.  The callback
    * vector includes a version number which mstshr_init checks to make
    * sure the vector format being used by the server hasn't changed.
    * If mstshr_init fails, we can't proceed so return immediately.
    */
   if ( (1&mstshr_init ( vector, info, errmsg )) == 0 ) return 0;
   /*
    * Now do any initialization specific to this shareable image.
    * The info argument is an optional string that can be specified
    * on the service rule using 'info=string'
    *
    * Any errors should place a text message describing the error in errmsg (up 
    * to 255 characters) and return an even (i.i. error) status code.
    *
    * Initialize the mutexes.
    */
    INITIALIZE_MUTEX ( &mbx_list );
    SET_MUTEX_NAME ( &mbx_list, "OSU HPSS mailbox list" )
    INITIALIZE_MUTEX ( &mbx_io );
    SET_MUTEX_NAME ( &mbx_io, "OSU HPSS I/O" )
    /*
     * Initialize global lists:
     *   known_service_mbx  list of service mailboxes to which we currently
     *	 		    have channels assigned.
     *
     *   free_mbx           Lookaside list of mailbox structures for handling
     *                      I/O to mailboxes (service, input, output).
     *
     *   auto_mailboxes     List of permitted mailbox names for 'auto'
     *      		    mode selection (info=*).
     */
    known_service_mbx = (struct service_mbx *) 0;
    free_mbx = (struct mailbox *) 0;
    auto_mailboxes = (struct mailbox_name *) 0;
    if ( (1&expand_free_mbx ( 10 )) == 0 ) {
	tu_strcpy ( errmsg, "hpss failed to initialize free mailbox list" );
    } else {
        /*
         * Return success status.
         */
        tu_strcpy ( errmsg, "hpss scriptserver sucessfully initialized" );
    }
    /*
     * Check environment variable to see if user wants a connection time.
     * (Connection timeouts improve robustness but signifcantly increase
     * the number of QIO's to the mailbox driver.
     */
    LOCK_C_RTL
    timeout_string = getenv ( "HPSS_CONNECT_TIMEOUT" );
    if ( timeout_string ) {
	connect_timeout = atoi ( timeout_string );
    }
    UNLOCK_C_RTL
    /*
     * Parse info and build list of auto mailbox names if present.
     */
    if ( info ) if ( *info  && (*info != ' ') ) {
	char *list;
	int i, start;
	struct mailbox_name *last, *mname;

	LOCK_C_RTL
	list = malloc ( tu_strlen(info) + 1 );
	UNLOCK_C_RTL
	if ( !list ) return 20;
	tu_strupcase ( list, info );		/* make test case insensitive */
	last = (struct mailbox_name *) 0;
	for ( start = i = 0; 1; i++ ) if ( !list[i] || (list[i] == ',') ) {
	    mname=(struct mailbox_name *) malloc(sizeof(struct mailbox_name));
	    if ( !mname ) break;
	    mname->next = (struct mailbox_name *) 0;
	    mname->name = &list[start];
	    if ( last ) last->next = mname;
	    else auto_mailboxes = mname;
	    last = mname;

	    if ( !list[i] ) break;
	    list[i] = '\0';
	    start = i+1;
	}
    }
    return 1;
}
/***************************************************************************/
/* State machine to detect when end of CGI header occured.
 *
 * states:
 *    0  looking for end of line (CR or LF).
 *    1  looking for LF after CR
 *    2  looking for CR-LF-CR or CR-LF-LF.
 *    3  looking for LF after CR-LF-CR sequence.
 */
static int update_cgi_header_state ( int old_state, char *buffer, int bufsize )
{
    int i, state;
    char octet;
    state = old_state;
    for ( i = 0; i < bufsize; i++ ) {
	octet = buffer[i];
	switch ( state ) {
	    case 0:
		if (octet == '\n') state = 2;
		if ( octet == '\r' ) state = 1;
		break;
	    case 1:
		if ( octet != '\n' ) state = 0;
		else state = 2;
		break;
	    case 2:
		if ( octet == '\n' ) return 4;		/* done */
		if ( octet == '\r' ) state = 3;
		else state = 0;
		break;
	    case 3:
		if ( octet == '\n' ) return 4;
		state = 0;
		break;
	    default:
		return 4;
	}
    }
}

static void fatal_abort ( mst_link_t link, char *stsline, char *message,
	struct mailbox *in_mbx, struct mailbox *out_mbx, char *ov_content )
{
    int length;
    /*
     * Send plaintext response with error message.
     */
    mst_write ( link, "<DNETTEXT>", 10, &length );
    mst_write ( link, stsline, tu_strlen(stsline), &length );
    mst_write (link, message, tu_strlen(message), &length);
    mst_write ( link, "</DNETTEXT>", 11, &length );
    /*
     * Rundown the resources (caller always returnes immediately after
     * calling us).
     */
    mst_close ( link );
    if ( in_mbx ) rundown_mailbox ( in_mbx );
    if ( out_mbx ) rundown_mailbox ( out_mbx );
    if ( ov_content ) {
	LOCK_C_RTL
	free ( ov_content );
	UNLOCK_C_RTL
    }
}
/***************************************************************************/
/* Main routine to handle client requests.  To the server, this routine
 * must behave like a DECnet scriptserver task (e.g. WWWEXEC) only messages 
 * are transferred via mst_read() and mst_write() rather than $QIO's to a 
 * logical link.
 *
 * Arguments:
 *    mst_link_t link	Connection structure used by mst_read(), mst_write().
 *
 *    char *service	Service name (for logging purposes).
 *
 *    char *info	Script-directory argument from 'exec' rule that
 *			triggered the MST (exec /path/* %service:info).
 *
 *    int ndx		Service thread index, all services sharing same pool
 *			share the same thread index numbers.
 *
 *    int avail		Number of remaining threads in pool assigned to service.
 */
int HPSS ( mst_link_t link, char *service, char *info, int ndx, int avail )
{
    int i, j, status, length, msglen, term_ndx, flags, ov_len, state;
    char *classname, *cl_str, *content_overflow, line[512], outbuf[4096];
    struct mstshr_envbuf env;
    struct mailbox *in_mbx, *out_mbx, *srv;
    union hpss_mbxmsg msg;
    struct timespec delta, expiration;
    /*
     * Log that we began execution
     */
    if ( http_log_level > 0 ) tlog_putlog ( 1, 
      "Service!AZ/!SL connected, info: '!AZ', pool remaining: !SL tmo: !SL!/", 
	service, ndx, info, avail, connect_timeout );
    /*
     * Setup cgi environment (reads prologue as a consequence).
     */
    status = mstshr_cgi_symbols ( link, info, &env );
    if ( http_log_level > 5 ) tlog_putlog ( 6,
	"Service!AZ/!SL cgi symbol status: !SL!/", service, ndx, status);
    if ( (status &1) == 0 ) return 0;
    in_mbx = (struct mailbox *) 0;
    out_mbx = (struct mailbox *) 0;
    content_overflow = (char *) 0;
    /*
     * Locate existing channel to mailbox specified by info argument or
     * create a new one.
     */
    if ( *info == '\0' ) {
	/*
	 * Mailbox to use is determined by 'script_name' port of the
	 * URL.  Name chosen by the client must match against mailbox list
	 * specified in the configuration file service rule.
	 */
	char mbx_name[64], *script_name, *last_slash;
	struct mailbox_name *pattern;
	script_name = mstshr_getenv ( "SCRIPT_NAME", &env );
	if ( !script_name ) {
	    fatal_abort ( link, "500 internal error",
		"Unexpected error: SCRIPT_NAME variable undefined.",
		in_mbx, out_mbx, content_overflow );
	    return 20;
	}
	last_slash = (char *) 0;
	for ( i = 0; script_name[i]; i++ ) 
	   if ( script_name[i] == '/' ) last_slash = &script_name[i];
	if ( last_slash ) 
		tu_strnzcpy ( mbx_name, last_slash+1, sizeof(mbx_name)-1 );
	else tu_strnzcpy ( mbx_name, script_name, sizeof(mbx_name)-1 );
	/*
	 * See if mailbox name allowed.
	 */
	tu_strupcase ( mbx_name, mbx_name );
	for ( pattern = auto_mailboxes; pattern; pattern = pattern->next ) {
	    int result;
	    result = tu_strmatchwild ( mbx_name, pattern->name );
	    if ( http_log_level > 5 ) tlog_putlog ( 6,
		"Service!AZ/!SL mbx name '!AZ' !AZ match '!AZ'!/",
		service, ndx, mbx_name,  
		result ? "doesn't" : "DOES", pattern->name );
	    if ( result == 0 ) break;
	}
	if ( !pattern ) {
	    fatal_abort ( link, "404 bad script name",
		"No match on requested script name.",
		in_mbx, out_mbx, content_overflow );
	    return 20;
	}
	srv = get_service_mailbox ( mbx_name );

    } else {
       /*
        * Mailbox to use is hardcoded in the configuration file exec or
	* presentation rule.
	*/
       srv = get_service_mailbox ( info );
    }
    if ( !srv ) {
	/*
	 * error assigning channel, likely cause is that service process
	 * that is supposed to create the mailbox failed to start.
	 */
	fatal_abort ( link, "500 service mailbox not found",
	    "Could not connect to service mailbox - service not started.",
		in_mbx, out_mbx, content_overflow );
	return 1;
    }
    /*
     * Create mailbox that will receive the script output and load into
     * message.
     */
    out_mbx = create_mailbox ( 0, &msg.comhdr.out_mbx, srv->owner );
    msg.comhdr.in_mbx = msg.comhdr.out_mbx;
    /*
     * Build message that bundles up the CGI variables.
     */
    if ( 1 != encode_envbuf ( &env, &msg, &term_ndx, &msglen ) ) {
	/*
	 * Error encoding message, abort.
	 */
	fatal_abort ( link, "500 Error formatting message",
	    "Internal error in message formatting",
	    in_mbx, out_mbx, content_overflow );
	return 0;
    }
    /*
     * Check if client is providing content.
     */
    cl_str = mstshr_getenv ( "CONTENT_LENGTH", &env );
    if ( cl_str ) {
	int content_length;

	LOCK_C_RTL
	content_length = atoi ( cl_str );
	UNLOCK_C_RTL
	if ( content_length > 0 ) {
	    /*
	     * Add as much content as we can to message, anything else will be
	     * sent via a specially created mailbox.
	     */
	    if ( http_log_level > 7 ) tlog_putlog ( 8,
		"Service!AZ/!SL encoding !SL byte!%S of content starting msglen: !SL!/", 
		service, ndx, content_length, msglen );
	    status = encode_content ( link, content_length, term_ndx,
		&msg, &msglen, &content_overflow, &ov_len );
	    if ( (status&1) == 0 ) {
		fatal_abort ( link, "500 Error encoding content",
		    "Internal error in server reading content",
		    in_mbx, out_mbx, content_overflow );
		return status;
	    }

	    if ( http_log_level > 7 ) tlog_putlog ( 8,
		"Service!AZ/!SL encode content status: !SL, msglen: !SL, overflow: !SL!/",
		service, ndx, status, msglen, ov_len );
	    if ( ((status&1) == 1) && (ov_len > 0) ) {
		in_mbx = create_mailbox ( 1, &msg.comhdr.in_mbx, srv->owner );
		if ( !in_mbx ) {
		    fatal_abort ( link, "500 error creating input mailbox",
			"Internal error in server creating input mailbox",
			in_mbx, out_mbx, content_overflow );
		    return 0;
		}
	    }
	}
    }
    /*
     * Send message to service, check for no readers.
     */
    status = qio_and_wait ( srv, IO$_WRITEVBLK | IO$M_READERCHECK,
	    msg.data, msglen );
    if ( http_log_level > 5 ) tlog_putlog ( 6,
	"Service!AZ/!SL mbx write: !SL msglen: !SL!/", service, ndx, 
	status, msglen );
    if ( (status&1) == 0 ) {
	unsigned short unit; int is_mbx, status2;  unsigned long uic;
	status2 = get_mailbox_info ( srv, &unit, &is_mbx, &uic );
	if ( (status2&1) == 1 ) tlog_putlog(0,
		"Failed to write to mailbox MBA!SL: status = !SL!/", unit, status );
	fatal_abort ( link, "500 write error to service mailbox",
	    (status == SS$_NOREADER) ?
	    "No readers assigned to service mailbox - service not running." :
	    "Could not issue write to service mailbox, check protection.",
		in_mbx, out_mbx, content_overflow );
	return 1;
    }
    /*
     * Send extra data if it didn't fit in the message (extra mailbox
     * unit present.
     */
    delta.tv_sec = connect_timeout;
    delta.tv_nsec = 0;
    if ( delta.tv_sec > 0 ) if ( 0 != pthread_get_expiration_np ( &delta, 
		&expiration ) ) {
	delta.tv_sec = 0;
    }
    if ( msg.comhdr.out_mbx != msg.comhdr.in_mbx ) {
	int i, seg;
	flags = 0;
	if ( delta.tv_sec > 0 ) {
	    /*
	     * Wait up to connect_timeout seconds for for application to 
	     * process service message and assign channel to input mailbox.
	     */
	    status = qio_and_timedwait ( in_mbx, IO$_SETMODE|IO$M_READERWAIT,
		0, 0, &expiration );
	    flags = IO$M_READERCHECK;
	}
	for ( i = 0; i < ov_len; i += seg ) {
	    seg = ov_len - i;
	    if ( seg > 4096 ) seg = 4096;
	    status = qio_and_wait ( in_mbx, IO$_WRITEVBLK | flags,
		&content_overflow[i], seg );
	    flags = IO$M_READERCHECK;
	    if ( http_log_level > 7 ) tlog_putlog( 8,
		"Wrote content to mailbox unit !SL, sts=!SL i=!SL!/",
		msg.comhdr.in_mbx, status, i );
	    if ( (status&1) == 0 ) break;
	}
	/*
	 * Cleanup.  Recompute timeout time so content transfer doesn't
	 * count against the timeout time.
	 */
	rundown_mailbox ( in_mbx );
	in_mbx = (struct mailbox *) 0;
	if ( delta.tv_sec > 0 ) {
	    pthread_get_expiration_np ( &delta, &expiration );
	}
	LOCK_C_RTL
	free ( content_overflow );
	UNLOCK_C_RTL
	content_overflow = (char *) 0;
    }
    /*
     * Place mst link in CGI mode and relay data from script to client.
     */
    mst_write ( link, "<DNETCGI>", 9, &length );

    flags = 0;
    state = 0;
    if ( delta.tv_sec > 0 ) {
	/*
	 * Wait for application to assign channel to output mailbox, limit
	 * the wait so if application dies we don't hang forever.
	 */
	status = qio_and_timedwait ( out_mbx, IO$_SETMODE|IO$M_WRITERWAIT,
		0, 0, &expiration );
	flags = IO$M_WRITERCHECK;
    }
    while ( (status&1) == 1 ) {
	/*
	 * Get next output buffer written by application to the output mailbox.
	 * After first message received, check for abnormal disconnects.
	 */
	status = qio_and_wait ( out_mbx, IO$_READVBLK|flags,
		 outbuf, sizeof(outbuf) );
	if ( (status&1) == 0 ) break;
	flags = IO$M_WRITERCHECK;
	if ( state < 4 ) {
	    /*
	     * The CGI header processor limits writes to 1000 bytes
	     * (size of stream buffer) until the header has been sent.
	     * Break into 1000 byte chunks until end of cgi header seen.
	     */
	    for ( i=0; (status&1) && (i < out_mbx->iosb.count); i+=length ) {
		int seg;
		seg = out_mbx->iosb.count - i;
		if ( (state < 4) && (seg > 1000) ) seg = 1000;
	        state = update_cgi_header_state ( state, &outbuf[i], seg );
		status = mst_write ( link, &outbuf[i], seg, &length );
	    }
	} else {
	    /*
	     * Pass response data on to client thread.
	     */
	    status = mst_write ( link, outbuf, out_mbx->iosb.count, &length );
	    if ( (status&1) && (length != out_mbx->iosb.count) ) 
		tlog_putlog ( 0, "Truncated write to MST link !SL/!SL!/",
		length,out_mbx->iosb.count );
	}
    }
    /*
     * Cleanup.
     */
    status = mst_write ( link, "</DNETCGI>", 10, &length );
    rundown_mailbox ( out_mbx );

    mst_close ( link );
    return status;
}
