/* PROGRAM (for OSU DECthreads httpd)				Set_DCL_Env.c
**		CGI SCRIPT TO SET SYMBOLS FOR DCL ENVIRONMENT.
**
** USAGE:
**	$ set noon
**	$ say = "write net_link"
**	$ crlf = f$fao("!/")
**	$ say "<DNETRECMODE>"	! Set implied carriage control (optional)
**	$ mcr 'f$parse("SET_DCL_ENV.EXE;",f$environment("PROCEDURE"))
**	$ [...]
**   Can pass a base symbol prefix as an argument (default is "WWW_").
**   Can pass a form symbol prefix as a second argument to invoke use
**     of CGI-SYMBOLS-like symbol names (default is the CERN WWW_KEY_foo
**     scheme).
**
**   Set the Content-Type in the DCL script, e.g.:
**	$ say "Content-Type: text/html", crlf	 ! CGI header (two crlf's if
**	$ [...]					   <DNETRECMODE> is not set)
**
**   or via a printf("Content-Type: text/html\n\n") in an executable, e.g.:)
**	$ define sys$output net_link
**	$ WWWquery "''database'" "''query'"
**	$ deassign sys$output
**	$ [...]
**
**   Once this program is run by the initial htbin script, any sequence
**	of executables or other DCL scripts can be called with sys$output
**	assigned to net_link so that their outputs will be sent to the
**	client, and they will all have direct access to the full CGI symbol
**	environment via DCL symbols (accessible via getenv() calls in C
**	programs).
**
**
** AUTHORS:
**	FM	Foteos Macrides		macrides@sci.wfbr.edu
**
** HISTORY:
**	12 Oct 94  FM	Written for use with the OSU DECthreads httpd.
**			(modification of Dave's CGI_SYMBOLS.C for v1.6
**			and my QueryVMS.c).  In addition to setting the
**			base CGI symbols via cgi_set_dcl_env(), it casts
**			HTTP_ACCEPT into a numbered list and count symbol
**			set, coverts POST or GET Form contents into an
**			unescaped, numbered KEY (odd is name, even is
**			value) and count symbol set, or an ISINDEX query
**			into an unescaped, numbered KEY and count symbol
**			set, all as in the DCL symbol support for the
**			CERN httpd.  Note that all symbols are limited
**			to 255 characters for DCL, and strings will be
**			clipped to that limit if longer.  This code does
**			not symbolize POST contents other than from Forms.
**			If a POST Form submission also has a "?<query>" in
**			the RequestURL (rare, but could occur), the KEY
**			symbol pairs for the Form content precede those for
**			the query.
**			This code also fills an "entries" structure with the
**			name/value pairs from Forms (like that in QueryVMS.c)
**			so you can easily add functions to do something useful
**			beyond setting the DCL symbols (to supplement whatever
**			you're doing via the DCL command file).  As you add
**		        such functions, you can include getenv() checks for
**			symbols set by the DCL command file to regulate their
**			implementation. (use the "Check whether we want equal
**			signs appended to names." code as a model).
**			The WWW_PATH_TRANSLATED symbol is not set to "" by
**			cgi_set_dcl_env() if WWW_PATH_INFO is "".  This
**			script does set it to "", you won't get a DCL error
**			if you try to use WWW_PATH_TRANSLATED without first
**			checking if WWW_PATH_INFO .nes. "". 
**
**			Differences from the CERN httpd symbol set:
**			===========================================
**			  1) The "WWW_" base and CERN-style form-content
**			     symbol prefixes can be replaced via a first
**			     argument for Set_DCL_Env.exe.  Any symbols
**			     set by the calling script for regulating
**			     Set_DCL_Env.exe should use the alternate
**			     prefix as well (we'll assume it's "WWW_" in
**			     the following comments).
**			  2) By default, the '=' is not retained on the ends
**			     of the WWW_KEY_<odd_number> symbols for Form
**			     content names. (The count is pointed to by
**			     WWW_KEY_COUNT, equivalently to the CERN httpd.)
**			     You don't need the equal sign to know that it's
**			     the name, and it was a pain to deal with when
**			     formatting text within the script for output
**			     to the client.  The symbol WWW_APPEND_EQUAL_SIGN
**			     can be made non-NULL by the calling script if you
**			     do want the equal sign appended.
**			  3) WWW_HTTP_ACCEPT points to the full, comma
**			     separated list of accepted MIME types, not to
**			     the count of WWW_HTTP_ACCEPT_<number> symbols
**			     as does the CERN httpd.  The count is pointed to
**			     instead by WWW_HTTP_ACCEPT_COUNT.  The comma
**			     separated list is likely to be clipped at 255
**			     characters (so you'd be unwise to parse it rather
**			     than checking the numbered list via a DCL loop,
**			     but cgi_set_dcl_env() sets WWW_HTTP_ACCEPT to
**			     that list, and so I left it that way.  You can
**			     also search the accepted MIME types by using
**			     <DNETHDR>, but that's more work and overhead
**			     than looping through this numbered list.
**			  4) I didn't include WWW_REFERER_URL, because you
**			     can get it as WWW_HTTP_REFERER.
**			  5) The WWW_HTTP_ACCEPT_LANGUAGE symbol is a comma
**			     separated list, as for the CERN server, but is
**			     cast to a WWW_HTTP_ACCEPT_LANGUAGE_COUNT and
**			     WWW_HTTP_ACCEPT_LANGUAGE_<num> symbol set as
**			     well.
**
**	12 Mar 95  FM	Added multi-line TEXTAREA handling, identical to
**			     that for the CERN httpd.
**
**	13 Mar 95  FM   Added option to process POST or GET Form content
**			     equivalently to the v1.7a CGI_SYMBOLS.c, if
**			     Set_DCL_Env.exe is invoked with a second
**			     (Form prefix) argument.  The first argument
**			     must be the base prefix (normally "WWW_").
**			     See comments in do_cgi_form_env() concerning
**			     the limitations of this symbolizing scheme,
**			     but it's easier to use with simple forms.
**			     In addition to CGI_SYMBOL.c's foo_FLD_name
**			     symbols and foo_FIELDS list, this version
**			     includes foo_FLD_COUNT and foo_FIELDS_COUNT
**			     symbols (for error checking).
**
**	18 Mar 95  FM	Added check for WWW_APPEND_EQUAL_SIGN (replace the
**			 "WWW_" with the alternate symbol prefix, if one
**			 has been passed as an argument). 
**
**	22 Apr 95  FM	Added WWW_HTTP_ACCEPT_LANGUAGE symbol and a
**			 WWW_HTTP_ACCEPT_LANGUAGE_COUNT and itemized
**			 WWW_HTTP_ACCEPT_LANGUAGE_<num> symbol set.
**
**	23 Apr 95  FM	Added WWW_AUTH_TYPE handling (is set to the
**			 authentication type, e.g., "Basic", or to "" if
**			 the script was not invoked with authentication.
**			Added code to set the WWW_PATH_TRANSLATED symbol
**			 to "" if no translation is present.
**
**	28 Apr 95  FM	Added code to set WWW_REMOTE_IDENT and
**			 WWW_REMOTE_USER to "" if no translation
**			 is present.
**
**	20 May 95  FM	Treat CRLF, lone LF or lone CR as 'newline' (LF)
**			 when unescaping.
**
**	14 Jan 96  FM	Modified do_cgi_form_env() emulation of CGI_Symbols.c
**			 to create a comma-separated list of VALUEs for fields
**			 which have the same NAME (as in SELECTs with the
**			 MULTIPLE attribute set).
** BUGS:
**
*/

