#!/usr/bin/perl -T

#
# You're welcome to use and modify this script freely. All I ask is that
# you retain this notice and acknowledge the original author (that's me).
#
# Ronald Tschalär, ronald@innovation.ch,  10. July 1996
#

use POSIX qw(ctime);
use File::Path qw(rmtree);
use strict;

my ($user, $system, $cuser, $csystem) = times;
my $usr_s = $user + $cuser;
my $sys_s = $system + $csystem;


# Some sanity checks that we were called correctly

if ($ENV{'REQUEST_METHOD'} ne "POST") {
    print "Status: 405 Method Not Allowed\n";
    print "Allow: POST\n";
    print "Content-type: text/html\n\n";
    print "<h2>This script only supports the POST method.</h2>\n";
    exit 1;
}

if ($ENV{'PATH_INFO'} ne "") {
    print "Status: 404 Not Found\n";
    print "Content-type: text/html\n\n";
    print "<h2>This script does not support path info.</h2>\n";
    exit 1;
}


# setup various definitions

my $loc_host  = "www.innovation.ch";            # the host-name to put in the URL's
my $form_path = "/java/java_compile.html";      # the URL-path to the compile form
my $ret_path  = "/cgi-bin/return_files";        # the URL-path to the return-files script
my $srv_root  = "/home/www/innovation/doc_root";  # the server's document-root
my $misc_dir  = "../doc_root/misc";
my $cntfile   = "$misc_dir/javac_cntr";
my $err_log   = "$misc_dir/javac_errors.log";
my $stats_log = "$misc_dir/javac_timing.stats";


my $tmp_dir = "/tmp/jc_$$";             # temporary directory for all files
if (-e $tmp_dir) {
    error("pid conflict - please choose <em>Compile</em> again.", 0, 1);
}

mkdir($tmp_dir, 0700)  ||  error("couldn't create temporary directory: $!", 0, 1);

my $jlinks = "/java${tmp_dir}";


# Tell them we're working

begin_html();
printflush("<div><h3>Parsing Input...</h3></div>\n");

# get some info from environment vars and untaint

$ENV{'REMOTE_ADDR'} =~ /([[:xdigit:].:]+)/;
my $ac_file = "$tmp_dir/.$1";
my $enc_type = $ENV{'CONTENT_TYPE'};
$enc_type =~ s/;.*//s;
my $cont_len = $ENV{'CONTENT_LENGTH'};


# get input

my ($got, $in) = 0;
while (my $count = read(STDIN, $in, $cont_len-$got, $got)) {
    $got += $count;
}
if ($got < $cont_len) {
    error("input truncated - got $got instead of the expected $cont_len bytes", 0);
}


# parse input

($user, $system, $cuser, $csystem) = times;
my $usr_h = $user + $cuser;
my $sys_h = $system + $csystem;

my ($jdk_version, @srcfiles, @libfiles, @htmlfiles, @imgfiles);

if ($enc_type =~ /multipart\/form-data/i) {
    handle_multipart($in, $ENV{'CONTENT_TYPE'});
} else {
    error("Unknown Content-type '$enc_type'", 1);
}

if (!@srcfiles) {
    error("No source files found. Make sure the source files have the extension .java .", 2);
}

my ($javac, $classpath, @options);
push(@options, "-encoding UTF-8");

if ($jdk_version eq "1.3.0") {
    $ENV{"JAVA_HOME"}     = "/usr/local/java/j2sdk1.4.2_19";
    $classpath            = ".";
    $javac                = "/usr/local/java/j2sdk1.4.2_19/bin/javac";
    push(@options, "-source 1.3");
    push(@options, "-target 1.3");
} elsif ($jdk_version eq "1.4.2") {
    $ENV{"JAVA_HOME"}     = "/usr/local/java/j2sdk1.4.2_19";
    $classpath            = ".";
    $javac                = "/usr/local/java/j2sdk1.4.2_19/bin/javac";
    push(@options, "-source 1.4");
} elsif ($jdk_version eq "1.5.0") {
    $ENV{"JAVA_HOME"}     = "/usr/local/java/jdk1.5.0_22";
    $classpath            = ".";
    $javac                = "/usr/local/java/jdk1.5.0_22/bin/javac";
} elsif ($jdk_version eq "1.6.0") {
    $ENV{"JAVA_HOME"}     = "/usr/local/java/jdk1.6.0_45";
    $classpath            = ".";
    $javac                = "/usr/local/java/jdk1.6.0_45/bin/javac";
} elsif ($jdk_version eq "1.7.0") {
    $ENV{"JAVA_HOME"}     = "/usr/local/java/jdk1.7.0_79";
    $classpath            = ".";
    $javac                = "/usr/local/java/jdk1.7.0_79/bin/javac";
} elsif ($jdk_version eq "1.8.0") {
    $ENV{"JAVA_HOME"}     = "/usr/lib/jvm/java";
    $classpath            = ".";
    $javac                = "/usr/bin/javac";
} else {
    my $form_url = "http://${loc_host}${form_path}";
    error("Unknown JDK version '$jdk_version' - please make sure you've" .
          " loaded the latest form from <a href=\"$form_url\">$form_url</a>", 2);
}

