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

/*
 * Authentication transfer services for affiliated federations.
 * This service transfers a DACS identity from a DACS federation to another
 * DACS federation, or any alien (non-DACS) federation that implements the
 * protocol.
 *
 * There are many possible approaches, each with many variations.
 *
 * Scenario:
 * A user authenticates in Federation A (the "initial federation") and
 * obtains credentials understood by that federation.  Later, the user wants
 * to obtain corresponding credentials issued by Federation B (the "target
 * federation"), without having to explicitly authenticate himself
 * in Federation B.  In a sense the user wants to show his Federation A
 * credentials to Federation B, as authentication material, and have
 * Federation B issue credentials.
 *
 * The solution must function when the two federations have completely
 * different domain names (i.e., they don't have to share a suffix).
 *
 * The main complication is that when credentials are encapsulated within HTTP
 * cookies:
 *   1) The cookies will be sent by browsers only to the initial
 *      federation's domain name space (i.e., how are the initial credentials
 *      sent to the target federation?) and
 *   2) The initial federation cannot set a cookie associated with the target
 *      federation in the user's browser (i.e., how are the new credentials
 *      returned to the user?); the target federation must do that itself.
 *
 * The DACS browser/POST method works about as follows:
 *   1) The user invokes the identity transfer service at the initial
 *      federation, specifying the target federation and any other arguments
 *      that are required
 *   2) The transfer service returns an HTML form in which is embedded
 *      the user's current credentials and other required arguments.
 *      When submitted, the form will be directed to a URI of an identity
 *      transfer service at the target federation.
 *   3) The HTML form is submitted by the user to the transfer service at
 *      the target federation, which validates the information contained in
 *      the form, responds with its own credentials, and redirects the user to
 *      a URL within the target federation.
 *
 * The DACS browser/artifact method is similar except that it uses a level
 * of indirection; rather than encapsulating credentials within a form, the
 * initial federation creates a temporary mapping between the user's
 * credentials and an identifier (the artifact):
 *   1) The user invokes the identity transfer service at the initial site,
 *      specifying the target federation and any other arguments that are
 *      required
 *   2) The transfer service redirects the user's browser to the target
 *      federation, passing the artifact as a query component of the URL
 *   3) The target federation validates the artifact by passing it back to the
 *      transfer service at the initial federation; if validation is
 *      successful, the target federation responds with its own credentials,
 *      and redirects the user's browser to a URL within the target federation.
 * The artifact might be a key used to lookup a record stored at the initial
 * federation in step 1, or something unforgeable created in step 1 by the
 * initial federation from which it can confidently extract identities, such as
 * an encrypted string or a weakened form of credentials.
 * A key-based scheme suggests that the target federation must contact the
 * same server that created the artifact; schemes where the artifact contains
 * all necessary information may not have that restriction.
 *
 * Notes:
 * o the browser/POST method could incorporate an artifact rather
 *   than the credentials.
 *
 * o the advantage of a GET-based method is that automatic redirection can
 *   occur (no direct user involvement); the disadvantage is that the GET's
 *   query component is readily visible in logs, etc.
 *
 * o the best approach also depends on the cryptographic support available.
 *
 * o when multiple credentials are present, the user will need the
 *   opportunity to select which identity (or identities) to transfer to the
 *   target federation.
 *
 */

#ifndef lint
static const char copyright[] =
"Copyright (c) 2003-2012\n\
Distributed Systems Software.  All rights reserved.";
static const char revid[] =
  "$Id: auth_transfer.c 2586 2012-03-15 16:21:40Z brachman $";
#endif

#include "dacs.h"

enum {
  DEFAULT_MAX_TOKEN_LIFETIME_SECS = 5
};

static char *default_submit_method = "GET";
static char *default_submit_label = "Transfer";

static char *log_module_name = "dacs_auth_transfer";

typedef struct Federation {
  char *fedname;
  char *uri;
} Federation;

static Dsvec *
get_transfer_federation_names(void)
{
  int n;
  char **argv;
  Dsvec *dsv;
  Federation *f;
  Kwv_pair *v;
  Mkargv conf = { 0, 0, " ", NULL, NULL };

  if ((v = conf_var(CONF_AUTH_TRANSFER_EXPORT)) == NULL)
	return(NULL);

  dsv = dsvec_init(NULL, sizeof(Federation *));
  while (v != NULL) {
	if ((n = mkargv(v->val, &conf, &argv)) != 2) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Invalid AUTH_TRANSFER_EXPORT directive: \"%s\"", v->val));
	  return(NULL);
	}

	if (!is_valid_federation_name(argv[0])) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Invalid AUTH_TRANSFER_EXPORT directive: \"%s\"", v->val));
	  return(NULL);
	}

	f = ALLOC(Federation);
	f->fedname = argv[0];
	f->uri = argv[1];
	dsvec_add_ptr(dsv, f);

	v = v->next;
  }

  return(dsv);
}

static Federation *
lookup_federation(Dsvec *feds, char *fedname)
{
  int i;
  Federation *f;

  for (i = 0; i < dsvec_len(feds); i++) {
	f = dsvec_ptr(feds, i, Federation *);
	if (streq(f->fedname, fedname))
	  return(f);
  }

  return(NULL);
}

static int
load_auth_transfer_item(char *name, char **buf)
{
  Vfs_directive *vd;
  Vfs_handle *handle;

  *buf = NULL;
  if ((vd = vfs_lookup_item_type(ITEM_TYPE_AUTH_TRANSFER)) == NULL)
	return(-1);

  if (vfs_open(vd, &handle) == -1)
	return(-1);

  if (vfs_get(handle, name, (void *) buf, NULL) == -1) {
	vfs_close(handle);
	return(-1);
  }

  if (vfs_close(handle) == -1)
	return(-1);

  return(0);
}

