/*
 * This program is intended to be run by a HTTP server script in order to
 * convert the CGILIB environment to CLI symbols.  An optional argument
 * is a prefix string for the created symbols (default="WWW_").
 *
 * The HTTP request information is obtained by getting the values of P1, P2, 
 * and P3 (method, path, protocol).  The script running this program should 
 * not modify these symbols.
 *
 * Additional execution options are specifing a bitmask as an integer value
 * in parameter P4:
 *   bit 0 - If set, inhibit sending of <DNETCGI>
 *
 * This program puts the link to the HTTP server into CGI mode and flags
 * the environment so that WWWEXEC will automatically send the CGI terminator
 * when the DCL script exits.  Note that in the CGI mode, the writes to
 * net_link must explicitly include the carriage control.  The first line
 * output must be either and content-type: header or a location: header
 * followed by a blank line (newline sequence).
 *
 * Usage:
 *    cgi_symbols prefix [form_prefix [fld[=|>]file ...]]
 *    cgi_symbols prefix [form_prefix [@indirect-file ...]]
 *    cgi_symbols table [filename]		! filename must contain period
 *
 * If (and only if) you specify a form prefix as argument 2 on the command 
 * line, the program interprets the request contents as form input,creating a 
 * series of symbols for it. The symbols created will be (xxx is form_prefix):
 *
 *	xxxFIELDS		Comma-separated list of field names parsed
 *				from form input.  For every name in list
 *				a DCL symbol of form xxxFLD_name will be
 *				created.  Note that the form writer must
 *				garantee that the field names will result in
 *				valid DCL symbol names (e.g. no hyphens).
 *				This list is truncated to 255 characters.
 *
 *	xxxFLD_yyyy		Field value of field yyyy parsed from form
 *				input.  Value is truncated to 255 characters.
 *
 * If you specify a form prefix, additional command line arguments are
 * considered to be of the form "fld=file" or "fld>file" where 'fld' is the 
 * name of a form input field and 'file' is the name of a file to create into
 * which is written the contents of the field.  If the separator is '=', the
 * data is considered text and line delimiters will be replaced with a
 * cannocial LF.  A '>' separator will save the contents raw.  The value of 
 * the corresponding DCL symbol will be an integer containing the length of 
 * the field written.
 *
 * Since the command line arguments are limited to 255 characters total,
 * an alternate way to specify the "fld=file" arguments is via a separate
 * file specified on the command line by preceding the argument with an '@'
 * symbol.  Each line in the file is treated as a single command line
 * argument and processed the same as actual command line arguments with
 * the following differences:
 *     - Nesting of indirect files not allowed (i.e. no @filename).
 *     - Lines beginning with '!' are treated as comments and ignored.
 *     - Lines containing the DCL substitution character (') are parsed
 *       and the delimted symbol names replaced with the DCL symbol values.
 *       (Substitution characters preceded by ^ are treated as literal).
 *     - Maximum allowed line length, including symbol expansion, is 1023 
 *       characters.
 *
 * If you specify a filename as argument 2 on the command line, the request
 * content data (possible none) is saved in a file by that name and argument
 * 1 is a logical name table to save the environment variables in rather than
 * creating DCL symbols.
 *
 * Note that that maximum amount of content that can be received from
 * the client is limited by the value of the environment variable
 * WWW_MAX_CGILIB_CONTENT, usually set in HTTP_STARTUP.COM.  When parsing
 * form data, the process must also have sufficient page file quota to
 * read the entire content into memory as well.
 *
 * Examples:
 *	$ run cgi_symbols
 *
 *	$ mcr sys$disk:[]cgi_symbols http_ cgiform_
 *
 *	$ mcr sys$disk:[]cgi_symbols http_ cgiform_ message=message'n'.tmp
 *
 *      $ mcr sys$disk:[]cgi_symbols lnm$process form_content044.tmp
 *
 * Author: David Jones
 * Date:   26-SEP-1994
 * Revised: 25-OCT-1994		Add option to interpret form input into symbols.
 * Revised: 28-OCT-1994		Bug fixes.
 * Revised: 16-MAY-1995		Support multiple occureces of form values.
 *				If value appears more than once, concatenate
 *				values and separate by commas.
 * Revised: 8-SEP-1995		Fix bug in handling of plus signs in input
 *				fields.  To revert to old behaviour compile
 *				with KEEP_PLUSES macro symbol defined.
 * Revised: 14-NOV-1995		Bug fix, terminate namlist in add_symbol().
 * Revised: 21-MAR-1996		Add alternate (logical name) command syntax.
 * Revised: 15-NOV-1997		Add P4 hack.
 * Revised: 9-MAR-2000		Added name=file hack.
 * Revised: 21-FEB-2001		Zero length parameter for LIB$GET_SYMBOL call.
 * Revised: 17-MAY-2001		Support multipart form (<input file=...>).
 * Revised: 29-SEP-2001		Support 'indirect' arguments.
 */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