#include <stdio.h>
#include <stdlib.h>
#include <unixlib.h>
#include <ctype.h>
#include <stdarg.h>
#include <descrip.h>
#include <libclidef.h>
#include <string.h>
#include <lib$routines.h>
#include "cgilib.h"
#include "scriptlib.h"

#define MAX_ENTRIES 1000	/* Maximum name/value pairs to handle       */
#define MAX_PREFIX_LEN 100	/* Maximum prefix length (default is "WWW_" */

typedef struct {    		/* Structure for holding name/value pairs   */
    char *name;
    char *val;
} entry;

static entry entries[MAX_ENTRIES];
static char  prefix[256];
static int   prefix_len=0;
static char  Fprefix[256];
static int   Fprefix_len=0;
static char  AcceptCount[20];
static char  KeyCount[20];

static void getword(char *word, char *line, char stop);
static char *makeword(char *line, char stop);
static char *fmakeword(FILE *f, char stop, int *len);
static char x2c(char *what);
static void unescape_url(char *url);
static void plustospace(char *str);
static int strcasecomp(char *a, char *b);
static int strncasecomp(char *a, char *b, int);
static void do_dcl_form_env(int m);
static void do_cgi_form_env(int m);

int main(int argc, char *argv[])
{
    register int x, m=0, line;
    char *cp, *cp1, *METHOD, *ACCEPT;
    int cl, len;
    unsigned int status;
    unsigned char append_equal_sign=0;
    FILE *contentf;
    int i, length, virtual_argc;
    int table = LIB$K_CLI_LOCAL_SYM;
    int count=0;
    char *virtual_argv[4];
    char param_name[4], param_value[256], symname[256], symvalue[256];
    $DESCRIPTOR(pname,"");
    $DESCRIPTOR(pvalue,"");
    $DESCRIPTOR(symbol,"");
    $DESCRIPTOR(value,"");
    symbol.dsc$a_pointer = symname;
    /*
     * Check for invalid invocation
     */
    if ( argc > 3 ) {
	printf(
	   "Too many arguments, this program must be run from a DCL script\n");
	exit (20);
    }
    /*
     * Build dummy argument list from P1 through P3 to get the values WWWEXEC 
     * passed to the script.
     */
    virtual_argc = 4;
    virtual_argv[0] = argv[0];		/* for lack of anything better! */
    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;

    for ( i = 1; i < virtual_argc; i++ ) {
	sprintf ( param_name, "P%d", i );
	length = 0;
	status = LIB$GET_SYMBOL ( &pname, &pvalue, &length );
	if ( (status&1) == 1 ) {
	    /*
	     * Allocate new buffer to hold value.
	     */
	    virtual_argv[i] = malloc ( length+1 );
	    param_value[length] = '\0';
	    strcpy ( virtual_argv[i], param_value );
	}
	else virtual_argv[i] = "";
    }

    /*
     * Load the base CGI environment for conversion to DCL symbols.
     */
    status = cgi_init ( virtual_argc, virtual_argv );
    if ( (status&1) == 0 )
        return status;

    /*
     * Get the CGI symbol prefix and set the basic symbols.
     */
    strncpy( prefix, ((argc > 1) ? argv[1] : "WWW_"), MAX_PREFIX_LEN );
    prefix[MAX_PREFIX_LEN] = '\0';
    prefix_len = strlen ( prefix );
    cgi_set_dcl_env ( prefix );

    /*
     * Check if CGI_SYMBOLS-like parsing of form input is wanted.
     */
    strncpy( Fprefix, ((argc > 2) ? argv[2] : ""), MAX_PREFIX_LEN);
    Fprefix[MAX_PREFIX_LEN] = '\0';
    Fprefix_len = strlen ( Fprefix );

    /*
     * Recast HTTP_ACCEPT to a numbered symbol list.
     */
    if ( (ACCEPT=cgi_info("HTTP_ACCEPT")) != NULL && *ACCEPT != '\0' ) {
        count = 0;
	while ( (cp=strchr(ACCEPT, ',')) != NULL ) {
	    *(cp++) = '\0';
	    while ( isspace(*ACCEPT) )
	        ACCEPT++;
	    sprintf( symname, "%sHTTP_ACCEPT_%d", prefix, ++count );
	    symbol.dsc$w_length = strlen( symname );
	    value.dsc$a_pointer = ACCEPT;
	    value.dsc$w_length = strlen( ACCEPT );
	    if ( value.dsc$w_length > 255 )
	        value.dsc$w_length = 255;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
		"Error defining %s symbol.  status: %d\n", symname, status );
	    ACCEPT = cp;
	}
	if (*ACCEPT != '\0') {
	    while ( isspace(*ACCEPT) )
	        ACCEPT++;
	    sprintf( symname, "%sHTTP_ACCEPT_%d", prefix, ++count );
	    symbol.dsc$w_length = strlen( symname );
	    value.dsc$a_pointer = ACCEPT;
	    value.dsc$w_length = strlen( ACCEPT );
	    if ( value.dsc$w_length > 255 )
	        value.dsc$w_length = 255;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
		"Error defining %s symbol.  status: %d\n", symname, status );
	}
    }

    /*
     * Set the ACCEPT count.
     */
    sprintf( symname, "%sHTTP_ACCEPT_COUNT", prefix );
    symbol.dsc$w_length = strlen( symname );
    sprintf( AcceptCount, "%d", count );
    value.dsc$a_pointer = AcceptCount;
    value.dsc$w_length = strlen ( AcceptCount );
    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
    if ( (status&1) == 0 ) fprintf(stderr,
	"Error defining %s symbol.  status: %d\n", symname, status );
    count = 0;

    /*
     * Recast HTTP_ACCEPT_LANGUAGE to a numbered symbol list.
     */
    if ( (ACCEPT=cgi_info("HTTP_ACCEPT_LANGUAGE")) != NULL &&
    	 *ACCEPT != '\0' ) {
        count = 0;
	while ( (cp=strchr(ACCEPT, ',')) != NULL ) {
	    *(cp++) = '\0';
	    while ( isspace(*ACCEPT) )
	        ACCEPT++;
	    sprintf( symname, "%sHTTP_ACCEPT_LANGUAGE_%d", prefix, ++count );
	    symbol.dsc$w_length = strlen( symname );
	    value.dsc$a_pointer = ACCEPT;
	    value.dsc$w_length = strlen( ACCEPT );
	    if ( value.dsc$w_length > 255 )
	        value.dsc$w_length = 255;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
		"Error defining %s symbol.  status: %d\n", symname, status );
	    ACCEPT = cp;
	}
	if (*ACCEPT != '\0') {
	    while ( isspace(*ACCEPT) )
	        ACCEPT++;
	    sprintf( symname, "%sHTTP_ACCEPT_LANGUAGE_%d", prefix, ++count );
	    symbol.dsc$w_length = strlen( symname );
	    value.dsc$a_pointer = ACCEPT;
	    value.dsc$w_length = strlen( ACCEPT );
	    if ( value.dsc$w_length > 255 )
	        value.dsc$w_length = 255;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
		"Error defining %s symbol.  status: %d\n", symname, status );
	}
    }

    /*
     * Set the ACCEPT_LANGUAGE count.
     */
    sprintf( symname, "%sHTTP_ACCEPT_LANGUAGE_COUNT", prefix );
    symbol.dsc$w_length = strlen( symname );
    sprintf( AcceptCount, "%d", count );
    value.dsc$a_pointer = AcceptCount;
    value.dsc$w_length = strlen ( AcceptCount );
    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
    if ( (status&1) == 0 ) fprintf(stderr,
	"Error defining %s symbol.  status: %d\n", symname, status );
    count = 0;

    /*
     * Pick up CGI symbols which the cgilib/scriptlib
     * doesn't presently handle properly.
     */
    sprintf( symname, "%sAUTH_TYPE", prefix );
    if ( getenv( symname ) == NULL ) {
        sprintf( symname, "%sHTTP_AUTHORIZATION", prefix );
        if ( ( cp = getenv( symname ) ) != NULL ) {
            if ( ( cp1 = strchr( cp, ' ' ) ) != NULL )
	        *cp1 = '\0';
	    if ( strlen( cp ) > 255 )
	        cp[255] = '\0';
        }
	else
            cp = "";
	sprintf( symname, "%sAUTH_TYPE", prefix );
	symbol.dsc$w_length = strlen( symname );
	sprintf( symvalue, "%s", cp );
	value.dsc$a_pointer = symvalue;
	value.dsc$w_length = strlen ( symvalue );
	status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	if ( (status&1) == 0 ) fprintf(stderr,
	    "Error defining %s symbol.  status: %d\n", symname, status );
    }
    sprintf( symname, "%sPATH_TRANSLATED", prefix );
    if ( getenv( symname ) == NULL ) {
        symbol.dsc$w_length = strlen( symname );
	symvalue[0] = '\0';
	value.dsc$a_pointer = symvalue;
	value.dsc$w_length = 0;
	status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	if ( (status&1) == 0 ) fprintf(stderr,
	    "Error defining %s symbol.  status: %d\n", symname, status );
    }
    sprintf( symname, "%sREMOTE_IDENT", prefix );
    if ( getenv( symname ) == NULL ) {
        symbol.dsc$w_length = strlen( symname );
	symvalue[0] = '\0';
	value.dsc$a_pointer = symvalue;
	value.dsc$w_length = 0;
	status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	if ( (status&1) == 0 ) fprintf(stderr,
	    "Error defining %s symbol.  status: %d\n", symname, status );
    }
    sprintf( symname, "%sREMOTE_USER", prefix );
    if ( getenv( symname ) == NULL ) {
        symbol.dsc$w_length = strlen( symname );
	symvalue[0] = '\0';
	value.dsc$a_pointer = symvalue;
	value.dsc$w_length = 0;
	status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	if ( (status&1) == 0 ) fprintf(stderr,
	    "Error defining %s symbol.  status: %d\n", symname, status );
    }

    /*
     * Check for Form content.
     */
    if ( (METHOD=cgi_info("REQUEST_METHOD")) != NULL) {
        /*
	 * Check whether we want equal signs appended to names.
	 */
        sprintf( symname, "%sAPPEND_EQUAL_SIGN", prefix );
        if ( getenv( symname ) != NULL )
	    append_equal_sign = 1;

        if ( 0==strcasecomp( METHOD, "POST" ) &&
             (cp=cgi_info( "CONTENT_TYPE" )) != NULL &&
             0==strcasecomp(cp,"application/x-www-form-urlencoded") ) {
            /*
	     * It's a Form with METHOD="POST".
	     */
	    cl = atoi( (cp=cgi_info("CONTENT_LENGTH")) ? cp : "0" );
	    if ( cl && (contentf = cgi_content_file()) ) {
	        /*
		 * We have POST content.
		 */
	        for(x = 0; cl && (!feof(contentf) && x < MAX_ENTRIES); x++) {
		    entries[x].val = fmakeword(contentf, '&', &cl);
		    plustospace(entries[x].val);
		    unescape_url(entries[x].val);
		    entries[x].name = makeword(entries[x].val,'=');
		    if (append_equal_sign)
		        strcat(entries[x].name, "=");
		    m++;
	        }
		if ( *Fprefix == '\0' ) {
		    /*
		     * Default CERN-style symbols wanted.
		     */
                    do_dcl_form_env(m);
		    count = (2 * m);
		} else {
		    /*
		     * OSU CGI_SYMBOLS-style symbols wanted.
		     */
		    do_cgi_form_env(m);
		    count = 0;
		}
	    }
	} else if ( 0==strcasecomp( METHOD, "GET" ) &&
		    (cp=cgi_info("QUERY_STRING")) != NULL && *cp != '\0' &&
		    strchr( cp, '=') != NULL ) {
            /*
	     * It's a Form with METHOD="GET" and we have content.
	     */
            for(x=0; cp[0] != '\0' && x < MAX_ENTRIES; x++) {
	        len = strlen(cp) + 1;
	        if (cp1=strchr(cp, '&'))
	            len -= strlen(cp1);
	        entries[x].val = (char *) malloc(sizeof(char) * len);
                getword(entries[x].val, cp, '&');
                plustospace(entries[x].val);
                unescape_url(entries[x].val);
                entries[x].name = makeword(entries[x].val,'=');
		if (append_equal_sign)
	            strcat(entries[x].name, "=");
	        m++;
	    }
	    if ( *Fprefix == '\0' ) {
		/*
		 * Default CERN-style symbols wanted.
		 */
                do_dcl_form_env(m);
		count = (2 * m);
	    } else {
		/*
		 * OSU CGI_SYMBOLS-style symbols wanted.
		 */
		do_cgi_form_env(m);
		count = 0;
	    }
        } else if ( *Fprefix != '\0' ) {
            /*
             * Output foo_FIELDS_COUNT and foo_FLD_COUNT symbols
	     * with zero values.
             */
            sprintf( symname, "%sFIELDS_COUNT", Fprefix );
	    symbol.dsc$w_length = strlen( symname );
	    strcpy(KeyCount, "0");
	    value.dsc$a_pointer = KeyCount;
	    value.dsc$w_length = 1;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
	        "Error defining %s symbol.  status: %d\n", symname, status );

            sprintf( symname, "%sFLD_COUNT", Fprefix );
	    symbol.dsc$w_length = strlen( symname );
	    strcpy(KeyCount, "0");
	    value.dsc$a_pointer = KeyCount;
	    value.dsc$w_length = 1;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
	        "Error defining %s symbol.  status: %d\n", symname, status );
        }
    }

    /*
     * Check for an ISINDEX query.
     */
    if ( (cp=cgi_info( "QUERY_STRING" )) != NULL && *cp != '\0' &&
	 strchr( cp, '=' ) == NULL ) {
	/*
	 * Check for a + separated set of terms.
	 */
	char *query = cp;
	while ( (cp=strchr(query, '+')) != NULL ) {
	    *(cp++) = '\0';
	    unescape_url(query);
	    sprintf( symname, "%sKEY_%d", prefix, ++count );
	    symbol.dsc$w_length = strlen( symname );
	    value.dsc$a_pointer = query;
	    value.dsc$w_length = strlen (query);
	    if ( value.dsc$w_length > 255 )
	        value.dsc$w_length = 255;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
		"Error defining %s symbol.  status: %d\n", symname, status );
	    query = cp;
	}
	/*
	 * Do the first term if its the only, or the last term.
	 */
	if ( *query != '\0' ) {
	    unescape_url(query);
	    sprintf( symname, "%sKEY_%d", prefix, ++count );
	    symbol.dsc$w_length = strlen( symname );
	    value.dsc$a_pointer = query;
	    value.dsc$w_length = strlen (query);
	    if ( value.dsc$w_length > 255 )
	        value.dsc$w_length = 255;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
		"Error defining %s symbol.  status: %d\n", symname, status );
	}
    }

    /*
     * Set the KEY count.
     */
    sprintf( symname, "%sKEY_COUNT", prefix );
    symbol.dsc$w_length = strlen( symname );
    sprintf(KeyCount, "%d", count);
    value.dsc$a_pointer = KeyCount;
    value.dsc$w_length = strlen ( KeyCount );
    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
    if ( (status&1) == 0 ) fprintf(stderr,
	"Error defining %s symbol.  status: %d\n", symname, status );

    /*
     * Add any supplementary function calls here.
     */

    /*
     * Return control to the DCL command file.
     */
    return (1);
} /* main */


