#!/usr/local/bin/perl

# Change this if you move the gateway. Duh. :-) - nocturne
$our_base_url = "http://www.mit.edu:8001/tweb";
$logfile = '/var/local/www/logs/trans-log';
$tmpdir  = '/var/tmp';

require "url_get.pl";
require "ourfork.pl";

$crypt_bin = '/usr/bin/crypt';

$| = 1;
open(STDERR,">&STDOUT");

$query = join(' ', @ARGV) if $ARGV[0];


# If it doesn't finish within 15 minutes, it will die.
# If $forking is set to 1, you'd better have this going through safefork.
$forking = 1;
&ourfork'safefork(900, "do_trans", $query);

# &do_trans($query);

### main part: decide what we're doing...

sub do_trans {
    local($query) = @_;
    local($pathinfo, $post, $postquery);
    $args =~ s/\+/ /g;
    $pathinfo = $ENV{PATH_INFO};
    $post = 0;
    $postquery = "";
    
    &checktime();
    
    if (! $ENV{'SERVER_PROTOCOL'}) {
         &old($query);
    } else {
        if ($ENV{'REQUEST_METHOD'} eq "POST") {
            read(STDIN, $postquery, $ENV{'CONTENT_LENGTH'});
	    $post = 1;
        }

        if ($pathinfo =~ "^/form.html(.*)$") {
            $pathinfo = $1;
            if ($post) {
		# they are submitting a form-based transparentizing query.
                &trans_form_parse($postquery);
            } else {
		# They are requesting the first-level form.
                &trans_form($pathinfo);
            }
        } elsif ($pathinfo =~ "^/map.html(.*)$") {
            $pathinfo = $1;
            if ($post) {
		# They are requesting the intermediate transparentization
		# imagemap-based form.
                &trans_map_parse($postquery);
            } else {
		# They are requesting the first-level imagemap form.
                &trans_map($pathinfo);
            }
	} elsif ($pathinfo =~ "^/map-parse/(.*)$") {
	    $pathinfo = $1;
            if ($post) {
		# This isn't something you can POST to. It's an imagemap.
                &not_found();
            } else {
		# They are submitting an imagemap-based transparentizing query
                &map_transparent($pathinfo, $query);
            }
        } else {
            &not_found();
	}
    }

    &kill_parent();
    exit(0);
}

sub map_transparent {
    local($encoded_url, $location, $url, $tempfile) = @_;
    local($their_url);

    $their_url = &decode_url($encoded_url);
    &log_url($their_url);

    $tempfile = ($tmpdir . "/www_trans.$$." . time());

    open(GIFTOPPM, ("|/usr/local/bin/giftoppm - >" . $tempfile));
    print GIFTOPPM (&url_get($their_url));
    close(GIFTOPPM);

    $color = "#" . &get_color($tempfile, $location);

    print "Content-Type: image/gif\n\n";

    open(PPMTOGIF, ("/usr/local/bin/ppmtogif -transparent \\" . $color . " " .
		    $tempfile . " 2>/dev/null |"));
    while (<PPMTOGIF>) {
	print $_;
    }
    close (PPMTOGIF);

    unlink($tempfile);
    1;
}

sub transmogrify {
    local($url, $color) = @_;

    # create a (practically) unique filename into which to
    # temporarily stuff data.
    $tempfile = ($tmpdir . "/www_trans.$$." . time());

    open(GIFTOPPM, ("|/usr/local/bin/giftoppm - >" . $tempfile));
    print GIFTOPPM (&url_get($url));
    close(GIFTOPPM);
    open(PPMTOGIF, ("/usr/local/bin/ppmtogif -transparent \\" . $color . " " .
		    $tempfile . " 2>/dev/null |"));
    while (<PPMTOGIF>) {
	print $_;
    }

    close (PPMTOGIF);
    unlink($tempfile);
    1;
}


### remove \000-\039 and \177-\377

sub prot {
    @_[0] =~ s/[\000-\037\177-\377]+//g;
    @_[0];
}

### parsing data
#
#   the POST data is all packed in the form
#      field1=value1&field2=value2&...
#   with the "invalid" characters encoded as %-sequences.

