#!/usr/bin/perl

# Copyright (c) 2003-2013
# Distributed Systems Software.  All rights reserved.
# $Id: dacs_error.in 2620 2013-01-22 17:52:34Z brachman $

use CGI;

$q = new CGI;

$error_code = $q->param("DACS_ERROR_CODE");
$federation = $q->param("DACS_FEDERATION");
$jurisdiction = $q->param("DACS_JURISDICTION");
$format = $q->param("FORMAT");

if ($format eq "HTML") {
  print "Content-type: text/html\n\n";
  print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n";
  print "<html><head><title>DACS Exception Report</title></head><body>\n";
}
else {
  print "Content-type: text/plain\n\n";
}

print "A DACS exception has occurred:\n\n";

if ($error_code eq "800") {
  $errmsg = "Authentication failed, invalid authenticating information";
}
elsif ($error_code eq "801") {
  $errmsg = "Authentication failed, invalid argument";
}
elsif ($error_code eq "802") {
  $errmsg = "Authentication failed, internal error";
}
elsif ($error_code eq "899") {
  $errmsg = "Authentication failed, reason unknown";
}
elsif ($error_code eq "900") {
  $errmsg = "Access denied, no applicable rule";
}
elsif ($error_code eq "901") {
  $errmsg = "Access denied, forbidden by rule";
}
elsif ($error_code eq "902") {
  $errmsg = "Access denied, user not authenticated";
}
elsif ($error_code eq "903") {
  $errmsg = "Access denied, user access revoked";
}
elsif ($error_code eq "904") {
  $errmsg = "Access denied, redirect";
}
elsif ($error_code eq "905") {
  $errmsg = "Access denied, acknowledgement needed";
}
elsif ($error_code eq "906") {
  $errmsg = "Access denied, low authentication level";
}
elsif ($error_code eq "907") {
  $errmsg = "Access denied, simple redirect";
}
elsif ($error_code eq "908") {
  $errmsg = "Access denied, too many credentials were submitted";
}
elsif ($error_code eq "909") {
  $errmsg = "Access denied, inactivity timeout";
}
elsif ($error_code eq "998") {
  $errmsg = "Access denied, reason unknown";
}
else {
  $errmsg = "Unknown error";
}

if ($format eq "HTML") {
  print "<p>\n";
  if ($federation ne "") {
    print "Federation: <tt>$federation</tt><br>\n";
  }

  if ($jurisdiction ne "") {
    print "Jurisdiction: <tt>$jurisdiction</tt><br>\n";
  }

  if ($error_code ne "") {
    print "Error Code: <tt>$error_code</tt><br>\n";
    print "Error Message: <tt>$errmsg</tt><br>\n";
  }
  print "<pre>\n";
}
else {
  if ($federation ne "") {
    print "Federation: $federation\n";
  }

  if ($jurisdiction ne "") {
    print "Jurisdiction: $jurisdiction\n";
  }

  if ($error_code ne "") {
    print "Error Code: $error_code\n";
    print "Error Message: $errmsg\n";
  }
}

$val = $ENV{"REDIRECT_ERROR_NOTES"};
if ($val ne "") {
    print "$val\n\n";
}

print "Environment:\n";
foreach $var (sort(keys(%ENV))) {
    $val = $ENV{$var};
    $val =~ s|\n|\\n|g;
    $val =~ s|"|\\"|g;
    print "${var}=\"${val}\"\n";
}

if ($ENV{"REQUEST_METHOD"} eq "POST") {
	printf "\nPOST method:\n";
	$n = read(STDIN, $inp, 8192);
	print "'$inp'";
}

# Ensure result is over 512 bytes long to avoid IE's replacement of this
# message with its "friendly HTTP error messages".

print "                                                                ";
print "                                                                ";
print "                                                                ";
print "                                                                ";
print "                                                                ";
print "                                                                ";
print "                                                                ";
print "                                                                ";

if ($format eq "HTML") {
  print "</pre></body></html>\n";
}

exit 0;