foreach (@libfiles) {
    $classpath = "${classpath}:$_";
}

($user, $system, $cuser, $csystem) = times;
my $usr_p = $user + $cuser;
my $sys_p = $system + $csystem;


# finally - we can compile...

printflush("<div><h3>Compiling...</h3></div>\n");

my $cmd = "$javac @options -classpath '$classpath' " .
          join(" ", map { "'$_'" } @srcfiles );
$cmd =~ s/[^\w \/.:='-]/\\$1/g;                 # Security patch
for (keys %ENV) { delete $ENV{$_} if $ENV{$_} =~ /}\s*;.+/ }	# Shellshock

$ENV{"PATH"} = "";
my $jc_out;

eval {
    local $SIG{ALRM} = sub { die "Compilation is taking too long - aborted it.\n" };
    alarm 60;
    $jc_out = `ulimit -t 70; $cmd 2>&1`;
    alarm 0;
};
$jc_out .= "\n$@" if ($@);

($user, $system, $cuser, $csystem) = times;
my $usr_c = $user + $cuser;
my $sys_c = $system + $csystem;


# ...and write out the results

print "<h3>Standard Output from javac:</h3>\n";
 
if ($jc_out) {
    print "<pre>\n$jc_out</pre>\n";
} else {
    print "No Errors, Warnings or other output produced\n";
}

print "<h3>Output File(s)</h3>\n";

($user, $system, $cuser, $csystem) = times;
my $usr_o1 = $user + $cuser;
my $sys_o1 = $system + $csystem;

my @outfiles = <${tmp_dir}/*.class>;

($user, $system, $cuser, $csystem) = times;
my $usr_o2 = $user + $cuser;
my $sys_o2 = $system + $csystem;

if (@outfiles) {
    # Ok, there were output files

    open(TOUCH, ">$ac_file"); close(TOUCH);  # simple access-control


    # generate links

    foreach (@outfiles) {
        print "<a href=\"http://${loc_host}${ret_path}?$_\">";
        s|.*/||;
        print "$_</a><br>\n";
    }
    print "<p><a href=\"http://${loc_host}${ret_path}?${tmp_dir}/AllClasses.jar\">AllClasses.jar</a><br>\n";
    print "<a href=\"http://${loc_host}${ret_path}?${tmp_dir}/AllClasses.zip\">AllClasses.zip</a><br>\n";
    print "<a href=\"http://${loc_host}${ret_path}?${tmp_dir}/AllClasses.tar.gz\">AllClasses.tar.gz</a><br>\n";


    # Add our applet, which deletes the files when the page is exited

    print "\n<applet codebase=\"/java/classes/NotifyPageExit/\"\n";
    print " code=\"NotifyPageExit.class\"  width=\"2\" height=\"2\">\n";
    print "<param name=\"script\" value=\"${ret_path}?${tmp_dir}/DeleteAll\">\n";
    print "<br>You don't seem to using a java-enabled browser. Please make\n";
    print "sure you either pick up all files or \n";
    print "<a href=\"http://${loc_host}${ret_path}?${tmp_dir}/DeleteAll\">Delete All Files</a>\n";
    print " before you leave this page. Thanx.\n";
    print "</applet>\n\n";


    # put up their html

    if (@htmlfiles) {
        symlink($tmp_dir, "${srv_root}${jlinks}");
    }

    foreach (@htmlfiles) {
        # get the raw data
        local $/ = undef;
        open(HTML, $_)  ||  next;
        my $html = <HTML>;
        close(HTML);

        # cut out body
        $html =~ s/.*<body>//is;
        $html =~ s/.*<\/head>//is;
        $html =~ s/<\/body>.*//is;

        # mung CODEBASE's
        $html =~ s/(<applet[^>]*)codebase\s*=\s*[^\s>]*/$1/igs;
        $html =~ s/(<applet)/$1 codebase=\"${jlinks}\"/igs;

        print "<hr>\n$html\n";
    }
} else {
    print "No Output File created\n";
}


