#!/usr/bin/perl -w
# Revision $Id: //Tuxedo/RELEASE/Product/webroot/IRISLink.cgi#15 $
# She-Bang identifies the location of the Perl executable.
# This does not need to be configured on Windows installations.
#-------------------------------------------------------------------------------
# The package name used here must be the same as that in the CgiSettings modules.
package DgwWeb;

#-------------------------------------------------------------------------------
# IRISLink Sockets CGI
our $PROGRAM_NAME = "IRISLink CGI ";

#-------------------------------------------------------------------------------
# SYNTAX:
#   This program should be called by a web page's <form action="IRISLink.cgi">.
#
# DESCRIPTION:
#   The CGI reads the input from the browser and sends this input
#   across a socket to the be processed by Degree Works residing
#   on another machine.
#
#   When using Active State's Perl Windows distribution (www.activestate.com)
#   use Perl for ISAPI with NT Server Internet Information Server. Otherwise,
#   problems with NT piping of STDIN may result.
#-------------------------------------------------------------------------------
use strict;
use warnings;
no warnings qw(redefine);

# SITE CONFIGURATION is now stored in CgiSettings.pm so that IRISLink.cgi does not 
# need to be backed up and edited after each release. 

# The configuration file CgiSettingsDir.pm must exist in the same directory as IRISLink.cgi.
# A variable called $ConfigDirectory is defined in CgiSettingsDir.pm which identifies the
# location of the CgiSettings.pm script.
# The reason we are doing this instead of just looking within the PERL5LIB directories,
# is because we may have multiple webroot/documentroot environments withine one web server instance.

# If your web server files are located on your DegreeWorks administrative server,
# it is recommended to store CgiSettings.pm in your $LOCAL_HOME/perl_libs directory. 
# If you are using CAS, then AuthCasDgw.pm should also exist in this directory
# or in one of the $ENV{'PERL5LIB'} directories.

use CgiSettingsDir;

my $MyConfigDirectory;
BEGIN { $MyConfigDirectory = $ConfigDirectory; }
use lib $MyConfigDirectory;

use CgiSettings;
#-------------------------------------------------------------------------------
# PERL MODULE SETUP
#-------------------------------------------------------------------------------
use IO::Socket;
use CGI;
use CGI qw(:standard);
use CGI::Carp;
use CGI::Cookie;

use if $CAS_Enabled, "AuthCasDgw";

if ($DEBUG_LEVEL > 0) 
{
    open(LOGFILE, ">>$LogFile") or DoExit("Log file could not be opened.");
}

#-------------------------------------------------------------------------------
# PROGRAM VARIABLES
#-------------------------------------------------------------------------------

our $NL = "\n";
local our %Parameters = ();
local our $casUser="";

# Sockets variables
our $AF_INET     = AF_INET();
our $SOCK_STREAM = SOCK_STREAM();

local our $IpAddress=""; # User's IP Address from HTTPD server
local our $Passport="";  # User's Passport from HTTPD server
local our $InputData=""; # The input from the browser
local our $ContentType=""; # Content Type

# HTTPD Vars
# Default to empty strings to avoid warnings
local our $ENV_REMOTE_ADDR    = $ENV {'REMOTE_ADDR'} || "";
local our $ENV_CONTENT_LENGTH = $ENV {'CONTENT_LENGTH'} || "";
local our $ENV_CONTENT_TYPE   = $ENV {'CONTENT_TYPE'} || "";
local our $ENV_QUERY_STRING   = $ENV {'QUERY_STRING'} || "";
local our $ENV_HTTP_COOKIE    = $ENV {'HTTP_COOKIE'} || "";
local our $ENV_HTTP_REFERER   = $ENV {'HTTP_REFERER'} || "";
local our $ENV_HTTP_ORIGIN    = $ENV {'HTTP_ORIGIN'} || "";

##DebugPrint ("+++++++++++ SPECIAL TESTING ++++++++++++++++");
##$ENV_HTTP_REFERER = "";
##$ENV_HTTP_ORIGIN  = "http://m0XXXX6.ellucian.com/dev/rdeans";

# The FORM METHOD requested by the client.
local our $REQUESTED_METHOD   = $ENV {'REQUEST_METHOD'};