#include <descrip.h>
#include <libclidef.h>

#include "scriptlib.h"
#include "cgilib.h"
int cgi_show_env();
#define BINARY_IO_SIZE 16384
static void set_form_symbols ( char *prefix, char **form_file_list );
int LIB$SET_SYMBOL(), LIB$GET_SYMBOL();
typedef int * INTEGER;
int hpss_parse_form_content ( INTEGER context, char *content_type,
	char *fdata, int fdata_len,
	int define_symbol ( INTEGER, char *, int, char *, int ) );

struct indirect_arg {
    struct indirect_arg *next;
    char s[1];				/* variable size */
};
struct indirect_arg_list {
    struct indirect_arg *first, *last;
    int count;				/* total number added. */
    char errmsg[128];			/* reason for load failure */
};
/****************************************************************************/
/* Scan line for substitution character (') and replace the delimited
 * DCL symbol names with their values.
 */
static int expand_indirect_line ( char *in, char *out, size_t out_limit,
	char *errmsg )
{
    int i, length, start, state, finish, nlen, vlen, status;
    static char sym_name[32], value[1024];
    static $DESCRIPTOR ( sym_name_dx, sym_name );
    static $DESCRIPTOR ( value_dx, value );
    char c;

    state = 0;
    nlen = 0;
    for ( i = length = 0; in[i]; i++ ) {
	if ( (length+1) >= out_limit ) {
	}
	c = in[i];
	if ( state == 0 ) {
	    if ( c == '\'' ) state = 1;
	    else if ( c == '^' ) {
		state = 2;
		out[length++] = c;
	    } else out[length++] = c;
	} else if ( state == 1 ) {
	   /*
	    * Build symbol name.
	    */
	   if ( (c == '\'') || (c == '.') ) {
		/*
		 * Symbol name completed insert value.
		 */
		state = 0;
		vlen = 0;
		sym_name[nlen] = '\0';
		sym_name_dx.dsc$w_length = nlen;
		nlen = 0;
		value_dx.dsc$w_length = out_limit-1-length;
		value_dx.dsc$a_pointer = &out[length];
		status = LIB$GET_SYMBOL ( &sym_name_dx,
			&value_dx, &vlen, 0 );
		if ( (status&1) == 1 ) {
		    length += vlen;
		} else {
		}
	   } else if ( nlen < sizeof(sym_name)-1 ) {
		sym_name[nlen++] = c;
	   } else {
		/* Symbol name too long */
		sprintf ( errmsg, "symbol name too long" );
		return 0;
	   }
	} else if ( state == 2 ) {
	    state = 0;
	    out[length++] = c;
	}
    }
    if ( nlen > 0 ) {
	/*
	 * Final quote was missing.
	 */
	sym_name_dx.dsc$w_length = nlen;
	value_dx.dsc$w_length = out_limit-1-length;
	value_dx.dsc$a_pointer = &out[length];
	vlen = 0;
	status = LIB$GET_SYMBOL ( &sym_name_dx, &value_dx, &vlen, 0 );
	if ( (status&1) == 1 ) {
	    length += vlen;
	} else {
	    sprintf ( errmsg, "get_symbol error 0x%x", status );
	    return 0;
	}
    }
    out[length] = '\0';
#ifdef DEBUG
    printf ( "expanded value: '%s'\n", out );
#endif
    return 1;
}
/****************************************************************************/
/* Process 'indirect' argument command line argument.  Open file and
 * read line by line, initializing an indirect_arg structure for each line and
 * appending it to the argument list.  Each argument is validated for
 * correct syntax the same as a standard argument (name=file, name>file).
 *
 * Nested indirects are not supported.
 *
 * Return value is 1 for success, 0 for error.  The list argument must
 * be initialized to a count of 0 on first call.
 */