# increment access counter

if (open(CNTR, "+<$cntfile")) {
    my $cntr = <CNTR>;
    chop($cntr);
    $cntr++;
    seek(CNTR, 0, 0);
    print CNTR "$cntr\n";
    close(CNTR);
}


# cleanup files

unlink(@srcfiles) if (@srcfiles);
unlink(@htmlfiles) if (@htmlfiles);
unless (@outfiles && @htmlfiles) {
    unlink(@libfiles) if (@libfiles);
    unlink(@imgfiles) if (@imgfiles);
}

if (!<${tmp_dir}/*>) {
    rmtree($tmp_dir, { safe => 1 });
}

end_html();

timing();

### THE END ###


sub handle_multipart {
    my ($data, $cont_type) = @_;

    # Get the boundary string

    my $bound = $cont_type;
    $bound =~ s/\s*[^;]*//;                     # remove content-type
    while ($bound =~ /^;/) {                    # loop through parameters
        $bound =~ s/^;\s*//;
        $bound =~ s/^([^=\s]*)\s*=\s*//;        # split off attribute
        my ($name, $value) = $1;

        if ($bound =~ /^\"/) {                  # value is quoted-string
            $bound =~ s/\"([^"]*)\"\s*//;
            $value = $1;
        } else {                                # value is token
            $bound =~ s/\s*([^;\s]*)\s*//;
            $value = $1;
        }

        if ($name =~/^boundary$/i) {
            $bound = $value; last;              # found boundary attribute
        }
    }
    error("No boundary found in '$cont_type'", 2)  if (!$bound);
    $bound =~ s/(.*)/\Q$1\E/;                   # escape reg-exp stuff

    error("parts boundary not found in body", 2)  if ($data !~ /--${bound}/);


    # split the data into the parts

    $data =~ s/\r\n--${bound}($|--.*)//s;       # remove epilogue
    $data = (split(/--${bound}\r\n/, $data, 2))[1]; # remove preamble
    my @parts = split(/\r\n--${bound}\r\n/, $data); # separate along boundary


    # handle all the parts

    foreach (@parts) {
        my ($headers, $body) = split(/\r\n\r\n/, $_, 2);
        $_ = $headers;
        my ($type, $field) = /Content-disposition:\s*([^\s;]*)\s*;\s*name="([^"]*)"/i;
        if ($field =~ /\w+file/) {
            my ($file) = /;\s*filename="([^"]*)"/i;
            next if (!$file);

            $file =~ s|.*[/\\]||;       # strip path stuff
            $file =~ s|[^\w\@:.-]||g;   # security: restrict allowed characters
            $file =~ s|^|$tmp_dir/|;    # and add tmp

            $file =~ /(.*)/;            # untaint (already stripped dangerous stuff)
            $file = $1;

            if ($field eq "srcfile") {
                if ($file =~ /(\.java?)$/i) {
                    $file =~ s/$1$/.java/;      # support Windoze/DOS
                    push(@srcfiles, $file);
                } else {
                    $file =~ s|.*/||;
                    print "<strong>Warning:</strong> Source files must have ";
                    print "the file extension '.java' or '.jav'. Ignoring file '$file'...<br>\n";
                    next;
                }
            } elsif ($field eq "libfile") {
                if ($file =~ /\.(zip|jar)$/i) {
                    push(@libfiles, $file);
                } else {
                    $file =~ s|.*/||;
                    print "<strong>Warning:</strong> Package files must have ";
                    print "the file extension '.zip' or '.jar'. Ignoring file '$file'...<br>\n";
                    next;
                }
            } elsif ($field eq "imgfile") {
                push(@imgfiles, $file);
            } elsif ($field eq "htmlfile") {
                push(@htmlfiles, $file);
            } else {
                error("Invalid field '$field' found", 2);
            }

            open(FILE, ">$file")  ||  error("Couldn't create $file: $!", 0);
            print FILE $body;
            close(FILE);
            if (-z $file) {
                $file =~ s|.*/||;
                print "<strong>Warning:</strong> file '$file' has size zero.";
                print " Perhaps you specified an invalid path or filename?<br>\n"
            }
        } elsif ($field eq "opt") {
            $body =~ /(-[\w:=-]+)/;     # security: restrict allowed characters
            push(@options, $1);
        } elsif ($field eq "jdk_version") {
            $jdk_version = $body;
        } else {
            error("Invalid field '$field' found", 2);
        }
    }
}