static Kwv_vartab *
lookup_transfer_vartab(char *initial_fed, char **id)
{
  int vtnum;
  Kwv_pair *pair;
  Kwv_vartab *transfer_vartab, *vt;

  vtnum = 0;
  while ((transfer_vartab = conf_transfer_vartab(vtnum++)) != NULL) {
	pair = conf_vartab_var(transfer_vartab, CONF_TRANSFER_IMPORT_FROM);
	while (pair != NULL) {
	  if (!is_valid_federation_name(pair->val)) {
		log_msg((LOG_ERROR_LEVEL,
				 "Invalid AUTH_TRANSFER_IMPORT_FROM directive: \"%s\"",
				 pair->val));
		return(NULL);
	  }
	  if (streq(pair->val, initial_fed))
		break;
	  pair = pair->next;
	}
	if (pair != NULL)
	  break;
  }

  if (transfer_vartab == NULL)
	return(NULL);

  vt = kwv_vartab_lookup(transfer_vartab, "TRANSFER_ID");
  *id = vt->pair->val;

  return(transfer_vartab);
}

static Acs_expr_result
eval(char *expr, Kwv *kwv, Kwv *kwv_auth, char **result_str, char **errmsg)
{
  int n;
  unsigned int ncookies;
  char *remote_addr;
  Acs_environment env;
  Acs_expr_result st;
  Cookie *cookies;
  Credentials *credentials;
  Expr_result result;
  Kwv *x;

  /*
   * If the request comes from a DACS-authenticated service, we can use
   * its credentials.
   */
  if ((remote_addr = getenv("REMOTE_ADDR")) == NULL) {
	*errmsg = "No REMOTE_ADDR found";
	return(ACS_EXPR_EVAL_ERROR);
  }
  x = kwv_init(10);
  kwv_add(x, "REMOTE_ADDR", remote_addr);

  if (get_cookies(NULL, &cookies, &ncookies) == -1) {
	*errmsg = "Cookie parse error";
	return(ACS_EXPR_EVAL_ERROR);
  }

  n = get_valid_credentials(cookies, remote_addr, 0, &credentials);
  if (n == -1) {
	*errmsg = "Error locating valid credentials";
	return(ACS_EXPR_EVAL_ERROR);
  }

  acs_new_env(&env);
  if (acs_init_env(x, kwv, NULL, credentials, &env) == -1) {
	*errmsg = "Could not evaluate predicate";
	return(ACS_EXPR_EVAL_ERROR);
  }
  var_ns_new(&env.namespaces, "Auth", kwv_auth);

  st = acs_expr(expr, &env, &result);
  if (st == ACS_EXPR_TRUE) {
	log_msg((LOG_TRACE_LEVEL, "Eval result: True", st));
	if (result_str != NULL)
	  *result_str = acs_format_result(&result);
  }
  else {
	log_msg((LOG_TRACE_LEVEL, "Eval failed, result: %d", st));
	*errmsg = "Import permission is denied";
	return(st);
  }

  return(st);
}

#ifdef NOTDEF
static int
do_predicate(char *predicate, Kwv *kwv, char *id)
{

  if (predicate != NULL && *predicate != '\0') {
	Acs_expr_result st;

	st = eval(predicate, kwv, NULL);

	if (st == ACS_EXPR_SYNTAX_ERROR) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Syntax error in Transfer \"%s\" predicate", id));
	  return(-1);
	}
	else if (st == ACS_EXPR_EVAL_ERROR) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Evaluation error in Transfer \"%s\" predicate", id));
	  return(-1);
	}
	else if (st == ACS_EXPR_LEXICAL_ERROR) {
	  log_msg((LOG_ERROR_LEVEL,
			   "Lexical error in Transfer \"%s\" predicate", id));
	  return(-1);
	}
	else if (st == ACS_EXPR_FALSE) {
	  log_msg((LOG_DEBUG_LEVEL, "Transfer \"%s\" predicate is false...", id));
	  return(0);
	}
  }

  log_msg((LOG_DEBUG_LEVEL, "Transfer \"%s\" predicate is true...", id));
  return(1);
}
#endif

static void
do_fail(char *prefix, char *errmsg)
{

  if (test_emit_xml_format()) {
	Common_status common_status;

	emit_xml_header(stdout, "dacs_auth_transfer");
	printf("<%s>\n", make_xml_root_element("dacs_auth_transfer"));
	init_common_status(&common_status, NULL, NULL, errmsg);
	printf("%s", make_xml_common_status(&common_status));
	printf("</dacs_auth_transfer>\n");
	emit_xml_trailer(stdout);
  }
  else if (test_emit_format(EMIT_FORMAT_JSON)) {
	Common_status common_status;

	emit_json_header(stdout, "dacs_auth_transfer");
	init_common_status(&common_status, NULL, NULL, errmsg);
	printf("%s", make_json_common_status(&common_status));
	emit_json_trailer(stdout);
  }
  else if (test_emit_format(EMIT_FORMAT_HTML)) {
	emit_html_header(stdout, NULL);
	printf("%s: %s<br/>\n", prefix, errmsg);
	emit_html_trailer(stdout);
  }
  else {
	emit_plain_header(stdout);
	printf("%s: %s\n", prefix, errmsg);
	emit_plain_trailer(stdout);
  }
}

/*
 * Initial federation: return an HTML (or XML) document that can be used to
 * select one set of credentials for export and select one target federation.
 * This is an optional element of the protocol, allowing a site to roll its
 * own.
 */