static int load_indirect_arg ( char *arg, struct indirect_arg_list *list )
{
    char line[1024], tmp_line[1024], *eol;
    FILE *af;
    int status, i, lnum;
    struct indirect_arg *iarg;
    /*
     * Attempt to open file.
     */
    af = fopen ( &arg[1], "r", "rop=rah" );
    if ( !af ) {
	strcpy ( list->errmsg, "File open failure" );
	return 0;
    }
    /*
     * Process file lines.
     */
    status = 1;
    lnum = 0;
    while ( fgets ( line, sizeof(line), af ) ) {
	lnum++;
	/*
	 * Trim off the line break character and substitute  DCL symbols
	 * embedded in the argument.
	 */
	eol = strchr ( line, '\n' );
	if ( !eol ) {
	    sprintf ( list->errmsg, "line %d too long (>%d)",
		lnum, sizeof(line)-1 );
	    status = 0;
	    break;
	}
	*eol = '\0';
	if ( strchr ( line, '\'' ) ) {
	    char exp_err[128];
	    strcpy ( tmp_line, line );
	    status = expand_indirect_line ( tmp_line, line, sizeof(line),
		exp_err );
	    if ( (status&1) == 0 ) {
		fprintf ( stderr, "line %d expansion error: %s\n", lnum,
			exp_err );
		break;
	    }
	}
	/*
	 * validate the line contents.
	 */
	if ( !line[0] ) continue;		/* ignore blank lines */
	if ( line[0] == '!' ) continue;		/* comment */
	if ( line[0] == '@' ) {
	    status = 0;
	    sprintf ( list->errmsg, "nested indirects not allowed, line %d",
		lnum );
	    break;
	}
	if ( !strchr ( line, '=' ) && ! strchr ( line, '>' ) ) {
	    status = 0;
	    sprintf ( list->errmsg, "invalid argument syntax, line %d", lnum );
	    break;
	}
	/*
	 * Everything checks, add new entry to list.  Upcase contents to
	 * the '='.
	 */
	iarg = malloc ( sizeof(struct indirect_arg) + strlen(line) );
	if ( !arg ) {
	    status = 0;
	    sprintf ( list->errmsg, "memory allocation failure" );
	    break;
	}
	iarg->next = (struct indirect_arg *) 0;
	strcpy ( iarg->s, line );
	for ( i = 0; (line[i] != '=') && (line[i] != '>'); i++ ) 
		iarg->s[i] = _toupper ( line[i] );

	if ( list->count == 0 ) list->first = iarg; 
	else list->last->next = iarg;
	list->last = iarg;
	list->count++;
    }
    fclose ( af );
    return status;
}

/****************************************************************************/

