Perl Client

Source Code

#!/usr/bin/perl -w

use strict;

my $this_script   = "./schedule.cgi";
my $remote_server = "[voyager server]";
my $remote_script = "/cgi-bin/roomstext.cgi";
my $remote_url    = "http://$remote_server$remote_script";

&ReadParse;
my %formdata;

print "Content-type: text/html\n\n";

&PrintInc("../headerfile.txt");
print qq(<a href=".">Short Loans Schedule</a> > Enhanced Group Study Rooms);
&PrintInc("../anotherfile.txt");

#  This value should be an integer that indicates
#  how may days from today's date you want info
#  on room reservations.

my $date_offset = $formdata{'date'};

if ($date_offset && ($date_offset =~ /^[1]*?[0-9]{1}$/)) {
    $remote_url .= "?date=$date_offset";
}

eval("use LWP::UserAgent");
if ($@) {
	print "This script requires the LWP::UserAgent module\n";
	exit;
}

my $ua = LWP::UserAgent->new(agent => $ENV{SCRIPT_NAME});

my $r = HTTP::Request->new('GET', 
	"$remote_url");
my $response = $ua->request($r);

unless ($response->is_success) {
	print $response->error_as_HTML . "\n";
	print "Could not connect to server\n";
	exit(1);
}

my $result = $response->content(); # content without HTTP header

$result =~ s#$remote_script#$this_script#g;

print "$result";

&PrintInc("../footerfile.txt");

##########################################################
#  ReadParse
##########################################################
#
#  ReadParse reads in and parses the CGI input.
#  It reads  / QUERY_STRING ("get"  method)
#            \    STDIN     ("post" method)

sub ReadParse {
    my ($meth, $formdata, $pair, $name, $value);

    # Retrieve useful ENVIRONMENT VARIABLES
    $meth = $ENV{'REQUEST_METHOD'};

    # If method unspecified or if method is GET
    if ($meth eq  '' || $meth eq 'GET') {
        # Read in query string
        $formdata = $ENV{'QUERY_STRING'};
    }
    # If method is POST
    elsif ($meth eq 'POST') {
        read(STDIN, $formdata, $ENV{'CONTENT_LENGTH'});
    }
    else {
        die "Unknown request method: $meth\n";
    }

    # name-value pairs are separated and put into a list array
    my @pairs = split(/&/, $formdata);

    foreach $pair (@pairs) {
        # names and values are split apart
        ($name, $value) = split(/=/, $pair);
        # pluses (+'s) are translated into spaces
        $value =~ tr/+/ /;
        # hex values (%xx) are converted to alphanumeric
        $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        # The code below attempts to ferret out shell meta-characters
        # in the form input.  It replaces them with spaces.
        # looking for the presence of shell meta-characters in $name
        $name  =~ s/[{}\!\$;><&\*'\|]/ /g;
        # looking for the presence of shell meta-characters in $value
        $value =~ s/[{}\!\$;><&\*'\|]/ /g;
        # associative array of names and values created
        $formdata{$name} = $value;
    }
}

############################################################
#  PrintInc
############################################################
#
#  Prints "include" files.
#  Usage: &PrintInc ("./relative-path-to/somefile.inc");

sub PrintInc {
  my ($inc_file) = @_;
  open (INCLUDE, "$inc_file")  || die "Can't open file.\n";
  while (<INCLUDE>) {
    print;
  }
  close (INCLUDE);
}

exit(0);