use strict;
use warnings;
-use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
-use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN);
-use POSIX qw(strftime EINTR EAGAIN);
-use Fcntl;
-use IO::File;
-use File::stat qw();
-use File::Find;
-use MIME::Base64;
-use Digest::MD5;
-use Digest::SHA;
-# use AnyEvent::Strict; # only use this for debugging
-use AnyEvent::Util qw(guard fh_nonblocking WSAEWOULDBLOCK WSAEINPROGRESS);
-use AnyEvent::Socket;
+
+use AnyEvent::HTTP;
use AnyEvent::Handle;
-use Net::SSLeay;
-use AnyEvent::TLS;
use AnyEvent::IO;
-use AnyEvent::HTTP;
-use Fcntl ();
+use AnyEvent::Socket;
+# use AnyEvent::Strict; # only use this for debugging
+use AnyEvent::TLS;
+use AnyEvent::Util qw(guard fh_nonblocking WSAEWOULDBLOCK WSAEINPROGRESS);
+
use Compress::Zlib;
+use Digest::MD5;
+use Digest::SHA;
use Encode;
-use PVE::SafeSyslog;
-use PVE::INotify;
-use PVE::Tools;
-use PVE::APIServer::Formatter;
-use PVE::APIServer::Utils;
+use Fcntl ();
+use Fcntl;
+use File::Find;
+use File::stat qw();
+use IO::File;
+use MIME::Base64;
+use Net::SSLeay;
+use POSIX qw(strftime EINTR EAGAIN);
+use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN);
+use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
-use Net::IP;
-use URI;
-use URI::Escape;
-use HTTP::Status qw(:constants);
+#use Data::Dumper; # FIXME: remove, just use: print to_json([$var], {pretty => 1}) ."\n";
use HTTP::Date;
use HTTP::Headers;
use HTTP::Request;
use HTTP::Response;
-use Data::Dumper;
+use HTTP::Status qw(:constants);
use JSON;
+use Net::IP;
+use URI::Escape;
+use URI;
+
+use PVE::INotify;
+use PVE::SafeSyslog;
+use PVE::Tools;
+
+use PVE::APIServer::Formatter;
+use PVE::APIServer::Utils;
my $limit_max_headers = 64;
my $limit_max_header_size = 8*1024;
}
sub cleanup_reqstate {
- my ($reqstate) = @_;
+ my ($reqstate, $deletetmpfile) = @_;
delete $reqstate->{log};
delete $reqstate->{request};
delete $reqstate->{starttime};
if ($reqstate->{tmpfilename}) {
- unlink $reqstate->{tmpfilename};
+ unlink $reqstate->{tmpfilename} if $deletetmpfile;
delete $reqstate->{tmpfilename};
}
}
sub client_do_disconnect {
my ($self, $reqstate) = @_;
- cleanup_reqstate($reqstate);
+ cleanup_reqstate($reqstate, 1);
my $shutdown_hdl = sub {
my $hdl = shift;
};
if (my $proxyhdl = delete $reqstate->{proxyhdl}) {
- &$shutdown_hdl($proxyhdl);
+ &$shutdown_hdl($proxyhdl)
+ if !$proxyhdl->{block_disconnect};
}
my $hdl = delete $reqstate->{hdl};
sub finish_response {
my ($self, $reqstate) = @_;
- cleanup_reqstate($reqstate);
+ cleanup_reqstate($reqstate, 0);
my $hdl = $reqstate->{hdl};
return if !$hdl; # already disconnected
my $code = $resp->code;
my $msg = $resp->message || HTTP::Status::status_message($code);
- ($msg) = $msg =~m/^(.*)$/m;
my $content = $resp->content;
+ # multiline mode only checks \n for $, so explicitly check for any \n or \r afterwards
+ ($msg) = $msg =~ m/^(.*)$/m;
+ if ($msg =~ /[\r\n]/) {
+ $code = 400; # bad request from user
+ $msg = HTTP::Status::status_message($code);
+ $content = '';
+ }
+
if ($code =~ /^(1\d\d|[23]04)$/) {
- # make sure content we have no content
+ # make sure informational, no content and not modified response send no content
$content = "";
}
} elsif ($delay && $delay > 0) {
my $w; $w = AnyEvent->timer(after => $delay, cb => sub {
undef $w; # delete reference
+ return if !$reqstate->{hdl}; # already disconnected
$reqstate->{hdl}->push_write($res);
$self->finish_response($reqstate);
});
if (ref($download) eq 'HASH') {
$mime = $download->{'content-type'};
+ my $encoding = $download->{'content-encoding'};
if ($download->{path} && $download->{stream} &&
$reqstate->{request}->header('PVEDisableProxy'))
pvestreamfile => $download->{path},
Content_Type => $mime,
);
+ $header->header('Content-Encoding' => $encoding) if defined($encoding);
# we need some data so Content-Length gets set correctly and
# the proxy doesn't wait for more data - place a canary
my $resp = HTTP::Response->new(200, "OK", $header, "error canary");
if ($download->{stream}) {
my $header = HTTP::Headers->new(Content_Type => $mime);
+ $header->header('Content-Encoding' => $encoding) if defined($encoding);
my $resp = HTTP::Response->new(200, "OK", $header);
$self->response($reqstate, $resp, undef, 1, 0, $fh);
return;
} elsif ($opcode == 8) {
my $statuscode = unpack ("n", $payload);
$self->dprint("websocket received close. status code: '$statuscode'");
- if ($reqstate->{proxyhdl}) {
- $reqstate->{proxyhdl}->push_shutdown();
- }
+ if (my $proxyhdl = $reqstate->{proxyhdl}) {
+ $proxyhdl->{block_disconnect} = 1 if length $proxyhdl->{wbuf};
+
+ $proxyhdl->push_shutdown();
+ }
$hdl->push_shutdown();
} elsif ($opcode == 9) {
# ping received, schedule pong
eval {
my $target;
my $keep_alive = 1;
+
+ # stringify URI object and verify it starts with a slash
+ $uri = "$uri";
+ if ($uri !~ m@^/@) {
+ $self->error($reqstate, 400, "invalid proxy uri");
+ return;
+ }
+
+ my $may_stream_file;
if ($host eq 'localhost') {
$target = "http://$host:85$uri";
# keep alive for localhost is not worth (connection setup is about 0.2ms)
$keep_alive = 0;
+ $may_stream_file = 1;
} elsif (Net::IP::ip_is_ipv6($host)) {
$target = "https://[$host]:8006$uri";
} else {
$header->header(Location => $location);
}
if ($stream) {
+ if (!$may_stream_file) {
+ $self->error($reqstate, 403, 'streaming denied');
+ return;
+ }
sysopen(my $fh, "$stream", O_NONBLOCK | O_RDONLY)
or die "open stream path '$stream' for forwarding failed: $!\n";
my $resp = HTTP::Response->new($code, $msg, $header, undef);
$params = extract_params($r, $method);
}
- delete $params->{_dc}; # remove disable cache parameter
+ delete $params->{_dc} if $params; # remove disable cache parameter
my $clientip = $reqstate->{peer_host};
} else {
my $elapsed = tv_interval($rstate->{starttime});
- my $rate = int($rstate->{bytes}/($elapsed*1024*1024));
- syslog('info', "multipart upload complete " .
- "(size: %d time: %ds rate: %.2fMiB/s md5sum: $rstate->{md5sum})",
- $rstate->{bytes}, $elapsed, $rate);
+ my $rate = int($rstate->{bytes} / ($elapsed * 1024 * 1024));
+ syslog('info',
+ "multipart upload complete (size: %d time: %ds rate: %.2fMiB/s md5sum: %s)",
+ $rstate->{bytes}, $elapsed, $rate, $rstate->{md5sum}
+ );
$self->handle_api2_request($reqstate, $auth, $method, $path, $rstate);
}
}
outfh => $outfh,
};
$reqstate->{tmpfilename} = $tmpfilename;
- $reqstate->{hdl}->on_read(sub { $self->file_upload_multipart($reqstate, $auth, $method, $path, $state); });
+ $reqstate->{hdl}->on_read(sub {
+ $self->file_upload_multipart($reqstate, $auth, $method, $path, $state);
+ });
return;
}
$self->error($reqstate, 506, "http protocol version $maj.$min not supported");
return;
}
+ if ($url =~ m|^[^/]*@|) {
+ # if an '@' comes before the first slash proxy forwarding might consider
+ # the frist part of the url to be part of an authority...
+ $self->error($reqstate, 400, "invalid url");
+ }
$self->{request_count}++; # only count valid request headers
if ($self->{request_count} >= $self->{max_requests}) {
honor_cipher_order => 1,
};
+ # workaround until anyevent supports TLS 1.3 ciphersuites directly
+ my $ciphersuites = delete $self->{ssl}->{ciphersuites};
+
foreach my $k (keys %$ssl_defaults) {
$self->{ssl}->{$k} //= $ssl_defaults->{$k};
}
$self->{ssl}->{dh} = 'skip2048';
}
- my $tls_ctx_flags = &Net::SSLeay::OP_NO_COMPRESSION | &Net::SSLeay::OP_SINGLE_ECDH_USE | &Net::SSLeay::OP_SINGLE_DH_USE;
- if ( delete $self->{ssl}->{honor_cipher_order} ) {
+ my $tls_ctx_flags = 0;
+ $tls_ctx_flags |= &Net::SSLeay::OP_NO_COMPRESSION;
+ $tls_ctx_flags |= &Net::SSLeay::OP_SINGLE_ECDH_USE;
+ $tls_ctx_flags |= &Net::SSLeay::OP_SINGLE_DH_USE;
+ $tls_ctx_flags |= &Net::SSLeay::OP_NO_RENEGOTIATION;
+ if (delete $self->{ssl}->{honor_cipher_order}) {
$tls_ctx_flags |= &Net::SSLeay::OP_CIPHER_SERVER_PREFERENCE;
}
+ # workaround until anyevent supports disabling TLS 1.3 directly
+ if (exists($self->{ssl}->{tlsv1_3}) && !$self->{ssl}->{tlsv1_3}) {
+ $tls_ctx_flags |= &Net::SSLeay::OP_NO_TLSv1_3;
+ }
+
$self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}});
Net::SSLeay::CTX_set_options($self->{tls_ctx}->{ctx}, $tls_ctx_flags);
+ if (defined($ciphersuites)) {
+ warn "Failed to set TLS 1.3 ciphersuites '$ciphersuites'\n"
+ if !Net::SSLeay::CTX_set_ciphersuites($self->{tls_ctx}->{ctx}, $ciphersuites);
+ }
}
if ($self->{spiceproxy}) {