#!/usr/bin/perl
# -*- perl -*-
#
#  Copyright (c) 1997, 2000 DJ Delorie, All Rights Reserved.  NO WARRANTEE.
#

# Note: This is used by a Firefox extension, so be lenient in allowing
# people in without $referrer set right.

BEGIN { push(@INC, "/home/apache/lib/perl"); };
use header;
use trailer;

#open(LOCK, ">/tmp/lock");
#flock(LOCK, 2);

$sockaddr = "S n a4 x8";
#require "sys/socket.ph";
use Socket;

$| = 1;

if ($ARGV[0] eq "see-script") {
    print "Content-type: text/plain\n\n";
    open(IN, "headers.cgi");
    print while <IN>;
    exit 0;
}

require "./common.pl";

push(@INC, "/home/apache/bin");
push(@INC, split(':', $ENV{"PATH"}));
require "cgi-lib.pl";
&ReadParse;

$in{'url'} =~ s@http://http://@http://@;

if ($in{'url'} !~ m@^http://([^\./]+\.)+[^\./]+@) {
    print "Content-type: text/html\n\n";
    print "<p>Sorry, I can only handle http://<i>some.host</i>/ URLs.\n";
    $u = &HtmlEncode($in{'url'});
    print "You typed in `<tt>$u</tt>'.\n";
    exit 0;
}

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

$in{'url'} =~ tr/'//d; #'

$in{'url'} .= "/" unless $in{'url'} =~ m@http://.*/@;
($urlhead,$urlpath) = $in{'url'} =~ m@([^/]+/+[^/]+)(.*)@;
$urlpath =~ s@/[^/]+$@/@;
$urlpath = "/" unless $urlpath;

$form = "<form action=\"headers.cgi\" method=GET>
<input type=text name=url size=70 value=\"$in{'url'}\">
</form>";

header::handler("","Headers for '$in{'url'}'");

($host,$port,$uri) = $in{'url'} =~ m@http://([^/:]+)(:\d+)?(.*)@;
$port =~ s/://;
$port = 80 unless $port;
$uri = "/" unless $uri;

if ($host eq "www.delorie.com" && $port == 81) {
    # This one is OK
} elsif ($host =~ /^[^\.]*$|delorie.com|^172\.31\.|^10\.10\.42\.|localhost|^127\.0\.0\./i) {
    print "Sorry, host `$host' not allowed.\n";
    exit 0;
}

&check_delorie_htm($in{'url'});

($name,$aliases,$type,$len,$addr) = gethostbyname($host);
if (! $addr) {
    &fail("<h1>Error</h1>Host $host unknown");
}
$them = pack($sockaddr, &AF_INET, $port, $addr);

unless (socket(S, &AF_INET, &SOCK_STREAM, $proto)) {
    &fail("<h1>Error</h1>Unable to create socket");
}

unless (connect(S, $them)) {
    &fail("<h1>Error</h1>Unable to connect to $host addr $addr port $port: $!");
}

select(S); $| = 1; select(STDOUT);

print S "GET $uri HTTP/1.0\r\n";
print S "Host: $host:$port\r\n";
print S "\r\n";

print "<pre>";
while (<S>) {
    last unless /\S/;
    s/\r//;
    s/&/\&amp\;/g;
    s/</\&lt\;/g;
    s/>/\&gt\;/g;
    s@Location:\s*(http://.*)@Location: <a href="headers.cgi?url=$1">$1</a>@;
    print;
}
print "</pre>";

sub fail {
    print $_[0];
print $form;
    trailer::handler("");
    exit 0;
}

print $form;
trailer::handler("");