/*
 * Copyright (c) 2003-2013
 * Distributed Systems Software.  All rights reserved.
 * See the file LICENSE for redistribution information.
 */

/*****************************************************************************
 * COPYRIGHT AND PERMISSION NOTICE
 *
 * Copyright (c) 2001-2003 The Queen in Right of Canada
 *
 * All rights reserved.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
 * deal in the Software without restriction, including without limitation
 * the rights to use, copy, modify, merge, publish, distribute, and/or sell
 * copies of the Software, and to permit persons to whom the Software is
 * furnished to do so, provided that the above copyright notice(s) and this
 * permission notice appear in all copies of the Software and that both the
 * above copyright notice(s) and this permission notice appear in supporting
 * documentation.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF THIRD PARTY RIGHTS.
 * IN NO EVENT SHALL THE COPYRIGHT HOLDER OR HOLDERS INCLUDED IN THIS NOTICE
 * BE LIABLE FOR ANY CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES,
 * OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
 * WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
 * ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
 * SOFTWARE.
 *
 * Except as contained in this notice, the name of a copyright holder shall not
 * be used in advertising or otherwise to promote the sale, use or other
 * dealings in this Software without prior written authorization of the
 * copyright holder.
 ***************************************************************************/

/*
 * The DACS language
 *
 * A program (an expression, statement, or sequence of statements) is processed
 * in three passes:
 *   1) lexical processing into tokens;
 *   2) syntax checking; and optionally
 *   3) evaluation via interpretation
 * Parsing is recursive descent.
 *
 * The current implementation does not try very hard to be efficient
 * in terms of parsing, memory use, or speedy interpretation.
 * The language is continuing to evolve, in mostly backward-compatible ways.
 */

#ifndef lint
static const char copyright[] =
"Copyright (c) 2003-2013\n\
Distributed Systems Software.  All rights reserved.";
static const char revid[] =
  "$Id: expr.c 2639 2013-02-27 19:40:13Z brachman $";
#endif

#include "auth.h"
#include "group.h"
#include "acs.h"
#include "http.h"
#include "dacs.h"

#include <math.h>
#ifdef HAVE_LIMITS_H
#include <limits.h>
#endif

#ifndef HAVE_TRUNC
extern double trunc(double);
#endif

static MAYBE_UNUSED char *log_module_name = "dacsexpr";

#ifndef PROG

/* Token classes */
typedef enum {
  TC_UNARY   = 0,	/* Unary operator */
  TC_BINARY  = 1,	/* Binary operator */
  TC_TERNARY = 2,	/* Ternary operator */
  TC_OPERAND = 3,	/* An operand */
  TC_SPEC    = 4	/* Special token */
} Token_class;

typedef struct Lex_token {
  Token token;
  char *lexeme;
  char *token_name;
  Token_class tc;
  int type_length;
  char *startaddr;
  Value *value;
} Lex_token;

typedef struct Lvalue {
  Lex_token *lval;			/* The variable being assigned to */
  Lex_token *assign_op;		/* The type of assignment to this lvalue */
  Token op;					/* The binary operation being performed */
  Value *value;				/* The current value of the lvalue, if needed */
  Var *var;					/* The variable being assigned to */
  Dsvec *refs;				/* Which elements are being modified */
} Lvalue;

typedef struct Func_desc {
  const char *name;		/* Function name */
  const char *arity;	/* Number of arguments */
  char *argdesc;		/* Argument type descriptor string */
  int (*func)(Lex_state *, int, Arglist *, Expr_result *);
  char *desc;
} Func_desc;

typedef struct Func_info {
  const char *name;
  int min_args;
  int max_args;
  const char *argdesc;
  int (*func)(Lex_state *, int, Arglist *, Expr_result *);
  /* This could be extended to instrument function calls... */
} Func_info;

#define L_CHARS(N)		(N)
#define L_ALPHA(N)		-(N)
#define IS_L_CHARS(N)	((N) > 0)
#define IS_L_ALPHA(N)	((N) < 0)

static inline int
lexeme_length(Lex_token *t)
{

  if (IS_L_CHARS(t->type_length))
	return(L_CHARS(t->type_length));
  else if (IS_L_ALPHA(t->type_length))
	return(L_ALPHA(t->type_length));

  return(-1);
}

static inline int
is_numeric_value(Value *v)
{

  return(v->token == T_INTEGER || v->token == T_REAL);
}

static inline int
is_operator(Lex_token *t)
{

  return(t->tc == TC_UNARY || t->tc == TC_BINARY || t->tc == TC_TERNARY);
}

/*
 * Entries are ordered so that we can scan the table from top to bottom.
 *
 * Potential operators:
 *   cmp/<=> : Perl comparison operator
 *   x       : Perl repetition operator
 *   
 */
static Lex_token tokens[] = {
  { T_IF,        "if",   "T_IF",      TC_SPEC,   L_ALPHA(2), NULL, NULL },
  { T_ELSEIF,  "elseif", "T_ELSEIF",  TC_SPEC,   L_ALPHA(6), NULL, NULL },
  { T_ELSE,      "else", "T_ELSE",    TC_SPEC,   L_ALPHA(4), NULL, NULL },
#ifdef NOTDEF
  { T_VBRACE,    "${",   "T_VBRACE",  TC_OPERAND,L_CHARS(2), NULL, NULL },
#endif
  { T_LBRACE,    "{",    "T_LBRACE",  TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_RBRACE,    "}",    "T_RBRACE",  TC_SPEC,   L_CHARS(1), NULL, NULL },

  { T_OR,        "||",   "T_OR",        TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_OR,        "or",   "T_OR",        TC_BINARY, L_ALPHA(2), NULL, NULL },
  { T_AND,       "&&",   "T_AND",       TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_AND,       "and",  "T_AND",       TC_BINARY, L_ALPHA(3), NULL, NULL },

  { T_PLUS_EQ,   "+=",   "T_PLUS_EQ",   TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_MINUS_EQ,  "-=",   "T_MINUS_EQ",  TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_TIMES_EQ,  "*=",   "T_TIMES_EQ",  TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_DIV_EQ,    "/=",   "T_DIV_EQ",    TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_MOD_EQ,    "%=",   "T_MOD_EQ",    TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_BITSHR_EQ, ">>=",  "T_BITSHR_EQ", TC_BINARY, L_CHARS(3), NULL, NULL },
  { T_BITSHL_EQ, "<<=",  "T_BITSHL_EQ", TC_BINARY, L_CHARS(3), NULL, NULL },
  { T_BITAND_EQ, "&=",   "T_BITAND_EQ", TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_BITXOR_EQ, "^=",   "T_BITXOR_EQ", TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_BITOR_EQ,  "|=",   "T_BITOR_EQ",  TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_DOT_EQ,    ".=",   "T_DOT_EQ",    TC_BINARY, L_CHARS(2), NULL, NULL },

  { T_BITSHL,    "<<",   "T_BITSHL",    TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_BITSHR,    ">>",   "T_BITSHR",    TC_BINARY, L_CHARS(2), NULL, NULL },

  { T_LE_I,      "le:i", "T_LE_I",      TC_BINARY, L_CHARS(4), NULL, NULL },
  { T_LT_I,      "lt:i", "T_LT_I",      TC_BINARY, L_CHARS(4), NULL, NULL },
  { T_EQ_I,      "eq:i", "T_EQ_I",      TC_BINARY, L_CHARS(4), NULL, NULL },
  { T_NE_I,      "ne:i", "T_NE_I",      TC_BINARY, L_CHARS(4), NULL, NULL },
  { T_GE_I,      "ge:i", "T_GE_I",      TC_BINARY, L_CHARS(4), NULL, NULL },
  { T_GT_I,      "gt:i", "T_GT_I",      TC_BINARY, L_CHARS(4), NULL, NULL },
  { T_LE,        "<=",   "T_LE",        TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_LE,        "le",   "T_LE",        TC_BINARY, L_ALPHA(2), NULL, NULL },
  { T_LT,        "<",    "T_LT",        TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_LT,        "lt",   "T_LT",        TC_BINARY, L_ALPHA(2), NULL, NULL },
  { T_GE,        ">=",   "T_GE",        TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_GE,        "ge",   "T_GE",        TC_BINARY, L_ALPHA(2), NULL, NULL },
  { T_GT,        ">",    "T_GT",        TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_GT,        "gt",   "T_GT",        TC_BINARY, L_ALPHA(2), NULL, NULL },
  { T_EQ,        "==",   "T_EQ",        TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_EQ,        "eq",   "T_EQ",        TC_BINARY, L_ALPHA(2), NULL, NULL },
  { T_NE,        "!=",   "T_NE",        TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_NE,        "ne",   "T_NE",        TC_BINARY, L_ALPHA(2), NULL, NULL },

  { T_BITOR,     "|",    "T_BITOR",     TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_BITXOR,    "^",    "T_BITXOR",    TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_BITAND,    "&",    "T_BITAND",    TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_BITCPL,    "~",    "T_BITCPL",    TC_UNARY,  L_CHARS(1), NULL, NULL },
  { T_PLUS,      "+",    "T_PLUS",      TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_MINUS,     "-",    "T_MINUS",     TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_EXP,       "**",   "T_EXP",       TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_TIMES,     "*",    "T_TIMES",     TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_DIV,       "/",    "T_DIV",       TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_MOD,       "%",    "T_MOD",       TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_DOTDOT,    "..",   "T_DOTDOT",    TC_BINARY, L_CHARS(2), NULL, NULL },
  { T_DOT,       ".",    "T_DOT",       TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_COND,      "?",    "T_COND",      TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_COLON,     ":",    "T_COLON",     TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_COMMA,     ",",    "T_COMMA",     TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_NOT,       "!",    "T_NOT",       TC_UNARY,  L_CHARS(1), NULL, NULL },
  { T_NOT,       "not",  "T_NOT",       TC_UNARY,  L_ALPHA(3), NULL, NULL },
  { T_LPAREN,    "(",    "T_LPAREN",    TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_RPAREN,    ")",    "T_RPAREN",    TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_LBRACKET,  "[",    "T_LBRACKET",  TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_RBRACKET,  "]",    "T_RBRACKET",  TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_EOS,       ";",    "T_EOS",       TC_SPEC,   L_CHARS(1), NULL, NULL },
  { T_ASSIGN,    "=",    "T_ASSIGN",    TC_BINARY, L_CHARS(1), NULL, NULL },
  { T_HASH,      "#",    "T_HASH",      TC_SPEC,   L_CHARS(1), NULL, NULL },
  /* Numbers and strings are implicit at this point. */
  /* T_UNDEF must be last in this table. */
  { T_UNDEF,     NULL,   "T_UNDEF",     TC_SPEC,   L_CHARS(0), NULL, NULL }
};

static Lex_token token_eoi = {
  T_EOI, NULL, "T_EOI", TC_SPEC, L_CHARS(0), NULL, NULL
};

static Lex_token token_unary_minus = {
  T_UNARY_MINUS, "-", "T_UNARY_MINUS", TC_UNARY, L_CHARS(1), NULL, NULL
};

static Lex_token token_unary_plus = {
  T_UNARY_PLUS, "+", "T_UNARY_PLUS", TC_UNARY, L_CHARS(1), NULL, NULL
};

static Lex_token token_preinc = {
  T_PREINC, "++", "T_PREINC", TC_UNARY, L_CHARS(2), NULL, NULL
};

static Lex_token token_predec = {
  T_PREDEC, "--", "T_PREDEC", TC_UNARY, L_CHARS(2), NULL, NULL
};

static Lex_token token_postinc = {
  T_POSTINC, "++", "T_POSTINC", TC_UNARY, L_CHARS(2), NULL, NULL
};

static Lex_token token_postdec = {
  T_POSTDEC, "--", "T_POSTDEC", TC_UNARY, L_CHARS(2), NULL, NULL
};

static Lex_token token_intval = {
  T_INTEGER, NULL, "T_INTEGER", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_string = {
  T_STRING, NULL, "T_STRING", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_variable = {
  T_VARIABLE, NULL, "T_VARIABLE", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_bstring = {
  T_BSTRING, NULL, "T_BSTRING", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_bool = {
  T_BOOL, NULL, "T_BOOL", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_realval = {
  T_REAL, NULL, "T_REAL", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_literal = {
  T_LITERAL, NULL, "T_LITERAL", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_cast = {
  T_CAST, NULL, "T_CAST", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_func = {
  T_FUNC, NULL, "T_FUNC", TC_OPERAND, L_CHARS(0), NULL, NULL
};

static Lex_token token_listref = {
  T_LIST_REF, NULL, "T_LIST_REF", TC_OPERAND, L_CHARS(0), NULL, NULL
};

#ifdef NOTDEF
static Lex_token token_dotdot = {
  T_DOTDOT, "..", "T_DOTDOT", TC_BINARY, L_CHARS(2), NULL, NULL
};
#endif

/* Such functions are marked for deletion in a future, unspecified release */
#define USE_DEPRECATED

static int is_operand(Lex_state *e, Expr_result *res);
static int heir(Lex_state *e, Expr_result *result);
static int heir2(Lex_state *e, Expr_result *result);
static int heir3(Lex_state *e, Expr_result *result);
static int heir4(Lex_state *e, Expr_result *result);
static int heir5(Lex_state *e, Expr_result *result);
static int heir6(Lex_state *e, Expr_result *result);
static int heir7(Lex_state *e, Expr_result *result);
static int heir8(Lex_state *e, Expr_result *result);
static int heir9(Lex_state *e, Expr_result *result);
static int heir10a(Lex_state *e, Expr_result *result);
static int heir10b(Lex_state *e, Expr_result *result);
static int heir11(Lex_state *e, Expr_result *result);
static int heir12(Lex_state *e, Expr_result *result);
static int heir13a(Lex_state *e, Expr_result *result);
static int heir13b(Lex_state *e, Expr_result *result);
static int heir14(Lex_state *e, Expr_result *result);
static int heir15(Lex_state *e, Expr_result *result);
static int heir17(Lex_state *e, Expr_result *result);
static int eval1(Lex_state *e, Expr_result *res, Token op, Expr_result *r1);
static int eval2(Lex_state *e, Expr_result *res, Token op, Expr_result *r1,
				 Expr_result *r2);
#ifdef NOTDEF
static int eval3(Lex_state *e, Expr_result *res, Token op, Expr_result *r1,
				 Expr_result *r2, Expr_result *r3);
#endif
static int do_if(Lex_state *e, Expr_result *result);
static int eval_function(char *name, Lex_state *e, Arglist *args,
						 Expr_result *result);
static int funargs(Lex_state *e, Arglist **head);
static int indexset(char *s1, char *s2, int icase);
static int force_string(Value *v, char **strp);
static int alist_eq(Value *v1, Value *v2, int icase);
static int list_eq(Value *v1, Value *v2, int icase);
static Value *alistref2(Lex_state *e, Value *value, Dsvec *refs,
						char **errmsg);
#ifdef NOTDEF
static Dsvec *listref2(Lex_state *e, Value *value, Dsvec *refs, char **errmsg);
#endif

static int func_ack(Lex_state *, int, Arglist *, Expr_result *);
static int func_alist(Lex_state *, int, Arglist *, Expr_result *);
static int func_alistref(Lex_state *, int, Arglist *, Expr_result *);
static int func_bstring(Lex_state *, int, Arglist *, Expr_result *);
static int func_contains_any(Lex_state *, int, Arglist *, Expr_result *);
static int func_counter(Lex_state *, int, Arglist *, Expr_result *);
static int func_dacs_admin(Lex_state *, int, Arglist *, Expr_result *);
static int func_dacs_approval(Lex_state *, int, Arglist *, Expr_result *);
static int func_dacs_meta(Lex_state *, int, Arglist *, Expr_result *);
static int func_dacsauth(Lex_state *, int, Arglist *, Expr_result *);
static int func_dacscheck(Lex_state *, int, Arglist *, Expr_result *);
static int func_debug(Lex_state *, int, Arglist *, Expr_result *);
static int func_decode(Lex_state *, int, Arglist *, Expr_result *);
static int func_digest(Lex_state *, int, Arglist *, Expr_result *);
static int func_encode(Lex_state *, int, Arglist *, Expr_result *);
static int func_eval(Lex_state *, int, Arglist *, Expr_result *);
static int func_exec(Lex_state *, int, Arglist *, Expr_result *);
static int func_exit(Lex_state *, int, Arglist *, Expr_result *);
static int func_expand(Lex_state *, int, Arglist *, Expr_result *);
#ifdef NOTDEF
static int func_extern(Lex_state *, int, Arglist *, Expr_result *);
#endif
static int func_file(Lex_state *, int, Arglist *, Expr_result *);
static int func_file_group(Lex_state *, int, Arglist *, Expr_result *);
static int func_file_owner(Lex_state *, int, Arglist *, Expr_result *);
static int func_from(Lex_state *, int, Arglist *, Expr_result *);
static int func_get(Lex_state *, int, Arglist *, Expr_result *);
static int func_hash(Lex_state *, int, Arglist *, Expr_result *);
static int func_hmac(Lex_state *, int, Arglist *, Expr_result *);
static int func_http(Lex_state *, int, Arglist *, Expr_result *);
static int func_index(Lex_state *, int, Arglist *, Expr_result *);
static int func_info(Lex_state *, int, Arglist *, Expr_result *);
static int func_keysof(Lex_state *, int, Arglist *, Expr_result *);
static int func_ldap(Lex_state *, int, Arglist *, Expr_result *);
static int func_length(Lex_state *, int, Arglist *, Expr_result *);
static int func_list(Lex_state *, int, Arglist *, Expr_result *);
static int func_listref(Lex_state *, int, Arglist *, Expr_result *);
static int func_on_success(Lex_state *, int, Arglist *, Expr_result *);
static int func_password(Lex_state *, int, Arglist *, Expr_result *);
static int func_pathname(Lex_state *, int, Arglist *, Expr_result *);
static int func_pbkdf2(Lex_state *, int, Arglist *, Expr_result *);
static int func_print(Lex_state *, int, Arglist *, Expr_result *);
static int func_printf(Lex_state *, int, Arglist *, Expr_result *);
static int func_random(Lex_state *, int, Arglist *, Expr_result *);
static int func_redirect(Lex_state *, int, Arglist *, Expr_result *);
static int func_regmatch(Lex_state *, int, Arglist *, Expr_result *);
static int func_regsub(Lex_state *, int, Arglist *, Expr_result *);
static int func_request_match(Lex_state *, int, Arglist *, Expr_result *);
static int func_rule(Lex_state *, int, Arglist *, Expr_result *);
static int func_setvar(Lex_state *, int, Arglist *, Expr_result *);
static int func_sizeof(Lex_state *, int, Arglist *, Expr_result *);
static int func_sleep(Lex_state *, int, Arglist *, Expr_result *);
static int func_source(Lex_state *, int, Arglist *, Expr_result *);
static int func_sprintf(Lex_state *, int, Arglist *, Expr_result *);
static int func_strftime(Lex_state *, int, Arglist *, Expr_result *);
static int func_strptime(Lex_state *, int, Arglist *, Expr_result *);
static int func_strchars(Lex_state *, int, Arglist *, Expr_result *);
static int func_strchop(Lex_state *, int, Arglist *, Expr_result *);
static int func_strrstr(Lex_state *, int, Arglist *, Expr_result *);
static int func_strstr(Lex_state *, int, Arglist *, Expr_result *);
static int func_strtolower(Lex_state *, int, Arglist *, Expr_result *);
static int func_strtoupper(Lex_state *, int, Arglist *, Expr_result *);
static int func_strtr(Lex_state *, int, Arglist *, Expr_result *);
static int func_subset(Lex_state *, int, Arglist *, Expr_result *);
static int func_substr(Lex_state *, int, Arglist *, Expr_result *);
static int func_syntax(Lex_state *, int, Arglist *, Expr_result *);
static int func_system(Lex_state *, int, Arglist *, Expr_result *);
static int func_time(Lex_state *, int, Arglist *, Expr_result *);
static int func_transform(Lex_state *, int, Arglist *, Expr_result *);
static int func_transform_config(Lex_state *, int, Arglist *, Expr_result *);
static int func_trim(Lex_state *, int, Arglist *, Expr_result *);
static int func_typeof(Lex_state *, int, Arglist *, Expr_result *);
static int func_undef(Lex_state *, int, Arglist *, Expr_result *);
static int func_user(Lex_state *, int, Arglist *, Expr_result *);
static int func_user_revoke(Lex_state *, int, Arglist *, Expr_result *);
static int func_ustamp(Lex_state *, int, Arglist *, Expr_result *);
static int func_valuesof(Lex_state *, int, Arglist *, Expr_result *);
static int func_var(Lex_state *, int, Arglist *, Expr_result *);
static int func_vfs(Lex_state *, int, Arglist *, Expr_result *);

/*
 * See validate_func_call().
 * The first field is the name by which the function is invoked.
 * The second field is the arity; the first number is the minimum number
 * of arguments, which can be followed by '+' to indicate zero or more
 * arguments may follow, or ".." and a number to indicate that there may be
 * up to that maximum number of arguments, or nothing to indicate that that
 * is the exact number of arguments permitted.
 * So "1+" means one or more arguments, "2..4" means two, three, or four
 * arguments are allowed, and "0" means no arguments are allowed.
 * The third field is the argument descriptor string; its nth character
 * classifies the nth argument:
 * '-': leave the argument as-is
 * 's': convert the argument to a T_STRING if necessary
 * 'S': the argument must already be a T_STRING or T_LITERAL
 * 'i': convert the argument to a T_INTEGER if necessary
 * 'I': the argument must already be a T_INTEGER
 * 'r': convert the argument to a T_REAL if necessary
 * 'R': the argument must already be a T_REAL
 * 'b': convert the argument to a T_BSTRING if necessary
 * 'B': the argument must already be a T_BSTRING
 * 'c': convert the argument to a T_STRING or T_BSTRING if necessary
 * 'C': the argument must already be a T_STRING or a T_BSTRING
 * 'L': the argument must already be a T_LIST
 * 'A': the argument must already be a T_ALIST
 * 'T': the argument must already be a T_LIST or T_ALIST
 * '*': means zero or more arguments may follow but quit validating;
 *      if present, this must be last
 * If there is no maximum argument count specified, the nth element of the
 * descriptor string is meaningful only if there really are that many
 * arguments; e.g., "S" means that if
 * there is one argument it must be a string and implies there can be no
 * arguments or exactly 1 argument.
 * An empty descriptor means leave all arguments as-is.
 *
 * XXX We might also support dynamically loaded functions by providing
 * a way for the administrator to give the callable name, its arity and
 * arg spec, and its library name and the file containing the function.
 * We'd then use dlopen() etc. to link in the function.
 */
Func_desc functions[] = {
  { "ack",             "1+",    "S*",    func_ack,
  	"notice acknowledgement processing" },
  { "alist",           "0+",    "*",     func_alist,
  	"create an alist" },
  { "alistref",        "1",     "L",     func_alistref,
  	"create an alist reference" },
  { "bstring",         "2",     "cI",    func_bstring,
  	"convert a string to binary" },
  { "contains_any",    "3..4",  "SSS*",  func_contains_any,
  	"count elements common to two lists" },
  { "counter",         "3..4",  "SSSi",  func_counter,
  	"persistent integer counters" },
  { "dacs_admin",      "0",     "",      func_dacs_admin,
  	"test if user is an administrator" },
  { "dacs_approval",   "1+",    "S*",    func_dacs_approval,
  	"create or test a signed authorization" },
  { "dacs_meta",       "1+",    "S*",    func_dacs_meta,
  	"get or update metadata" },
  { "dacsauth",        "1+",    "*",     func_dacsauth,
  	"perform authentication tests" },
  { "dacscheck",       "1+",    "*",     func_dacscheck,
  	"perform authorization tests" },
  { "debug",           "2",     "S*",    func_debug,
  	"control debugging output" },
  { "decode",          "2",     "SS",    func_decode,
  	"convert from a text representation" },
  { "digest",          "2..3",  "ciS",   func_digest,
  	"cryptographic hash functions" },
  { "encode",          "2",     "Sc",    func_encode,
  	"convert to a text representation" },
  { "eval",            "1",     "S",     func_eval,
  	"evaluate a string" },
  { "exec",            "1+",    "*",     func_exec,
  	"execute a program" },
  { "exit",            "1",     "-",     func_exit,
  	"terminate current evaluation" },
  { "expand",          "1",     "S",     func_expand,
  	"variable interpolation" },
#ifdef NOTDEF
  { "extern",          "1+",     "s",     func_extern,
  	"call external function" },
#endif
  { "file",            "1+",    "S*",    func_file,
  	"perform an operation on a file" },
  { "file_group",      "0..1",  "S",     func_file_group,
  	"test if user is associated with file's group" },
  { "file_owner",      "0..1",  "S",     func_file_owner,
  	"test if user is associated with file's owner" },
  { "from",            "1",     "s",     func_from,
  	"test where the current request comes from" },
  { "get",             "1..2",  "S*",    func_get,
  	"read the contents of a file or VFS object" },
  { "hash",            "2..3",  "ciS",   func_hash,
  	"fast hashes" },
  { "hmac",            "4..5",  "ciciS", func_hmac,
  	"secure keyed-hashes" },
  { "http",            "1+",    "S*",    func_http,
  	"invoke an HTTP request" },
  { "index",           "2..3",  "*",     func_index,
  	"search for a character in a string" },
  { "info",            "1..2",  "S*",    func_info,
  	"information about namespaces and variables" },
  { "keysof",           "1",     "A",    func_keysof,
  	"extract keys from an alist" },
  { "ldap",            "2..3",  "ss*",   func_ldap,
  	"extract a component from an LDAP name" },
  { "length",          "1",     "-",     func_length,
  	"string length" },
  { "list",            "0+",    "*",     func_list,
  	"create a list" },
  { "listref",         "2+",    "T*",    func_listref,
  	"dereference a list" },
  { "on_success",      "1+",    "SS",    func_on_success,
  	"evaluate an expression if authentication or authorization succeeds" },
  { "password",        "1+",    "SS*",   func_password,
  	"compute or check a password hash" },
  { "pathname",        "3",     "SSs*",  func_pathname,
  	"filename-based string interpolation" },
  { "pbkdf2",          "4",     "bbii",  func_pbkdf2,
  	"password-based key derivation" },
  { "print",           "0+",    "*",     func_print,
  	"display a string" },
  { "printf",          "1+",    "S*",    func_printf,
  	"display a formatted string" },
  { "random",          "2..3",  "S*",    func_random,
  	"generate random values" },
  { "redirect",        "1..2",  "sS",    func_redirect,
  	"redirect user after access is denied" },
  { "regmatch",        "2..4",  "SS*",   func_regmatch,
  	"string matching" },
  { "regsub",          "3..5",  "SSS*",  func_regsub,
  	"string substitution" },
  { "request_match",   "1",     "S",     func_request_match,
  	"compare the current request to a URI" },
  { "return",          "1",     "-",     func_exit,
  	"terminate current evaluation" },
  { "revoke",          "1",     "S",     func_user_revoke,
  	"UNIMPLEMENTED" },
  { "rule",            "2",     "SS",    func_rule,
  	"recursive authorization checking" },
  { "setvar",          "2+",    "SS*",   func_setvar,
  	"operations on namespaces" },
  { "sizeof",          "1",     "*",     func_sizeof,
  	"basic data type sizes" },
  { "sleep",           "1",     "i",     func_sleep,
  	"suspend execution temporarily" },
  { "source",          "1..2",  "Ss",    func_source,
  	"read and evaluate external expressions" },
  { "sprintf",         "1+",    "S*",    func_sprintf,
  	"format a string" },
  { "strchars",        "2+",    "SS*",   func_strchars,
  	"select characters from a string" },
  { "strchop",        "2",      "SS",    func_strchop,
  	"delete characters from end of a string" },
  { "strftime",        "1",     "S",     func_strftime,
  	"format the current date and time" },
  { "strptime",        "1..3",  "SSS",   func_strptime,
  	"parse a date and time" },
  { "strrstr",         "2..3",  "SSS",   func_strrstr,
  	"locate last instance of a substring" },
  { "strstr",          "2..3",  "SSS",   func_strstr,
  	"locate first instance of a substring" },
  { "strtolower",      "1",     "S",     func_strtolower,
  	"map uppercase characters to lowercase" },
  { "strtoupper",      "1",     "S",     func_strtoupper,
  	"map lowercase characters to uppercase" },
  { "strtr",           "2..4",  "SS*",   func_strtr,
  	"character transliteration" },
  { "subset",          "3..4",  "SSS*",  func_subset,
  	"test if one set is a subset of another" },
  { "substr",          "3",     "SII",   func_substr,
  	"extract a substring" },
  { "syntax",          "2..3",  "SSS",   func_syntax,
  	"perform a syntax check on a string" },
  { "system",          "1",     "S",     func_system,
  	"UNIMPLEMENTED" },
  { "time",            "1..2",  "s*",    func_time,
  	"local time and date" },
  { "transform",       "4..6",  "SCSS*", func_transform,
  	"filter text through rule-based transformations" },
  { "transform_config","1",     "S",     func_transform_config,
  	"set options for transform" },
  { "trim",            "2..3",  "sSI",   func_trim,
  	"delete trailing characters" },
  { "typeof",          "1..2",  "*",     func_typeof,
  	"get or test data type" },
  { "undef",           "0",     "",      func_undef,
  	"an undefined value" },
  { "user",            "1",     "S",     func_user,
  	"test current user's identity" },
  { "ustamp",          "2..3",  "SSS",   func_ustamp,
  	"generate a unique stamp" },
  { "valuesof",        "1",     "A",     func_valuesof,
  	"extract values from an alist" },
  { "var",             "3+",    "SS*",   func_var,
  	"operations on individual variables" },
  { "vfs",             "1+",    "s*",    func_vfs,
  	"perform a VFS operation" },
  { NULL,              "0",     NULL,   NULL,
    NULL }
};

typedef struct Typename_map {
  Token token;
  char *typename[3];	/* Canonical name of the type, with optional aliases. */
} Typename_map;

static Typename_map typenames[] = {
  { T_INTEGER, { "integer",  "int",     NULL }},
  { T_REAL,    { "real",     "double",  NULL }},
  { T_STRING,  { "string",   NULL,      NULL }},
  { T_LITERAL, { "bareword", NULL,      NULL }},
  { T_BOOL,    { "bool",     NULL,      NULL }},
  { T_BSTRING, { "binary",   "bstring", NULL }},
  { T_LIST,    { "list",     NULL,      NULL }},
  { T_ALIST,   { "alist",    NULL,      NULL }},
  { T_VOID,    { "void",     NULL,      NULL }},
  { T_UNDEF,   { NULL,       NULL,      NULL }}
};

/* EXPERIMENTAL */
typedef struct Castname_map {
  Token token;
  char *castname[3];
} Castname_map;

static Castname_map castnames[] = {
  { T_B16U,    { "HEX", "BASE16", NULL }},
  { T_B16,     { "hex", "base16", NULL }},
  { T_B10,     { "dec", "base10", NULL }},
  { T_B8,      { "oct", "base8",  NULL }},
  { T_B2,      { "bin", "base2",  NULL }},
  { T_UNDEF,   { NULL,  NULL,     NULL }}
};

static int is_batch = 0;
static int do_lexdump = 0;

/*
 * Return the lexical token N before or after the current one,
 * otherwise return NULL.
 */
static Lex_token *
token_lookahead(Lex_state *e, int n)
{
  int ind;
  Lex_token *t;

  ind = e->ctn + n;
  if (ind < 0 || ind >= dsvec_len(e->lexptr))
	return(NULL);

  t = dsvec_ptr(e->lexptr, (unsigned int) ind, Lex_token *);

  return(t);
}

/*
 * Return 1 if the lexical token N before or after the current one is TOKEN,
 * otherwise return 0.
 */
static int
token_is(Lex_state *e, int n, Token token)
{
  int ind;
  Lex_token *t;

  ind = e->ctn + n;
  if (ind < 0 || ind >= dsvec_len(e->lexptr))
	return(0);

  t = dsvec_ptr(e->lexptr, (unsigned int) ind, Lex_token *);
  if (t != NULL && t->token == token)
	return(1);

  return(0);
}

#ifdef NOTDEF
/*
 * Return the lexical token N before (or after) the current one, but only if
 * it is TOKEN, otherwise return NULL.
 */
static Lex_token *
token_is_match(Lex_state *e, int n, Token token)
{
  int ind;
  Lex_token *t;

  ind = e->ctn + n;
  if (ind < 0 || ind >= dsvec_len(e->lexptr))
	return(NULL);

  t = dsvec_ptr(e->lexptr, (unsigned int) ind, Lex_token *);
  if (t != NULL && t->token == token)
	return(t);

  return(NULL);
}
#endif

static int
token_advance(Lex_state *e, int n)
{
  int i;
  Lex_token *t;

  for (i = 0; i < n; i++) {
	t = dsvec_ptr(e->lexptr, e->ctn, Lex_token *);
	if (t->token == T_EOI)
	  return(-1);
	e->ctn++;
  }

  return(0);
}

static void
token_save(Lex_state *e, int *ctn_save)
{

  *ctn_save = e->ctn;
}

static void
token_restore(Lex_state *e, int new_ctn)
{

  e->ctn = new_ctn;
}

/*
 * If the current token matches TOKEN, return it and advance to the next
 * token, otherwise return NULL.
 */
static Lex_token *
token_matches(Lex_state *e, Token token)
{
  Lex_token *t;

  t = dsvec_ptr(e->lexptr, e->ctn, Lex_token *);
  if (t->token == T_EOI)
	return(NULL);

  if (t->token == token) {
	token_advance(e, 1);
	return(t);
  }

  return(NULL);
}

Lex_token *
token_lookup(Token t)
{
  int i;

  for (i = 0; tokens[i].token != T_UNDEF; i++) {
	if (tokens[i].token == t)
	  return(&tokens[i]);
  }

  if (token_eoi.token == t)
	return(&token_eoi);
  if (token_unary_minus.token == t)
	return(&token_unary_minus);
  if (token_unary_plus.token == t)
	return(&token_unary_plus);
  if (token_preinc.token == t)
	return(&token_preinc);
  if (token_predec.token == t)
	return(&token_predec);
  if (token_postinc.token == t)
	return(&token_postinc);
  if (token_postdec.token == t)
	return(&token_postdec);
  if (token_string.token == t)
	return(&token_string);
  if (token_bstring.token == t)
	return(&token_bstring);
  if (token_bool.token == t)
	return(&token_bool);
  if (token_cast.token == t)
	return(&token_cast);
  if (token_intval.token == t)
	return(&token_intval);
  if (token_realval.token == t)
	return(&token_realval);
  if (token_literal.token == t)
	return(&token_literal);
  if (token_func.token == t)
	return(&token_func);
  if (token_listref.token == t)
	return(&token_listref);
#ifdef NOTDEF
  if (token_dotdot.token == t)
	return(&token_dotdot);
#endif

  return(NULL);
}
	
static Token
token_current(Lex_state *e)
{
  int ind;
  Lex_token *t;

  ind = e->ctn;
  t = dsvec_ptr(e->lexptr, (unsigned int) ind, Lex_token *);
  if (t == NULL)
	return(T_UNDEF);

  return(t->token);
}

static char *
token_name(Token t)
{
  Lex_token *lt;

  if ((lt = token_lookup(t)) == NULL)
	return(NULL);

  return(lt->token_name);
}

static Token
typename_to_type(char *typename)
{
  int i, j;

  for (i = 0; typenames[i].token != T_UNDEF; i++) {
	for (j = 0; typenames[i].typename[j] != NULL; j++) {
	  if (strcaseeq(typename, typenames[i].typename[j]))
		return(typenames[i].token);
	}
  }

  return(T_UNDEF);
}

static char *
type_to_typename(Token t)
{
  int i;

  for (i = 0; typenames[i].typename != NULL; i++) {
	if (t == typenames[i].token)
	  return(typenames[i].typename[0]);
  }

  return(NULL);
}

static Token
castname_to_type(char *castname)
{
  int i, j;

  for (i = 0; castnames[i].token != T_UNDEF; i++) {
	for (j = 0; castnames[i].castname[j] != NULL; j++) {
	  if (streq(castname, castnames[i].castname[j]))
		return(castnames[i].token);
	}
  }

  return(T_UNDEF);
}

static MAYBE_UNUSED char *
type_to_castname(Token t)
{
  int i;

  for (i = 0; castnames[i].castname != NULL; i++) {
	if (t == castnames[i].token)
	  return(castnames[i].castname[0]);
  }

  return(NULL);
}

static int
str_or_lit(Token token)
{

  return(token == T_STRING || token == T_LITERAL);
}

/*
 * It is sometimes necessary to ignore an evaluation error.
 */
static void
seterr_reset(Lex_state *e, Expr_result *result)
{

  e->do_eval = 1;
  result->err = 0;
  result->errmsg = NULL;
}

static void
seterr(Lex_state *e, Expr_result *result, Acs_expr_result err, char *msg)
{
  Lex_token *t;
  Ds ds;

  /* An error has occurred, so stop evaluating expressions. */
  e->do_eval = 0;

  result->err = err;
  if (result->errmsg == NULL) {
	ds_init(&ds);
	ds_asprintf(&ds, "%s", msg);

	t = token_lookahead(e, 0);
	if (t->token == T_EOI)
	  ds_asprintf(&ds, ", token=end-of-input");
	else if (t->token == T_EOS)
	  ds_asprintf(&ds, ", token=end-of-statement");
	else if (t->lexeme != NULL)
	  ds_asprintf(&ds, ", token=\"%s\"", t->lexeme);
	else
	  ds_asprintf(&ds, ", token=%d", t->token);

	if (t->startaddr != NULL)
	  ds_asprintf(&ds, " at offset=%d", t->startaddr - e->expr);

	if ((t = token_lookahead(e, -1)) != NULL)
	  ds_asprintf(&ds, " prev_token=\"%s\"", t->lexeme);
	else
	  ds_asprintf(&ds, " prev_token=start-of-input");

	result->errmsg = ds_buf(&ds);
  }
}

static void
seterr_e(Lex_state *e, Expr_result *result, char *msg)
{

  seterr(e, result, ACS_EXPR_EVAL_ERROR, msg);
}

#ifdef NOTDEF
static void
seterr_l(Lex_state *e, Expr_result *result, char *msg)
{

  seterr(e, result, ACS_EXPR_LEXICAL_ERROR, msg);
}
#endif

static void
seterr_s(Lex_state *e, Expr_result *result, char *msg)
{

  seterr(e, result, ACS_EXPR_SYNTAX_ERROR, msg);
}

typedef enum Comment_style {
  COMMENT_NONE    = 0,
  COMMENT_SLASHES = 1,
  COMMENT_C       = 2,
  COMMENT_HASH    = 3
} Comment_style;

static inline int
isws(int ch)
{

  return(ch == ' ' || ch == '\t' || ch == '\n');
}

static inline int
ishc(char *buf_start, char *hchar)
{

  if (*hchar != '#')
	return(0);
  if (hchar == buf_start)
	return(1);
  if (!isws(*(hchar - 1)))
	return(0);
  return(1);
}

/*
 * Given an expression, remove all commented out areas.
 * If there isn't at least one comment, return NULL (so that the original
 * copy of the expression can be used), otherwise return a comment-free
 * copy of the expression.
 *
 * We recognize C++ style comments ("// a comment until end-of-line")
 * and Shell style comments ("# a comment until end-of-line").
 */
Ds *
acs_elide_comments(char *expr)
{
  int quote_ch;
  char *comment_start, *p, *start_p;
  Ds *ds;
  Comment_style cstyle;

  if (expr == NULL)
	return(NULL);

  start_p = p = expr;
  comment_start = NULL;
  cstyle = COMMENT_NONE;

  /* Scan for comment initiating characters. */
  quote_ch = '\0';
  while (*p != '\0') {
	if (*p == '"' || *p == '\'') {
	  if (*p == quote_ch)
		quote_ch = '\0';
	  else
		quote_ch = *p;
	}
	else if (quote_ch == '\0'
			 && (ishc(start_p, p)
				 || (*p == '/' && *(p + 1) == '/')
				 || (*p == '/' && *(p + 1) == '*'))) {
	  comment_start = p;
	  if (*p == '#')
		cstyle = COMMENT_HASH;
	  else if (*(p + 1) == '/')
		cstyle = COMMENT_SLASHES;
	  else
		cstyle = COMMENT_C;
	  break;
	}
	p++;
  }

  if (comment_start == NULL)
	return(NULL);

  /*
   * There is at least one comment.
   * Copy whatever precedes the start of comment.
   */
  ds = ds_init(NULL);
  if (comment_start - start_p) {
	ds_concatn(ds, start_p, comment_start - start_p);
	ds_concatc(ds, '\n');
  }

  while (*p != '\0') {
	/* We're at the start of a comment. */
	if (cstyle == COMMENT_HASH)
	  p++;
	else
	  p += 2;

	/* Skip (elide) until the end of comment (or end of line or buffer). */
	while (*p != '\0') {
	  if ((cstyle == COMMENT_SLASHES && (*p == '\n' || *p == '\0'))
		  || (cstyle == COMMENT_HASH && (*p == '\n' || *p == '\0'))
		  || (cstyle == COMMENT_C && *p == '*' && *(p + 1) == '/'))
		break;
	  p++;
	}

	if (cstyle == COMMENT_SLASHES || cstyle == COMMENT_HASH) {
	  if (*p != '\0')
		p++;
	}
	else
	  p += 2;

	cstyle = COMMENT_NONE;

	/* Copy until the start of the next comment or end of buffer. */
	quote_ch = '\0';
	while (*p != '\0') {
	  if (*p == '"' || *p == '\'') {
		if (*p == quote_ch)
		  quote_ch = '\0';
		else
		  quote_ch = *p;
	  }
	  else if (quote_ch == '\0' &&
			   (ishc(start_p, p)
				|| (*p == '/' && *(p + 1) == '/')
				|| (*p == '/' && *(p + 1) == '*'))) {
		if (*p == '#')
		  cstyle = COMMENT_HASH;
		else if (*(p + 1) == '/')
		  cstyle = COMMENT_SLASHES;
		else
		  cstyle = COMMENT_C;
		break;
	  }
	  ds_concatc(ds, (int) *p);
	  p++;
	}
  }

  if (cstyle != COMMENT_NONE)
	log_msg((LOG_ERROR_LEVEL, "Unterminated comment found"));

  return(ds);
}

static void
lexdump(char *str, Dsvec lexptr, int n)
{
  int i;
  Lex_token *t;

  for (i = 0; i < n; i++) {
	if ((t = dsvec_ptr(&lexptr, i, Lex_token *)) == NULL)
	  break;
	if (t->lexeme != NULL)
	  fprintf(stderr, "token %2d: \"%s\"", i, strquote(t->lexeme, "\""));
	else
	  fprintf(stderr, "token %2d: %d", i, t->token);

	if (t->token_name != NULL)
	  fprintf(stderr, " (%s)", t->token_name);
	if (t->startaddr != NULL)
	  fprintf(stderr, " at offset %u", (unsigned int) (t->startaddr - str));
	fprintf(stderr, "\n");
  }
}

static char *
dotdot_symbol()
{
  Lex_token *t;
  static char *sym = NULL;

  if (sym != NULL)
	return(sym);

  if ((t = token_lookup(T_HASH)) == NULL)
	return(NULL);		/* ??? */

  return(sym = t->lexeme);
}

/*
 * An intval is a string of decimal digits (no sign).
 * If there's at least one decimal digit, set *VAL to the value of
 * the integer and ENDP (if non-NULL) to point to the first non-digit
 character, and return 1.
 * strtol(3) recognizes octal, decimal, and hex values.
 * Return 0 if no integer is found.
 * Return -1 if the integer is invalid.
 */
int
is_intval_str(char *str, long *val, char **endp)
{
  char *end;
  long v;

  if (!isdigit((int) *str))
	return(0);

  /* A base of 0 means to expect a C-style integer constant. */
  v = strtol(str, &end, 0);
  if (end == str)
	return(0);
  if ((v == LONG_MAX || v == LONG_MIN) && errno == ERANGE)
    return(-1);

  if (val != NULL)
	*val = v;

  if (endp != NULL)
	*endp = end;

  return(1);
}

#ifdef NOTDEF
static int
make_integer(char *str, Expr_result *res)
{
  long val;

  if (is_intval_str(str, &val, NULL) != 1)
    return(-1);

  res->value.token = T_INTEGER;
  res->value.val.intval = val;
  res->err = 0;
  res->errmsg = NULL;
  return(0);
}
#endif

/*
 * A realval is an optional string of decimal digits (possibly signed)
 * followed by a period and at least one digit or an 'e' or 'E' followed
 * by at least one digit.
 * If the legal syntax appears, set *VAL to the value of the real number and
 * ENDP to point to the first character not part of the number, and
 * return 1.
 * Return 0 if no real is found.
 * Return -1 if the real is invalid.
 */
static int
is_realval_str(char *str, double *val, char **endp)
{
  char *end;
  double v;

  if (!isdigit((int) *str) && *str != '.')
    return(0);

  v = strtod(str, &end);
  if (end == str)
    return(0);
  if ((v == HUGE_VAL || v == -HUGE_VAL || v == 0.0) && errno == ERANGE)
    return(-1);

  if (endp != NULL)
	*endp = end;
  *val = v;
  return(1);
}

static int
is_exponent_str(char *str)
{
  char *p;

  p = str;
  if (*p != 'e' && *p != 'E')
    return(0);
  p++;

  if (*p == '+' || *p == '-')
    p++;

  if (isdigit((int) *p))
    return(1);

  return(0);
}

static Value *
vinit_value(Value *v, Token token, va_list ap)
{
  Value *value;

  if (v != NULL)
	value = v;
  else
	value = ALLOC(Value);

  value->token = token;
  value->is_var_reference = 0;
  value->is_alist_reference = 0;
  value->is_quoted = 0;
  value->varname = NULL;

  if (token == T_REAL)
	value->val.realval = va_arg(ap, double);
  else if (token == T_INTEGER)
	value->val.intval = va_arg(ap, long);
  else if (token == T_STRING || token == T_FUNC || token == T_LITERAL)
	value->val.strval = va_arg(ap, char *);
  else if (token == T_VARIABLE) {
	value->is_var_reference = 1;
	value->varname = va_arg(ap, char *);
	value->val.strval = NULL;
  }
  else if (token == T_LIST) {
	value->val.listval.list = dsvec_init(NULL, va_arg(ap, size_t));
	value->val.listval.dim = NULL;
  }
  else if (token == T_ALIST) {
	value->val.alistval.kwv = kwv_init(4);
	/* No duplicate keys. */
	kwv_set_mode(value->val.alistval.kwv, "dn");
  }
  else if (token == T_DOTDOT)
	value->val.dotdot.min = value->val.dotdot.max = 0;
  else if (token == T_UNDEF)
	value->val.strval = NULL;

  return(value);
}

Value *
init_value(Value *v, Token token, ...)
{
  Value *value;
  va_list ap;

  va_start(ap, token);
  value = vinit_value(v, token, ap);
  va_end(ap);

  return(value);
}

static Value *
copy_value(Value *dst, Value *src)
{
  Value *dst_value;

  if (dst != NULL)
	dst_value = dst;
  else
	dst_value = ALLOC(Value);

  dst_value->token = src->token;
  dst_value->is_var_reference = src->is_var_reference;
  dst_value->is_alist_reference = src->is_alist_reference;
  dst_value->varname = (src->varname == NULL)
	? NULL : strdup(src->varname);
  dst_value->is_quoted = src->is_quoted;

  switch (src->token) {
  case T_REAL:
	dst_value->val.realval = src->val.realval;
	break;

  case T_INTEGER:
	dst_value->val.intval = src->val.intval;
	break;

  case T_LITERAL:
  case T_STRING:
	dst_value->val.strval = (src->val.strval == NULL)
	  ? NULL : strdup(src->val.strval);
	break;

  case T_VARIABLE:
	dst_value->val.strval = (src->val.strval == NULL)
	  ? NULL : strdup(src->val.strval);
	break;

  case T_BSTRING:
	dst_value->val.bval.data = memdupn(src->val.bval.data,
								   src->val.bval.len);
	dst_value->val.bval.len = src->val.bval.len;
	break;

  case T_LIST:
	dst_value->val.listval.list = dsvec_copy(NULL, src->val.listval.list);
	break;

  case T_ALIST:
	dst_value->val.alistval.kwv = kwv_copy(src->val.alistval.kwv);
	break;

  case T_DOTDOT:
	dst_value->val.dotdot.min = src->val.dotdot.min;
	dst_value->val.dotdot.max = src->val.dotdot.max;
	break;

  default:
	dst_value = NULL;
	break;
  }

  return(dst_value);
}

static Expr_result *
copy_result(Expr_result *new_result, Expr_result *old_result)
{
  Expr_result *r;

  if (new_result != NULL)
	r = new_result;
  else
	r = ALLOC(Expr_result);

  copy_value(&r->value, &old_result->value);
  r->err = old_result->err;
  r->errmsg = old_result->errmsg;
  r->exit_called = old_result->exit_called;

  return(r);
}

static Expr_result *
expr_result_from_value(Expr_result *result, Value *value)
{
  Expr_result *er;

  if (result != NULL)
	er = result;
  else
	er = ALLOC(Expr_result);

  copy_value(&er->value, value);

  er->err = ACS_EXPR_FALSE;
  er->errmsg = NULL;
  er->exit_called = 0;

  return(er);
}

static Expr_result *
init_expr_result(Expr_result *result, Token token, ...)
{
  va_list ap;
  Expr_result *er;

  if (result != NULL)
	er = result;
  else
	er = ALLOC(Expr_result);

  va_start(ap, token);
  vinit_value(&er->value, token, ap);
  va_end(ap);

  er->err = ACS_EXPR_FALSE;
  er->errmsg = NULL;
  er->exit_called = 0;

  return(er);
}

static int
value_init(Expr_result *new_res, Expr_result *old_res)
{

  init_expr_result(new_res, T_UNDEF);
  new_res->err = old_res->err;
  new_res->errmsg = old_res->errmsg;

  if (new_res->err)
	return(-1);
  return(0);
}

/*
 * If the initial part of STR is an integer or real number, create a token,
 * set ENDP to the first character not part of the number, and return 1.
 * ENDP may be NULL if no end pointer is required.
 * TP may be NULL if no token is required.
 * If no number can be constructed, return 0; if a number appears but is
 * invalid (e.g., too big), return -1; otherwise, return 1.
 */
static int
is_number_str(char *str, Lex_token **tp, char **endp)
{
  int st;
  char *p;
  long intval;
  double realval;
  Lex_token *t;

  p = str;
  if (*p == '.') {
	/* Is there a fractional part? */
	if (!isdigit((int) *(p + 1)))
	  return(0);
  }
  else {
	/* Advance past an initial integer part. */
	while (isdigit((int) *p))
	  p++;
	if (p == str)
	  return(0);

	if (*p == '.' && *(p + 1) == '.')
	  goto intval;
  }

  /* This is a number, but is it an integer or a real? */
  if (*p == '.' || is_exponent_str(p)) {
    if ((st = is_realval_str(str, &realval, endp)) == -1)
      return(-1);
    if (st == 1) {
	  if (tp == NULL)
		return(1);
      t = ALLOC(Lex_token);
      t->token = T_REAL;
	  t->token_name = "T_REAL";
      t->tc = TC_OPERAND;
	  t->startaddr = str;
      t->value = init_value(NULL, T_REAL, realval);
      *tp = t;
      return(1);
    }
    /* Fall through and guess that it's supposed to be an integer */
  }

  intval:

  if ((st = is_intval_str(str, &intval, endp)) == 1) {
	if (tp == NULL)
	  return(1);
	t = ALLOC(Lex_token);
	t->token = T_INTEGER;
	t->token_name = "T_INTEGER";
	t->tc = TC_OPERAND;
	t->startaddr = str;
	t->value = init_value(NULL, T_INTEGER, intval);
	*tp = t;
	return(1);
  }

  return(st);
}

/*
 * Test if V should be treated as True (return 1) or False (return 0).
 * Return -1 if the test does not make sense for V.
 */
static int
is_true_value(Value *v)
{

  if (str_or_lit(v->token) || v->token == T_INTEGER || v->token == T_REAL) {
	if ((v->token == T_INTEGER && v->val.intval == 0L)
		|| (v->token == T_STRING && v->val.strval[0] == '\0')
		|| (v->token == T_STRING && v->val.strval[0] == '0'
			&& v->val.strval[1] == '\0')
		|| (v->token == T_REAL && v->val.realval == 0.0))
	  return(0);

	return(1);
  }

  if (v->token == T_BSTRING) {
	if (v->val.bval.len)
	  return(1);
	return(0);
  }

  if (v->token == T_LIST) {
	if (dsvec_len(v->val.listval.list) != 0)
	  return(1);
	return(0);
  }

  if (v->token == T_ALIST) {
	if (kwv_count(v->val.alistval.kwv, NULL) != 0)
	  return(1);
	return(0);
  }

  return(-1);
}

static int
variable_value(Lex_state *e, Value *v, Value **v2, char **strp)
{
  int undef;
  char *str, *varname;
  Ds *ds;
  Expr_result *vres;
  Var *var;

  if (v->token != T_VARIABLE)
	return(-1);
  
  if ((varname = v->varname) == NULL)
	return(-1);

  if ((var = var_parse_name(varname, NULL)) == NULL)
	return(-1);

  if ((ds = acs_variable_resolve(var, e->env, &vres, &undef)) == NULL)
	return(-1);
  str = ds_buf(ds);

  *v2 = &vres->value;

  return(0);
}

/*
 * Convert R to an integer.
 * Return 0 and set IP if possible, return -1 otherwise.
 */
static int
force_integer(Lex_state *e, Expr_result *r, long *ip)
{
  long i;
  Value *v;

  if (r->value.token == T_VARIABLE) {
	char *varname;
	Kwv *kwv;
	Kwv_pair *kp;
	Var *var;

	varname = r->value.varname;
	if ((var = var_parse_name(varname, NULL)) == NULL)
	  return(-1);
	if ((kwv = var_ns_lookup_kwv(e->env->namespaces, var->ns)) == NULL)
	  return(-1);

	if ((kp = kwv_lookup(kwv, var->name)) == NULL) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Reference to the value of an undefined variable: %s",
			   varname));
	  return(-1);
	}

	if (kp->xval != NULL) {
	  v = (Value *) kp->xval;
	}
	else {
	  /* Parse a string... */
	  return(-1);
	}
  }
  else
	v = &r->value;

  if (v->token == T_REAL)
	i = trunc(v->val.realval);
  else if (v->token == T_INTEGER)
	i = v->val.intval;
  else if (v->token == T_STRING) {
	char *endp;
	double d;

	if (is_realval_str(v->val.strval, &d, &endp) == 1) {
	  if (*endp != '\0')
		return(-1);
	  i = (long) trunc(d);
	}
	else if (is_intval_str(v->val.strval, &i, &endp) != 1 || *endp != '\0')
	  return(-1);
  }
  else if (v->token == T_BSTRING)
	return(-1);
  else
	return(-1);

  *ip = i;
  return(0);
}

/*
 * Convert R to a real.
 * Return 0 and set DP if possible, return -1 otherwise.
 */
static int
force_real(Expr_result *r, double *dp)
{
  double d;

  if (r->value.token == T_REAL)
	d = r->value.val.realval;
  else if (r->value.token == T_INTEGER)
	d = (double) r->value.val.intval;
  else if (r->value.token == T_STRING) {
	char *endp;

	if (is_realval_str(r->value.val.strval, &d, &endp) != 1 || *endp != '\0')
	  return(-1);
  }
  else if (r->value.token == T_BSTRING)
	return(-1);
  else
	return(-1);

  *dp = d;
  return(0);
}

/*
 * Convert an alist into a list.
 * Return 0 and set LIST if possible, return -1 otherwise.
 */
static int
force_list(Value *v, List *list)
{
  Kwv *kwv;
  Kwv_iter *iter;
  Kwv_pair *pair;

  if (v->token != T_ALIST)
	return(-1);

  list->list = dsvec_init(NULL, sizeof(Value));
  list->dim = NULL;

  kwv = v->val.alistval.kwv;
  iter = kwv_iter_begin(kwv, NULL);
  for (pair = kwv_iter_first(iter); pair != NULL;
	   pair = kwv_iter_next(iter)) {
	Value *v;

	v = init_value(NULL, T_STRING, pair->name);
	dsvec_add_ptr(list->list, v);
	dsvec_add_ptr(list->list, copy_value(NULL, pair->xval));
  }

  kwv_iter_end(iter);
  return(0);
}

/*
 * Convert a list into an alist, provided there are no keys or an even number,
 * and there are no duplicate keys.
 * Return 0 and set ALIST if possible, return -1 otherwise.
 */
static int
force_alist(Lex_state *e, Expr_result *r, Alist *alist)
{
  unsigned int i, n;
  Dsvec *dsv;
  Kwv *kwv;

  /* XXX */
  if (str_or_lit(r->value.token)) {
	kwv = var_ns_lookup_kwv(e->env->namespaces, r->value.val.strval);
	if (kwv == NULL)
	  return(-1);
	alist->kwv = kwv_copy(kwv);

	return(0);
  }

  if (r->value.token != T_LIST)
	return(-1);

  dsv = r->value.val.listval.list;
  n = dsvec_len(dsv);
  if (n & 01)
	return(-1);

  if ((kwv = kwv_init(n)) == NULL)
	return(-1);

  kwv_set_mode(kwv, "dn");

  for (i = 0; i < n; i += 2) {
	char *key;
	Kwv_pair pair;
	Value *k, *v;

	k = (Value *) dsvec_ptr_index(dsv, i);
	if (force_string(k, &key) == -1)
	  return(-1);
	v = (Value *) dsvec_ptr_index(dsv, i + 1);

	kwv_set_pair(&pair, key, NULL, copy_value(NULL, v));
	if (kwv_add_pair(kwv, &pair) == NULL)
	  return(-1);
  }

  alist->kwv = kwv;

  return(0);
}

static Ds *
format_list(Ds *ods, Value *v)
{
  unsigned int i;
  char *str;
  Ds *ds;
  Dsvec *dsv;

  if (ods == NULL)
	ds = ds_init(NULL);
  else
	ds = ods;

  dsv = v->val.listval.list;
  ds_asprintf(ds, "[");
  for (i = 0; i < dsvec_len(dsv); i++) {
	Value *vv;

	vv = (Value *) dsvec_ptr_index(dsv, i);
	if (vv->token == T_STRING) {
	  str = vv->val.strval;
	  ds_asprintf(ds, "%s\"%s\"", (i == 0) ? "" : ",", str);
	}
	else {
	  if (force_string(vv, &str) == -1) {
		log_msg((LOG_ERROR_LEVEL, "List element %d is invalid", i));
		return(NULL);
	  }
	  ds_asprintf(ds, "%s%s", (i == 0) ? "" : ",", str);
	}
  }
  ds_asprintf(ds, "]");

  return(ds);
}

static Ds *
format_alist(Ds *ods, Value *v)
{
  int n;
  Ds *ds;
  Kwv *kwv;
  Kwv_iter *iter;
  Kwv_pair *pair;

  if (ods == NULL)
	ds = ds_init(NULL);
  else
	ds = ods;

  kwv = v->val.alistval.kwv;
  iter = kwv_iter_begin(kwv, NULL);

  n = 0;
  ds_asprintf(ds, "{");
  for (pair = kwv_iter_first(iter); pair != NULL; pair = kwv_iter_next(iter)) {
	char *str;
	Value *vv;

	ds_asprintf(ds, "%s\"%s\",", (n == 0) ? "" : ",", pair->name);

	vv = (Value *) pair->xval;
	if (vv == NULL) {
	  if (pair->val != NULL)
		ds_asprintf(ds, "\"%s\"", pair->val);
	  else
		ds_asprintf(ds, "?NULL?");
	}
	else if (vv->token == T_STRING) {
	  str = vv->val.strval;
	  ds_asprintf(ds, "\"%s\"", str);
	}
	else {
	  if (force_string(vv, &str) == -1) {
		log_msg((LOG_ERROR_LEVEL, "Alist element %d is invalid", n));
		return(NULL);
	  }
	  ds_asprintf(ds, "%s", str);
	}
	n++;
  }
  kwv_iter_end(iter);
  ds_asprintf(ds, "}");

  return(ds);
}

static int
force_string(Value *v, char **strp)
{
  char *str;

  if (is_undef(v))
	return(-1);
  else if (str_or_lit(v->token))
	str = v->val.strval;
  else if (v->token == T_REAL)
	str = ds_xprintf("%f", v->val.realval);
  else if (v->token == T_INTEGER)
	str = ds_xprintf("%ld", v->val.intval);
  else if (v->token == T_BSTRING) {
	if (strprintable(v->val.bval.data, v->val.bval.len, 1))
	  str = strndup(v->val.bval.data, v->val.bval.len);
	else {
	  /* XXX */
	  str = strbtohex(v->val.bval.data, v->val.bval.len, 0);
	}
  }
  else if (v->token == T_LIST) {
	Ds ds;

	ds_init(&ds);
	format_list(&ds, v);
	str = ds_buf(&ds);
  }
  else if (v->token == T_ALIST) {
	Ds ds;

	ds_init(&ds);
	format_alist(&ds, v);
	str = ds_buf(&ds);
  }
  else if (v->token == T_DOTDOT) {
	if (v->val.dotdot.max == DOTDOT_LAST)
	  str = ds_xprintf("%ld..%s", v->val.dotdot.min, dotdot_symbol());
	else
	  str = ds_xprintf("%ld..%ld", v->val.dotdot.min, v->val.dotdot.max);
  }
  else
	return(-1);

  *strp = str;
  return(0);
}

static int
force_bstring(Expr_result *r, Bstring *bsp)
{
  char *str;
  Bstring bs;

  if (r->value.token == T_REAL || r->value.token == T_INTEGER) {
	if (force_string(&r->value, &str) == -1)
	  return(-1);
	bs.data = str;
	bs.len = strlen(str);
  }
  else if (str_or_lit(r->value.token)) {
	bs.data = r->value.val.strval;
	bs.len = strlen(r->value.val.strval);
  }
  else if (r->value.token == T_BSTRING) {
	bs.data = memdupn(r->value.val.bval.data, r->value.val.bval.len);
	bs.len = r->value.val.bval.len;
  }
  else
	return(-1);

  *bsp = bs;
  return(0);
}

static int
boolean_value(Expr_result *r, int *boolp)
{
  int b;

  if ((b = is_true_value(&r->value)) == -1)
	return(-1);

  *boolp = b;
  return(0);
}

static int
lboolean_value(Expr_result *r, long *boolp)
{
  int b;

  if ((b = is_true_value(&r->value)) == -1)
	return(-1);

  *boolp = b;
  return(0);
}

/*
 * An integer value is needed, but the only conversion allowed is from
 * a string representation.
 * Return -1 if R is not an integer, 0 otherwise.
 */
static int
integer_value(Lex_state *e, Value *v, long *ip)
{
  long i;
  char *str;
  Value *v1;

  v1 = NULL;
  str = NULL;
  if (v->token == T_VARIABLE) {
	if (variable_value(e, v, &v1, &str) == -1)
	  return(-1);
  }
  else
	v1 = v;

  if ((v1 != NULL && v1->token == T_STRING)
	  || (v1 == NULL && str != NULL)) {
    char *endp;

	if (v1 != NULL)
	  str = v1->val.strval;
    if (is_intval_str(str, &i, &endp) != 1 || *endp != '\0')
      return(-1);
  }
  else if (v1->token == T_REAL)
    return(-1);
  else if (v1->token == T_INTEGER)
    i = v1->val.intval;
  else if (v1->token == T_BSTRING)
	return(-1);
  else
    return(-1);

  *ip = i;
  return(0);
}

/*
 * A real value is needed, using any reasonable conversion.
 * Return -1 if R is not a real, 0 otherwise.
 */
static int
real_value(Lex_state *e, Value *v, double *dp)
{
  double d;
  char *str;
  Value *v1;

  v1 = NULL;
  str = NULL;
  if (v->token == T_VARIABLE) {
	if (variable_value(e, v, &v1, &str) == -1)
	  return(-1);
  }
  else
	v1 = v;

  if ((v1 != NULL && v1->token == T_STRING)
	  || (v1 == NULL && str != NULL)) {
    char *endp;

	if (v1 != NULL)
	  str = v1->val.strval;
    if (is_realval_str(str, &d, &endp) != 1 || *endp != '\0')
      return(-1);
  }
  else if (v1->token == T_REAL)
    d = v1->val.realval;
  else if (v1->token == T_INTEGER)
    d = (double) v1->val.intval;
  else if (v1->token == T_BSTRING)
	return(-1);
  else
    return(-1);

  *dp = d;
  return(0);
}

static int
string_value(Lex_state *e, Value *v, char **strp)
{
  char *str;
  Value *v1;

  v1 = NULL;
  str = NULL;
  if (v->token == T_VARIABLE) {
	if (variable_value(e, v, &v1, &str) == -1)
	  return(-1);
  }
  else
	v1 = v;

  if (str != NULL)
	;
  else if (str_or_lit(v1->token))
    str = v1->val.strval;
  else if (v1->token == T_REAL)
    str = ds_xprintf("%f", v1->val.realval);
  else if (v1->token == T_INTEGER)
    str = ds_xprintf("%ld", v1->val.intval);
  else if (v1->token == T_BSTRING)
	return(-1);
  else
    return(-1);

  *strp = str;
  return(0);
}

static int
int_to_string(Lex_state *e, Expr_result *result, Token op, Expr_result *r1)
{
  long intval;
  char *str;

  intval = r1->value.val.intval;

  switch (op) {
  case T_B16U:
	/* Convert to a hex string, upper case. */
	str = ds_xprintf("%lX", intval);
	break;

  case T_B16:
	/* Convert to a hex string. */
	str = ds_xprintf("%lx", intval);
	break;

  case T_B10:
	/* Convert to a decimal string. */
	str = ds_xprintf("%ld", intval);
	break;

  case T_B8:
	/* Convert to an octal string. */
	str = ds_xprintf("%lo", intval);
	break;

  case T_B2:
	{
	  int i, msb;
	  long mask;
	  Ds ds;

	  /* Convert to a base2 string. */
	  ds_init(&ds);

	  mask = 1;
	  msb = -1;
	  for (i = 0; i < sizeof(long) * 8; i++) {
		if (intval & mask)
		  msb = i;
		if (i != sizeof(long) * 8 - 1)
		  mask <<= 1;
	  }

	  if (msb == -1)
		ds_appendc(&ds, (int) '0');
	  else {
		mask = (1 << msb);
		while (msb >= 0) {
		  ds_appendc(&ds, (int) ((intval & mask) ? '1' : '0'));
		  mask >>= 1;
		  msb--;
		}
	  }

	  ds_appendc(&ds, (int) '\0');

	  str = ds_buf(&ds);

	  break;
	}

  default:
	return(-1);
	/*NOTREACHED*/
  }


  result->value.token = T_STRING;
  result->value.val.strval = str;

  return(0);
}

static int
string_to_integer(Lex_state *e, Expr_result *result, Token op, Expr_result *r1)
{
  char *endptr, *str;
  long intval;

  str = r1->value.val.strval;

  switch (op) {
  case T_B16:
	/* Convert a hex string to integer. */
	intval = strtol(str, &endptr, 16);
	if ((intval == 0 && (errno == EINVAL || errno == ERANGE))
		|| *endptr != '\0')
	  return(-1);
	break;

  case T_B10:
	/* Convert a decimal string to integer. */
	intval = strtol(str, &endptr, 10);
	if ((intval == 0 && (errno == EINVAL || errno == ERANGE))
		|| *endptr != '\0')
	  return(-1);
	break;

  case T_B8:
	/* Convert an octal string to integer. */
	intval = strtol(str, &endptr, 8);
	if ((intval == 0 && (errno == EINVAL || errno == ERANGE))
		|| *endptr != '\0')
	  return(-1);
	break;

  case T_B2:
	/* Convert a base2 string to integer. */
	intval = strtol(str, &endptr, 2);
	if ((intval == 0 && (errno == EINVAL || errno == ERANGE))
		|| *endptr != '\0')
	  return(-1);
	break;

  default:
	return(-1);
	/*NOTREACHED*/
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = intval;

  return(0);
}

static int
is_bareword_str(char *str, char **namep, char **nextp)
{
  char *p;

  p = str;
  if (!isalpha((int) *p))
    return(0);
  p++;
  while (isalnum((int) *p) || *p == '_')
    p++;

  if (nextp != NULL)
	*nextp = p;

  if (namep != NULL)
	*namep = strndup(str, p - str);

  return(1);
}

static int
is_function_name_str(char *str, char **namep, char **nextp)
{
  char *endp, *p;

  p = str;
  if (!isalpha((int) *p) && *p != '_')
	return(0);
  p++;

  while (isalnum((int) *p) || *p == '_')
    p++;

  if (*p == ':' && *(p + 1) == ':') {
	if (*(p + 2) == '\0')
	  return(0);
	p += 2;
  }

  while (isalnum((int) *p) || *p == '_')
    p++;

  endp = NULL;
  if (*p == ' ' || *p == '\t')
	endp = p++;

  while (*p == ' ' || *p == '\t')
	p++;

  if (*p != '(')
	return(0);
  if (endp == NULL)
	endp = p;

  if (namep != NULL)
	*namep = strndup(str, endp - str);
	
  if (nextp != NULL)
	*nextp = p;

  return(1);
}

/*
 * Test if STR looks like a function name or another literal symbol.
 * If it does, create and return a token, set ENDP to point to the first
 * character past the name, and return 1.
 * Otherwise, return 0.
 */
static int
is_literal_str(char *str, Lex_token **tp, char **endp)
{
  char *bname, *fname, *p;
  Lex_token *t;

  if (is_function_name_str(str, &fname, &p)) {
	t = ALLOC(Lex_token);
	*t = token_func;
	t->startaddr = str;
	t->value = init_value(NULL, T_FUNC, fname);
  }
  else if (is_bareword_str(str, &bname, &p)) {
	/* This is similar to what perl calls a "bareword". */
	t = ALLOC(Lex_token);
	*t = token_literal;	
	t->startaddr = str;
	t->value = init_value(NULL, T_LITERAL, bname);
  }
  else
	return(0);

  *tp = t;
  *endp = p;

  return(1);
}

/*
 * Using binary operator OP, compare V1 to V2.
 * Return -1 if the comparison yields an error and set RESULT to an error
 * status, otherwise return 0 and set RESULT to the result of the comparison
 * (-1 (less than), 0 (False or equal), or 1 (True or greater than),
 * depending on OP).
 */
static int
eval2_compare(Lex_state *e, Expr_result *result, Token op, Value *v1,
			  Value *v2)
{
  char *s1, *s2;
  long l1, l2, val;
  double real1, real2;

  /*
   * Begin by trying to convert V1 and V2 to the same type, then do
   * the requested comparison.
   */
  if (integer_value(e, v1, &l1) != -1 && integer_value(e, v2, &l2) != -1) {
	;
  }
  else if (real_value(e, v1, &real1) != -1 && real_value(e, v2, &real2) != -1) {
	l2 = 0L;
	if (op == T_LT || op == T_LT_I)
	  l1 = (real1 < real2) ? -1 : 1;
	else if (op == T_LE || op == T_LE_I)
	  l1 = (real1 <= real2) ? -1 : 1;
	else if (op == T_EQ || op == T_EQ_I)
	  l1 = (real1 == real2) ? 0 : 1;
	else if (op == T_NE || op == T_NE_I)
	  l1 = (real1 != real2) ? -1 : 0;
	else if (op == T_GE || op == T_GE_I)
	  l1 = (real1 >= real2) ? 1 : 0;
	else if (op == T_GT || op == T_GT_I)
	  l1 = (real1 > real2) ? 1 : 0;
	else {
	  seterr_e(e, result, "Code botch");
	  return(-1);
	}
  }
  else if (string_value(e, v1, &s1) != -1 && string_value(e, v2, &s2) != -1) {
	/* Do a string comparison */
	if (op == T_LT_I || op == T_LE_I || op == T_EQ_I || op == T_NE_I
		|| op == T_GE_I || op == T_GT_I)
	  l1 = strcasecmp(s1, s2);
	else
	  l1 = strcmp(s1, s2);
	l2 = 0L;
  }
  else if (v1->token == T_BSTRING && v2->token == T_STRING) {
	size_t len2;

	/* Do a binary string comparison */
	len2 = strlen(v2->val.strval);
	if (v1->val.bval.len < len2)
	  l1 = -1;
	else if (v1->val.bval.len > len2)
	  l1 = 1;
	else
	  l1 = memcmp(v1->val.bval.data, v2->val.strval, len2);
	l2 = 0L;
  }
  else if (v1->token == T_STRING && v2->token == T_BSTRING) {
	size_t len1;

	/* Do a binary string comparison */
	len1 = strlen(v1->val.strval);
	if (len1 < v2->val.bval.len)
	  l1 = -1;
	else if (len1 > v2->val.bval.len)
	  l1 = 1;
	else
	  l1 = memcmp(v1->val.strval, v2->val.bval.data, len1);
	l2 = 0L;
  }
  else if (v1->token == T_BSTRING && v2->token == T_BSTRING) {
	/* Do a binary string comparison */
	if (v1->val.bval.len < v2->val.bval.len)
	  l1 = -1;
	else if (v1->val.bval.len > v2->val.bval.len)
	  l1 = 1;
	else
	  l1 = memcmp(v1->val.bval.data, v2->val.bval.data, v2->val.bval.len);
	l2 = 0L;
  }
  else if ((op == T_EQ || op == T_NE || op == T_EQ_I || op == T_NE_I)
		   && v1->token == T_LIST && v2->token == T_LIST) {
	int icase;

	icase = (op == T_EQ_I || op == T_NE_I);
	l1 = (long) list_eq(v1, v2, icase);
	l2 = 1L;
  }
  else if ((op == T_EQ || op == T_NE || op == T_EQ_I || op == T_NE_I)
		   && v1->token == T_ALIST && v2->token == T_ALIST) {
	int icase;

	icase = (op == T_EQ_I || op == T_NE_I);
	l1 = (long) alist_eq(v1, v2, icase);
	l2 = 1L;
  }
  else {
	seterr_s(e, result, ds_xprintf("Invalid binary operand, op=%s",
								   token_name(op)));
	return(-1);
  }

  switch (op) {
  case T_LT:
  case T_LT_I:
	val = (l1 < l2);
	break;
  case T_LE:
  case T_LE_I:
	val = (l1 <= l2);
	break;
  case T_EQ:
  case T_EQ_I:
	val = (l1 == l2);
	break;
  case T_NE:
  case T_NE_I:
	val = (l1 != l2);
	break;
  case T_GE:
  case T_GE_I:
	val = (l1 >= l2);
	break;
  case T_GT:
  case T_GT_I:
	val = (l1 > l2);
	break;
  default:
	seterr_e(e, result, "Code botch");
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = val;

  return(0);
}

/*
 * Lexeme scanner
 * Starting at STR, examine characters to determine the next input token.
 * PREV_T points to the previous token (if NULL, this is the first token).
 * Set ENDP to point to the character following a valid lexeme.
 * Return a pointer to the token or NULL on error.
 */
static Lex_token *
lexeme_scan(char *str, Lex_token *prev_t, char **endp)
{
  int len, quote_ch, st;
  Lex_token *newt, *t;

  for (t = &tokens[0]; t->token != T_UNDEF; t++) {
	len = lexeme_length(t);
	if ((IS_L_CHARS(t->type_length) && strneq(str, t->lexeme, len))
		|| (IS_L_ALPHA(t->type_length) && strneq(str, t->lexeme, len)
			&& !isalpha((int) str[len]))) {
	  /*
	   * Special handling for the binary period operator.
	   */
	  if (prev_t == NULL || prev_t->token == T_LPAREN || is_operator(prev_t)) {
		if (t->token == T_DOT)
		  continue;
	  }
	  *endp = str + len;
	  newt = ALLOC(Lex_token);
	  *newt = *t;
	  newt->startaddr = str;
	  return(newt);
	}
  }

  /*
   * It must be a number, quoted string, literal string, or variable reference,
   * otherwise it is invalid...
   */

  /* A number? */
  if ((st = is_number_str(str, &t, endp)) == -1)
	return(NULL);
  if (st == 1)
	return(t);

  /*
   * XXX We might add backquotes/backticks (command interpolation) here
   * as a new type of string.  We'd need to do variable substitution within
   * the backquoted region and but not any other kind of parsing.  Redirection
   * and such would be supported.  The output of the command, if any, would be
   * interpolated.  The syntax would be similar to Perl's rather than the
   * shell's, so command interpolation would not be embedded within other
   * strings.
   * Note that this feature has security implications, so certain
   * restrictions might be enforced.  Also, might the command be allowed to
   * be a built-in?
   */
  if (*str == '"' || *str == '\'') {
	char *p;
	Ds *s;

	quote_ch = *str;
	s = ds_init(NULL);
	p = str + 1;
	while (1) {
	  if (*p == '\\') {
		if (*(p + 1) == '\0')	{
		  /* Ends with an unescaped backslash? */
		  return(NULL);
		}
		/*
		 * Only a quoted quote character is treated specially here.
		 * C-style character and numeric escapes are handled by var_expand().
		 */
		if (*(p + 1) == quote_ch) {
		  p++;
		  ds_appendc(s, (int) *p++);
		}
		else {
		  ds_appendc(s, (int) *p++);
		  ds_appendc(s, (int) *p++);
		}
	  }
	  else if (*p == quote_ch) {
		p++;
		ds_appendc(s, '\0');
		break;
	  }
	  else if (*p == '\0')
		return(NULL);
	  else {
		ds_appendc(s, *p);
		p++;
	  }
	}

	newt = ALLOC(Lex_token);
	*newt = token_string;
	newt->startaddr = str;
    newt->value = init_value(NULL, T_STRING, ds_buf(s));
	newt->value->is_quoted = (quote_ch == '\'');
	*endp = p;
	return(newt);
  }

  /*
   * A regular variable reference; e.g., ${foo} or ${foo::bar:i}
   * Note that variable references embedded with a string are
   * handled elsewhere.
   */
  if (*str == '$' && *(str + 1) == '{') {
	char *p;
	Ds ds;

	ds_init(&ds);
	ds_appendc(&ds, '$');
	ds_appendc(&ds, '{');
	p = str + 2;
	while (*p != '}' && *p != '\0') {
	  if (*p == '\\' && *(p + 1) == '}')
		ds_appendc(&ds, *p++);
	  ds_appendc(&ds, *p++);
	}
	if (*p == '\0')
	  return(NULL);
	ds_appendc(&ds, '}');
	ds_appendc(&ds, '\0');

	newt = ALLOC(Lex_token);
	*newt = token_variable;
	newt->startaddr = str;
	newt->value = init_value(NULL, T_VARIABLE, ds_buf(&ds));
	newt->value->is_var_reference = 1;
	newt->value->varname = ds_buf(&ds);
	if (var_parse_name(newt->value->varname, NULL) == NULL)
	  return(NULL);
	*endp = p + 1;
	return(newt);
  }

  /*
   * Special case - a simplified variable reference, which may include
   * a namespace qualifier; e.g., $foo or $foo::bar
   * The variable name ends when the first invalid
   * character is seen.  The braces are unnecessary if there are no
   * modifier flags or "special" characters in the variable name.
   * Note that variable references embedded with a string are
   * handled elsewhere.
   */
  if (*str == '$' && (isalpha((int) *(str + 1)) || *(str + 1) == '_')) {
	char *p;
	Ds ds;
	size_t var_ns_sep_str_len;

	/* A simple variable reference; e.g., $foo + 4 */
	ds_init(&ds);
	ds_appendc(&ds, '$');
	ds_appendc(&ds, '{');
	p = str + 1;
	if (!isalpha((int) *p) && *p != '_')
	  return(NULL);

	var_ns_sep_str_len = strlen(VAR_NS_SEP_STR);
	while (*p != '\0') {
	  if (!var_ns_sep_str_len && *p == '#')
		ds_appendc(&ds, *p++);
	  if (isalnum((int) *p) || *p == '_')
		ds_appendc(&ds, *p++);
	  else if (var_ns_sep_str_len
			   && strneq(p, VAR_NS_SEP_STR, var_ns_sep_str_len)) {
		ds_append(&ds, VAR_NS_SEP_STR);
		p += var_ns_sep_str_len;
		/* Don't allow this to appear again */
		var_ns_sep_str_len = 0;
	  }
	  else
		break;
	}
	if (p == str + 1)
	  return(NULL);
	ds_appendc(&ds, '}');
	ds_appendc(&ds, '\0');

	newt = ALLOC(Lex_token);
	*newt = token_variable;
	newt->startaddr = str;
	newt->value = init_value(NULL, T_VARIABLE, ds_buf(&ds));
	newt->value->is_var_reference = 1;
	newt->value->varname = ds_buf(&ds);
	if (var_parse_name(newt->value->varname, NULL) == NULL)
	  return(NULL);
	*endp = p;
	return(newt);
  }

  if (is_literal_str(str, &t, endp))
	return(t);

  return(NULL);
}

/*
 * Lexical analyzer
 * Return the number of tokens if ok, -1 otherwise.
 */
static int
lexan(Lex_state *e, Expr_result *result)
{
  char *input, *p, *nextp;
  Lex_token *t, *t_prev;
  Acs_environment *env;
  Dsvec *lexptr;
  static char *c[] = { "unary", "binary", "ternary", "operand", "spec" };

  input = e->expr;
  env = e->env;
  lexptr = e->lexptr;

  p = input;
  t_prev = NULL;

  while (*p != '\0') {
	/* Skip any leading white space */
	if (*p == ' ' || *p == '\t' || *p == '\n') {
	  p++;
	  continue;
	}

	if ((t = lexeme_scan(p, t_prev, &nextp)) == NULL) {
	  result->err = ACS_EXPR_LEXICAL_ERROR;
	  if (isprint((int) *p))
		result->errmsg = ds_xprintf("Character 0%o ('%c') at offset %d",
									*p, *p, p - input);
	  else
		result->errmsg = ds_xprintf("Character 0%o at offset %d",
									*p, p - input);
	  return(-1);
	}
    t->lexeme = (char *) malloc(nextp - p + 1);
    strcpyn(t->lexeme, p, nextp - p);
	dsvec_add_ptr(lexptr, (void *) t);

	log_msg((LOG_TRACE_LEVEL, "lexeme: %s\"%s\" (t=%d, c=%s)",
			 (t->value != NULL && t->value->is_var_reference) ? "var " : "",
			 t->lexeme, t->token, c[t->tc]));

	t_prev = t;
	p = nextp;
  }

  dsvec_add_ptr(lexptr, (void *) &token_eoi);

  return(dsvec_len(lexptr));
}

char *
acs_format_result(Expr_result *res)
{
  char *s;

  if (force_string(&res->value, &s) == -1)
	return(NULL);

  return(s);
}

/*
 * Process a sequence of zero or more statements.
 * If the first token is a left brace, we expect to stop at the matching
 * right brace; otherwise the block is implicit and we stop at the end-of-input
 * token.
 * The value of the block is that of the last statement, or the
 * empty string if the block is empty.
 */
static int
do_block(Lex_state *e, int is_top, Expr_result *result)
{
  int need_rbrace, saw_eos;

  if (!is_top && token_matches(e, T_LBRACE))
	need_rbrace = 1;
  else
	need_rbrace = 0;

  /* The block looks like "{ }" (it's empty). */
  if (need_rbrace && token_matches(e, T_RBRACE)) {
	e->block_end++;
	if (e->do_eval)
	  init_value(&result->value, T_STRING, "");

	return(0);
  }

  /* Evaluate the statements in the (non-empty) block sequentially. */
  while (1) {
	if (heir(e, result) == -1)
	  return(-1);

	/*
	 * If exit() (and currently, return()) was called during evaluation,
	 * then we should stop evaluating this program now.
	 */
	if (result->exit_called)
	  return(0);

	/*
	 * The only time a T_EOS is unnecessary is if there's just one
	 * statement or if the statement is not a brace-delimited block.
	 * There can always be multiple T_EOS tokens.
	 */
	saw_eos = 0;
	while (token_matches(e, T_EOS))
	  saw_eos = 1;

	if (token_is(e, 0, T_EOI)) {
	  /* We've hit the end-of-input. */
	  if (need_rbrace) {
		seterr_s(e, result, "Closing brace is missing");
		return(-1);
	  }
	  break;
	}

	/*
	 * If we've hit the closing brace, we're done.
	 * We don't require a T_EOS in this case.
	 */
	if (need_rbrace && token_matches(e, T_RBRACE)) {
	  e->block_end++;
	  break;
	}

	if (!e->block_end && !saw_eos) {
	  seterr_s(e, result, "Expected ';'");
	  return(-1);
	}
	e->block_end = 0;
  }

  return(0);
}

/*
 * Note that NARGS will be -1 because the number of arguments is not yet
 * known.
 */
static int
func_expr(char *expr, int nargs, Acs_environment *env, Expr_result *result)
{
  int n;
  Dsvec lexptr;
  Lex_token *t;
  Lex_state e;

  dsvec_init(&lexptr, sizeof(Lex_token *));

  e.env = env;
  e.lexptr = &lexptr;
  e.ctn = 0;
  e.expr = expr;
  e.do_eval = env->do_eval;
  e.exit_called = 0;
  e.block_end = 0;

  if ((n = lexan(&e, result)) == -1)
	return(-1);

  if (do_lexdump || env->trace_level > 1)
	lexdump(expr, lexptr, n);

  /*
   * If there is nothing remaining after lexical analysis, there is isn't
   * really an expression.  Return the result as True because this simplifies
   * processing an empty Allow or Deny clause in an ACL since an empty clause
   * in those contexts is True.
   * An "empty" clause may actually consist of white space or comments.
   */
  if (n == 0 || (n == 1 && token_is(&e, 0, T_EOI))) {
	result->value.token = T_INTEGER;
	result->value.val.intval = 1;
	result->err = ACS_EXPR_TRUE;
	result->errmsg = NULL;

	return(0);
  }

  init_value(&result->value, T_UNDEF);
  result->err = ACS_EXPR_FALSE;
  result->errmsg = NULL;

#ifdef NOTDEF
  /* XXX Why should this not be allowed?? */
  /* A block is disallowed at the top level. */
  if (token_is(&e, 0, T_LBRACE)) {
	t = dsvec_ptr(&lexptr, e.ctn, Lex_token *);
	result->err = ACS_EXPR_SYNTAX_ERROR;
	result->errmsg = ds_xprintf("func_expr: syntax error, token = '%s' (%d)",
								t->lexeme == NULL ? "T_EOI" : t->lexeme,
								t->token);
	return(-1);
  }
#endif

  /* Do a syntax checking pass. */
  e.do_eval = 0;
  if (do_block(&e, 1, result) == -1) {
	t = dsvec_ptr(&lexptr, e.ctn, Lex_token *);
	if (result->errmsg == NULL) {
	  result->err = ACS_EXPR_SYNTAX_ERROR;
	  result->errmsg = ds_xprintf("func_expr: syntax error, token = '%s' (%d)",
								  t->lexeme == NULL ? "T_EOI" : t->lexeme,
								  t->token);
	}
	return(-1);
  }
  log_msg((LOG_TRACE_LEVEL, "Syntax check succeeded"));

  if (env->do_eval) {
	/* Evaluate the expression(s), if required. */
	e.do_eval = 1;
	e.ctn = 0;
	e.block_end = 0;
	init_value(&result->value, T_UNDEF);
	result->err = ACS_EXPR_FALSE;
	result->errmsg = NULL;
	if (do_block(&e, 1, result) == -1) {
	  t = dsvec_ptr(&lexptr, e.ctn, Lex_token *);
	  if (result->errmsg == NULL) {
		result->err = ACS_EXPR_EVAL_ERROR;
		result->errmsg = ds_xprintf("func_expr: eval error, token = '%s' (%d)",
									t->lexeme == NULL ? "T_EOI" : t->lexeme,
									t->token);
	  }
	  return(-1);
	}
  }

  return(0);
}

/* These namespace names can only be altered internally. */
static char *readonly_namespaces[] = {
  "DACS", "Args", "Env", NULL
};

static int dacs_disable_readonly_namespaces = 0;

/*
 * Return 1 if NS is a reserved name for a namespace, 0 otherwise.
 * The caller knows that NS is syntactically valid, except for the
 * default case.
 */
int
acs_is_readonly_namespace(char *ns)
{
  int i;

  if (dacs_disable_readonly_namespaces)
	return(0);

  if (ns == NULL)		/* It must be the default namespace */
#ifdef DEFAULT_NAMESPACE
	ns = DEFAULT_NAMESPACE;
#else
  {
	log_msg((LOG_ERROR_LEVEL,
			 "Invalid variable reference: namespace is required"));
	return(1);
  }
#endif

  for (i = 0; readonly_namespaces[i] != NULL; i++) {
	if (streq(ns, readonly_namespaces[i]))
	  return(1);
  }

  return(0);
}

#ifdef NOTDEF
static int
is_reserved_namespace(char *ns)
{
  int i;

  if (!var_ns_is_valid_namespace_name(ns))
	return(1);

#ifdef DEFAULT_NAMESPACE
  if (ns == NULL)		/* It must be the default namespace */
	ns = DEFAULT_NAMESPACE;
#endif

  for (i = 0; readonly_namespaces[i] != NULL; i++) {
	if (streq(ns, readonly_namespaces[i]))
	  return(1);
  }

  if (streq(ns, "Conf") && conf_var_ns_user_readonly)
	return(1);

  return(0);
}
#endif

/*
#include <setjmp.h>

static int got_jmp_env = 0;
static jmp_buf jmp_env;
*/

/*
 * This is the primary entry point for evaluating an expression.
 * We assume that the expression has already been preprocessed so that
 * all comments have been removed.
 */
Acs_expr_result
acs_expr(char *expr, Acs_environment *env, Expr_result *result)
{
  int jump_st, st;
  Expr_result *res;

  log_msg((LOG_TRACE_LEVEL, "acs_expr:\n%s", expr));

  res = init_expr_result(result, T_UNDEF);

  /*
   * This can be called recursively, but we only want to return to the
   * top level.
   */
  jump_st = 0;
  if (!env->got_jmp_env)
	jump_st = setjmp(env->jmp_env);

  if (jump_st == 0) {
	env->got_jmp_env++;
	st = func_expr(expr, -1, env, res);
  }
  else {
	env->got_jmp_env = 0;
	log_msg((LOG_DEBUG_LEVEL, "longjmp called: setjmp returned %d", jump_st));
	if (env->redirect_action != NULL) {
	  /* We're here because of a call to redirect(). */
	  result->value.token = T_STRING;
	  result->value.val.strval = env->redirect_action;
	}
	return(ACS_EXPR_TRUE);
  }
  env->got_jmp_env--;

  if (st == -1) {
	char *err;

  fail:
	if (res->err == ACS_EXPR_SYNTAX_ERROR)
	  err = "Syntax error";
	else if (res->err == ACS_EXPR_LEXICAL_ERROR)
	  err = "Lexical error";
	else if (res->err == ACS_EXPR_EVAL_ERROR)
	  err = "Evaluation error";
	else
	  err = "Unknown error";

	if (res->errmsg != NULL)
	  log_msg((LOG_ERROR_LEVEL, "%s: %s", err, res->errmsg));
	else
	  log_msg((LOG_ERROR_LEVEL, "%s", err));
	return(res->err);
  }

  if (env->do_eval
	  && (is_undef(&res->value) || (st = is_true_value(&res->value))) == -1) {
	res->err = ACS_EXPR_EVAL_ERROR;
	res->errmsg = ds_xprintf("Invalid boolean result value, expr=%s", expr);
	goto fail;
  }

  if (st == 0)
	return(ACS_EXPR_FALSE);

  return(ACS_EXPR_TRUE);
}

Acs_expr_ns_arg *
var_ns_to_acs_ns(Var_ns *namespaces)
{
  int i;
  Acs_expr_ns_arg *ns_args;
  Var_ns *ns;

  for (i = 0, ns = namespaces; ns != NULL; i++, ns = ns->next)
	;

  ns_args = (Acs_expr_ns_arg *) malloc(sizeof(Acs_expr_ns_arg) * (i + 1));

  for (i = 0, ns = namespaces; ns != NULL; i++, ns = ns->next) {
	ns_args[i].name = ns->ns;
	ns_args[i].kwv = ns->kwv;
  }

  ns_args[i].name = NULL;
  ns_args[i].kwv = NULL;

  return(ns_args);
}

/*
 * This is a simple wrapper for acs_expr().
 * In addition to a string result and a result code, this API gives the
 * caller access to the expression environment after evaluation - this may
 * include new variables.
 */
Acs_expr_result
acs_expr_string_env(char *expr, Acs_environment *env, char **result_str)
{
  Acs_expr_result st;
  Expr_result result;

  log_msg((LOG_DEBUG_LEVEL, "Evaluating: %s", expr));
  st = acs_expr(expr, env, &result);
  log_msg((LOG_DEBUG_LEVEL, "Evaluation result: %d", st));

  if (result_str != NULL) {
	if (!acs_expr_error_occurred(st))
	  *result_str = acs_format_result(&result);
	else
	  *result_str = NULL;
  }

  return(st);
}

/*
 * This is a simple wrapper for acs_expr().
 * Nothing is returned other than a string result and a result code.
 */
Acs_expr_result
acs_expr_string(char *expr, Acs_expr_ns_arg *ns_args, char **result_str)
{
  int i;
  Acs_environment env;
  Acs_expr_result st;

  acs_new_env(&env);
  env.redirect_reason = ACS_DENIAL_REASON_BY_REDIRECT;

  for (i = 0; ns_args[i].name != NULL; i++)
	var_ns_new(&env.namespaces, ns_args[i].name, ns_args[i].kwv);

  st = acs_expr_string_env(expr, &env, result_str);

  return(st);
}

/*
 * Given a vector of lines, each one a separate expression, evaluate each
 * one in turn until one evaluates to a non-empty string; return that string.
 * A NULL entry may terminate the list.
 * Stop immediately if an evaluation error occurs. 
 */
Acs_expr_result
acs_expr_list_eval(Dsvec *dsv, Acs_expr_ns_arg *ns_args, char **result_str)
{
  int i;
  char *expr, *val;
  Acs_expr_result st;

  for (i = 0; i < dsvec_len(dsv); i++) {
	if ((expr = dsvec_ptr(dsv, i, char *)) == NULL)
	  break;
	if ((st = acs_expr_string(expr, ns_args, &val)) < 0)
	  return(st);
	if (st == ACS_EXPR_TRUE && val != NULL && *val != '\0') {
	  *result_str = val;
	  return(ACS_EXPR_TRUE);
	}
  }

  return(ACS_EXPR_FALSE);
}

/*
 * Read expressions from VFS_URI (or else use ITEM_TYPE), one per line
 * (which may be continued).
 * Then evaluate each one until one evaluates to a non-empty string; set
 * RESULT_STR to its value and return ACS_EXPR_TRUE.
 * If the no such expression is found, return ACS_EXPR_FALSE.
 * If an error occurs, return the error code.
 */
Acs_expr_result
acs_expr_list(char *vfs_uri, char *item_type,
			  Acs_expr_ns_arg *ns_args, char **result_str)
{
  char *buffer;
  Acs_expr_result st;
  Ds line;
  Dsvec *dsv;
  Vfs_handle *h;

  if (vfs_uri != NULL) {
    if ((h = vfs_open_uri(vfs_uri)) == NULL) {
      log_msg((LOG_DEBUG_LEVEL, "Can't open vfs_uri \"%s\"", vfs_uri));
      return(ACS_EXPR_EVAL_ERROR);
    }
  }
  else if (item_type != NULL) {
    if ((h = vfs_open_item_type(item_type)) == NULL) {
      log_msg((LOG_DEBUG_LEVEL, "Can't open item type \"%s\"", item_type));
      return(ACS_EXPR_EVAL_ERROR);
    }
  }
  else
    return(ACS_EXPR_EVAL_ERROR);

  if (vfs_get(h, NULL, (void **) &buffer, NULL) == -1) {
    log_msg((LOG_DEBUG_LEVEL,
             "Could not load expressions from \"%s\" failed",
             item_type != NULL ? item_type : vfs_uri));
	vfs_close(h);
	return(ACS_EXPR_EVAL_ERROR);
  }

  vfs_close(h);

  ds_init(&line);
  line.escnl_flag = 1;
  dsio_set(&line, NULL, buffer, 0, 0);
  dsv = dsvec_load(&line, NULL);

  st = acs_expr_list_eval(dsv, ns_args, result_str);

  return(st);
}

/*
 * Find the value of variable VAR, ignoring the case of
 * VAR->NAME if ICASE is non-zero.
 * This includes handling of the special "#" variable name which represents
 * the number of variables in a namespace and a kludge for configuration
 * directive processing.
 */
static char *
acs_variable_value(Acs_environment *env, Var *var, int icase, Kwv_pair **kpp)
{
  int ic;
  char *val;
  Kwv *kwv;
  Kwv_pair *v;
  extern int do_conf_resolve;
  extern Kwv *nkwv, *merged_kwv, *xkwv;

  if ((kwv = var_ns_lookup_kwv(env->namespaces, var->ns)) == NULL) {
	if (streq(var->name, "#")) {
	  if (kpp != NULL)
		*kpp = NULL;
	  return("0");
	}

    return(NULL);
  }

  /*
   * If this is happening during the final stages of configuration
   * directive evaluation, then we need to resolve variable references
   * on the RHS of directives, watching out for recursive definitions.
   * NKWV is the "new kwv" being built from the evaluated RHS of KWV.
   * XKWV is used to keep track of variables that are currently being
   * resolved so that we can detect a loop.
   * XXX This is an ugly kludge that needs to be repaired asap
   */
  if (do_conf_resolve && streq(var->ns, "Conf")) {
	char *nval;
	Kwv_pair *pair;
	Acs_expr_result st;
	Expr_result result;

	if (do_conf_resolve < 0)
	  return(NULL);

	/* If we've already resolved this variable, return its value. */
	if ((pair = kwv_lookup(nkwv, var->name)) != NULL) {
	  if (kpp != NULL)
		*kpp = pair;
	  return(pair->val);
	}

	/*
	 * If the variable is another directive, look up its RHS and evaluate it.
	 * Otherwise check if its a predefined (and pre-evaluated) configuration
	 * variable.
	 */
	if ((pair = kwv_lookup(merged_kwv, var->name)) == NULL) {
	  pair = kwv_lookup(kwv, var->name);
	  if (kpp != NULL)
		*kpp = pair;
	  return(pair->val);
	}

	/* Note that NAME is being resolved. */
	if (kwv_add(xkwv, var->name, "") == NULL) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Config resolution error: recursive evaluation"));
	  do_conf_resolve = -1;
	  return(NULL);
	}

	st = acs_expr(pair->val, env, &result);
	if (st == ACS_EXPR_LEXICAL_ERROR || st == ACS_EXPR_SYNTAX_ERROR
		|| st == ACS_EXPR_EVAL_ERROR || do_conf_resolve < 0) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Config resolution error: evaluation error"));
	  do_conf_resolve = -1;
	  return(NULL);
	}

	if (is_undef(&result.value)) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Config resolution error: reference to undefined value"));
	  do_conf_resolve = -1;
	  return(NULL);
	}

	nval = acs_format_result(&result);

	/* Record the variable and its value, delete the note. */
	kwv_add(nkwv, var->name, nval);
	kwv_delete(xkwv, var->name);

	if (kpp != NULL)
	  *kpp = kwv_new_pair(var->name, nval, (void *) &result);
	return(nval);
  }

  ic = kwv->icase;
  kwv->icase = icase;

  if (streq(var->name, "#")) {
	val = ds_xprintf("%d", kwv_count(kwv, NULL));
	v = NULL;
  }
  else if ((v = kwv_lookup(kwv, var->name)) != NULL) {
	log_msg((LOG_TRACE_LEVEL, "lookup: %s::%s%s -> \"%s\"",
			 var->ns == NULL ? "" : var->ns, var->name,
			 icase ? " (:i)" : "", v->val));
	val = v->val;
  }
  else {
	log_msg((LOG_TRACE_LEVEL, "lookup failed: %s::%s%s",
			 var->ns == NULL ? "" : var->ns, var->name,
			 icase ? " (:i)" : ""));
	val = NULL;
  }

  if (v != NULL && v->next != NULL)
	log_msg((LOG_WARN_LEVEL, "lookup warning: %s::%s%s has multiple values",
			 var->ns == NULL ? "" : var->ns, var->name,
			 icase ? " (:i)" : ""));

  kwv->icase = ic;

  if (kpp != NULL)
	*kpp = v;

  return(val);
}

/*
 * Lookup callback function for variables.
 * Return the value of variable VAR, or the result of applying the modifier
 * flag(s) to that variable, or NULL if an error occurs.
 * Note that var.c:var_value() calls this function.
 *
 * A namespace is required (the old behaviour was to search for the variable
 * if the namespace was omitted).
 *
 * Modifier Flags:
 *   e: if the variable exists, the value is "1" else "0".
 *   n: if the variable exists and is non-empty, the value is "1" else "0".
 *   z: if the variable is undefined or empty, the value is "1" else "0".
 *   i: lookup the variable name ignoring case.
 *   ?: if the variable is undefined or is the empty string,
 *      return the value of the expression that follows the flag
 *   +: if the variable is defined or not the empty string,
 *      return the value of the expression that follows the flag
 */
Ds *
acs_variable_resolve(Var *var, void *arg, void *vresp, int *undef)
{
  int test_exists, test_exists_or, test_exists_nor, test_nonempty;
  int ignore_varname_case, test_empty;
  char *rval, *val;
  Acs_environment *env;
  Ds *ds;
  Expr_result *res, **vres;
  Kwv_pair *kp;
  extern int do_conf_resolve;

  env = (Acs_environment *) arg;

  /* Lookup the variable's value as directed. */
  ignore_varname_case = ((var->flags & VAR_ICASE_FLAG) != 0);
  test_exists = ((var->flags & VAR_EXISTS_FLAG) != 0);
  test_exists_or = ((var->flags & VAR_ALTVAL_FLAG) != 0);
  test_exists_nor = ((var->flags & VAR_NALTVAL_FLAG) != 0);
  test_nonempty = ((var->flags & VAR_NONEMPTY_FLAG) != 0);
  test_empty = ((var->flags & VAR_EMPTY_FLAG) != 0);

  kp = NULL;
  val = acs_variable_value(env, var, ignore_varname_case, &kp);
  if (undef != NULL)
	*undef = (val == NULL);

  if (do_conf_resolve == -1)
	return(NULL);

  res = NULL;
  rval = NULL;
  ds = NULL;

  if (test_exists_or) {
	if (val == NULL || *val == '\0')
	  ds = acs_string_operand(var->altval, env);
	else
	  rval = val;
  }
  else if (test_exists_nor) {
	if (val != NULL && *val != '\0')
	  ds = acs_string_operand(var->altval, env);
	else
	  rval = "";
  }
  else if (test_exists) {
	if (val == NULL)
	  rval = "";	/* False */
	else
	  rval = "1";	/* True */
  }
  else if (test_nonempty) {
	if (val == NULL || *val == '\0')
	  rval = "";	/* False */
	else
	  rval = "1";	/* True */
  }
  else if (test_empty) {
	if (val == NULL || *val == '\0')
	  rval = "1";	/* True */
	else
	  rval = "";	/* False */
  }
  else {
	if (val == NULL) {
	  if (do_conf_resolve) {
		log_msg((LOG_ERROR_LEVEL,
				 "Config resolution error: undefined variable: %s",
				 var_ns_varname(var->ns, var->name)));
		do_conf_resolve = -1;
		return(NULL);
	  }
	  rval = "";
	}
	else {
	  rval = val;
	  if (kp != NULL && kp->xval != NULL)
		res = expr_result_from_value(NULL, kp->xval);
	}
  }

  if (rval != NULL)
	ds = ds_set(NULL, rval);
  else
	rval = ds_buf(ds);

  vres = (Expr_result **) vresp;
  if (vres != NULL) {
	if (res != NULL)
	  *vres = res;
	else
	  *vres = init_expr_result(NULL, T_STRING, rval);
  }


  return(ds);
}

/*
 * Evaluate the string STR within context ENV and return the value.
 * Variable references within the string are resolved through the
 * callback function acs_variable_resolve().
 * NULL is returned if an error occurs (such as an error parsing a variable).
 */
Ds *
acs_string_operand(char *str, Acs_environment *env)
{
  Ds *ds;

  ds = var_expand(str, acs_variable_resolve, env);

  return(ds);
}

/*
 * Increment or decrement (depending on TOKEN) integer variable VAR with
 * current (integer) value V by 1.
 */
static int
inc_variable(Lex_state *e, Value *v, Var *var, Token token, int is_list_ref,
			 Expr_result *result)
{
  int incr;
  char *newval;
  Kwv *kwv;
  Kwv_pair *kp;

  if (var == NULL)
	return(-1);
  if (var->flagstr != NULL)
	return(-1);

  if (acs_is_readonly_namespace(var->ns))
	return(-1);

  if (!e->do_eval)
	return(0);

  if ((kwv = var_ns_lookup_kwv(e->env->namespaces, var->ns)) == NULL)
	return(-1);

  if ((kp = kwv_lookup(kwv, var->name)) == NULL) {
	log_msg((LOG_ERROR_LEVEL,
			 "Increment/decrement requires initialized variable"));
	return(-1);
  }

  if (v->token != T_INTEGER) {
	log_msg((LOG_ERROR_LEVEL, "Increment/decrement needs integer lvalue"));
	return(-1);
  }

  if (token == T_PREDEC || token == T_POSTDEC)
	incr = -1;
  else
	incr = 1;

  if (token == T_PREDEC || token == T_PREINC) {
	v->val.intval += incr;
	copy_value(&result->value, v);
  }
  else {
	copy_value(&result->value, v);
	v->val.intval += incr;
  }

  if (!is_list_ref) {
	if (force_string(v, &newval) == -1)
	  return(-1);
	kp->val = newval;
	kp->xval = v;
  }

  return(0);
}

/*
 * Parse and construct a list.
 * A T_LBRACKET introduces a list constructor (e.g., [1, 2]) if it is not
 * preceded by a list-valued expression - the caller has determined that.
 * A list can contain any basic data type as an element, another list,
 * or a range specification ("1..5"), or it can be empty.
 * If successful, the value of RESULT will be a sequence of pointers to
 * zero or more list elements (each a Value).
 * Return -1 if an error occurs, 0 otherwise.
 *
 * Note that this is invalid:
 *    $a=[1,2,3,4]; $b=[0,2]; $a$b
 * But to append $b to $a, you can say: $a . $b
 *
 * XXX additional syntax:
 *  [ {index-expr => val-expr}, {index-expr => val-expr} ]
 *  [ {3 => 0}, {"foo" => "baz"}, { 10..19 => $i }
 */
static int
list_cons(Lex_state *e, Expr_result *result)
{

  if (!token_matches(e, T_LBRACKET))
    return(-1);

  if (e->do_eval)
	init_value(&result->value, T_LIST, sizeof(Value));

  /* No elements means it's the empty list */
  if (token_matches(e, T_RBRACKET))
    return(0);

  /* There is at least one element. */
  while (1) {
	Expr_result *res;

	res = init_expr_result(NULL, T_UNDEF);

	/*
	 * The comma operator is essentially disabled during list construction
	 * processing, so skip that production.
	 */
    if (heir2(e, res) == -1)
      return(-1);

	if (e->do_eval)
	  dsvec_add_ptr(result->value.val.listval.list, &res->value);

    if (!token_matches(e, T_COMMA))
      break;
  }

  if (!token_matches(e, T_RBRACKET))
    return(-1);

  return(0);
}

static int
alist_cons(Lex_state *e, Expr_result *result)
{
  char *key;

  if (!token_matches(e, T_LBRACE))
    return(-1);

  if (e->do_eval)
	init_value(&result->value, T_ALIST, sizeof(Value));

  /* No elements means it's the empty list */
  if (token_matches(e, T_RBRACE))
    return(0);

  /* There is at least one element. */
  key = NULL;
  while (1) {
	Expr_result *res;

	res = init_expr_result(NULL, T_UNDEF);

	/*
	 * The comma operator is essentially disabled during list construction
	 * processing, so skip that production.
	 */
    if (heir2(e, res) == -1)
      return(-1);

	if (e->do_eval) {
	  if (key == NULL) {
		if (force_string(&res->value, &key) == -1) {
		  seterr_e(e, result, "Invalid key");
		  return(-1);
		}
	  }
	  else {
		Kwv_pair pair;

		kwv_set_pair(&pair, key, NULL, &res->value);
		if (kwv_add_pair_nocopy(result->value.val.alistval.kwv, &pair)
			== NULL) {
		  seterr_e(e, result, ds_xprintf("Error adding key \"%s\"", key));
		  return(-1);
		}
		key = NULL;
	  }
	}

    if (!token_matches(e, T_COMMA))
      break;
  }

  if (key != NULL) {
	/* There is a missing value... */
	seterr_e(e, result, "A value must follow each key");
	return(-1);
  }

  if (!token_matches(e, T_RBRACE))
    return(-1);

  return(0);
}

/*
 * LIST-REF-SEQ -> LIST-REF | LIST-REF LIST-REF-SEQ
 * LIST-REF     -> "[" LIST-REF-ELS "]" | "{" LIST-REF-ELS "}"
 * LIST-REF-ELS -> EMPTY | LIST-REF-EL | LIST-REF-EL "," LIST-REF-ELS
 * LIST-REF-EL  -> EXP
 */
static int
is_list_ref_el(Lex_state *e, Dsvec *ref)
{
  int st;
  Expr_result *r;
  Value *v;

  r = init_expr_result(NULL, T_UNDEF);
  if ((st = heir2(e, r)) != 0)
	return(st);

  if (e->do_eval) {
	v = &r->value;
	dsvec_add_ptr(ref, v);
  }

  return(1);
}

/*
 * Process zero or more comma-separated list reference elements.
 */
static int
is_list_ref_els(Lex_state *e, Dsvec *ref, Token *ref_type)
{
  int st;
  Token end_token;

  if (token_matches(e, T_LBRACKET)) {
	end_token = T_RBRACKET;
	*ref_type = T_LIST;
  }
  else if (token_matches(e, T_LBRACE)) {
	end_token = T_RBRACE;
	*ref_type = T_ALIST;
  }
  else
	return(-1);

  if (token_matches(e, end_token)) {
	/* An empty list */
	if (e->do_eval)
	  dsvec_add_ptr(ref, NULL);

	return(1);
  }

  while (1) {
	if ((st = is_list_ref_el(e, ref)) != 1)
	  return(st);
	
	if (token_matches(e, end_token) != NULL)
	  break;

	if (token_matches(e, T_COMMA) == NULL)
	  return(0);
  }

  return(1);
}

/*
 * Process one list reference, appending it to REF.
 * Return 0 if it is not a list reference, 1 if it is, or -1 if it is
 * but an error occurred.
 */
static int
is_list_ref(Lex_state *e, Dsvec *ref, Token *ref_type)
{
  int st;

  if (!token_is(e, 0, T_LBRACKET) && !token_is(e, 0, T_LBRACE))
	return(0);

  if ((st = is_list_ref_els(e, ref, ref_type)) != 1)
	return(st);

  return(1);
}

/*
 * Test for a valid list reference sequence: <list-ref>+
 * If successful, return 1 and element 0 of REF will point to a vector that
 * describes the first index, element 1 describes the second index, and so on.
 * Each description is a vector of Value structures.
 * So, given $foo[val1][val2,val3], REF would look like:
 *   REF --> T_LIST0 --> VALUE0 valueof(val1)
 *           T_LIST1 --> VALUE0 valueof(val2)
 *                   --> VALUE1 valueof(val3)
 * Where val1 is an expression that evaluates to an integer or dotdot
 * If it is not a list reference, return 0, or -1 if an error occurs.
 *
 * Note that subscripts within braces (e.g., {"a", "b"}) do not make an alist.
 * The subscript is represented as a T_LIST with the IS_ALIST_REFERENCE
 * flag set.
 */
static int
is_list_ref_seq(Lex_state *e, Dsvec *ref)
{
  int st;
  Dsvec *dsv;
  Value *value;
  Token ref_type;

  dsv = dsvec_init(NULL, sizeof(Value));
  if ((st = is_list_ref(e, dsv, &ref_type)) != 1)
	return(st);

  /* There is at least one reference. */
  if (e->do_eval) {
	value = init_value(NULL, T_LIST, sizeof(Value));
	value->val.listval.list = dsv;
	value->is_alist_reference = (ref_type == T_ALIST);
	dsvec_add_ptr(ref, value);
  }

  while (1) {
	dsv = dsvec_init(NULL, sizeof(Value));
	if ((st = is_list_ref(e, dsv, &ref_type)) != 1)
	  break;
	if (e->do_eval) {
	  value = init_value(NULL, T_LIST, sizeof(Value));
	  value->val.listval.list = dsv;
	  value->is_alist_reference = (ref_type == T_ALIST);
	  dsvec_add_ptr(ref, value);
	}
  }

  if (st == -1)
	return(-1);

  /* We found at least one valid list reference. */
  return(1);
}

/*
 * Resolve a single list reference, V, applied to LIST.
 * V can be a non-negative integer or a valid ".." construct.
 * Example: if LIST is [1,2,3] and V is 0..1, return [1,2]
 */
static Dsvec *
listref3(Lex_state *e, Dsvec *list, Value *v, char **errmsg)
{
  Dsvec *selection;

  if (v->token == T_LIST) {
	*errmsg = "Invalid list reference (list)";
	return(NULL);
  }

  if (v->token == T_DOTDOT) {
	long max, min;
	char *range;
	Range_syntax rs;

	min = v->val.dotdot.min;
	if ((max = v->val.dotdot.max) == DOTDOT_LAST)
	  max = dsvec_len(list) - 1;
	range = ds_xprintf("%ld:%ld", min, max);
	rs.element_sep_char = ',';
	rs.span_sep_str = ":";
	rs.signed_values = 0;
	selection = dsvec_range(NULL, list, range, &rs);
	if (selection == NULL) {
	  *errmsg = "Invalid list reference (range)";
	  return(NULL);
	}
  }
  else if (v->token == T_INTEGER) {
	long subscript;

	subscript = v->val.intval;
	if (subscript < 0 || subscript >= dsvec_len(list)) {
	  *errmsg = "Subscript out of range";
	  return(NULL);
	}
	selection = dsvec_init(NULL, sizeof(Value *));
	dsvec_add_ptr(selection, dsvec_ptr_index(list, subscript));
  }
  else {
	*errmsg = "Invalid subscript";
	return(NULL);
  }

  return(selection);
}

/*
 * Apply list reference REFS to the alist VALUE and return the result as a
 * list. Each element of REFS corresponds to a [...] list reference construct
 * applied to VALUE.
 * A request for an undefined key is an error.
 * There are two modes: in mode 0, only the selected value or values are
 * returned; in mode 1, the selected pair or pairs are returned.
 *
 * Syntax:
 *   ALIST-SELECTION  -> "[" ALIST-SELECT-ELS "]"
 *                          | "{" ALIST-SELECT-ELS "}"
 *   ALIST-SELECT-ELS -> ALIST-SELECT-EL | ALIST-SELECT-EL "," ALIST-SELECT-ELS
 *   ALIST-SELECT-EL  -> STR-EXP
 *   STR-EXP          -> 
 
 *
 * Given: $a = {red, 0, blue, 1, yellow, 2}
 * mode 0: $a[blue] is 1
 * mode 0: $a[blue,red] is [1,0]
 * mode 1: $a{blue} is {"blue", 1}
 * mode 1: $a{blue,red} is {"blue", 1, "red", 0}
 * mode 2: $a/[b.*] is 1
 * mode 2: $a/[.*] is [0, 1, 2]
 * mode 3: $a/{b.*} is {"blue", 1}
 * mode 3: $a/{.*} is $a is {"red", 0, "blue", 1, "yellow", 2}
 *
 * {"blue", 1}.key is "blue"
 * {"blue", 1}.value is 1
 *
 * Given: $a = {red, [1, 2], blue, [3, 4], yellow, [5, 6]}
 * $a[red] is [1, 2]
 * $a[red][0] is 1
 *
 * $a{red} is {red, [1, 2]}
 * $a{red}.key is "red"
 * $a{red}.value is $a[red] is [1, 2]
 *
 * $a/[[Rr]ed] is $a[Red] is [1, 2]
 * $a/{y.*}.key is $a{"yellow"}.key is "yellow"
 * $a/{.*}.key is ["red", "blue", "yellow"]
 * $a/{.*}.value is [[1, 2], [3, 4], [5, 6]]
 */
static Value *
alistref2(Lex_state *e, Value *value, Dsvec *refs, char **errmsg)
{
  int i;
  Dsvec *selection;
  Kwv *kwv, *selected_kwv;
  Value *ref_val, *rv, *v;

  if (value->token == T_ALIST) {
	selected_kwv = value->val.alistval.kwv;
	selection = NULL;
  }
  else if (value->token == T_LIST) {
	selected_kwv = NULL;
	selection = value->val.listval.list;
  }
  else
	return(NULL);

  /*
   * Process each list reference in turn, left to right;
   * e.g., <list-value>[...][...]{...} ...
   * There are four major cases to handle while iterating through the
   * sequence of list references (REFS):
   *  1. <list>[list]:   $a[0], $a[0..2], $a[0,2]  ==> value or list of values
   *  2. <alist>[list]:  $a["0"], $a["0", "foo"] ==> value or list of values
   *  3. <list>{alist}:  $a{0} ==> invalid
   *  4. <alist>{alist}: $a{"0"}, $a{"0", "foo"} ==> alist
   */
  for (i = 0; i < dsvec_len(refs); i++) {
	int j;
	Dsvec *ll, *selected;
	Kwv_pair *pair;
	Value *ref_el_val;

	ref_val = (Value *) dsvec_ptr_index(refs, i);
	rv = NULL;

	if (ref_val->token == T_LIST && !ref_val->is_alist_reference) {
	  /*
	   * This is a "[...]" style dereference of a list or alist.
	   * Apply each element of REF_VAL to the list or alist.
	   * These elements must be strings or literals for the alist case.
	   */
	  ll = ref_val->val.listval.list;
	  selected = NULL;
	  for (j = 0; j < dsvec_len(ll); j++) {
		ref_el_val = (Value *) dsvec_ptr_index(ll, j);

		if (selected_kwv != NULL) {
		  /* Dereference an alist. */
		  if (!str_or_lit(ref_el_val->token)) {
			*errmsg = "Invalid key";
			return(NULL);
		  }
		  if ((pair = kwv_lookup(selected_kwv, ref_el_val->val.strval))
			  == NULL) {
			/* XXX This should yield the empty alist... */
			*errmsg = "Undefined reference";
			return(NULL);
		  }
		  if (pair->xval == NULL) {
			if (pair->val == NULL) {
			  *errmsg = "Internal error - no value";
			  return(NULL);
			}
			pair->xval = init_value(NULL, T_STRING, pair->val);
		  }

		  rv = (Value *) pair->xval;
		  if (selected == NULL)
			selected = dsvec_init(NULL, sizeof(Value *));
		  dsvec_add_ptr(selected, rv);
		}
		else {
		  Dsvec *dsv;
		  Expr_result *er;

		  /* Dereference a list. */
		  er = init_expr_result(NULL, T_UNDEF);
		  er->value = *ref_el_val;
		  dsv = listref3(e, selection, &er->value, errmsg);
		  if (dsv == NULL)
			return(NULL);

		  if (selected == NULL)
			selected = dsvec_init(NULL, sizeof(Value));
		  dsvec_append(selected, dsv);
		}
	  }

	  if (dsvec_len(selected) == 0)
		selection = NULL;
	  else {
		selection = selected;
		if (dsvec_len(selected) == 1) {
		  v = (Value *) dsvec_ptr_index(selected, 0);
		  if (v->token == T_LIST) {
			selection = v->val.listval.list;
			selected_kwv = NULL;	/* XXX free */
		  }
		  else if (v->token == T_ALIST) {
			selected_kwv = v->val.alistval.kwv;	/* XXX free */
			selection = NULL;
		  }
		  else {
			goto got_non_list;
		  }
		}
	  }
	}
	else if (ref_val->token == T_LIST && ref_val->is_alist_reference) {
	  /*
	   * This is a "{...}" style dereference of an alist.
	   * A successful result will always produce another alist.
	   */
	  if (selection != NULL) {
		*errmsg = "Cannot dereference list with alist";
		return(NULL);
	  }

	  if (selected_kwv == NULL) {
		*errmsg = "Cannot dereference empty alist";
		return(NULL);
	  }
	  
	  ll = ref_val->val.listval.list;
	  kwv = kwv_init(4);
	  for (j = 0; j < dsvec_len(ll); j++) {
		ref_el_val = (Value *) dsvec_ptr_index(ll, j);

		if (!str_or_lit(ref_el_val->token)) {
		  *errmsg = "Invalid key";
		  return(NULL);
		}
		if ((pair = kwv_lookup(selected_kwv, ref_el_val->val.strval))
			== NULL) {
		  /* XXX This should yield the empty alist... */
		  *errmsg = "Undefined reference";
		  return(NULL);
		}
		if (pair->xval == NULL) {
		  if (pair->val == NULL) {
			*errmsg = "Internal error - no value";
			return(NULL);
		  }
		  pair->xval = init_value(NULL, T_STRING, pair->val);
		}

		if (kwv_add_pair(kwv, pair) == NULL) {
		  *errmsg = "Error processing alist subscript";
		  return(NULL);
		}
	  }

	  selected_kwv = kwv;
	}
	else {
	  *errmsg = "Invalid list reference";
	  return(NULL);
	}
  }

  if (selection != NULL) {
	if (dsvec_len(selection) == 1)
	  v = dsvec_ptr_index(selection, 0);
	else {
	  v = init_value(NULL, T_LIST, sizeof(Value));
	  v->val.listval.list = selection;
	}
  }
  else {
	v = init_value(NULL, T_ALIST, sizeof(Value));
	v->val.alistval.kwv = selected_kwv;
  }

  return(v);

 got_non_list:
  if (i == dsvec_len(refs) -1)
	return(v);

  *errmsg = "A non-list is being dereferenced";
  return(NULL);
}

#ifdef NOTDEF
/*
 * Apply list reference REFS to the list VALUE.
 * Each element of REFS corresponds to a [...] or {...} list reference
 * construct applied to VALUE.
 *
 * Syntax:
 *   LIST-SELECTION    -> "[" LIST-SELECT-ELS "]"
 *   LIST-SELECT-ELS   -> LIST-SELECT-EL | LIST-SELECT-EL "," LIST-SELECT-ELS
 *   LIST-SELECT-EL    -> EXP | LIST-SELECT-SLICE
 *   LIST-SELECT-SLICE -> EXP ".." EXP | EXP ".." "#"
 * List element selection can be composed and is right associative,
 * so you can write <list>[LIST-SELECTION]...; e.g., $a[0..9][2]
 * e.g., [0], [1,2], [1,2..4,8], [$i], [1 + 1]
 *
 * Given: $a = [[1,2,3], [4,5,6], [7,8,9]]
 * $a[0][2] is 3
 *
 * If $list = [1,2,[3,4,5]]
 * $list[2][1..#] is [4,5]
 *
 * XXX Would also like:
 *   $a["foo"] = ...
 *   $a[0]["foo"] = ...
 * And:
 *   $a["foo", "baz", "bar"] --> [$a["foo"], $a["baz"], $a["zzz"]]
 */
static Dsvec *
listref2(Lex_state *e, Value *value, Dsvec *refs, char **errmsg)
{
  int i, j;
  Dsvec *current_list, *new_list, *selection;
  Value *v;

  if (value->token != T_LIST)
	return(NULL);

  current_list = value->val.listval.list;
  for (i = 0; i < dsvec_len(refs); i++) {
	v = (Value *) dsvec_ptr_index(refs, i);

	if (v->token == T_LIST) {
	  Dsvec *ll;

	  ll = v->val.listval.list;
	  new_list = dsvec_init(NULL, sizeof(Value));
	  for (j = 0; j < dsvec_len(ll); j++) {
		Expr_result *er;
		Value *rv;

		rv = (Value *) dsvec_ptr_index(ll, j);
		er = init_expr_result(NULL, T_UNDEF);
		er->value = *rv;
		selection = listref3(e, current_list, &er->value, errmsg);
		if (selection == NULL)
		  return(NULL);
		dsvec_append(new_list, selection);
	  }
	}
	else {
	  if ((selection = listref3(e, current_list, v, errmsg)) == NULL)
		return(NULL);

	  new_list = selection;
	}

	if (dsvec_len(new_list) == 0)
	  current_list = NULL;
	else {
	  current_list = new_list;
	  if (dsvec_len(new_list) == 1) {
		v = (Value *) dsvec_ptr_index(new_list, 0);
		if (v->token == T_LIST)
		  current_list = v->val.listval.list;
	  }
	}
  }

  return(current_list);
}
#endif

/*
 * Get the value of VAR, applying REFS, an optional list dereference.
 * Example: $foo[0][1]
 */
static Value *
lvalue_value(Lex_state *e, Var *var, Dsvec *refs)
{
  int undef;
  char *val;
  Ds *ds;
  Expr_result *vres;
  Value *v;

  vres = NULL;
  if ((ds = acs_variable_resolve(var, e->env, &vres, &undef)) == NULL)
	return(NULL);
  val = ds_buf(ds);

  if (vres == NULL)
	return(NULL);

  if (refs != NULL) {
	char *errmsg;

#ifdef NOTDEF
	Dsvec *new_list;

	new_list = listref2(e, &vres->value, refs, &errmsg);
	if (new_list == NULL)
	  return(NULL);

	if (dsvec_len(new_list) != 1)
	  return(NULL);
	v = (Value *) dsvec_ptr_index(new_list, 0);
#else
	if ((v = alistref2(e, &vres->value, refs, &errmsg)) == NULL)
	  return(NULL);
#endif
  }
  else
	v = &vres->value;

  return(v);
}

/*
 * VAR-REF    -> '${' NS VARNAME LIST-SELECTION FLAGS '}'
 * NS         -> NAMESPACE '::'
 * NAMESPACE  -> ALPHA [ALPHANUM | '-' | '_']* | EMPTY
 * VARNAME    -> [ALPHANUM | '-' | '_' | '.' | '!' | '~'
 *              | '*' | '\'' | '(' | ')']+
 * FLAGS      -> ':' [GEN-FLAG | EX-FLAG]
 * GEN-FLAG   -> 'i'
 * EX-FLAG    -> 'e' | 'n' | 'z' | '+' SUBST-EXPR | '?' DEF-EXPR
 * SUBST-EXPR -> EMPTY | EXPR
 * DEF-EXPR   -> EMPTY | EXPR
 */

/*
 * Return 1 if the current token sequence yields an operand that can be an
 * lvalue, 0 if not, or -1 if there is an error.
 * An lvalue is something that may appear on the left hand side of an
 * assignment operator, and also an auto-incremented/decremented variable.
 * An lvalue may be in parens; the parens are a no-op (e.g., ($foo))
 * Also, the variable part may be in parens, followed by a list reference
 * sequence (e.g., ($foo)[0])
 *
 * If an lvalue is found, set VARP to information about the variable.
 * If a list reference sequence follows the variable, set IS_LIST_REF to
 * non-zero and REFS to a vector that describes the list reference sequence;
 * if there is no list reference sequence, set IS_LIST_REF to zero.
 * RESULT is used only to report an error.
 */
static int
is_lvalue(Lex_state *e, Lex_token **t1p, Var **varp, int *is_list_ref,
		  Dsvec *ref, Expr_result *res)
{
  int ctn_save;
  char *varname;
  Lex_token *t1;
  Var *var;

  token_save(e, &ctn_save);
  if (token_matches(e, T_LPAREN)) {
	int st;

	if ((st = is_lvalue(e, t1p, varp, is_list_ref, ref, res)) != 1) {
	  token_restore(e, ctn_save);
	  return(st);
	}

	if (!token_matches(e, T_RPAREN)) {
	  token_restore(e, ctn_save);
	  return(0);
	}

	if ((*is_list_ref = is_list_ref_seq(e, ref)) == -1)
	  return(-1);

	return(1);
  }

  if ((t1 = token_matches(e, T_VARIABLE)) == NULL) {
	token_restore(e, ctn_save);
	return(0);
  }
  *t1p = t1;

  varname = t1->value->varname;
  if ((var = var_parse_name(varname, NULL)) == NULL) {
	seterr_s(e, res, "Invalid variable name");
	return(-1);
  }

  *varp = var;

  if ((*is_list_ref = is_list_ref_seq(e, ref)) == -1)
	return(-1);

  return(1);
}

/*
 * Return 1 if the current token is a basic operand (and evaluate it,
 * if necessary), 0 otherwise.
 */
static int
is_operand(Lex_state *e, Expr_result *res)
{
  int undef;
  char *val, *varname;
  Ds *ds;
  Expr_result *vres;
  Lex_token *t;
  Var *var;

  t = token_lookahead(e, 0);
  switch (t->token) {
  case T_STRING:
	if (t->value->is_quoted) {
	  val = t->value->val.strval;
	  ds = ds_set(NULL, val);
	}
	else {
	  if ((ds = acs_string_operand(t->value->val.strval, e->env)) == NULL)
		val = NULL;
	  else
		val = ds_buf(ds);
	}

	if (val == NULL)
	  return(0);

	if (!e->do_eval)
	  return(1);

	if (t->value->is_var_reference) {
	  res->value.is_var_reference = 1;
	  res->value.varname = strdup(t->value->val.strval);
	}
	else {
	  res->value.is_var_reference = 0;
	  res->value.varname = NULL;
	}

	if (strlen(val) != ds_len(ds) -1
		|| !strprintable(val, ds_len(ds) - 1, 1)) {
	  res->value.token = T_BSTRING;
	  res->value.val.bval.data = ds_buf(ds);
	  res->value.val.bval.len = ds_len(ds) - 1;
	}
	else {
	  res->value.token = T_STRING;
	  res->value.val.strval = val;
	  res->value.is_quoted = t->value->is_quoted;
	}

	return(1);
	/*NOTREACHED*/

  case T_VARIABLE:
	varname = t->value->varname;
	if ((var = var_parse_name(varname, NULL)) == NULL) {
	  seterr_s(e, res, "Invalid variable name");
      return(-1);
    }

	if (!e->do_eval)
	  return(1);

	vres = NULL;
	if ((ds = acs_variable_resolve(var, e->env, &vres, &undef)) == NULL)
	  return(-1);
	val = ds_buf(ds);

	if (vres != NULL)
	  copy_result(res, vres);
	else {
	  res->value.token = T_STRING;
	  res->value.val.strval = val;
	  res->value.is_quoted = 0;
	}
	return(1);
	/*NOTREACHED*/

  case T_INTEGER:
	if (e->do_eval)
	  res->value = *t->value;
	return(1);
	/*NOTREACHED*/

  case T_REAL:
	if (e->do_eval)
	  res->value = *t->value;
	return(1);
	/*NOTREACHED*/

  case T_LITERAL:
	if (e->do_eval) {
	  res->value.token = T_LITERAL;
	  res->value = *t->value;
	}
	return(1);
	/*NOTREACHED*/

  default:
	return(0);
	/*NOTREACHED*/
  }

  /*NOTREACHED*/
}

typedef struct AssignToken {
  Token assign_op;
  Token op;
} AssignToken;

static Token
lookup_assign_token(Token t)
{
  int i;
  static AssignToken assign[] = {
	{ T_ASSIGN,    T_ASSIGN },
	{ T_PLUS_EQ,   T_PLUS },
	{ T_MINUS_EQ,  T_MINUS },
	{ T_TIMES_EQ,  T_TIMES },
	{ T_DIV_EQ,    T_DIV },
	{ T_MOD_EQ,    T_MOD },
	{ T_BITSHR_EQ, T_BITSHR },
	{ T_BITSHL_EQ, T_BITSHL },
	{ T_BITAND_EQ, T_BITAND },
	{ T_BITXOR_EQ, T_BITXOR },
	{ T_BITOR_EQ,  T_BITOR },
	{ T_DOT_EQ,    T_DOT },
	{ T_UNDEF,     T_UNDEF }
  };

  for (i = 0; assign[i].assign_op != T_UNDEF; i++) {
	if (t == assign[i].assign_op)
	  return(assign[i].op);
  }

  return(T_UNDEF);
}

/*
 * Recursive descent parser
 *
 * Grammar:
 *
 * S  -> EXP | EXP ";" | EXP ";" S
 * EXP -> E
 *
 * E    -> E2   | E2 "," E
 * E2   -> E3   | LVALUE ASSIGN_OP E2 | IF_ELSEIF_ELSE
 * E3   -> E4   | E4 "?" E ":" E
 * E4   -> E5   | E5 OR E5
 * E5   -> E6   | E6 AND E5
 * E6   -> E7   | E7 "|" E7
 * E7   -> E8   | E8 "^" E8
 * E8   -> E9   | E9 "&" E9
 * E9   -> E10a | E10a EQ_OP E10a
 * E10a -> E10b | E10b REL_OP E10b
 * E10b -> E11  | E11 "." E11
 * E11  -> E12  | E12 "<<" E12 | E12 ">>" E12
 * E12  -> E13a | E13a "+" E13a  | E13a "-" E13a
 * E13a -> E13b | E13b "*" E13b  | E13b "/" E13b | E13b "%" E13b
 * E13b -> E15  | E15 "**" E13a
 * E15  -> E17  | NOT E15 | "~" E15 | "++" LVALUE | "--" LVALUE | "+" E | "-" E
 * E17  -> "(" E ")" | LVALUE "++" | LVALUE "--" | FUNCTION_CALL | PRIMARY
 *
 * ASSIGN_OP -> "=" | "+=" | "-=" | "*=" | "/=" | "%=" | ">>="
 *   | "<<=" | "&=" | "^=" | "|=" | ".="
 *
 * PRIMARY -> number | string
 * OR      -> "||" | "or"
 * AND     -> "&&" | "and"
 * NOT     -> "!" | "not"
 * EQ_OP   -> "==" | "!=" | "eq" | "ne"
 * REL_OP  -> "<" | "<=" | ">" | ">=" | "lt" | "le" | "gt" | "ge"
 * VAR     -> a variable reference
 * IF_ELSEIF_ELSE -> an "if" statement with zero or more "elseif" components
 *  and an optional "else" component
 * FUNCTION_CALL -> FUNCTION_NAME "(" ARG_LIST ")"
 * ARG_LIST -> EMPTY | E2 | ARG_LIST "," E2
 *
 * LVALUE -> "(" LVALUE ")" | VAR

 * A function call is a function name (an alphabetic followed by alphanumerics
 * or underscores), followed by a left paren, followed by zero
 * or more comma-separated arguments (each an expression), followed by a
 * right paren.
 *
 * The names of the parsing functions correspond to the operator precedence
 * levels appearing in Table 7-3 of "C: A Reference Manual", Harbison & Steele,
 * Fourth Edition, 1995, p. 181, with a few additional operators.
 * Level 10b has a higher precedence than 10a.
 */
static int
heir(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir2(e, &res1) == -1) {
	if (e->do_eval || e->exit_called)
	  copy_result(result, &res1);
	else if (res1.errmsg != NULL) {
	  result->errmsg = res1.errmsg;
	  result->err = res1.err;
	}
	return(-1);
  }

  /* The comma operator */
  if (token_matches(e, T_COMMA)) {
	if (heir(e, result) == -1)
	  return(-1);
	log_msg((LOG_TRACE_LEVEL, "comma"));
  }
  else
    if (e->do_eval || e->exit_called)
	  copy_result(result, &res1);

  return(0);
}

/*
 * Test for an assignment statement: <lvalue> <assign-op> ...
 * If one is found, return 1, otherwise return 0 if there isn't one,
 * or -1 if an error occurs.
 * Set LVALUE to describe the lvalue so that the pre-assignment value can be
 * used and its new value stored.
 */
static int
is_assign(Lex_state *e, Lvalue *lvalue, Expr_result *result)
{
  int ctn_save, is_list_ref, st, undef;
  Ds *ds;
  Dsvec *refs;
  Expr_result *res, *vres;
  Lex_token *t1, *t2;
  Token op;
  Value *v;
  Var *var;

  /*
   * We may need to scan ahead past several tokens, so note where we are
   * in case this is not an assignment statement and we need to back up.
   */
  token_save(e, &ctn_save);

  res = init_expr_result(result, T_UNDEF);
  refs = dsvec_init(NULL, sizeof(Value));
  if ((st = is_lvalue(e, &t1, &var, &is_list_ref, refs, res)) == -1)
	return(-1);
  if (st == 0) {
	token_restore(e, ctn_save);
	return(0);
  }

  if ((t2 = token_lookahead(e, 0)) == NULL
	  || (op = lookup_assign_token(t2->token)) == T_UNDEF) {
	token_restore(e, ctn_save);
	return(0);
  }

  if (var->flagstr != NULL) {
	seterr_s(e, res, "Modifier flags not permitted on LHS of assignment");
	return(-1);
  }

  if (acs_is_readonly_namespace(var->ns)) {
	seterr_s(e, res,
			 ds_xprintf("Can't assign to invalid or reserved namespace '%s'",
						t1->value->val.strval));
	return(-1);
  }

  token_advance(e, 1);

  if (!e->do_eval)
	return(1);

  /*
   * We need the current value if the variable is a list selection or if this
   * is a compound assignment (e.g., "+=").
   */
  vres = NULL;
  if (is_list_ref || op != T_ASSIGN) {
	char *errmsg, *val;
	Token ct;

	if ((ds = acs_variable_resolve(var, e->env, &vres, &undef)) == NULL)
	  return(-1);
	val = ds_buf(ds);
	if (is_list_ref) {
	  if (vres == NULL) {
		seterr_e(e, res, "Invalid variable dereference");
		return(-1);
	  }

	  ct = vres->value.token;
	  if (ct == T_LIST || ct == T_ALIST) {
		v = alistref2(e, &vres->value, refs, &errmsg);
		if (v == NULL) {
		  seterr_e(e, result,
				   ds_xprintf("Invalid %s reference follows variable in assignment: %s",
							  ct == T_LIST ? "list" : "alist", errmsg));
		  return(-1);
		}
		result->value = *v;
	  }
	  else {
		seterr_e(e, res, "Invalid variable type dereference");
		return(-1);
	  }
	}
	else
	  v = &vres->value;
  }
  else
	v = NULL;

  lvalue->lval = t1;
  lvalue->assign_op = t2;
  lvalue->op = op;
  lvalue->value = v;
  lvalue->var = var;
  if (dsvec_len(refs))
	lvalue->refs = refs;
  else
	lvalue->refs = NULL;

  return(1);
}

/*
 * Assignment or if-statement.
 */
static int
heir2(Lex_state *e, Expr_result *result)
{
  int st;
  Expr_result res1;
  Lvalue lvalue;

  if (value_init(&res1, result))
	return(-1);

  /*
   * Assignments look like:  <lvalue> assign-op <expr>
   */
  lvalue.lval = NULL;
  lvalue.assign_op = NULL;
  lvalue.op = T_UNDEF;
  lvalue.value = NULL;
  lvalue.var = NULL;
  lvalue.refs = NULL;
  if ((st = is_assign(e, &lvalue, result)) == -1)
	return(-1);

  if (st != 0) {
	char *val;

	if (heir2(e, result) == -1)
	  return(-1);

	if (!e->do_eval)
	  return(0);

	if (lvalue.assign_op->token != T_ASSIGN) {
	  Expr_result *temp;

	  temp = init_expr_result(NULL, T_UNDEF);
	  copy_value(&temp->value, lvalue.value);

	  if (eval2(e, result, lvalue.op, temp, result) == -1)
		return(-1);
	}

	if (force_string(&result->value, &val) == -1) {
	  seterr_s(e, result, "Conversion error for RHS of assignment");
	  return(-1);
	}

	if (lvalue.value != NULL) {
	  if (lvalue.refs != NULL) {
		/*
		 * If we are "updating" an existing list variable, just store the new
		 * value via the pointer.
		 */
		copy_value(lvalue.value, &result->value);
	  }
	  else {
		Kwv *kwv;
		Kwv_pair pair;

		if ((kwv = var_ns_lookup_kwv(e->env->namespaces, lvalue.var->ns))
			== NULL)
		  return(-1);
		kwv_set_pair(&pair, lvalue.var->name, val,
					 copy_value(NULL, &result->value));
		if (kwv_replace_pair(kwv, &pair) == NULL)
		  return(-1);
	  }
	}
	else
	  {
	  if ((var_ns_lookup(e->env->namespaces, lvalue.var->ns) == NULL
		   && var_ns_new(&e->env->namespaces, lvalue.var->ns, NULL) == NULL)
		  || var_ns_add_var(e->env->namespaces, lvalue.var->ns,
							lvalue.var->name, val,
							copy_result(NULL, result)) == NULL) {
		seterr_s(e, result, ds_xprintf("Cannot assign result to \"%s\"",
									   lvalue.var->name));
		return(-1);
	  }
	}

	if (result->value.token == T_STRING)
	  log_msg((LOG_TRACE_LEVEL, "Set %s to \"%s\"", lvalue.var->name, val));
	else
	  log_msg((LOG_TRACE_LEVEL, "Set %s to %s", lvalue.var->name, val));
  }
  else if (token_matches(e, T_IF)) {
	if (do_if(e, result) == -1)
	  return(-1);
	log_msg((LOG_TRACE_LEVEL, "if"));
  }
  else {
	if (heir3(e, result) == -1)
	  return(-1);
  }

  return(0);
}

/*
 * We've seen the "if" or "elseif" keyword.
 * Process the condition and if True, evaluate the statement block; if False,
 * only parse the statement block:
 *    if/elseif (cond) { if-true-block }
 * Return 1 if the condition was True, 0 if not, and -1 or error.
 */
static int
do_if_test(Lex_state *e, Expr_result *result)
{
  int eval_state, is_true, st;
  Expr_result cond, discard, *res;

  if (value_init(&cond, result))
	return(-1);

  if (!token_matches(e, T_LPAREN)) {
	seterr_s(e, result, "Opening paren is missing");
	return(-1);
  }

  if (heir(e, &cond) == -1)
	return(-1);

  if (!token_matches(e, T_RPAREN)) {
	seterr_s(e, result, "Closing paren is missing");
	return(-1);
  }

  if (!token_is(e, 0, T_LBRACE)) {
	seterr_s(e, result, "Opening brace is missing");
	return(-1);
  }

  if (e->do_eval)
	res = result;
  else {
	if (value_init(&discard, result))
	  return(-1);
	res = &discard;
  }

  st = is_true_value(&cond.value);
  if (e->do_eval && st == -1) {
	seterr(e, result, ACS_EXPR_EVAL_ERROR, "Invalid boolean result value");
	return(-1);
  }
  if (st == 1 || !e->do_eval) {
	/* Do True block */
	if (do_block(e, 0, res) == -1)
	  return(-1);
	is_true = 1;
  }
  else {

	/*
	 * Condition is False
	 * Parse but do not process the "if true" part.
	 */
	eval_state = e->do_eval;
	e->do_eval = 0;
	if (do_block(e, 0, res) == -1)
	  return(-1);
	e->do_eval = eval_state;
	is_true = 0;
  }

  return(is_true);
}

/*
 * Process an if/elseif/else statement.
 * The "elseif" and "else" are optional.
 * The value of the statement is that of the last executed statement, or
 * the empty string if no statement is executed.
 */
static int
do_if(Lex_state *e, Expr_result *result)
{
  int eval_state, is_true;

  eval_state = e->do_eval;
  while (1) {
	if ((is_true = do_if_test(e, result)) == -1)
	  return(-1);

	if (is_true)
	  e->do_eval = 0;

	if (token_matches(e, T_ELSEIF))
	  continue;
	else if (token_matches(e, T_ELSE)) {
	  if (!token_is(e, 0, T_LBRACE)) {
		seterr_s(e, result, "Opening brace is missing");
		return(-1);
	  }

	  if (e->do_eval) {
		if (do_block(e, 0, result) == -1)
		  return(-1);
	  }
	  else {
		Expr_result discard;

		if (value_init(&discard, result))
		  return(-1);
		if (do_block(e, 0, &discard) == -1)
		  return(-1);
	  }
	  break;
	}
	else {
	  /* There's no "else" */
	  if (e->do_eval)
		init_value(&result->value, T_STRING, "");
	  break;
	}
  }

  e->do_eval = eval_state;

  return(0);
}

/*
 * The C-style conditional:
 *    expr ? val1 : val2
 * If expr is True, the value is that of val1 and val2 is not evaluated;
 * If expr is False, the value is that of val2 and val1 is not evaluated.
 */
static int
heir3(Lex_state *e, Expr_result *result)
{
  int eval_state, st;
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir4(e, &res1) == -1) {
	if (e->do_eval || e->exit_called)
	  copy_result(result, &res1);
	else if (res1.errmsg != NULL) {
	  result->errmsg = res1.errmsg;
	  result->err = res1.err;
	}
	return(-1);
  }

  if (token_matches(e, T_COND)) {
	Expr_result discard;

	/* This is a C-style conditional expression: a ? b : c */
	if (value_init(&discard, result))
	  return(-1);

	if (!e->do_eval || (st = is_true_value(&res1.value)) == 1) {
	  if (heir(e, result) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (!token_matches(e, T_COLON)) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  /* Parse but don't evaluate the second expression. */
	  eval_state = e->do_eval;
	  e->do_eval = 0;
	  if (heir(e, &discard) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  e->do_eval = eval_state;
	}
	else if (e->do_eval && st == -1) {
	  seterr(e, result, ACS_EXPR_EVAL_ERROR, "Invalid boolean result value");
	  return(-1);
	}
	else {
	  /* Parse but don't evaluate the first expression. */
	  eval_state = e->do_eval;
	  e->do_eval = 0;
	  if (heir(e, &discard) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  e->do_eval = eval_state;
	  if (!token_matches(e, T_COLON)) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (heir(e, result) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	}
	log_msg((LOG_TRACE_LEVEL, "conditional"));
  }
  else {
    if (e->do_eval || e->exit_called)
	  copy_result(result, &res1);
  }

  return(0);
}

/*
 * The C-style logical OR operator.
 * The tricky part is that evaluation is from left to right and stops
 * as soon as the truth or falsehood of the result is known.
 */
static int
heir4(Lex_state *e, Expr_result *result)
{
  int eval_state;
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir5(e, result) == -1)
	return(-1);

  if (e->do_eval || e->exit_called)
	copy_result(&res1, result);
  eval_state = e->do_eval;

  while (1) {
	if (token_matches(e, T_OR)) {
	  int i1, i2;

	  if (e->do_eval) {
		if (boolean_value(&res1, &i1) == -1) {
		  seterr_s(e, result, "Invalid operand");
		  return(-1);
		}
		if (i1) {
		  result->value.val.intval = 1L;
		  result->value.token = T_INTEGER;
		  e->do_eval = 0;
		  if (heir5(e, &res1) == -1) {
			seterr_s(e, result, "Invalid operand");
			return(-1);
		  }
		}
		else {
		  if (heir5(e, &res1) == -1) {
			seterr_s(e, result, "Invalid operand");
			return(-1);
		  }
		  if (boolean_value(&res1, &i2) == -1) {
			seterr_s(e, result, "Invalid operand");
			return(-1);
		  }
		  if (i2) {
			result->value.val.intval = 1L;
			result->value.token = T_INTEGER;
			e->do_eval = 0;
		  }
		  else {
			result->value.val.intval = 0L;
			result->value.token = T_INTEGER;
		  }
		}
	  }
	  else {
		if (heir5(e, &res1) == -1) {
		  seterr_s(e, result, "Invalid operand");
		  return(-1);
		}
	  }
	  log_msg((LOG_TRACE_LEVEL, "logical or"));
	}
	else
	  break;
  }

  e->do_eval = eval_state;

  return(0);
}

/*
 * The C-style logical AND operator.
 * The tricky part is that evaluation is from left to right and stops
 * as soon as the truth or falsehood of the result is known.
 */
static int
heir5(Lex_state *e, Expr_result *result)
{
  int eval_state;
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir6(e, result) == -1)
	return(-1);

  if (e->do_eval || e->exit_called)
	copy_result(&res1, result);
  eval_state = e->do_eval;

  while (1) {
	if (token_matches(e, T_AND)) {
	  int i1, i2;

	  if (e->do_eval) {
		if (boolean_value(&res1, &i1) == -1) {
		  seterr_s(e, result, "Invalid operand");
		  return(-1);
		}
		if (i1 == 0) {
		  result->value.val.intval = 0L;
		  result->value.token = T_INTEGER;
		  e->do_eval = 0;
		  if (heir5(e, &res1) == -1) {
			seterr_s(e, result, "Invalid operand");
			return(-1);
		  }
		}
		else {
		  if (heir5(e, &res1) == -1) {
			seterr_s(e, result, "Invalid operand");
			return(-1);
		  }
		  if (boolean_value(&res1, &i2) == -1) {
			seterr_s(e, result, "Invalid operand");
			return(-1);
		  }
		  if (i2 == 0) {
			result->value.val.intval = 0L;
			result->value.token = T_INTEGER;
			e->do_eval = 0;
		  }
		  else {
			result->value.val.intval = 1L;
			result->value.token = T_INTEGER;
		  }
		}
	  }
	  else {
		if (heir5(e, &res1) == -1) {
		  seterr_s(e, result, "Invalid operand");
		  return(-1);
		}
	  }
	  log_msg((LOG_TRACE_LEVEL, "logical and"));
	}
	else
	  break;
  }

  e->do_eval = eval_state;

  return(0);
}

static int
heir6(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir7(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_BITOR)) {
	  if (heir7(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_BITOR, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "bitwise or"));
	}
	else
	  break;
  }

  return(0);
}

static int
heir7(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir8(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_BITXOR)) {
	  if (heir8(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_BITXOR, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "bit xor"));
	}
	else
	  break;
  }

  return(0);
}

static int
heir8(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir9(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_BITAND)) {
	  if (heir9(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_BITAND, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "bit and"));
	}
	else
	  break;
  }

  return(0);
}

static int
heir9(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir10a(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_EQ)) {
	  if (heir10a(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_EQ, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "eq"));
	}
	else if (token_matches(e, T_EQ_I)) {
	  if (heir10a(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_EQ_I, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "eq:i"));
	}
	else if (token_matches(e, T_NE)) {
	  if (heir10a(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_NE, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "ne"));
	}
	else if (token_matches(e, T_NE_I)) {
	  if (heir10a(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_NE_I, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "ne:i"));
	}
	else
	  break;
  }

  return(0);
}

static int
heir10a(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir10b(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_LT)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_LT, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "lt"));
	}
	else if (token_matches(e, T_LT_I)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_LT_I, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "lt:i"));
	}
	else if (token_matches(e, T_LE)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_LE, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "le"));
	}
	else if (token_matches(e, T_LE_I)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_LE_I, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "le:i"));
	}
	else if (token_matches(e, T_EQ)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_EQ, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "eq"));
	}
	else if (token_matches(e, T_EQ_I)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_EQ_I, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "eq:i"));
	}
	else if (token_matches(e, T_NE)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_NE, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "ne"));
	}
	else if (token_matches(e, T_NE_I)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_NE_I, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "ne:i"));
	}
	else if (token_matches(e, T_GT)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_GT, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "gt"));
	}
	else if (token_matches(e, T_GT_I)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_GT_I, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "gt:i"));
	}
	else if (token_matches(e, T_GE)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_GE, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "ge"));
	}
	else if (token_matches(e, T_GE_I)) {
	  if (heir10b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_GE_I, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "ge:i"));
	}
	else
	  break;
  }

  return(0);
}

static int
heir10b(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir11(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_DOT)) {
	  if (heir11(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }

	  if (eval2(e, result, T_DOT, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "dot"));
	}
	else
	  break;
  }

  return(0);
}

/*
 * Bit shifts
 */
static int
heir11(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir12(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_BITSHL)) {
	  if (heir12(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_BITSHL, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "bit shift left"));
	}
	else if (token_matches(e, T_BITSHR)) {
	  if (heir12(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_BITSHR, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "bit shift right"));
	}
	else
	  break;
  }

  return(0);
}

/*
 * Addition and subtraction
 */
static int
heir12(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir13a(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_PLUS)) {
	  if (heir13a(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_PLUS, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "binary plus"));
	}
	else if (token_matches(e, T_MINUS)) {
	  if (heir13a(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_MINUS, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "binary minus"));
	}
	else
	  break;
  }

  return(0);
}

/*
 * Multiplication, division, and modulo
 */
static int
heir13a(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir13b(e, result) == -1)
	return(-1);

  while (1) {
	if (token_matches(e, T_TIMES)) {
	  if (heir13b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_TIMES, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "multiply"));
	}
	else if (token_matches(e, T_DIV)) {
	  if (heir13b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_DIV, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "divide"));
	}
	else if (token_matches(e, T_MOD)) {
	  if (heir13b(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  if (eval2(e, result, T_MOD, result, &res1) == -1)
		return(-1);
	  log_msg((LOG_TRACE_LEVEL, "mod"));
	}
	else
	  break;
  }

  return(0);
}

/*
 * Exponentiation
 */
static int
heir13b(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir14(e, result) == -1)
	return(-1);

  if (token_matches(e, T_EXP)) {
	if (heir13a(e, &res1) == -1) {
	  seterr_s(e, result, "Invalid operand");
	  return(-1);
	}
	if (eval2(e, result, T_EXP, result, &res1) == -1)
	  return(-1);
	log_msg((LOG_TRACE_LEVEL, "exponentiation"));
  }

  return(0);
}

static int
heir14(Lex_state *e, Expr_result *result)
{
  Expr_result res1;

  if (value_init(&res1, result))
	return(-1);

  if (heir15(e, result) == -1)
	return(-1);

  if (token_matches(e, T_DOTDOT)) {
	int saw_hash;
	long max, min;

	if (token_matches(e, T_HASH)) 
	  saw_hash = 1;
	else {
	  if (heir15(e, &res1) == -1) {
		seterr_s(e, result, "Invalid operand");
		return(-1);
	  }
	  saw_hash = 0;
	}

	if (!e->do_eval)
	  return(0);

	if (result->value.token != T_INTEGER)
	  return(-1);
	if (!saw_hash && res1.value.token != T_INTEGER)
	  return(-1);

	result->value.token = T_DOTDOT;
	if ((min = result->value.val.intval) < 0) {
	  seterr_e(e, result, "Invalid minimum dotdot value");
	  return(-1);
	}
	result->value.val.dotdot.min = min;
	if (saw_hash)
	  result->value.val.dotdot.max = DOTDOT_LAST;	/* XXX */
	else {
	  if ((max = res1.value.val.intval) < 0) {
		seterr_e(e, result, "Invalid maximum dotdot value");
		return(-1);
	  }
	  if (min > max) {
		seterr_e(e, result, "Invalid dotdot order");
		return(-1);
	  }
	  result->value.val.dotdot.max = max;
	}

	log_msg((LOG_TRACE_LEVEL, "dotdot"));
  }

  return(0);
}

static int
heir15(Lex_state *e, Expr_result *result)
{
  Expr_result res1;
  Lex_token *t;

  if (value_init(&res1, result))
	return(-1);

  if (token_matches(e, T_NOT)) {
	if (heir15(e, &res1) == -1) {
	  seterr_s(e, result, "Invalid operand");
	  return(-1);
	}

	if (eval1(e, result, T_NOT, &res1) == -1)
	  return(-1);

	log_msg((LOG_TRACE_LEVEL, "logical not"));
	return(0);
  }

  if (token_matches(e, T_BITCPL)) {
	if (heir15(e, &res1) == -1) {
	  seterr_s(e, result, "Invalid operand");
	  return(-1);
	}

	if (eval1(e, result, T_BITCPL, &res1) == -1)
	  return(-1);

	log_msg((LOG_TRACE_LEVEL, "bit complement"));
	return(0);
  }

  if (token_is(e, 0, T_LPAREN)
	  && ((t = token_lookahead(e, 1)) != NULL && t->token == T_LITERAL)
	  && token_is(e, 2, T_RPAREN)) {
	if (token_advance(e, 3) == -1) {
	  seterr_s(e, result, "Unexpected end-of-input");
	  return(-1);
	}

	if (heir15(e, &res1) == -1) {
	  seterr_s(e, result, "Invalid operand");
	  return(-1);
	}

	if ((result->value.token = typename_to_type(t->value->val.strval))
		== T_UNDEF) {
	  /* EXPERIMENTAL */
	  Token ct;

	  if ((ct = castname_to_type(t->value->val.strval)) != T_UNDEF) {
		if (!e->do_eval)
		  return(0);

		/*
		 * Base representation conversion: integer to string or string to
		 * integer; e.g., (hex) <integer-value> or (hex) <string-value>
		 */
		if (res1.value.token == T_INTEGER) {
		  if (int_to_string(e, result, ct, &res1) == -1) {
			seterr_s(e, result,
					 ds_xprintf("Invalid integer to %s string cast",
								t->value->val.strval));
			return(-1);
		  }
		}
		else if (res1.value.token == T_STRING) {
		  if (string_to_integer(e, result, ct, &res1) == -1) {
			seterr_s(e, result,
					 ds_xprintf("Invalid %s string to integer cast",
								t->value->val.strval));
			return(-1);
		  }
		}
		else {
		  seterr_s(e, result, "Invalid cast");
		  return(-1);
		}
		log_msg((LOG_TRACE_LEVEL, "cast to \"%s\"", t->value->val.strval));
		return(0);
	  }
	  else {
		seterr_s(e, result, "Invalid cast");
		return(-1);
	  }
	}

	if (eval1(e, result, T_CAST, &res1) == -1)
	  return(-1);

	log_msg((LOG_TRACE_LEVEL, "cast to \"%s\"", t->value->val.strval));
	return(0);
  }

  if (token_is(e, 0, T_PLUS) && token_is(e, 1, T_PLUS)) {
	int ctn_save, is_list_ref, saw_lvalue;
	Dsvec *refs;
	Lex_token *t1;
	Var *var;

	token_save(e, &ctn_save);
	token_advance(e, 2);
	refs = dsvec_init(NULL, sizeof(Value));
	saw_lvalue = is_lvalue(e, &t1, &var, &is_list_ref, refs, result);
	if (saw_lvalue == -1)
	  return(-1);

	if (saw_lvalue) {
	  Value *v;

	  if (!e->do_eval)
		return(0);

	  /* Pre-increment */
	  if ((v = lvalue_value(e, var, is_list_ref ? refs : NULL)) == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Pre-inc: invalid list reference variable: %s",
							var->varname));
		return(-1);
	  }

	  if (inc_variable(e, v, var, T_PREINC, is_list_ref, result) == -1)
		return(-1);

	  log_msg((LOG_TRACE_LEVEL, "pre-increment"));
	  return(0);
	}

	token_restore(e, ctn_save);
  }

  if (token_is(e, 0, T_MINUS) && token_is(e, 1, T_MINUS)) {
	int ctn_save, is_list_ref, saw_lvalue;
	Dsvec *refs;
	Lex_token *t1;
	Var *var;

	token_save(e, &ctn_save);
	token_advance(e, 2);
	refs = dsvec_init(NULL, sizeof(Value));
	saw_lvalue = is_lvalue(e, &t1, &var, &is_list_ref, refs, result);
	if (saw_lvalue == -1)
	  return(-1);

	if (saw_lvalue) {
	  Value *v;

	  if (!e->do_eval)
		return(0);

	  /* Pre-decrement */
	  if ((v = lvalue_value(e, var, is_list_ref ? refs : NULL)) == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Pre-dec: invalid list reference variable: %s",
							var->varname));
		return(-1);
	  }

	  if (inc_variable(e, v, var, T_PREDEC, is_list_ref, result) == -1)
		return(-1);

	  log_msg((LOG_TRACE_LEVEL, "pre-decrement"));
	  return(0);
	}
	token_restore(e, ctn_save);
  }

  if (token_matches(e, T_PLUS)) {
	if (value_init(&res1, result))
	  return(-1);

	if (heir15(e, &res1) == -1)
	  return(-1);

	if (eval1(e, result, T_UNARY_PLUS, &res1) == -1)
	  return(-1);

	log_msg((LOG_TRACE_LEVEL, "unary plus"));
	return(0);
  }

  if (token_matches(e, T_MINUS)) {
	if (value_init(&res1, result))
	  return(-1);

	if (heir15(e, &res1) == -1)
	  return(-1);

	if (eval1(e, result, T_UNARY_MINUS, &res1) == -1)
	  return(-1);

	log_msg((LOG_TRACE_LEVEL, "unary minus"));
	return(0);
  }

  return(heir17(e, result));
}

/*
 * Handle operators and syntactic constructs that bind very tightly to
 * operands.
 */
static int
heir17(Lex_state *e, Expr_result *result)
{
  int is_list_ref, saw_lvalue, undef;
  Dsvec *refs;
  Lex_token *t, *t1;
  Token ct;
  Var *var;

  refs = dsvec_init(NULL, sizeof(Value));
  if ((saw_lvalue = is_lvalue(e, &t1, &var, &is_list_ref, refs, result)) == -1)
	return(-1);

  if (saw_lvalue && token_is(e, 0, T_MINUS) && token_is(e, 1, T_MINUS)) {
	Value *v;

	/* Post-decrement */
	token_advance(e, 2);

	if (!e->do_eval)
	  return(0);

	if ((v = lvalue_value(e, var, is_list_ref ? refs : NULL)) == NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Post-dec: invalid list reference variable: %s",
						  var->varname));
	  return(-1);
	}

	if (inc_variable(e, v, var, T_POSTDEC, is_list_ref, result) == -1)
	  return(-1);

	log_msg((LOG_TRACE_LEVEL, "post-decrement"));
	return(0);
  }

  if (saw_lvalue && token_is(e, 0, T_PLUS) && token_is(e, 1, T_PLUS)) {
	Value *v;

	/* Post-increment */
	token_advance(e, 2);

	if (!e->do_eval)
	  return(0);

	if ((v = lvalue_value(e, var, is_list_ref ? refs : NULL)) == NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Post-inc: invalid list reference variable: %s",
						  var->varname));
	  return(-1);
	}

	if (inc_variable(e, v, var, T_POSTINC, is_list_ref, result) == -1)
	  return(-1);

	log_msg((LOG_TRACE_LEVEL, "post-increment"));
	return(0);
  }

  /*
   * A list or alist constructor?
   * It may be followed by a list reference:
   * [1, 2, 3, 4]
   * [1, 2, 3, 4][2]
   * { "red", 0, "yellow", 0, "blue", 0, "black", 0 }
   * { "red", 0, "blue", 0 }["blue"] --> 0
   */
  if (!saw_lvalue
	  && (token_is(e, 0, T_LBRACKET) || token_is(e, 0, T_LBRACE))) {
	char *errmsg;

	if (token_is(e, 0, T_LBRACKET)) {
	  if (list_cons(e, result) == -1) {
		if (result->errmsg == NULL)
		  seterr_e(e, result, "Invalid list constructor");
		return(-1);
	  }
	}
	else {
	  if (alist_cons(e, result) == -1) {
		if (result->errmsg == NULL)
		  seterr_e(e, result, "Invalid alist constructor");
		return(-1);
	  }
	}

	ct = token_current(e);
	if (ct != T_LBRACKET && ct != T_LBRACE)
	  return(0);

	/* Collect the sequence of list references. */
	refs = dsvec_init(NULL, sizeof(Value));
	if (is_list_ref_seq(e, refs) != 1) {
	  seterr_e(e, result, "Invalid list reference follows constructor");
	  return(-1);
	}

	if (!e->do_eval)
	  return(0);

	/* Dereference the list. */
#ifdef NOTDEF
	if (result->value.token == T_LIST) {
	  new_list = listref2(e, &result->value, refs, &errmsg);
	  if (new_list == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid list reference follows constructor: %s",
							errmsg));
		return(-1);
	  }

	  if (dsvec_len(new_list) == 1) {
		Value *v;

		v = (Value *) dsvec_ptr_index(new_list, 0);
		copy_value(&result->value, v);
	  }
	  else {
		result->value.token = T_LIST;
		result->value.val.listval.list = new_list;
	  }
	}
	else if (result->value.token == T_ALIST) {
	  Value *v;

	  v = alistref2(e, &result->value, refs, &errmsg);
	  if (v == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid alist reference follows constructor: %s",
							errmsg));
		return(-1);
	  }
	  result->value = *v;
	}
	else
	  return(-1);
#else
	if (result->value.token == T_LIST
		|| result->value.token == T_ALIST) {
	  Value *v;

	  v = alistref2(e, &result->value, refs, &errmsg);
	  if (v == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid %s reference follows constructor: %s",
							result->value.token == T_LIST ? "list" : "alist",
							errmsg));
		return(-1);
	  }
	  result->value = *v;
	}
	else
	  return(-1);
#endif
	return(0);
  }

  /*
   * A list variable followed by a list reference?
   * Note that ($a.$b)[0] is legal - may also use listref($a.$b, 0).
   */
  if (saw_lvalue && is_list_ref) {
	char *errmsg, *val;
	Ds *ds;
	Expr_result *vres;

	if (!e->do_eval)
	  return(0);

	/* Get the variable's value, which must be a list or alist. */
	vres = NULL;
	if ((ds = acs_variable_resolve(var, e->env, &vres, &undef)) == NULL)
	  return(-1);
	val = ds_buf(ds);

	if (vres == NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Invalid list reference variable: %s",
						  var->varname));
	  return(-1);
	}
	
	if (vres->value.token == T_LIST) {
	  Value *v;

	  v = alistref2(e, &vres->value, refs, &errmsg);
	  if (v == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid list reference follows variable: %s",
							errmsg));
		return(-1);
	  }
	  result->value = *v;
	}
	else if (vres->value.token == T_ALIST) {
	  Value *v;

	  v = alistref2(e, &vres->value, refs, &errmsg);
	  if (v == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid alist reference follows variable: %s",
							errmsg));
		return(-1);
	  }
	  result->value = *v;
	}
	else {
	  seterr_e(e, result,
			   ds_xprintf("Invalid lvalue list reference variable: %s",
						  var->varname));
	  return(-1);
	}

	return(0);
  }

  if (!saw_lvalue && (t = token_matches(e, T_FUNC)) != NULL) {
	char *fname;
	Arglist *args;

	fname = t->value->val.strval;
	args = NULL;
	if (funargs(e, &args) == -1) {
	  seterr_e(e, result,
			 ds_xprintf("Invalid function call argument: \"%s\"", fname));
	  return(-1);
	}

    if (eval_function(fname, e, args, result) == -1) {
	  if (result->errmsg != NULL)
		log_msg((LOG_ERROR_LEVEL, "%s", result->errmsg));
	  return(-1);
	}

	/*
	 * A list-valued function may be followed by a list reference.
	 */
	if (token_is(e, 0, T_LBRACKET)) {
	  char *errmsg;
	  Dsvec *refs;
	  Value *v;

	  refs = dsvec_init(NULL, sizeof(Value));
	  if (is_list_ref_seq(e, refs) != 1) {
		seterr_e(e, result, "Invalid list reference follows function call");
		return(-1);
	  }

	  if (!e->do_eval)
		return(0);

	  if (result->value.token != T_LIST) {
		seterr_e(e, result,
				 ds_xprintf("Invalid function value list reference: \"%s\"",
							fname));
		return(-1);
	  }

#ifdef NOTDEF
	  new_list = listref2(e, &result->value, refs, &errmsg);
	  if (new_list == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid list reference follows function call: %s",
							errmsg));
		return(-1);
	  }

	  if (dsvec_len(new_list) == 1) {
		v = (Value *) dsvec_ptr_index(new_list, 0);
		copy_value(&result->value, v);
	  }
	  else {
		result->value.token = T_LIST;
		result->value.val.listval.list = new_list;
	  }
#else
	  v = alistref2(e, &result->value, refs, &errmsg);
	  if (v == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid list reference follows function call: %s",
							errmsg));
		return(-1);
	  }
	  result->value = *v;
#endif
	}

	return(0);
  }

  if (saw_lvalue) {
	char *val;
	Ds *ds;
	Expr_result *vres;

	/* Get the variable's value. */
	vres = NULL;
	if ((ds = acs_variable_resolve(var, e->env, &vres, &undef)) == NULL)
	  return(-1);
	val = ds_buf(ds);

	if (vres != NULL)
	  copy_result(result, vres);
	else {
	  result->value.token = T_STRING;
	  result->value.val.strval = val;
	  result->value.is_quoted = 0;
	}

	return(0);
  }

  if (token_matches(e, T_LPAREN)) {
	/* Evaluate the expression in parens. */
	if (heir(e, result) == -1)
	  return(-1);

	if (!token_matches(e, T_RPAREN))
	  return(-1);

	/*
	 * A list-valued expression in parens may be followed by a list
	 * reference.
	 */
	ct = token_current(e);
	if (ct == T_LBRACKET || ct == T_LBRACE) {
	  char *errmsg;
	  Value *v;

	  refs = dsvec_init(NULL, sizeof(Value));
	  if (is_list_ref_seq(e, refs) != 1) {
		seterr_e(e, result,
				 "Invalid list reference follows parenthesized expression");
		return(-1);
	  }

	  if (!e->do_eval)
		return(0);

	  if (result->value.token == T_STRING) {
		seterr_e(e, result, "Invalid list reference follows string");
		return(-1);
	  }

#ifdef NOTDEF
	  if (result->value.token == T_LIST) {
		Dsvec *new_list;

		new_list = listref2(e, &result->value, refs, &errmsg);
		if (new_list == NULL) {
		  seterr_e(e, result,
				   ds_xprintf("Invalid list reference follows constructor: %s",
							  errmsg));
		  return(-1);
		}

		if (dsvec_len(new_list) == 1) {
		  Value *v;

		  v = (Value *) dsvec_ptr_index(new_list, 0);
		  copy_value(&result->value, v);
		}
		else {
		  result->value.token = T_LIST;
		  result->value.val.listval.list = new_list;
		}
	  }
	  else if (result->value.token == T_ALIST) {
		Value *v;

		v = alistref2(e, &result->value, refs, &errmsg);
		if (v == NULL) {
		  seterr_e(e, result,
				   ds_xprintf("Invalid alist reference follows lvalue constructor: %s",
							  errmsg));
		  return(-1);
		}
		result->value = *v;
	  }
	  else {
		seterr_e(e, result,
				 ds_xprintf("Invalid list reference variable type: %s",
							var->varname));
		return(-1);
	  }
#else
	  if (result->value.token != T_LIST && result->value.token != T_ALIST) {
		seterr_e(e, result,
				 ds_xprintf("Invalid list reference variable type: %s",
							var->varname));
		return(-1);
	  }
	  v = alistref2(e, &result->value, refs, &errmsg);
	  if (v == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid %s reference follows constructor: %s",
							result->value.token == T_LIST ? "list" : "alist",
							errmsg));
		return(-1);
	  }
	  result->value = *v;
#endif
	}
	return(0);
  }

  if (is_operand(e, result)) {
	token_advance(e, 1);
	return(0);
  }

  seterr_e(e, result, ds_xprintf("Syntax error at: \"%s\"", e->expr));
  return(-1);
}

Arglist *
expr_init_arg(void)
{
  Arglist *a;

  a = ALLOC(Arglist);
  a->result = init_expr_result(NULL, T_UNDEF);
  a->next = NULL;

  return(a);
}

/*
 * Verify the syntax of a function call, evaluating arguments as we go.
 * Build the resulting argument values into a list and return the list.
 * Return -1 if a syntax or evaluation occurs, 0 otherwise.
 */
static int
funargs(Lex_state *e, Arglist **head)
{
  Arglist *a, *prev;

  if (!token_matches(e, T_LPAREN))
    return(-1);

  /* No arguments? */
  if (token_matches(e, T_RPAREN))
    return(0);

  /* There are one or more function arguments. */
  prev = NULL;
  while (1) {
	a = expr_init_arg();

	/*
	 * The comma operator is essentially disabled during argument list
	 * processing, so skip that production.
	 */
    if (heir2(e, a->result) == -1)
      return(-1);

    if (prev != NULL)
      prev->next = a;
    else
      *head = a;
    prev = a;

    if (!token_matches(e, T_COMMA))
      break;
  }

  if (!token_matches(e, T_RPAREN))
    return(-1);

  return(0);
}

static Kwv *
init_funcs(void)
{
  int i;
  long lint;
  Kwv *kwv;

  kwv = kwv_init(100);
  for (i = 0; functions[i].name != NULL; i++) {
	char *ptr;
	Func_info *fi;
	Kwv_pair pair;

	fi = ALLOC(Func_info);
	fi->name = functions[i].name;
	fi->argdesc = functions[i].argdesc;
	fi->func = functions[i].func;

	if (is_intval_str((char *) functions[i].arity, &lint, &ptr) != 1)
	  return(NULL);
	fi->min_args = fi->max_args = (int) lint;

	if (*ptr == '+') {
	  fi->max_args = -1;
	  ptr++;
	}
	else if (*ptr == '.' && *(ptr + 1) == '.') {
	  ptr += 2;
	  if (is_intval_str(ptr, &lint, &ptr) != 1)
		return(NULL);
	  fi->max_args = (int) lint;
	}

	if (*ptr != '\0')
	  return(NULL);

	kwv_set_pair(&pair, (char *) fi->name, NULL, fi);
	if (kwv_add_pair(kwv, &pair) == NULL)
	  return(NULL);
  }

  return(kwv);
}

static Kwv *kwv_func = NULL;

/*
 * Validiate the function call syntax of F.
 * Convert argument types as necessary.
 * Note: conversion is done in place - the original value is lost.
 * Return -1 on failure, otherwise the number of arguments to the function
 */
static int
validate_func_call(Lex_state *e, Func_info *fi, Arglist *args)
{
  int n, nargs;
  const char *d;
  char *errmsg;
  Arglist *x;
  Lex_token *t;

  n = 0;
  if (kwv_func == NULL) {
	if ((kwv_func = init_funcs()) == NULL)
	  return(-1);
  }

  nargs = 0;
  for (x = args; x != NULL; x = x->next)
	nargs++;

  /* Check if the correct number of arguments has been given. */
  if (nargs < fi->min_args) {
	errmsg = "too few arguments";
	goto bad_arg;
  }
  if (fi->max_args != -1 && nargs > fi->max_args) {
	errmsg = "too many arguments";
	goto bad_arg;
  }

  if (e->do_eval == 0) {
	/*
	 * We can't examine the argument types yet because they have not been
	 * computed.
	 */
	return(nargs);
  }

  /*
   * Argument descriptor characters:
   * '-': leave the argument as-is
   * 's': convert the argument to a T_STRING if necessary
   * 'S': the argument must already be a T_STRING
   * 'i': convert the argument to a T_INTEGER if necessary
   * 'I': the argument must already be a T_INTEGER
   * 'r': convert the argument to a T_REAL if necessary
   * 'R': the argument must already be a T_REAL
   * 'b': convert the argument to a T_BSTRING if necessary
   * 'B': the argument must already be a T_BSTRING
   * 'c': convert the argument to a T_STRING or T_BSTRING if necessary
   * 'C': the argument must already be a T_STRING or a T_BSTRING
   * 'L': the argument must already be a T_LIST
   * 'A': the argument must already be a T_ALIST
   * 'T': the argument must already be a T_LIST or T_ALIST
   * '*': means zero or more arguments may follow but quit validating
   * An empty descriptor means leave all arguments as-is.
   */
  errmsg = NULL;
  n = 1;
  for (d = fi->argdesc, x = args; *d != '\0' && x != NULL; d++, x = x->next) {
	switch ((int) *d) {
	case '-':
	  break;

	case '*':
	  return(nargs);

	case 's':
	  if (x->result->value.token == T_STRING)
		break;
	  else if (x->result->value.token == T_LITERAL) {
		x->result->value.token = T_STRING;
	  }
	  else if (x->result->value.token == T_INTEGER) {
		x->result->value.val.strval
		  = ds_xprintf("%ld", x->result->value.val.intval);
		x->result->value.token = T_STRING;
	  }
	  else if (x->result->value.token == T_REAL) {
		/* This is tricky to do properly because of printf() formatting. */
		x->result->value.val.strval
		  = ds_xprintf("%f", x->result->value.val.realval);
		x->result->value.token = T_STRING;
	  }
	  else {
		errmsg = "require a real number";
		goto bad_arg;
	  }
	  break;

	case 'S':
	  if (!str_or_lit(x->result->value.token)) {
		errmsg = "require a string or literal";
		goto bad_arg;
	  }
	  break;

	case 'B':
	  if (x->result->value.token != T_BSTRING) {
		errmsg = "require a binary string";
		goto bad_arg;
	  }
	  break;

	case 'C':
	  if (!str_or_lit(x->result->value.token)
		  && x->result->value.token != T_BSTRING) {
		errmsg = "require a string or literal, or binary string";
		goto bad_arg;
	  }
	  break;

	case 'c':
	  if (str_or_lit(x->result->value.token)
		  || x->result->value.token == T_BSTRING)
		break;
	  if (force_string(&x->result->value,
					   &x->result->value.val.strval) == -1) {
		errmsg = "require a string or literal, or binary string";
		goto bad_arg;
	  }
	  x->result->value.token = T_STRING;
	  break;

	case 'b':
	  if (force_bstring(x->result, &x->result->value.val.bval) == -1) {
		errmsg = "require a binary string";
		goto bad_arg;
	  }
	  x->result->value.token = T_BSTRING;
	  break;

	case 'i':
	  if (x->result->value.token == T_INTEGER)
		break;
	  else if (x->result->value.token == T_STRING) {
		if (is_number_str(x->result->value.val.strval, &t, NULL) != 1) {
		  errmsg = "require an integer number";
		  goto bad_arg;
		}
		if (t->token == T_REAL)
		  x->result->value.val.intval = (long) t->value->val.realval;
		else
		  x->result->value.val.intval = t->value->val.intval;
		x->result->value.token = T_INTEGER;
	  }
	  else if (x->result->value.token == T_REAL) {
		x->result->value.val.intval = (long) x->result->value.val.realval;
		x->result->value.token = T_INTEGER;
	  }
	  else {
		errmsg = "require an integer number";
		goto bad_arg;
	  }
	  break;

	case 'I':
	  if (x->result->value.token != T_INTEGER) {
		errmsg = "require an integer number";
		goto bad_arg;
	  }
	  break;

	case 'r':
	  if (x->result->value.token == T_REAL)
		break;
	  else if (x->result->value.token == T_INTEGER) {
		x->result->value.val.realval = (double) x->result->value.val.intval;
		x->result->value.token = T_REAL;
	  }
	  else if (x->result->value.token == T_STRING) {
		if (is_number_str(x->result->value.val.strval, &t, NULL) != 1) {
		  errmsg = "require a real number";
		  goto bad_arg;
		}
		if (t->token == T_REAL)
		  x->result->value.val.realval = t->value->val.realval;
		else
		  x->result->value.val.realval = (double) t->value->val.intval;
		x->result->value.token = T_REAL;
	  }
	  else {
		errmsg = "require a real number";
		goto bad_arg;
	  }
	  break;

	case 'R':
	  if (x->result->value.token != T_REAL) {
		errmsg = "require a real number";
		goto bad_arg;
	  }
	  break;

	case 'L':
	  if (x->result->value.token != T_LIST) {
		errmsg = "require a list";
		goto bad_arg;
	  }
	  break;

	case 'A':
	  if (x->result->value.token != T_ALIST) {
		errmsg = "require an alist";
		goto bad_arg;
	  }
	  break;

	case 'T':
	  if (x->result->value.token != T_LIST
		  && x->result->value.token != T_ALIST) {
		errmsg = "require a list or alist";
		goto bad_arg;
	  }
	  break;

	default:
	  errmsg = "internal error";
	  goto bad_arg;
	}
	n++;
  }

  return(nargs);

 bad_arg:
  if (errmsg != NULL) {
	if (n)
	  log_msg((LOG_ERROR_LEVEL, "Function \"%s\": Argument %d is invalid: %s",
			   fi->name, n, errmsg));
	else
	  log_msg((LOG_ERROR_LEVEL, "Function \"%s\": %s", fi->name, errmsg));
  }

  return(-1);
}

#ifdef NOTDEF
static Func *
lookup_function_name(char *name)
{
  Func *f;

  for (f = functions; f->name != NULL; f++) {
	if (streq(f->name, name))
	  return(f);
  }

  return(NULL);
}
#endif

/*
 * Usage: digest(msg, msg-len, [digest-name])
 */
static int
func_digest(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  unsigned int digest_len, msg_len;
  char *digest_name, *msg_str;
  unsigned char *digest;
  Arglist *x;

  x = arglist;
  if (x->result->value.token == T_STRING) {
	msg_str = x->result->value.val.strval;
	x = x->next;
	if ((msg_len = x->result->value.val.intval) == 0)
	  msg_len = strlen(msg_str);
  }
  else if (x->result->value.token == T_BSTRING) {
	msg_str = x->result->value.val.bval.data;
	x = x->next;
	if ((msg_len = x->result->value.val.intval) == 0)
	  msg_len = x->result->value.val.bval.len;
  }
  else {
	seterr_e(e, result, "digest function failed: invalid argument");
	return(-1);
  }
  x = x->next;

  if (x != NULL) {
	if (x->next != NULL) {
	  seterr_e(e, result, "digest function failed: too many arguments");
	  return(-1);
	}

	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "digest function failed: unrecognized digest name");
	  return(-1);
	}
	digest_name = strtoupper(x->result->value.val.strval);
  }
  else
	digest_name = "SHA1";

  digest = crypto_digest(digest_name, msg_str, msg_len, NULL, &digest_len);
  if (digest == NULL) {
	seterr_e(e, result, "digest function failed");
	return(-1);
  }

  result->value.token = T_BSTRING;
  result->value.val.bval.data = (void *) digest;
  result->value.val.bval.len = (size_t) digest_len;

  return(0);
}

/*
 * Usage: hmac(msg, msg-len, key, key-len, [digest-name])
 */
static int
func_hmac(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  unsigned int hmac_len, msg_len, key_len;
  char *digest_name, *key_str, *msg_str;
  unsigned char *hmac;
  Arglist *x;

  x = arglist;
  if (x->result->value.token == T_STRING) {
	msg_str = x->result->value.val.strval;
	x = x->next;
	if ((msg_len = x->result->value.val.intval) == 0)
	  msg_len = strlen(msg_str);
  }
  else if (x->result->value.token == T_BSTRING) {
	msg_str = x->result->value.val.bval.data;
	x = x->next;
	if ((msg_len = x->result->value.val.intval) == 0)
	  msg_len = x->result->value.val.bval.len;
  }
  else {
	seterr_e(e, result, "hmac function failed: invalid argument");
	return(-1);
  }
  x = x->next;

  if (x->result->value.token == T_STRING) {
	key_str = x->result->value.val.strval;
	x = x->next;
	if ((key_len = x->result->value.val.intval) == 0)
	  key_len = strlen(key_str);
  }
  else if (x->result->value.token == T_BSTRING) {
	key_str = x->result->value.val.bval.data;
	key_len = x->result->value.val.bval.len;
	x = x->next;
	if (x->result->value.val.intval != 0)
	  key_len = x->result->value.val.intval;
  }
  else
	return(-1);
  x = x->next;

  if (x != NULL) {
	if (x->next != NULL) {
	  seterr_e(e, result, "hmac function failed: too many arguments");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "hmac function failed: unrecognized digest name");
	  return(-1);
	}
	digest_name = strtoupper(x->result->value.val.strval);
  }
  else
	digest_name = "SHA1";

  if (hmac_lookup_digest_by_name(digest_name) == NULL) {
	seterr_e(e, result, "hmac function failed: unrecognized digest name");
	return(-1);
  }

  if (crypto_hmac(digest_name, (unsigned char *) key_str, key_len,
				  (unsigned char *) msg_str, msg_len,
				  &hmac, &hmac_len) == NULL) {
	seterr_e(e, result, "hmac function failed");
	return(-1);
  }

  result->value.token = T_BSTRING;
  result->value.val.bval.data = (void *) hmac;
  result->value.val.bval.len = (size_t) hmac_len;

  return(0);
}

/*
 * There are two usages:
 *   index(SRC_STRING, SEARCH_STRING [,nocase})
 *   index(SRC_LIST, SEARCH_OPERAND [,nocase})
 *
 * Note that indexes start at one, not zero.
 * A return value of zero means that the search was unsuccessful.
 * XXX should probably take an exact-type-match flag.
 */
static int
func_index(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int exact, icase;
  char *s1, *s2;
  Arglist *x1, *x2, *x3;

  exact = 0;
  icase = 0;

  x1 = arglist;
  x2 = x1->next;
  x3 = x2->next;
  if (x3 != NULL) {
	if (x3->result->value.token != T_LITERAL
		|| !strcaseeq(x3->result->value.val.strval, "nocase")) {
	  seterr_e(e, result, "Invalid argument to 'index' function");
	  return(-1);
	}
	icase = 1;
  }

  /*
   * Form 1: look for the first occurrence in SRC_STRING of any char in the
   * SEARCH_STRING.
   */
  if (str_or_lit(x1->result->value.token)) {
	if (!str_or_lit(x2->result->value.token)) {
	  seterr_e(e, result, "index function failed: invalid argument");
	  return(-1);
	}
	s1 = x1->result->value.val.strval;
	s2 = x2->result->value.val.strval;

	result->value.token = T_INTEGER;
	result->value.val.intval = indexset(s1, s2, icase);

	return(0);
  }

  /*
   * Form 2: look for the first occurrence in SRC_LIST of any equivalent value
   * (element) in the SEARCH_OPERAND.  The comparison can be between any
   * two types for which OP is valid.
   */
  if (x1->result->value.token == T_LIST) {
	int i, st;
	Dsvec *ll;
	Token op;
	Value *v;

	ll = x1->result->value.val.listval.list;

	if (icase)
	  op = T_EQ_I;
	else
	  op = T_EQ;

	/* Compare each element of the list to the specified item. */
	for (i = 0; i < dsvec_len(ll); i++) {
	  v = (Value *) dsvec_ptr_index(ll, i);
	  st = eval2_compare(e, result, op, v, &x2->result->value);
	  if (st == 0 && result->value.val.intval == 1) {
		result->value.token = T_INTEGER;
		result->value.val.intval = i + 1;
		return(0);
	  }
	  else if (st == -1) {
		/* Ignore the error. */
		seterr_reset(e, result);
	  }
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = 0;

	return(0);
  }

  seterr_e(e, result, "index function failed: invalid argument");
  return(-1);
}

static int
func_info(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *p, *s1, *s2;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;
  x = x->next;
  if (x != NULL)
	s2 = x->result->value.val.strval;
  else
	s2 = NULL;

  if (streq(s1, "namespaces") && x == NULL) {
	result->value.token = T_STRING;
	if ((p = var_ns_names(e->env->namespaces)) != NULL)
	  result->value.val.strval = p;
	else
	  result->value.val.strval = "";
  }
  else if (streq(s1, "namespace") && s2 != NULL) {
	result->value.token = T_STRING;
	if ((p = var_ns_buf(e->env->namespaces, s2)) != NULL)
	  result->value.val.strval = p;
	else
	  result->value.val.strval = "";
  }
  else {
	seterr_s(e, result, "Invalid function call argument to 'info'");
	return(-1);
  }

  return(0);
}

static int
func_keysof(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  Arglist *x;
  Kwv *kwv;
  Kwv_iter *iter;
  Kwv_pair *pair;

  x = arglist;
  kwv = x->result->value.val.alistval.kwv;
  iter = kwv_iter_begin(kwv, NULL);
  if (kwv_count(kwv, NULL) == 1) {
	if ((pair = kwv_iter_first(iter)) == NULL) {
	  seterr_s(e, result, "Internal kwv error");
	  return(-1);
	}
	result->value.token = T_STRING;
	result->value.val.strval = strdup(pair->name);
  }
  else {
	Value v, *vv;

	init_value(&v, T_LIST, sizeof(Value));
	for (pair = kwv_iter_first(iter); pair != NULL;
		 pair = kwv_iter_next(iter)) {
	  vv = init_value(NULL, T_STRING, strdup(pair->name));
	  dsvec_add_ptr(v.val.listval.list, vv);
	}
	result->value = v;
  }

  kwv_iter_end(iter);

  return(0);
}

static int
func_valuesof(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  Arglist *x;
  Kwv *kwv;
  Kwv_iter *iter;
  Kwv_pair *pair;

  x = arglist;
  kwv = x->result->value.val.alistval.kwv;
  iter = kwv_iter_begin(kwv, NULL);
  if (kwv_count(kwv, NULL) == 1) {
	Value *v;

	if ((pair = kwv_iter_first(iter)) == NULL) {
	  seterr_s(e, result, "Internal kwv error");
	  return(-1);
	}
	v = copy_value(NULL, pair->xval);
	result->value = *v;
  }
  else {
	Value v;

	init_value(&v, T_LIST, sizeof(Value));
	for (pair = kwv_iter_first(iter); pair != NULL;
		 pair = kwv_iter_next(iter)) {
	  dsvec_add_ptr(v.val.listval.list, copy_value(NULL, pair->xval));
	}
	result->value = v;
  }

  kwv_iter_end(iter);

  return(0);
}

/*
 * Usage: strchars(str, range-spec+)
 * Return a new string by selecting characters from STR according to a
 * sequence of one or more range specifications, each of which is a string
 * argument.  A range specification is an unordered set of one or more
 * comma-separated elements, each of which is a non-negative subscript or
 * a range that looks like: <non-negative-int> ".." <non-negative-int>.
 * The first <non-negative-int> in a pair may be elided, which means
 * "from the beginning" and the second <non-negative-int> may be missing
 * or "#", which means "to the end".
 * The result of each each successive range-spec is appended to the previous
 * result.
 */
static int
func_strchars(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *range, *s1;
  Arglist *x;
  Ds ds;
  Range_syntax rs;

  x = arglist;
  s1 = x->result->value.val.strval;

  rs.element_sep_char = ',';
  rs.span_sep_str = "..";
  rs.element_max_str = "#";
  rs.signed_values = 0;

  ds_init(&ds);
  while ((x = x->next) != NULL) {
	Ds dsv;

	range = x->result->value.val.strval;

	ds_init(&dsv);
	if (ds_range(&dsv, s1, range, &rs) == NULL) {
	  seterr_s(e, result, "Invalid range argument to strchars");
	  return(-1);
	}
	ds_concat(&ds, ds_buf(&dsv));
  }

  result->value.token = T_STRING;
  result->value.val.strval = ds_buf(&ds);

  return(0);
}

/*
 * Usage: strchop(str, del)
 * Return a new string by deleting from the end of STR a continuous run of any
 * characters in DEL.
 */
static int
func_strchop(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *del, *s;
  Arglist *x;

  x = arglist;
  s = x->result->value.val.strval;
  x = x->next;
  del = x->result->value.val.strval;


  result->value.token = T_STRING;
  result->value.val.strval = strchop(s, del);

  return(0);
}

static int
func_strtolower(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;

  result->value.token = T_STRING;
  result->value.val.strval = strtolower(s1);

  return(0);
}

static int
func_strtoupper(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;

  result->value.token = T_STRING;
  result->value.val.strval = strtoupper(s1);

  return(0);
}

static int
func_strftime(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *buf, *s1;
  size_t rc;
  struct tm *tm;
  time_t now;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;

  time(&now);
  tm = localtime(&now);
  buf = (char *) malloc(1024);	/* XXX */
  if ((rc = strftime(buf, 1024, s1, tm)) == 0) {
	seterr_s(e, result,
			 ds_xprintf("strftime conversion failed for '%s'", s1));
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = buf;
  log_msg((LOG_TRACE_LEVEL, "Strftime of '%s' is %s",
		   s1, result->value.val.strval));

  return(0);
}

/*
 * Usage: strtr(<input-string>, <string1>[, <string2>[,cds]])
 *
 * String transliteration, like the tr(1) command and perl's tr and y
 * operators.
 * The first argument is the input string to be transliterated
 * (stdin in the tr command).
 * The second argument is the search list ("string1" in the tr command).
 * The third argument is the (possibly empty) replacement list
 * ("string2" in the tr command); it may be omitted if no flag string
 * argument follows.
 * The fourth, optional argument is a literal flag string made of the
 * characters 'c', 'd', and 's' (in any order), which correspond to the
 * same flags in the tr command.
 * The result is the transliterated string.
 */
static int
func_strtr(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *input, *string1, *string2, *tr_str;
  int cflag, dflag, sflag;
  Arglist *x;

  cflag = dflag = sflag = 0;

  x = arglist;
  input = x->result->value.val.strval;
  x = x->next;
  string1 = x->result->value.val.strval;
  x = x->next;
  if (x == NULL)
	string2 = NULL;
  else {
	string2 = x->result->value.val.strval;
	if (string2[0] == '\0')
	  string2 = NULL;
	x = x->next;
	/* Character flag arguments? */
	if (x != NULL) {
	  char *p;

	  p = x->result->value.val.strval;
	  if (x->next != NULL) {
		seterr_e(e, result, "strtr failed: too many arguments");
		return(-1);
	  }
	  while (*p != '\0') {
		switch ((int) *p) {
		case 'c':
		  cflag++;
		  break;
		case 'd':
		  dflag++;
		  break;
		case 's':
		  sflag++;
		  break;
		default:
		  seterr_e(e, result,
				   ds_xprintf("strtr failed: invalid flag argument: '%c'",
							  *p));
		  return(-1);
		}
		p++;
	  }
	}
  }

  log_msg((LOG_TRACE_LEVEL, "Eval: strtr(\"%s\", \"%s\")", string1, string2));
  if (strtr(input, string1, string2, cflag, dflag, sflag, &tr_str) == -1) {
	seterr_e(e, result, ds_xprintf("strtr failed: %s", tr_str));
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = tr_str;

  return(0);
}

static int
func_strstr(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int icase;
  char *p, *string, *substring;
  Arglist *x;

  icase = 0;

  x = arglist;
  string = x->result->value.val.strval;
  x = x->next;
  substring = x->result->value.val.strval;
  if (*substring == '\0') {
	result->value.token = T_STRING;
	result->value.val.strval = string;
	return(0);
  }

  x = x->next;
  if (x != NULL) {
	if (x->result->value.token != T_LITERAL
		|| !strcaseeq(x->result->value.val.strval, "nocase")) {
	  seterr_e(e, result, "Invalid argument to 'strstr' function");
	  return(-1);
	}
	icase = 1;
  }

  result->value.token = T_STRING;
  if (icase)
	p = strcasestr(string, substring);
  else
	p = strstr(string, substring);

  if (p == NULL)
	result->value.val.strval = "";
  else
	result->value.val.strval = p;

  return(0);
}

static int
func_strrstr(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int icase;
  char *p, *string, *substring;
  Arglist *x;

  icase = 0;

  x = arglist;
  string = x->result->value.val.strval;
  x = x->next;
  substring = x->result->value.val.strval;
  if (*substring == '\0') {
	result->value.token = T_STRING;
	result->value.val.strval = string;
	return(0);
  }

  x = x->next;
  if (x != NULL) {
	if (x->result->value.token != T_LITERAL
		|| !strcaseeq(x->result->value.val.strval, "nocase")) {
	  seterr_e(e, result, "Invalid argument to 'strrstr' function");
	  return(-1);
	}
	icase = 1;
  }

  result->value.token = T_STRING;
  if (icase)
	p = strrcasestr(string, substring);
  else
	p = strrstr(string, substring);

  if (p == NULL)
	result->value.val.strval = "";
  else
	result->value.val.strval = p;

  return(0);
}

/*
 * Return the length of the argument, which can be any sensible data type.
 */
static int
func_length(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  long len;
  char *s1;
  Arglist *x;

  x = arglist;
  if (x->result->value.token == T_STRING) {
	s1 = x->result->value.val.strval;
	len = strlen(s1);
  }
  else if (x->result->value.token == T_BSTRING)
	len = x->result->value.val.bval.len;
  else if (x->result->value.token == T_LIST)
	len = dsvec_len(x->result->value.val.listval.list);
  else if (x->result->value.token == T_ALIST)
	len = kwv_count(x->result->value.val.alistval.kwv, NULL);
  else
	return(-1);

  result->value.token = T_INTEGER;
  result->value.val.intval = len;

  return(0);
}

static int
func_list(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  Arglist *x;
  Value v;

  init_value(&v, T_LIST, sizeof(Value));

  x = arglist;
  while (x != NULL) {
	dsvec_add_ptr(v.val.listval.list, &x->result->value);
	x = x->next;
  }

  result->value.token = T_LIST;
  result->value = v;

  return(0);
}

static int
func_alist(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *key;
  Arglist *x;
  Value v;

  init_value(&v, T_ALIST, sizeof(Value));

  x = arglist;
  key = NULL;
  while (x != NULL) {
	if (key == NULL) {
	  if (force_string(&x->result->value, &key) == -1) {
		seterr_e(e, result, "Invalid key");
		return(-1);
	  }
	}
	else {
	  Kwv_pair pair;

	  kwv_set_pair(&pair, key, NULL, &x->result->value);
	  if (kwv_add_pair_nocopy(v.val.alistval.kwv, &pair) == NULL) {
		seterr_e(e, result, ds_xprintf("Error adding key \"%s\"", key));
		return(-1);
	  }
	  key = NULL;
	}

	x = x->next;
  }

  result->value.token = T_ALIST;
  result->value = v;

  return(0);
}

/*
 * Convert a regular list reference into an alist reference.
 * listref($a, alistref(["foo"])) is equivalent to $a{"foo"}
 */
static int
func_alistref(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  Arglist *x;
  Value *ll;

  x = arglist;
  ll = &x->result->value;
  copy_value(&result->value, ll);
  result->value.is_alist_reference = 1;

  return(0);
}

/*
 * listref(<list>, <list-ref-el> [, ...])
 * Where <list-ref-el> is a non-negative integer or a list.
 * If $list is [1,2,3,4,[5,6,7]]
 *  listref($list, 0) is 1
 *  listref($list, 4) is [5,6,7]
 *  listref($list, 4, 1) is 6
 *  listref($list, [0,2]) is [1,3]
 *  listref($list, [0..2,0]) is [1,2,3,1]
 */
static int
func_listref(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *errmsg;
  Arglist *x;
  Dsvec *refs;
  Value *list, *lv, *v, *value;

  x = arglist;
  list = &x->result->value;

  if ((x = x->next) == NULL) {
	seterr_e(e, result, "Missing argument to 'listref' function");
	return(-1);
  }

  refs = dsvec_init(NULL, sizeof(Value));
  while (x != NULL) {
	v = &x->result->value;
	if (v->token == T_LIST)
	  dsvec_add_ptr(refs, v);
	else if (v->token == T_ALIST) {
	  lv = init_value(NULL, T_LIST, sizeof(Value));
	  if (force_list(v, &lv->val.listval) == -1) {
		seterr_e(e, result, "Invalid argument to 'listref' function");
		return(-1);
	  }
	  dsvec_add_ptr(refs, lv);
	}
	else {
	  lv = init_value(NULL, T_LIST, sizeof(Value));
	  dsvec_add_ptr(lv->val.listval.list, v);
	  dsvec_add_ptr(refs, lv);
	}

	x = x->next;
  }

  if ((value = alistref2(e, list, refs, &errmsg)) == NULL) {
	seterr_e(e, result, errmsg);
	return(-1);
  }

  result->value = *value;

  return(0);
}

typedef struct AttrTypeAndValue {
  char *type;
  char *value;
} AttrTypeAndValue;

/*
 * RFC 2253
 * Parse an AttrTypeAndValue element into its components.
 */
AttrTypeAndValue *
ldap_atav_parse(char *atav_str)
{
  char *p, *s;
  AttrTypeAndValue *atav;

  atav = ALLOC(AttrTypeAndValue);
  atav->type = NULL;
  atav->value = NULL;

  s = p = atav_str;
  while (*p != '\0') {
	if (*p == '=') {
	  *p++ = '\0';
	  atav->type = s;
	  atav->value = p;
	  return(atav);
	}
	p++;
  }

  /* No '=' found, invalid string */
  return(NULL);
}

/*
 * RFC 2253
 * Parse a RelativeDistinguishedName into a SEQUENCE of AttributeTypeAndValue
 * elements.
 */
Dsvec *
ldap_rdn_parse(char *rdn_str)
{
  char *p, *s;
  AttrTypeAndValue *atav;
  Dsvec *dsv;

  dsv = dsvec_init(NULL, sizeof(AttrTypeAndValue *));
  s = p = strdup(rdn_str);
  while (*p != '\0') {
	if (*p == '\\') {
	  p++;
	  if (*p == '\0') {
		/* String ends with a backslash? */
		return(NULL);
	  }
	}
	else if (*p == '+') {
	  /* End of an AttributeTypeAndValue */
	  *p++ = '\0';
	  if ((atav = ldap_atav_parse(s)) == NULL)
		return(NULL);
	  dsvec_add_ptr(dsv, atav);
	  s = p;
	}

	p++;
  }

  if (s != p) {
	if ((atav = ldap_atav_parse(s)) == NULL)
	  return(NULL);
	dsvec_add_ptr(dsv, atav);
  }

  dsvec_add_ptr(dsv, NULL);
  return(dsv);
}

/*
 * RFC 2253
 * Break the string representation of a Distinguished Name into a vector
 * (a SEQUENCE) of RelativeDistinguishedName elements, terminated by a
 * NULL element.
 * Return NULL if DN_STR is invalid, otherwise a pointer to the vector.
 */
Dsvec *
ldap_dn_parse(char *dn_str)
{
  char *p, *s;
  Dsvec *dsv;

  dsv = dsvec_init(NULL, sizeof(char *));
  s = p = strdup(dn_str);
  while (*p != '\0') {
	if (*p == '\\') {
	  p++;
	  if (*p == '\0') {
		/* String ends with a backslash? */
		return(NULL);
	  }
	}
	else if (*p == ',') {
	  /* End of an RDN */
	  *p++ = '\0';
	  if (ldap_rdn_parse(s) == NULL)	/* Check syntax */
		return(NULL);
	  dsvec_add_ptr(dsv, s);
	  s = p;
	}

	p++;
  }

  if (s != p) {
	if (ldap_rdn_parse(s) == NULL)		/* Check syntax */
	  return(NULL);
	dsvec_add_ptr(dsv, s);
  }

  dsvec_add_ptr(dsv, NULL);
  return(dsv);
}

/*
 * LDAP name manipulation functions based on RFC 2253, LDAP UTF-8 String
 * Representation of Distinguished Names
 *
 * DistinguishedName ::= RDNSequence
 *  RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
 *   RelativeDistinguishedName ::= SET SIZE (1..MAX) OF AttributeTypeAndValue
 *     AttributeTypeAndValue ::= SEQUENCE {
 *       type  AttributeType,
 *       value AttributeValue }
 * o adjoining RelativeDistinguishedNames are separated by a comma character
 * o where there is a multi-valued RDN, the outputs from adjoining
 *   AttributeTypeAndValues are separated by a plus character
 * o the AttributeTypeAndValue is encoded as the string representation of
 *   the AttributeType, followed by an equals character followed by the
 *   string representation of the AttributeValue
 * o if the AttributeType is in a published table of attribute types
 *   associated with LDAP, then the type name string from that table
 *   is used, otherwise it is encoded as the dotted-decimal encoding of
 *   the AttributeType's OBJECT IDENTIFIER
 * o if the AttributeValue is of a type which does not have a string
 *   representation defined for it, then it is simply encoded as an
 *   octothorpe character followed by the hexadecimal representation of each
 *   of the bytes of the BER encoding
 * o if the UTF-8 string does not have any of the following characters
 *   which need escaping, then that string can be used as the string
 *   representation of the value
 *    - a space or "#" character occurring at the beginning of the string
 *    - a space character occurring at the end of the string
 *    - one of the characters ",", "+", """, "\", "<", ">" or ";"
 *   Implementations MAY escape other characters.
 *   If a character to be escaped is one of the list shown above, then it
 *   is prefixed by a backslash
 *   Otherwise the character to be escaped is replaced by a backslash and
 *   two hex digits, which form a single byte in the code of the character
 */
static int
func_ldap(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *func, *s1;
  Arglist *x;
  Dsvec *dsv;

  x = arglist;
  if (!str_or_lit(x->result->value.token)) {
	seterr_e(e, result, "Invalid argument to 'ldap' function");
	return(-1);
  }

  func = x->result->value.val.strval;
  x = x->next;
  s1 = x->result->value.val.strval;
  x = x->next;

  if (strcaseeq(func, "dn_index")) {
	long ind;

	if (x == NULL) {
	  seterr_e(e, result, "Missing index number argument to 'ldap' function");
	  return(-1);
	}
	if (integer_value(e, &x->result->value, &ind) == -1) {
	  seterr_e(e, result, "Invalid index number argument to 'ldap' function");
	  return(-1);
	}
	x = x->next;
	if (x != NULL) {
	  seterr_e(e, result, "Extra argument to 'ldap' function");
	  return(-1);
	}
	if ((dsv = ldap_dn_parse(s1)) == NULL) {
	  seterr_e(e, result, "Invalid DN argument to 'ldap' function");
	  return(-1);
	}
	if (ind < 1) {
	  seterr_e(e, result, "Invalid index number argument to 'ldap' function");
	  return(-1);
	}
	if (ind > ((int) dsvec_len(dsv) - 1))
	  ind = dsvec_len(dsv) - 1;

	result->value.token = T_STRING;
	result->value.val.strval = dsvec_ptr(dsv, ind - 1, char *);
  }
  else if (strcaseeq(func, "dn_length")) {
	if (x != NULL) {
	  seterr_e(e, result, "Extra argument to 'ldap' function");
	  return(-1);
	}
	dsv = ldap_dn_parse(s1);
	result->value.token = T_INTEGER;
	if (dsv == NULL)
	  result->value.val.intval = -1;
	else
	  result->value.val.intval = dsvec_len(dsv) - 1;
  }
  else if (strcaseeq(func, "rdn_index")) {
	long ind;

	if (x == NULL) {
	  seterr_e(e, result, "Missing index number argument to 'ldap' function");
	  return(-1);
	}
	if (integer_value(e, &x->result->value, &ind) == -1) {
	  seterr_e(e, result, "Invalid index number argument to 'ldap' function");
	  return(-1);
	}
	x = x->next;
	if (x != NULL) {
	  seterr_e(e, result, "Extra argument to 'ldap' function");
	  return(-1);
	}
	if ((dsv = ldap_rdn_parse(s1)) == NULL) {
	  seterr_e(e, result, "Invalid RDN argument to 'ldap' function");
	  return(-1);
	}
	if (ind < 1) {
	  seterr_e(e, result, "Invalid index number argument to 'ldap' function");
	  return(-1);
	}
	if (ind > ((int) dsvec_len(dsv) - 1))
	  ind = dsvec_len(dsv) - 1;

	result->value.token = T_STRING;
	result->value.val.strval = dsvec_ptr(dsv, ind - 1, char *);
  }
  else if (strcaseeq(func, "rdn_attrtype")
		   || strcaseeq(func, "rdn_attrvalue")) {
	long ind;
	AttrTypeAndValue *atav;

	if (x != NULL) {
	  if (integer_value(e, &x->result->value, &ind) == -1) {
		seterr_e(e, result,
				 "Invalid index number argument to 'ldap' function");
		return(-1);
	  }
	  x = x->next;
	  if (x != NULL) {
		seterr_e(e, result, "Extra argument to 'ldap' function");
		return(-1);
	  }
	}
	else
	  ind = 1;

	if ((dsv = ldap_rdn_parse(s1)) == NULL) {
	  seterr_e(e, result, "Invalid RDN argument to 'ldap' function");
	  return(-1);
	}
	if (ind < 1) {
	  seterr_e(e, result, "Invalid index number argument to 'ldap' function");
	  return(-1);
	}
	if (ind > ((int) dsvec_len(dsv) - 1))
	  ind = dsvec_len(dsv) - 1;
	atav = dsvec_ptr(dsv, ind - 1, AttrTypeAndValue *);
	result->value.token = T_STRING;
	if (strcaseeq(func, "rdn_attrtype"))
	  result->value.val.strval = strdup(atav->type);
	else
	  result->value.val.strval = strdup(atav->value);
  }
  else if (strcaseeq(func, "rdn_length")) {
	if (x != NULL) {
	  seterr_e(e, result, "Extra argument to 'ldap' function");
	  return(-1);
	}
	dsv = ldap_rdn_parse(s1);
	result->value.token = T_INTEGER;
	if (dsv == NULL)
	  result->value.val.intval = -1;
	else
	  result->value.val.intval = dsvec_len(dsv) - 1;
  }
  else {
	seterr_e(e, result, "Unrecognized mode argument to 'ldap' function");
	return(-1);
  }

  return(0);
}

/*
 * Add an entry to the post-authentication success list or the
 * post-authorization success list, or display the contents of either list.
 * Usage:
 *     on_success(acs|auth);
 *     on_success(acs|auth, expr);
 * Returns the number of items in the specified list.
 */
static int
func_on_success(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int i, is_acs, n, st;
  char **current_list, *s1, *s2;
  Arglist *x;

  x = arglist;

  if (x == NULL) {
	seterr_e(e, result, "Missing argument to 'on_success' function");
	return(-1);
  }

  s1 = x->result->value.val.strval;
  if (strcaseeq(s1, "acs"))
	is_acs = 1;
  else if (strcaseeq(s1, "auth"))
	is_acs = 0;
  else {
	seterr_e(e, result, "Invalid first argument to 'on_success' function");
	return(-1);
  }
  x = x->next;

  if (x != NULL) {
	s2 = x->result->value.val.strval;
	st = is_acs ? acs_add_success_expr(s2) : auth_add_success_expr(s2);
	if (st == -1) {
	  seterr_e(e, result, "Error adding entry in 'on_success' function");
	  return(-1);
	}
  }

  n = is_acs ? acs_get_success_exprs(&current_list)
	: auth_get_success_exprs(&current_list);

  if (x == NULL) {
	Ds *ds;

	ds = ds_init(NULL);
	for (i = 0; i < n; i++)
	  ds_asprintf(ds, "%s%s", current_list[i],
				  ((i + 1) < n) ? "\n" : "");
	result->value.token = T_STRING;
	result->value.val.strval = non_null(ds_buf(ds));
  }
  else {
	result->value.token = T_INTEGER;
	result->value.val.intval = n;
  }
  
  return(0);
}

/*
 * Usage: regsub(<source>, <regex>, <replacement>[,nocase][,repeat])
 *
 * Match REGEX against SOURCE and return the string that results when
 * substitutions are applied to DEST.
 * This is similar to the ed/ex/vi command s/REGEX/REPLACEMENT/, where
 * the current line is SOURCE.
 * Examples:
 *   regsub("hello world", "world", "auggie") -> "hello auggie"
 *   regsub("hello", ".*", "& &")             -> "hello hello"
 *   regsub("one two three", "(.*) (.*) (.*)", "\${3} \${2} \${1}")
 */
static int
func_regsub(Lex_state *e, int nargs,Arglist *arglist, Expr_result *result)
{
  int cflags, repeat;
  char *errmsg, *p, *src_string, *repl_string, *regex_string;
  Arglist *x;

  x = arglist;
  src_string = x->result->value.val.strval;
  x = x->next;
  regex_string = x->result->value.val.strval;
  x = x->next;
  repl_string = x->result->value.val.strval;
  x = x->next;

  cflags = REG_EXTENDED;
  repeat = 0;

  while (x != NULL) {
	if (x->result->value.token == T_LITERAL
		&& strcaseeq(x->result->value.val.strval, "nocase"))
	  cflags |= REG_ICASE;
	else if (x->result->value.token == T_LITERAL
			 && strcaseeq(x->result->value.val.strval, "repeat"))
	  repeat = 1;
	else {
	  seterr_e(e, result, "Invalid argument to 'regsub' function");
	  return(-1);
	}
	x = x->next;
  }

  if ((p = strregexsub(src_string, regex_string, repl_string, cflags,
					   repeat, &errmsg)) == NULL) {
	log_msg((LOG_ERROR_LEVEL, "strregexsub: %s", errmsg));
	seterr_s(e, result,
			 ds_xprintf("Error occurred in 'regsub', src='%s', regex='%s'",
						src_string, regex_string));
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = p;

  return(0);
}

/*
 * Usage: regmatch(<string>, <regex>[,namespace][,nocase])
 *
 * The regular expression REGEX is matched with STRING,
 * with a '^' (the start-of-string anchor) implicitly prepended.
 * REGEX may contain subexpressions enclosed between '(' and ')'
 * (or '\(' and '\)').
 * If the optional 'nocase' literal argument is given, then matching is done
 * case-insensitively. Only one parenthesized pair can be used.
 * IEEE Std 1003.2 ("POSIX.2") "extended" regular expressions are used.
 *
 * If the match fails, the result is 0. If the match succeeds there are
 * several possibilities:
 *
 * - if there are no subexpressions in REGEX, the result is an integer that
 * is the number of characters matched.
 *
 * - if there is at least one subexpression in REGEX but no namespace (a
 * string argument) is given, the result is the substring of STRING that was
 * matched by the entire regular expression.
 *
 * - if there is at least one subexpression in REGEX and a namespace argument
 * is given, the value of the first matching subexpression is assigned to the
 * variable "1" of the namespace, the value of the second subexpression is
 * assigned to the variable "2" of the namespace, and so on up to the ninth
 * subexpression. Variable "0" of the namespace is assigned the substring of
 * STRING that was matched by the entire regular expression.
 */
static int
func_regmatch(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int icase, st;
  char *errmsg, *regex_str, *str, *ns;
  regex_t *preg;
  Arglist *x;
  Dsvec *matches;

  x = arglist;
  str = x->result->value.val.strval;
  x = x->next;
  regex_str = ds_xprintf("^%s", x->result->value.val.strval);
  x = x->next;
  if (x != NULL && x->result->value.token == T_STRING) {
	ns = x->result->value.val.strval;
	if (acs_is_readonly_namespace(ns)) {
	  seterr_s(e, result,
			   ds_xprintf("Can't assign to reserved namespace '%s'", ns));
	  return(-1);
	}
	x = x->next;
  }
  else
	ns = NULL;

  if (x != NULL) {
	if (x->result->value.token != T_LITERAL
		|| !strcaseeq(x->result->value.val.strval, "nocase")
		|| x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'regmatch' function");
	  return(-1);
	}
	icase = REG_ICASE;
  }
  else
	icase = 0;

  matches = dsvec_init(NULL, sizeof(char *));
  preg = NULL;
  st = strregex(str, regex_str, &preg, REG_EXTENDED | icase, matches, &errmsg);
  if (st == -1) {
	seterr_e(e, result, errmsg);
	return(-1);
  }
  else if (st == 0) {
	/* No match */
	result->value.token = T_INTEGER;
	result->value.val.intval = 0;
  }
  else {
	str = (char *) dsvec_ptr_index(matches, 0);

	if (preg->re_nsub == 0) {
	  /* The regex_str didn't have any substring matches. */
	  result->value.token = T_INTEGER;
	  result->value.val.intval = strlen(str);
	}
	else if (ns == NULL) {
	  result->value.token = T_STRING;
	  result->value.val.strval = str;
	}
	else {
	  unsigned int ui;
	  Kwv *kwv;
	  Var_ns *vs;

	  vs = var_ns_new(&e->env->namespaces, ns, NULL);
	  vs->flags = VAR_NS_TEMPORARY;

	  if ((kwv = vs->kwv) == NULL)
		kwv = vs->kwv = kwv_init(dsvec_len(matches));

	  result->value.token = T_INTEGER;
	  result->value.val.intval = strlen(str);

	  for (ui = 0; ui < dsvec_len(matches); ui++) {
		str = (char *) dsvec_ptr_index(matches, ui);
		kwv_replace(kwv, ds_xprintf("%d", ui), str);
	  }
	}
  }

  return(0);
}

/*
 * Usage:
 *   substr(STRING, START_POSITION, LENGTH)
 */
static int
func_substr(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  unsigned int start_pos, slen;
  char *s1;
  long i1, i2, len;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;
  x = x->next;
  i1 = x->result->value.val.intval;
  x = x->next;
  i2 = x->result->value.val.intval;

  if (i1 == 0) {
	seterr_e(e, result, "Second arg to 'substr' cannot be zero");
	return(-1);
  }
  if (i2 == 0) {
	seterr_e(e, result, "Third arg to 'substr' cannot be zero");
	return(-1);
  }

  len = strlen(s1);
  if (i1 > 0)
	start_pos = i1;
  else {
	if (-i1 > len)
	  start_pos = len + 1;		/* To trigger the special case below... */
	else
	  start_pos = len + i1 + 1;
  }

  if (i2 > 0)
	slen = i2;
  else
	slen = len;

  result->value.token = T_STRING;
  if (start_pos > len)
	result->value.val.strval = "";
  else {
	char *start;
	Ds ds;

	start = s1 + (int) start_pos - 1;
	ds_init(&ds);
	ds_concatn(&ds, start, slen);
	result->value.val.strval = ds_buf(&ds);
  }

  return(0);
}

/*
 * Evaluate the argument to the user() predicate and user_revoke() function,
 * called a UE (user() expression).
 */

typedef struct User_expr {
  char *expr;
  Lex_state *e;
  Dsvec *dsv;
  int current;
  Credentials *credentials;
  char *errmsg;
} User_expr;

typedef struct User_token {
  Token token;
  char *value;
} User_token;

static int ue_filter1(User_expr *expr, int *result);
static int ue_filter2(User_expr *expr, int *result);
static int ue_filter3(User_expr *expr, int *result);
static int ue_filter4(User_expr *expr, int *result);

/* For debugging */
static MAYBE_UNUSED void
ue_dump(User_expr *expr)
{
  int i;
  User_token *ut;

  for (i = 0; i < dsvec_len(expr->dsv); i++) {
	ut = dsvec_ptr(expr->dsv, i, User_token *);

	switch (ut->token) {
	case T_OR:
	  fprintf(stderr, "or\n");
	  break;
	case T_AND:
	  fprintf(stderr, "and\n");
	  break;
	case T_LPAREN:
	  fprintf(stderr, "(\n");
	  break;
	case T_RPAREN:
	  fprintf(stderr, ")\n");
	  break;
	case T_NOT:
	  fprintf(stderr, "!\n");
	  break;
	case T_EOI:
	  fprintf(stderr, "EOI\n");
	  break;
	case T_STRING:
	  fprintf(stderr, "%s\n", ut->value);
	  break;
	default:
	  fprintf(stderr, "???\n");
	  break;
	}
  }
}

/*
 * Look for the next UE token, skipping initial whitespace.
 * Set PTR to the character following the token.
 *
 * Tokens are:
 * o ||, or
 * o &&, and
 * o (, )
 * o !, not
 * o anything else is a "string token"
 */
static User_token *
ue_lex(char *str, char **ptr)
{
  size_t len;
  char *p, *s;
  User_token *ut;

  p = str;
  while (*p == ' ' || *p == '\t')
	p++;
  s = p;

  ut = ALLOC(User_token);
  if (*s == '\0') {
	ut->token = T_EOI;
	ut->value = NULL;
	len = 0;
  }
  else if (strneq(s, "or", 2) && !isalpha((int) *(s + 2))) {
	ut->token = T_OR;
	ut->value = NULL;
	len = 2;
  }
  else if (*s == '|' && *(s + 1) == '|') {
	ut->token = T_OR;
	ut->value = NULL;
	len = 2;
  }
  else if (strneq(s, "and", 3) && !isalpha((int) *(s + 3))) {
	ut->token = T_AND;
	ut->value = NULL;
	len = 3;
  }
  else if (*s == '&' && *(s + 1) == '&') {
	ut->token = T_AND;
	ut->value = NULL;
	len = 2;
  }
  else if (*s == '(') {
	ut->token = T_LPAREN;
	ut->value = NULL;
	len = 1;
  }
  else if (*s == '!') {
	ut->token = T_NOT;
	ut->value = NULL;
	len = 1;
  }
  else if (strneq(s, "not", 3) && !isalpha((int) *(s + 3))) {
	ut->token = T_NOT;
	ut->value = NULL;
	len = 3;
  }
  else if (*s == ')') {
	ut->token = T_RPAREN;
	ut->value = NULL;
	len = 1;
  }
  else {
	static char *break_char = " \t|&(!)";

	while (*p != '\0' && strchr(break_char, (int) *p) == NULL)
	  p++;
	ut->token = T_STRING;
	len = p - s;
	ut->value = strndup(s, len);
  }

  *ptr = s + len;

  return(ut);
}

/*
 * UE lexical scanner
 */
static Dsvec *
ue_lex_scan(char *expr)
{
  char *nextp;
  Dsvec *dsv;
  User_token *ut;  

  dsv = dsvec_init(NULL, sizeof(User_token));

  do {
	ut = ue_lex(expr, &nextp);
	dsvec_add_ptr(dsv, (void *) ut);
	expr = nextp;
  } while (ut->token != T_EOI);

  return(dsv);
}

static User_token *
ue_tcurrent(User_expr *expr)
{
  User_token *ut;

  ut = dsvec_ptr(expr->dsv, expr->current, User_token *);

  return(ut);
}

static User_token *
ue_tnext(User_expr *expr)
{
  User_token *ut;

  ut = dsvec_ptr(expr->dsv, expr->current + 1, User_token *);

  return(ut);
}

static int
ue_tmatches(User_expr *expr, Token token)
{
  User_token *ut;

  ut = dsvec_ptr(expr->dsv, expr->current, User_token *);

  if (ut->token == token) {
	expr->current++;
	return(1);
  }

  return(0);
}

static MAYBE_UNUSED Token
ue_tpeek(User_expr *expr)
{
  User_token *ut;

  ut = dsvec_ptr(expr->dsv, expr->current, User_token *);

  if (ut == NULL)
	return(T_UNDEF);

  return(ut->token);
}

/*
 * Evaluate a UE primary term
 * Return 0 and set RESULT if the evaluation is performed, or -1 if there's
 * an error.
 */
static int
ue_eval(User_expr *expr, int *result)
{
  int st;
  char *arg, *op, *p;
  Credentials *cr;
  User_token *ut;

  if ((ut = ue_tcurrent(expr)) == NULL)
	return(-1);

  if (ut->token != T_STRING)
	return(-1);

  op = ut->value;
  cr = expr->credentials;

  if ((p = strcaseprefix(op, "version")) != NULL) {
	expr->current++;
	ut = ue_tcurrent(expr);
	arg = ut->value;
	log_msg((LOG_TRACE_LEVEL, "Check for version \"%s\"", arg));
	st = (cr != NULL && streq(arg, cr->version));
  }
  else if ((p = strcaseprefix(op, "namespace")) != NULL) {
	Kwv *kwv;
	Kwv_iter *iter;
	Kwv_pair *pair;

	expr->current++;
	ut = ue_tcurrent(expr);
	arg = ut->value;
	log_msg((LOG_TRACE_LEVEL, "Check namespace \"%s\"", arg));
	st = 0;
	if ((kwv = var_ns_lookup_kwv(expr->e->env->namespaces, arg)) != NULL) {
	  iter = kwv_iter_begin(kwv, NULL);
	  for (pair = kwv_iter_first(iter); pair != NULL;
		   pair = kwv_iter_next(iter)) {
		int r;
		User_expr *ue;

		ue = ALLOC(User_expr);
		ue->e = expr->e;
		ue->expr = pair->val;
		ue->dsv = ue_lex_scan(pair->val);
		ue->current = 0;
		ue->credentials = expr->credentials;
		ue->errmsg = NULL;
		r = 0;
		if ((st = ue_eval(ue, &r)) == -1) {
		  kwv_iter_end(iter);
		  return(-1);
		}

		if (st == 0 && r == 1) {
		  st = 1;
		  break;
		}
	  }
	  kwv_iter_end(iter);
	}
  }
  else if ((p = strcaseprefix(op, "style")) != NULL) {
	Auth_style auth_style;

	expr->current++;
	ut = ue_tcurrent(expr);
	arg = ut->value;
	log_msg((LOG_TRACE_LEVEL, "Check for style \"%s\"", arg));

	if ((auth_style = auth_style_from_string(arg)) == AUTH_STYLE_UNKNOWN) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Invalid authentication style argument: \"%s\"", arg));
	  return(-1);
	}

	if (cr == NULL) {
	  log_msg((LOG_TRACE_LEVEL,
			   "No credentials, auth style comparison fails"));
	  st = 0;
	}
	else {
	  /* Test if the credentials contains each of specified style types. */
	  st = ((cr->auth_style & auth_style) == auth_style);
	}
  }
  else if ((p = strcaseprefix(op, "imported_by")) != NULL) {
	expr->current++;
	ut = ue_tcurrent(expr);
	arg = ut->value;
	log_msg((LOG_TRACE_LEVEL, "Check for importedby \"%s\"", arg));
	st = (cr->imported_by != NULL && streq(cr->imported_by, arg));
  }
  else {
	User_token *ut_next;
	DACS_name_cmp m;

	if ((ut_next = ue_tnext(expr)) != NULL && ut_next->token == T_STRING
		&& (m = lookup_name_cmp(ut_next->value)) != DACS_NAME_CMP_UNKNOWN)
	  expr->current++;
	else
	  m = get_name_cmp_mode();

	if ((st = is_matching_user_identity(op, cr, m, &expr->errmsg)) == -1)
	  return(-1);
  }

  expr->current++;
  *result = st;

  return(0);
}

/*
 * Lowest priority UE syntactic element
 */
static int
ue_filter1(User_expr *expr, int *result)
{
  int res1, res2;

  res1 = 0;
  if (ue_filter2(expr, &res1) == -1)
	return(-1);

  while (1) {
	if (ue_tmatches(expr, T_OR)) {
	  res2 = 0;
	  if (ue_filter2(expr, &res2) == -1)
		return(-1);

	  res1 = res1 || res2;
	}
	else
	  break;
  }

  *result = res1;

  return(0);
}

static int
ue_filter2(User_expr *expr, int *result)
{
  int res1, res2;

  res1 = 0;
  if (ue_filter3(expr, &res1) == -1)
	return(-1);

  while (1) {
	if (ue_tmatches(expr, T_AND)) {
	  res2 = 0;
	  if (ue_filter2(expr, &res2) == -1)
		return(-1);
	  res1 = res1 && res2;
	}
	else
	  break;
  }

  *result = res1;

  return(0);
}

static int
ue_filter3(User_expr *expr, int *result)
{
  int res;
  
  if (ue_tmatches(expr, T_NOT)) {
	res = 0;
	if (ue_filter3(expr, &res) == -1)
	  return(-1);
	*result = !res;
  }
  else
	return(ue_filter4(expr, result));

  return(0);
}

static int
ue_filter4(User_expr *expr, int *result)
{
  
  if (ue_tmatches(expr, T_LPAREN)) {
	if (ue_filter1(expr, result) == -1)
	  return(-1);
	if (ue_tmatches(expr, T_RPAREN))
	  return(0);
	return(-1);
  }

  if (ue_eval(expr, result) == -1)
	return(-1);

  return(0);
}

/*
 * Execute the user filter expression EXPR for each set of credentials
 * (or the unauthenticated user), optionally returning the list of matches.
 * Return the number of matches, or -1 if an error occurs.
 *
 * Grammar:
 *
 * EXP -> E1
 * E1  -> E2 | E2 <or> E2
 * E2  -> E3 | E3 <and> E2
 * E3  -> E4 | <not> E3
 * E4  -> primary | '(' E1 ')'
 */
static int
ue_exec(char *expr, Lex_state *e, Dsvec **matched, char **errmsg)
{
  int n, result;
  Credentials *cr;
  User_expr *ue;

  log_msg((LOG_TRACE_LEVEL, "ue_exec: \"%s\"", expr));

  ue = ALLOC(User_expr);
  ue->e = e;
  ue->expr = expr;
  ue->dsv = ue_lex_scan(expr);
  ue->errmsg = NULL;

  cr = e->env->credentials;
  n = 0;

  do {
	ue->credentials = cr;
	ue->current = 0;

	result = 0;
	if (ue_filter1(ue, &result) != 0) {
	  *errmsg = ue->errmsg;
	  return(-1);
	}

	if (!ue_tmatches(ue, T_EOI)) {
	  *errmsg = "Syntax error";
	  return(-1);
	}

	if (result) {
	  n++;
	  if (matched != NULL) {
		if (*matched == NULL)
		  *matched = dsvec_init(NULL, sizeof(Credentials *));
		dsvec_add_ptr(*matched, cr);
	  }
	}

	if (cr != NULL)
	  cr = cr->next;
  } while (cr != NULL);
	
  return(n);
}

/*
 * User identity predicate.
 * The single string argument is a filter expression that must be
 * satisfied by a single set of credentials (or the unauthenticated user).
 * Return TRUE iff the expression is satisfied.
 * All valid credentials are considered.
 */
static int
func_user(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *errmsg, *s1;
  Arglist *x;

  x = arglist;
  if (x == NULL
	  || x->next != NULL
	  || !str_or_lit(x->result->value.token)
	  || ((s1 = x->result->value.val.strval) == NULL)
	  || *s1 == '\0') {
	seterr_e(e, result, "Invalid argument to 'user' function");
	return(-1);
  }

  if ((st = ue_exec(s1, e, NULL, &errmsg)) == -1) {
	if (errmsg != NULL)
	  seterr_e(e, result, ds_xprintf("Error in 'user' function: %s", errmsg));
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = st;

  return(0);
}

static int
func_user_revoke(Lex_state *e, int nargs, Arglist *arglist,
				 Expr_result *result)
{
#ifndef NOTDEF
  seterr_e(e, result, "Function 'revoke' is not implemented yet");
  return(-1);
#else
  int st;
  char *errmsg, *s1;
  Arglist *x;
  Dsvec *matched;

  x = arglist;
  if (x == NULL
	  || x->next != NULL
	  || !str_or_lit(x->result->value.token)
	  || ((s1 = x->result->value.val.strval) == NULL)
	  || *s1 == '\0') {
	seterr_e(e, result, "Invalid argument to 'revoke' function");
	return(-1);
  }

  /*
   * XXX special case to reset? arg eq.i "none"
   */

  matched = NULL;
  if ((st = ue_exec(s1, e->env->credentials, &matched, &errmsg)) == -1) {
	if (errmsg != NULL)
	  seterr_e(e, result, ds_xprintf("Error in 'ignore' function: %s",
									 errmsg));
	return(-1);
  }

  /*
   * If the unauthenticated user was matched it means "deny".
   * Otherwise, each matching identity should be ignored
   * (this could be scope-limited, but only if useful).
   */

  result->value.token = T_INTEGER;
  result->value.val.intval = st;

  return(0);
#endif
}

/*
 * Generate a unique, sequenced stamp - return the string.
 * The first argument selects a mode of operation.
 * The second argument stores the <unique-hostid-string> and is initialized
 * if it does not exist.
 * The third argument is optional, depending on the mode.
 *
 * The string's format is:
 *   <unique-hostid-string>,<pid>,<unique-sequenced-string>
 * where <unique-hostid-string> is guaranteed (or nearly so) to be unique
 * to the host where this function is called
 * and where <unique-sequenced-string> is different for each stamp and has
 * the characteristic that if this component of stamp B compares
 * lexicographically greater than this component of stamp A, then stamp A was
 * created before stamp B.
 * <unique-sequenced-string> ordinarily consists of:
 *   <epoch-seconds>.<stamp-counter>
 * The user may specify a string to use, however.
 */
static int
func_ustamp(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *op_name, *ntp_host, *str, *user_unique, *vfs_uri;
  Arglist *x;

  x = arglist;
  if (x == NULL || x->next == NULL) {
	seterr_e(e, result, "Too few arguments to 'ustamp' function");
	return(-1);
  }

  ntp_host = NULL;
  user_unique = NULL;

  op_name = x->result->value.val.strval;
  x = x->next;

  vfs_uri = x->result->value.val.strval;
  x = x->next;

  if (strcaseeq(op_name, "clock")) {
	if (x != NULL) {
	  seterr_e(e, result, "Too many arguments to 'ustamp' function");
	  return(-1);
	}
	str = ustamp_clock(NULL, vfs_uri);
  }
  else if (strcaseeq(op_name, "ntpclock")) {
	if (x == NULL) {
	  seterr_e(e, result, "Too few arguments to 'ustamp' function");
	  return(-1);
	}
	ntp_host = x->result->value.val.strval;
	if (x->next != NULL) {
	  seterr_e(e, result, "Too many arguments to 'ustamp' function");
	  return(-1);
	}
	str = ustamp_ntpclock(NULL, vfs_uri, ntp_host);
	seterr_e(e, result, "Unimplemented op argument to 'ustamp' function");
	return(-1);
  }
  else if (strcaseeq(op_name, "user")) {
	if (x == NULL) {
	  seterr_e(e, result, "Too few arguments to 'ustamp' function");
	  return(-1);
	}
	user_unique = x->result->value.val.strval;
	if (x->next != NULL) {
	  seterr_e(e, result, "Too many arguments to 'ustamp' function");
	  return(-1);
	}
	str = ustamp_user(NULL, vfs_uri, user_unique);
	seterr_e(e, result, "Unimplemented op argument to 'ustamp' function");
	return(-1);
  }
  else {
	seterr_e(e, result, "Unrecognized operation in 'ustamp' function");
	return(-1);
  }

  if (str == NULL) {
	seterr_e(e, result, "Stamp generation failed in 'ustamp' function");
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = str;

  return(0);  
}

/*
 * Go through all credentials searching for a DACS admin identity.
 * Return TRUE iff one is found, 0 otherwise.
 */
static int
func_dacs_admin(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  Arglist *x;

  x = arglist;

  if (x != NULL) {
	seterr_e(e, result, "Invalid argument to 'dacs_admin' function");
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = 0;
  if (e->env->credentials == NULL)
	log_msg((LOG_TRACE_LEVEL, "No credentials, no admin identity match"));
  else if (is_dacs_admin(e->env->credentials))
	result->value.val.intval = 1;

  return(0);
}

static int
func_dacs_approval(Lex_state *e, int nargs, Arglist *arglist,
				   Expr_result *result)
{
  char *approval, *dn, *ident, *method, *op, *uri;
  Arglist *x;
  Crypt_keys *ck;

  x = arglist;
  op = x->result->value.val.strval;
  x = x->next;

  if (strcaseeq(op, "create")) {
	if (x == NULL || !str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'dacs_approval' function");
	  return(-1);
	}
	uri = x->result->value.val.strval;

	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_approval' function");
	  return(-1);
	}

	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'dacs_approval' function");
	  return(-1);
	}
	method = x->result->value.val.strval;

	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_approval' function");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'dacs_approval' function");
	  return(-1);
	}
	ident = x->result->value.val.strval;

	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_approval' function");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'dacs_approval' function");
	  return(-1);
	}
	dn = x->result->value.val.strval;

	if (x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacs_approval' function");
	  return(-1);
	}

	if ((ck = crypt_keys_from_vfs(ITEM_TYPE_JURISDICTION_KEYS)) == NULL) {
	  seterr_e(e, result,
			   "Could not get private key in 'dacs_approval' function");
	  return(-1);
	}

	/* XXX Should take a private key as an argument. */
	approval = dacs_approval_create(uri, method, ident, dn, ck->private_key);
	crypt_keys_free(ck);

	if (approval == NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Could not sign approval: dn=\"%s\"", dn));
	  return(-1);
	}

	result->value.token = T_STRING;
	result->value.val.strval = approval;
  }
  else if (strcaseeq(op, "check")) {
	int st;
	unsigned int sign_len;
	char *message, *p;
	unsigned char *sign;
	Kwv *kwv, *kwv_m;
	Kwv_conf u_conf = { "=", "\"", NULL, KWV_CONF_DEFAULT, ", ", 0,
						NULL, NULL };

	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_approval' function");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token) || x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacs_approval' function");
	  return(-1);
	}
	approval = x->result->value.val.strval;

	if ((kwv = kwv_make_sep(NULL, approval, &u_conf)) == NULL) {
	  seterr_e(e, result,
			   "Invalid approval argument to 'dacs_approval' function");
	  return(-1);
	}

	if ((p = kwv_lookup_value(kwv, "a")) == NULL) {
	  seterr_e(e, result,
			   "Invalid approval argument to 'dacs_approval' function");
	  return(-1);
	}
	if (stra64b(p, (unsigned char **) &message, NULL) == NULL) {
	  seterr_e(e, result,
			   "Invalid approval argument to 'dacs_approval' function");
	  return(-1);
	}

	if ((p = kwv_lookup_value(kwv, "s")) == NULL) {
	  seterr_e(e, result,
			   "Invalid approval argument to 'dacs_approval' function");
	  return(-1);
	}
	if (stra64b(p, (unsigned char **) &sign, &sign_len) == NULL) {
	  seterr_e(e, result,
			   "Invalid approval argument to 'dacs_approval' function");
	  return(-1);
	}

	if ((kwv_m = kwv_make_sep(NULL, message, &u_conf)) == NULL) {
	  seterr_e(e, result,
			   "Invalid approval argument to 'dacs_approval' function");
	  return(-1);
	}

	if ((ck = crypt_keys_from_vfs(ITEM_TYPE_JURISDICTION_KEYS)) == NULL) {
	  seterr_e(e, result,
			   "Could not get public key in 'dacs_approval' function");
	  return(-1);
	}

	if ((dn = kwv_lookup_value(kwv_m, "h")) == NULL) {
	  seterr_e(e, result,
			   "Invalid approval argument to 'dacs_approval' function");
	  return(-1);
	}

	st = crypto_signv(dn, (unsigned char *) message, strlen(message),
					  sign, sign_len, ck->public_key);

	result->value.token = T_INTEGER;
	result->value.val.intval = (st == 1);
  }
  else if (strcaseeq(op, "approval")) {
	int st;
	char *p, *message, *ns;
	Kwv *kwv_a, *kwv_m;
	Kwv_conf u_conf = { "=", "\"", NULL, KWV_CONF_DEFAULT, ", ", 0,
						NULL, NULL };

	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_approval' function");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'dacs_approval' function");
	  return(-1);
	}
	approval = x->result->value.val.strval;
	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_approval' function");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token) || x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacs_meta' function");
	  return(-1);
	}
	ns = x->result->value.val.strval;
	if (!var_ns_is_valid_namespace_name(ns)) {
	  seterr_e(e, result,
			   "Invalid namespace argument in 'dacs_meta' function");
	  return(-1);
	}

	st = 0;
	if ((kwv_a = kwv_make_sep(NULL, approval, &u_conf)) == NULL)
	  goto done;
	if ((p = kwv_lookup_value(kwv_a, "a")) == NULL)
	  goto done;
	if (stra64b(p, (unsigned char **) &message, NULL) == NULL)
	  goto done;

	if ((kwv_m = kwv_make_sep(NULL, message, &u_conf)) == NULL)
	  goto done;

	if (var_ns_new(&e->env->namespaces, ns, kwv_m) == NULL)
	  goto done;

	st = 1;

  done:
	result->value.token = T_INTEGER;
	result->value.val.intval = st;
  }
  else {
	seterr_e(e, result, "Unrecognized operation in 'dacs_approval' function");
	return(-1);
  }

  return(0);
}

static int
func_dacs_meta(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int i;
  char *ns, *op;
  Arglist *x;
  Ds ds;
  Jurisdiction *j;
  Kwv *kwv;

  x = arglist;
  op = x->result->value.val.strval;
  x = x->next;

  if (strcaseeq(op, "list_jurisdictions")) {
	if (x != NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacs_meta' function");
	  return(-1);
	}

	if (load_jurisdictions() == -1) {
	  seterr_e(e, result,
			   "Could not load jurisdictions in 'dacs_meta' function");
	  return(-1);
	}

	ds_init(&ds);
	j = jurisdictions;
	for (i = 0; i < njurisdictions; i++)
	  ds_asprintf(&ds, "%s\n", j[i].jname);

	result->value.token = T_STRING;
	result->value.val.strval = ds_buf(&ds);
  }
  else if (strcaseeq(op, "federation")) {
	Crypt_keys *ck;

	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_meta' function");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token) || x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacs_meta' function");
	  return(-1);
	}
	ns = x->result->value.val.strval;
	if (!var_ns_is_valid_namespace_name(ns)) {
	  seterr_e(e, result,
			   "Invalid namespace argument in 'dacs_meta' function");
	  return(-1);
	}

	kwv = kwv_init(8);
	var_ns_new(&e->env->namespaces, ns, kwv);

	kwv_add(kwv, "federation", conf_val(CONF_FEDERATION_NAME));
	kwv_add(kwv, "domain", conf_val(CONF_FEDERATION_DOMAIN));
	if ((ck = crypt_keys_from_vfs(ITEM_TYPE_FEDERATION_KEYS)) != NULL) {
	  if (ck->fed_id != NULL)
		kwv_add(kwv, "fed_id", ck->fed_id);
	  if (ck->public_key_pem != NULL)
		kwv_add(kwv, "fed_public_key", ck->public_key_pem);
	}
	crypt_keys_free(ck);

	result->value.token = T_INTEGER;
	result->value.val.intval = 0;
  }
  else if (strcaseeq(op, "jurisdiction")) {
	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_meta' function");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token) || x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacs_meta' function");
	  return(-1);
	}

	ns = x->result->value.val.strval;
	if (!var_ns_is_valid_namespace_name(ns)) {
	  seterr_e(e, result,
			   "Invalid namespace argument in 'dacs_meta' function");
	  return(-1);
	}

	if (get_jurisdiction_meta(NULL, &j) == -1) {
	  seterr_e(e, result,
			   "Could not load jurisdictions in 'dacs_meta' function");
	  return(-1);
	}

	kwv = kwv_init(8);
	var_ns_new(&e->env->namespaces, ns, kwv);

	kwv_add(kwv, "jname", j->name);
	kwv_add(kwv, "name", j->name);
	kwv_add(kwv, "alt_name", j->alt_name);
	kwv_add(kwv, "dacs_url", j->dacs_url);
	kwv_add(kwv, "authenticates", j->authenticates);
	kwv_add(kwv, "prompts", j->prompts);
	if (j->auxiliary != NULL)
	  kwv_add(kwv, "auxiliary", j->auxiliary);
#ifndef NOTDEF
	if (j->public_key_pem != NULL)
	  kwv_add(kwv, "public_key_pem", j->public_key_pem);
#else
	{
	  Crypt_keys *ck;

	  if ((ck = crypt_keys_from_vfs(ITEM_TYPE_JURISDICTION_KEYS)) != NULL) {
		if (ck->public_key_pem != NULL)
		  kwv_add(kwv, "public_key", ck->public_key_pem);
		crypt_keys_free(ck);
	  }
	}
#endif

	result->value.token = T_INTEGER;
	result->value.val.intval = 0;
  }
  else if (strcaseeq(op, "jname")) {
	char *jname;

	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'dacs_meta' function");
	  return(-1);
	}
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'dacs_meta' function");
	  return(-1);
	}
	jname = x->result->value.val.strval;
	if (!is_valid_jurisdiction_name(jname)) {
	  seterr_e(e, result,
			   "Invalid jurisdiction argument to 'dacs_meta' function");
	  return(-1);
	}

	x = x->next;
	if (!str_or_lit(x->result->value.token) || x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacs_meta' function");
	  return(-1);
	}
	ns = x->result->value.val.strval;
	if (!var_ns_is_valid_namespace_name(ns)) {
	  seterr_e(e, result,
			   "Invalid namespace argument in 'dacs_meta' function");
	  return(-1);
	}

	if (get_jurisdiction_meta(jname, &j) == -1) {
	  seterr_e(e, result,
			   "Could not find jurisdiction in 'dacs_meta' function");
	  return(-1);
	}

	kwv = kwv_init(8);
	var_ns_new(&e->env->namespaces, ns, kwv);

	kwv_add(kwv, "jname", j->name);
	kwv_add(kwv, "name", j->name);
	kwv_add(kwv, "alt_name", j->alt_name);
	kwv_add(kwv, "dacs_url", j->dacs_url);
	kwv_add(kwv, "authenticates", j->authenticates);
	kwv_add(kwv, "prompts", j->prompts);
	if (j->auxiliary != NULL)
	  kwv_add(kwv, "auxiliary", j->auxiliary);
	if (name_eq(jname, conf_val(CONF_JURISDICTION_NAME),
				DACS_NAME_CMP_CONFIG)) {
#ifndef NOTDEF
	  if (j->public_key_pem != NULL)
		kwv_add(kwv, "public_key_pem", j->public_key_pem);
#else
	  {
		Crypt_keys *ck;

		if ((ck = crypt_keys_from_vfs(ITEM_TYPE_JURISDICTION_KEYS)) != NULL) {
		  if (ck->public_key_pem != NULL)
			kwv_add(kwv, "public_key", ck->public_key_pem);
		  crypt_keys_free(ck);
		}
	  }
#endif
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = 0;
  }
  else if (strcaseeq(op, "update_jurisdiction")) {
	seterr_e(e, result, "Unimplemented op argument to 'dacs_meta' function");
	return(-1);
  }
  else if (strcaseeq(op, "update_jurisdictions")) {
	seterr_e(e, result, "Unimplemented op argument to 'dacs_meta' function");
	return(-1);
  }
  else {
	seterr_e(e, result, "Unrecognized operation in 'dacs_meta' function");
	return(-1);
  }

  return(0);
}

static int
func_dacsauth(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *s;
  Arglist *x;
  Auth_out dacsauth_out;
  Dsvec *args;
  Kwv_pair pair;
  Value v, v1, v2, v3;

  if (arglist == NULL) {
	seterr_e(e, result, "Missing argument to 'dacsauth' function");
	return(-1);
  }

  args = dsvec_init(NULL, sizeof(char *));
  dsvec_add_ptr(args, "dacsauth");

  if (arglist->next == NULL) {
	Dsvec *mk;
	Mkargv conf = { 0, 0, " \t", NULL, NULL };
	  
	/* This is the single argument variant. */
	x = arglist;
	if (!str_or_lit(x->result->value.token)
		|| (s = x->result->value.val.strval) == NULL) { 
	  seterr_e(e, result, "Invalid argument to 'dacsauth' function");
	  return(-1);
	}
	if ((mk = ds_mkargv(NULL, s, &conf)) == NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacsauth' function");
	  return(-1);
	}
	dsvec_append(args, mk);
  }
  else {
	/* This is the multiple argument variant. */
	for (x = arglist; x != NULL; x = x->next) {
	  if (!str_or_lit(x->result->value.token)
		  || (s = x->result->value.val.strval) == NULL) { 
		seterr_e(e, result, "Invalid argument to 'dacsauth' function");
		return(-1);
	  }
	  dsvec_add_ptr(args, x->result->value.val.strval);
	}
	dsvec_add_ptr(args, NULL);
  }

  st = dacsauth_main(dsvec_len(args), (char **) dsvec_base(args), 0,
					 &dacsauth_out);

  init_value(&v, T_ALIST, sizeof(Value));

  init_value(&v1, T_INTEGER, (long) dacsauth_out.result);
  kwv_set_pair(&pair, "result", NULL, &v1);
  kwv_add_pair_nocopy(v.val.alistval.kwv, &pair);

  init_value(&v2, T_STRING, dacsauth_out.identity);
  kwv_set_pair(&pair, "identity", NULL, &v2);
  kwv_add_pair_nocopy(v.val.alistval.kwv, &pair);

  init_value(&v3, T_STRING, dacsauth_out.role_string);
  kwv_set_pair(&pair, "roles", NULL, &v3);
  kwv_add_pair_nocopy(v.val.alistval.kwv, &pair);

  result->value.token = T_ALIST;
  result->value = v;

  return(0);
}

static int
func_dacscheck(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *s;
  Arglist *x;
  Dsvec *args;

  if (arglist == NULL) {
	seterr_e(e, result, "Missing argument to 'dacscheck' function");
	return(-1);
  }

  args = dsvec_init(NULL, sizeof(char *));
  dsvec_add_ptr(args, "dacscheck");

  if (arglist->next == NULL) {
	Dsvec *mk;
	Mkargv conf = { 0, 0, " \t", NULL, NULL };
	  
	x = arglist;
	if (!str_or_lit(x->result->value.token)
		|| (s = x->result->value.val.strval) == NULL) { 
	  seterr_e(e, result, "Invalid argument to 'dacscheck' function");
	  return(-1);
	}
	if ((mk = ds_mkargv(NULL, s, &conf)) == NULL) {
	  seterr_e(e, result, "Invalid argument to 'dacscheck' function");
	  return(-1);
	}
	dsvec_append(args, mk);
  }
  else {
	for (x = arglist; x != NULL; x = x->next) {
	  if (!str_or_lit(x->result->value.token)
		  || (s = x->result->value.val.strval) == NULL) { 
		seterr_e(e, result, "Invalid argument to 'dacscheck' function");
		return(-1);
	  }
	  dsvec_add_ptr(args, x->result->value.val.strval);
	}
	dsvec_add_ptr(args, NULL);
  }

  st = dacscheck_main(dsvec_len(args), (char **) dsvec_base(args), 0, NULL);

  result->value.token = T_INTEGER;
  result->value.val.intval = st;

  return(0);
}

static Dsvec *
char_sep_list_parser(char *list_format, char *spec)
{
  char *decoded, *el, *p, *s;
  Dsvec *v;

  if (spec == NULL)
	return(NULL);

  v = dsvec_init(NULL, sizeof(char *));
  s = p = strdup(spec);

  while ((el = strsep(&p, list_format)) != NULL) {
	if (*el != '\0') {
	  if ((decoded = url_decode(el, NULL, NULL)) == NULL)
		return(NULL);
	  dsvec_add_ptr(v, decoded);
	}
  }

  return(v);
}

static int
is_char_sep_list_sep(int ch)
{

  if (ispunct(ch) || ch == '\n' || ch == '\t' || ch == ' ')
	return(1);

  return(0);
}

/*
 * Return 1 if each element of SUBLIST appears in SUPERLIST,
 * 0 if an element not in SUPERLIST is found, and -1 on error.
 * Do case insensitive comparisons if IGNORE_CASE is non-zero.
 */
static int
check_subset(Dsvec *subset, Dsvec *superset, int icase)
{
  int i, j;
  char *p, *q;

  i = 0;
  while ((p = dsvec_ptr(subset, i, char *)) != NULL) {
	j = 0;
	while ((q = dsvec_ptr(superset, j, char *)) != NULL) {
	  if (icase ? strcaseeq(p, q) : streq(p, q))
		break;

	  j++;
	}
	if (q == NULL)
	  return(0);
	i++;
  }

  return(1);
}

/*
 * Usage:
 * subset(<list-format-identifier>, <purported-subset>, <superset>[, nocase])
 *
 * The <list-format-identifier> tells us how to parse the following
 * arguments.  If the format is a single punctuation character,
 * then that character separates the elements.
 * <purported-subset> is the list whose elements are
 * each required to appear somewhere in the list <superset>.
 *
 * Example:
 *  <allow>
 *    ${REQUEST:Pi} eq "GetMap" and
 *    subset(",", ${LAYERS:Pi}, "RELIEF:Foundation,GTOPO30:Foundation")
 * </allow>
 *
 * This says that the REQUEST parameter (case insensitive) must be "GetMap"
 * and that the elements of the LAYERS parameter (case insensitive) must
 * exactly match either RELIEF:Foundation or GTOPO30:Foundation; if an
 * element appears in LAYERS that does not also appear in the given list, the
 * predicate is False, otherwise it is True.
 */
static int
func_subset(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int icase, rc;
  char *s1, *s2, *t;
  Arglist *x;
  Dsvec *subset, *superset;
  Dsvec *(*parser)(char *, char *);

  x = arglist;
  t = x->result->value.val.strval;
  x = x->next;
  s1 = x->result->value.val.strval;
  x = x->next;
  s2 = x->result->value.val.strval;
  x = x->next;
  if (x != NULL) {
	if (x->result->value.token != T_LITERAL
		|| !strcaseeq(x->result->value.val.strval, "nocase")
		|| x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'subset' function");
	  return(-1);
	}
	icase = 1;
  }
  else
	icase = 0;

  parser = NULL;
  if (is_char_sep_list_sep((int) *t) && *(t + 1) == '\0')
	parser = char_sep_list_parser;
  else {
	seterr_e(e, result, "Unrecognized format type for 'subset' function");
	return(-1);
  }

  if ((subset = parser(t, s1)) == NULL) {
	seterr_e(e, result,
			 "Parse failed on subset argument for 'subset' function");
	return(-1);
  }

  if ((superset = parser(t, s2)) == NULL) {
	seterr_e(e, result,
		   "Parse failed on superset argument for 'subset' function");
	return(-1);
  }

  rc = check_subset(subset, superset, icase);
  if (rc == -1) {
	seterr_e(e, result, "Evaluation of 'subset' function failed");
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = rc;

  return(0);
}

/*
 * Return the number of elements of TESTSET that appear at least once
 * in TARGETSET.
 */
static int
contains_count(Dsvec *testset, Dsvec *targetset, int icase)
{
  int i, j, n;
  char *p, *q;

  i = 0;
  n = 0;
  while ((p = dsvec_ptr(testset, i, char *)) != NULL) {
	j = 0;
	while ((q = dsvec_ptr(targetset, j, char *)) != NULL) {
	  if (icase ? strcaseeq(p, q) : streq(p, q)) {
		n++;
		break;
	  }
	  j++;
	}
	i++;
  }

  return(n);
}

/*
 * Function to test if acknowledgements have been obtained.
 * If so, execution continues; if not, an exception is triggered
 * (ACS_DENIAL_REASON_ACK_NEEDED).
 * Usages:
 *    1. ack(notice-list)
 *           -- require an ack that matches CURRENT_URI_NO_QUERY
 *    2. ack(notice-list, EXACT_MATCH[, uri-list])
 *           -- basically the same as #1, except for additional arguments.
 *    3. ack(notice-list, ALL_ACKS[, uri-list])
 *           -- require that the set of all acks collectively name
 *              all elements of notice-list
 * Not implemented:
 *    4. ack(notice-list, ANY_ACK[, uri-list])
 *           -- require a single ack that names both a resource in uri-list
 *              and all elements of notice-list
 *
 * Each URI in notice-list identifies a notice that must be acknowledged.
 * Each URI in uri-list identifies a resource that may have been acknowledged.
 * Both notice-list and uri-list are comma-separated lists of URI
 * (optionally, with spaces following a comma).
 *
 * Additionally, the argument(s) [, NEW_ACK[, uri-list]] may appear as the
 * last arguments; NEW_ACK indicates that a new acknowlegement should be
 * issued and uri-list, if present, indicates the URIs that this ack
 * acknowledges instead of the default, CURRENT_URI_NO_QUERY.
 */
static int
func_ack(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  unsigned int ui;
  char *mode, *s1;
  Arglist *x;
  Dsvec *needed_notices, *notices;
  extern Dsvec *get_needed_notices(Dsvec *, char *mode);

  x = arglist;
  if (x == NULL) {
	seterr_e(e, result, "Invalid argument to 'ack' function");
	return(-1);
  }

  notices = dsvec_init(NULL, sizeof(char *));
  mode = "EXACT_MATCH";

  for (x = arglist; x != NULL; x = x->next) {
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'ack' function");
	  return(-1);
	}

	s1 = x->result->value.val.strval;
	if (strcaseeq(s1, "EXACT_MATCH") || strcaseeq(s1, "ALL_MATCH")) {
	  mode = s1;
	  x = x->next;
	  break;
	}

	if (uri_parse(s1) == NULL) {
	  seterr_e(e, result, "Invalid URI argument to 'ack' function");
	  return(-1);
	}
	dsvec_add_ptr(notices, s1);
  }

  if (x != NULL) {
	seterr_e(e, result, "Invalid argument to 'ack' function");
	return(-1);
  }

  /*
   * Check which of the required acknowledgements for this service request
   * have already been obtained and which ones are still required.
   * If none are required, this predicate should return True; otherwise,
   * access should be denied, rule processing terminated immediately, and
   * an ACS_DENIAL_REASON_ACK_NEEDED exception triggered.
   * If no acknowledgements have been collected for this service request,
   * a new NAT may be issued later; it may name the service request, a
   * caller-specified list of URI, or a list of URI obtained from the
   * matching rule.
   * If a NAT applies to this service request but one or more acknowledgements
   * are still needed, then this NAT may be replaced later.
   */
  for (ui = 0; ui < dsvec_len(notices); ui++) {
	log_msg((LOG_TRACE_LEVEL, "Rule wants ack for notice: %s",
			 (char *) dsvec_ptr_index(notices, ui)));
  }

  if ((needed_notices = get_needed_notices(notices, mode)) != NULL) {
	log_msg((LOG_TRACE_LEVEL, "Notices not yet acknowledged: %s",
			 strjoin(needed_notices, " ")));
	e->env->notices = needed_notices;
	longjmp(e->env->jmp_env, 2);
  }
  else {
	log_msg((LOG_TRACE_LEVEL, "No acks needed"));
	result->value.token = T_INTEGER;
	result->value.val.intval = 1;
  }

  return(0);
}

static int
func_bstring(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  void *s1;
  size_t slen, need;
  Arglist *x;

  x = arglist;
  if (x->result->value.token == T_BSTRING) {
	s1 = x->result->value.val.bval.data;
	slen = x->result->value.val.bval.len;
  }
  else {
	s1 = x->result->value.val.strval;
	slen = strlen(s1) + 1;
  }

  x = x->next;
  need = (size_t) x->result->value.val.intval;

  if (need == 0)
	need = slen;
  else if (need > slen)
	need = slen;

  result->value.token = T_BSTRING;
  result->value.val.bval.data = memdupn(s1, need);
  result->value.val.bval.len = need;

  return(0);
}

static int
list_add(char *naming_context, char *name, void ***ptr)
{
  char *p;
  Dsvec *dsv;

  if ((dsv = (Dsvec *) *ptr) == NULL) {
    *ptr = (void **) dsvec_init(NULL, sizeof(char *));
    dsv = (Dsvec *) *ptr;
  }

  if (naming_context != NULL && (p = strprefix(name, naming_context)) != NULL)
    dsvec_add_ptr(dsv, strdup(p + 1));
  else
    dsvec_add_ptr(dsv, strdup(name));

  return(1);
}

#define COUNTER_FIELD_SEP	" "

typedef enum Counter_op {
  COUNTER_CREATE = 0,
  COUNTER_SET    = 1,
  COUNTER_DEL    = 2,
  COUNTER_INC    = 3,
  COUNTER_DEC    = 4,
  COUNTER_DECDEL = 5,
  COUNTER_EXISTS = 6,
  COUNTER_GET    = 7,
  COUNTER_LIST   = 8
} Counter_op;

/*
 * Integer counters
 * counter(set|get|del|inc|dec|decdel|exists, vfs_uri,
 *    counter-name[, int-value])
 *
 * To some extent this is a kludge because a tie() function would provide
 * a more general solution.
 */
static int
func_counter(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int do_update, exists;
  char *buf, *counter_name, *list_val, *op_name, *vfs_uri;
  long inc, new_val, old_val, val;
  Arglist *x;
  Counter_op op;
  Ds *err;
  Vfs_conf *conf;
  Vfs_handle *h;

  x = arglist;
  op_name = x->result->value.val.strval;
  x = x->next;

  vfs_uri = x->result->value.val.strval;
  x = x->next;

  if (x != NULL) {
	counter_name = x->result->value.val.strval;
	x = x->next;
  }
  else
	counter_name = NULL;

  val = 0;
  inc = 0;
  if (x != NULL) {
	val = x->result->value.val.intval;
	if (x->next != NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Too many arguments to 'counter' function"));
	  return(-1);
	}
  }

  if (strcaseeq(op_name, "create"))
	op = COUNTER_CREATE;
  else if (strcaseeq(op_name, "set"))
	op = COUNTER_SET;
  else if (strcaseeq(op_name, "exists"))
	op = COUNTER_EXISTS;
  else if (strcaseeq(op_name, "get"))
	op = COUNTER_GET;
  else if (strcaseeq(op_name, "list"))
	op = COUNTER_LIST;
  else if (strcaseeq(op_name, "del") || strcaseeq(op_name, "delete"))
	op = COUNTER_DEL;
  else if (strcaseeq(op_name, "inc")) {
	op = COUNTER_INC;
	if (x == NULL)
	  inc = 1;
	else
	  inc = val;
  }
  else if (strcaseeq(op_name, "dec")) {
	op = COUNTER_DEC;
	if (x == NULL)
	  inc = -1;
	else
	  inc = -val;
  }
  else if (strcaseeq(op_name, "decdel")) {
	op = COUNTER_DECDEL;
	if (x == NULL)
	  inc = -1;
	else
	  inc = -val;
  }
  else {
	seterr_e(e, result, "Unimplemented op argument to 'counter' function");
	return(-1);
  }

  if (op != COUNTER_LIST && counter_name == NULL) {
	seterr_e(e, result,
			 ds_xprintf("Counter name is required in 'counter' function"));
	return(-1);
  }

  if ((op == COUNTER_CREATE || op == COUNTER_SET) && x == NULL) {
	seterr_e(e, result,
			 ds_xprintf("Too few arguments to 'counter' function"));
	return(-1);
  }

  if ((op == COUNTER_DEL || op == COUNTER_EXISTS || op == COUNTER_GET
	   || op == COUNTER_LIST) && x != NULL) {
	seterr_e(e, result,
			 ds_xprintf("Too many arguments to 'counter' function"));
	return(-1);
  }

  err = ds_init(NULL);
  conf = vfs_conf(NULL);
  conf->null_flag = 0;
  conf->lock_flag = (op == COUNTER_EXISTS || op == COUNTER_GET
					 || op == COUNTER_LIST) ? VFS_SHLOCK : VFS_EXLOCK;
  conf->create_flag = (op == COUNTER_SET);
  vfs_conf(conf);

  if ((h = vfs_open_any(vfs_uri)) == NULL) {
	ds_asprintf(err, "Could not open VFS for vfs_uri \"%s\", ", vfs_uri);
	ds_asprintf(err, "failed in 'counter' function");
	seterr_e(e, result, ds_buf(err));
	return(-1);
  }

  if (vfs_control(h, VFS_SET_FIELD_SEP, COUNTER_FIELD_SEP) == -1) {
	ds_asprintf(err, "Error during 'counter/control' for key \"%s\", ",
				counter_name);
	ds_asprintf(err, "failed in 'counter' function: %s",
				h->error_msg != NULL ? h->error_msg : "");
	seterr_e(e, result, ds_buf(err));
	vfs_close(h);
	return(-1);
  }

  do_update = 1;
  list_val = NULL;

  switch (op) {
  case COUNTER_CREATE:
	if ((exists = vfs_exists(h, counter_name)) == -1) {
	  ds_asprintf(err, "Error during 'counter/create' for key \"%s\", ",
				  counter_name);
	  ds_asprintf(err, "failed in 'counter' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	if (exists) {
	  if (vfs_get(h, counter_name, (void **) &buf, NULL) == -1) {
		ds_asprintf(err, "Error during 'counter/create' for key \"%s\", ",
					counter_name);
		ds_asprintf(err, "failed in 'counter' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }

	  strtrim(buf, "\n", 0);
	  if (strnum(buf, STRNUM_L, &new_val) == -1) {
		ds_asprintf(err, "Error during 'counter/conversion' for key \"%s\", ",
					counter_name);
		ds_asprintf(err, "failed in 'counter' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }
	  do_update = 0;
	}
	else
	  new_val = val;
	break;

  case COUNTER_SET:
	new_val = val;
	break;

  case COUNTER_LIST:
	{
	  int i, n;
	  char *name;
	  Ds *ds;
	  Dsvec *names;

	  names = NULL;
	  if ((n = vfs_list(h, NULL, NULL, list_add, (void ***) &names)) == -1) {
		seterr_e(e, result,
				 ds_xprintf("Error during 'counter/list' for key \"%s\"",
							counter_name));
		return(-1);
	  }

	  ds = ds_init(NULL);
	  for (i = 0; i < n; i++) {
		name = (char *) dsvec_ptr_index(names, i);
		if (vfs_get(h, name, (void **) &buf, NULL) == -1) {
		  ds_asprintf(err, "Error during 'counter/get' for key \"%s\", ",
					  name);
		  ds_asprintf(err, "failed in 'counter' function: %s",
					  h->error_msg != NULL ? h->error_msg : "");
		  seterr_e(e, result, ds_buf(err));
		  vfs_close(h);
		  return(-1);
		}

		ds_asprintf(ds, "%s%s%s%s", name, COUNTER_FIELD_SEP, buf,
					((i + 1) < n) ? "\n" : "");
	  }

	  list_val = non_null(ds_buf(ds));
	  do_update = 0;
	  break;
	}

  case COUNTER_EXISTS:
	if ((new_val = (long) vfs_exists(h, counter_name)) == -1) {
	  ds_asprintf(err, "Error during 'counter/exists' for key \"%s\", ",
				  counter_name);
	  ds_asprintf(err, "failed in 'counter' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}
	do_update = 0;
	break;

  case COUNTER_INC:
  case COUNTER_DEC:
  case COUNTER_GET:
  case COUNTER_DECDEL:
	if (vfs_get(h, counter_name, (void **) &buf, NULL) == -1) {
	  ds_asprintf(err, "Error during 'counter/get' for key \"%s\", ",
				  counter_name);
	  ds_asprintf(err, "failed in 'counter' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	strtrim(buf, "\n", 0);
	if (strnum(buf, STRNUM_L, &old_val) == -1) {
	  ds_asprintf(err, "Error during 'counter/conversion' for key \"%s\", ",
				  counter_name);
	  ds_asprintf(err, "failed in 'counter' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	new_val = old_val + inc;

	if (new_val == old_val)
	  do_update = 0;

	if (new_val > 0 || op != COUNTER_DECDEL)
	  break;

	/*FALLTHROUGH*/

  case COUNTER_DEL:
	if (vfs_delete(h, counter_name) == -1) {
	  ds_asprintf(err, "Error during 'counter/delete' for key \"%s\", ",
				  counter_name);
	  ds_asprintf(err, "failed in 'counter' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}
	do_update = 0;
	new_val = 0;
	break;

  default:
	seterr_e(e, result,
			 ds_xprintf("Internal errr in 'counter' function"));
	return(-1);
	/*NOTREACHED*/
  }

  if (do_update) {
	char *v;

	v = ds_xprintf("%ld", new_val);

	if (vfs_put(h, counter_name, v, strlen(v)) == -1) {
	  ds_asprintf(err, "Error during 'counter/put' for key \"%s\", ",
				  counter_name);
	  ds_asprintf(err, "failed in 'counter' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}
  }

  if (vfs_close(h) == -1) {
	ds_asprintf(err, "Close failed for vfs_uri \"%s\"", vfs_uri);
	ds_asprintf(err, "failed in 'counter' function: %s",
				h->error_msg != NULL ? h->error_msg : "");
	seterr_e(e, result, ds_buf(err));
	return(-1);
  }

  if (op != COUNTER_LIST) {
	result->value.token = T_INTEGER;
	result->value.val.intval = new_val;
  }
  else {
	result->value.token = T_STRING;
	result->value.val.strval = list_val;
  }

  return(0);
}

/*
 * Usage:
 * contains_any(<list-format-identifier>, <test-set>, <target-set>[, nocase])
 *
 * The <list-format-identifier> tells us how to parse the following
 * arguments. The result is the count of the number of elements of <test-set>
 * that appear in <target-set> at least once.
 *
 * Example:
 *    contains_any(",", ${LAYERS:Pi}, "Nests,Secret_roads,Cultural_heritage")
 *
 * Here, the value of the expression is two if any two elements in the
 * LAYERS parameter (case insensitive) appear in the given list, otherwise
 * the value is zero.
 */
static int
func_contains_any(Lex_state *e, int nargs, Arglist *arglist,
				  Expr_result *result)
{
  int icase, rc;
  char *s1, *s2, *t;
  Arglist *x;
  Dsvec *subset, *superset;
  Dsvec *(*parser)(char *, char *);

  x = arglist;
  t = x->result->value.val.strval;
  x = x->next;
  s1 = x->result->value.val.strval;
  x = x->next;
  s2 = x->result->value.val.strval;
  x = x->next;
  if (x != NULL) {
	if (x->result->value.token != T_LITERAL
		|| !strcaseeq(x->result->value.val.strval, "nocase")
		|| x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'contains_any' function");
	  return(-1);
	}
	icase = REG_ICASE;
  }
  else
	icase = 0;

  parser = NULL;
  if (is_char_sep_list_sep((int) *t) && *(t + 1) == '\0')
	parser = char_sep_list_parser;
  else {
	seterr_e(e, result,
			 "Unrecognized format type for 'contains_any' function");
	return(-1);
  }

  if ((subset = parser(t, s1)) == NULL) {
	seterr_e(e, result,
		   "Parse failed on subset argument for 'contains_any' function");
	return(-1);
  }

  if ((superset = parser(t, s2)) == NULL) {
	seterr_e(e, result,
		   "Parse failed on superset argument for 'contains_any' function");
	return(-1);
  }

  rc = contains_count(subset, superset, icase);
  if (rc == -1) {
	seterr_e(e, result, "Evaluation of 'contains_any' function failed");
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = rc;

  return(0);
}

/*
 *
 */
static int
func_encode(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *enc;
  unsigned char *s1;
  unsigned int len;
  Arglist *x;

  x = arglist;
  enc = x->result->value.val.strval;

  x = x->next;
  if (x->result->value.token == T_STRING) {
	s1 = (unsigned char *) x->result->value.val.strval;
	len = strlen(x->result->value.val.strval);
  }
  else if (x->result->value.token == T_BSTRING) {
	s1 = (unsigned char *) x->result->value.val.bval.data;
	len = x->result->value.val.bval.len;
  }
  else {
	seterr_e(e, result, "Unrecognized data type for 'encode' function");
	return(-1);
  }

  if (strcaseeq(enc, "ascii85"))
	strba85(s1, len, &result->value.val.strval);
  else if (strcaseeq(enc, "cescape"))
	result->value.val.strval = strcescape((char *) s1, len);
  else if (strcaseeq(enc, "hex"))
	result->value.val.strval = strbtohex(s1, len, 0);
  else if (strcaseeq(enc, "mime"))
	mime_encode_base64(s1, len, &result->value.val.strval);
  else if (strcaseeq(enc, "dacs64"))
	strba64(s1, len, &result->value.val.strval);
  else if (strcaseeq(enc, "url"))
	result->value.val.strval = url_encode((char *) s1, len);
  else {
	seterr_e(e, result, "Unrecognized encoding type for 'encode' function");
	return(-1);
  }

  result->value.token = T_STRING;

  return(0);
}

static int
func_debug(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  long intval;
  char *s1, *val;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;

  x = x->next;
  if (str_or_lit(x->result->value.token)) {
	val = x->result->value.val.strval;
	intval = 0;
  }
  else if (x->result->value.token == T_INTEGER) {
	val = NULL;
	intval = x->result->value.val.intval;
  }
  else {
	seterr_e(e, result, "Invalid type for value in 'debug' function");
	return(-1);
  }

  if (strcaseeq(s1, "lexdump")) {
	if ((val != NULL && strcaseeq(val, "on"))
		|| (val == NULL && intval))
	  do_lexdump = 1;
	else if ((val != NULL && strcaseeq(val, "off"))
			 || (val == NULL && !intval))
	  do_lexdump = 0;
	else {
	  seterr_e(e, result, "Unrecognized value for value in 'debug' function");
	  return(-1);
	}
  }
  else if (strcaseeq(s1, "trace")) {
	if (val != NULL) {
	  if (strcaseeq(val, "off"))
		e->env->trace_level = 0;
	  else {
		seterr_e(e, result, "Invalid type for value in 'debug' function");
		return(-1);
	  }
	}
	else {
	  if (intval < 0) {
		seterr_e(e, result, "Invalid type for value in 'debug' function");
		return(-1);
	  }
	  e->env->trace_level = intval;
	}
  }
  else {
	seterr_e(e, result, "Unrecognized mode for 'debug' function");
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = 1;

  return(0);
}

/*
 *
 */
static int
func_decode(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *dec, *decoded, *s1;
  unsigned int len;
  Arglist *x;

  x = arglist;
  dec = x->result->value.val.strval;

  x = x->next;
  s1 = x->result->value.val.strval;

  if (strcaseeq(dec, "ascii85")) {
	unsigned char *d;

	if ((stra85b(s1, &d, &len)) == NULL) {
	  seterr_e(e, result, "stra85b decoding failed");
	  return(-1);
	}

	result->value.token = T_BSTRING;
	result->value.val.bval.data = (void *) d;
	result->value.val.bval.len = (size_t) len;
  }
  else if (strcaseeq(dec, "cescape")) {
	Ds *ds;

	ds = struncescape(s1);
	result->value.token = T_BSTRING;
	result->value.val.bval.data = ds_buf(ds);
	result->value.val.bval.len = ds_len(ds) - 1;	/* Ignore the null */
  }
  else if (strcaseeq(dec, "hex")) {
	unsigned char *d;

	if ((d = strhextob(s1, &len)) == NULL) {
	  seterr_e(e, result, "Hex decoding failed");
	  return(-1);
	}

	result->value.token = T_BSTRING;
	result->value.val.bval.data = (void *) d;
	result->value.val.bval.len = (size_t) len;
  }
  else if (strcaseeq(dec, "mime")) {
	unsigned char *d;
	long nbytes;

	if ((nbytes = mime_decode_base64(s1, &d)) == -1) {
	  seterr_e(e, result, "MIME base-64 decoding failed");
	  return(-1);
	}

	result->value.token = T_BSTRING;
	result->value.val.bval.data = (void *) d;
	result->value.val.bval.len = (size_t) nbytes;
  }
  else if (strcaseeq(dec, "dacs64")) {
	unsigned char *d;

	if ((stra64b(s1, &d, &len)) == NULL) {
	  seterr_e(e, result, "stra64b decoding failed");
	  return(-1);
	}

	result->value.token = T_BSTRING;
	result->value.val.bval.data = (void *) d;
	result->value.val.bval.len = (size_t) len;
  }
  else if (strcaseeq(dec, "url")) {
	int nonp;
	Ds *ds;

	/*
	 * Decode the URL-style %XX encoded string.
	 * RFC 2396 URI Generic Syntax
	 */
	if ((decoded = url_decode(s1, &nonp, &ds)) == NULL || nonp != 0) {
	  seterr_s(e, result, ds_xprintf("url_decode failed for \"%s\"", s1));
	  return(-1);
	}

	result->value.token = T_BSTRING;
	result->value.val.bval.data = ds_buf(ds);
	result->value.val.bval.len = ds_len(ds) - 1;	/* Ignore the null */
  }
  else {
	seterr_e(e, result, "Unrecognized decoding type for 'decode' function");
	return(-1);
  }

  return(0);
}

/*
 * Re-evaluate the argument as an expression.
 * Example: eval("strlen(\"abc\")") is 3
 */
static int
func_eval(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;

  return(func_expr(s1, -1, e->env, result));
}

/*
 * Stop evaluating (but continue parsing) and return the argument as
 * the final result.
 */
static int
func_exit(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  Arglist *x;

  x = arglist;
  copy_value(&result->value, &x->result->value);
  result->err = x->result->err;
  result->errmsg = x->result->errmsg;
  e->exit_called = result->exit_called = 1;
  e->do_eval = 0;

  return(0);
}

static int
func_expand(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;
  Ds *ds; 

  x = arglist;
  s1 = x->result->value.val.strval;

  if ((ds = acs_string_operand(s1, e->env)) == NULL) {
	seterr_e(e, result, "Error during string interpolation in 'expand' function");
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = ds_buf(ds);

  return(0);
}

#ifdef NOTDEF
static int
func_extern(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *err, *func_name;
  Arglist *x;
  Ds *ds; 
  int (*func)(char *, int, Arglist *, Expr_result *);
  void *sym;
  static void *h = NULL;

  x = arglist;
  func_name = x->result->value.val.strval;

  if (h == NULL) {
	/* XXX */
	if ((h = dynload_load("/tmp/libmine.so", &err)) == NULL) {
	  seterr_e(e, result, err);
	  return(-1);
	}
  }

  if ((sym = dynload_symbol(h, func_name, &err)) == NULL) {
	seterr_e(e, result, err);
	return(-1);
  }

  func = (int (*)(char *, int, Arglist *, Expr_result *)) sym;
  if (func(func_name, nargs, arglist, result) == -1)
	return(-1);

  result->value.token = T_STRING;
  result->value.val.strval = "yabba dabba";

  return(0);
}
#endif

static MAYBE_UNUSED void
register_function(char *name, char *arity, char *argdesc,
				  int (*func)(Lex_state *, int, Arglist *, Expr_result *)) {

}

/*
 * Random value functionality
 * Usages:
 *   random(bytes, NBYTES)
 *   random(uint, LO, HI)
 *   random(string, NBYTES[, SPEC])
 *   random(stringc, NBYTES, SPEC])
 */
static int
func_random(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;

  /*
  REGISTER_FUNC("random", "2+", "S*");
  */

  x = arglist;
  s1 = x->result->value.val.strval;
  x = x->next;

  if (strcaseeq(s1, "bytes")) {
	int nbytes;

	if (x == NULL) {
	  seterr_e(e, result, ds_xprintf("Missing argument to 'random' function"));
	  return(-1);
	}

	if (x->result->value.token != T_INTEGER) {
	  seterr_e(e, result, ds_xprintf("Invalid argument to 'random' function"));
	  return(-1);
	}
	nbytes = (int) x->result->value.val.intval;

	if (x->next != NULL) {
	  seterr_e(e, result, ds_xprintf("Invalid argument to 'random' function"));
	  return(-1);
	}

	result->value.token = T_BSTRING;
	result->value.val.bval.data = (void *) crypto_make_random_buffer(nbytes);
	result->value.val.bval.len = (size_t) nbytes;
  }
  else if (strcaseeq(s1, "uint")) {
	unsigned int lo, hi, uint;

	if (x == NULL) {
	  seterr_e(e, result, ds_xprintf("Missing argument to 'random' function"));
	  return(-1);
	}

	if (x->result->value.token != T_INTEGER) {
	  seterr_e(e, result, ds_xprintf("Invalid argument to 'random' function"));
	  return(-1);
	}
	lo = (unsigned int) x->result->value.val.intval;

	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, ds_xprintf("Missing argument to 'random' function"));
	  return(-1);
	}

	if (x->result->value.token != T_INTEGER) {
	  seterr_e(e, result, ds_xprintf("Invalid argument to 'random' function"));
	  return(-1);
	}
	hi = (unsigned int) x->result->value.val.intval;

	if (x->next != NULL) {
	  seterr_e(e, result, ds_xprintf("Invalid argument to 'random' function"));
	  return(-1);
	}

	if (crypto_random_uint(lo, hi, &uint) == -1) {
	  seterr_e(e, result, ds_xprintf("Function 'random' failed"));
	  return(-1);
	}
	result->value.token = T_INTEGER;
	result->value.val.intval = (long) uint;
  }
  else if (strcaseeq(s1, "string") || strcaseeq(s1, "stringc")) {
	int cflag, nbytes;
	char *spec;

	cflag = strcaseeq(s1, "stringc");
	if (x == NULL) {
	  seterr_e(e, result, ds_xprintf("Missing argument to 'random' function"));
	  return(-1);
	}

	if (x->result->value.token != T_INTEGER) {
	  seterr_e(e, result, ds_xprintf("Invalid argument to 'random' function"));
	  return(-1);
	}
	nbytes = (int) x->result->value.val.intval;

	if ((x = x->next) == NULL) {
	  if (cflag) {
		seterr_e(e, result,
				 ds_xprintf("Missing argument to 'random' function"));
		return(-1);
	  }
	  result->value.token = T_STRING;
	  result->value.val.strval = crypto_make_random_string(NULL, nbytes);
	}
	else {
	  if (x->result->value.token != T_STRING) {
		seterr_e(e, result,
				 ds_xprintf("Invalid argument to 'random' function"));
		return(-1);
	  }
	  spec = x->result->value.val.strval;
	  if (x->next != NULL) {
		seterr_e(e, result,
				 ds_xprintf("Invalid argument to 'random' function"));
		return(-1);
	  }
	  result->value.token = T_STRING;
	  result->value.val.strval
		= crypto_make_random_string_from_spec(spec, nbytes, cflag);
	}
  }
  else {
	seterr_e(e, result, "Invalid argument to 'random' function");
	return(-1);
  }

  return(0);
}

/*
 * This function always returns its argument (a string expected to have a
 * form acceptable as the second argument to a DACS error handler directive)
 * and sets the redirect flag; it is up to the caller to interpret this.
 * Evaluation stops but parsing continues.
 * In the context of a Deny clause, the intent is to deny access and redirect
 * the user to the given URL.
 */
static int
func_redirect(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;
  Acs_denial_reason reason;

  x = arglist;
  if (x->next != NULL) {
	char *code;

	code = x->result->value.val.strval;
	/* Check code */
	if ((reason = acs_lookup_error_code(code)) == ACS_DENIAL_REASON_UNKNOWN
		|| reason == ACS_DENIAL_REASON_DEFAULT) {
	  seterr_e(e, result,
			   "Invalid error code argument to 'redirect' function");
	  return(-1);
	}
	x = x->next;
  }
  else
	reason = ACS_DENIAL_REASON_BY_REDIRECT;

  s1 = x->result->value.val.strval;
  if (x->next != NULL) {
	seterr_e(e, result, "Invalid argument to 'redirect' function");
	return(-1);
  }

  /* Do a syntax check on the action. */
  if (acs_init_error_handler(NULL, NULL, s1,  ACS_HANDLER_NONE) == NULL) {
	seterr_e(e, result, "Invalid argument to 'redirect' function");
	return(-1);
  }

  e->env->redirect_action = s1;
  e->env->redirect_reason = reason;

  /* No value is actually returned. */

  log_msg((LOG_DEBUG_LEVEL, "Request to redirect to \"%s\"", s1));
  longjmp(e->env->jmp_env, 1);

  /*NOTREACHED*/
  return(-1);
}

static int
func_file(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int argc, st;
  char *s1;
  Arglist *x;
  Dsvec *argv;
  extern int file_func(int argc, char **argv, char **result);

  argv = dsvec_init(NULL, sizeof(char *));
  argc = 0;
  for (x = arglist; x != NULL; x = x->next) {
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'file' function");
	  return(-1);
	}
	s1 = x->result->value.val.strval;
	dsvec_add_ptr(argv, s1);
	argc++;
  }

  dsvec_add_ptr(argv, NULL);

  if ((st = file_func(dsvec_len(argv) - 1, (char **) dsvec_base(argv),
					  &result->value.val.strval)) == -1) {
	if (result->value.val.strval != NULL)
	  seterr_e(e, result, result->value.val.strval);
	else
	  seterr_e(e, result, "Error executing 'file' function");
	return(-1);
  }

  result->value.token = T_STRING;
  if (st == 0)
	result->value.val.strval = "";

  return(0);
}

static int
func_file_owner(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *argv[4], *errmsg, *filename, *ident, *jname, *owner, *sresult;
  extern int file_func(int argc, char **argv, char **result);

  if (arglist != NULL) {
	if (arglist->next != NULL)
	  return(-1);
	filename = arglist->result->value.val.strval;
  }
  else
	filename = var_ns_get_value(e->env->namespaces, "DACS", "FILENAME");

  jname = var_ns_get_value(e->env->namespaces, "Conf", "JURISDICTION_NAME");
  argv[0] = "test";
  argv[1] = "-e";
  argv[2] = filename;
  argv[3] = NULL;

  result->value.token = T_INTEGER;
  result->value.val.intval = 0;

  if ((st = file_func(3, argv, &sresult)) == -1)
	return(-1);

  if (st != 1)
	return(0);
 
  argv[0] = "stat";
  argv[1] = "%U";
  argv[2] = filename;
  argv[3] = NULL;
  if ((st = file_func(3, argv, &owner)) == -1)
	return(-1);
  ident = ds_xprintf("%s:%s", jname, owner);
  if ((st = ue_exec(ident, e, NULL, &errmsg)) == -1) {
	if (errmsg != NULL)
	  seterr_e(e, result, ds_xprintf("Error in 'file_owner' function: %s",
									 errmsg));
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = st;

  return(0);
}

static int
func_file_group(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *argv[4], *errmsg, *filename, *group, *ident, *jname, *sresult;
  extern int file_func(int argc, char **argv, char **result);

  if (arglist != NULL) {
	if (arglist->next != NULL)
	  return(-1);
	filename = arglist->result->value.val.strval;
  }
  else
	filename = var_ns_get_value(e->env->namespaces, "DACS", "FILENAME");

  jname = var_ns_get_value(e->env->namespaces, "Conf", "JURISDICTION_NAME");
  argv[0] = "test";
  argv[1] = "-e";
  argv[2] = filename;
  argv[3] = NULL;

  result->value.token = T_INTEGER;
  result->value.val.intval = 0;

  if ((st = file_func(3, argv, &sresult)) == -1)
	return(-1);

  if (st != 1)
	return(0);
 
  argv[0] = "stat";
  argv[1] = "%G";
  argv[2] = filename;
  argv[3] = NULL;
  if ((st = file_func(3, argv, &group)) == -1)
	return(-1);
  ident = ds_xprintf("%%%s:%s", jname, group);
  if ((st = ue_exec(ident, e, NULL, &errmsg)) == -1) {
	if (errmsg != NULL)
	  seterr_e(e, result, ds_xprintf("Error in 'file_group' function: %s",
									 errmsg));
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = st;

  return(0);
}

/*
 * Test where a request comes from (as in Apache allow/deny directives),
 * comparing it (REMOTE_ADDR) against:
 * a (partial) domain name, a full IP address, a partial IP address,
 * a network/netmask pair, or a network/nnn CIDR specification.
 * For compatibility with Apache, the argument "all" (case insensitive)
 * always returns 1.
 */
static int
func_from(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *errmsg, *remote_addr, *remote_host, *s1;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;

  if (*s1 == '\0') {
	seterr_e(e, result, "Invalid argument to 'from' function");
	return(-1);
  }

  remote_addr = var_ns_get_value(e->env->namespaces, "DACS", "REMOTE_ADDR");
  remote_host = var_ns_get_value(e->env->namespaces, "DACS", "REMOTE_HOST");

  if ((st = is_from_address(s1, remote_addr, remote_host, &errmsg)) == -1) {
	seterr_e(e, result,
			 ds_xprintf("%s while evaluating 'from' function", errmsg));
	return(-1);
  }

  result->value.token = T_INTEGER;
  if (st == 1)
	result->value.val.intval = 1;
  else
	result->value.val.intval = 0;

  return(0);
}

/*
 * Read a file (from the filesystem) or retrieve something from a store.
 * Syntax 1: get(<filename>)
 * Syntax 2: get(<item_type>, <key>)
 *
 * NB: trailing newlines are always removed, which is sometimes a feature
 * and sometimes a bug - this should be configurable.
 */
static int
func_get(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *buf, *key, *vfs_ref;
  Arglist *x;

  x = arglist;
  vfs_ref = x->result->value.val.strval;
  x = x->next;

  if (*vfs_ref == '\0') {
	seterr_e(e, result, "Invalid argument to 'get' function");
	return(-1);
  }

  if (x != NULL) {
	key = x->result->value.val.strval;
	if (x->next != NULL) {
	  seterr_e(e, result, "Too many arguments to 'get' function");
	  return(-1);
	}
  }
  else
	key = NULL;

  if (strcaseeq(vfs_ref, "stdin")) {
	if (load_file(NULL, &buf, NULL) == -1) {
	  seterr_e(e, result,
			   ds_xprintf("Could not load \"%s\" in 'get' function", vfs_ref));
	  return(-1);
	}
	clearerr(stdin);

	result->value.token = T_STRING;
	result->value.val.strval = buf;

	return(0);
  }

  if (dacs_app_type == DACS_STANDALONE && key == NULL && *vfs_ref != '/') {
	log_msg((LOG_TRACE_LEVEL, "This is a relative path: \"%s\"", vfs_ref));
	if (load_file(vfs_ref, &buf, NULL) == -1) {
	  seterr_e(e, result,
			   ds_xprintf("Could not load \"%s\" in 'get' function", vfs_ref));
	  return(-1);
	}
  }
  else {
	Vfs_handle *h;

	if ((h = vfs_open_any(vfs_ref)) == NULL) {
	  Ds *err;

	  err = ds_init(NULL);
	  ds_asprintf(err, "Could not open VFS for vfs-ref \"%s\", ", vfs_ref);
	  ds_asprintf(err, "failed in 'get' function");
	  seterr_e(e, result, ds_buf(err));
	  return(-1);
	}

	if (vfs_get(h, key, (void **) &buf, NULL) == -1) {
	  seterr_e(e, result,
			   ds_xprintf("Could not load \"%s\" in 'get' function", vfs_ref));
	  vfs_close(h);
	  return(-1);
	}

	if (vfs_close(h) == -1) {
	  seterr_e(e, result, ds_xprintf("Close failed in 'get' function"));
	  return(-1);
	}
  }

  result->value.token = T_STRING;
  result->value.val.strval = strtrim(buf, "\n", 0);

  return(0);
}

static int
func_hash(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *hash_name, *msg_str;
  size_t msg_len;
  Arglist *x;

  x = arglist;
  if (x->result->value.token == T_STRING) {
	msg_str = x->result->value.val.strval;
	x = x->next;
	if ((msg_len = x->result->value.val.intval) == 0)
	  msg_len = strlen(msg_str);
  }
  else if (x->result->value.token == T_BSTRING) {
	msg_str = x->result->value.val.bval.data;
	x = x->next;
	if ((msg_len = x->result->value.val.intval) == 0)
	  msg_len = x->result->value.val.bval.len;
  }
  else {
	seterr_e(e, result, "hash function failed: invalid argument");
	return(-1);
  }

  x = x->next;
  if (x != NULL) {
	if (x->next != NULL) {
	  seterr_e(e, result, "hash function failed: too many arguments");
	  return(-1);
	}

	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "hash function failed: unrecognized hash name");
	  return(-1);
	}
	hash_name = strtolower(x->result->value.val.strval);
  }
  else
	hash_name = "hash32";

  if (streq(hash_name, "hash32")) {
	unsigned long hval;

	hval = (unsigned long) strhash32((unsigned char *) msg_str, msg_len);
	result->value.token = T_STRING;
	result->value.val.strval = ds_xprintf("%lu", hval);
  }
  else if (streq(hash_name, "hash64")) {
	unsigned long long hval;

	hval = (unsigned long long) strhash64((unsigned char *) msg_str, msg_len);
	result->value.token = T_STRING;
	result->value.val.strval = ds_xprintf("%llu", hval);
  }
  else {
	seterr_e(e, result, "hash function failed: unrecognized hash name");
	return(-1);
  }

  return(0);
}

#ifdef NOTDEF
/*
 * Read one or more lines from the specified stream
 *   <var> = gets(<stream>)
 *   <list_var> = gets(<stream>)
 * Read one line or all lines until EOF from <stream> and set
 * variable _ within <stream> to the input string.
 * Set eof within <stream> if nothing was read because of EOF.
 * Set error within <stream> if an error occurred.
 *
 * <stream> specifies whether to strip nl.
 * Returns 1 if ok, 0 if EOF, -1 if read error.
 */
static int
func_gets(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *buf, *line, *vfs_ref;
  Arglist *x;
  Ds ds;
  Kwv *kwv;
  Vfs_handle *h;

  x = arglist;
  vfs_ref = x->result->value.val.strval;
  x = x->next;

  if (!streq(vfs_ref, "stdin")) {
	seterr_e(e, result, "Invalid stream argument to 'gets' function");
	return(-1);
  }

  ds_init(&ds);
  ds.delnl_flag = 1;
  kwv = kwv_init(4);
  if ((line = ds_gets(&ds, stdin)) == NULL) {
	kwv_add(kwv, "eof", (dsio_eof(&ds) != 0) ? "1" : "0");
	kwv_add(kwv, "error", (dsio_eof(&ds) == -1) ? "1" : "0");
	vs = var_ns_new(&e->env->namespaces, "stdin", kwv);
  }
  
}
#endif
  
/*
 * password(check, given-password, password-digest [,alg])
 * password(getdata, username [,vfs-ref])
 * password(getdigest, username [,vfs-ref])
 * password(hash, plain-password [,alg])
 * password(list, [,vfs-ref]])
 * password(syntax, given-password [,constraints])
 * password(test, test-type, username [,vfs-ref])
 */
static int
func_password(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *op, *s2, *s3, *algname;
  Arglist *x;
  Passwd_digest_alg alg;
  Vfs_handle *h;

  x = arglist;
  op = x->result->value.val.strval;
  x = x->next;

  if (x == NULL) {
	if (!strcaseeq(op, "list")) {
	  seterr_e(e, result, "Invalid argument to 'password' function");
	  return(-1);
	}
	s2 = NULL;
  }
  else {
	s2 = x->result->value.val.strval;
	x = x->next;
  }

  s3 = NULL;
  if (strcaseeq(op, "check")) {
	if (x == NULL) {
	  seterr_e(e, result,
			   "Missing password-digest argument to 'password' function");
	  return(-1);
	}

	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result,
			   "Invalid password_digest argument to 'password' function");
	  return(-1);
	}
	s3 = x->result->value.val.strval;
	x = x->next;
  }
  else if (strcaseeq(op, "getdigest")) {
	char *digest_str, *vfs_ref;

	if (x != NULL) {
	  if (!str_or_lit(x->result->value.token)) {
		seterr_e(e, result,
				 "Invalid vfs-ref argument to 'password' function");
		return(-1);
	  }
	  vfs_ref = x->result->value.val.strval;
	  if (x->next != NULL) {
		seterr_e(e, result, "Invalid argument to 'password' function");
		return(-1);
	  }
	}
	else
	  vfs_ref = "passwds";

	if ((h = vfs_open_any(vfs_ref)) == NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Cannot open vfs-ref \"%s\" in 'password' function",
						 vfs_ref));
	  return(-1);
	}

	result->value.token = T_STRING;
	if ((digest_str = pw_getdigest_entry(h, s2)) == NULL)
	  result->value.val.strval = "";
	else 
	  result->value.val.strval = digest_str;

	vfs_close(h);

	return(0);
  }
  else if (strcaseeq(op, "getdata")) {
	char *vfs_ref;
	Ds *data;

	if (x != NULL) {
	  if (!str_or_lit(x->result->value.token)) {
		seterr_e(e, result,
				 "Invalid vfs-ref argument to 'password' function");
		return(-1);
	  }
	  vfs_ref = x->result->value.val.strval;
	  if (x->next != NULL) {
		seterr_e(e, result, "Invalid argument to 'password' function");
		return(-1);
	  }
	}
	else
	  vfs_ref = "passwds";

	if ((h = vfs_open_any(vfs_ref)) == NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Cannot open vfs-ref \"%s\" in 'password' function",
						  vfs_ref));
	  return(-1);
	}

	result->value.token = T_BSTRING;
	if ((data = pw_getdata_entry(h, s2)) == NULL) {
	  result->value.val.bval.data = NULL;
	  result->value.val.bval.len = 0;
	}
	else {
	  result->value.val.bval.data = ds_buf(data);
	  result->value.val.bval.len = ds_len(data);
	}

	vfs_close(h);

	return(0);
  }
  else if (strcaseeq(op, "list")) {
	char *vfs_ref;
	Dsvec *dsv;
	/* Either no additional arguments, or a vfs-ref. */

	if (s2 != NULL)
	  vfs_ref = s2;
	else
	  vfs_ref = "passwds";

	if ((h = vfs_open_any(vfs_ref)) == NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Cannot open vfs-ref \"%s\" in 'password' function",
						 vfs_ref));
	  return(-1);
	}

	if ((dsv = pw_list_entries(h)) == NULL) {
	  seterr_e(e, result, "Cannot list entries in 'password' function");
	  return(-1);
	}

	vfs_close(h);

	result->value.token = T_STRING;
	if (dsvec_len(dsv) == 0)
	  result->value.val.strval = "";
	else
	  result->value.val.strval = strjoin(dsv, "\n");

	return(0);
  }
  else if (strcaseeq(op, "syntax")) {
	if (x != NULL) {
	  if (!str_or_lit(x->result->value.token)) {
		seterr_e(e, result,
				 "Invalid constraint argument to 'password' function");
		return(-1);
	  }
	  s3 = x->result->value.val.strval;
	  x = x->next;
	}
	else
	  s3 = conf_val(CONF_PASSWORD_CONSTRAINTS);

	if (s3 == NULL || x != NULL) {
	  seterr_e(e, result, "Invalid argument to 'password' function");
	  return(-1);
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = pw_is_passwd_acceptable(s2, s3);

	return(0);
  }
  else if (strcaseeq(op, "test")) {
	int st;
	char *username, *vfs_ref;
	Pw_op op;

	/* s2 is the test type */
	if (strcaseeq(s2, "enabled"))
	  op = PW_OP_TEST_ENABLED;
	else if (strcaseeq(s2, "disabled"))
	  op = PW_OP_TEST_DISABLED;
	else if (strcaseeq(s2, "data"))
	  op = PW_OP_TEST_PRIVATE;
	else if (strcaseeq(s2, "exists"))
	  op = PW_OP_TEST_EXISTS;
	else {
	  seterr_e(e, result,
			   "Unrecognized test type argument to 'password' function");
	  return(-1);
	}
 
	if (x == NULL) {
	  seterr_e(e, result, "Missing username to 'password' function");
	  return(-1);
	}

	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result,
			   "Invalid vfs-ref argument to 'password' function");
	  return(-1);
	}
	username = x->result->value.val.strval;
	x = x->next;

	if (x != NULL) {
	  if (!str_or_lit(x->result->value.token)) {
		seterr_e(e, result,
				 "Invalid vfs-ref argument to 'password' function");
		return(-1);
	  }
	  vfs_ref = x->result->value.val.strval;
	  if (x->next != NULL) {
		seterr_e(e, result, "Invalid argument to 'password' function");
		return(-1);
	  }
	}
	else
	  vfs_ref = "passwds";

	if ((h = vfs_open_any(vfs_ref)) == NULL) {
	  seterr_e(e, result,
			   ds_xprintf("Cannot open vfs-ref \"%s\" in 'password' function",
						  vfs_ref));
	  return(-1);
	}

	if ((st = pw_test_entry(h, op, username)) == -1) {
	  seterr_e(e, result, "Error testing entry in 'password' function");
	  return(-1);
	}

	vfs_close(h);

	result->value.token = T_INTEGER;
	result->value.val.intval = st;

	return(0);
  }
  algname = NULL;
  if (x != NULL) {
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid alg argument to 'password' function");
	  return(-1);
	}
	algname = x->result->value.val.strval;
	if ((alg = passwd_lookup_digest_algorithm(algname)) == PASSWD_ALG_NONE) {
	  seterr_e(e, result,
			   "Unrecognized digest alg argument in 'password' function");
	  return(-1);
	}

	x = x->next;
  }
  else if (passwd_get_digest_algorithm(&algname, &alg) == -1) {
	seterr_e(e, result,
			 "Unrecognized digest alg is configured in 'password' function");
	return(-1);
  }

  if (x != NULL) {
	seterr_e(e, result, "Too many arguments to 'password' function");
	return(-1);
  }

  if (strcaseeq(op, "hash")) {
	char *str;

	if ((str = passwd_make_digest(alg, s2, NULL)) == NULL) {
	  seterr_e(e, result, "Error computing hash in 'password' function");
	  return(-1);
	}
	result->value.token = T_STRING;
	result->value.val.strval = str;
  }
  else if (strcaseeq(op, "check")) {
	int st;
	Pw_entry *pw;

	if ((pw = pw_parse_entry(NULL, s3)) == NULL) {
	  seterr_e(e, result,
			   "Error parsing digest arguement in 'password' function");
	  return(-1);
	}

	if ((st = passwd_check_digest(alg, s2, pw)) == -1) {
	  seterr_e(e, result, "Error checking hash in 'password' function");
	  return(-1);
	}
	result->value.token = T_INTEGER;
	result->value.val.intval = st;
  }
  else {
	seterr_e(e, result, "Unrecognized operation in 'password' function");
	return(-1);
  }

  return(0);
}

static int
func_pathname(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1, *s2, *s3, *str;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;
  x = x->next;
  s2 = x->result->value.val.strval;
  x = x->next;
  s3 = x->result->value.val.strval;

  if ((str = directory_name_interpolate(s1, s2, s3)) == NULL) {
	seterr_e(e, result, ds_xprintf("Directory name interpolation failed"));
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = str;

  return(0);
}

static int
func_pbkdf2(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int pwdlen, saltlen;
  unsigned int count, dklen;
  unsigned char *pwd, *salt;
  unsigned char *kdf2;
  size_t len;
  Arglist *x;

  x = arglist;
  len = x->result->value.val.bval.len;
  if (len == 0) {
	seterr_e(e, result, "Invalid password argument in 'pbkdf2' function");
	return(-1);
  }
  pwd = (unsigned char *) x->result->value.val.bval.data;
  pwdlen = (int) len;	/* XXX */

  x = x->next;
  len = x->result->value.val.bval.len;
  if (len == 0) {
	seterr_e(e, result, "Invalid salt argument in 'pbkdf2' function");
	return(-1);
  }
  salt = (unsigned char *) x->result->value.val.bval.data;
  saltlen = (int) len;	/* XXX */

  x = x->next;
  count = (unsigned int) x->result->value.val.intval;

  x = x->next;
  dklen = (unsigned int) x->result->value.val.intval;

  kdf2 = crypto_pbkdf2(pwd, pwdlen, salt, saltlen, count, dklen);
  if (kdf2 == NULL) {
	seterr_e(e, result, ds_xprintf("Key derivation failed"));
	return(-1);
  }

  result->value.token = T_BSTRING;
  result->value.val.bval.data = kdf2;
  result->value.val.bval.len = dklen;

  return(0);
}

/*
 * Concatenate all arguments, converting to strings if necessary, and print
 * to the log.  Useful for debugging.
 * The returned value is 1.
 */
static int
func_print(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *str;
  Arglist *x;
  Ds ds;

  ds_init(&ds);
  for (x = arglist; x != NULL; x = x->next) {
	if (force_string(&x->result->value, &str) == -1)
	  return(-1);
	ds_asprintf(&ds, "%s", str);
  }

  if (ds_len(&ds) == 0)
	ds_asprintf(&ds, "");

  if (e->env->is_dacsexpr)
	printf("%s\n", ds_buf(&ds));
  else
	log_msg(((Log_level) (LOG_DEBUG_LEVEL | LOG_USER_FLAG), "%s",
			 ds_buf(&ds)));

  result->value.token = T_VOID;

  return(0);
}

#define PRINTF(DS, FMT, FIELD_WIDTH, PRECISION, FUNC) \
  do { \
    if (FIELD_WIDTH) { \
      if (PRECISION) \
        (void) ds_asprintf(DS, FMT, FIELD_WIDTH, PRECISION, FUNC); \
      else \
        (void) ds_asprintf(DS, FMT, FIELD_WIDTH, FUNC); \
    } \
	else if (PRECISION) \
	  (void) ds_asprintf(DS, FMT, PRECISION, FUNC); \
    else \
	  (void) ds_asprintf(DS, FMT, FUNC); \
  } while (0);

/*
 * Scaled down version of printf(3).
 */
static int
internal_doprnt(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result,
				int whereto)
{
  int cc, field_width, i, precision, saved_ch;
  long lval;
  unsigned long ulval;
  double rval;
  char *fmt, *fmt_start, *format, *strval;
  Arglist *x;
  Ds ds;

  x = arglist;
  format = x->result->value.val.strval;
  x = x->next;

  ds_init(&ds);
  while (1) {
	for (fmt = format; *fmt != '\0'; fmt++) {
	  switch (*fmt) {
	  case '%':
		fmt_start = fmt++;
		if (*fmt == '%') {
		  ds_asprintf(&ds, "%%");
		  break;
		}

		while (strchr("#-+ 0", *fmt) != NULL)
		  fmt++;
		if (*fmt == '*') {
		  if (x->result->value.token == T_INTEGER)
			field_width = x->result->value.val.intval;
		  else {
			if (force_integer(e, x->result, &lval) == -1) {
			  seterr_e(e, result, "Invalid field width value in 'printf'");
			  return(-1);
			}
			field_width = (int) lval;
		  }
		  x = x->next;
		}
		else
		  field_width = 0;

		while (strchr("*0123456789", *fmt) != NULL)
		  fmt++;
		if (*fmt == '.')
		  fmt++;
		if (*fmt == '*') {
		  if (x->result->value.token == T_INTEGER)
			precision = x->result->value.val.intval;
		  else {
			if (force_integer(e, x->result, &lval) == -1) {
			  seterr_e(e, result, "Invalid precision value in 'printf'");
			  return(-1);
			}
			precision = (int) lval;
		  }
		  x = x->next;
		}
		else
		  precision = 0;

		while (strchr("*0123456789", *fmt) != NULL)
		  fmt++;
		if (*fmt == '\0') {
		  seterr_e(e, result, "Missing conversion specifier in 'printf'");
		  return(-1);
		}
		saved_ch = *(fmt + 1);
		*(fmt + 1) = '\0';
		switch (*fmt) {
		case 'c':
		case 's':
		  if (x == NULL)
			strval = "";
		  else {
			if (str_or_lit(x->result->value.token))
			  strval = x->result->value.val.strval;
			else if (force_string(&x->result->value, &strval) == -1) {
			  seterr_e(e, result, "String argument required in 'printf'");
			  return(-1);
			}
			x = x->next;
		  }
		  PRINTF(&ds, fmt_start, field_width, precision, strval);
		  break;

		case 'd':
		case 'i':
		  if (x == NULL)
			lval = 0;
		  else {
			if (x->result->value.token == T_INTEGER)
			  lval = x->result->value.val.intval;
			else if (force_integer(e, x->result, &lval) == -1) {
			  seterr_e(e, result, "Integer argument required in 'printf'");
			  return(-1);
			}
			x = x->next;
		  }
		  PRINTF(&ds, fmt_start, field_width, precision, lval);
		  break;

		case 'o':
		case 'u':
		case 'x':
		case 'X':
		  if (x == NULL)
			ulval = 0;
		  else {
			if (x->result->value.token == T_INTEGER)
			  ulval = x->result->value.val.intval;
			else {
			  if (force_integer(e, x->result, &lval) == -1) {
				seterr_e(e, result, "Integer argument required in 'printf'");
				return(-1);
			  }
			  ulval = (unsigned long) lval;
			}
			x = x->next;
		  }
		  PRINTF(&ds, fmt_start, field_width, precision, ulval);
		  break;

		case 'e':
		case 'E':
		case 'f':
		case 'g':
		case 'G':
		  if (x == NULL)
			rval = 0.0;
		  else {
			if (x->result->value.token == T_REAL)
			  rval = x->result->value.val.realval;
			else if (force_real(x->result, &rval) == -1) {
			  seterr_e(e, result, "Real argument required in 'printf'");
			  return(-1);
			}
			x = x->next;
		  }
		  PRINTF(&ds, fmt_start, field_width, precision, rval);
		  break;
		default:
		  return(-1);
		}

		*(fmt + 1) = saved_ch;
		break;

	  case '\\':
		fmt++;
		if (*fmt == '\0')	/* Ends with a backslash?  Ignore it. */
		  break;
		if (is_octdigit((int) *fmt)) {
		  cc = 0;
		  for (i = 0; i < 3; i++) {
			if (!is_octdigit((int) *fmt))
			  break;
			cc = cc * 8 + octdigit_val((int) *fmt);
			fmt++;
		  }
		}
		else {
		  /* Harbison & Steele 2.7.6 */
		  switch ((int) *fmt) {
		  case 'a':
			cc = '\a'; break;
		  case 'b':
			cc = '\b'; break;
		  case 'f':
			cc = '\f'; break;
		  case 'n':
			cc = '\n'; break;
		  case 'r':
			cc = '\r'; break;
		  case 't':
			cc = '\t'; break;
		  case 'v':
			cc = '\v'; break;
		  default:
			cc = (int) *fmt; break;
		  }
		}

		ds_asprintf(&ds, "%c", cc);
		break;

	  default:
		ds_asprintf(&ds, "%c", *fmt);
		break;
	  }
	}

	/* If we've used up both the format and the arguments, we're done. */
	if (x == NULL)
	  break;
  }

  result->value.token = T_VOID;

  if (whereto == 0) {
	printf("%s", ds_buf(&ds));
	fflush(stdout);
  }
  else if (whereto == 1)
	log_msg(((Log_level) (LOG_DEBUG_LEVEL | LOG_USER_FLAG | LOG_SENSITIVE_FLAG),
			 "%s", ds_buf(&ds)));
  else {
	result->value.token = T_STRING;
	result->value.val.strval = ds_buf(&ds);
  }

  return(0);
}

/*
 * Scaled down version of printf(3).
 */
static int
func_printf(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{

  if (e->env->is_dacsexpr)
	return(internal_doprnt(e, nargs, arglist, result, 0));

  return(internal_doprnt(e, nargs, arglist, result, 1));
}

/*
 * Scaled down version of sprintf(3).
 */
static int
func_sprintf(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{

  return(internal_doprnt(e, nargs, arglist, result, 2));
}

/*
 * Execute a program with the specified arguments.
 * Return NULL if there's an error, otherwise a string.
 * Usage: exec(<path>[, arg]...)
 */
static int
func_exec(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int child_exit_status, read_fd, status;
  char **env, *s1;
  pid_t pid, wpid;
  Arglist *x;
  Ds ds;
  Dsvec *v;
  FILE *fp;
  Kwv *kwv;

  x = arglist;
  if (x == NULL) {
	seterr_e(e, result, "Invalid argument to 'exec' function");
	return(-1);
  }

  v = dsvec_init(NULL, sizeof(char *));
  for (x = arglist; x != NULL; x = x->next) {
	if (force_string(&x->result->value, &s1) == -1) {
	  seterr_e(e, result, "Invalid argument to 'exec' function");
	  return(-1);
	}
	if (x == arglist && *s1 == '\0') {
	  seterr_e(e, result, "Invalid argument to 'exec' function");
	  return(-1);
	}
	dsvec_add_ptr(v, s1);
  }

  dsvec_add_ptr(v, NULL);

  if ((kwv = var_ns_lookup_kwv(e->env->namespaces, "ExecEnv")) != NULL)
	env = kwv_env(kwv);
  else
	env = NULL;

  /* XXX Should there be a time limit to wait? */
  if (filterthru((char **) dsvec_base(v), env, &read_fd, NULL, NULL, &pid)
	  == -1) {
	seterr_e(e, result, "Function 'exec' failed");
	return(-1);
  }

  if ((fp = fdopen(read_fd, "r")) == NULL) {
	close(read_fd);
	seterr_e(e, result, "I/O failure in function 'exec'");
	return(-1);
  }

  ds_init(&ds);
  while (ds_agets(&ds, fp) != NULL)
	;
  if (ferror(fp) || !feof(fp)) {
	seterr_e(e, result, "I/O failure while reading in function 'exec'");
	return(-1);
  }
  fclose(fp);

  if ((wpid = waitpid(pid, &status, WNOHANG)) != pid) {
	if (wpid != 0) {
	  seterr_e(e, result, "Error during waitpid call in function 'exec'");
	  return(-1);
	}
	log_msg((LOG_DEBUG_LEVEL, "No stopped or exited children."));
  }
  else {
	child_exit_status = WEXITSTATUS(status);
	log_msg((LOG_DEBUG_LEVEL, "Child exit status is %d", child_exit_status));
	var_ns_add_key(e->env->namespaces, "DACS", "status",
				   ds_xprintf("%d", child_exit_status));
  }

  result->value.token = T_STRING;
  if (ds_len(&ds) == 0)
	result->value.val.strval = strdup("");
  else
	result->value.val.strval = ds_buf(&ds);

  {
	char *lastch;

	/* XXX it should be possible to override this, as by tcl's -keepnewline */
	lastch = result->value.val.strval + ds_len(&ds) - 2;
	if (*lastch == '\n')
	  *lastch = '\0';
  }

  return(0);
}

/*
 * Invoke the specified URL with the given arguments.
 * Return the retrieved object as a string or report an error.
 *
 * Usage: http(<url>, [<method>[, argname, argvalue]...])
 * If <url> begins with "https", use SSL.
 * The <method> is "GET", "POST", etc. (case insensitive).
 */
static int
func_http(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int n, reply_len, st, status_code;
  char *m, *url, *argname, *argvalue, *reply;
  Arglist *x;
  Dsvec *v;
  Http_params *params;
  Http_method method;

  x = arglist;
  url = x->result->value.val.strval;
  if (*url == '\0') {
	seterr_e(e, result, "Invalid url argument to 'http' function");
	return(-1);
  }

  if ((x = x->next) == NULL)
	m = "GET";
  else {
	m = x->result->value.val.strval;
	x = x->next;
  }
 if ((method = http_string_to_method(m)) == HTTP_UNKNOWN_METHOD) {
	seterr_e(e, result, "Unrecognized method argument to 'http' function");
	return(-1);
  }

  v = dsvec_init(NULL, sizeof(Http_params));

  for (n = 0; x != NULL; n++, x = x->next) {
	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'http' function");
	  return(-1);
	}
	argname = x->result->value.val.strval;

	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing argument to 'http' function");
	  return(-1);
	}
	if (force_string(&x->result->value, &argvalue) == -1) {
	  seterr_e(e, result, "Invalid argument to 'http' function");
	  return(-1);
	}

	params = http_param(v, argname, argvalue, NULL, 0);
  }

  reply = NULL;
  reply_len = -1;
  st = http_invoke(url, method, HTTP_SSL_URL_SCHEME,
				   n, (Http_params *) dsvec_base(v), NULL, NULL,
				   &reply, &reply_len, &status_code, NULL);

  if (st == -1) {
	if (reply != NULL)
	  seterr_e(e, result,
			   ds_xprintf("Evaluation of 'http' function failed: %s", reply));
	else
	  seterr_e(e, result, "Evaluation of 'http' function failed");
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = reply;
  return(0);
}

/*
 * Match a given URI against the request.
 * If the argument is only the path component of a URI (i.e., it starts
 * with a slash), canonicalize it using the current request.
 * The path component is actually a url_pattern and may end with a slash-star.
 * If the argument matches the request, return the number of path components
 * in the given path that match the request, counting a scheme+authority
 * as one component.
 */
static int
func_request_match(Lex_state *e, int nargs, Arglist *arglist,
				   Expr_result *result)
{
  int st;
  char *req, *s, *uri_str;
  Arglist *x;
  Dsvec *dsv_req_path;
  Uri *req_uri, *uri;

  x = arglist;
  s = x->result->value.val.strval;
  if (*s == '/') {
	char *sa;

	if ((sa = current_uri_sa(NULL)) == NULL) {
	  seterr_e(e, result,
			   "Cannot get request URI in 'request_match' function");
	  return(-1);
	}
	uri_str = ds_xprintf("%s%s", sa, s);
  }
  else
	uri_str = s;
	
  if ((uri = uri_parse(uri_str)) == NULL) {
	seterr_e(e, result, "Invalid URI argument to 'request_match' function");
	return(-1);
  }

  if ((req = current_uri_no_query(NULL)) == NULL) {
	seterr_e(e, result, "Cannot get request URI in 'request_match' function");
	return(-1);
  }
  if ((req_uri = uri_parse(req)) == NULL) {
	seterr_e(e, result, "Invalid request URI in 'request_match' function");
	return(-1);
  }

  if (uri->scheme != NULL && !strcaseeq(uri->scheme, req_uri->scheme))
	st = 0;
  else if (uri->host != NULL && !strcaseeq(uri->host, req_uri->host))
	st = 0;
  else if (uri->port_given != NULL && uri->port != req_uri->port)
	st = 0;
  else {
	int exact;

	if ((dsv_req_path = uri_path_parse(req_uri->path)) == NULL) {
	  seterr_e(e, result,
			   "Invalid request URI in 'request_match' function");
	  return(-1);
	}

	exact = 0;
	if ((st = acs_match_url_segs(uri->path, dsv_req_path, &exact)) == -1) {
	  seterr_e(e, result,
			   "Error during URI match in 'request_match' function");
	  return(-1);
	}
	if (st != 0) {
	  /* Include the scheme/authority in the count, if given. */
	  if (*s != '/')
		st++;
	}
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = st;
  return(0);
}

#include "dacs_api.h"

/*
 * Test whether URI (the first argument) satisfies any rule in
 * RULESET (the second argument).
 * If no error occurs and the rule is satisified (i.e., it grants access),
 * return 1 and if the rule is not satisifed (i.e., it denies access),
 * return 0.
 * If an error occurs during rule processing, report that.
 */
static int
func_rule(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *host, *hostname, *object_url, *port, *s1, *s2, *str;
  struct hostent *he;
  struct in_addr addr;
  Acl_file *best;
  Arglist *x;
  Acs_environment *env;
  Acs_result res;
  Credentials *cr;
  Kwv *kwv, *kwv_args, *kwv_conf, *kwv_dacs;
  Uri *uri;

  x = arglist;
  s1 = x->result->value.val.strval;
  x = x->next;
  s2 = x->result->value.val.strval;

  if (*s1 == '/')
	object_url = ds_xprintf("file://%s", s1);
  else
	object_url = s1;

  if ((uri = uri_parse(object_url)) == NULL || uri->scheme == NULL) {
	seterr_e(e, result, "Invalid object name in 'rule' function");
	return(-1);
  }

  if ((kwv = var_ns_lookup_kwv(e->env->namespaces, "Conf")) != NULL)
	kwv_conf = kwv_copy(kwv);
  else
	kwv_conf = kwv_init(10);
  if ((kwv = var_ns_lookup_kwv(e->env->namespaces, "DACS")) != NULL)
	kwv_dacs = kwv_copy(kwv);
  else
	kwv_dacs = kwv_init(10);

  kwv_conf->dup_mode = KWV_REPLACE_DUPS;
  if (strcaseeq(uri->scheme, "https")) {
	str = ds_xprintf("HTTPS=on");
	kwv_add_str(kwv_dacs, str);
  }
  else
	kwv_delete(kwv_conf, "HTTPS");

  if (uri->host != NULL)
	host = uri->host;
  else {
	if (get_conf_from_host(NULL, &hostname, NULL, NULL, NULL) != -1
		&& hostname != NULL)
	  host = hostname;
	else
	  host = "localhost";
  }

  str = ds_xprintf("SERVER_NAME=%s", host);
  kwv_add_str(kwv_dacs, str);

  if ((he = gethostbyname(host)) != NULL
	  && he->h_addr_list != NULL && he->h_addr_list[0] != NULL) {
	addr = *(struct in_addr *) he->h_addr_list[0];
	str = ds_xprintf("SERVER_ADDR=%s", inet_ntoa(addr));
	kwv_add_str(kwv_dacs, str);
  }
  else
	log_msg((LOG_WARN_LEVEL, "Can't determine SERVER_ADDR for \"%s\"", host));

  if (uri->port_given != NULL)
	port = ds_xprintf("%d", uri->port);
  else {
	if (uri->scheme != NULL && strcaseeq(uri->scheme, "https"))
	  port = DEFAULT_HTTPS_PORT_NUMBER;
	else
	  port = DEFAULT_PORT_NUMBER;
  }
  str = ds_xprintf("HTTP_HOST=%s:%s", host, port);
  kwv_add_str(kwv_dacs, str);

  str = ds_xprintf("SERVER_PORT=%s", port);
  kwv_add_str(kwv_dacs, str);

  if (uri->path != NULL) {
	if (uri->query_string != NULL)
	  str = ds_xprintf("REQUEST_URI=%s?%s", uri->path, uri->query_string);
	else
	  str = ds_xprintf("REQUEST_URI=%s", uri->path);
	kwv_add_str(kwv_dacs, str);
  }

  str = ds_xprintf("DOCUMENT_ROOT=/");
  kwv_add_str(kwv_dacs, str);

  str = ds_xprintf("REQUEST_METHOD=GET");
  kwv_add_str(kwv_dacs, str);

  str = ds_xprintf("SERVER_SOFTWARE=dacsexpr-%s", DACS_VERSION_RELEASE);
  kwv_add_str(kwv_dacs, str);

  if ((cr = e->env->credentials) != NULL) {
	str = ds_xprintf("REMOTE_USER=%s",
					 auth_identity(cr->federation, cr->home_jurisdiction,
								   cr->username, NULL));
	kwv_add_str(kwv_dacs, str);
  }

  kwv_conf->dup_mode = KWV_NO_DUPS;

  if (uri->query_args != NULL) {
	kwv_args = query_args_to_kwv(uri->query_args);
	str = ds_xprintf("QUERY_STRING=%s", uri->query_string);
	kwv_add_str(kwv_dacs, str);
  }
  else
	kwv_args = NULL;

  env = init_env(s1, uri, kwv_conf, kwv_dacs);
  if (acs_init_env(NULL, kwv_args, uri->path, e->env->credentials, env)
	  == -1) {
	seterr_e(e, result, "Could not initialize environment in 'rule' function");
	return(-1);
  }

  best = NULL;
  acs_init_result(&res);
  if (acs_find_applicable_acl(s2, env, &best, ACL_DELEGATE_MAX, &res)
	  == -1) {
	seterr_e(e, result, "Error finding applicable rule in 'rule' function");
	return(-1);
  }
  if (res.m.nsegs_matched == 0) {
	seterr_e(e, result, "Cannot find applicable rule in 'rule' function");
	return(-1);
  }

  result->value.token = T_INTEGER;
  e->env->acl_rule = res.m.acl;
  if ((st = acl_grants_user(res.m.acl, env, &res.cr, &res)) != 1)
	result->value.val.intval = 0;
  else
	result->value.val.intval = 1;

  return(0);
}

/*
 * Operations on namespaces
 */
static int
func_setvar(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *format, *str, *ns_dst;
  Arglist *x;

  x = arglist;

  format = x->result->value.val.strval;
  x = x->next;

  ns_dst = x->result->value.val.strval;
  if (*ns_dst == '\0') {
	seterr_e(e, result, "Invalid destination namespace argument to 'setvar'");
	return(-1);
  }

  if (acs_is_readonly_namespace(ns_dst)) {
	seterr_e(e, result, "Cannot alter reserved namespace in 'setvar'");
	return(-1);	
  }
  x = x->next;

  /*
   * Parse a string according to the format and create variables in the
   * specified namespace.
   */

  if (strcaseeq(format, "delete")) {
	if (x != NULL) {
	  seterr_e(e, result, "Too many arguments to 'setvar'");
	  return(-1);
	}
	if (var_ns_delete(&e->env->namespaces, ns_dst) == -1) {
	  seterr_e(e, result,
			   "Invalid destination namespace argument to 'setvar'");
	  return(-1);
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = 0;
	return(0);
  }
  else if (strcaseeq(format, "copy")
		   || strcaseeq(format, "merge")
		   || strcaseeq(format, "rename")) {
	char *ns_src;
	Kwv *kwv_src, *kwv_dst;
	Var_ns *v;

	if (x == NULL) {
	  seterr_e(e, result, "Missing source namespace argument to 'setvar'");
	  return(-1);
	}
	if (x->next != NULL) {
	  seterr_e(e, result, "Too many arguments to 'setvar'");
	  return(-1);
	}

	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid source namespace argument to 'setvar'");
	  return(-1);
	}
	ns_src = x->result->value.val.strval;

	if ((v = var_ns_lookup(e->env->namespaces, ns_src)) == NULL) {
	  seterr_e(e, result, "Source namespace to 'setvar' does not exist");
	  return(-1);
	}
	kwv_src = v->kwv;

	if (strcaseeq(format, "merge")) {
	  kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst);
	  kwv_dst = kwv_merge(kwv_src, kwv_dst, KWV_REPLACE_DUPS);
	}
	else if (strcaseeq(format, "rename")) {
	  if (streq(ns_src, ns_dst)) {
		seterr_e(e, result,
				 "Source and destination namespaces are the same in 'setvar'");
		return(-1);
	  }

	  /* If the destination exists, delete it. */
	  if (var_ns_lookup(e->env->namespaces, ns_dst) != NULL) {
		if (var_ns_delete(&e->env->namespaces, ns_dst) == -1) {
		  seterr_e(e, result,
				   "Invalid destination namespace argument to 'setvar'");
		  return(-1);
		}
	  }

	  /* Now rename the source. */
	  v->ns = strdup(ns_dst);

	  result->value.token = T_INTEGER;
	  result->value.val.intval = kwv_count(v->kwv, NULL);
	  return(0);
	}
	else
	  kwv_dst = kwv_copy(kwv_src);

	if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
	  seterr_e(e, result, "Namespace copy in 'setvar' failed");
	  return(-1);
	}
	
	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
  else if (strcaseeq(format, "load")) {
	char *buf, *s1, *s2;
	unsigned int num;
	Dsvec *lines;
	Kwv *kwv_dst;

	/*
	 * Syntaxes:
	 * 1. setvar(load, <dst-namespace>, <filename>)
	 * 2. setvar(load, <dst-namespace>, <item_type> | <vfs_uri>, <key>)
	 * The "non-indexed" object will be split into lines and loaded into
	 * <dst-namespace> with indices 0..N-1
	 */
	if (x == NULL) {
	  seterr_e(e, result, "Missing file/URI argument to 'setvar'");
	  return(-1);
	}
	s1 = x->result->value.val.strval;
	x = x->next;
	if (*s1 == '\0') {
	  seterr_e(e, result, "Invalid argument to 'setvar' function");
	  return(-1);
	}

	if (x == NULL) {
	  if (load_file(s1, &buf, NULL) == -1) {
		seterr_e(e, result, ds_xprintf("Could not get file \"%s\"", s1));
		return(-1);
	  }
	}
	else {
	  Vfs_handle *h;

	  if (x->result->value.token != T_STRING) {
		seterr_e(e, result, "Invalid key argument to 'setvar' function");
		return(-1);
	  }
	  if (x->next != NULL) {
		seterr_e(e, result, "Too many arguments to 'setvar' function");
		return(-1);
	  }
	  s2 = x->result->value.val.strval;
	  if ((h = vfs_open_item_type(s1)) == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Could not open vfs for item type \"%s\" in 'setvar' function", s1));
		return(-1);
	  }
	  if (vfs_get(h, s2, (void **) &buf, NULL) == -1) {
		seterr_e(e, result,
				 ds_xprintf("Could not find item \"%s\" in 'setvar' function",
							s2));
		return(-1);
	  }

	  if (vfs_close(h) == -1) {
		seterr_e(e, result,
				 ds_xprintf("Close failed for item type \"%s\" in 'setvar' function", s1));
		return(-1);
	  }
	}

	if ((lines = strsplit_nocopy(buf, "\n", 0)) == NULL) {
	  seterr_e(e, result, "Could not parse file in 'setvar' function");
	  return(-1);
	}

	if ((kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst)) == NULL)
	  kwv_dst = kwv_init(dsvec_len(lines));
	kwv_set_mode(kwv_dst, "dr");

	for (num = 0; num < dsvec_len(lines); num++) {
	  char *line;

	  line = dsvec_ptr(lines, num, char *);
	  kwv_add_nocopy(kwv_dst, ds_xprintf("%u", num), line);
	}

	if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
	  seterr_e(e, result, "Namespace assignment in 'setvar' failed");
	  return(-1);
	}
	
	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
  else if (strcaseeq(format, "loadi")) {
	int i, n;
	char *s1;
	Dsvec *names;
	Kwv *kwv_dst;
	Vfs_handle *h;

	if (x == NULL) {
	  seterr_e(e, result, "Missing file/URI argument to 'setvar'");
	  return(-1);
	}
	s1 = x->result->value.val.strval;

	if (*s1 == '\0') {
	  seterr_e(e, result, "Invalid argument to 'setvar' function");
	  return(-1);
	}

	if (x->next != NULL) {
	  seterr_e(e, result, "Too many arguments to 'setvar' function");
	  return(-1);
	}

	if ((h = vfs_open_any(s1)) == NULL) {
	  Ds *err;

	  err = ds_init(NULL);
	  ds_asprintf(err, "Could not open VFS for vfs_uri \"%s\", ", s1);
	  ds_asprintf(err, "failed in 'vfs' function");
	  seterr_e(e, result, ds_buf(err));
	  return(-1);
	}

	names = NULL;
	if ((n = vfs_list(h, NULL, NULL, list_add, (void ***) &names)) == -1) {
	  seterr_e(e, result,
			   ds_xprintf("Could not list \"%s\" in 'setvar' function",
						  s1));
	  return(-1);
	}

	if ((kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst)) == NULL)
	  kwv_dst = kwv_init(dsvec_len(names));
	kwv_set_mode(kwv_dst, "dr");

	for (i = 0; i < n; i++) {
	  char *key, *value;
	  size_t length;

	  key = (char *) dsvec_ptr_index(names, i);
	  if (vfs_get(h, key, (void *) &value, &length) == -1) {
		seterr_e(e, result,
				 ds_xprintf("Could not get key \"%s\" in 'setvar' function",
							key));
		return(-1);
	  }
	  if (kwv_add(kwv_dst, key, value) == NULL) {
		seterr_e(e, result,
				 ds_xprintf("Could not add key \"%s\" in 'setvar' function",
							key));
		return(-1);
	  }
	}

	if (vfs_close(h) == -1) {
	  seterr_e(e, result,
			   ds_xprintf("Close failed for item type \"%s\" in 'setvar' function", s1));
	  return(-1);
	}

	if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
	  seterr_e(e, result, "Namespace assignment in 'setvar' failed");
	  return(-1);
	}
	
	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
  else if (strcaseeq(format, "kwv")) {
	Kwv *kwv_dst;
	Kwv_conf conf = {
	  "=", "\"'", NULL, KWV_CONF_DEFAULT, ",", 10, NULL, NULL
	};

	if (x == NULL) {
	  seterr_e(e, result,
			   "Missing kwv-sep-char argument to 'setvar' function");
	  return(-1);
	}
	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result,
			   "Invalid kwv-sep-char argument to 'setvar' function");
	  return(-1);
	}
	conf.sep = x->result->value.val.strval;
	if (strlen(conf.sep) > 1) {
	  seterr_e(e, result,
			   "Invalid kwv-sep-char argument to 'setvar' function");
	  return(-1);
	}

	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing sep-char argument to 'setvar' function");
	  return(-1);
	}
	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid sep-char argument to 'setvar' function");
	  return(-1);
	}
	conf.multi_mode = x->result->value.val.strval;

	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing string argument to 'setvar' function");
	  return(-1);
	}
	if (force_string(&x->result->value, &str) == -1) {
	  seterr_e(e, result, "Invalid string argument to 'setvar' function");
	  return(-1);
	}

	x = x->next;
	if (x != NULL) {
	  seterr_e(e, result, "Too many arguments to 'setvar' function");
	  return(-1);
	}

	/*
	 * If kwv_sepchar is not a null, it is a character that separates
	 * a keyword from its value; otherwise, there is no keyword and we'll
	 * generate them automatically starting with '1'.
	 * If not a null, sepchars is one or more characters, any of which
	 * separate one keyword/value (or just a value) from the next.
	 */
	kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst);
	if (kwv_dst != NULL)
	  kwv_set_mode(kwv_dst, "dr");
	kwv_dst = kwv_make_add(kwv_dst, str, &conf);

	if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
	  seterr_e(e, result, "Namespace assignment in 'setvar' failed");
	  return(-1);
	}
	
	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
  else if (strcaseeq(format, "query")) {
	Kwv *kwv_dst;

	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid string argument to 'setvar'");
	  return(-1);
	}
	str = x->result->value.val.strval;
	if (x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'setvar'");
	  return(-1);
	}

	kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst);
	if (kwv_dst == NULL)
	  kwv_dst = kwv_init(8);
	kwv_set_mode(kwv_dst, "dr");

	if ((kwv_dst = cgiparse_string(str, kwv_dst, NULL)) == NULL) {
	  seterr_e(e, result, "Error parsing string argument to 'setvar'");
	  return(-1);
	}

	if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
	  seterr_e(e, result, "Namespace assignment in 'setvar' failed");
	  return(-1);
	}
	
	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
  else if (strcaseeq(format, "post")) {
	Kwv *kwv_dst;

	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid string argument to 'setvar'");
	  return(-1);
	}
	str = x->result->value.val.strval;
	if (x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'setvar'");
	  return(-1);
	}

	kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst);
	if (kwv_dst == NULL)
	  kwv_dst = kwv_init(8);
	kwv_set_mode(kwv_dst, "dr");

	if (cgiparse(stdin, NULL, kwv_dst, NULL) == -1) {
	  seterr_e(e, result, "Error parsing string argument to 'setvar'");
	  return(-1);
	}

	if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
	  seterr_e(e, result, "Namespace assignment in 'setvar' failed");
	  return(-1);
	}
	
	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
  else if (strcaseeq(format, "split") || strcaseeq(format, "regsplit")) {
	unsigned int num;
	int is_split;
	long inc_delimit, limit;
	char *errmsg, *s2;
	Kwv *kwv_dst;
	Dsvec *lines;

	is_split = strcaseeq(format, "split");

	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid string argument to 'setvar'");
	  return(-1);
	}
	str = x->result->value.val.strval;
	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing string argument to 'setvar'");
	  return(-1);
	}

	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid string argument to 'setvar'");
	  return(-1);
	}
	s2 = x->result->value.val.strval;
	if (*s2 == '\0') {
	  seterr_e(e, result, "Invalid delimiter argument to 'setvar'");
	  return(-1);
	}

	limit = 0;
	inc_delimit = 0;
	x = x->next;
	if (x != NULL) {
	  if (integer_value(e, &x->result->value, &limit) == -1
		  || limit < 0) {
		seterr_e(e, result, "Invalid limit argument to 'setvar'");
		return(-1);
	  }

	  if (is_split && x->next != NULL) {
		x = x->next;
		if (integer_value(e, &x->result->value, &inc_delimit) == -1) {
		  seterr_e(e, result, "Invalid flag argument to 'setvar'");
		  return(-1);
		}
	  }

	  if (x->next != NULL) {
		seterr_e(e, result, "Invalid argument to 'setvar'");
		return(-1);
	  }
	}

	if (is_split) {
	  if ((lines = strsplitd(str, s2, (int) limit, (int) inc_delimit))
		  == NULL) {
		seterr_e(e, result, "strsplit failed in 'setvar'");
		return(-1);
	  }
	}
	else {
	  if ((lines = strsplit_re(str, s2, (int) limit, (int) inc_delimit,
							   &errmsg)) == NULL) {
		seterr_e(e, result,
				 ds_xprintf("strsplit_re failed in 'setvar': %s", errmsg));
		return(-1);
	  }
	}

	if ((kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst)) == NULL) {
	  kwv_dst = kwv_init(dsvec_len(lines));
	  kwv_set_mode(kwv_dst, "dr");
	}

	for (num = 0; num < dsvec_len(lines); num++) {
	  char *name, *val;
	  Kwv_pair pair;

	  /* Note: don't forget to add the xval (Value) component */
	  name = ds_xprintf("%u", num);
	  val = (char *) dsvec_ptr_index(lines, num);
	  kwv_set_pair(&pair, name, val, init_value(NULL, T_STRING, val));
	  kwv_add_pair(kwv_dst, &pair);
	}

	if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
	  seterr_e(e, result, "Namespace assignment in 'setvar' failed");
	  return(-1);
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
  else if (strcaseeq(format, "authorization")) {
	char *errmsg;
	Http_auth_authorization *aa;
	Kwv *kwv_dst;

	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid string argument to 'setvar'");
	  return(-1);
	}
	str = x->result->value.val.strval;
	if (x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'setvar'");
	  return(-1);
	}

	if ((aa = http_auth_authorization_parse(str, &errmsg)) == NULL) {
	  seterr_e(e, result, errmsg);
	  return(-1);
	}

	if ((kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst)) == NULL) {
	  kwv_dst = kwv_init(16);
	  kwv_set_mode(kwv_dst, "dr");
	  if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
		seterr_e(e, result, "Namespace assignment in 'setvar' failed");
		return(-1);
	  }
	}
	else
	  kwv_reset(kwv_dst);

	/* RFC 2617 3.2.2 */
	kwv_add(kwv_dst, "AUTH_SCHEME", non_null(aa->scheme_name));
	kwv_add(kwv_dst, "USERNAME", non_null(aa->username));
	kwv_add(kwv_dst, "PASSWORD", non_null(aa->password));
	kwv_add(kwv_dst, "REALM", non_null(aa->realm));
	kwv_add(kwv_dst, "NONCE", non_null(aa->nonce));
	kwv_add(kwv_dst, "DIGEST_URI", non_null(aa->digest_uri));
	kwv_add(kwv_dst, "RESPONSE", non_null(aa->response));
	kwv_add(kwv_dst, "ALGORITHM", non_null(aa->algorithm));
	kwv_add(kwv_dst, "CNONCE", non_null(aa->cnonce));
	kwv_add(kwv_dst, "OPAQUE", non_null(aa->opaque));
	kwv_add(kwv_dst, "MESSAGE_QOP", non_null(aa->message_qop));
	kwv_add(kwv_dst, "NONCE_COUNT", non_null(aa->nonce_count));
	kwv_add(kwv_dst, "AUTH_PARAM", non_null(aa->auth_param));

	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
  else if (strcaseeq(format, "uri")) {
	Kwv *kwv_dst;
	Uri *uri;

	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid string argument to 'setvar'");
	  return(-1);
	}
	str = x->result->value.val.strval;
	if (x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'setvar'");
	  return(-1);
	}

	if ((uri = uri_parse(str)) == NULL) {
	  seterr_e(e, result, "Invalid URI argument to 'setvar'");
	  return(-1);
	}

	if ((kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst)) == NULL) {
	  kwv_dst = kwv_init(8);
	  kwv_set_mode(kwv_dst, "dr");
	  if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
		seterr_e(e, result, "Namespace assignment in 'setvar' failed");
		return(-1);
	  }
	}
	else
	  kwv_reset(kwv_dst);

	if (uri->scheme != NULL)
	  kwv_add(kwv_dst, "SCHEME", uri->scheme);
	if (uri->authority != NULL)
	  kwv_add(kwv_dst, "AUTHORITY", uri->authority);
	if (uri->host != NULL)
	  kwv_add(kwv_dst, "HOST", uri->host);
	if (uri->port_given != NULL)
	  kwv_add(kwv_dst, "PORT", uri->port_given);
	if (uri->server != NULL)
	  kwv_add(kwv_dst, "SERVER", uri->server);
	if (uri->userinfo != NULL)
	  kwv_add(kwv_dst, "USERINFO", uri->userinfo);
	if (uri->path != NULL) {
	  int i;
	  Dsvec *dsv;

	  kwv_add(kwv_dst, "PATH", uri->path);
	  if ((dsv = strsplit(uri->path, "/", 0)) != NULL) {
		kwv_add(kwv_dst, "PATH_LENGTH", ds_xprintf("%lu", dsvec_len(dsv) - 1));
		for (i = 1; i < dsvec_len(dsv); i++)
		  kwv_add(kwv_dst,
				  ds_xprintf("PATH_%d", i - 1),
				  (char *) dsvec_ptr_index(dsv, i));
	  }
	}
	if (uri->query_string != NULL)
	  kwv_add(kwv_dst, "QUERY", uri->query_string);
	if (uri->fragment != NULL)
	  kwv_add(kwv_dst, "FRAGMENT", uri->fragment);

	result->value.token = T_INTEGER;
	result->value.val.intval = kwv_count(kwv_dst, NULL);
	return(0);
  }
#ifdef NOTDEF
  else if (strcaseeq(format, "xml")) {
	/*
	 * XXX This might be used to parse the attributes of an XML element into
	 * variables, or perhaps parse an entire XML data structure.
	 * Ex1: setvar(xml, Dog, '<dog tail="no" coat="blue merle"/>')
	 * ${Dog::tail} <-- "no", ${Dog::coat} <-- "blue merle"
	 * XXX check if an XML attribute name can be a DACS variable name
	 * Ex2: setvar(xml, Dog, '<dog tail="no" coat="blue merle">Blah</dog>')
	 * As above, plus ${Dog::CONTENT} <- "Blah"
	 * Ex3: setvar(xml, Dog, '<dog tail="no" coat="blue merle">Blah</dog>')
	 *      setvar(xml, Dog, '<dog tail="yes" coat="black tri">Woof</dog>')
	 * ${Dog1::tail} <-- "no", ${Dog1::coat} <-- "blue merle"
	 * ${Dog2::tail} <-- "yes", ${Dog2::coat} <-- "black tri"
	 * ${Dog1::CONTENT} <- "Blah"
	 * ${Dog2::CONTENT} <- "Woof"
	 * Ex4: setvar(xml, Dog, '<dog><breed>Collie</breed></dog>')
	 * ${Dog::child0} <- Dog::breed0
	 * ${Dog::breed0} <- "Collie"
	 * XXX Another function call might support XPointer/XQuery operations
	 * on the resulting parse tree
	 */
	if (x == NULL) {
	  seterr_e(e, result, "Missing string argument to 'setvar' function");
	  return(-1);
	}
	if (force_string(&x->result->value, &str) == -1) {
	  seterr_e(e, result, "Invalid string argument to 'setvar' function");
	  return(-1);
	}

	x = x->next;
	if (x != NULL) {
	  seterr_e(e, result, "Too many arguments to 'setvar' function");
	  return(-1);
	}

	/*
	 * The string argument is expected to be an XML document that
	 * describes a set of variable names and their values.
	 */
	seterr_e(e, result, "Function 'setvar' is not fully implemented");
	return(-1);
  }
#endif
  else {
	seterr_e(e, result, "Invalid format argument to 'setvar' function");
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = 1;
  return(0);
}

/*
 *
 */
static int
func_sizeof(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;
  Token t;

  x = arglist;
  s1 = x->result->value.val.strval;
  if ((t = typename_to_type(s1)) == T_UNDEF) {
	seterr_e(e, result, "Unrecognized typename in 'sizeof'");
	return(-1);
  }

  result->value.token = T_INTEGER;

  switch (t) {
  case T_INTEGER:
  case T_BOOL:
	result->value.val.intval = sizeof(result->value.val.intval);
	break;
	
  case T_REAL:
	result->value.val.intval = sizeof(result->value.val.realval);
	break;
	
  case T_STRING:
  case T_LITERAL:
	result->value.val.intval = 1;
	break;
	
  case T_BSTRING:
	result->value.val.intval = 1;
	break;

  default:
	return(-1);
  }

  return(0);
}

/*
 * Delays the caller
 * Usage: sleep(<seconds>)
 */
static int
func_sleep(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  unsigned int rem, secs;
  Arglist *x;

  x = arglist;
  secs = (unsigned int) x->result->value.val.intval;

  rem = sleep(secs);

  result->value.token = T_INTEGER;
  result->value.val.intval = rem;

  return(0);
}

static int
func_source(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *expr, *key, *vfs_uri;
  Arglist *x;
  Vfs_handle *h;

  x = arglist;
  vfs_uri = x->result->value.val.strval;
  x = x->next;

  if (*vfs_uri == '\0') {
	seterr_e(e, result, "Invalid argument to 'source' function");
	return(-1);
  }

  if (x != NULL) {
	key = x->result->value.val.strval;
	if (x->next != NULL) {
	  seterr_e(e, result, "Too many arguments to 'source' function");
	  return(-1);
	}
  }
  else
	key = NULL;

  if ((h = vfs_open_any(vfs_uri)) == NULL) {
	Ds *err;

	err = ds_init(NULL);
    ds_asprintf(err, "Could not open VFS for vfs_uri \"%s\", ", vfs_uri);
    ds_asprintf(err, "failed in 'source' function");
    seterr_e(e, result, ds_buf(err));
    return(-1);
  }

  if (vfs_get(h, key, (void **) &expr, NULL) == -1) {
	seterr_e(e, result,
			 ds_xprintf("Could not load expression using \"%s\" in 'source' function", vfs_uri));
	vfs_close(h);
	return(-1);
  }

  if (vfs_close(h) == -1) {
	seterr_e(e, result, ds_xprintf("Close failed in 'source' function"));
	return(-1);
  }

  return(func_expr(expr, -1, e->env, result));
}

/*
 * strptime(3) analog.
 * Usage:
 *     strptime(<datestr>, <formatstr>, <namespace>)
 *     strptime(<namespace>)
 */
static int
func_strptime(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *p, *s1, *s2, *ns_dst;
  struct tm *tm;
  time_t now, t;
  Arglist *x;
  Kwv *kwv_dst;
  Kwv_pair pair;

  x = arglist;
  if (x == NULL) {
	seterr_e(e, result, "Missing first argument to 'strptime' function");
	return(-1);
  }

  s1 = x->result->value.val.strval;
  x = x->next;

  if (x != NULL) {
	s2 = x->result->value.val.strval;
	x = x->next;
	if (x == NULL) {
	  seterr_e(e, result, "Missing namespace argument to 'strptime' function");
	  return(-1);
	}
	ns_dst = x->result->value.val.strval;

	x = x->next;
	if (x != NULL) {
	  seterr_e(e, result, "Invalid argument to 'strptime' function");
	  return(-1);
	}
  }
  else {
	ns_dst = s1;
	s1 = s2 = NULL;
  }

  time(&now);
  tm = localtime(&now);
  if (s1 != NULL) {
	if ((p = strptime(s1, s2, tm)) == NULL || *p != '\0') {
	  seterr_e(e, result, "Parse error in 'strptime' function");
	  return(-1);
	}
  }

  if ((t = mktime(tm)) == -1) {
	seterr_e(e, result, "Conversion error in 'strptime' function");
	return(-1);
  }

  kwv_dst = var_ns_lookup_kwv(e->env->namespaces, ns_dst);
  if (kwv_dst == NULL)
	kwv_dst = kwv_init(16);
  
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "clock",
										 ds_xprintf("%d", t),
										 init_expr_result(NULL, T_INTEGER,
														  t)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_sec",
										 ds_xprintf("%d", tm->tm_sec),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_sec)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_min",
										 ds_xprintf("%d", tm->tm_min),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_min)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_hour",
										 ds_xprintf("%d", tm->tm_hour),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_hour)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_mday",
										 ds_xprintf("%d", tm->tm_mday),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_mday)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_mon",
										 ds_xprintf("%d", tm->tm_mon),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_mon)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_year",
										 ds_xprintf("%d", tm->tm_year),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_year)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_wday",
										 ds_xprintf("%d", tm->tm_wday),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_wday)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_yday",
										 ds_xprintf("%d", tm->tm_yday),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_yday)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_isdst",
										 ds_xprintf("%d", tm->tm_isdst),
										 init_expr_result(NULL, T_INTEGER,
														  tm->tm_isdst)));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_zone",
										 tm_get_zone_name(tm),
										 init_expr_result(NULL, T_STRING,
														  tm_get_zone_name(tm))));
  kwv_replace_pair(kwv_dst, kwv_set_pair(&pair, "tm_gmtoff",
										 ds_xprintf("%ld", tm_get_gmtoff(tm)),
										 init_expr_result(NULL, T_INTEGER,
														  tm_get_gmtoff(tm))));

  if (var_ns_replace(&e->env->namespaces, ns_dst, kwv_dst) == -1) {
	seterr_e(e, result, "Namespace assignment in 'strptime' failed");
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = t;
  log_msg((LOG_TRACE_LEVEL, "Strptime of \"%s\" using \"%s\" is %d",
		   s1, s2, t));

  return(0);
}

/*
 * XXX Given that system(3) is susceptible to a variety of security problems,
 * I'm not sure that this should be implemented... perhaps if it is done
 * carefully and with certain restrictions (e.g., see perlsec(1)).
 */
static int
func_system(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;

  x = arglist;
  s1 = x->result->value.val.strval;

  seterr_e(e, result, "Attempt to execute unimplemented function: system");
  return(-1);
}

static int
func_syntax(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *type, *name, *charset_spec;
  Arglist *x;

  x = arglist;
  if (x == NULL) {
	seterr_e(e, result, "Missing type argument in 'syntax' function");
	return(-1);
  }
  type = x->result->value.val.strval;

  x = x->next;
  if (x == NULL) {
	seterr_e(e, result, "Missing name argument in 'syntax' function");
	return(-1);
  }
  name = x->result->value.val.strval;

  x = x->next;
  charset_spec = NULL;
  if (strcaseeq(type, "charset")) {
	if (x == NULL) {
	  seterr_e(e, result,
			   "Missing charset_spec argument in 'syntax' function");
	  return(-1);
	}
	charset_spec = x->result->value.val.strval;
	x = x->next;
  }

  if (x != NULL) {
	seterr_e(e, result, "Unexpected argument to 'syntax' function");
	return(-1);
  }

  st = 1;
  if (strcaseeq(type, "federation"))
	st = is_valid_federation_name(name);
  else if (strcaseeq(type, "jurisdiction"))
	st = is_valid_jurisdiction_name(name);
  else if (strcaseeq(type, "username"))
	st = is_valid_username(name);
  else if (strcaseeq(type, "uri"))
	st = (uri_parse(name) != NULL);
  else if (strcaseeq(type, "dacsname")) {
	DACS_name dacs_name;
	DACS_name_type nt;

	nt = parse_dacs_name(name, &dacs_name);
	switch (nt) {
	case DACS_USER_NAME: st = 1; break;
	case DACS_GROUP_NAME: st = 2; break;
	case DACS_JURISDICTION_NAME: st = 3; break;
	case DACS_FEDERATION_NAME: st = 4; break;
	case DACS_IP_NAME: st = 5; break;
	case DACS_UNKNOWN_NAME: default: st = 0; break;
	}
  }
  else if (strcaseeq(type, "group"))
	st = is_valid_name(name);
  else if (strcaseeq(type, "hostname"))
	st = is_valid_hostname(name);
  else if (strcaseeq(type, "emailaddr"))
	st = (rfc822_parse_address(name, NULL, NULL) != -1);
  else if (strcaseeq(type, "domainname"))
	st = looks_like_domain_name(name);
  else if (strcaseeq(type, "ipaddr")) {
	struct in_addr in;

	st = is_ip_addr(name, &in);
  }
  else if (strcaseeq(type, "role"))
	st = is_valid_role_str(name);
  else if (strcaseeq(type, "variable")) {
	char *ptr;

	if (var_parse_name(name, &ptr) == NULL || *ptr != '\0')
	  st = 0;
  }
  else if (strcaseeq(type, "varname")) {
	if (var_parse_ref(name) == NULL)
	  st = 0;
  }
  else if (strcaseeq(type, "namespace"))
	st = var_ns_is_valid_namespace_name(name);
  else if (strcaseeq(type, "expr")) {
	int save_do_eval;
	Expr_result *res;

	save_do_eval = e->do_eval;
	e->do_eval = 0;
	res = init_expr_result(result, T_UNDEF);
	if (func_expr(name, -1, e->env, res) == -1)
	  st = 0;
	e->do_eval = save_do_eval;
  }
  else if (strcaseeq(type, "charset")) {
	char *p;

	for (p = name; *p != '\0'; p++) {
	  if (!strtr_char((int) *p, charset_spec, 0)) {
		st = 0;
		break;
	  }
	}
  }
  else {
	seterr_e(e, result, "Invalid type argument to 'syntax' function");
	return(-1);
  }

  result->value.token = T_INTEGER;
  result->value.val.intval = st;

  return(0);
}

/*
 * Return information about the current time and date.
 * Usage: time(<timearg>[, <timeval>])
 */
static int
func_time(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;
  time_t now;
  struct tm *tm;

  x = arglist;
  s1 = x->result->value.val.strval;
  x = x->next;

  if (x != NULL) {
	long v;

	/*
	 * XXX If the second argument is not an integer, it should be treated
	 * as a namespace created by strptime() (i.e., a struct timeval).
	 */
	if (integer_value(e, &x->result->value, &v) == -1) {
	  Expr_result *val;
	  Kwv *kwv_src;
	  Kwv_pair *pair;

	  if (!str_or_lit(x->result->value.token)) {
		seterr_e(e, result, "Invalid second argument to 'time' function");
		return(-1);
	  }
	  kwv_src = var_ns_lookup_kwv(e->env->namespaces,
								  x->result->value.val.strval);
	  if (kwv_src == NULL || (pair = kwv_lookup(kwv_src, "clock")) == NULL) {
		seterr_e(e, result, "Invalid namespace argument to 'time' function");
		return(-1);
	  }
	  val = (Expr_result *) pair->xval;
	  if (val->value.token != T_INTEGER) {
		seterr_e(e, result, "Invalid 'clock' found in namespace");
		return(-1);
	  }
	  now = (time_t) val->value.val.intval;
	}
	else
	  now = (time_t) v;
	x = x->next;
  }
  else
	time(&now);

  if (*s1 == '\0' || x != NULL) {
	seterr_e(e, result, "Invalid argument to 'time' function");
	return(-1);
  }

  tm = localtime(&now);

  if (strcaseeq(s1, "now")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = now;
  }
  else if (strcaseeq(s1, "sec")
		   || strcaseeq(s1, "secs") || strcaseeq(s1, "seconds")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_sec;
  }
  else if (strcaseeq(s1, "min")
		   || strcaseeq(s1, "mins") || strcaseeq(s1, "minutes")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_min;
  }
  else if (strcaseeq(s1, "hour")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_hour;
  }
  else if (strcaseeq(s1, "mday")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_mday;
  }
  else if (strcaseeq(s1, "isleapyear")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = is_leap_year(tm->tm_year);
  }
  else if (strcaseeq(s1, "ismdaylast")) {
	int st;

	/*
	 * Is this the last day of the month?
	 * 0:Jan/31, 1:Feb/2?, 2:Mar/31, 3:Apr/30,  4:May/31,  5:Jun/30,
	 * 6:Jul/31, 7:Aug/31, 8:Sep/30, 9:Oct/31, 10:Nov/30, 11:Dec/31
	 */
	st = 0;
	if ((tm->tm_mon == 0 || tm->tm_mon == 2 || tm->tm_mon == 4
		 || tm->tm_mon == 6 || tm->tm_mon == 7 || tm->tm_mon == 9
		 || tm->tm_mon == 11) && tm->tm_mday == 31)
	  st = 1;
	else if ((tm->tm_mon == 3 || tm->tm_mon == 5 || tm->tm_mon == 8
			  || tm->tm_mon == 10) && tm->tm_mday == 30)
	  st = 1;
	else if (tm->tm_mon == 1
			 && (tm->tm_mday == (28 + is_leap_year(tm->tm_year))))
	  st = 1;

	result->value.token = T_INTEGER;
	result->value.val.intval = st;
  }
  else if (strcaseeq(s1, "mon") || strcaseeq(s1, "month")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_mon;
  }
  else if (strcaseeq(s1, "year")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_year + 1900;
  }
  else if (strcaseeq(s1, "wday")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_wday;
  }
  else if (strcaseeq(s1, "yday")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_yday;
  }
  else if (strcaseeq(s1, "isdst")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm->tm_isdst;
  }
  else if (strcaseeq(s1, "zone")) {
	result->value.token = T_STRING;
	result->value.val.strval = tm_get_zone_name(tm);
  }
  else if (strcaseeq(s1, "gmtoff")) {
	result->value.token = T_INTEGER;
	result->value.val.intval = tm_get_gmtoff(tm);
  }
  else {
	seterr_e(e, result, "Invalid argument to 'time' function");
	return(-1);
  }

  return(0);
}

static int
func_transform_config(Lex_state *e, int nargs, Arglist *arglist,
					  Expr_result *result)
{
  int i;
  char *flag, *p, *s1;
  Arglist *x;
  Dsvec *mk;
  Kwv *kwv_dacs;
  Mkargv conf = { 0, 0, " \t", NULL, NULL };
  Transform_config *tc, transform_config;
  Var_ns *env_ns;

  x = arglist;
  s1 = x->result->value.val.strval;

  if ((mk = ds_mkargv(NULL, s1, &conf)) == NULL) {
	seterr_e(e, result, "Invalid argument to 'transform_config' function");
	return(-1);
  }

  tc = transform_init(&transform_config);
  if ((kwv_dacs = var_ns_lookup_kwv(e->env->namespaces, "DACS")) != NULL)
	var_ns_new(&tc->env->namespaces, "DACS", kwv_dacs);
  if (dacs_conf != NULL && dacs_conf->conf_var_ns != NULL)
	var_ns_new(&tc->env->namespaces, dacs_conf->conf_var_ns->ns,
			   dacs_conf->conf_var_ns->kwv);
  if ((env_ns = var_ns_from_env("Env")) != NULL)
	var_ns_new(&tc->env->namespaces, "Env", env_ns->kwv);

  for (i = 0; i < dsvec_len(mk); i++) {
	if ((flag = (char *) dsvec_ptr_index(mk, i)) == NULL)
	  break;

	if (streq(flag, "-prefix")) {
	  if ((p = (char *) dsvec_ptr_index(mk, ++i)) == NULL) {
		seterr_e(e, result, "Invalid argument to 'transform_config' function");
		return(-1);
	  }
	  tc->directive_prefix = p;
	}
	else if (streq(flag, "-suffix")) {
	  if ((p = (char *) dsvec_ptr_index(mk, ++i)) == NULL) {
		seterr_e(e, result, "Invalid argument to 'transform_config' function");
		return(-1);
	  }
	  tc->directive_suffix = p;
	}
	else if (streq(flag, "-rprefix")) {
	  if ((p = (char *) dsvec_ptr_index(mk, ++i)) == NULL) {
		seterr_e(e, result, "Invalid argument to 'transform_config' function");
		return(-1);
	  }
	  tc->regex_prefix = p;
	}
	else if (streq(flag, "-rsuffix")) {
	  if ((p = (char *) dsvec_ptr_index(mk, ++i)) == NULL) {
		seterr_e(e, result, "Invalid argument to 'transform_config' function");
		return(-1);
	  }
	  tc->regex_suffix = p;
	}
	else {
	  seterr_e(e, result, "Invalid argument to 'transform_config' function");
	  return(-1);
	}
  }

  result->value.token = T_BSTRING;
  result->value.val.bval.data = memdupn(tc, sizeof(Transform_config));
  result->value.val.bval.len = sizeof(Transform_config);

  return(0);
}

/*
 * Usage 1: transform(<input>, <name>, <rules>, <docs>[, <idents>])
 * Usage 2: ${tc} = transform_config(<flag-str>)
 *          transform(<input>, ${tc}, <rules>, <docs>[, <idents>])
 */
static int
func_transform(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *errmsg, *idents, *input, *object_name, *rules, *docs;
  Arglist *x;
  Transform_config *tc, transform_config;

  tc = transform_init(&transform_config);

  x = arglist;
  input = x->result->value.val.strval;
  x = x->next;

  if (x->result->value.token == T_BSTRING) {
	if (x->result->value.val.bval.len != sizeof(Transform_config)) {
	  seterr_e(e, result,
			   "Unrecognized config argument to 'transform' function");
	  return(-1);
	}
	tc = (Transform_config *) x->result->value.val.bval.data;
	x = x->next;
  }

  object_name = x->result->value.val.strval;
  x = x->next;

  rules = x->result->value.val.strval;
  x = x->next;

  docs = x->result->value.val.strval;
  x = x->next;

  if (x != NULL) {
	idents = x->result->value.val.strval;
	x = x->next;
  }
  else
	idents = NULL;

  if (x != NULL) {
	seterr_e(e, result, "Invalid argument to 'transform' function");
	return(-1);
  }

  dsio_set(tc->ds_in, NULL, input, 0, 0);

  if (transform(tc, object_name, idents, &errmsg) == -1) {
	seterr_e(e, result, ds_xprintf("Error in 'transform': %s", errmsg));
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = ds_buf(tc->ds_out);

  return(0);
}

/*
 * Trim (delete) trailing characters.
 * Usage: trim(str, delete-set [,limit])
 * Delete each character in DELETE-SET (a strtr() type spec) that appears at
 * the end of STR, up to LIMIT characters - if LIMIT is zero, there is
 * no limit.
 * Return the new string.
 */
static int
func_trim(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int limit;
  char *delete_set, *p, *s1;
  Arglist *x;

  x = arglist;
  if (x == NULL || x->next == NULL) {
	seterr_e(e, result, "Missing argument to 'trim' function");
	return(-1);
  }

  s1 = x->result->value.val.strval;
  x = x->next;

  delete_set = x->result->value.val.strval;
  x = x->next;

  if (x != NULL)
	limit = x->result->value.val.intval;
  else
	limit = 0;

  if ((p = strtrim(s1, delete_set, limit)) == NULL) {
	seterr_e(e, result, "Error in 'trim' function");
	return(-1);
  }

  result->value.token = T_STRING;
  result->value.val.strval = p;

  return(0);
}

/*
 * Usage 1: typeof(<expr>) --> type-name
 * Usage 2: typeof(type-name, <expr>) --> boolean
 */
static int
func_typeof(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  char *s1;
  Arglist *x;

  x = arglist;
  if (x->next != NULL) {
	Token t;

	if (!str_or_lit(x->result->value.token)) {
	  seterr_e(e, result, "Invalid argument to 'typeof' function");
	  return(-1);
	}
	s1 = x->result->value.val.strval;

	x = x->next;
	if (x->next != NULL) {
	  seterr_e(e, result, "Invalid argument to 'typeof' function");
	  return(-1);
	}

	if ((t = typename_to_type(s1)) == T_UNDEF) {
	  seterr_e(e, result, "Invalid argument to 'typeof' function");
	  return(-1);
	}
	result->value.token = T_INTEGER;
	result->value.val.intval = (x->result->value.token == t);
  }
  else {
	result->value.token = T_STRING;
	result->value.val.strval = type_to_typename(x->result->value.token);
  }

  return(0);
}

int
is_undef(Value *value)
{

  return(value != NULL && value->token == T_UNDEF
		 && (value->val.strval == NULL
			 || (value->val.strval != NULL
				 && memcmp(value->val.strval, "undef()", 8) == 0)));
}

static int
func_undef(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{

  /* Returns an invalid literal. */
  result->value.token = T_UNDEF;
  result->value.val.strval = "undef()";

  return(0);
}

/*
 * var(get, namespace, varname[, altval])
 * var(delete, namespace, varname)
 * var(exists, namespace, varname)
 * var(set, namespace, varname)
 */
static int
func_var(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int undef;
  char *altval, *op, *ns, *varname;
  Arglist *x;
  Expr_result *vres;
  Var var;

  x = arglist;
  op = x->result->value.val.strval;

  x = x->next;
  ns = x->result->value.val.strval;
  if (!var_ns_is_valid_namespace_name(ns)) {
	seterr_e(e, result, "Invalid namespace argument in 'var' function");
	return(-1);
  }

  x = x->next;
  if (x == NULL) {
	seterr_e(e, result, "Missing argument to 'var' function");
	return(-1);
  }

  if (!str_or_lit(x->result->value.token)) {
	if (force_string(&x->result->value, &varname) == -1) {
	  seterr_e(e, result, "Invalid variable name argument in 'var' function");
	  return(-1);
	}
  }
  else
	varname = x->result->value.val.strval;
  if (!var_ns_is_valid_varname(varname, NULL)) {
	seterr_e(e, result, "Invalid variable name argument in 'var' function");
	return(-1);
  }

  x = x->next;

  if (strcaseeq(op, "delete")) {
	Kwv *kwv;

	if (x != NULL) {
	  seterr_e(e, result, "Too many arguments to 'var' function");
	  return(-1);
	}

	if ((kwv = var_ns_lookup_kwv(e->env->namespaces, ns)) == NULL
		|| kwv_lookup(kwv, varname) == NULL) {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = 0;
	}
	else {
	  result->value.token = T_INTEGER;
	  if (kwv_delete(kwv, varname) == -1) {
		seterr_e(e, result, "Error in 'var' function");
		return(-1);
	  }
	  result->value.val.intval = 1;
	}
  }
  else if (strcaseeq(op, "get")) {
	char *val;
	Ds *ds;

	if (x != NULL) {
	  if (!str_or_lit(x->result->value.token)) {
		if (force_string(&x->result->value, &altval) == -1) {
		  seterr_e(e, result, "Invalid altval argument in 'var' function");
		  return(-1);
		}
	  }
	  else
		altval = x->result->value.val.strval;
	  x = x->next;
	}
	else
	  altval = "";

	if (x != NULL) {
	  seterr_e(e, result, "Too many arguments to 'var' function");
	  return(-1);
	}

	var.ns = ns;
	var.name = varname;
	var.flagstr = NULL;
	var.flags = VAR_DEFAULT_FLAG | VAR_ALTVAL_FLAG;
	var.altval = altval;
	vres = NULL;
	if ((ds = acs_variable_resolve(&var, e->env, &vres, &undef)) == NULL) {
	  seterr_e(e, result, "Undefined variable reference in 'var' function");
	  return(-1);
	}
	val = ds_buf(ds);

	if (vres != NULL)
	  copy_value(&result->value, &vres->value);
	else {
	  result->value.token = T_STRING;
	  result->value.val.strval = val;
	  result->value.is_quoted = 0;
	}
  }
  else if (strcaseeq(op, "exists")) {
	Kwv *kwv;

	if (x != NULL) {
	  seterr_e(e, result, "Too many arguments to 'var' function");
	  return(-1);
	}

	if ((kwv = var_ns_lookup_kwv(e->env->namespaces, ns)) == NULL
		|| kwv_lookup(kwv, varname) == NULL) {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = 0;
	}
	else {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = 1;
	}
  }
  else if (strcaseeq(op, "set")) {
	char *val;

	if (x == NULL) {
	  seterr_e(e, result, "Missing value argument to 'var' function");
	  return(-1);
	}

	if (!str_or_lit(x->result->value.token)) {
	  if (force_string(&x->result->value, &val) == -1) {
		seterr_e(e, result, "Invalid value argument in 'var' function");
		return(-1);
	  }
	}
	else
	  val = x->result->value.val.strval;

	if (x->next != NULL) {
	  seterr_e(e, result, "Too many arguments to 'var' function");
	  return(-1);
	}

	if (var_ns_lookup(e->env->namespaces, ns) == NULL) {
	  if (var_ns_new(&e->env->namespaces, ns, NULL) == NULL) {
		seterr_e(e, result, "Error in 'var' function");
		return(-1);
	  }
	}

	if (var_ns_add_var(e->env->namespaces, ns, varname, val,
					   copy_result(NULL, x->result)) == NULL) {
	  seterr_e(e, result, "Error in 'var' function");
	  return(-1);
	}

	copy_value(&result->value, &x->result->value);
  }
  else {
	seterr_e(e, result, "Unrecognized operation in 'var' function");
	return(-1);
  }

  return(0);
}

/*
 * Virtual filestore access
 * Usage: vfs(<op>, <item_type>[, arg]...)
 */
static int
func_vfs(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
  int st;
  char *buf, *item_type, *key, *name, *opname, *s1;
  Arglist *x;
  Ds *err;
  Vfs_conf *conf;
  Vfs_directive *vd;
  Vfs_handle *h;
  Vfs_op op;

  x = arglist;
  opname = x->result->value.val.strval;

  if ((op = vfs_lookup_op(opname)) == VFS_UNKNOWN) {
	seterr_e(e, result, "Unrecognized op argument to 'vfs' function");
	return(-1);
  }

  if (op == VFS_OPEN || op == VFS_CLOSE) {
	seterr_e(e, result, "Invalid op argument to 'vfs' function");
	return(-1);
  }
  log_msg((LOG_TRACE_LEVEL, "vfs op=\"%s\"", opname));

  x = x->next;
  if (op == VFS_ENABLED) {
	char *store_name;

	if (x == NULL) {
	  int i;
	  Dsvec *dsv;
	  Value *vv;

	  dsv = vfs_enabled_list();
	  dsvec_sort(dsv, NULL);
	  result->value.token = T_LIST;
	  result->value.val.listval.list = dsvec_init(NULL, sizeof(Value *));
	  result->value.val.listval.dim = NULL;
	  for (i = 0; i < dsvec_len(dsv); i++) {
		store_name = (char *) dsvec_ptr_index(dsv, i);
		vv = init_value(NULL, T_STRING, store_name);
		dsvec_add_ptr(result->value.val.listval.list, vv);
	  }

	  return(0);
	}

	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid store-name argument to 'vfs' function");
	  return(-1);
	}
	store_name = x->result->value.val.strval;
	result->value.token = T_INTEGER;
	result->value.val.intval = vfs_enabled(store_name);

	return(0);
  }

  if (op == VFS_DEFINED || op == VFS_URI) {
	if (x == NULL) {
	  seterr_e(e, result, "Missing item-type argument to 'vfs' function");
	  return(-1);
	}
	if (x->result->value.token != T_STRING) {
	  seterr_e(e, result, "Invalid item-type argument to 'vfs' function");
	  return(-1);
	}

	item_type = x->result->value.val.strval;
	vd = vfs_lookup_item_type(item_type);

	if (op == VFS_DEFINED) {
	  result->value.token = T_INTEGER;
	  if (vd == NULL)
		result->value.val.intval = 0;
	  else {
		result->value.val.intval = 1;
		/* XXX not freed */
	  }
	}
	else {
	  result->value.token = T_STRING;
	  if (vd == NULL)
		result->value.val.strval = "";
	  else {
		result->value.val.strval = strdup(vd->uri_str);
		/* XXX not freed */
	  }
	}

	return(0);
  }

  if (x == NULL) {
	seterr_e(e, result, "Missing vfs-ref argument to 'vfs' function");
	return(-1);
  }
  if (x->result->value.token != T_STRING) {
	seterr_e(e, result, "Invalid vfs-ref argument to 'vfs' function");
	return(-1);
  }
  name = x->result->value.val.strval;
  x = x->next;

  err = ds_init(NULL);
  key = NULL;
  s1 = NULL;
  if (x != NULL) {
	/* Either a value or a key then a value is expected */
	if (op != VFS_PUT || x->next != NULL) {
	  if (force_string(&x->result->value, &key) == -1) {
		seterr_e(e, result, "Invalid key argument to 'vfs' function");
		return(-1);
	  }
	  x = x->next;
	}

	if (x != NULL) {
	  if (force_string(&x->result->value, &s1) == -1) {
		seterr_e(e, result, "Invalid argument to 'vfs' function");
		return(-1);
	  }
	  x = x->next;

	  if (x != NULL) {
		seterr_e(e, result, "Too many arguments to 'vfs' function");
		return(-1);
	  }
	}
  }

  conf = vfs_conf(NULL);
  conf->null_flag = 0;
  conf->create_flag = (op != VFS_EXISTS && op != VFS_DELETE
					   && op != VFS_RENAME);
  vfs_conf(conf);

  if ((h = vfs_open_any(name)) == NULL) {
	ds_asprintf(err, "Could not open VFS for vfs_uri \"%s\", ", name);
	ds_asprintf(err, "failed in 'vfs' function");
	seterr_e(e, result, ds_buf(err));
	return(-1);
  }

  switch (op) {
  case VFS_GET:
	if (s1 != NULL) {
	  ds_asprintf(err,
				  "Too many arguments to 'get' for key \"%s\" ,", key);
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	if (vfs_get(h, key, (void **) &buf, NULL) == -1) {
	  ds_asprintf(err, "Error during 'get' for key \"%s\", ", key);
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	result->value.token = T_STRING;
	result->value.val.strval = strtrim(buf, "\n", 0);
	break;

  case VFS_GETSIZE:
	{
	  size_t length;

	  if (s1 != NULL) {
		ds_asprintf(err, "Too many arguments to 'getsize' for key \"%s\" ,",
					key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }

	  if (vfs_getsize(h, key, &length) == -1) {
		ds_asprintf(err, "Error during 'getsize' for key \"%s\", ", key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }

	  result->value.token = T_INTEGER;
	  result->value.val.intval = length;
	  break;
	}

  case VFS_EXISTS:
	if (s1 != NULL) {
	  ds_asprintf(err,
				  "Too many arguments to 'exists' for key \"%s\" ,", key);
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	if ((st = vfs_exists(h, key)) == -1) {
	  ds_asprintf(err, "Error during 'exists' for key \"%s\", ", key);
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = (st > 0);
	break;

  case VFS_DELETE:
	if (s1 != NULL) {
	  ds_asprintf(err,
				  "Too many arguments to 'delete' for key \"%s\" ,", key);
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	if (vfs_delete(h, key) == -1) {
	  ds_asprintf(err, "Error during 'delete' for key \"%s\", ", key);
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = 1;
	break;

  case VFS_CONTROL:
	{
	  char *c_arg;
	  Vfs_control_op c_op;

	  c_arg = NULL;
	  if (strcaseeq(key, "flush"))
		c_op = VFS_FLUSH_DATA;
	  else if (strcaseeq(key, "get_container")) {
		c_op = VFS_GET_CONTAINER;
		ds_asprintf(err, "Unimplemented 'control' operation \"%s\", ", key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }
	  else if (strcaseeq(key, "set_cookies")) {
		c_op = VFS_SET_COOKIES;
		/* XXX one or more cookie arguments should follow... */
		ds_asprintf(err, "Unimplemented 'control' operation \"%s\", ", key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }
	  else if (strcaseeq(key, "set_field_sep")) {
		c_op = VFS_SET_FIELD_SEP;
		if (x == NULL || x->result->value.token != T_STRING
			|| x->next != NULL) {
		  return(-1);
		}
		c_arg = x->result->value.val.strval;
		x = x->next;
	  }
	  else if (strcaseeq(key, "set_lock")) {
		c_op = VFS_SET_LOCK;
		/* XXX a lock mode specifier should follow... */
		ds_asprintf(err, "Unimplemented 'control' operation \"%s\", ", key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }
	  else {
		ds_asprintf(err, "Unrecognized 'control' operation \"%s\", ", key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }

	  if ((st = vfs_control(h, c_op, s1, c_arg)) == -1) {
		ds_asprintf(err, "Error during 'control', ");
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }

	  result->value.token = T_INTEGER;
	  result->value.val.intval = st;
	  break;
	}

  case VFS_PUT:
	if (s1 == NULL) {
	  ds_asprintf(err, "Missing value argument for 'put' for key \"%s\" ,",
				  key);
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	/* Make the value null-terminated. */
	if (vfs_put(h, key, s1, strlen(s1) + 1) == -1) {
		ds_asprintf(err, "Error during 'put' for key \"%s\", ", key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = 1;
	break;

  case VFS_RENAME:
	if (key == NULL) {
	  ds_asprintf(err, "Missing oldkey argument for 'rename' - ");
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}
	if (s1 == NULL) {
	  ds_asprintf(err, "Missing newkey argument for 'rename' - ");
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}
	if (vfs_rename(h, key, s1) == -1) {
	  ds_asprintf(err, "Error during 'rename' for oldkey \"%s\", ", key);
	  ds_asprintf(err, "failed in 'vfs' function: %s",
				  h->error_msg != NULL ? h->error_msg : "");
	  seterr_e(e, result, ds_buf(err));
	  vfs_close(h);
	  return(-1);
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = 1;
	break;

  case VFS_LIST:
	{
	  int st;
	  Ds ds;
	  Dsvec *names;

	  if (key != NULL || s1 != NULL) {
		ds_asprintf(err, "Too many arguments to 'list' for key \"%s\" ,", key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }

	  names = NULL;
	  st = vfs_list(h, NULL, NULL, list_add, (void ***) &names);
	  if (st == -1) {
		ds_asprintf(err, "Error during 'list' for key \"%s\", ", key);
		ds_asprintf(err, "failed in 'vfs' function: %s",
					h->error_msg != NULL ? h->error_msg : "");
		seterr_e(e, result, ds_buf(err));
		vfs_close(h);
		return(-1);
	  }

	  if (names == NULL) {
		result->value.token = T_STRING;
		result->value.val.strval = "";
	  }
	  else {
		unsigned int ui;

		ds_init(&ds);
		for (ui = 0; ui < dsvec_len(names); ui++)
		  ds_asprintf(&ds, "%s%s", (ui == 0) ? "" : "\n",
					  (char *) dsvec_ptr_index(names, ui));

		result->value.token = T_STRING;
		result->value.val.strval = ds_buf(&ds);
	  }
	  break;
	}

  default:
	seterr_e(e, result, "Unimplemented op argument to 'vfs' function");
	vfs_close(h);
	return(-1);
  }

  if (vfs_close(h) == -1) {
	ds_asprintf(err, "Close failed for item type \"%s\"", s1);
	ds_asprintf(err, "failed in 'vfs' function: %s",
				h->error_msg != NULL ? h->error_msg : "");
	seterr_e(e, result, ds_buf(err));
	return(-1);
  }

  return(0);
}

#ifdef NOTDEF
/*
 * Manage namespaces, such as setting attributes (e.g., read-only), scope,
 * testing existence, deleting, etc.
 */
static int
func_namespace(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{
}

/*
 * Return information about credentials.
 */
static int
func_credentials(Lex_state *e, int nargs, Arglist *arglist,
				 Expr_result *result)
{

}

/*
 * Return information about the request:
 * the remote IP address, the remote domain name(s), user agent, method.
 */
static int
func_request(Lex_state *e, int nargs, Arglist *arglist, Expr_result *result)
{

}
#endif

static Func_info *
lookup_function(char *name)
{
  Func_info *fi;
  Kwv_pair *pair;

#ifdef NOTDEF
  if (module_lookup_function(name, NULL, NULL) != -1) {
	log_msg((LOG_TRACE_LEVEL,
			 "Calling dynamically loaded function: %s", name));
	return(NULL);
  }
#endif

  if (kwv_func == NULL) {
	if ((kwv_func = init_funcs()) == NULL)
	  return(NULL);
  }

  fi = NULL;
  if (kwv_func != NULL && (pair = kwv_lookup(kwv_func, name)) != NULL)
	fi = (Func_info *) pair->xval;
  return(fi);
}

/*
 * Evaluate function calls
 */
static int
eval_function(char *name, Lex_state *e, Arglist *args, Expr_result *result)
{
  int nargs, st;
  Func_info *fi;

  if ((fi = lookup_function(name)) == NULL) {
	seterr_e(e, result,
			 ds_xprintf("Unrecognized function name: \"%s\"", name));
	return(-1);
  }

  if ((nargs = validate_func_call(e, fi, args)) == -1) {
	seterr_e(e, result, ds_xprintf("Invalid function call: \"%s\"", name));
	return(-1);
  }

  result->err = ACS_EXPR_FALSE;
  result->errmsg = NULL;

  if (!e->do_eval)
	return(0);

  /*
   * XXX Maybe store a copy of the result of any successful function call
   * in ${Expr::result} so that it can be referenced later.
   */
  st = fi->func(e, nargs, args, result);
  if (st == -1)
	return(-1);

  return(0);
}

/*
 * Evaluate unary operators
 */
static int
eval1(Lex_state *e, Expr_result *result, Token op, Expr_result *r1)
{
  long l1, val;
  double real1;

  if (!e->do_eval)
	return(0);

  val = 0;

  switch (op) {
  case T_UNARY_MINUS:
	if (integer_value(e, &r1->value, &l1) != -1) {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = -l1;
	}
	else if (real_value(e, &r1->value, &real1) != -1) {
	  result->value.token = T_REAL;
	  result->value.val.realval = -real1;
	}
    else
	  seterr_s(e, result, "Invalid unary minus operand");
    break;

  case T_UNARY_PLUS:
	if (integer_value(e, &r1->value, &l1) != -1) {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = l1;
	}
	else if (real_value(e, &r1->value, &real1) != -1) {
	  result->value.token = T_REAL;
	  result->value.val.realval = real1;
	}
    else
	  seterr_s(e, result, "Invalid unary plus operand");
    break;

  case T_NOT:
	if (r1->value.token == T_INTEGER) {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = (r1->value.val.intval == 0);
	}
	else if (r1->value.token == T_REAL) {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = (r1->value.val.realval == 0.0);
	}
	else if (r1->value.token == T_STRING) {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = !(r1->value.val.strval[0] != '\0');
	}
	else
	  seterr_s(e, result, "Invalid unary not operand");
	break;

  case T_BITCPL:
	if (integer_value(e, &r1->value, &l1) != -1) {
	  result->value.token = T_INTEGER;
	  result->value.val.intval = ~l1;
	}
	else {
	  seterr_s(e, result, "Invalid unary operand");
	  return(-1);
	}
	break;

  case T_CAST:
	/*
	 * The type of the result is the type we are converting to.
	 * The type of the argument is the type we are converting from.
	 * The caller has already set RESULT to the target type.
	 */
	switch (result->value.token) {
	case T_INTEGER:
	  if (force_integer(e, r1, &result->value.val.intval) == -1) {
		seterr_s(e, result, "Invalid integer type cast");
		return(-1);
	  }
	  break;

	case T_REAL:
	  if (force_real(r1, &result->value.val.realval) == -1) {
		seterr_s(e, result, "Invalid real type cast");
		return(-1);
	  }
	  break;

	case T_STRING:
	  if (force_string(&r1->value, &result->value.val.strval) == -1) {
		seterr_s(e, result, "Invalid string type cast");
		return(-1);
	  }
	  break;

	case T_BOOL:
	  if (lboolean_value(r1, &result->value.val.intval) == -1) {
		seterr_s(e, result, "Invalid boolean type cast");
		return(-1);
	  }
	  result->value.token = T_INTEGER;
	  break;

	case T_BSTRING:
	  if (force_bstring(r1, &result->value.val.bval) == -1) {
		seterr_s(e, result, "Invalid bstring type cast");
		return(-1);
	  }
	  break;

	case T_LIST:
	  /* Convert an alist to a list. */
	  if (force_list(&r1->value, &result->value.val.listval) == -1) {
		seterr_s(e, result, "Invalid list type cast");
		return(-1);
	  }
	  break;

	case T_ALIST:
	  /* Convert a list to an alist, if possible. */
	  if (force_alist(e, r1, &result->value.val.alistval) == -1) {
		seterr_s(e, result, "Invalid alist type cast");
		return(-1);
	  }
	  break;

	case T_VOID:
	  result->value.token = T_VOID;
	  break;

	default:
	  seterr_s(e, result, "Unrecognized type cast");
	  return(-1);
	  /*NOTREACHED*/
	}
	break;

  default:
	seterr_s(e, result, "Unrecognized unary operator");
	break;
  }

  if (result->err < 0)
	return(-1);

  return(0);
}

/*
 * No check for overflow
 */
static long
lpower(long a, long b)
{
  int i;
  long val;

  if (b < 0L)
	return(0L);

  if (b == 0L)
	return(1L);
  val = 1L;
  for (i = 0; i < b; i++)
	val *= a;

  return(val);
}

static int
indexset(char *s1, char *s2, int icase)
{
  size_t n;

  if (icase)
	n = strcasecspn(s1, s2);
  else
	n = strcspn(s1, s2);

  if (n == strlen(s1))
	n = 0;
  else
	n++;

  return((int) n);
}

static int
list_eq(Value *v1, Value *v2, int icase)
{
  unsigned int i, len;

  if (v1->token != T_LIST || v2->token != T_LIST)
	return(-1);

  if ((len = dsvec_len(v1->val.listval.list))
	  != dsvec_len(v2->val.listval.list))
	return(0);

  for (i = 0; i < len; i++) {
	Value *va, *vb;

	va = (Value *) dsvec_ptr_index(v1->val.listval.list, i);
	vb = (Value *) dsvec_ptr_index(v2->val.listval.list, i);
	if (va->token != vb->token)
	  return(0);

	switch (va->token) {
	case T_INTEGER:
	  if (va->val.intval != vb->val.intval)
		return(0);
	  break;

	case T_STRING:
	case T_LITERAL:
	  if (icase) {
		if (!strcaseeq(va->val.strval, vb->val.strval))
		  return(0);
	  }
	  else {
		if (!streq(va->val.strval, vb->val.strval))
		  return(0);
	  }
	  break;

	case T_BSTRING:
	  if (va->val.bval.len != vb->val.bval.len)
		return(0);
	  if (memcmp(va->val.bval.data, va->val.bval.data, va->val.bval.len) != 0)
		return(0);
	  break;

	case T_REAL:
	  if (va->val.realval != vb->val.realval)
		return(0);
	  break;

	case T_LIST:
	  if (!list_eq(va, vb, icase))
		return(0);
	  break;

	case T_ALIST:
	  if (!alist_eq(va, vb, icase))
		return(0);
	  break;

	default:
	  return(-1);
	}
  }

  return(1);
}

/*
 * Two alists are equal if they both have exactly the same keys
 * with the same values.
 */
static int
alist_eq(Value *v1, Value *v2, int icase)
{
  unsigned int len;
  Kwv_iter *iter;
  Kwv_pair *pair1, *pair2;

  if (v1->token != T_ALIST || v2->token != T_ALIST)
	return(-1);

  if ((len = kwv_count(v1->val.alistval.kwv, NULL))
	  != kwv_count(v2->val.alistval.kwv, NULL))
	return(0);

  iter = kwv_iter_begin(v1->val.alistval.kwv, NULL);
  for (pair1 = kwv_iter_first(iter); pair1 != NULL;
	   pair1 = kwv_iter_next(iter)) {
	Value *va, *vb;

	if ((pair2 = kwv_lookup(v2->val.alistval.kwv, pair1->name)) == NULL)
	  return(0);
	va = (Value *) pair1->xval;
	vb = (Value *) pair2->xval;
	if (va->token != vb->token)
	  return(0);

	switch (va->token) {
	case T_INTEGER:
	  if (va->val.intval != vb->val.intval)
		return(0);
	  break;

	case T_STRING:
	case T_LITERAL:
	  if (icase) {
		if (!strcaseeq(va->val.strval, vb->val.strval))
		  return(0);
	  }
	  else {
		if (!streq(va->val.strval, vb->val.strval))
		  return(0);
	  }
	  break;

	case T_BSTRING:
	  if (va->val.bval.len != vb->val.bval.len)
		return(0);
	  if (memcmp(va->val.bval.data, va->val.bval.data, va->val.bval.len) != 0)
		return(0);
	  break;

	case T_REAL:
	  if (va->val.realval != vb->val.realval)
		return(0);
	  break;

	case T_LIST:
	  if (!list_eq(va, vb, icase))
		return(0);
	  break;

	case T_ALIST:
	  if (!alist_eq(va, vb, icase))
		return(0);
	  break;

	default:
	  return(-1);
	}
  }

  kwv_iter_end(iter);

  return(1);
}

static MAYBE_UNUSED void
list_free(List list)
{

  dsvec_free(list.list);
}

static MAYBE_UNUSED void
alist_free(Alist Alist)
{

  kwv_free(Alist.kwv);
}

/*
 * Evaluate binary operators
 * Note that RESULT may be the same as R1 or R2, so RESULT must not be
 * modified until after R1 and R2 are no longer needed during evaluation.
 */
static int
eval2(Lex_state *e, Expr_result *result, Token op, Expr_result *r1,
	  Expr_result *r2)
{
  int i1, i2;
  long l1, l2, val;
  double real1, real2, rval;
  char *s1, *s2;
  Value *arg1, *arg2;

  if (!e->do_eval)
	return(0);

  val = 0;

  switch (op) {
  case T_OR:
  case T_AND:
	/*
	 * These are actually handled while parsing, because of their special
	 * semantics, but this evaluation code might still be useful.
	 */
	if (boolean_value(r1, &i1) == -1 || boolean_value(r2, &i2) == -1) {
	  seterr_s(e, result, "Invalid operand");
	  return(-1);
	}

	if (op == T_OR) {
	  if (i1 || i2) {
		result->value.val.intval = 1L;
		result->value.token = T_INTEGER;
	  }
	  else {
		result->value.val.intval = 0L;
		result->value.token = T_INTEGER;
	  }
	}
	else if (op == T_AND) {
	  if (i1 && i2) {
		result->value.val.intval = 1L;
		result->value.token = T_INTEGER;
	  }
	  else {
		result->value.val.intval = 0L;
		result->value.token = T_INTEGER;
	  }
	}
	else {
	  seterr_e(e, result, "Code botch");
	  return(-1);
	}

	break;

  case T_LT:
  case T_LE:
  case T_EQ:
  case T_NE:
  case T_GE:
  case T_GT:
  case T_LT_I:
  case T_LE_I:
  case T_EQ_I:
  case T_NE_I:
  case T_GE_I:
  case T_GT_I:
#ifdef NOTDEF
	if (integer_value(e, &r1->value, &l1) != -1
		&& integer_value(e, &r2->value, &l2) != -1) {
	  ;
	}
	else if (real_value(e, &r1->value, &real1) != -1
			 && real_value(e, &r2->value, &real2) != -1) {
	  l2 = 0L;
	  if (op == T_LT || op == T_LT_I)
		l1 = (real1 < real2) ? -1 : 1;
	  else if (op == T_LE || op == T_LE_I)
		l1 = (real1 <= real2) ? -1 : 1;
	  else if (op == T_EQ || op == T_EQ_I)
		l1 = (real1 == real2) ? 0 : 1;
	  else if (op == T_NE || op == T_NE_I)
		l1 = (real1 != real2) ? -1 : 0;
	  else if (op == T_GE || op == T_GE_I)
		l1 = (real1 >= real2) ? 1 : 0;
	  else if (op == T_GT || op == T_GT_I)
		l1 = (real1 > real2) ? 1 : 0;
	  else {
		seterr_e(e, result, "Code botch");
		return(-1);
	  }
	}
	else if (string_value(e, &r1->value, &s1) != -1
			 && string_value(e, &r2->value, &s2) != -1) {
	  /* Do a string comparison */
	  if (op == T_LT_I || op == T_LE_I || op == T_EQ_I || op == T_NE_I
		  || op == T_GE_I || op == T_GT_I)
		l1 = strcasecmp(s1, s2);
	  else
		l1 = strcmp(s1, s2);
	  l2 = 0L;
	}
	else if (r1->value.token == T_BSTRING && r2->value.token == T_STRING) {
	  size_t len2;

	  /* Do a binary string comparison */
	  len2 = strlen(r2->value.val.strval);
	  if (r1->value.val.bval.len < len2)
		l1 = -1;
	  else if (r1->value.val.bval.len > len2)
		l1 = 1;
	  else
		l1 = memcmp(r1->value.val.bval.data, r2->value.val.strval, len2);
	  l2 = 0L;
	}
	else if (r1->value.token == T_STRING && r2->value.token == T_BSTRING) {
	  size_t len1;

	  /* Do a binary string comparison */
	  len1 = strlen(r1->value.val.strval);
	  if (len1 < r2->value.val.bval.len)
		l1 = -1;
	  else if (len1 > r2->value.val.bval.len)
		l1 = 1;
	  else
		l1 = memcmp(r1->value.val.strval, r2->value.val.bval.data, len1);
	  l2 = 0L;
	}
	else if (r1->value.token == T_BSTRING && r2->value.token == T_BSTRING) {
	  /* Do a binary string comparison */
	  if (r1->value.val.bval.len < r2->value.val.bval.len)
		l1 = -1;
	  else if (r1->value.val.bval.len > r2->value.val.bval.len)
		l1 = 1;
	  else
		l1 = memcmp(r1->value.val.bval.data, r2->value.val.bval.data,
					r2->value.val.bval.len);
	  l2 = 0L;
	}
	else if ((op == T_EQ || op == T_NE || op == T_EQ_I || op == T_NE_I)
			 && r1->value.token == T_LIST && r2->value.token == T_LIST) {
	  int icase;

	  icase = (op == T_EQ_I || op == T_NE_I);
	  l1 = (long) list_eq(&r1->value, &r2->value, icase);
	  l2 = 1L;
	}
	else if ((op == T_EQ || op == T_NE || op == T_EQ_I || op == T_NE_I)
			 && r1->value.token == T_ALIST && r2->value.token == T_ALIST) {
	  int icase;

	  icase = (op == T_EQ_I || op == T_NE_I);
	  l1 = (long) alist_eq(&r1->value, &r2->value, icase);
	  l2 = 1L;
	}
	else {
	  seterr_s(e, result, ds_xprintf("Invalid binary operand, op=%s",
									 token_name(op)));
	  return(-1);
	}

	switch (op) {
	case T_LT:
	case T_LT_I:
	  val = (l1 < l2);
	  break;
	case T_LE:
	case T_LE_I:
	  val = (l1 <= l2);
	  break;
	case T_EQ:
	case T_EQ_I:
	  val = (l1 == l2);
	  break;
	case T_NE:
	case T_NE_I:
	  val = (l1 != l2);
	  break;
	case T_GE:
	case T_GE_I:
	  val = (l1 >= l2);
	  break;
	case T_GT:
	case T_GT_I:
	  val = (l1 > l2);
	  break;
	default:
	  seterr_e(e, result, "Code botch");
	  return(-1);
	}
	result->value.token = T_INTEGER;
	result->value.val.intval = val;
#else
	if (eval2_compare(e, result, op, &r1->value, &r2->value) == -1)
	  return(-1);
#endif

	break;

  case T_BITOR:
  case T_BITXOR:
  case T_BITAND:
  case T_BITSHL:
  case T_BITSHR:
	if (integer_value(e, &r1->value, &l1) != -1
		&& integer_value(e, &r2->value, &l2) != -1) {
	  if (op == T_BITOR)
		val = l1 | l2;
	  else if (op == T_BITXOR)
		val = l1 ^ l2;
	  else if (op == T_BITAND)
		val = l1 & l2;
	  else if (op == T_BITSHL)
		val = l1 << l2;
	  else if (op == T_BITSHR)
		val = l1 >> l2;
	  else {
		seterr_e(e, result, "Code botch");
		return(-1);
	  }
	  result->value.token = T_INTEGER;
	  result->value.val.intval = val;
	}
	else if ((op == T_BITSHL || op == T_BITSHR) && r1->value.token == T_LIST
			 && integer_value(e, &r2->value, &l2) != -1) {
	  if (op == T_BITSHL)
		dsvec_rotate(r1->value.val.listval.list, -l2);
	  else
		dsvec_rotate(r1->value.val.listval.list, l2);
	  result->value.token = T_LIST;
	  result->value.val.listval.list = r1->value.val.listval.list;
	}
	else {
	  seterr_s(e, result, ds_xprintf("Invalid binary operand, op=%s",
									 token_name(op)));
	  return(-1);
	}
	break;

  case T_PLUS:
  case T_MINUS:
  case T_TIMES:
  case T_DIV:
	if (integer_value(e, &r1->value, &l1) != -1
		&& integer_value(e, &r2->value, &l2) != -1) {
	  if (op == T_PLUS)
		val = l1 + l2;
	  else if (op == T_MINUS)
		val = l1 - l2;
	  else if (op == T_TIMES)
		val = l1 * l2;
	  else if (op == T_DIV) {
		if (l2 == 0) {
		  seterr_e(e, result, "Attempt to divide by zero");
		  return(-1);
		}
		val = l1 / l2;
	  }
	  else {
		seterr_e(e, result, "Code botch");
		return(-1);
	  }

	  result->value.token = T_INTEGER;
	  result->value.val.intval = val;
	  break;
	}
	else if (real_value(e, &r1->value, &real1) != -1
			 && real_value(e, &r2->value, &real2) != -1) {
	  if (op == T_PLUS)
		rval = real1 + real2;
	  else if (op == T_MINUS)
		rval = real1 - real2;
	  else if (op == T_TIMES)
		rval = real1 * real2;
	  else if (op == T_DIV) {
		if (real2 == 0.0) {
		  seterr_e(e, result, "Attempt to divide by zero");
		  return(-1);
		}
		rval = real1 / real2;
	  }
	  else {
		seterr_e(e, result, "Code botch");
		return(-1);
	  }

	  result->value.token = T_REAL;
	  result->value.val.realval = rval;
	  break;
	}
	else {
	  seterr_s(e, result, ds_xprintf("Invalid binary operand, op=%s",
									 token_name(op)));
	  return(-1);
	}
	break;

  case T_DOT:
	/* Concatenation */
	if (r1->value.token == T_VARIABLE) {
	  if (variable_value(e, &r1->value, &arg1, NULL) == -1) {
		seterr_e(e, result, "No such variable??");
		return(-1);
	  }
	}
	else
	  arg1 = &r1->value;

	if (r2->value.token == T_VARIABLE) {
	  if (variable_value(e, &r2->value, &arg2, NULL) == -1) {
		seterr_e(e, result, "No such variable??");
		return(-1);
	  }
	}
	else
	  arg2 = &r2->value;

	if (arg1->token == T_BSTRING && arg2->token == T_BSTRING) {
	  void *new_data;
	  size_t new_len;

	  new_len = arg1->val.bval.len + arg2->val.bval.len;
	  new_data = malloc(new_len);
	  memcpy(new_data, arg1->val.bval.data, arg1->val.bval.len);
	  memcpy((char *) new_data + arg1->val.bval.len, arg2->val.bval.data,
			 arg2->val.bval.len);

	  result->value.token = T_BSTRING;
	  result->value.val.bval.data = new_data;
	  result->value.val.bval.len = new_len;
	}
	else if (arg1->token == T_LIST) {
	  List new_list;

	  /*
	   * For list concatenation/append, the lhs is a list and the rhs
	   * can be most any basic type; just stick it on the end.
	   * If the rhs is a list, its element/elements are appended rather than
	   * the list itself.
	   */
	  if (arg2->token == T_INTEGER
		  || arg2->token == T_STRING
		  || arg2->token == T_BSTRING
		  || arg2->token == T_LITERAL
		  || arg2->token == T_REAL) {
		new_list.list = dsvec_copy(NULL, arg1->val.listval.list);
		dsvec_add_ptr(new_list.list, copy_value(NULL, arg2));
		result->value.token = T_LIST;
		result->value.val.listval.list = new_list.list;
	  }
	  else if (arg2->token == T_LIST) {
		unsigned int i;

		new_list.list = dsvec_copy(NULL, arg1->val.listval.list);
		for (i = 0; i < dsvec_len(arg2->val.listval.list); i++) {
		  Value *v;

		  v = (Value *) dsvec_ptr_index(arg2->val.listval.list, i);
		  dsvec_add_ptr(new_list.list, copy_value(NULL, v));
		}
		result->value.token = T_LIST;
		result->value.val.listval.list = new_list.list;
	  }
	  else {
		seterr_s(e, result, "Type is invalid for list append");
		return(-1);
	  }
	}
	else if (arg1->token == T_ALIST) {
	  Kwv *kwv_new;

	  /*
	   * For alist concatenation/append, both the lhs and rhs must be an alist.
	   * It is an error if the same key appears in both arguments.
	   */
	  if (arg2->token != T_ALIST) {
		seterr_s(e, result, "Type is invalid for alist append");
		return(-1);
	  }

	  if ((kwv_new = kwv_copy(arg1->val.alistval.kwv)) == NULL) {
		seterr_s(e, result, "Error in alist append");
		return(-1);
	  }

	  if (kwv_merge(kwv_new, arg2->val.alistval.kwv, KWV_NO_DUPS) == NULL) {
		if (kwv_new->error_msg != NULL)
		  seterr_s(e, result,
				   ds_xprintf("Error in alist append: %s",
							  kwv_new->error_msg));
		else
		  seterr_s(e, result, "Error in alist append");
		return(-1);
	  }

	  result->value.token = T_ALIST;
	  result->value.val.alistval.kwv = kwv_new;
	}
	else {
	  if (string_value(e, arg1, &s1) == -1
		  || string_value(e, arg2, &s2) == -1) {
		seterr_s(e, result, ds_xprintf("Invalid binary operand, op=%s",
									   token_name(op)));
		return(-1);
	  }

	  result->value.token = T_STRING;
	  result->value.val.strval = ds_xprintf("%s%s", s1, s2);
	}
	break;

  case T_EXP:
	if (integer_value(e, &r1->value, &l1) != -1
		&& integer_value(e, &r2->value, &l2) != -1) {
	  if (l2 < 0) {
		/* Can't raise to a negative power */
		seterr_e(e, result, "Attempt to raise to a negative power");
		return(-1);
	  }
	  val = lpower(l1, l2);
	  result->value.token = T_INTEGER;
	  result->value.val.intval = val;
	}
	else if (real_value(e, &r1->value, &real1) != -1
			 && real_value(e, &r2->value, &real2) != -1) {
	  rval = pow(real1, real2);
	  if (errno == ERANGE || errno == EDOM) {
		seterr_e(e, result, "Error or overflow in pow()");
		return(-1);
	  }
	  result->value.token = T_REAL;
	  result->value.val.realval = rval;
	}
	else {
	  seterr_s(e, result, ds_xprintf("Invalid binary operand, op=%s",
									 token_name(op)));
	  return(-1);
	}
	break;

  case T_MOD:
	if (integer_value(e, &r1->value, &l1) != -1
		&& integer_value(e, &r2->value, &l2) != -1) {
	  if (l2 == 0L) {
		seterr_e(e, result, "Attempt to divide by zero");
		return(-1);
	  }
	  val = l1 % l2;
	}
	else {
	  seterr_s(e, result, ds_xprintf("Invalid binary operand, op=%s",
									 token_name(op)));
	  return(-1);
	}

	result->value.token = T_INTEGER;
	result->value.val.intval = val;
	break;

  default:
	seterr_s(e, result, "Unrecognized binary operator");
	return(-1);
  }

  return(0);
}

#ifdef NOTDEF
/*
 * Evaluate ternary operators
 */
static int
eval3(Lex_state *e, Expr_result *result, Token op, Expr_result *r1,
	  Expr_result *r2, Expr_result *r3)
{
  int rc1, rc2;
  Expr_result res2, res3;

  if (!e->do_eval)
	return(0);

  if (value_init(&res2, result))
	return(-1);
  if (value_init(&res3, result))
	return(-1);

  rc1 = rc2 = 0;

  switch(op) {
  default:
	/* Unknown ternary op */
	seterr_s(e, result, "Unrecognized ternary operator");
	return(-1);
  }

  return(0);
}
#endif

static void process_commands(FILE *fp);

static void
dacs_usage(char *name)
{

  fprintf(stderr, "Usage: %s [-x] %s [-e expr] [-dl] [-h|-help] [-n] [-p] [-s] [-test] [--] [filename] [script-args]\n",
		  name, standard_command_line_usage);
  fprintf(stderr, "Flags:\n");
  fprintf(stderr, "-dl      : display debugging info\n");
  fprintf(stderr, "-e expr  : evaluate expr\n");
  fprintf(stderr, "-n       : do not evaluate, just syntax check\n");
  fprintf(stderr, "-p       : print the result\n");
  fprintf(stderr, "-s       : strip quotes around output\n");
  fprintf(stderr, "-test    : evaluate a test case\n");
  fprintf(stderr, "--       : end of flag arguments\n");
  fprintf(stderr, "If filename is '-' or missing and no expression was\n");
  fprintf(stderr, "given, the standard input is read\n");
  fprintf(stderr, "Type '?' for help\n");

  exit(2);
}

static void
show_help(FILE *fp, char *str)
{
  int i, argc;
  char **argv;
  Mkargv conf = { 1, 0, " \t", NULL, NULL };
  
  if ((argc = mkargv(str, &conf, &argv)) == -1) {
	fprintf(fp, "??\n");
	return;
  }

  if (argc == 1) {
	if (strcaseeq(argv[0], "list")) {
	  for (i = 1; functions[i - 1].name != NULL; i++) {
		if ((i % 8) == 0)
		  fprintf(fp, ",\n");
		else if (i != 1)
		  fprintf(fp, ", ");
		fprintf(fp, "%s", functions[i - 1].name);
	  }
	  fprintf(fp, "\n");
	  return;
	}
	else if (strcaseeq(argv[0], "desc")) {
	  for (i = 0; functions[i].name != NULL; i++)
		fprintf(fp, "%s: %s\n", functions[i].name, functions[i].desc);
	  return;
	}
  }
  else if (argc == 2 && strcaseeq(argv[0], "desc")) {
	for (i = 0; functions[i].name != NULL; i++) {
	  if (strcaseeq(functions[i].name, argv[1])) {
		fprintf(fp, "%s: %s\n", functions[i].name, functions[i].desc);
		return;
	  }
	}
	fprintf(fp, "??\n");
	return;
  }

  /* Anything else falls through to top-level help. */

  fprintf(fp, "clear             - clears all DACS:: variables\n");
  fprintf(fp, "set               - displays all DACS:: variables\n");
  fprintf(fp, "set VAR=\"VALUE\" - sets DACS:: variable VAR to VALUE\n");
  fprintf(fp, "source filename   - execute commands from a file\n");
  fprintf(fp, "so filename       - same as 'source' command\n");
  fprintf(fp, "<VAR              - evaluate the expression in variable VAR\n");
  fprintf(fp, "quit or exit      - terminates\n");
  fprintf(fp, "help or ?         - this help message\n");
  fprintf(fp, "help list         - list function names\n");
  fprintf(fp, "help desc         - describe all functions\n");
  fprintf(fp, "help desc FN      - describe function FN\n");
  fprintf(fp, "Anything else is an expression to be evaluated\n");
  fprintf(fp, "A line may be continued by ending it with a backslash\n");

}

/*
 * Initialize the Argv namespace from the first ARGC elements of ARGV.
 */
int
acs_init_argv_namespace(Acs_environment *env, int argc, char **argv)
{
  int i;
  Kwv *kwv;

  if ((kwv = kwv_init(argc)) == NULL)
	return(-1);

  for (i = 0; i < argc; i++)
	kwv_add(kwv, ds_xprintf("%d", i), argv[i]);

  if (var_ns_replace(&env->namespaces, "Argv", kwv) == -1)
	return(-1);

  var_ns_set_flags(env->namespaces, "Argv", VAR_NS_READONLY);

  return(0);
}

static Acs_environment env;

/*
 * Read an expression test case from FILENAME (or stdin, if NULL).
 * A test case consists of a section containing one or more options,
 * each one a single-line comment, followed by the expression to evaluate:
 *
 *    {<whitespace>* "//" <whitespace>* <option> ":" <value> <end-of-line>}*
 * As a special case, lines like the following are ignored:
 *    <whitespace>* "///" .* <end-of-line>
 * Options control how the test is performed and specify the expected result.
 *
 * Options:
 * expect:<regex> or expect-regex:<regex>
 *   - result string must match <regex>
 * expect-exact:<string>
 *   - result string must match <string> exactly
 * expect-code:<code>
 *   - result code must be <code> (0=true, 1=false, 2=error)
 * expect-type:<type>
 *   - result type must be <type> (integer, real, string, literal, or undef)
 * show-result:<y/n> (yes or no)
 *   - if "yes", show the result string
 */
static int
run_test_case(char *filename)
{
  int expect_code, expect_identical, rc, rs, show;
  char *e, *errmsg, *expr, *file, *fname, *option, *p, *str, *test, *value;
  char *expect_exact, *expect_regex, *expect_type, *expected_value;
  char errbuf[100];
  regex_t preg;
  regmatch_t pmatch[1];
  Acs_expr_result st;
  Ds *ds;
  Expr_result *result;

  if (filename == NULL) {
	file = NULL;
	fname = "<stdin>";
  }
  else
	file = fname = filename;

  errmsg = NULL;
  if (load_file(file, &test, NULL) == -1) {
	errmsg = "Error loading test case file";
	goto fail;
  }

  p = test;
  expr = NULL;
  expect_exact = expect_regex = expect_type = NULL;
  expect_code = -1;
  expect_identical = 0;
  show = 0;

  while (1) {
	/* Skip initial whitespace. */
	while (*p == ' ' || *p == '\t')
	  p++;

	if (*p == '\n') {
	  p++;
	  break;
	}

	/*
	 * If this is neither an option line nor a special comment line,
	 * the expressions begin.
	 */
	if (*p != '/' || *(p + 1) != '/')
	  break;

	p += 2;

	if (*p == '/') {
	  /* This is a special comment line - just advance to the next line. */
	  p = strchr(p + 1, (int) '\n');
	  if (p == NULL) {
		errmsg = "No newline terminates option comment";
		goto fail;
	  }
	  p++;
	  continue;
	}

	/* This is an option line. */
	while (*p == ' ' || *p == '\t')
	  p++;

	option = p;
	if ((p = strchr(option, (int) ':')) == NULL) {
	  errmsg = "Invalid option specification";
	  goto fail;
	}
	*p++ = '\0';

	/* No whitespace is allowed here. */
	value = p;
	if ((p = strchr(value, (int) '\n')) == NULL) {
	  errmsg = "No newline found";
	  goto fail;
	}
	*p++ = '\0';
	if (verbose_level)
	  fprintf(stderr, "Option: \"%s\", Value: \"%s\"\n", option, value);

	if (streq(option, "expect-identical")) {
	  expect_exact = expected_value = value;
	  expect_identical = 1;
	}
	else if (streq(option, "expect-exact")) {
	  Ds *expected;

	  if ((expected = struncescape(value)) == NULL) {
		errmsg = "Invalid escape sequence in input";
		goto fail;
	  }
	  expected_value = ds_buf(expected);
	  expect_exact = expected_value;
	}
	else if (streq(option, "expect") || streq(option, "expect-regex")) {
	  expected_value = value;
	  expect_regex = expected_value;
	  if ((rs = regcomp(&preg, expect_regex, REG_EXTENDED)) != 0) {
		regerror(rs, &preg, errbuf, sizeof(errbuf));
		errmsg = ds_xprintf("Invalid regular expression: \"%s\": %s",
							expect_regex, errbuf);
		goto fail;
	  }
	}
	else if (streq(option, "expect-code")) {
	  expected_value = value;
	  expect_code = atoi(expected_value);
	}
	else if (streq(option, "expect-type")) {
	  expected_value = value;
	  expect_type = expected_value;
	}
	else if (streq(option, "expect-flags")) {
	  if (streq(value, "rw_namespaces"))
		dacs_disable_readonly_namespaces = 1;
	  else if (streq(value, "ro_namespaces"))
		dacs_disable_readonly_namespaces = 0;
	  else {
		errmsg = ds_xprintf("Unrecognized expect-flags value: \"%s\"", value);
		goto fail;
	  }
	}
	else if (streq(option, "show-result")) {
	  expected_value = value;
	  if (strcaseeq(expected_value, "yes"))
		show = 1;
	  else if (strcaseeq(expected_value, "no"))
		show = 0;
	  else {
		errmsg = "Unrecognized show option value";
		goto fail;
	  }
	}
	else {
	  errmsg = "Unrecognized option";
	  goto fail;
	}
  }

  expr = p;

  e = expr;
  if ((ds = acs_elide_comments(expr)) != NULL)
	e = ds_buf(ds);
  if (!quiet_flag)
	fprintf(stderr, "%s: ", fname);
  result = init_expr_result(NULL, T_UNDEF);
  st = acs_expr(e, &env, result);

  if (st == ACS_EXPR_TRUE)
	rc = 0;
  else if (st == ACS_EXPR_FALSE)
	rc = 1;
  else
	rc = 2;

  if (expect_code != -1 && rc != expect_code) {
	errmsg = ds_xprintf("failed on expect-code: expect %d, got %d",
						expect_code, rc);
	goto fail;
  }

  if (expect_type != NULL) {
	Lex_token *t;

	if ((t = token_lookup(result->value.token)) == NULL) {
	  errmsg = "Internal error: token lookup failed";
	  goto fail;
	}
	if (strcasesuffix(t->token_name, strlen(t->token_name), expect_type)
		== NULL) {
	  errmsg = ds_xprintf("failed on expect-type: expect %s, got %s",
						  expect_type, t->token_name);
	  goto fail;
	}
  }

  if (acs_expr_error_occurred(st)) {
	errmsg = NULL;
	goto fail;
  }	
  
  str = acs_format_result(result);

  if (expect_exact != NULL) {
	if (!streq(str, expect_exact)) {
	  errmsg = ds_xprintf("failed on expect-exact: expect \"%s\", got \"%s\"",
						  expect_exact, str);
	  goto fail;
	}
  }

  if (expect_regex != NULL) {
	rs = regexec(&preg, str, 1, pmatch, 0);
	if (rs != 0) {
      if (rs != REG_NOMATCH) {
		regerror(rs, &preg, errbuf, sizeof(errbuf));
		errmsg = ds_xprintf("Regular expression error: \"%s\": %s",
							expect_regex, errbuf);
		goto fail;
	  }
	  errmsg = ds_xprintf("failed on expect-regex: expect \"%s\", got \"%s\"",
						  expect_regex, str);
	  goto fail;
	}
  }

  if (show) {
	if (result->value.token == T_STRING)
	  printf("\"%s\"\n", str);
	else
	  printf("%s\n", str);
  }

  if (!quiet_flag)
	fprintf(stderr, "ok\n");

  return(0);

 fail:

  if (errmsg != NULL) {
	if (quiet_flag)
	  fprintf(stderr, "%s: ", fname);
	fprintf(stderr, "%s\n", errmsg);
	fprintf(stderr, "An error has occurred.  If you are sure this is a\n");
	fprintf(stderr, "DACS bug, please see dacs.readme(7) for instructions.\n");
  }

  return(-1);
}

static int
eval_command(char *buf)
{
  char *e;
  Ds *ds;
  Kwv *kwv;

  if ((kwv = var_ns_lookup_kwv(env.namespaces, "DACS")) == NULL) {
	Var_ns *v;

	v = var_ns_new(&env.namespaces, "DACS", NULL);
	kwv = v->kwv;
  }

  e = buf;
  if ((ds = acs_elide_comments(buf)) != NULL)
	e = ds_buf(ds);
  if (e == NULL)
	return(1);

  if (streq(e, "clear"))
	var_ns_delete(&env.namespaces, "DACS");
  else if (streq(e, "help") || strprefix(e, "help "))
	show_help(stdout, e + 4);
  else if (streq(e, "?") || strprefix(e, "? "))
	show_help(stdout, e + 1);
  else if (streq(e, "quit") || streq(e, "exit"))
	return(0);
  else if (streq(e, "set")) {
	char *str;

	if ((str = kwv_buf(kwv, '=', '\"')) != NULL)
	  printf("%s", str);
  }
  else if (strneq(e, "set ", 4)) {
	Kwv_conf kwv_conf = {
	  "=", NULL, " ", KWV_CONF_DEFAULT, NULL, 10, NULL, NULL
	};

	kwv_make_add(kwv, e + 4, &kwv_conf);
  }
  else if (strneq(e, "source ", 7) || strneq(e, "so ", 3)) {
	char *filename, *p;
	FILE *fp;

	for (p = e; *p != ' '; p++)
	  ;
	while (*p == ' ')
	  p++;
	filename = p;
	if ((fp = fopen(filename, "r")) == NULL) {
	  fprintf(stderr, "Couldn't open %s\n", filename);
	  return(1);
	}
	process_commands(fp);
	fclose(fp);
  }
  else if (streq(e, "trace"))
	env.trace_level = 1;
  else if (strneq(e, "trace ", 6)) {
	if (streq(e + 6, "on"))
	  env.trace_level = 1;
	else if (streq(e + 6, "off"))
	  env.trace_level = 0;
	else
	  printf("?\n");
  }
  else {
	char *expr, *str;
	Acs_expr_result st;
	Expr_result *result;

	if (e[0] == '<') {
	  if ((expr = kwv_lookup_value(kwv, e + 1)) == NULL)
		expr = e;
	}
	else if (e[0] == '\0')
	  return(1);
	else
	  expr = e;

	env.do_eval = 1;
	result = init_expr_result(NULL, T_UNDEF);

	st = acs_expr(expr, &env, result);

	if (st == ACS_EXPR_SYNTAX_ERROR)
	  printf("Syntax error\n");
	else if (st == ACS_EXPR_LEXICAL_ERROR)
	  printf("Lexical error\n");
	else if (st == ACS_EXPR_EVAL_ERROR)
	  printf("Evaluation error\n");
	else if (!is_batch) {
	  if (result->value.token != T_VOID) {
		str = acs_format_result(result);
		if (str_or_lit(result->value.token)
			|| result->value.token == T_BSTRING)
		  fprintf(stderr, "\"%s\"\n", str);
		else
		  fprintf(stderr, "%s\n", str);
	  }
	}
  }

  return(1);
}

/*
 * Read from FP and process.
 */
static void
process_commands(FILE *fp)
{
  char *cmd, *prompt;
  Ds *ds;

  ds = ds_init(NULL);
  ds->delnl_flag = 1;
  ds->escnl_flag = 1;

  if (is_batch) {
	if (ds_agetf(ds, stdin) == NULL) {
	  fprintf(stderr, "Input error\n");
	  return;
	}
	eval_command(ds_buf(ds));
	ds_free(ds);
	return;
  }

  prompt = "> ";
  while (1) {
#ifdef HAVE_READLINE
	if ((cmd = ds_readline(ds, prompt, ">> ")) == NULL)
	  break;
#else
	if (fp == stdin && prompt != NULL)
	  printf("%s", prompt);
	if ((cmd = ds_gets(ds, fp)) == NULL) {
	  if (feof(fp) || ferror(fp))
		break;
	  continue;
	}
#endif

	if (eval_command(cmd) == 0)
	  break;
  }

}

/*
 * For testing, debugging, and what have you.
 */
int
dacsexpr_main(int argc, char **argv, int do_init, void *main_out)
{
  int exec_run, i, print_result, rc, run_test, strip_flag;
  char *errmsg, *expr, *filename;
  Acs_expr_result st;
  Expr_result result;
  Var_ns *env_ns;

  if (!isatty(0))
	is_batch = 1;

  env_ns = NULL;
  expr = NULL;
  strip_flag = 0;
  filename = NULL;
  run_test = 0;
  exec_run = 0;
  print_result = 0;

  dacs_log_format = "%a[%l]: %sf:%sl";
  /*
   * If run as a script via:
   *   #! .../dacsexpr
   * then everything that follows the command name on the line is passed as
   * a single argument to this program, followed by the name of the file
   * being executed, and any command line arguments as individual arguments.
   * See execve(2).
   */
#ifdef NOTDEF
  for (i = 0; i < argc; i++)
	fprintf(stderr, "\"%s\"\n", argv[i]);
#endif

  if (argc >= 3 && argv[1][0] == '-') {
	if ((argv[1][1] == 'x' && (argv[1][2] == ' ' || argv[1][2] == '\0'))
		|| strchr(argv[1], (int) ' ') != NULL
		|| strchr(argv[1], (int) '\t') != NULL) {
	  Dsvec *av;

	  exec_run = 1;
	  av = ds_mkargv(NULL, &argv[1][3], NULL);
	  ds_mkargv_add(av, argv[2]);
	  if (argc > 3)
		ds_mkargv_addv(av, argc - 3, &argv[3]);
	  argc = dsvec_len(av) - 1;
	  argv = (char **) dsvec_base(av);
	}
  }

  errmsg = NULL;
  if (dacs_init(DACS_UTILITY_OPT, &argc, &argv, NULL, &errmsg) == -1) {
  fail:
	if (errmsg != NULL)
	  fprintf(stderr, "dacsexpr: %s\n", errmsg);
	dacs_usage(argv[0]);
    /*NOTREACHED*/
  }

  if (is_batch || (!quiet_flag && !dacs_saw_command_line_log_level)) {
	/* Override the config file default */
	log_set_level(NULL, LOG_WARN_LEVEL);
  }

  acs_new_env(&env);
  if (dacs_conf != NULL && dacs_conf->conf_var_ns != NULL)
	var_ns_add(&env.namespaces, dacs_conf->conf_var_ns);
  var_ns_new(&env.namespaces, "DACS", NULL);

  /* Initialize the Env namespace. */
  if (env_ns == NULL && (env_ns = var_ns_from_env("Env")) != NULL)
	var_ns_add(&env.namespaces, env_ns);

  for (i = 1; i < argc; i++) {
	if (streq(argv[i], "-e")) {
	  if (++i == argc) {
		errmsg = "Expression is missing";
		goto fail;
	  }
	  if (expr != NULL) {
		errmsg = "Only one expression is allowed";
		goto fail;
	  }
	  expr = argv[i];
	}
	else if (streq(argv[i], "-h") || streq(argv[i], "-help")) {
	  dacs_usage(argv[0]);
	  /*NOTREACHED*/
	}
	else if (streq(argv[i], "-n"))
	  env.do_eval = 0;
	else if (streq(argv[i], "-p"))
	  print_result = 1;
	else if (streq(argv[i], "-s"))
	  strip_flag = 1;
	else if (streq(argv[i], "-test"))
	  run_test = 1;
	else if (streq(argv[i], "-dl"))
	  do_lexdump = 1;
	else if (streq(argv[i], "--")) {
	  i++;
	  break;
	}
	else
	  break;
  }

  /*
   * Case 1: there are no remaining arguments, which means read expressions
   * from stdin.
   * Case 2: the next argument is '-', which also means read expressions
   * from stdin but one or more arguments to the script may follow.
   * Case 3: the next argument is a filename from which expressions should
   * be read.
   */
  if (i < argc) {
	if (!streq(argv[i], "-"))
	  filename = argv[i];
	else
	  exec_run = 1;

	/* Remaining args are for script */
	acs_init_argv_namespace(&env, argc - i, &argv[i]);
  }

  if (filename != NULL || exec_run || is_batch) {
	if (expr != NULL) {
	  errmsg = "Cannot specify an expression and an input file";
	  goto fail;
	}

	is_batch = 1;

	if (run_test) {
	  rc = run_test_case(filename);
	  return(rc);
	}

	if (load_file(filename, &expr, NULL) == -1) {
	  if (filename == NULL)
		errmsg = "Error loading expression file from stdin";
	  else
		errmsg = ds_xprintf("Error loading expression file \"%s\"", filename);
	  goto fail;
	}
  }

  if (expr != NULL) {
	char *e, *str;
	Ds *ds;

	e = expr;
	if ((ds = acs_elide_comments(expr)) != NULL)
	  e = ds_buf(ds);
	if (e == NULL)
	  return(2);

	st = acs_expr(e, &env, &result);

	if (acs_expr_error_occurred(st))
	  rc = 2;
	else if (st == ACS_EXPR_TRUE || is_batch || !env.do_eval)
	  rc = 0;
	else
	  rc = 1;

	if (result.exit_called)
	  rc = result.value.val.intval;

	if (!quiet_flag && env.do_eval) {
	  if (st == ACS_EXPR_SYNTAX_ERROR)
		fprintf(stderr, "Syntax error\n");
	  else if (st == ACS_EXPR_EVAL_ERROR)
		fprintf(stderr, "Evaluation error\n");
	  else if (!is_batch || print_result) {
		str = acs_format_result(&result);
		if (!strip_flag
			&& (result.value.token == T_STRING
				|| result.value.token == T_BSTRING))
		  printf("\"%s\"\n", str);
		else
		  printf("%s\n", str);
	  }
	}

	return(rc);
  }

  process_commands(stdin);

  return(0);
}

#else

int
main(int argc, char **argv)
{
  int rc;

  rc = dacsexpr_main(argc, argv, 1, NULL);

  exit(rc);
}
#endif
