Some years ago, I came up with an idea. I thought it would be really neat to write a CGI script, to place on a dependable server, that would 1) check to see if a particular (non-dependable) site was available, 2) if so, redirect the user there, or 3) display a nice message saying try again later. I was a freshman in college and the only languages I'd ever used were BASIC and LOGO (and my programming classes were scheduled for my sophomore year).
I'd heard about this Perl language that was really popular for writing CGIs, so I lurked around c.l.p.m., and bugged all the CS people I knew, asking them if they had any idea how to do it in Perl. It became clear that nobody else knew anything about it, so I started playing around with it. I downloaded scripts from here and there, noting sections of each that pertained in some slight way to my goal. Eventually, after staring at this code (with no book at my disposal), I started pasting things together.
Here's my first Perl program (BTW, this really sucks, I already know that!):
#!/usr/local/bin/perl -w
use Socket;
$query = "$ENV{'QUERY_STRING'}";
$pro = "http";
if ($query eq "y") {
$hostname = "www.yahoo.com";
}
elsif ($query eq "Skippy") {
$hostname = "skippy.wgz.org";
}
elsif ($query eq "Winpatch") {
$hostname = "winpatch.wgz.org";
}
elsif ($query eq "Spectral") {
$hostname = "spectral.wgz.org";
}
elsif ($query eq "Magic") {
$hostname = "magic.hurrah.com";
}
elsif ($query eq "Skylab") {
$hostname = "www.skylab.org";
}
elsif ($query eq "biff") {
$hostname = "biff.ch.up.edu";
}
else {
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML>
<HEAD><TITLE>Invalid Option</TITLE>
<base href="http://snafu.ch.up.edu/"></HEAD>
<BODY background="skippylogo.gif" BGCOLOR="#DCDCDC" TEXT="#000000" LIN
+K="#FF1135
" ALINK="#DCDCDC" VLINK="#5A5A5A">
<H1 ALIGN=CENTER>Invalid Option</H1>
<HR>
"$query" is not a valid option.
<BR><a href="$ENV{'HTTP_REFERER'}">Back</a>
<HR>
<i><a href="mailto:keys\@babylon5fan.com?subject=server.cgi?$query">ke
+ys\@babylo
n5fan.com</a></i>
</BODY>
</HTML>
EOF
$stat = "Invalid";
&end;
}
$hostaddr = (gethostbyname($hostname))[4]
|| &fail;
$proto = (getprotobyname ('tcp'))[2]
|| &err ("Protocol Failure");
socket (SOCK, AF_INET, SOCK_STREAM, $proto)
|| &err ("Socket Failure");
connect (SOCK, pack "SnA4x8", AF_INET, $port || 80, $hostaddr)
|| &fail;
select (SOCK);
$| = 1;
select (STDOUT);
print "Location: $pro://$hostname";
print ":$port" if $port ne "";
print "$ENV{'PATH_INFO'}\n\n";
$stat = "Redirected";
&end;
sub fail {
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML>
<HEAD><TITLE>Service Unavailable</TITLE>
<base href="http://snafu.ch.up.edu/"></HEAD>
<BODY background="skippylogo.gif" BGCOLOR="#DCDCDC" TEXT="#000000" LIN
+K="#FF1135
" ALINK="#DCDCDC" VLINK="#5A5A5A">
<H1 ALIGN=CENTER>$query is unavailable</H1>
<HR>Service for $pro on $query is currently down. Please try again la
+ter.
<BR><a href="$ENV{'HTTP_REFERER'}">Back</a>
<HR>
<i><a href="mailto:keys\@babylon5fan.com?subject=server.cgi?$query">ke
+ys\@babylo
n5fan.com</a></i>
</BODY>
</HTML>
EOF
$stat = "Unavailable";
&end;
}
sub err {
my ($error) = @_;
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML>
<HEAD><TITLE>Error</TITLE>
<base href="http://snafu.ch.up.edu/"></HEAD>
<BODY background="skippylogo.gif" BGCOLOR="#DCDCDC" TEXT="#000000" LIN
+K="#FF1135
" ALINK="#DCDCDC" VLINK="#5A5A5A">
<H1 ALIGN=CENTER>Error</H1>
<HR>
An error has occurred. With any luck I should already know about it,
+though...
<BR><a href="$ENV{'HTTP_REFERER'}">Back</a>
<HR>
<i><a href="mailto:keys\@babylon5fan.com?subject=$error">keys\@babylon
+5fan.com<!-
a></i>
</BODY>
</HTML>
EOF
$stat = "Error: $error";
&end;
}
sub end {
chmod (0602, "./hidden/server.cgi.log");
open (FILE, ">> ./hidden/server.cgi.log")
|| open (FILE, "> ./hidden/server.cgi.log");
print FILE scalar localtime;
print FILE ",$ENV{'REMOTE_HOST'},$ENV{'HTTP_REFERER'},$query,$stat\n";
close (FILE);
exit(0);
}
Now, 5 years later, I'm looking at this code again. I've come a very long way. If I had to do this again, it would take around 30 lines, and would consist mostly of method calls to common modules. All variables would be properly scoped, and I'd use a hash.
I'm already digressing. Looking at this program again reminds me of how difficult it was to get started with Perl, and how much I needed just a little push in the right direction. PM is a tremendous resource, and in the 8 months I've been a regular visitor, I've seen drastic improvements in my ability.
In response to
footpad's challenge, here's how I'd write it now. Sorry, it's 48 lines (with whitespace and brackets):
#!/usr/local/bin/perl -wT
use strict;
use CGI;
use LWP::Simple;
my %hosts = (
'skylab' => 'http://skylab.org/',
'tarball' => 'http://tarball.wgz.org/',
'google' => 'http://www.google.com/',
'secure' => 'http://secure.wgz.com/',
);
my $q = new CGI;
my $dest = $q->param('dest') || '';
my $dest_url = $hosts{lc($dest)};
my $message = '';
if(defined($dest_url))
{
if(head($dest_url))
{
print $q->redirect(-location=>$dest_url);
exit(0);
}
else
{
$message = "$dest is unavailable";
}
}
else
{
if($dest)
{
$message = "$dest is not a recognized destination";
}
else
{
$message = 'No dest specified';
}
}
print $q->header();
print $q->start_html(-title=>$message);
print $q->h1($message);
print $q->h2('Please try again');
print $q->end_html();
--isotope
http://www.skylab.org/~isotope/