static void getword(char *word, char *line, char stop) {
    int x = 0,y;

    for(x=0; ((line[x] != '\0') && (line[x] != stop)); x++)
        word[x] = line[x];

    word[x] = '\0';
    if(line[x]) ++x;
    y=0;

    while(line[y++] = line[x++]);
    return;
}


static char *makeword(char *line, char stop) {
    int x = 0,y;
    char *word = (char *) malloc(sizeof(char) * (strlen(line) + 1));

    for(x=0;((line[x]) && (line[x] != stop));x++)
        word[x] = line[x];

    word[x] = '\0';
    if(line[x]) ++x;
    y=0;

    while(line[y++] = line[x++]);
    return word;
}


static char *fmakeword(FILE *f, char stop, int *cl) {
    int wsize;
    char *word;
    int ll;

    wsize = 96;
    ll=0;
    word = (char *) malloc(sizeof(char) * (wsize + 1));

    while(1) {
        word[ll] = (char)fgetc(f);
        if(ll==wsize) {
            word[ll+1] = '\0';
            wsize+=1024;
            word = (char *)realloc(word,sizeof(char)*(wsize+1));
        }
        --(*cl);
        if((word[ll] == stop) || (feof(f)) || (!(*cl))) {
            if(word[ll] != stop) ll++;
            word[ll] = '\0';
            return word;
        }
        ++ll;
    }
}