static int
do_presentation(Kwv *kwv, char **errmsg)
{
  int i, n;
  unsigned int ncookies;
  char *export_stage_uri, *remote_addr;
  Cookie *cookies;
  Credentials *cr, *credentials, *selected;
  Dsvec *feds;
  Federation *f;

  if ((remote_addr = getenv("REMOTE_ADDR")) == NULL) {
	*errmsg = "No REMOTE_ADDR found";

  fail:
	do_fail("Presentation failed", *errmsg);
	return(-1);
  }

  if (get_cookies(NULL, &cookies, &ncookies) == -1) {
	*errmsg = "Cookie parse error";
	goto fail;
  }

  n = get_valid_scredentials(cookies, remote_addr, 0, &credentials,
							 &selected, NULL);
  if (n <= 0) {
	*errmsg = "No valid credentials are available to export";
	goto fail;
  }

  if ((feds = get_transfer_federation_names()) == NULL
	  || dsvec_len(feds) == 0) {
	*errmsg = "No target federations are available for exportation";
	goto fail;
  }

  if ((export_stage_uri = var_ns_get_value(dacs_conf->conf_var_ns, "Conf",
										   "transfer_export_uri")) == NULL) {
	if ((export_stage_uri = current_uri_no_query(NULL)) == NULL) {
	  *errmsg = "No URI configured for export stage";
	  goto fail;
	}
  }

  if (test_emit_xml_format()) {
	emit_xml_header(stdout, "dacs_auth_transfer");
	printf("<%s export_stage_uri=\"%s\">\n",
		   make_xml_root_element("dacs_auth_transfer"),
		   export_stage_uri);
	printf("<transfer_identities>\n");
	for (cr = credentials; cr != NULL; cr = cr->next) {
	  printf("<transfer_identity name=\"%s\"/>\n",
			 auth_identity_from_credentials(cr));
	}
	printf("</transfer_identities>\n");
	printf("<transfer_federations>\n");
	for (i = 0; i < dsvec_len(feds); i++) {
	  f = dsvec_ptr(feds, i, Federation *);
	  printf("<transfer_federation name=\"%s\" uri=\"%s\"/>\n",
			 f->fedname, f->uri);
	}
	printf("</transfer_federations>\n");
	printf("</dacs_auth_transfer>\n");
	emit_xml_trailer(stdout);
  }
  else if (test_emit_format(EMIT_FORMAT_JSON)) {
	*errmsg = "Request for unsupported FORMAT";
	goto fail;
  }
  else if (test_emit_format(EMIT_FORMAT_HTML)) {
	int redirect_default;
	char *id, *no_choice, *p;
	Html_header_conf *hc;

	if ((p = kwv_lookup_value(kwv, "REDIRECT_DEFAULT")) != NULL
		&& strcaseeq(p, "yes"))
	  redirect_default = 1;
	else
	  redirect_default = 0;

	hc = emit_html_header_conf(NULL);

	if (redirect_default && n == 1 && dsvec_len(feds) == 1) {
	  id = auth_identity_from_credentials(credentials);
	  f = dsvec_ptr(feds, 0, Federation *);
	  hc->redirect_url
		= ds_xprintf("%s?OPERATION=EXPORT&DACS_IDENTITY=%s&TARGET_FEDERATION=%s",
					 export_stage_uri, id, f->fedname);
	  log_msg((LOG_TRACE_LEVEL, "Redirecting to %s", hc->redirect_url));
	  emit_html_header(stdout, hc);
	  goto done;
	}

	if (load_auth_transfer_item("header", &p) != -1)
	  printf("%s", p);
	else {
	  if (conf_val(CONF_CSS_PATH) != NULL)
		hc->css = ds_xprintf("%s/dacs_auth_transfer.css",
							 conf_val(CONF_CSS_PATH));
	  else
		hc->css = CSS_DIR/**/"/dacs_auth_transfer.css";
	  hc->title = "dacs_auth_transfer";
	  emit_html_header(stdout, hc);
	}

	if (load_auth_transfer_item("prologue", &p) != -1)
	  printf("%s", p);

	if (load_auth_transfer_item("instructions", &p) != -1)
	  printf("%s", p);

	printf("\n<div class=\"transfer_form\">\n");
	p = var_ns_get_value(dacs_conf->conf_var_ns, "Conf",
						 "transfer_submit_method");
	printf("<form method=\"%s\" action=\"%s\">\n",
		   (p != NULL) ? p : default_submit_method, export_stage_uri);
	if (credentials->next == NULL)
	  no_choice = " checked";
	else
	  no_choice = "";
	printf("\n<div class=\"transfer_identities_area\">\n");
	printf("Please select the identity to transfer:<br/>\n");
 	for (cr = credentials; cr != NULL; cr = cr->next) {
	  id = auth_identity_from_credentials(cr);
	  printf("<span class=\"transfer_identity\">\n");
	  printf("<input type=\"radio\" name=\"DACS_IDENTITY\" value=\"%s\"%s/>%s<br/>\n",
			 id, no_choice, id);
	  printf("</span>\n");
	}
	printf("</div>\n");

	if (dsvec_len(feds) == 1)
	  no_choice = " checked";
	else
	  no_choice = "";
	printf("\n<div class=\"transfer_federations_area\">\n");
	printf("Please select the target federation:<br/>\n");
	for (i = 0; i < dsvec_len(feds); i++) {
	  f = dsvec_ptr(feds, i, Federation *);
	  printf("<span class=\"transfer_federation\">\n");
	  printf("<input type=\"radio\" name=\"TARGET_FEDERATION\" value=\"%s\"%s/>%s<br/>\n",
			 f->fedname, no_choice, f->fedname);
	  printf("</span>\n");
	}
	printf("</div>\n");

	printf("<input type=\"hidden\" name=\"OPERATION\" value=\"EXPORT\"/>\n");
	if (load_auth_transfer_item("form", &p) != -1)
	  printf("%s", p);

	printf("\n<div class=\"transfer_submit_area\">\n");

	p = var_ns_get_value(dacs_conf->conf_var_ns, "Conf",
						 "transfer_submit_label");
	printf("<input type=\"submit\" value=\" %s \"/>\n",
		   (p != NULL) ? p : default_submit_label);

	printf("</div>\n");
	printf("</form>\n");
	printf("</div>\n");

	if (load_auth_transfer_item("epilogue", &p) != -1)
	  printf("%s", p);

	if (load_auth_transfer_item("trailer", &p) != -1)
	  printf("%s", p);
	else
	  emit_html_trailer(stdout);
  }
  else {
	*errmsg = "Request for unsupported FORMAT";
	goto fail;
  }

 done:

  return(0);
}

