340 lines
11 KiB
Perl
Executable File
340 lines
11 KiB
Perl
Executable File
######################################################################
|
|
# HTTP Connection from a reverse proxy client. GET/HEAD only.
|
|
# most functionality is implemented in the base class.
|
|
######################################################################
|
|
|
|
package Perlbal::ClientHTTP;
|
|
use strict;
|
|
use warnings;
|
|
use base "Perlbal::ClientHTTPBase";
|
|
|
|
use fields ('put_in_progress', # 1 when we're currently waiting for an async job to return
|
|
'put_fh', # file handle to use for writing data
|
|
'put_pos', # file offset to write next data at
|
|
|
|
'content_length', # length of document being transferred
|
|
'content_length_remain', # bytes remaining to be read
|
|
);
|
|
|
|
use HTTP::Date ();
|
|
use File::Path;
|
|
|
|
use Errno qw( EPIPE );
|
|
use POSIX qw( O_CREAT O_TRUNC O_WRONLY O_RDONLY ENOENT );
|
|
|
|
# class list of directories we know exist
|
|
our (%VerifiedDirs);
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
|
|
my $self = fields::new($class);
|
|
$self->SUPER::new(@_);
|
|
|
|
$self->{put_in_progress} = 0;
|
|
$self->{put_fh} = undef;
|
|
$self->{put_pos} = 0;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub close {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
|
|
# don't close twice
|
|
return if $self->{closed};
|
|
|
|
$self->{put_fh} = undef;
|
|
|
|
$self->SUPER::close(@_);
|
|
}
|
|
|
|
sub send_response {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
|
|
$self->watch_read(0);
|
|
$self->watch_write(1);
|
|
return $self->_simple_response(@_);
|
|
}
|
|
|
|
sub event_read {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
|
|
# see if we have headers?
|
|
if ($self->{req_headers}) {
|
|
if ($self->{req_headers}->request_method eq 'PUT') {
|
|
# read in data and shove it on the read buffer
|
|
if (defined (my $dataref = $self->read($self->{content_length_remain}))) {
|
|
# got some data
|
|
$self->{read_buf} .= $$dataref;
|
|
my $clen = length($$dataref);
|
|
$self->{read_size} += $clen;
|
|
$self->{content_length_remain} -= $clen;
|
|
|
|
# handle put if we should
|
|
$self->handle_put if $self->{read_size} >= 8192; # arbitrary
|
|
|
|
# now, if we've filled the content of this put, we're done
|
|
unless ($self->{content_length_remain}) {
|
|
$self->watch_read(0);
|
|
$self->handle_put;
|
|
}
|
|
} else {
|
|
# undefined read, user closed on us
|
|
$self->close('remote_closure');
|
|
}
|
|
} else {
|
|
# since we have headers and we're not doing any special
|
|
# handling above, let's just disable read notification, because
|
|
# we won't do anything with the data
|
|
$self->watch_read(0);
|
|
}
|
|
return;
|
|
}
|
|
|
|
# try and get the headers, if they're all here
|
|
my $hd = $self->read_request_headers;
|
|
return unless $hd;
|
|
|
|
# fully formed request received
|
|
$self->{requests}++;
|
|
|
|
# notify that we're about to serve
|
|
return if $self->{service}->run_hook('start_web_request', $self);
|
|
|
|
# see what method it is?
|
|
if ($hd->request_method eq 'GET' || $hd->request_method eq 'HEAD') {
|
|
# and once we have it, start serving
|
|
$self->watch_read(0);
|
|
return $self->_serve_request($hd);
|
|
} elsif ($self->{service}->{enable_put} && $hd->request_method eq 'PUT') {
|
|
# they want to put something, so let's setup and wait for more reads
|
|
my $clen = $hd->header('Content-length') + 0;
|
|
|
|
# return a 400 (bad request) if we got no content length or if it's
|
|
# bigger than any specified max put size
|
|
return $self->send_response(400, "Content-length of $clen is invalid.")
|
|
if !$clen ||
|
|
($self->{service}->{max_put_size} &&
|
|
$clen > $self->{service}->{max_put_size});
|
|
|
|
# if we have some data already from a header over-read, handle it by
|
|
# flattening it down to a single string as opposed to an array of stuff
|
|
if (defined $self->{read_size} && $self->{read_size} > 0) {
|
|
my $data = '';
|
|
foreach my $rdata (@{$self->{read_buf}}) {
|
|
$data .= ref $rdata ? $$rdata : $rdata;
|
|
}
|
|
$self->{read_buf} = $data;
|
|
$self->{content_length} = $clen;
|
|
$self->{content_length_remain} = $clen - $self->{read_size};
|
|
} else {
|
|
# setup to read the file
|
|
$self->{read_buf} = '';
|
|
$self->{content_length} = $self->{content_length_remain} = $clen;
|
|
}
|
|
|
|
# setup the directory asynchronously
|
|
$self->setup_put;
|
|
return;
|
|
} elsif ($self->{service}->{enable_delete} && $hd->request_method eq 'DELETE') {
|
|
# delete a file
|
|
$self->watch_read(0);
|
|
return $self->setup_delete;
|
|
}
|
|
|
|
# else, bad request
|
|
return $self->send_response(400);
|
|
}
|
|
|
|
# called when we're requested to do a delete
|
|
sub setup_delete {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
|
|
# error in filename? (any .. is an error)
|
|
my $uri = $self->{req_headers}->request_uri;
|
|
return $self->send_response(400, 'Invalid filename')
|
|
if $uri =~ /\.\./;
|
|
|
|
# now we want to get the URI
|
|
if ($uri =~ m!^(?:/[\w\-\.]+)+$!) {
|
|
# now attempt the unlink
|
|
Perlbal::AIO::aio_unlink($self->{service}->{docroot} . '/' . $uri, sub {
|
|
my $err = shift;
|
|
if ($err == 0 && !$!) {
|
|
# delete was successful
|
|
return $self->send_response(204);
|
|
} elsif ($! == ENOENT) {
|
|
# no such file
|
|
return $self->send_response(404);
|
|
} else {
|
|
# failure...
|
|
return $self->send_response(400, "$!");
|
|
}
|
|
});
|
|
} else {
|
|
# bad URI, don't accept the delete
|
|
return $self->send_response(400, 'Invalid filename');
|
|
}
|
|
}
|
|
|
|
# called when we've got headers and are about to start a put
|
|
sub setup_put {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
|
|
return if $self->{service}->run_hook('setup_put', $self);
|
|
return if $self->{put_fh};
|
|
|
|
# error in filename? (any .. is an error)
|
|
my $uri = $self->{req_headers}->request_uri;
|
|
return $self->send_response(400, 'Invalid filename')
|
|
if $uri =~ /\.\./;
|
|
|
|
# now we want to get the URI
|
|
if ($uri =~ m!^((?:/[\w\-\.]+)*)/([\w\-\.]+)$!) {
|
|
# sanitize uri into path and file into a disk path and filename
|
|
my ($path, $filename) = ($1 || '', $2);
|
|
|
|
# verify minput if necessary
|
|
if ($self->{service}->{min_put_directory}) {
|
|
my @elems = grep { defined $_ && length $_ } split '/', $path;
|
|
return $self->send_response(400, 'Does not meet minimum directory requirement')
|
|
unless scalar(@elems) >= $self->{service}->{min_put_directory};
|
|
my $minput = '/' . join('/', splice(@elems, 0, $self->{service}->{min_put_directory}));
|
|
my $path = '/' . join('/', @elems);
|
|
return unless $self->verify_put($minput, $path, $filename);
|
|
}
|
|
|
|
# now we want to open this directory
|
|
my $lpath = $self->{service}->{docroot} . '/' . $path;
|
|
return $self->attempt_open($lpath, $filename);
|
|
} else {
|
|
# bad URI, don't accept the put
|
|
return $self->send_response(400, 'Invalid filename');
|
|
}
|
|
}
|
|
|
|
# verify that a minimum put directory exists
|
|
# return value: 1 means the directory is okay, continue
|
|
# 0 means we must verify the directory, stop processing
|
|
sub verify_put {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
my ($minput, $extrapath, $filename) = @_;
|
|
|
|
my $mindir = $self->{service}->{docroot} . '/' . $minput;
|
|
return 1 if $VerifiedDirs{$mindir};
|
|
$self->{put_in_progress} = 1;
|
|
|
|
Perlbal::AIO::aio_open($mindir, O_RDONLY, 0755, sub {
|
|
my $fh = shift;
|
|
$self->{put_in_progress} = 0;
|
|
|
|
# if error return failure
|
|
return $self->send_response(404, "Base directory does not exist") unless $fh;
|
|
CORE::close($fh);
|
|
|
|
# mindir existed, mark it as so and start the open for the rest of the path
|
|
$VerifiedDirs{$mindir} = 1;
|
|
return $self->attempt_open($mindir . $extrapath, $filename);
|
|
});
|
|
return 0;
|
|
}
|
|
|
|
# attempt to open a file
|
|
sub attempt_open {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
my ($path, $file) = @_;
|
|
|
|
$self->{put_in_progress} = 1;
|
|
|
|
Perlbal::AIO::aio_open("$path/$file", O_CREAT | O_TRUNC | O_WRONLY, 0644, sub {
|
|
# get the fd
|
|
my $fh = shift;
|
|
|
|
# verify file was opened
|
|
$self->{put_in_progress} = 0;
|
|
|
|
if (! $fh) {
|
|
if ($! == ENOENT) {
|
|
# directory doesn't exist, so let's manually create it
|
|
eval { File::Path::mkpath($path, 0, 0755); };
|
|
return $self->system_error("Unable to create directory", "path = $path, file = $file") if $@;
|
|
|
|
# should be created, call self recursively to try
|
|
return $self->attempt_open($path, $file);
|
|
} else {
|
|
return $self->system_error("Internal error", "error = $!, path = $path, file = $file");
|
|
}
|
|
}
|
|
|
|
$self->{put_fh} = $fh;
|
|
$self->{put_pos} = 0;
|
|
$self->handle_put;
|
|
});
|
|
}
|
|
|
|
# method that sends a 500 to the user but logs it and any extra information
|
|
# we have about the error in question
|
|
sub system_error {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
my ($msg, $info) = @_;
|
|
|
|
# log to syslog
|
|
Perlbal::log('warning', "system error: $msg ($info)");
|
|
|
|
# and return a 500
|
|
return $self->send_response(500, $msg);
|
|
}
|
|
|
|
# called when we've got some put data to write out
|
|
sub handle_put {
|
|
my Perlbal::ClientHTTP $self = shift;
|
|
|
|
return if $self->{service}->run_hook('handle_put', $self);
|
|
return if $self->{put_in_progress};
|
|
return unless $self->{put_fh};
|
|
return unless $self->{read_size};
|
|
|
|
# dig out data to write
|
|
my ($data, $count) = ($self->{read_buf}, $self->{read_size});
|
|
($self->{read_buf}, $self->{read_size}) = ('', 0);
|
|
|
|
# okay, file is open, write some data
|
|
$self->{put_in_progress} = 1;
|
|
|
|
Perlbal::AIO::aio_write($self->{put_fh}, $self->{put_pos}, $count, $data, sub {
|
|
return if $self->{closed};
|
|
|
|
# see how many bytes written
|
|
my $bytes = shift() + 0;
|
|
|
|
$self->{put_pos} += $bytes;
|
|
$self->{put_in_progress} = 0;
|
|
|
|
# now recursively call ourselves?
|
|
if ($self->{read_size}) {
|
|
$self->handle_put;
|
|
} else {
|
|
# we done putting this file?
|
|
unless ($self->{content_length_remain}) {
|
|
# close it
|
|
# FIXME this should be done through AIO
|
|
if ($self->{put_fh} && CORE::close($self->{put_fh})) {
|
|
$self->{put_fh} = undef;
|
|
return $self->send_response(200);
|
|
} else {
|
|
return $self->system_error("Error saving file", "error in close: $!");
|
|
}
|
|
}
|
|
}
|
|
});
|
|
}
|
|
|
|
1;
|
|
|
|
# Local Variables:
|
|
# mode: perl
|
|
# c-basic-indent: 4
|
|
# indent-tabs-mode: nil
|
|
# End:
|