our $EXP_CONTENT_TYPE = 'application/x-www-form-urlencoded';

our $PASSPORT_LABEL = 'PASSPORT';
our $NAME_VALUE_SEP = '=';     # Name value separator
our $FIELD_SEP      = '&';     # Field separator
our $END_MSG_CHAR   = '#';     # Ends all messages                      #1.0f#

our $EXTERNAL_ASSERTION_VALUE = 'ASSERT_VALUE';
our $EXTERNAL_ASSERTION_IS_UDC = 'ASSERT_ISUDC';

#-------------------------------------------------------------------------------
# MAIN
#-------------------------------------------------------------------------------


DebugPrint("###########################################################################");
DebugPrint("$PROGRAM_NAME request begining at: ", scalar localtime(time()));
DebugPrint("---------------------------------------------------------------------------");

DebugPrint("DEF_PORTNUMBER       = \"$DEF_PORTNUMBER\"");
DebugPrint("DEF_SERVER_NAME      = \"$DEF_SERVER_NAME\"");
DebugPrint("ALLOWED_URLS         = \"@ALLOWED_URLS\"");
DebugPrint("ACCEPTABLE_METHOD    = \"$ACCEPTABLE_METHOD\"");
DebugPrint("REQUIRE_HTTP_REFERER = \"$REQUIRE_HTTP_REFERER\"");
DebugPrint("DEBUG_LEVEL          = \"$DEBUG_LEVEL\"");
DebugPrint("DEF_TIMEOUT          = \"$DEF_TIMEOUT\"");
DebugPrint("ENV_HTTP_REFERER     = \"$ENV_HTTP_REFERER\"");
DebugPrint("ENV_HTTP_ORIGIN      = \"$ENV_HTTP_ORIGIN\"");

# If the user calls IRISLink.cgi?CheckModPerl, then check to see if
# we are running under mod_perl. This would only be done manually by an
# administrator to, for example, check the configuration of mod_perl.
# It would never by used by the production Degree Works software.
if ($ENV_QUERY_STRING eq "CheckModPerl")
{
  # Note: the following subroutine will not return. It outputs a
  # message and exits.
  CheckModPerl();
}

# If the port number has not yet been configured
if ($DEF_PORTNUMBER == 9999)
{
  DoExit("The DEF_PORTNUMBER is currently set to <b>$DEF_PORTNUMBER</b> " .
         "and the DEF_SERVER_NAME is currently set to <b>$DEF_SERVER_NAME</b>; " .
         "please configure both in <b>IRISLink.cgi</b> to match your environment - " .
         "you can do a <b>webshow</b> on the DegreeWorks server to find out " .
         "the port web08 is using.");
}
   
#-- Open a socket connection
our $g_oSocket = IO::Socket::INET->new (PeerAddr	=> $DEF_SERVER_NAME,
                                        PeerPort	=> $DEF_PORTNUMBER,
                                        Proto		  => "tcp",
                                        Type		  => SOCK_STREAM,
                                        Reuse		  => 1,
                                        Timeout		=> $DEF_TIMEOUT)
or DoExit("Couldn't connect to $DEF_SERVER_NAME:$DEF_PORTNUMBER : $@\n", "die");

$g_oSocket->autoflush(1);

#-- Get the browser input
$InputData = GetRestrictedInput(); 

#-- Need to do this after we get the request since CheckReferer uses the InputData
#-- Check that the request came from a valid HTTP_REFERER.
if ($REQUIRE_HTTP_REFERER) 
{
    CheckReferer(); 
}

DebugPrint("CAS enabled? " . ($Parameters{CAS} ? $Parameters{CAS} : "NOT ENABLED"));
if ($Parameters{CAS} && ($Parameters{CAS} eq 'ENABLED') && $CAS_Enabled)
{
       my $casTicket = LoginCAS();

       if ($casTicket eq "")
       {
           DebugPrint("CAS authentication not validated");
           print "CAS authentication not validated";
           exit(0);
       }

       DebugPrint('CAS InputData: ' . $InputData);
}

if (length ($External_AuthAssertion_Name) ne 0)
{
   HandleExternalAuthAssertion();
}