static char x2c(char *what) {
    register char digit;

    digit = (what[0] >= 'A' ? ((what[0] & 0xdf) - 'A')+10 : (what[0] - '0'));
    digit *= 16;
    digit += (what[1] >= 'A' ? ((what[1] & 0xdf) - 'A')+10 : (what[1] - '0'));
    return(digit);
}


static void unescape_url(char *url) {
    register int x,y;

    for(x=0,y=0;url[y];++x,++y) {
        if((url[x] = url[y]) == '%') {
            url[x] = x2c(&url[y+1]);
            y+=2;
	    if(url[x] == '\r') {
	        if(url[y] == '%' && x2c(&url[y+1]) == '\n')
		    /* Ignore the CR in CRLFs */
		    x--;
		else
		    /* Convert lone CR to LF */
		    url[x] = '\n';
	    }
        }
    }
    url[x] = '\0';
}


static void plustospace(char *str) {
    register int x;

    for(x=0;str[x];x++) if(str[x] == '+') str[x] = ' ';
}


static int strcasecomp(char *a, char *b)
{
	char *p = a;
	char *q = b;
	for(p=a, q=b; *p && *q; p++, q++) {
	    int diff = tolower(*p) - tolower(*q);
	    if (diff) return diff;
	}
	if (*p) return 1;	/* p was longer than q */
	if (*q) return -1;	/* p was shorter than q */
	return 0;		/* Exact match */
}