static Dsvec *
parse_cookie_lines(char *buf)
{
  char *p, *s;
  Dsvec *dsv;

  dsv = dsvec_init(NULL, sizeof(char *));
  s = buf;
  while ((p = strsep(&s, "\n")) != NULL) {
    if (*p != '\0')
      dsvec_add_ptr(dsv, p);
  }
  dsvec_add_ptr(dsv, NULL);

  return(dsv);
}

/*
 * A client is asking the initial federation to export a particular identity
 * (if there is one set of credentials, the default is to export that
 * identity).
 *
 * Procedure:
 * 1. Check that credentials for the requested identity exist (or that there
 *    is a suitable default) and are valid;
 * 2. Check that the requested target federation is recognized; send it a TOKEN
 *    request, passing the identity and expecting a response that is the URL
 *    that contains the transfer token in its query component
 * 3. Redirect the client to the URL
 *
 * Arguments:
 * DACS_IDENTITY: the identity to export (valid matching credentials must be
 *  supplied); if absent, there must be only one set of credentials and that
 *  will be selected
 * TARGET_FEDERATION: the canonical name of the federation to which the
 *  identity should be exported
 * TRANSFER_SUCCESS_URL: optionally, a URL to which the caller should be
 *  redirected if the transfer is successful; if absent, a configured URL
 *  or default may be used
 * TRANSFER_ERROR_URL: optionally, a URL to which the caller should be
 *  redirected if the transfer fails; if absent, a configured URL
 *  or default may be used
 *
 * Config:
 * TRANSFER_ERROR_HANDLER: optionally, a URL to which the caller should be
 * redirected if the transfer fails
 */