#-- Append the field separator.
$InputData .= $FIELD_SEP; 

#-- Append user IP address and passport
$InputData .= GetUserId(); 

#-- Append the end character, Ends all messages
$InputData .= $END_MSG_CHAR;

DebugPrint("Sending message...");
$g_oSocket->send($InputData) or DoExit("Can't send: $!\n", "die");

#-- Deliver the reply                                           #1.0g begin#
#my ($Passport, @Data);

local our $g_sResponse = "";
local our $g_sTemp = "";

DebugPrint("Receiving reply...");
my $l_bFirstLineRead = 0;
my $bIrislinkError = $FALSE;
my $Count = 0;

# Ellucian:RAYMOND: The recv was acting as if it was failing when it seems it 
#                   was more of a warning or bogus; instead of dying on a recv
#                   we will just print to debug and keep going.
#while (1)
my $RecvPassport = "";
while ($Count < 10000)
{
  $Count = $Count + 1;
  $g_oSocket->recv($g_sTemp, 1024) or DebugPrint("Recv failed");
  if ($DEBUG_LEVEL > 1) 
  {
	  DebugPrint("<<<----------------------this recv");
	  DebugPrint($g_sTemp);
  }
	if (!$l_bFirstLineRead)
	{
		$l_bFirstLineRead = 1;
		$g_sTemp =~ s/PASSPORT=(\w+)\n//;
		$RecvPassport = ( $1 ? $1 : "" );
		DebugPrint("Passport: [$RecvPassport]");
	}

	if ($g_sTemp =~ m/\<\$FINISHED\$\>/g)
	{
    DebugPrint('Entire <$FINISHED$> tag found in response - removing it now');
          # Now remove FINISHED from the response
    #$g_sTemp =~ s/\<\$FINISHED\$\>\n//g;
    $g_sTemp =~ s/\<\$FINISHED\$\>//g;              #1.1e
          # Add the resulting string to our response
    $g_sResponse .= $g_sTemp;
    last;
	}
  else # FINISHED is not in sTemp                       #1.1b begin
  {
    # See if the start of <$FINISHED$> is on the end of the sResponse
    # and the rest of <$FINISHED$> is is in sTemp
    # Since <$FINISHED$> is 12 characters we will get the last 11
    # chars from the sResponse - the > may be in sTemp
    my $sFinished = substr ($g_sResponse, -11, 11) . $g_sTemp;
    if ($sFinished =~ m/\<\$FINISHED\$\>/g)
    {
      DebugPrint('Partial <$FINISHED$> tag found in response - removing entire tag now');
      # Add the last part of FINISHED to the response
      $g_sResponse .= $g_sTemp;
      # Now remove FINISHED from the response
      #$g_sResponse =~ s/\<\$FINISHED\$\>\n//g;
      $g_sResponse =~ s/\<\$FINISHED\$\>//g;              #1.1e
      # And now we are done
      last;
     } # finished
   } # else                                             #1.1b end
	$g_sResponse .= $g_sTemp;
}

# If the response says this is an IRISLink error being returned
# The 2nd line should look like this for errors: <!-- [DWERROR] -->
if ($g_sResponse =~ m/-- \[DWERROR\] --/g)
{
  # The error line is supposed to be an HTML comment so we don't have to remove it
  # Make sure to send a content type of html instead of xml or pdf etc since this
  # error will be a simple html/js error
  $bIrislinkError = $TRUE;
  DebugPrint("IRISLink Error is being returned because we found [DWERROR] in response");
}

if ($DEBUG_LEVEL > 1) 
{
  DebugPrint("<<<--- Total Response --->>>");                  #1.1b
  DebugPrint($g_sResponse);
  DebugPrint("<<<--end Total Response-->>>");
}

if ($RecvPassport ne "")                                         #1.1f
  {SendHeader($PASSPORT_LABEL . '=' . $RecvPassport, $bIrislinkError);}
else # no passsport found - must be a pdf file being returned
  {SendHeader("", $bIrislinkError);}

