Content Accepted

#!/usr/bin/perl

use lib '/opt/grub/local/apache/cgi-bin';
use webdb;

# Very simple PUT handler. Read the Apache Week article before attempting
# to use this script. You are responsible for ensure that this script is
# used securely.

# A simple log file, must be writable by the user that this program runs as.
# Should not be within the document tree.
$putlog = "/tmp/put1.log";

# Check we are using PUT method
if ($ENV{'REQUEST_METHOD'} ne "PUT") { &reply(500, "Request method is not PUT"); }

# Note: should also check we are an authentication user by checking
# REMOTE_USER

# Check we got a destination filename
$filename = $ENV{'PATH_TRANSLATED'};
if (!$filename  || $filename !~ /^\/opt\/grub\/local\/apache\/htdocs\/arcs\/[^\/]+\.gz$/) { &reply(500, "No PATH_TRANSLATED"); }
my @parts = split( /\//, $filename );
$filename = "/tmp/" . pop( @parts );

# Check we got some content
$clength = $ENV{'CONTENT_LENGTH'};
if (!$clength) { &reply(500, "Content-Length missing or zero ($clength)"); }

# Read the content itself
$toread = $clength;
$content = "";
while ($toread > 0)
{
    $nread = read(STDIN, $data, $toread);
    &reply(500, "Error reading content") if !defined($nread);
    &reply(500, "Premature end of content") if $nread <= 0;
    $toread -= $nread;
    $content .= $data;
}

# Write it out 
# Note: doesn't check the location of the file, whether it already
# exists, whether it is a special file, directory or link. Does not
# set the access permissions. Does not handle subdirectories that
# need creating.
open(OUT, "> $filename") || &reply(500, "Cannot write to $filename");
print OUT $content;
close(OUT);

# Load this into webdb
my $user = "Unknown";
if ( $filename =~ /([\w\-]+)\./ ) {
        $user = $1;
}

my @parts = split( /\./, $filename );
pop @parts; pop @parts;
my $provided_key = pop @parts;

my $return = webdb::validate_file( $filename, $user, $provided_key );
if ( $return ne "Success: Keys match" ) {
	unlink( $filename ); 
	&reply( 401, $return );
	exit( 0 ); 
} 

my @parts = split( /\//, $filename );
my $arcname = pop @parts;
my @time = localtime();
my $path = sprintf( "/archive/arcs/%04d/%02d/%02d/%02d", $time[5] + 1900, $time[4], $time[3],
	$time[2], $arcname );
system( "/bin/mkdir -p $path" );

my $return = webdb::rewrite_file( $filename, "$path/$arcname" );
unlink( $filename ); 

my $command = "curl -T $path/$arcname http://search.isc.org/grubdev/$arcname";
system( $command );

if ( $return ne "Success" ) {
	&reply( 500, $return );
}

#my $return = webdb::load_arc( $filename, $user, time() . "000" );
#$return = "Error: HBase is down, your file has been saved and will be loaded once HBase is available."; 

#if ( $return ne "Success" ) {
#	&reply( 202, "Your file was uploaded and saved to disk, but there was an error loading it into HBase.<br>We will save it and attempt to manually load this file at a later date and time. " . $return );
#}

# Everything seemed to work, reply with 204 (or 200). Should reply with 201
# if content was created, not updated.
&reply(200);

exit(0);

#
# Send back reply to client for a given status.
#

sub reply
{
    local($status, $message) = @_;
    local($remuser, $remhost, $logline) = ();

    print "Status: $status\n";
    print "Content-Type: text/html\n\n";

    if ($status == 200) {
        print "<HEAD><TITLE>OK</TITLE></HEAD><H1>Content Accepted</H1>\n";
    } elsif ($status == 500) {
        print "<HEAD><TITLE>Error</TITLE></HEAD><H1>Error Publishing File</H1>\n";
	print "An error occurred publishing this file ($message).\n";
    }
    # Note: status 204 and 201 gives have content part

    # Create a simple log
    $remuser = $ENV{'REMOTE_USER'} || "-";
    $remhost = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} || "-";
    
    $logline = "$remhost $remuser $filename status $status";
    $logline .= " ($message)" if ($status == 500);
    &log($logline);
    exit(0);
}

sub log
{
    local($msg) = @_;
    open (LOG, ">> $putlog") || return;
    print LOG "$msg\n";
    close(LOG);
}