static int
do_export(Kwv *kwv, char **errmsg)
{
  int argnum, n, reply_len, status_code;
  unsigned int ncookies;
  char *error_url, *full_identity, *identity, *remote_addr, *success_url;
  char **admin_cookies, *buf, *p, *reply, *target_fed, *target_url;
  Cookie *cookies;
  Credentials *cr, *credentials;
  DACS_name dacs_name;
  Dsvec *dsv, *feds;
  Federation *f;
  Http_params *params;

  /*
   * XXX are target federation names per jurisdiction
   * or federation-wide?  There should not be duplicate target federation
   * names.
   */
	
  success_url = kwv_lookup_value(kwv, "TRANSFER_SUCCESS_URL");
  error_url = kwv_lookup_value(kwv, "TRANSFER_ERROR_URL");

  if ((target_fed = kwv_lookup_value(kwv, "TARGET_FEDERATION")) == NULL) {
	*errmsg = "TARGET_FEDERATION argument is required";

  fail:
	do_fail("Export failed", *errmsg);

	return(-1);
  }

  /* Lookup target_fed */
  if ((feds = get_transfer_federation_names()) == NULL) {
	*errmsg = "No transfer federations found";
	goto fail;
  }
  if ((f = lookup_federation(feds, target_fed)) == NULL) {
	*errmsg = ds_xprintf("Lookup of target federation \"%s\" failed",
						 target_fed);
	goto fail;
  }

  target_url = f->uri;
  log_msg((LOG_TRACE_LEVEL, "Target URL is \"%s\"", target_url));

  if (get_cookies(NULL, &cookies, &ncookies) == -1) {
	*errmsg = "Cookie parse error";
	goto fail;
  }

  if (ncookies == 0) {
	*errmsg = "No credentials found";
	goto fail;
  }

  log_msg((LOG_DEBUG_LEVEL, "%d credential%s found",
		   ncookies, ncookies != 1 ? "s" : ""));

  if ((remote_addr = getenv("REMOTE_ADDR")) == NULL) {
	*errmsg = "No REMOTE_ADDR found";
	goto fail;
  }

  n = get_valid_credentials(cookies, remote_addr, 0, &credentials);
  if (n == -1) {
	*errmsg = "Error locating valid credentials";
	goto fail;
  }
  if (n == 0) {
	*errmsg = "No valid credentials found";
	goto fail;
  }

  identity = kwv_lookup_value(kwv, "DACS_IDENTITY");
  if (identity == NULL) {
	if (n == 1) {
	  if ((identity = auth_identity_from_credentials(credentials)) == NULL) {
		*errmsg = "Invalid default credentials";
		goto fail;
	  }
	}
	else {
	  *errmsg = "DACS_IDENTITY argument is required";
	  goto fail;
	}
  }

  if (parse_dacs_name(identity, &dacs_name) != DACS_USER_NAME) {
	*errmsg = "Invalid DACS_IDENTITY";
	goto fail;
  }
  if (dacs_name.federation == NULL)
	dacs_name.federation = conf_val(CONF_FEDERATION_NAME);
  if (dacs_name.jurisdiction == NULL)
	dacs_name.jurisdiction = conf_val(CONF_JURISDICTION_NAME);
  full_identity = auth_identity(dacs_name.federation, dacs_name.jurisdiction,
								dacs_name.username, NULL);

  for (cr = credentials; cr != NULL; cr = cr->next) {
	char *id;

	if ((id = auth_identity_from_credentials(cr)) == NULL) {
	  *errmsg = "Invalid credentials found";
	  goto fail;
	}
	if (streq(id, full_identity))
	  break;
  }

  if (cr == NULL) {
	*errmsg = ds_xprintf("No matching credentials found for \"%s\"",
						 full_identity);
	goto fail;
  }

  if (validate_credentials_ip(cr, remote_addr, errmsg) == -1)
	goto fail;

  /*
   * Request a token from the target federation.
   * If successful, the reply will be a URL that includes the token
   * in the query component; the user should be redirected to that URL
   * to complete the transfer.
   */
  dsv = dsvec_init_size(NULL, sizeof(Http_params), 10);
  argnum = 0;

  params = http_param(dsv, "OPERATION", "TOKEN", NULL, 0);
  argnum++;

  params = http_param(dsv, "DACS_IDENTITY", full_identity, NULL, 0);
  argnum++;

  params = http_param(dsv, "INITIAL_FEDERATION",
					  conf_val(CONF_FEDERATION_NAME), NULL, 0);
  argnum++;

  params = http_param(dsv, "CLIENT_ADDR", remote_addr, NULL, 0);
  argnum++;

  if (cr->role_str != NULL && *cr->role_str != '\0') {
	params = http_param(dsv, "ROLES", cr->role_str, NULL, 0);
	argnum++;
  }

  if (success_url != NULL) {
	params = http_param(dsv, "TRANSFER_SUCCESS_URL", success_url, NULL, 0);
	argnum++;
  }

  if (error_url != NULL) {
	params = http_param(dsv, "TRANSFER_ERROR_URL", error_url, NULL, 0);
	argnum++;
  }

  if (kwv_lookup_value(kwv, "DACS_DEBUG") != NULL) {
	params = http_param(dsv, "DACS_DEBUG", "yes", NULL, 0);
	argnum++;
  }

  /*
   * We can identify the initial federation using DACS credentials, but
   * only if they were obtained offline (e.g., by the target federation using
   * the cookie utility and sending them to this jurisdiction over a secure
   * channel.  Administrative credentials created by this jurisdiction are
   * currently not helpful because the target federation cannot decrypt them
   * directly (it could invoke dacs_current_credentials to verify them).
   */
  admin_cookies = NULL;
  p = ds_xprintf("%s.cookies", target_fed);
  if (load_auth_transfer_item(p, &buf) != -1) {
	Dsvec *v;

	if ((v = parse_cookie_lines(buf)) != NULL) {
	  admin_cookies = (char **) dsvec_base(v);
	  log_msg((LOG_TRACE_LEVEL, "Sending cookie from \"%s\"", p));
	}
  }

  reply_len = -1;
  if (http_invoke(target_url, HTTP_POST_METHOD, HTTP_SSL_URL_SCHEME,
				  argnum, (Http_params *) dsvec_base(dsv), NULL,
				  admin_cookies,
				  &reply, &reply_len, &status_code, NULL) == -1
	  || status_code != 200) {
	*errmsg = ds_xprintf("Could not invoke URL: \"%s\" (status code=%d)",
						 target_url, status_code);

	if (error_url != NULL) {
	  emit_http_header_redirect(stdout, error_url);
	  return(-1);
	}

	goto fail;
  }

  if (kwv_lookup_value(kwv, "DACS_DEBUG") != NULL) {
	emit_html_header(stdout, NULL);
	printf("TOKEN request reply: <a href=\"%s\">link</a>\n", reply);
	printf("<br/>%s\n", reply);
  }
  else {
	Html_header_conf *hc;

	hc = emit_html_header_conf(NULL);
	hc->redirect_url = reply;
	emit_html_header(stdout, hc);
  }

  return(0);
}

/*
 * Target federation: respond to a request for a transfer token.
 * We assume that an ACL restricts the caller appropriately.
 *
 * Note that the token is opaque to the client, meaning that the target
 * federation can apply any semantics it wants, whatever degree of
 * security (encryption, MAC, etc.) it requires, and can unilaterally change
 * any aspect of the token.  This means that the two federations require
 * no coordination in this respect, other than agreeing on the overall
 * protocol.
 *
 * 1. We check that the requested identity can be imported and mapped
 *    (if necessary) to an identity in this federation
 * 2. Map this request to a use-only-once token (either by storing a
 *    persistent record or possibly by restricting its lifetime)
 * 3. Return a URL for the caller to redirect the client to; it must include
 *    an appropriate query component
 *
 * Arguments:
 * DACS_IDENTITY: the identity to export (valid matching credentials must be
 *  supplied); if absent, there must be only one set of credentials and that
 *  will be selected
 * INITIAL_FEDERATION: the canonical name of the federation that is
 *  requesting the token, which must be configured
 *
 * Returns: (dacs_auth_transfer.dtd?)
 * TOKEN: if successful, a unique identifier that this server can later map
 * to this request.
 * It should be difficult to guess, cryptographically protected against
 * modification and forgery, and have a configurable lifetime.  Expired tokens
 * should eventually be reaped.
 */