int main ( int argc, char **argv )
{
    int i, status, LIB$GET_SYMBOL(), table, length, virtual_argc, flags;
    char **virtual_argv, *base_prefix, *form_prefix, **form_file_list;
    char param_name[4], param_value[256];
    $DESCRIPTOR(pname,"");
    $DESCRIPTOR(pvalue,"");
    struct indirect_arg_list indirect;
    /*
     * Check for invalid invocation.  All arguments after argv[2] must
     * be of form symbol=filename or symbol>filename or @indirect-filename.
     */
    form_file_list = (char **) 0;
    indirect.count = 0;
    if ( argc > 3 ) {
	int i, j, fc;
	/*
	 * Scan arguments and build table of form fields whose values are
	 * to be directed to files.
	 */
	form_file_list = (char **) malloc ( sizeof(char *) * (argc-1) );
	fc = 0;			/* direct file count */
	for ( i = 3; i < argc; i++ ) {
	   /*
	    * if the argument begins with an 'at' sign, it is prefixing
	    * a file containing 1 argument per line.
	    */
	   if ( argv[i][0] == '@' ) {
		if ( !load_indirect_arg ( argv[i], &indirect ) ) {
		    fprintf ( stderr, "Error in indirect argument '%s':\n   %s\n",
			argv[i], indirect.errmsg );
		    exit ( 20 );
		}
		continue;
	   }
	   if ( ! strchr ( argv[i], '=' ) && ! strchr ( argv[i], '>' ) ) {
	        fprintf( stderr,
	       "Too many arguments, this program must be run from a DCL script\n");
	        exit (20);
	    }
	    /*
	     * Make a copy and upcase to the equals sign so we can
	     * do caseless compares later with the parsed form data.
	     */
	    form_file_list[fc] = malloc ( strlen(argv[i]) + 1 );
	    strcpy ( form_file_list[fc], argv[i] );
	    for ( j = 0; (form_file_list[fc][j] != '=') &&
			(form_file_list[fc][j] != '>'); j++ )
		form_file_list[fc][j] = _toupper(form_file_list[fc][j]);
#ifdef DEBUG
	    printf("form_file_list[%d]: '%s'\n", fc, form_file_list[fc]);
#endif
	    fc++;
	}
	/*
	 * Expand table. if any indirect files specified.
	 */
	if ( indirect.count > 0 ) {
	    char **exp_list;
	    struct indirect_arg *iarg;

	    exp_list = (char **) realloc ( form_file_list,
		(sizeof (char **)) * (fc + indirect.count + 1) );
	    if ( !exp_list ) {
		fprintf ( stderr, 
			"Error allocating memory for indirect arguments\n" );
		exit(44);
	    }
	    for ( iarg = indirect.first; iarg; iarg = iarg->next ) {
		exp_list[fc++] = iarg->s;
	    }
	    form_file_list = exp_list;
	}
	form_file_list[fc] = (char *) 0;
    }
    /*
     *
    /*
     * Build dummy argument list from P1 through P3 to get the values WWWEXEC 
     * passed to the script.
     */
    status = cgi_synthesize_argv ( argv[0], &virtual_argc, &virtual_argv );
    if ( (status&1) == 0 ) return status;
    /*
     * Retrieve flags for execution options from P4.
     */
    pname.dsc$w_length = 2;
    pname.dsc$a_pointer = param_name;
    pvalue.dsc$w_length = sizeof(param_value)-1;
    pvalue.dsc$a_pointer = param_value;

    flags = 0;
    length = 0;
    strcpy ( param_name, "P4" );
    status = LIB$GET_SYMBOL ( &pname, &pvalue, &length );
    if ( (status&1) == 1 ) {
	param_value[length] = '\0';
	if ( length > 0 ) flags = atoi ( param_value );
    }
    /*
     * Load CGI environment and convert to DCL
     */
    if ( (flags&1) ) {
        status = cgi_init_env ( virtual_argc, virtual_argv );
    } else {
        status = cgi_init ( virtual_argc, virtual_argv );
    }

    base_prefix = argc > 1 ? argv[1] : "";
    if ( !*base_prefix ) base_prefix = "WWW_";
    form_prefix = argc > 2 ? argv[2] : "";
    if ( strchr ( form_prefix, '.') ) {
	/*
	 * A period in form_prefix means it is an output filename.
	 * base_prefix becomes the table name.
	 */
	cgi_set_cli_env ( "", base_prefix );
	if ( *form_prefix ) {
	    /* Second argument is filename to receive post data */
	    FILE *pdata;
	    char *var, buffer[4096];
	    int seg, length, content_length;

    	    var = cgi_info ( "CONTENT_LENGTH" );
    	    content_length = var ? atoi(var) : 0;
	    if ( content_length <= 0 ) return 3;	/* no content. */

	    pdata = fopen ( argv[2], "w", "mbc=64" );
	    if ( !pdata ) {
		perror ( "Error creating content file\n" );
		return 0;
	    }

	    for ( ; content_length > 0; content_length -= seg ) {
		seg = (content_length > sizeof(buffer) ) ? sizeof(buffer) :
			content_length;
		length = cgi_read ( buffer, seg );
		fwrite ( buffer, length, 1, pdata );
		if ( length <= 0 ) break;
	    }
	    fclose ( pdata );
	}
    } else {
        cgi_set_dcl_env ( base_prefix );
        /*
         * Check if form input parse wanted.
         */
        if ( *form_prefix ) set_form_symbols ( form_prefix, form_file_list );
    }
    return 1;
}
/***************************************************************************/
/* Search comma-delimited list of names (namlist) for specified name
 * and add to end of list if not found.  If found, fetch value of DCL symbol
 * given by prefix+symname and return that to caller.
 *
 * Return values:
 *    0		Name too large to add to list,	vallen set to 0.
 *    1		Name appended to end of list, vallen set to 0.
 *    2		Name found, symbol value stored symval, length in vallen.
 */
