#!/usr/local/bin/perl # # Redirection Script # # Nagarajan Gopalan # Interactive Media Specialist # Eisenhower National Clearinghouse # The Ohio State University $ENV{'SCRIPT_NAME'} =~ m#(/.*/)(.*)$#; $SCRIPTDIR = $1; $SCRIPT = $2; # Receive and decode information &cgi_receive; &cgi_decode; # Print out usage information if not receiving a URL &print_info unless $FORM{'url'}; # Check to see if the URL has changed $dbase = "./urls/volume2.txt"; if ($FORM{'volume'} eq "2") { $dbase = "./urls/volume2.txt"; } else { $dbase = "./urls/volume2.txt"; } open (DATABASE, "<$dbase"); $status = "2"; $url = $FORM{'url'}; while (!eof(DATABASE) ) { $record = ; @data = split(/\t/, $record); if ($data[0] eq $FORM{'url'}) { $url = $data[1]; if ($data[0] eq $data[1]) {$status = "1";} else {$status = "0";} } } $FORM{'url'} = $url; close (DATABASE); # Log request to file $log = "./logs/volume2a.txt"; if ($FORM{'volume'} eq "2") { $log = "./logs/volume2a.txt"; } else { $log = "./logs/volume2a.txt"; } if ($status eq "1" ){$stat_message = "Correct URL";} if ($status eq "0" ){$stat_message = "Updated URL";} if ($status eq "2" ){$stat_message = "URL not in database";} open (LOG, ">>$log"); @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); @months = ('January','February','March','April','May','June','July','August','September','October','November','December'); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); if ($hour < 10) { $hour = "0$hour"; } if ($min < 10) { $min = "0$min"; } if ($sec < 10) { $sec = "0$sec"; } $date = "$days[$wday], $months[$mon] $mday, 19$year at $hour\:$min\:$sec"; print LOG "\nAccessed on \t:\t",$date,"\nStatus \t:\t",$stat_message, "\nFrom Document \t:\t",$ENV{"HTTP_REFERER"}, "\nURL Requested \t:\t", $FORM{'url'}, "\nBrowser Used \t:\t",$ENV{"HTTP_USER_AGENT"},"\nIP Address \t:\t",$ENV{REMOTE_ADDR},"(",$ENV{REMOTE_HOST},")\n"; close (LOG); # Redirect output to requested URL (or updated URL) print <<"EndResponse"; Status: 302 Redirected Content-type: text/html Location: $FORM{'url'} Client Redirected The CGI script has redirected your browser to this location. EndResponse exit; sub cgi_receive { if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $incoming, $ENV{'CONTENT_LENGTH'}); } else { $incoming = $ENV{'QUERY_STRING'}; } } sub cgi_decode { @pairs = split(/&/, $incoming); foreach (@pairs) { ($name, $value) = split(/=/, $_); $name =~ tr/+/ /; $value =~ tr/+/ /; $name =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie; $value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie; #### Strip out semicolons unless for special character $value =~ s/;/$$/g; $value =~ s/&(\S{1,6})$$/&\1;/g; $value =~ s/$$/ /g; $value =~ s/\|/ /g; $value =~ s/^!/ /g; ## Allow exclamation points in sentences #### Skip generally blank fields next if ($value eq ""); #### Allow for multiple values of a single name $FORM{$name} .= ", " if ($FORM{$name}); #### Check to see if input NAME is the URL, i.e. SUBMIT button if ($name =~ m|^\w+:\S+$|) { $FORM{'url'} = $name; } $FORM{$name} .= $value; } } sub print_info { print <<"EndHelp"; Content-type: text/plain This redirect script accepts input from forms set up in the ENC CD-ROM for the purpose of linking to external Web sites. It checks the URL requested against a database and updates it if necessary. It then sends a 300-level HTTP status code to redirect the browser to the requested or updated URL as appropriate. EndHelp exit; }