static int
do_token(Kwv *kwv, char **errmsg)
{
  unsigned int enc_len;
  char *b64_token, *client_addr, *identity, *initial_fed, *p, *token;
  char *error_arg, *error_url, *role_str, *success_arg, *success_url;
  char *id, *imported_identity, *import_url_arg, *lifetime_secs, *predicate;
  unsigned char *enc_token;
  time_t now;
  Crypt_keys *ck;
  DACS_name dacs_name;
  Ds ds;
  Kwv *kwv_auth;
  Kwv_vartab *transfer_vartab;

  if ((initial_fed = kwv_lookup_value(kwv, "INITIAL_FEDERATION")) == NULL) {
	*errmsg = "INITIAL_FEDERATION argument is required";

  fail:
	emit_html_header_status_line(stdout, "400", "Operation failed");
	return(-1);
  }

  if ((identity = kwv_lookup_value(kwv, "DACS_IDENTITY")) == NULL) {
	*errmsg = "DACS_IDENTITY argument is required";
	goto fail;
  }

  if ((client_addr = kwv_lookup_value(kwv, "CLIENT_ADDR")) == NULL) {
	*errmsg = "CLIENT_ADDR argument is required";
	goto fail;
  }

  if ((transfer_vartab = lookup_transfer_vartab(initial_fed, &id)) == NULL) {
	*errmsg = ds_xprintf("No config to import from federation \"%s\"",
						 initial_fed);
	goto fail;
  }
  log_msg((LOG_TRACE_LEVEL, "Using Transfer clause \"%s\"", id));

  kwv_auth = kwv_init(10);
  kwv_auth->dup_mode = KWV_NO_DUPS;

  predicate = conf_vartab_val(transfer_vartab, CONF_TRANSFER_PREDICATE);
  if (predicate != NULL) {
	char *result_str;
	Acs_expr_result st;

	st = eval(predicate, kwv, kwv_auth, &result_str, errmsg);
	if (st == ACS_EXPR_TRUE)
	  log_msg((LOG_TRACE_LEVEL, "Predicate result: True", st));
	else {
	  log_msg((LOG_TRACE_LEVEL, "Predicate failed, result: %d", st));
	  *errmsg = "Import permission is denied";
	  goto fail;
	}
  }

  log_msg((LOG_DEBUG_LEVEL, "Importation from federation \"%s\" is permitted",
		   initial_fed));		   

  if (parse_dacs_name(identity, &dacs_name) != DACS_USER_NAME
	  || dacs_name.federation == NULL || dacs_name.jurisdiction == NULL) {
	*errmsg = ds_xprintf("Invalid DACS_IDENTITY: \"%s\"", identity);
	goto fail;
  }
  p = conf_vartab_val(transfer_vartab, CONF_TRANSFER_REFEDERATE);
  if (p != NULL && strcaseeq(p, "yes")) {
	dacs_name.federation = conf_val(CONF_FEDERATION_NAME);
	dacs_name.jurisdiction = conf_val(CONF_JURISDICTION_NAME);
	imported_identity = auth_identity(dacs_name.federation,
									  dacs_name.jurisdiction,
									  dacs_name.username, NULL);
  }
  else
	imported_identity = identity;

  if ((success_url = kwv_lookup_value(kwv, "TRANSFER_SUCCESS_URL")) == NULL)
	success_url = conf_vartab_val(transfer_vartab, CONF_TRANSFER_SUCCESS_URL);
  if (success_url != NULL)
	success_arg = ds_xprintf("&TRANSFER_SUCCESS_URL=%s", success_url);
  else
	success_arg = "";

  if ((error_url = kwv_lookup_value(kwv, "TRANSFER_ERROR_URL")) == NULL)
	error_url = conf_vartab_val(transfer_vartab, CONF_TRANSFER_ERROR_URL);
  if (error_url != NULL)
	error_arg = ds_xprintf("&TRANSFER_ERROR_URL=%s", error_url);
  else
	error_arg = "";

  /*
   * It is a local decision whether the initial federation's roles can
   * be used here, but if the two federations are closely related, they
   * could conceivably be used as-is.
   */
  p = conf_vartab_val(transfer_vartab, CONF_TRANSFER_IMPORT_ROLES);
  if (p != NULL && strcaseeq(p, "yes")) {
	if ((role_str = kwv_lookup_value(kwv, "ROLES")) == NULL
		|| *role_str == '\0')
	  role_str = "";
	else {
	  if (!is_valid_role_str(role_str)) {
		*errmsg = ds_xprintf("Invalid role string: \"%s\"", role_str);
		goto fail;
	  }
	}
	log_msg((LOG_TRACE_LEVEL, "Importing roles: \"%s\"",
			 (*role_str == '\0') ? "(none)" : role_str));
  }
  else {
	role_str = "";
	log_msg((LOG_TRACE_LEVEL, "Not importing roles"));
  }
  kwv_replace(kwv_auth, "IMPORTED_ROLES", role_str);

  p = conf_vartab_val(transfer_vartab, CONF_TRANSFER_ROLES_EVAL);
  if (p != NULL) {
	char *result_str;
	Acs_expr_result st;

	st = eval(p, kwv, kwv_auth, &result_str, errmsg);
	if (acs_expr_error_occurred(st)) {
	  log_msg((LOG_ERROR_LEVEL, "Invalid ROLES* directive: %s", p));
	  goto fail;
	}

	if (st == ACS_EXPR_TRUE) {
	  if (!is_valid_role_str(result_str)) {
		*errmsg = ds_xprintf("Invalid replacement role string: \"%s\"",
							 role_str);
		goto fail;
	  }
	}

	role_str = result_str;
	kwv_replace(kwv_auth, "IMPORTED_ROLES", role_str);
  }

  lifetime_secs = conf_vartab_val(transfer_vartab,
								  CONF_TRANSFER_CREDENTIALS_LIFETIME_SECS);
  if (lifetime_secs != NULL) {
	time_t lifetime;

	if (strnum(lifetime_secs, STRNUM_TIME_T, &lifetime) == -1) {
	  *errmsg = "Invalid CREDENTIALS_LIFETIME_SECS";
	  goto fail;
	}
  }

  p = conf_vartab_val(transfer_vartab, CONF_TRANSFER_EXIT_EVAL);
  if (p != NULL) {
	char *result_str;
	Acs_expr_result st;

	kwv_replace(kwv_auth, "IMPORTED_USERNAME", dacs_name.username);
	st = eval(p, kwv, kwv_auth, &result_str, errmsg);
	if (acs_expr_error_occurred(st)) {
	  log_msg((LOG_ERROR_LEVEL, "Invalid EXIT* directive: %s", p));
	  goto fail;
	}

	if ((p = kwv_lookup_value(kwv_auth, "IMPORTED_ROLES")) != NULL) {
	  role_str = p;
	  if (*p != '\0' && !is_valid_role_str(role_str)) {
		*errmsg = ds_xprintf("Invalid exit role string: \"%s\"",
							 role_str);
		goto fail;
	  }
	}

	if ((p = kwv_lookup_value(kwv_auth, "IMPORTED_USERNAME")) != NULL) {
	  if (!is_valid_username(p)) {
		*errmsg = ds_xprintf("Invalid IMPORTED_USERNAME: \"%s\"", p);
		goto fail;
	  }
	  dacs_name.username = p;
	  imported_identity = auth_identity(dacs_name.federation,
										dacs_name.jurisdiction,
										dacs_name.username, NULL);
	}
  }

  ds_init(&ds);
  time(&now);
  ds_asprintf(&ds, "i=\"%s\"", imported_identity);
  /* XXX ua_hash??? */
  ds_asprintf(&ds, " t=\"%lu\"", (unsigned long) now);
  ds_asprintf(&ds, " ip=\"%s\"", client_addr);
  if (lifetime_secs != NULL)
	ds_asprintf(&ds, " l=\"%s\"", lifetime_secs);
  if (role_str != NULL)
	ds_asprintf(&ds, " r=\"%s\"", role_str);

  token = ds_buf(&ds);
  log_msg((LOG_TRACE_LEVEL, "token=\"%s\" (%d bytes + null)",
		   token, strlen(token)));

  ck = crypt_keys_from_vfs(ITEM_TYPE_FEDERATION_KEYS);
  enc_len = crypto_encrypt_string(ck, (unsigned char *) ds_buf(&ds),
								  ds_len(&ds) + 1, &enc_token);
  crypt_keys_free(ck);

  log_msg((LOG_TRACE_LEVEL, "Encrypted length: %d bytes", enc_len));
  log_msg((LOG_TRACE_LEVEL, "Encrypted: %s", hexdump(enc_token, enc_len)));
  mime_encode_base64(enc_token, enc_len, &b64_token);
  log_msg((LOG_TRACE_LEVEL, "Base64=\"%s\" (%d bytes + null)",
		   b64_token, strlen(b64_token)));

  if ((import_url_arg
	   = conf_vartab_val(transfer_vartab, CONF_TRANSFER_IMPORT_URL)) == NULL) {
	if ((import_url_arg = current_uri_no_query(NULL)) == NULL) {
	  *errmsg = "Can't construct IMPORT URL";
	  goto fail;
	}
  }

  emit_plain_header(stdout);
  printf("%s?OPERATION=IMPORT%s%s&TOKEN=%s%s\n",
		 import_url_arg, success_arg, error_arg, url_encode(b64_token, 0),
		 kwv_lookup_value(kwv, "DACS_DEBUG") != NULL ? "&DACS_DEBUG=yes" : "");
  emit_plain_trailer(stdout);

  return(0);
}