static int add_symbol ( char *prefix, int prefix_len,
	char *symname, char *namlist, 
	int *nl_len, char *symval, int *vallen )
{
    int i,j,k, status, LIB$GET_SYMBOL(), table;
    /*
     * Search list from back.
     */
    *vallen = 0;
    for ( i = *nl_len-1; i >= 0; --i ) {
	if ( (i == 0) || namlist[i] == ',' ) {
	    /*
	     * namlist[i] or namlist[i+1] is start of name.
	     */
	    j = (i==0) ? i : i+1;
	    for ( k = 0; symname[k] != '\0'; k++ ) {
		if ( symname[k] != namlist[j] ) break;
		j++;
	    }
	    if ( (symname[k]=='\0') && 
		   (namlist[j] == ',' || namlist[j] == '\0') ) {
		/* 
		 * found match, retrieve DCL symbol
		 */
		$DESCRIPTOR(symbol,"");
		$DESCRIPTOR(value,"");
		char prefixed_sym[256];
		/* Build symbol name from prefix */
 		symbol.dsc$w_length = k + prefix_len + 4;
		if ( symbol.dsc$w_length > 255 ) symbol.dsc$w_length = 255;
		strncpy ( prefixed_sym, prefix, prefix_len );
		strcpy ( &prefixed_sym[prefix_len], "FLD_" );
		strncpy ( &prefixed_sym[prefix_len+4], symname,	
			symbol.dsc$w_length - prefix_len - 4);
		symbol.dsc$a_pointer = prefixed_sym;
		/*
		 * Make descriptor for result and fetch.
		 */
		value.dsc$w_length = 255;
		value.dsc$a_pointer = symval;

		status = LIB$GET_SYMBOL ( &symbol, &value, vallen, &table );
		if ( (status&1) == 0 ) *vallen = 0;
		return 2;
	    }
	}
    }
    /*
     * No match, append name to namlist.
     */
    i = *nl_len;
    if ( i > 0 && i < 255 ) namlist[i++] = ',';
    for ( j = 0; symname[j] && symname[j] != '='; j++ ) if ( i < 255 ) {
	namlist[i++] = symname[j];
    } else return 0;
    namlist[i] = '\0';

    *nl_len = i;
    return 1;
}
/***************************************************************************/
/* Scan for a matching name in a list of name=filename strings and if found
 * create a file with the correspodning name that contains the caller-specified
 * data.  The return value is 0 for no match and 1 for a match.  The number
 * of data bytes written to the file is returned in outlen, outlen will
 * contain -1 if an I/O error occurred.
 *
 * The file data is interpreted as text data, <CR><LF> sequences are replaced
 * with a bare <LF>.
 */
