# Revision $Id: //Tuxedo/RELEASE/Product/webroot/IRISLink.cgi#4 $ # 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; #------------------------------------------------------------------------------- # WEB07 <1.0x> - IRISLink Sockets CGI #$PROGRAM_NAME_SHORT = "WEB07"; our $PROGRAM_NAME = "IRISLink CGI "; #------------------------------------------------------------------------------- #------------------------------------------------------------------------------- # FILENAME : web07.pl # MPE FILENAME: /ACCOUNT/WWW/cgi-bin/web07.pl # MPE DATE : 01/03/2001 # # SYNTAX: # web07.pl [ServerName] [port] [URL_Location] # This program should be called by a web page's
. # The command line options are only for testing. # # PARAMETERS: # $ARGV[0] - Name of the host to which messages will be sent # $ARGV[1] - The port number over which messages will be sent # $ARGV[2] - The starting URL from which all requests originate # # EXAMPLE(S): # web07.pl yourHP.edu 7000 yourWebServer.edu # # ENVIRONMENT VARIABLES: # None are used. # # DESCRIPTION: # WEB07 reads the input from the browser and sends this input # across a socket to the be processed by IRISLink residing # on another machine. # # USAGE NOTES: # WEB07 has been tested on Windows NT, Linux and Solaris. # # The SITE CONFIGURATION section (lines 70-85) must be configured by the # installatoin site. # # 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); #Oreilly documentation suggests using a time-based seed like this: #srand( time() ^ ($$ + ($$ << 15)) ); #Get a bounded random number using: #$port = int(rand $x) + $y; # $x = upper boundary, $y = lower boundary. #------------------------------------------------------------------------------- # 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 CGI::Carp qw(fatalsToBrowser); #$CGI::POST_MAX=1024 * 10; # max 10K posts #$CGI::DISABLE_UPLOADS = 1; # no uploads 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 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'}; our $ENV_HTTP_REFERER = $ENV {'HTTP_REFERER'}; # 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\""); #-- Get the arguments passed in local our ($ServerName, $Port, $URL_Location) = @ARGV; #-- Check that the request cam from a valid HTTP_REFERER. if ($REQUIRE_HTTP_REFERER) { CheckReferer(); # Comment out for TST07. } # If the port number has not yet been configured if ($DEF_PORTNUMBER == 9999) { DoExit("The DEF_PORTNUMBER is currently set to $DEF_PORTNUMBER " . "and the DEF_SERVER_NAME is currently set to $DEF_SERVER_NAME; " . "please configure both in IRISLink.cgi to match your environment - " . "you can do a webshow 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(); # Comment out for TST07. 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; # Comment out for TST07. #-- Append user IP address and passport $InputData .= GetUserId(); # Comment out for TST07. #-- 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 $Count = 0; ################################### 9.9a ####################### # SUNGARD: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 DoExit("Can't recv: $!\n", "die"); $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 ($DEBUG_LEVEL > 1) { DebugPrint("<<<--- Total Response --->>>"); #1.1b DebugPrint($g_sResponse); DebugPrint("<<<--end Total Response-->>>"); } if ($RecvPassport ne "") #1.1f {SendHeader($PASSPORT_LABEL . '=' . $RecvPassport);} else # no passsport found - must be a pdf file being returned {SendHeader("");} 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 ' $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 #------------------------------------------------------------------------------- #------------------------------------------------------------------------------- # CheckReferer - Check that the request cam from a valid HTTP_REFERER. #------------------------------------------------------------------------------- # PARAMETERS: # None are used # # RETURN: # 0 - If processing completes; Else exit the program. #------------------------------------------------------------------------------- sub CheckReferer { DebugPrint('>>>CheckReferer().'); # Handle the $URL_Location from @ARGV. if (defined($URL_Location)) { push(@ALLOWED_URLS, $URL_Location); } my $RefererIsOK = $FALSE; if ($ENV_HTTP_REFERER eq "") { DoExit("The browser did not send HTTP_REFERER."); } foreach my $url (@ALLOWED_URLS) { if ($url eq "" || $ENV_HTTP_REFERER =~ /http\:\/\/$url\//i || #1.0c# $ENV_HTTP_REFERER =~ /https\:\/\/$url\//i) #1.0j# { $RefererIsOK = $TRUE; } } if ($RefererIsOK) { return(0); DebugPrint('---CheckReferer().'); } else { 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"; $PROGRAM_NAME Error
$PROGRAM_NAME Error:

$ErrorMsg
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); # 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().'); #local ($Passport); # The user's passport cookie #1.0g# #local ($IpAddress); # The user's IP address #1.0g# #local ($UserId); # The formatted string to return #1.0g# 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.

You cannot use this application without support cookies.

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) = @_; # 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} : "" ); 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 .= "\n"; print $HttpHeader; DebugPrint("<--$HttpHeader-->"); DebugPrint('---SendHeader().'); } # end sendheader #------------------------------------------------------------------------------- # SetupSocket - Setup the socket connection. #------------------------------------------------------------------------------- # PARAMETERS: # $ServerName, $Port - From @ARGV; these are not required. # # GLOBALS: # FHSOCKET output The socket that is opened # # RETURN: # None #------------------------------------------------------------------------------- sub SetupSocket { DebugPrint('>>>SetupSocket().'); # Get the arguments passed in @ARGV. ($ServerName, $Port) = @ARGV; #1.0a# # Set the Port and ServerName if not yet set $Port = $DEF_PORTNUMBER unless $Port; $ServerName = $DEF_SERVER_NAME unless $ServerName; DebugPrint("<-- Actual server name is $ServerName -->"); if ($USE_PORT_RANGES) #1.0u begin { # Seed the random function with a time value srand( time() ^ ($$ + ($$ << 15)) ); #$Port = int(rand $x) + $y; # $x = number of integers, $y = lower boundary. # Get a random number X where 0 <= X < NUMBER_OF_PORTS my $RandomNumber = int(rand $NUMBER_OF_PORTS); DebugPrint("<-- Random number generated is $RandomNumber -->"); # Now add the random number to the base port to get our port to use $Port = $RandomNumber + $DEF_PORTNUMBER; } DebugPrint("<-- Port being used is $Port -->"); #1.0u end # Get $proto and $ServerAddr from Socket module. my ($name,$aliases,$proto,$type,$len,$ServerAddr); ($name,$aliases,$proto) = getprotobyname('tcp'); ($name,$aliases,$type,$len,$ServerAddr) = gethostbyname($ServerName); # Get socket address structure. my $Server = sockaddr_in($Port, $ServerAddr); # Create socket if (!socket(FHSOCKET, $AF_INET, $SOCK_STREAM, $proto)) { # If socket creation fails exit and report stack trace with confess #confess "WEB07 Socket failure: $!\n"; DoExit ("Socket failure: $!.
Perhaps the configured port is already in use?", "die"); } # Connect to socket if (!connect(FHSOCKET, $Server)) { # If socket connection fails exit and report stack trace with confess #confess "WEB07 Connect failure: $!\n"; DoExit ("Cannot connect to server socket: " . "$!.
Check to see if sockets server (WEB08) is running and try again.", "die"); } DebugPrint('---SetupSocket().'); } # end setupsocket #------------------------------------------------------------------------------- # 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/-/_/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;