sub error {
    my ($err_str, $sev, $keep) = @_;

    # log error
    if (open(LOG, ">>$err_log")) {
        print LOG ctime(time);
        print LOG "Error: $err_str\n";
        if ($sev > 0) {
            print LOG "User-Agent: ".$ENV{'HTTP_USER_AGENT'}."\n";
            print LOG "Referrer: ".$ENV{"HTTP_REFERER"}."\n";
        }
        if ($sev > 1) {
            print LOG "Content-type: ".$ENV{"CONTENT_TYPE"}."\n";
            print LOG "========== Input "."="x63 ."\n";
            print LOG "$in\n";
            print LOG "========== End Input "."="x59 ."\n";
        }
        print LOG "\n\n";

        close(LOG);
    }

    # print error and clean up
    if ($keep) {
        begin_html();
    }
    print "<h2>Error: $err_str</h2>\n";
    if (!$keep || !<${tmp_dir}/*>) {
	rmtree($tmp_dir, { safe => 1 });
    }
    end_html();
    timing();
    exit 1;
}


sub printflush {
    local $| = 1;
    print @_;
}


sub begin_html {
    print "Content-type: text/html\n";
    print "Pragma: no-cache\n";
    print "Cache-Control: no-cache\n";
    print "\n";
    print "<!DOCTYPE html>\n";
    print "<html>\n<head>\n";
    print "<title>Compilation Results</title>\n";
    print "<base href=\"http://${loc_host}${jlinks}/\">\n";
    print "<style type=\"text/css\">div { width: 80em }</style>\n";
    print "</head>\n\n";
    print "<body>\n";
}


sub end_html {
    print "<hr>\n".ctime(time)."</body></html>\n";
}


sub timing {
    my ($user, $system, $cuser, $csystem) = times;
    my $usr_e = $user + $cuser;
    my $sys_e = $system + $csystem;

    open(TIM, ">>$stats_log")  ||  return;

    print  TIM ctime(time);
    printf TIM "User-Agent: %s\n", $ENV{'HTTP_USER_AGENT'};

    printf TIM "Cont-len: %6d\n", $cont_len;
    printf TIM "Num Source-files: %2d\tNum Output-files: %2d\n",
                scalar(@srcfiles), scalar(@outfiles);
    printf TIM "Num HTML-files:   %2d\tNum Image-files:  %2d\n",
                scalar(@htmlfiles), scalar(@imgfiles);
    print  TIM "JDK: $jdk_version\n";
    if ($usr_h) {
        printf TIM "Setup:   %5.2fU\t%5.2fS\n", $usr_h-$usr_s, $sys_h-$sys_s;
    }
    if ($usr_p) {
        printf TIM "Parse:   %5.2fU\t%5.2fS\n", $usr_p-$usr_h, $sys_p-$sys_h;
    }
    if ($usr_c) {
        printf TIM "Compile: %5.2fU\t%5.2fS\n", $usr_c-$usr_p, $sys_c-$sys_p;
        printf TIM "Output:  %5.2fU\t%5.2fS\n", $usr_e-$usr_c, $sys_e-$sys_c;
        printf TIM "OutputL: %5.2fU\t%5.2fS\n", $usr_o2-$usr_o1, $sys_o2-$sys_o1;
    }


    printf TIM "Total:   %5.2fU\t%5.2fS\n", $usr_e-$usr_s, $sys_e-$sys_s;
    print TIM "\n";
    close(TIM);
}