static int value_to_file ( char *name, char **map, char *data, int dlen,
	int *outlen )
{
    FILE *df;
    int i, j, nlen, start, state, rec_len, n, text_mode;
    nlen = strlen ( name );
    /* printf("Scanning form_file_list for '%s'\n", name ); */
    for ( i = 0; map[i]; i++ ) if ( strncmp ( name, map[i], nlen ) == 0 ) {
	/*
	 * Potential match, make sure we are at end of keywork in map entry.
	 */
	if ( map[i][nlen] == '>' ) {
	    text_mode = 0;			/* Transfer as binary data */
	} else if ( map[i][nlen] == '=' ) {	/* transfer as text */
	    text_mode = 1;
	} else {
	    continue;				/* not a match */
	}
	/*
	 * We have a match, open a file by this name.
	 */
	*outlen = 0;		/* Count of bytes written */
	df = fopen ( &map[i][nlen+1], (text_mode) ? "w" : "wb" );
	/* printf("Status of fopen on '%s': %x\n", &map[i][nlen+1], df ); */
	if ( !df ) { *outlen = -1; return 1; }

	if ( !text_mode ) {
	    /*
	     * Copy raw data, set dlen to -1 to force skip of text_mode part.
	     */
	    for ( j = 0; j < dlen; j += n ) {
		rec_len = dlen - j;
		if ( rec_len > BINARY_IO_SIZE ) rec_len = BINARY_IO_SIZE;
		n = fwrite ( &data[j], 1, rec_len, df );
		if ( n < 0 ) {
		    *outlen = -1;
		    break;
		}
		*outlen += n;
	    }
	    dlen = -1;
	}

	/*
	 * Scan for line terminators, limit records to 32 K for make life
	 * easier on VMS utilities that want to manipulate the file.
	 */
	state = 0;
	for ( start = j = 0; j < dlen; j++ ) {
	    char c;
	    /*
	     * Scan for LF, CRLF or record overflow.
	     */
	    c = data[j];
	    if ( state == 0 ) {
		if ( c == '\r' ) state = 1;
		else if ( c == '\n' ) {
		    state = 2;
		    rec_len = j - start;
		}
	    } else if ( state == 1 ) {
		if ( c == '\n' ) {
		    state = 2;
		    rec_len = j - start - 1;
		} else if ( c == '\r' ) state = 0;
	    } else if ( (j-start) >= 32767 ) {
		state = 2;		/* forced line break! */
		rec_len = j - start;
	    } else if ( c == '\0' ) break;

	    if ( state == 2 ) {
		/*
		 * Write a cannonical record and update outlen.
		 */
		c = data[start+rec_len];
		data[start+rec_len] = '\n';
		n = fwrite ( &data[start], 1, rec_len+1, df );
		data[start+rec_len] = c;
		if ( n < 0 ) {
		    *outlen = -1;
		    break;
		}
		*outlen += n;
		start = j + 1;
		state = 0;
	    }
	}
	if ( start <= dlen ) {
	    /* Missing final line terminator, send remaining data */
	    n = fwrite ( &data[start], 1, dlen-start, df );
	    if ( n < 0 ) *outlen = -1;
	    else *outlen += n;
	}
	fclose ( df );
	return 1;
    }
    return 0;		/* no match */
}
/***************************************************************************/
/*  Callback routine for use with hpss_parse_form.  Context argument is
 *  cast to point to a structure that holds state and parameters.
 *
 *  Return values:
 *	1		Success.
 *	3		Success, hpss_parse_from_content() should generate
 *			'field'.CONTENT-TYPE and 'field'.FILENAME symbols
 *			for multipart content.
 *    even		Error defining symbol.
 */