sub trans_map_parse {
    local(%post, $tmp, $name);

    for (split(/&/,@_[0])) {
	if (/=/) {
	    $name = $`;
	    $tmp = $';
	    $tmp =~ s/\+/ /g;
	    $tmp =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;
	    $post{$name} = $tmp;
	}
    }

    $their_url = &prot($post{'dullimage'});

    print "Content-Type: text/html\n\n";
    print "<html>\n<head>\n<title>TransWeb";
    print "</title>\n</head><body>\n";
    print "<h1>TransWeb</h1>\n";
    print "<h2>Transparentizing Clickable Imagemap</h2>\n";
    print "You should click on a place in this image which is the color\n";
    print "you'd like to make transparent.<p>\n";
    print "<strong>Remember to configure your web browser to load the\n";
    print "next retrieved URL to disk; otherwise, it may be difficult to\n";
    print "properly save it for future use.</strong><p>\n";
    print "<a href=\"" . $our_base_url . "/map-parse/";
    print (&encode_url($their_url) . "\">");
    print "<img align=middle src=\"" . $their_url . "\" ISMAP></a>\n";
    print "<p>\nYou should also note that this web page was generated\n";
    print "on the fly -- attempts to reload this page or return to this\n";
    print "page by copying down its URL will only get you the top-level\n";
    print "web page.<p>\n";
    print "<hr>\nIf you have any problems with this, feel free to\n";
    print "<a href=\"http://www.mit.edu:8001/comment\">send mail to\n";
    print "webmaster@mit.edu</a> about it.\n</body>\n</html>\n";
}

sub trans_form_parse {
    local(%post, $tmp, $remote_url, $name, $red, $green, $blue, $base);

    for (split(/&/,@_[0])) {
	if (/=/) {
	    $name = $`;
	    $tmp = $';
	    $tmp =~ s/\+/ /g;
	    $tmp =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;
	    $post{$name} = $tmp;
	}
    }

    $remote_url = &prot($post{'dullimage'});
    $red        = &prot($post{'red'});
    $blue       = &prot($post{'blue'});
    $green      = &prot($post{'green'});
    $base       = &prot($post{'base'});

    if ($base eq "Hexidecimal") {
	# this cuts out unnecessary resolution and converts to decimal.
	$red   = hex(substr($red,   0, 2));
	$green = hex(substr($green, 0, 2));
	$blue  = hex(substr($blue,  0, 2));
    }

    # This converts (back) to hexidecimal, and pads with "0"s.
    $red   = sprintf("%02x", $red);
    $green = sprintf("%02x", $green);
    $blue  = sprintf("%02x", $blue);

    print("Content-Type: image/gif\n\n");

    $color = "#" . $red . $green . $blue;

    &log_url($remote_url);
    &transmogrify($remote_url, $color);

}

### error message for attempted use with HTTP/0.9 and earlier
sub old {
    local($args) = @_;

    print <<"EndOfStuff";
Content-Type: text/html\n\n
<title>TransWeb gateway on WWW.MIT.EDU</title>
<h1>Your client is old...</h1>

Your client does not support HTTP/1.0, and therefore can't use the
form support interface. We suggest you ask your system administrator
to install a more recent web client.<p>

We're sorry, but we really can't provide an interface you can use.
If you would like to talk with us about this, feel free to
<a href="http://www.mit.edu:8001/comment">send mail to
webmaster@mit.edu about it</a>.
EndOfStuff
}

sub trans_form {
    &print_std_header();

    print <<"EndOfForm";
<h2>Helping you to make Transparent Images</h2>

This gateway allows you to enter the URL of a GIF image, and a colormap entry
to be made transparent. When you submit this form, TransWeb will read the
image you specified and return to you a transparentized version of the image.
<p>

If you have a web browser which supports clickable imagemaps (e.g.
Mosaic, Arena), you may find the
<a href="$our_base_url/map.html">imagemap-based
version of TransWeb</a> easier to use.<p>

<img align="bottom" alt="**NOTE**" src="http://www.mit.edu:8001/gif/info.gif">
It is highly likely that you will want to configure your browser to
"load to disk" before you submit this form, if it is configured to spawn
a separate image-viewing program when receiving images. (In Mosaic,
you can do this by selecting "Load to Local Disk" from the "Options" menu.)
<p>

<hr>

Please:
<ul>
<li>specify the URL of the image you'd like to transparentize
<li>specify the RGB value of the color to be transparentized
<li>select the base in which you are specifying the RGB values: hexidecimal
(base 16) or decimal (base 10).
</ul>

<hr>

<FORM method="POST">
Image URL: <input name="dullimage" size=50><p>

<ul>
<li>Red:<input name="red" size=8><br>
<li>Green:<input name="green" size=8><br>
<li>Blue:<input name="blue" size=8><br>
</ul>

<input type="radio" name="base" value="Decimal"    >Decimal<br>
<input type="radio" name="base" value="Hexidecimal" CHECKED>Hexidecimal<p>

<input type="submit" value="Submit these values">
<input type="reset" value="Naaaaah, just kidding">
</FORM>
EndOfForm

    &print_std_footer();
}