static int strncasecomp(char *a, char *b, int n)
{
	char *p = a;
	char *q = b;
	
	for(p=a, q=b;; p++, q++) {
	    int diff;
	    if (p == a+n) return 0;	/*   Match up to n characters */
	    if (!(*p && *q)) return *p - *q;
	    diff = tolower(*p) - tolower(*q);
	    if (diff) return diff;
	}
}

static void do_dcl_form_env(int m)
{
    int i, count, status, length, table;
    $DESCRIPTOR(symbol,"");
    $DESCRIPTOR(value,"");
    char symname[256];
    register int x;
    symbol.dsc$a_pointer = symname;

    /*
     * Define local symbols to be used by calling script.
     */
    table = LIB$K_CLI_LOCAL_SYM;
    for ( count = x = 0; x < m; x++ ) {
	/*
	 * Set key for name.
	 */
	sprintf( symname, "%sKEY_%d", prefix, ++count );
	symbol.dsc$w_length = strlen( symname );
	value.dsc$a_pointer = entries[x].name;
	value.dsc$w_length = strlen ( entries[x].name );
	if ( value.dsc$w_length > 255 )
	    value.dsc$w_length = 255;
	status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	if ( (status&1) == 0 ) fprintf(stderr,
	    "Error defining %s symbol.  status: %d\n", symname, status );
	/*
	 * Set key(s) for value.
	 */
	if ( strchr( entries[x].val, '\n' ) == NULL ) {
	    /*
	     * Value is a simple string.
	     */
	    sprintf( symname, "%sKEY_%d", prefix, ++count );
	    symbol.dsc$w_length = strlen( symname );
	    value.dsc$a_pointer = entries[x].val;
	    value.dsc$w_length = strlen ( entries[x].val );
	    if ( value.dsc$w_length > 255 )
	        value.dsc$w_length = 255;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
		"Error defining %s symbol.  status: %d\n", symname, status );
	} else {
	    /*
	     * Value is a multi-line TEXTAREA.
	     */
	    int line = 0;
	    char *newline;
	    char *cp = entries[x].val;
	    ++count;
	    while ( (newline=strchr( cp, '\n' )) != NULL ) {
	        /*
		 * Get all the lines preceding newlines.
		 */
	        *newline = '\0';
		sprintf( symname, "%sKEY_%d_%d", prefix, count, ++line );
		symbol.dsc$w_length = strlen( symname );
		value.dsc$a_pointer = cp;
		value.dsc$w_length = strlen ( cp );
		if ( value.dsc$w_length > 255 )
		    value.dsc$w_length = 255;
		status = LIB$SET_SYMBOL ( &symbol, &value, &table );
		if ( (status&1) == 0 ) fprintf(stderr,
		    "Error defining %s symbol.  status: %d\n",
		    		    symname, status );
		cp = (newline + 1);
	    }
	    if ( *cp != '\0' ) {
	        /*
		 * Get the last line if there wasn't a terminal newline.
		 */ 
		sprintf( symname, "%sKEY_%d_%d", prefix, count, ++line );
		symbol.dsc$w_length = strlen( symname );
		value.dsc$a_pointer = cp;
		value.dsc$w_length = strlen ( cp );
		if ( value.dsc$w_length > 255 )
		    value.dsc$w_length = 255;
		status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	        if ( (status&1) == 0 ) fprintf(stderr,
		    "Error defining %s symbol.  status: %d\n",
		    		    symname, status );
	    }
	    /*
	     * Set the line count for this key.
	     */
	    sprintf( symname, "%sKEY_%d_COUNT", prefix, count);
	    symbol.dsc$w_length = strlen( symname );
	    sprintf(KeyCount, "%d", line);
	    value.dsc$a_pointer = KeyCount;
	    value.dsc$w_length = strlen ( KeyCount );
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) fprintf(stderr,
		"Error defining %s symbol.  status: %d\n", symname, status );
	}
    }
    return;
}