struct form_ctx {
    int flags;				/* processing options */
    char *prefix;			/* prefix for DCL symbols. */
    char **form_file_list;		/* Symbols to save as files */
    int prefix_len;			/* Length of prefix string */
    int slist_len;			/* used portion of slist */
    char slist[256];			/* comma-separated list of 
					   symbols created */
};

static int define_symbol_cb ( INTEGER context, 
	char *symbol, int slen,
	char *value, int vlen )
{
    struct form_ctx *ctx;
    int i, k, old_len, status, table, written, last_dot;
    char munged_name[256], old_value[256], file_len_str[64];
    static char symname[256];
    static $DESCRIPTOR(symbol_dx,symname);
    static $DESCRIPTOR(value_dx,"");
    /*
     * retrieve context.
     */
    ctx = (struct form_ctx *) context;
    /*
     * Munge the symbol to have only valid DCL symbol characters.
     */
    if ( slen < sizeof(munged_name) ) {
	strncpy ( munged_name, symbol, slen );
	munged_name[slen] = '\0';
    } else { 
	strncpy(munged_name,symbol,sizeof(munged_name)-1); 
	munged_name[sizeof(munged_name)-1] = '\0';
    }
    for ( last_dot = -1, i = 0; munged_name[i]; i++ ) {
	if ( munged_name[i] == '.' ) last_dot = i;
	if ( !isalnum(munged_name[i]) && (munged_name[i] != '_') &&
		(munged_name[i] != '$') ) munged_name[i] = '_';
    }
    /*
     * Check for special synthesized symbols.
     */
    if ( (last_dot > 0) && (ctx->flags & 1) ) {
	if ( (strcmp ( &munged_name[last_dot], "_FILENAME" ) == 0) ||
	     (strcmp ( &munged_name[last_dot], "_CONTENT_TYPE") == 0) ) {
	    /*
	     * Symbol value is actually sub-field parsed from mime header.
	     * (In future, may want to append to FIELD symbol rather than
	     * make a separate symbol).
	     */
	}
    }
    /*
     * Append name to field list or retrieve current DCL symbol
     * value if already defined once.
     */
    k = add_symbol ( ctx->prefix, ctx->prefix_len,
	munged_name, ctx->slist, &ctx->slist_len,
	old_value, &old_len );
    /*
     * Make DCL symbol name: 'prefix'FLD_'name'
     */
    symbol_dx.dsc$w_length = slen + 4 + ctx->prefix_len;
    if ( symbol_dx.dsc$w_length > 255 ) symbol_dx.dsc$w_length = 255;
    strncpy ( symname, ctx->prefix, ctx->prefix_len );
    strcat ( symname, "FLD_" );
    strncpy ( &symname[ctx->prefix_len+4], munged_name, 
	symbol_dx.dsc$w_length-(ctx->prefix_len+4) );
    symname[symbol_dx.dsc$w_length] = '\0';
    /*
     * See if this symbol value should be redirected to a file.
     */
    if ( ctx->form_file_list ) {
	/*
	 * Make file and repoint fdata_value to a string containing
	 * the number of bytes written (or -1 for error).
	 */
	if ( value_to_file ( munged_name, ctx->form_file_list, value, vlen,
			   &written ) ) {
	    value = file_len_str;
	    sprintf ( value, "%d", written );
	    vlen = strlen ( value );
	}
    }
    /*
     * Make DCL symbol.
     */
    if ( old_len > 0 ) if ( (old_len + vlen) < 254 ) {
	/*
	 * Make value string the previous value with current value concatenated.
	 */
	old_value[old_len++] = ',';
	strncpy(&old_value[old_len], value, vlen  );
	vlen += old_len;
	value = old_value;
    }
    if ( vlen < 1024 ) value_dx.dsc$w_length = vlen;
    else value_dx.dsc$w_length = 1023;
    value_dx.dsc$a_pointer = value;

    table = LIB$K_CLI_LOCAL_SYM;
    status = LIB$SET_SYMBOL ( &symbol_dx, &value_dx, &table );
    if ( (status&1) == 0 ) fprintf(stderr,
			"Error defining CGI form symbol: %d\n", status );
    /*
     * Only request multipart synthesized fields if directed by flags.
     */
    return (ctx->flags&1) ? 3 : 1;

}
/***************************************************************************/
/* Generate list of symbols for FORM input.  If form_file_list is non-null
 * it specifies a list of symbols whose out is to be directed to a file
 * rather than made the symbol value.  When redirected to a file the symbol
 * value will be the length of the decoded data.
 */