/*
 * Target federation: respond to a request to import credentials identified
 * by a token.
 * Arguments:
 *  TOKEN: the token previously created for this request; if valid, it
 *  identifies the identity to be imported
 *  SUCCESS_URL:
 *  ERROR_URL:
 *
 * Returns: if successful, new credentials for the imported identity
 */
static int
do_import(Kwv *kwv, char **errmsg)
{
  char *b64_token, *creation, *error_url, *identity, *success_url;
  char *client_addr, *cookie, *it, *lifetime_secs_str, *remote_addr, *role_str;
  unsigned char *enc_token, *token;
  long enc_len;
  unsigned int max_token_lifetime_secs;
  time_t creation_time_secs, now;
  Credentials *cr;
  Crypt_keys *ck;
  DACS_name dacs_name;
  Kwv *token_kwv;
  static Kwv_conf conf = {
    "=", "\"'", NULL, KWV_CONF_DEFAULT, " \t", 10, NULL, NULL
  };

  success_url = kwv_lookup_value(kwv, "TRANSFER_SUCCESS_URL");
  error_url = kwv_lookup_value(kwv, "TRANSFER_ERROR_URL");

  if ((b64_token = kwv_lookup_value(kwv, "TOKEN")) == NULL) {
	*errmsg = "TOKEN argument is required";

  fail:
	if (error_url != NULL)
	  emit_http_header_redirect(stdout, error_url);
	else
	  do_fail("Import failed", *errmsg);

	return(-1);
  }

  log_msg((LOG_TRACE_LEVEL, "Base64=\"%s\" (%d bytes + null)",
		   b64_token, strlen(b64_token)));

  if ((enc_len = mime_decode_base64(b64_token, &enc_token)) == -1) {
	*errmsg = "base64 decoding failed";
	goto fail;
  }
  log_msg((LOG_TRACE_LEVEL, "Encrypted length: %d bytes", enc_len));
  log_msg((LOG_TRACE_LEVEL, "Encrypted: %s", hexdump(enc_token, enc_len)));

  ck = crypt_keys_from_vfs(ITEM_TYPE_FEDERATION_KEYS);
  if (crypto_decrypt_string(ck, enc_token, enc_len, &token, NULL) == -1) {
	crypt_keys_free(ck);
	*errmsg = "Decryption failed";
	goto fail;
  }
  log_msg((LOG_TRACE_LEVEL, "token=\"%s\" (%d bytes + null)",
		   token, strlen((char *) token)));
  crypt_keys_free(ck);

  /* Decode and validate the token. */
  if ((token_kwv = kwv_make_sep(NULL, (char *) token, &conf)) == NULL) {
	*errmsg = "Token parse failed";
	goto fail;
  }

  if ((identity = kwv_lookup_value(token_kwv, "i")) == NULL) {
	*errmsg = "Token has no identity?";
	goto fail;
  }

  if ((client_addr = kwv_lookup_value(token_kwv, "ip")) == NULL) {
	*errmsg = "Token has no client IP";
	goto fail;
  }

  if ((remote_addr = getenv("REMOTE_ADDR")) != NULL) {
	if (!streq(client_addr, remote_addr)) {
	  /* XXX This test should be configurable */
	  log_msg((LOG_INFO_LEVEL,
			   "Importing \"%s\": IP addr mismatch (orig %s vs req %s)",
			   identity, client_addr, remote_addr));
	}
  }

  /* This is an optional token element. */
  if ((role_str = kwv_lookup_value(token_kwv, "r")) == NULL)
	role_str = "";

  if ((lifetime_secs_str = kwv_lookup_value(token_kwv, "l")) == NULL)
	lifetime_secs_str = conf_val(CONF_AUTH_CREDENTIALS_DEFAULT_LIFETIME_SECS);

  if ((creation = kwv_lookup_value(token_kwv, "t")) == NULL) {
	*errmsg = "Token has no creation time?";
	goto fail;
  }
  if (strnum(creation, STRNUM_TIME_T, &creation_time_secs) == -1) {
	*errmsg = "Token has invalid creation time?";
	goto fail;
  }

  /* Check if the transfer token is "too old". */
  time(&now);
  if (conf_val_uint(CONF_AUTH_TRANSFER_TOKEN_LIFETIME_SECS,
					&max_token_lifetime_secs) != 1)
	max_token_lifetime_secs = DEFAULT_MAX_TOKEN_LIFETIME_SECS;
  log_msg((LOG_TRACE_LEVEL,
		   "Max token lifetime is %u secs", max_token_lifetime_secs));
  if ((now - creation_time_secs) > max_token_lifetime_secs) {
	*errmsg = "Token has expired";
	goto fail;
  }

  if (parse_dacs_name(identity, &dacs_name) != DACS_USER_NAME
	  || dacs_name.federation == NULL || dacs_name.jurisdiction == NULL) {
	*errmsg = "Invalid DACS_IDENTITY";
	goto fail;
  }

  /* Identity is already mapped if it's supposed to be. */
  cr = make_credentials(dacs_name.federation, dacs_name.jurisdiction,
						dacs_name.username, client_addr, role_str,
						lifetime_secs_str,
						AUTH_STYLE_IMPORTED | AUTH_STYLE_ALIEN,
						AUTH_VALID_FOR_ACS, conf_val(CONF_JURISDICTION_NAME),
						NULL);

  /* Check for revocation */
  if (vfs_lookup_item_type(ITEM_TYPE_REVOCATIONS) != NULL)
	it = "revocations";
  else
	it = NULL;

  if (it != NULL && check_revocation(cr, kwv, it, 0) != 0) {
	*errmsg = "Authentication failed";
	goto fail;
  }

  /* Create and return new credentials via an HTTP cookie. */
  if (make_set_auth_cookie_header(cr, NULL, 0, &cookie) == -1) {
	*errmsg = "Could not create cookie";
	goto fail;
  }

  printf("%s", cookie);

  if (kwv_lookup_value(kwv, "DACS_DEBUG") == NULL) {
	Html_header_conf *hc;

	hc = emit_html_header_conf(NULL);

	/* Redirect the client as requested or configured. */
	if (success_url != NULL) {
	  hc->redirect_url = success_url;
	  emit_html_header(stdout, hc);
	}
	else {
	  emit_html_header(stdout, NULL);
	  printf("Credentials have been transferred.\n");
	  emit_html_trailer(stdout);
	}
  }
  else {
	emit_html_header(stdout, NULL);
	printf("\nToken: '%s'<br/>\n", token);
	if (success_url != NULL)
	  printf("\nRedirect: <a href=\"%s\">%s</a><br/>\n",
			 success_url, success_url);
	else {
	  /* ??? */
	  printf("Credentials have been transferred.\n");
	}
  }

  return(0);
}