sub trans_map {
    &print_std_header();

    print <<"EndOfForm2";
<h2>Helping you to make Transparent Images</h2>

If your web browser is incapable of handling imagemaps (e.g. lynx,
emacs w3-mode, CERN linemode browser), then you will be unable to make use
of the form on this page. However, there is hope. You can use the
<a href="$our_base_url/form.html">form-based version of TransWeb</a>,
which allows you to specify colors via HTML forms, rather than
by clicking on an image.<p>

This gateway allows you to specify the URL of a GIF image which you'd
like to transparentize:

<ol>

<li>When you submit this form, TransWeb will present you with an
imagemap.

<li><em>After you submit the form on this page</em>, you should configure
your web browser to load the next retrieved URL to local disk. (In Mosaic,
you can do this by selecting "Load to Local Disk" from the "Options" menu.)

<li>You should click on the spot on the imagemap you'd like to make
transparent.

<li>TransWeb will return to you a transparentized version of the
image you specified.

</ol>

<hr>

<FORM method="POST">
Image URL: <input name="dullimage" size=50><p>

<input type="submit" value="Submit this URL">
<input type="reset" value="Naaaaah, just kidding">
</FORM>
EndOfForm2
   &print_std_footer();
}

sub not_found {
    print("Content-Type: text/html\n\n");

    print <<"EndOfForm3";
<html><head>
<title>Not Found</title>
</head><body>
The URL you specified was not found. Perhaps you're looking for one of
these:
<ul>

<li>our <a href="$our_base_url/map.html">clickable-imagemap-based
transparentizing service</a>

<li>our <a href="$our_base_url/form.html">form-based transparentizing service</a>
</ul></body></html>
EndOfForm3
}
1;

sub print_std_header {
    print("Content-Type: text/html\n\n");
    print("<html>\n<head><title>TransWeb Transparent-GIF Service</title>\n");
    print("</head><body>\n");
    print("<h1><a href=\"http://www.mit.edu:8001/transweb.html\">TransWeb");
    print("</a></h1>\n");
}

sub print_std_footer {
print <<"EndOfFooter";
<hr>

Related pages which might be of interest:

<ul>
<li><a href="http://www.mit.edu:8001/transweb.html">TransWeb Homepage</a>
<li><a href="http://www.mit.edu:8001/people/nocturne/transparent.html">Nocturne's
Transparent Image page</a>
<li><a href="http://www.mit.edu:8001/">MIT SIPB Web-server Homepage</a>
</ul>

<hr>

Feel free to <a href="http://www.mit.edu:8001/comment">send mail to
webmaster@mit.edu</a> if you have any questions or problems.<p>

The TransWeb service was written by 
<a href="http://www.mit.edu:8001/people/nocturne/homepage.html">Eric
Mumpower (nocturne)</a>.<p>

EndOfFooter
}