static void do_cgi_form_env (int m)
{
    int i, j, FLDCount, FIELDSCount, status, length, table;
    $DESCRIPTOR(symbol,"");
    $DESCRIPTOR(value,"");
    char symname[256], sym_list[256], temp[256];
    char *cp;
    register int x;
    symbol.dsc$a_pointer = symname;

    /*
     * Initilize our comma-separated list of names and counters.
     */
    for (i = 0; i < 256; i++)
        sym_list[i] = '\0';
    length = 0;
    FLDCount = 0;
    FIELDSCount = 0;

    /*
     * Define local symbols to be used by calling script.
     */
    table = LIB$K_CLI_LOCAL_SYM;
    /*
     *  Set the foo_FLD_name symbol values.
     *
     *  Note that with this design, multi-line TEXTAREA values are
     *    almost certain to be trunctated.
     */
    sprintf( symname, "%sFLD_", Fprefix );
    symname[255] = '\0';
    for ( x = 0; x < m; x++ ) {
	strncpy( (char *)&symname[Fprefix_len],
			 entries[x].name, (255 - Fprefix_len) );

	/*
	 * Force field names uppercase and convert any dashes to underscores.
	 */
	for ( i = Fprefix_len; symname[i] != '\0'; i++ ) {
	    symname[i] = toupper( symname[i] );
	    if (symname[i] == '-')
	        symname[i] =  '_';
	}
	symbol.dsc$w_length = strlen( symname );

        /*
	 * Check if we already have the name, and if not, set the
	 * new name=value pair, otherwise, append the value to the
	 * existing one as a comma-separated list.
	 */
	i = 0;
	while ( i < x && strcmp( entries[i].name, entries[x].name ) )
	    i++;
	if ( i >= x ) {
	    /*
	     * Set the new pair;
	     */
	    value.dsc$a_pointer = entries[x].val;
	    value.dsc$w_length = strlen ( entries[x].val );
	    if ( value.dsc$w_length > 255 )
	        value.dsc$w_length = 255;
	    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
	    if ( (status&1) == 0 ) {
	        fprintf( stderr,
			 "Error defining %s symbol.  status: %d\n",
			 symname, status );
	    } else {
	        FLDCount++;

	        /*
		 * Create or extend a comma-separated list
		 * of form field names.
		 *
		 * Note that this list is likely to be
		 * trunctated for a large form.
		 */
		j = strlen( entries[x].name );
		if ( (length + j + (sym_list[0] ? 2 : 1)) < 256 ) {
		    if ( sym_list[0] ) {
		        strcat( sym_list, "," );
			length++;
		    }
		    strcat( sym_list, entries[x].name );
		    length += j;
		    FIELDSCount++;
		}
	    }
	} else {
	    /*
	     * Append the current value to the previous value
	     * as a comma separated list.
	     */
	    cp = getenv( symname );
	    j = strlen( entries[x].val ) + (cp ? strlen( cp ) : 256) + 2;
	    if ( j < 256 ) {
	        strcpy( temp, cp );
		strcat( temp, "," );
		strcat( temp, entries[x].val );
		value.dsc$a_pointer = temp;
		value.dsc$w_length = strlen ( temp );
		status = LIB$SET_SYMBOL ( &symbol, &value, &table );
		if ( (status&1) == 0 ) {
		    fprintf( stderr,
		    	     "Error redefining %s symbol.  status: %d\n",
			     symname, status );
		}
	    } else {
	        fprintf( stderr,
	      		 "Error extending %s symbol.  status: %d\n",
			 symname, status );
	    }
	}
    }

    /*
     *  Set a foo_FLD_COUNT symbol with the number of
     *    foo_FLD_name=value symbols that were set,
     *	  where value could be a comma-separated list.
     */
    sprintf( symname, "%sFLD_COUNT", Fprefix );
    symbol.dsc$w_length = strlen( symname );
    sprintf(KeyCount, "%d", FLDCount);
    value.dsc$a_pointer = KeyCount;
    value.dsc$w_length = strlen ( KeyCount );
    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
    if ( (status&1) == 0 ) fprintf(stderr,
	"Error defining %s symbol.  status: %d\n", symname, status );

    /*
     * Output the list of unique names as the foo_FIELDS symbol.
     */
    sprintf( symname, "%sFIELDS", Fprefix );
    symbol.dsc$w_length = strlen ( symname );
    value.dsc$w_length = strlen( sym_list );
    value.dsc$a_pointer = sym_list;
    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
    if ( (status&1) == 0 ) fprintf(stderr,
	"Error defining %s symbol.  status: %d\n", symname, status );

    /*
     * Output a foo_FIELDS_COUNT symbol with
     * the number of (comma-separated) names in the list
     * (might be less than foo_FLD_COUNT).
     */
    sprintf( symname, "%sFIELDS_COUNT", Fprefix );
    symbol.dsc$w_length = strlen( symname );
    sprintf(KeyCount, "%d", FIELDSCount);
    value.dsc$a_pointer = KeyCount;
    value.dsc$w_length = strlen ( KeyCount );
    status = LIB$SET_SYMBOL ( &symbol, &value, &table );
    if ( (status&1) == 0 ) fprintf(stderr,
	"Error defining %s symbol.  status: %d\n", symname, status );

    return;
}