int
main(int argc, char **argv)
{
  int st;
  char *errmsg, *op;
  Kwv *kwv;

  errmsg = "Internal error";

  if (dacs_init(DACS_WEB_SERVICE, &argc, &argv, &kwv, &errmsg) == -1) {

  fail:
	log_msg((LOG_ERROR_LEVEL, "Failed: %s", errmsg));

	exit(1);
  }

  if (should_use_argv) {
	if (argc > 1) {
	  errmsg = "Usage: unrecognized parameter";
	  do_fail("main", errmsg);
	  goto fail;
	}
  }

  kwv_set_mode(kwv, "+i");
  if ((op = kwv_lookup_value(kwv, "OPERATION")) == NULL) {
	errmsg = "Require OPERATION argument";
	do_fail("main", errmsg);
	goto fail;
  }

  if (strcaseeq(op, "PRESENTATION"))
	st = do_presentation(kwv, &errmsg);
  else if (strcaseeq(op, "EXPORT"))
	st = do_export(kwv, &errmsg);
  else if (strcaseeq(op, "TOKEN"))
	st = do_token(kwv, &errmsg);
  else if (strcaseeq(op, "IMPORT"))
	st = do_import(kwv, &errmsg);
  else {
	errmsg = ds_xprintf("Unrecognized OPERATION: \"%s\"", op);
	do_fail("main", errmsg);
	goto fail;
  }

  if (st == -1) {
	do_fail("main", errmsg);
	goto fail;
  }

  exit(0);
}