if ($ContentType =~ m/jxml/i) 
{
	# replace all carriage-returns and line-feeds with nothing
	$g_sResponse =~ s/\n//g;
	$g_sResponse =~ s/\r//g;

	# replace all apostrophes with &apos;
	$g_sResponse =~ s/\'/\&apos\;/g;
	$g_sResponse =~ s/\(\&apos\;/\(\'/g;
	$g_sResponse =~ s/\&apos\;\)/\'\)/g;

	# replace double quotes
	#$g_sResponse =~ s/\"/\\\"\;/g;
}
print $g_sResponse;

#-- Close the socket
close($g_oSocket);

DebugPrint("---------------------------------------------------------------------------");
DebugPrint("$PROGRAM_NAME request finished at: ", scalar localtime(time()));
DebugPrint("***************************************************************************");

close(LOGFILE);

#-- Close the program.
exit(0);

#-------------------------------------------------------------------------------
# END MAIN
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# CheckModPerl - check whether or not we are using mod_perl display a message.
#
# This routine will not return. It always exits after issuing a message.
#-------------------------------------------------------------------------------
# PARAMETERS:
#   None are used
#
# RETURN:
#   This subroutine does not return.
#-------------------------------------------------------------------------------
sub CheckModPerl
{
  # Use eval to handle the case where ALLOW_CHECKMODPERL is not
  # declared in the CgiSettings file. In that case, treat as false.
  if ( ! eval {no strict; no warnings;$ALLOW_CHECKMODPERL} )
  {
    # If not allowed issue error message and exit with error.
    DebugPrint("?CheckModPerl was used, but not allowed by configuration");
    DoExit("CheckModPerl is not allowed","die");
  }

  my $sMessage="Mod_perl is not in use";
  if (exists($ENV{MOD_PERL}))
  {
    $sMessage="Mod_perl version=" . $ENV{MOD_PERL};
  }

  print "Content-type: text/html\n\n"; # Send the content type and blank line.

  print << "END_OF_MESSAGE";
<html>
<head>
<title>$PROGRAM_NAME - Check For Mod_Perl</title>
</head>
<body>
<br>
<center>
<font size="+2">$sMessage</font><br>
</center>
</body>
</html>
END_OF_MESSAGE

  DebugPrint("Check for mod_perl: $sMessage");

  exit(0);

}  # CheckModPerl

#-------------------------------------------------------------------------------
# CheckReferer - Check that the request came from a valid HTTP_REFERER or HTTP_ORIGIN
#-------------------------------------------------------------------------------
# PARAMETERS:
#   None are used
#
# RETURN:
#   0 - If processing completes; Else exit the program.
#-------------------------------------------------------------------------------
sub CheckReferer 
{
    DebugPrint('>>>CheckReferer().');

    my $IsLogon = $FALSE;
    if ($InputData =~ /SERVICE="?LOGON"?/)  
    {
      $IsLogon = $TRUE;
    }
      
    # If both REFERER and ORIGIN are missing
    if ($ENV_HTTP_REFERER eq "" && $ENV_HTTP_ORIGIN eq "")
    {
      # Give a better error if our new Luminis variable is not defined; we don't
      # want to encounter an ugly perl error
      unless(defined($ENABLE_LUMINIS_INTEGRATION))
      {
        DebugPrint ("ENABLE_LUMINIS_INTEGRATION is not defined in CgiSettings.pm and " .
                    "the REFERER and ORIGIN are missing - please add that variable and " .
                    " set it to TRUE if you are using Luminis integration.");
        DoExit("The browser did not send HTTP_REFERER or HTTP_ORIGIN");
      }
      
      # If this is a logon request and Luminis is in use then allow
      # the absence of REFERER/ORIGIN
      if ($ENABLE_LUMINIS_INTEGRATION && $IsLogon)
      {
        DebugPrint("REFERER/ORIGIN are missing but Luminis is enabled and this is a LOGON request - so allow");
        DebugPrint('---CheckReferer().');
        return(0);
      }
      else # Not a logon and not REFERER/ORIGIN - so give an error
      {
        if (!$ENABLE_LUMINIS_INTEGRATION)
        {
          DebugPrint("REFERER/ORIGIN are missing and Luminis is disabled - can't allow request");
        }
        elsif (!$IsLogon)
        {
          DebugPrint("REFERER/ORIGIN are missing and Luminis is enabled but this is not a LOGON request - can't allow request");
        }

        DoExit("The request did not include appropriate headers.");
      }
    }
    
    #-- At this point we know that one or both of the Referer or Origin have a value
    
    my $RefererIsOK = $TRUE;
    my $OriginIsOK  = $TRUE;

    # REFERER check
    if ($ENV_HTTP_REFERER ne "") # not blank
    {
      DebugPrint("REFERER was sent - we will check it against our allowed-list");
      $RefererIsOK = $FALSE;
      foreach my $url (@ALLOWED_URLS) 
      {
        if ($url eq "" ||
            $ENV_HTTP_REFERER =~  /https?\:\/\/$url\//i)
        {
          DebugPrint("REFERER matches allowed-url [$url]");
          $RefererIsOK = $TRUE;
        }
      }
    }
    
    # ORIGIN check
    if ($ENV_HTTP_ORIGIN ne "") # not blank
    {
      DebugPrint("ORIGIN was sent - we will check it against our allowed-list");
      $OriginIsOK = $FALSE;
      foreach my $url (@ALLOWED_URLS) 
      {
        if ($url eq "" ||
            $ENV_HTTP_ORIGIN =~  /https?\:\/\/$url/i)    # no trailing / at end of url        
        {
          DebugPrint("ORIGIN matches allowed-url [$url]");
          $OriginIsOK = $TRUE;
        }
      }
    }

    if ($RefererIsOK && $OriginIsOK) 
    {
        DebugPrint('Both the REFERER and the ORIGIN are valid!');
        DebugPrint('---CheckReferer().');
        return(0);
    } 
    elsif (!$RefererIsOK)
    {
        DebugPrint("Request was made from an invalid URL - invalid REFERER.");
        DoExit("Request was made from an invalid URL.");
    }
    elsif (!$OriginIsOK)
    {
        DebugPrint("Request was made from an invalid URL - invalid ORIGIN.");
        DoExit("Request was made from an invalid URL");
    }

}

#-------------------------------------------------------------------------------
# DebugPrint - Send the httpd header with message and die or exit.
#-------------------------------------------------------------------------------
# PARAMETERS:
#   $ErrorMsg, $Action
#
# RETURN:
#   0 - If processing completes; Else exit the program.
#-------------------------------------------------------------------------------
sub DebugPrint 
{
    if ($DEBUG_LEVEL > 0) {
        print LOGFILE @_, $NL;
    }
}

#-------------------------------------------------------------------------------
# DoExit - Send the httpd header with message and die or exit.
#-------------------------------------------------------------------------------
# PARAMETERS:
#   $ErrorMsg, $Action
#
# RETURN:
#   0 - If processing completes; Else exit the program.
#-------------------------------------------------------------------------------
sub DoExit
{
    DebugPrint('>>>DoExit().');

    my ($ErrorMsg, $Action) = @_;        # Error message
    print "Content-type: text/html\n\n"; # Send the content type and blank line.

    print << "END_OF_MESSAGE";
<html>
<head>
<title>$PROGRAM_NAME Error</title>
</head>
<body>
<br>
<center>
<font size="+2">$PROGRAM_NAME Error:</font><br>
<br>
<font size="+1">
$ErrorMsg
</font>
</center>
</body>
</html>
END_OF_MESSAGE

    DebugPrint("DoExit Error: ", $ErrorMsg);

    if ($Action && $Action eq "die") {
        confess();
    } else {
        exit(0);
    }
}

#-------------------------------------------------------------------------------
# GetRestrictedInput
#   Get the input from the browser restricted to $ACCEPTABLE_METHOD which
#   may be "POST", "GET" or "BOTH".
#-------------------------------------------------------------------------------
# PARAMETERS:
#   None are used
#
# RETURN:
#   $Input
#-------------------------------------------------------------------------------
sub GetRestrictedInput
{
    DebugPrint('>>>GetRestrictedInput().');
    my ($Input);   # The input from the query string or a form
    $Input = "";
    my $InputReturn = "";

    if (($REQUESTED_METHOD eq $ACCEPTABLE_METHOD) or ($ACCEPTABLE_METHOD eq "BOTH")) {
        if ($REQUESTED_METHOD eq "POST") {
            read (STDIN, $Input, $ENV_CONTENT_LENGTH);
        } elsif ($REQUESTED_METHOD eq "GET") {
            $Input = $ENV_QUERY_STRING;
        }
        if ($Input eq "") {
            #For compatibility with Luminis and SEP drag-n-drop DEFAULT_INPUT_VALUES can be set
            #in CgiSettings.pm instead of sending form input
            if ($DEFAULT_INPUT_ENABLED) {
                $Input = $DEFAULT_INPUT_VALUES;
                DebugPrint("<--$Input-->");
                DebugPrint('---Returning default input values.');
                return($Input);
            } else {	
                DoExit ("Cannot read form input.");
            }
        }
    } else {
        DoExit ("The requested FORM METHOD is not allowed.");
    }

    # Split up each pair of key=value pairs
    foreach my $pair (split (/$FIELD_SEP/, $Input)) {

       # For each pair, split into $key and $value variables
       my ($key, $value) = split (/$NAME_VALUE_SEP/, $pair);

       #-- WEB08 is doing the appropriate decoding so don't do it here
       # Get rid of the pesky %xx encodings
       #$key =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
       #$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;

       # Remove any reserved words.
       # For example, EXTERNAL_ASSERTION_VALUE may only be passed by an external access manager.
       # So, it cannot be inlcluded in the name value pairs any other way.
       next if $key eq $EXTERNAL_ASSERTION_VALUE;
       next if $key eq $EXTERNAL_ASSERTION_IS_UDC;

       # Use $key as index for $Parameters hash, $value as value
       $Parameters{$key} = $value;

       $InputReturn .= $key . $NAME_VALUE_SEP . $value . $FIELD_SEP;
    }

    DebugPrint('GetRestrictedInput Returning [' . $InputReturn . ']');
    return $InputReturn;
}

#-------------------------------------------------------------------------------
# GetUserId - Get the user's IP address and passport, format them for return.
#-------------------------------------------------------------------------------
# PARAMETERS:
#   None are used
#
# RETURN:
#   $UserId
#-------------------------------------------------------------------------------
sub GetUserId 
{
    DebugPrint('>>>GetUserId().');
    my $Passport = "";
    my $IpAddress = "";
    my $UserId = "";

    # If this user has a cookie
    if (defined ($ENV_HTTP_COOKIE))
    {
        # Get the passport cookie
        my %Cookies = fetch CGI::Cookie;
        if (defined $Cookies{'PASSPORT'}) {
            $Passport = $Cookies{'PASSPORT'}->value;
        }

    } # end if

    #
    # Note if there is a problem with your users' IP address changing with each request you can
    #  set the UCX-CFG020 WEBPARAMS "Ignore IP address" flag to Y and leave the code below alone.
    #

    # Get the user's IP address
    my $UserIP = ($Parameters{LOGONADDR} ? $Parameters{LOGONADDR} : "" );
    if (length ($UserIP) ne 0)
    {
      DebugPrint("Using user's real IP Address");
      $IpAddress = $Parameters{LOGONADDR};
    }
    else # Could not get user's IP
    {
      DebugPrint("Could not determine user's IP Address - using REMOTE_ADDR instead");
      $IpAddress = $ENV_REMOTE_ADDR;
    }  

    # Put the passport name/value pair and the ip addr name value pair together
    $UserId = "PASSPORT=" . $Passport . $FIELD_SEP .
              "IPADDR" . $NAME_VALUE_SEP . $IpAddress . $FIELD_SEP;

    DebugPrint("<--$UserId-->");
    DebugPrint('---GetUserId().');
    # Return user's passport and ip addr
    return($UserId);

} # end getuserid

#-------------------------------------------------------------------------------
# ReportNoCookie - Report that this browser/server does not support cookies.
#-------------------------------------------------------------------------------
# PARAMETERS:
#   None are used
#
# RETURN:
#   None - this subroutine exits the program.
#-------------------------------------------------------------------------------
sub ReportNoCookie 
{
    DebugPrint('>>>ReportNoCookie().');
    # Report that this server/browser does not have a cookie
    DoExit ("This browser or server does not support cookies.<P>
            You cannot use this application without support cookies.<P>
            Please try a cookie compatible browser.");
} # end reportnocookie

#-------------------------------------------------------------------------------
# SendHeader - Send the httpd header with cookie.
#-------------------------------------------------------------------------------
# PARAMETERS:
#   $Cookie
#
# RETURN:
#   None
#-------------------------------------------------------------------------------
sub SendHeader
{
    DebugPrint('>>>SendHeader().');
    my ($Cookie, $bIsIrisLinkError) = @_;   # Cookie to set
    my $HttpHeader;

    # If a cookie was actually passed
    if ($Cookie ne "")
    {
        #Send the passport cookie
        #printf ("Set-Cookie: %s; path=/; domain=.srn.com\n", zCookie);
        $HttpHeader = "Set-Cookie: $Cookie;\n";
    }

    $ContentType = ( $Parameters{ContentType} ? $Parameters{ContentType} : "" );
    if ($bIsIrisLinkError)
    {
      DebugPrint("IRISLink Error was returned so we are setting the ContentType to html");
      $ContentType = "html";
    }
    DebugPrint(">>> ContentType = $ContentType");
    my $FileName = "";

    # Send the necessary content type and blank line.
    if ($ContentType =~ m/excel/i)
    {
        $FileName = ( $Parameters{FileName} ? $Parameters{FileName} : "" );
        if ($FileName eq "") {
            $FileName = "ClassRoster.xls";
        }
        $HttpHeader .= "content-type: application/vnd.ms-excel\n";
        $HttpHeader .= "content-disposition: attachment; filename=$FileName\n";
    }
    elsif ($ContentType =~ m/pdf/i)       #1.1f - PDF
    {
        # Jan 2009 comments:
        #  When we specify this fname the IE pop-blocker is engaged and we are unable to
        #  download the pdf document. W/out specifying the FileName the pdf is loaded
        #  in the new window we opened (but a SaveAs gives it an ugly IRISLinkpdf fname)
        # Jan 2012 comments:
        #  When setting this filename as shown here it now works in IE and FF.
        #  It is possible that on some browsers it does not work so if testing shows a problem
        #  as noted above then simply comment this line out.
        #  However, when this name is used we end up getting the normal pop-up window but the PDF
        #  gets loaded into its own window - so we end up with 2 pop-ups instead of 1.
        #$FileName = "MyDegreeWorksAudit.pdf";

        $HttpHeader .= "content-type: application/pdf\n";
        if (length($FileName) > 0) {
         $HttpHeader .= "content-disposition: attachment; filename=$FileName\n";
        }
    }
    elsif ($ContentType eq "xml") {
       $HttpHeader .= "content-type: text/xml\n";
    }
    else {
        $HttpHeader .= "Content-type: text/html\n";
    }

    # Set the no-cache option for Netscape and IE                      #1.0v
    $HttpHeader .= $NOCACHE_OPTION;                                    #1.0v
    $HttpHeader .= "Cache-Control: no-cache, no-store, must-revalidate\n";
    $HttpHeader .= "X-Frame-Options: SAMEORIGIN\n";
    $HttpHeader .= "Pragma: no-cache\n";
    $HttpHeader .= "Expires: 0\n";
    $HttpHeader .= "\n";

    print $HttpHeader;
    DebugPrint("<--$HttpHeader-->");
    DebugPrint('---SendHeader().');
} # end sendheader

#-------------------------------------------------------------------------------
# LoginCAS
#-------------------------------------------------------------------------------
# PARAMETERS:
#   Service url
#
# RETURN:
#   $casUser - the user hash from cas including all ldap attributes cas might be configured to return.
#-------------------------------------------------------------------------------
sub LoginCAS
{
   my $cgi = CGI->new( );

   my $casServiceUrl = $cgi->url . '?' . $cgi->query_string;
   $casServiceUrl =~ s/\;/\&/g;

   my $casUrl = $casServiceUrl;
   my $casUserSub;
   my $returnCasTicket;
   my $cas = new AuthCasDgw(casUrl => $CAS_URL, CAFile => $CAS_CAFile);
   
   my $DegreeWorks_ID;
   my $login_url = $cas->getServerLoginURL($casUrl);
   DebugPrint("CAS LOGIN URL = $login_url");
   DebugPrint("INPUT: $InputData");
   
   if ( $cgi->param('ticket') eq "" )
   {
       DebugPrint("CAS ticket is not present, redirecting to login_url.");
       print $cgi->redirect( -URL => $login_url);
       exit(0);
   }
   else
   {
	   # Change all ampersands to semicolons so that DegreeWorks does not process these as individual NVPs.
	   $casServiceUrl =~ s/\&/\;/g;
     DebugPrint("CAS Service URL after semicolons = [$casServiceUrl]");
	   # Remove everything following "&ticket". 
	   # The ServiceUrl must match the one that was sent to CAS in the redirect request above.
	   $casServiceUrl =~ s/\;ticket.*//g;
     DebugPrint("CAS Service URL after rem ticket = [$casServiceUrl]");
	   $InputData = $InputData . $FIELD_SEP . "SERVICEURL" . $NAME_VALUE_SEP . $casServiceUrl;
     $returnCasTicket = $cgi->param("ticket");
     DebugPrint("CAS ticket = [$returnCasTicket]");
     DebugPrint("CAS Service URL = [$casServiceUrl]");
     #NOTE: CAS can be configured to allow a ticket to be validated more than once but that is not preferred.
     #NOTE: So, since we would prefer to validate the ticket in web12 we are going to forward the ticket on to web09 instead of validating it here.
     #$casUserSub = $cas->validateST($casUrl, $returnCasTicket);
     #DebugPrint("CAS USER AUTHENTICATED AS: Name=[$casUserSub->{ 'casAuthenticatedUser' }] ID=[$casUserSub->{ $CAS_ID_Attribute_Name }]");
     #$DegreeWorks_ID = $casUserSub{$CAS_ID_Attribute_Name};
   }
   #Return ticket instead of user information from validated ticket
   return ($returnCasTicket);
   #return($casUserSub);
}

#-------------------------------------------------------------------------------
# HandleExternalAuthAssertion
#-------------------------------------------------------------------------------
# 
#-------------------------------------------------------------------------------
sub HandleExternalAuthAssertion
{
   my $externalAssertion;
   DebugPrint("External_AuthAssertion_Name: [" . $External_AuthAssertion_Name . "]");
   DebugPrint("External_AuthAssertion_isCookie: [" . $External_AuthAssertion_isCookie . "]");
   DebugPrint("External_AuthAssertion_isUdcId: [" . $External_AuthAssertion_isUdcId . "]");

   if ($External_AuthAssertion_isCookie)
   {
      if (defined ($ENV_HTTP_COOKIE))
      {
         my %Cookies = fetch CGI::Cookie;
         if (defined $Cookies{$External_AuthAssertion_Name})
         {
            $externalAssertion = $Cookies{$External_AuthAssertion_Name}->value;
            DebugPrint("externalAssertion cookie: [" . $externalAssertion . "]");
         }
      }
   }
   else
   {
      # In order to get the proper header name from $ENV, we have to reformat it...
      # Replace dashes with underscores
	   $External_AuthAssertion_Name =~ s/HTTP_//g;
      # Upshift the name to all caps
      $External_AuthAssertion_Name = "\U$External_AuthAssertion_Name";
      # Prefix with "HTTP_"
      $External_AuthAssertion_Name = "HTTP_" . $External_AuthAssertion_Name;
      DebugPrint("External_AuthAssertion_Name Header: [" . $External_AuthAssertion_Name . "]");
      if (defined ($ENV{$External_AuthAssertion_Name}))
      {
         $externalAssertion = $ENV{$External_AuthAssertion_Name};
         DebugPrint("externalAssertion header: [" . $externalAssertion . "]");
      }
   }
   if ($externalAssertion ne "")
   {
      $InputData .= $FIELD_SEP . $EXTERNAL_ASSERTION_VALUE . $NAME_VALUE_SEP . $externalAssertion;
      $InputData .= $FIELD_SEP . $EXTERNAL_ASSERTION_IS_UDC . $NAME_VALUE_SEP . $External_AuthAssertion_isUdcId;
   }

   DebugPrint("HandleExternalAuthAssertion after InputData=[" . $InputData . "]");
}

1;