sub get_color {
    local($filename, $position, $x, $y, $height, $width, $placeflag,
	  $raw_format, $goalpix, $line, $curpix, $pixel) = @_;

    if ($position =~ /(\d*),(\d*)/) {
        $x = $1;
        $y = $2;
    } else {
        print "Content-Type: text/html\n\n";
        print "Something went wrong. We didn't get the imagemap\n";
        print "coordinates. Sorry, you lose.\n";
	return;
    }

    open(IMAGE, ("<" . $filename));

    $placeflag  = 0;
    $raw_format = 0;

    # Read the ppm manpage for a specification of this format.
    until ($placeflag == 4) {
	$line = <IMAGE>;

	# "#" is the comment character.
	$line =~ s/#.*$//;

	# this means we haven't hit the magic number yet
	if ($placeflag == 0) {
	    if ($line =~ s/P(\d)\s*//) {
	        $raw_format = $1;
		if ($raw_format =~ "6") {
                    $raw_format = 1;
                } else {
                    $raw_format = 0;
                }

	        $placeflag = 1;
	    }
        }

	# this means we haven't hit the width yet
	if ($placeflag == 1) {
	    if ($line =~ s/(\d+)//) {
	        $width = $1;
		$placeflag = 2;
	    }
	}

	# this means we haven't hit the height yet
	if ($placeflag == 2) {
	    if ($line =~ s/(\d+)//) {
	        $height = $1;
		$placeflag = 3;
		$goalpix = ($x + ($width * $y));
		if ($goalpix < 1) {
		    $goalpix = 1;
		}
		if ($goalpix > ($width * $height)) {
		    $goalpix = ($width * $height);
                }
	    }
	}

	# this means we haven't hit the maxval yet
	if ($placeflag == 3) {
	    if ($line =~ s/(\d+)//) {
	        $maxval = $1;
		$placeflag = 4;
	    }
	}

	if ($placeflag == 4) {
	    if ($raw_format) {
	        if ($line !~ /^\s*$/) {
		    #oh shit, they put data on the line with the maxval.
		    $line =~ s/\s//g;
		    $curpix = length($line) / 3;
		    if ($goalpix < $curpix) {
			return(substr($line, $goalpix * 3, 3));
		    }
		}
	    } else { # else not in raw format
		# I'm not writing code for this because I think it won't
		# happen, because GIFs are 8-bit.
		if ($line !~ /^\s*$/) {
	            print "Content-Type: text/html\n\n";
		    print "Sorry, our code wasn't prepared to deal with a\n";
		    print "particular unlikely contingency. If you get this\n";
		    print "error, <a href=\"http://www.mit.edu:8001/comment\"";
		    print ">please tell us</a> that you got this error and\n";
		    print "that we should work on the support of\n";
		    print "non-raw-format images.\n";
		    print "<p>\nTrust us -- we'll know what it means.\n";
        	    return;
		}
	    }
	}
    }

    if ($raw_format) {
	# We can assume that it's byte number (n), from this point.
	seek(IMAGE, (3 * ($goalpix - 1)), 1);
	read(IMAGE, $pixel, 3);

	return(sprintf("%02x%02x%02x", (unpack("C3", $pixel))));

    } else {
        print "Content-Type: text/html\n\n";
        print "Sorry, our code wasn't prepared to deal with a\n";
	print "particular unlikely contingency. If you get this\n";
	print "error, <a href=\"http://www.mit.edu:8001/comment\"";
	print ">please tell us</a> that you got this error and\n";
	print "that we should work on the support of\n";
	print "non-raw-format images.\n";
	print "<p>\nTrust us -- we'll know what it means.\n";
        return;
    }
}
sub checktime {
    local($hour);

    $hour = (localtime)[2];

    if (($hour > 11) && ($hour < 19)) {
        print <<"END";
Content-Type: text/html

<html><head><title>Try again later...</title></head>
<body><h1>Try TransWeb later...</h1>

The TransWeb service has been disabled during peak usage hours (12 pm
- 6 pm EST) due to excessive server load. Please try it again outside
these hours.<p>

<hr>
<address><a href="http://www.mit.edu:8001/comment">webmaster@mit.edu</a></address>
</body></html>
END
        &kill_parent();
	exit;
    }
}

sub cooldate {
    local(@t, $year, $month, $day);
    @t = localtime();
    $year  =  $t[5];
    $month = ($t[4] + 1);
    $day   =  $t[3];
    return &padzero($year) . &padzero($month) . &padzero($day);
}

sub fulldate {
    local(@t, $year, $month, $day, $date);
    @t = localtime();
    $year  =  $t[5];
    $month = ($t[4] + 1);
    $day   =  $t[3];
    $date = &padzero($year) . "/" . &padzero($month) . "/" . &padzero($day);
    $time = &padzero($t[2]) . ":" . &padzero($t[1])  . ":" . &padzero($t[0]);

    return $date . " " . $time;
}

sub padzero {
    local($n) = @_;
    ($n<10)?("0" . $n):$n;
}

sub encode_url {
    local($url) = @_;
    local($cdate, $crypts);
    $cdate = &cooldate();

    # encrypt with today as the key
    $crypts = &my_crypt($cdate, $url);

    # uuencode
    $crypts = pack("u", $crypts);

    # %00-encode URL-unsafe characters
    # Reserve A as character to change "%" to.
    $crypts =~ s/([^a-zB-Z0-9\.])/sprintf('%%%02x',ord($1))/eg;

    # Change "%" to "A"
    $crypts =~ s/\%/A/g;
    return ($crypts);
}

sub decode_url {
    local($crypts) = @_;
    local($cdate);
    $cdate = &cooldate();

    # Change "A" to "%"
    $crypts =~ s/A/\%/g;

    # Decode the webified %00-style encodings
    $crypts =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;

    # uudecode
    $crypts =  unpack("u", $crypts);

    # decrypt, using today as the key.
    $crypts = &my_crypt($cdate, $crypts);

    return ($crypts);
}

sub my_crypt {
    local($key, $string) = @_;
    local($temp_file, $crypts);

    $temp_file = ($tmpdir . "/www_crypt." . time() . "." . $$);

    open(OF, (">" . $temp_file));
    print OF $string;
    close(OF);

    open(CRYPT, ($crypt_bin . " $cdate < $temp_file |"));

    while (<CRYPT>) {
 	$crypts .= $_;
    }
    close(CRYPT);

    unlink($temp_file);

    return($crypts);
}

sub log_url {
    local($url) = @_;
    open (LOG, ">>" . $logfile);
    print LOG (&fulldate() . " [" . $ENV{'REMOTE_ADDR'} . "] " . $url . "\n");
    close LOG;
}

sub kill_parent {
    if ($forking = 1) {
	kill 9, getppid();
    }
}
1;