static void set_form_symbols ( char *prefix, char **form_file_list )
{
    char *var, *fdata, *fdata_value, *c_type, file_len_str[32];
    int status, table, i, j, k, vallen, fdv_len;
    int content_length, slist_len, length;
    $DESCRIPTOR(symbol,"");
    $DESCRIPTOR(value,"");
    char sym_list[256], symname[256], symval[256], content_type[512];
    struct form_ctx context;
    /*
     * Initialize
     */
    strcpy ( symname, prefix );
    table = LIB$K_CLI_LOCAL_SYM;
    symbol.dsc$a_pointer = symname;
    slist_len = 0;
    /*
     * See if any content present first checking for POST data and using
     * query string as fallback.
     */
    var = cgi_info ( "CONTENT_LENGTH" );
    content_length = var ? atoi(var) : 0;
    
    if ( content_length > 0 ) {
	/*
	 * Get content-type.
	 */
	c_type = cgi_info ( "CONTENT_TYPE" );
	/*
	 * Allocate buffer and read entire form data into it, forcing final &.
	 */
	fdata = malloc ( content_length+1 );
	if ( !fdata ) return;
	
	length = cgi_read ( fdata, content_length );
    } else {
	c_type = (char *) 0;
	var = cgi_info ( "QUERY_STRING" );
	if ( var ) {
	    length = strlen ( var );
	    fdata = malloc ( length + 1 );
	    if ( !fdata ) return;
	    strcpy ( fdata, var );
	} else length = 0;
    }
    /*
     * Process content-type, make the string up to first semi-colon upper case.
     */
    if ( c_type ) {
	int post_semicolon;
	for ( post_semicolon = i = 0; c_type[i]; i++ ) {
	    if ( i >= (sizeof(content_type)-1) ) break;
	    if ( post_semicolon ) content_type[i] = c_type[i];
	    else {
		if ( c_type[i] == ';' ) post_semicolon = 1;
		content_type[i] = _toupper(c_type[i]);
	    }
	}
	content_type[i] = '\0';
    } else {
	strcpy ( content_type, "APPLICATION/X-WWW-FORM-URLENCODED" );
    }
    /*
     * Breakout form fields encoded in content into separate symbols.
     */
    context.flags = 1;			/* want sub-fields */
    context.slist_len = 0;
    context.prefix = prefix;
    context.prefix_len = strlen(context.prefix);
    if ( length > 0 ) {
	context.form_file_list = form_file_list;
	
	status = hpss_parse_form_content ( (INTEGER) &context,
		content_type, fdata, length, define_symbol_cb );
    }
    /*
     * Set final symbol, which is list of fields.
     */
    strncpy ( symname, context.prefix, context.prefix_len );
    strcpy ( &symname[context.prefix_len], "FIELDS" );
    symbol.dsc$a_pointer = symname;
    symbol.dsc$w_length = strlen ( symname );
    value.dsc$w_length = context.slist_len;
    value.dsc$a_pointer = context.slist;
    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
}
