]> git.proxmox.com Git - pve-http-server.git/blobdiff - PVE/APIServer/AnyEvent.pm
access control: correctly match v4-mapped-v6 addresses
[pve-http-server.git] / PVE / APIServer / AnyEvent.pm
old mode 100755 (executable)
new mode 100644 (file)
index 277a1ec..f0e2e68
@@ -34,6 +34,7 @@ use PVE::SafeSyslog;
 use PVE::INotify;
 use PVE::Tools;
 use PVE::APIServer::Formatter;
+use PVE::APIServer::Utils;
 
 use Net::IP;
 use URI;
@@ -44,8 +45,9 @@ use HTTP::Headers;
 use HTTP::Request;
 use HTTP::Response;
 use Data::Dumper;
+use JSON;
 
-my $limit_max_headers = 30;
+my $limit_max_headers = 64;
 my $limit_max_header_size = 8*1024;
 my $limit_max_post = 64*1024;
 
@@ -65,6 +67,16 @@ my $split_abs_uri = sub {
     return wantarray ? ($rel_uri, $format) : $rel_uri;
 };
 
+sub dprint {
+    my ($self, $message) = @_;
+
+    return if !$self->{debug};
+
+    my ($pkg, $pkgfile, $line, $sub) = caller(1);
+    $sub =~ s/^(?:.+::)+//;
+    print "worker[$$]: $pkg +$line: $sub: $message\n";
+}
+
 sub log_request {
     my ($self, $reqstate) = @_;
 
@@ -142,13 +154,15 @@ sub client_do_disconnect {
        return;
     }
 
-    print "close connection $hdl\n" if $self->{debug};
+    $self->dprint("close connection $hdl");
 
     &$shutdown_hdl($hdl);
 
+    warn "connection count <= 0!\n" if $self->{conn_count} <= 0;
+
     $self->{conn_count}--;
 
-    print "$$: CLOSE FH" .  $hdl->{fh}->fileno() . " CONN$self->{conn_count}\n" if $self->{debug};
+    $self->dprint("CLOSE FH" .  $hdl->{fh}->fileno() . " CONN$self->{conn_count}");
 }
 
 sub finish_response {
@@ -175,8 +189,93 @@ sub finish_response {
     }
 }
 
+sub response_stream {
+    my ($self, $reqstate, $stream_fh) = @_;
+
+    # disable timeout, we don't know how big the data is
+    $reqstate->{hdl}->timeout(0);
+
+    my $buf_size = 4*1024*1024;
+
+    my $on_read;
+    $on_read = sub {
+       my ($hdl) = @_;
+       my $reqhdl = $reqstate->{hdl};
+       return if !$reqhdl;
+
+       my $wbuf_len = length($reqhdl->{wbuf});
+       my $rbuf_len = length($hdl->{rbuf});
+       # TODO: Take into account $reqhdl->{wbuf_max} ? Right now
+       # that's unbounded, so just assume $buf_size
+       my $to_read = $buf_size - $wbuf_len;
+       $to_read = $rbuf_len if $rbuf_len < $to_read;
+       if ($to_read > 0) {
+           my $data = substr($hdl->{rbuf}, 0, $to_read, '');
+           $reqhdl->push_write($data);
+           $rbuf_len -= $to_read;
+       } elsif ($hdl->{_eof}) {
+           # workaround: AnyEvent gives us a fake EPIPE if we don't consume
+           # any data when called at EOF, so unregister ourselves - data is
+           # flushed by on_eof anyway
+           # see: https://sources.debian.org/src/libanyevent-perl/7.170-2/lib/AnyEvent/Handle.pm/#L1329
+           $hdl->on_read();
+           return;
+       }
+
+       # apply backpressure so we don't accept any more data into
+       # buffer if the client isn't downloading fast enough
+       # note: read_size can double upon read, and we also need to
+       # account for one more read after start_read, so *4
+       if ($rbuf_len + $hdl->{read_size}*4 > $buf_size) {
+           # stop reading until write buffer is empty
+           $hdl->on_read();
+           my $prev_on_drain = $reqhdl->{on_drain};
+           $reqhdl->on_drain(sub {
+               my ($wrhdl) = @_;
+               # on_drain called because write buffer is empty, continue reading
+               $hdl->on_read($on_read);
+               if ($prev_on_drain) {
+                   $wrhdl->on_drain($prev_on_drain);
+                   $prev_on_drain->($wrhdl);
+               }
+           });
+       }
+    };
+
+    $reqstate->{proxyhdl} = AnyEvent::Handle->new(
+       fh => $stream_fh,
+       rbuf_max => $buf_size,
+       timeout => 0,
+       on_read => $on_read,
+       on_eof => sub {
+           my ($hdl) = @_;
+           eval {
+               if (my $reqhdl = $reqstate->{hdl}) {
+                   $self->log_aborted_request($reqstate);
+                   # write out any remaining data
+                   $reqhdl->push_write($hdl->{rbuf}) if length($hdl->{rbuf}) > 0;
+                   $hdl->{rbuf} = "";
+                   $reqhdl->push_shutdown();
+                   $self->finish_response($reqstate);
+               }
+           };
+           if (my $err = $@) { syslog('err', "$err"); }
+           $on_read = undef;
+       },
+       on_error => sub {
+           my ($hdl, $fatal, $message) = @_;
+           eval {
+               $self->log_aborted_request($reqstate, $message);
+               $self->client_do_disconnect($reqstate);
+           };
+           if (my $err = $@) { syslog('err', "$err"); }
+           $on_read = undef;
+       },
+    );
+}
+
 sub response {
-    my ($self, $reqstate, $resp, $mtime, $nocomp, $delay) = @_;
+    my ($self, $reqstate, $resp, $mtime, $nocomp, $delay, $stream_fh) = @_;
 
     #print "$$: send response: " . Dumper($resp);
 
@@ -184,7 +283,7 @@ sub response {
     $reqstate->{hdl}->timeout_reset();
     $reqstate->{hdl}->timeout($self->{timeout});
 
-    $nocomp = !$self->{compression};
+    $nocomp = 1 if !$self->{compression};
     $nocomp = 1 if !$reqstate->{accept_gzip};
 
     my $code = $resp->code;
@@ -218,7 +317,7 @@ sub response {
     $resp->header('Server' => "pve-api-daemon/3.0");
 
     my $content_length;
-    if ($content) {
+    if ($content && !$stream_fh) {
 
        $content_length = length($content);
 
@@ -245,11 +344,16 @@ sub response {
     #print "SEND(without content) $res\n" if $self->{debug};
 
     $res .= "\015\012";
-    $res .= $content if $content;
+    $res .= $content if $content && !$stream_fh;
 
     $self->log_request($reqstate, $reqstate->{request});
 
-    if ($delay && $delay > 0) {
+    if ($stream_fh) {
+       # write headers and preamble...
+       $reqstate->{hdl}->push_write($res);
+       # ...then stream data via an AnyEvent::Handle
+       $self->response_stream($reqstate, $stream_fh);
+    } elsif ($delay && $delay > 0) {
        my $w; $w = AnyEvent->timer(after => $delay, cb => sub {
            undef $w; # delete reference
            $reqstate->{hdl}->push_write($res);
@@ -293,7 +397,7 @@ my $file_extension_info = {
 };
 
 sub send_file_start {
-    my ($self, $reqstate, $filename) = @_;
+    my ($self, $reqstate, $download) = @_;
 
     eval {
        # print "SEND FILE $filename\n";
@@ -302,8 +406,57 @@ sub send_file_start {
 
            my $r = $reqstate->{request};
 
-           my $fh = IO::File->new($filename, '<') ||
-               die "$!\n";
+           my $fh;
+           my $nocomp;
+           my $mime;
+
+           if (ref($download) eq 'HASH') {
+               $mime = $download->{'content-type'};
+
+               if ($download->{path} && $download->{stream} &&
+                   $reqstate->{request}->header('PVEDisableProxy'))
+               {
+                   # avoid double stream from a file, let the proxy handle it
+                   die "internal error: file proxy streaming only available for pvedaemon\n"
+                       if !$self->{trusted_env};
+                   my $header = HTTP::Headers->new(
+                       pvestreamfile => $download->{path},
+                       Content_Type => $mime,
+                   );
+                   # 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");
+                   $self->response($reqstate, $resp);
+                   return;
+               }
+
+               if (!($fh = $download->{fh})) {
+                   my $path = $download->{path};
+                   die "internal error: {download} returned but neither fh not path given\n"
+                       if !$path;
+                   sysopen($fh, "$path", O_NONBLOCK | O_RDONLY)
+                       or die "open stream path '$path' for reading failed: $!\n";
+               }
+
+               if ($download->{stream}) {
+                   my $header = HTTP::Headers->new(Content_Type => $mime);
+                   my $resp = HTTP::Response->new(200, "OK", $header);
+                   $self->response($reqstate, $resp, undef, 1, 0, $fh);
+                   return;
+               }
+           } else {
+               my $filename = $download;
+               $fh = IO::File->new($filename, '<') ||
+                   die "unable to open file '$filename' - $!\n";
+
+               my ($ext) = $filename =~ m/\.([^.]*)$/;
+               my $ext_info = $file_extension_info->{$ext};
+
+               die "unable to detect content type" if !$ext_info;
+               $mime = $ext_info->{ct};
+               $nocomp = $ext_info->{nocomp};
+           }
+
            my $stat = File::stat::stat($fh) ||
                die "$!\n";
 
@@ -322,14 +475,9 @@ sub send_file_start {
            my $len = sysread($fh, $data,  $stat->size);
            die "got short file\n" if !defined($len) || $len != $stat->size;
 
-           my ($ext) = $filename =~ m/\.([^.]*)$/;
-           my $ext_info = $file_extension_info->{$ext};
-
-           die "unable to detect content type" if !$ext_info;
-
-           my $header = HTTP::Headers->new(Content_Type => $ext_info->{ct});
+           my $header = HTTP::Headers->new(Content_Type => $mime);
            my $resp = HTTP::Response->new(200, "OK", $header, $data);
-           $self->response($reqstate, $resp, $mtime, $ext_info->{nocomp});
+           $self->response($reqstate, $resp, $mtime, $nocomp);
        };
        if (my $err = $@) {
            $self->error($reqstate, 501, $err);
@@ -367,11 +515,38 @@ sub websocket_proxy {
            die "websocket_proxy: missing port or socket\n";
        }
 
+       my $encode = sub {
+           my ($data, $opcode) = @_;
+
+           my $string;
+           my $payload;
+           if ($binary) {
+               $string = $opcode ? $opcode : "\x82"; # binary frame
+               $payload = $$data;
+           } else {
+               $string = $opcode ? $opcode : "\x81"; # text frame
+               $payload = encode_base64($$data, '');
+           }
+
+           my $payload_len = length($payload);
+           if ($payload_len <= 125) {
+               $string .= pack 'C', $payload_len;
+           } elsif ($payload_len <= 0xffff) {
+               $string .= pack 'C', 126;
+               $string .= pack 'n', $payload_len;
+           } else {
+               $string .= pack 'C', 127;
+               $string .= pack 'Q>', $payload_len;
+           }
+           $string .= $payload;
+           return $string;
+       };
+
        tcp_connect $remhost, $remport, sub {
            my ($fh) = @_
                or die "connect to '$remhost:$remport' failed: $!";
 
-           print "$$: CONNECTed to '$remhost:$remport'\n" if $self->{debug};
+           $self->dprint("CONNECTed to '$remhost:$remport'");
 
            $reqstate->{proxyhdl} = AnyEvent::Handle->new(
                fh => $fh,
@@ -401,28 +576,7 @@ sub websocket_proxy {
                my $len = length($hdl->{rbuf});
                my $data = substr($hdl->{rbuf}, 0, $len > $max_payload_size ? $max_payload_size : $len, '');
 
-               my $string;
-               my $payload;
-
-               if ($binary) {
-                   $string = "\x82"; # binary frame
-                   $payload = $data;
-               } else {
-                   $string = "\x81"; # text frame
-                   $payload = encode_base64($data, '');
-               }
-
-               my $payload_len = length($payload);
-               if ($payload_len <= 125) {
-                   $string .= pack 'C', $payload_len;
-               } elsif ($payload_len <= 0xffff) {
-                   $string .= pack 'C', 126;
-                   $string .= pack 'n', $payload_len;
-               } else {
-                   $string .= pack 'C', 127;
-                   $string .= pack 'Q>', $payload_len;
-               }
-               $string .= $payload;
+               my $string = $encode->(\$data);
 
                $reqstate->{hdl}->push_write($string) if $reqstate->{hdl};
            };
@@ -466,19 +620,19 @@ sub websocket_proxy {
 
                    my $data = substr($hdl->{rbuf}, 0, $offset + 4 + $payload_len, ''); # now consume data
 
-                   my @mask = (unpack('C', substr($data, $offset+0, 1)),
-                       unpack('C', substr($data, $offset+1, 1)),
-                       unpack('C', substr($data, $offset+2, 1)),
-                       unpack('C', substr($data, $offset+3, 1)));
-
+                   my $mask = substr($data, $offset, 4);
                    $offset += 4;
 
                    my $payload = substr($data, $offset, $payload_len);
 
-                   for (my $i = 0; $i < $payload_len; $i++) {
-                       my $d = unpack('C', substr($payload, $i, 1));
-                       my $n = $d ^ $mask[$i % 4];
-                       substr($payload, $i, 1, pack('C', $n));
+                   # NULL-mask might be used over TLS, skip to increase performance
+                   if ($mask ne pack('N', 0)) {
+                       # repeat 4 byte mask to payload length + up to 4 byte
+                       $mask = $mask x (int($payload_len / 4) + 1);
+                       # truncate mask to payload length
+                       substr($mask, $payload_len) = "";
+                       # (un-)apply mask
+                       $payload ^= $mask;
                    }
 
                    $payload = decode_base64($payload) if !$binary;
@@ -487,11 +641,16 @@ sub websocket_proxy {
                        $reqstate->{proxyhdl}->push_write($payload) if $reqstate->{proxyhdl};
                    } elsif ($opcode == 8) {
                        my $statuscode = unpack ("n", $payload);
-                       print "websocket received close. status code: '$statuscode'\n" if $self->{debug};
-                   if ($reqstate->{proxyhdl}) {
-                               $reqstate->{proxyhdl}->push_shutdown();
-                   }
+                       $self->dprint("websocket received close. status code: '$statuscode'");
+                       if ($reqstate->{proxyhdl}) {
+                           $reqstate->{proxyhdl}->push_shutdown();
+                       }
                        $hdl->push_shutdown();
+                   } elsif ($opcode == 9) {
+                       # ping received, schedule pong
+                       $reqstate->{hdl}->push_write($encode->(\$payload, "\x8A")) if $reqstate->{hdl};
+                   } elsif ($opcode == 0xA) {
+                       # pong received, continue
                    } else {
                        die "received unhandled websocket opcode $opcode\n";
                    }
@@ -513,7 +672,7 @@ sub websocket_proxy {
                "Sec-WebSocket-Protocol: $wsproto\015\012" .
                "\015\012";
 
-           print $res if $self->{debug};
+           $self->dprint($res);
 
            $reqstate->{hdl}->push_write($res);
 
@@ -531,7 +690,7 @@ sub websocket_proxy {
 }
 
 sub proxy_request {
-    my ($self, $reqstate, $clientip, $host, $node, $method, $uri, $ticket, $token, $params) = @_;
+    my ($self, $reqstate, $clientip, $host, $node, $method, $uri, $auth, $params) = @_;
 
     eval {
        my $target;
@@ -551,10 +710,18 @@ sub proxy_request {
            PVEClientIP => $clientip,
        };
 
-       $headers->{'cookie'} = PVE::APIServer::Formatter::create_auth_cookie($ticket, $self->{cookie_name}) if $ticket;
-       $headers->{'CSRFPreventionToken'} = $token if $token;
+       $headers->{'cookie'} = PVE::APIServer::Formatter::create_auth_cookie($auth->{ticket}, $self->{cookie_name})
+           if $auth->{ticket};
+       $headers->{'Authorization'} = PVE::APIServer::Formatter::create_auth_header($auth->{api_token}, $self->{apitoken_name})
+           if $auth->{api_token};
+       $headers->{'CSRFPreventionToken'} = $auth->{token}
+           if $auth->{token};
        $headers->{'Accept-Encoding'} = 'gzip' if ($reqstate->{accept_gzip} && $self->{compression});
 
+       if (defined(my $host = $reqstate->{request}->header('Host'))) {
+           $headers->{Host} = $host;
+       }
+
        my $content;
 
        if  ($method eq 'POST' || $method eq 'PUT') {
@@ -608,6 +775,7 @@ sub proxy_request {
                eval {
                    my $code = delete $hdr->{Status};
                    my $msg = delete $hdr->{Reason};
+                   my $stream = delete $hdr->{pvestreamfile};
                    delete $hdr->{URL};
                    delete $hdr->{HTTPVersion};
                    my $header = HTTP::Headers->new(%$hdr);
@@ -615,9 +783,16 @@ sub proxy_request {
                        $location =~ s|^http://localhost:85||;
                        $header->header(Location => $location);
                    }
-                   my $resp = HTTP::Response->new($code, $msg, $header, $body);
-                   # Note: disable compression, because body is already compressed
-                   $self->response($reqstate, $resp, undef, 1);
+                   if ($stream) {
+                       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);
+                       $self->response($reqstate, $resp, undef, 1, 0, $fh);
+                   } else {
+                       my $resp = HTTP::Response->new($code, $msg, $header, $body);
+                       # Note: disable compression, because body is already compressed
+                       $self->response($reqstate, $resp, undef, 1);
+                   }
                };
                warn $@ if $@;
            });
@@ -638,16 +813,19 @@ sub decode_urlencoded {
        my ($k, $v) = split(/=/, $kv);
        $k =~s/\+/ /g;
        $k =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
-       $v =~s/\+/ /g;
-       $v =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
 
-       $v = Encode::decode('utf8', $v);
+       if (defined($v)) {
+           $v =~s/\+/ /g;
+           $v =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
 
-       if (defined(my $old = $res->{$k})) {
-           $res->{$k} = "$old\0$v";
-       } else {
-           $res->{$k} = $v;
+           $v = Encode::decode('utf8', $v);
+
+           if (defined(my $old = $res->{$k})) {
+               $v = "$old\0$v";
+           }
        }
+
+       $res->{$k} = $v;
     }
     return $res;
 }
@@ -658,7 +836,15 @@ sub extract_params {
     my $params = {};
 
     if ($method eq 'PUT' || $method eq 'POST') {
-       $params = decode_urlencoded($r->content);
+       my $ct;
+       if (my $ctype = $r->header('Content-Type')) {
+           $ct = parse_content_type($ctype);
+       }
+       if (defined($ct) && $ct eq 'application/json')  {
+           $params = decode_json($r->content);
+       } else {
+           $params = decode_urlencoded($r->content);
+       }
     }
 
     my $query_params = decode_urlencoded($r->url->query());
@@ -724,7 +910,7 @@ sub handle_api2_request {
            $res->{proxy_params}->{tmpfilename} = $reqstate->{tmpfilename} if $upload_state;
 
            $self->proxy_request($reqstate, $clientip, $host, $res->{proxynode}, $method,
-                                $r->uri, $auth->{ticket}, $auth->{token}, $res->{proxy_params}, $res->{proxynode});
+                                $r->uri, $auth, $res->{proxy_params});
            return;
 
        } elsif ($upgrade && ($method eq 'GET') && ($path =~ m|websocket$|)) {
@@ -756,10 +942,11 @@ sub handle_api2_request {
            $delay = 0 if $delay < 0;
        }
 
-       if (defined(my $filename = $res->{download})) {
-           my $fh = IO::File->new($filename) ||
-               die "unable to open file '$filename' - $!\n";
-           send_file_start($self, $reqstate, $filename);
+       my $download = $res->{download};
+       $download //= $res->{data}->{download}
+            if defined($res->{data}) && ref($res->{data}) eq 'HASH';
+       if (defined($download)) {
+           send_file_start($self, $reqstate, $download);
            return;
        }
 
@@ -786,7 +973,10 @@ sub handle_spice_proxy_request {
 
     eval {
 
-        die "Port $spiceport is not allowed" if ($spiceport < 61000 || $spiceport > 61099);
+       my ($minport, $maxport) = PVE::Tools::spice_port_range();
+       if ($spiceport < $minport || $spiceport > $maxport) {
+           die "SPICE Port $spiceport is not in allowed range ($minport, $maxport)\n";
+       }
 
        my $clientip = $reqstate->{peer_host};
        my $r = $reqstate->{request};
@@ -795,9 +985,9 @@ sub handle_spice_proxy_request {
 
         if ($node ne 'localhost' && PVE::INotify::nodename() !~ m/^$node$/i) {
             $remip = $self->remote_node_ip($node);
-           print "REMOTE CONNECT $vmid, $remip, $connect_str\n" if $self->{debug};
+           $self->dprint("REMOTE CONNECT $vmid, $remip, $connect_str");
         } else {
-           print "$$: CONNECT $vmid, $node, $spiceport\n" if $self->{debug};
+           $self->dprint("CONNECT $vmid, $node, $spiceport");
        }
 
        if ($remip && $r->header('PVEDisableProxy')) {
@@ -815,7 +1005,7 @@ sub handle_spice_proxy_request {
            my ($fh) = @_
                or die "connect to '$remhost:$remport' failed: $!";
 
-           print "$$: CONNECTed to '$remhost:$remport'\n" if $self->{debug};
+           $self->dprint("CONNECTed to '$remhost:$remport'");
            $reqstate->{proxyhdl} = AnyEvent::Handle->new(
                fh => $fh,
                rbuf_max => 64*1024,
@@ -1139,7 +1329,7 @@ sub unshift_read_header {
        eval {
            # print "$$: got header: $line\n" if $self->{debug};
 
-           die "to many http header lines\n" if ++$state->{count} >= $limit_max_headers;
+           die "too many http header lines (> $limit_max_headers)\n" if ++$state->{count} >= $limit_max_headers;
            die "http header too large\n" if ($state->{size} += length($line)) >= $limit_max_header_size;
 
            my $r = $reqstate->{request};
@@ -1191,11 +1381,16 @@ sub unshift_read_header {
 
                my $len = $r->header('Content-Length');
 
+               my $host_header = $r->header('Host');
+               if (my $rpcenv = $self->{rpcenv}) {
+                   $rpcenv->set_request_host($host_header);
+               }
+
                # header processing complete - authenticate now
 
                my $auth = {};
                if ($self->{spiceproxy}) {
-                   my $connect_str = $r->header('Host');
+                   my $connect_str = $host_header;
                    my ($vmid, $node, $port) = $self->verify_spice_connect_url($connect_str);
                    if (!(defined($vmid) && $node && $port)) {
                        $self->error($reqstate, HTTP_UNAUTHORIZED, "invalid ticket");
@@ -1206,7 +1401,19 @@ sub unshift_read_header {
                } elsif ($path =~ m/^\Q$base_uri\E/) {
                    my $token = $r->header('CSRFPreventionToken');
                    my $cookie = $r->header('Cookie');
-                   my $ticket = PVE::APIServer::Formatter::extract_auth_cookie($cookie, $self->{cookie_name});
+                   my $auth_header = $r->header('Authorization');
+
+                   # prefer actual cookie
+                   my $ticket = PVE::APIServer::Formatter::extract_auth_value($cookie, $self->{cookie_name});
+
+                   # fallback to cookie in 'Authorization' header
+                   $ticket = PVE::APIServer::Formatter::extract_auth_value($auth_header, $self->{cookie_name})
+                       if !$ticket;
+
+                   # finally, fallback to API token if no ticket has been provided so far
+                   my $api_token;
+                   $api_token = PVE::APIServer::Formatter::extract_auth_value($auth_header, $self->{apitoken_name})
+                       if !$ticket;
 
                    my ($rel_uri, $format) = &$split_abs_uri($path, $self->{base_uri});
                    if (!$format) {
@@ -1215,7 +1422,7 @@ sub unshift_read_header {
                    }
 
                    eval {
-                       $auth = $self->auth_handler($method, $rel_uri, $ticket, $token,
+                       $auth = $self->auth_handler($method, $rel_uri, $ticket, $token, $api_token,
                                                    $reqstate->{peer_host});
                    };
                    if (my $err = $@) {
@@ -1260,7 +1467,8 @@ sub unshift_read_header {
                    }
 
                    my $ctype = $r->header('Content-Type');
-                   my ($ct, $boundary) = parse_content_type($ctype) if $ctype;
+                   my ($ct, $boundary);
+                   ($ct, $boundary)= parse_content_type($ctype) if $ctype;
 
                    if ($auth->{isUpload} && !$self->{trusted_env}) {
                        die "upload 'Content-Type '$ctype' not implemented\n"
@@ -1270,7 +1478,7 @@ sub unshift_read_header {
 
                        die "upload without content length header not supported" if !$len;
 
-                       print "start upload $path $ct $boundary\n" if $self->{debug};
+                       $self->dprint("start upload $path $ct $boundary");
 
                        my $tmpfilename = get_upload_filename();
                        my $outfh = IO::File->new($tmpfilename, O_RDWR|O_CREAT|O_EXCL, 0600) ||
@@ -1303,7 +1511,7 @@ sub unshift_read_header {
                        return;
                    }
 
-                   if (!$ct || $ct eq 'application/x-www-form-urlencoded') {
+                   if (!$ct || $ct eq 'application/x-www-form-urlencoded' || $ct eq 'application/json') {
                        $reqstate->{hdl}->unshift_read(chunk => $len, sub {
                            my ($hdl, $data) = @_;
                            $r->content($data);
@@ -1416,8 +1624,6 @@ sub accept {
 
     fh_nonblocking $clientfh, 1;
 
-    $self->{conn_count}++;
-
     return $clientfh;
 }
 
@@ -1457,8 +1663,14 @@ sub wait_end_loop {
 sub check_host_access {
     my ($self, $clientip) = @_;
 
+    $clientip = PVE::APIServer::Utils::normalize_v4_in_v6($clientip);
     my $cip = Net::IP->new($clientip);
 
+    if (!$cip) {
+       $self->dprint("client IP not parsable: $@");
+       return 0;
+    }
+
     my $match_allow = 0;
     my $match_deny = 0;
 
@@ -1466,6 +1678,7 @@ sub check_host_access {
        foreach my $t (@{$self->{allow_from}}) {
            if ($t->overlaps($cip)) {
                $match_allow = 1;
+               $self->dprint("client IP allowed: ". $t->prefix());
                last;
            }
        }
@@ -1474,6 +1687,7 @@ sub check_host_access {
     if ($self->{deny_from}) {
        foreach my $t (@{$self->{deny_from}}) {
            if ($t->overlaps($cip)) {
+               $self->dprint("client IP denied: ". $t->prefix());
                $match_deny = 1;
                last;
            }
@@ -1491,29 +1705,40 @@ sub check_host_access {
 sub accept_connections {
     my ($self) = @_;
 
+    my ($clientfh, $handle_creation);
     eval {
 
-       while (my $clientfh = $self->accept()) {
+       while ($clientfh = $self->accept()) {
 
            my $reqstate = { keep_alive => $self->{keep_alive} };
 
            # stop keep-alive when there are many open connections
-           if ($self->{conn_count} >= $self->{max_conn_soft_limit}) {
+           if ($self->{conn_count} + 1 >= $self->{max_conn_soft_limit}) {
                $reqstate->{keep_alive} = 0;
            }
 
            if (my $sin = getpeername($clientfh)) {
                my ($pfamily, $pport, $phost) = PVE::Tools::unpack_sockaddr_in46($sin);
                ($reqstate->{peer_port}, $reqstate->{peer_host}) = ($pport,  Socket::inet_ntop($pfamily, $phost));
+           } else {
+               $self->dprint("getpeername failed: $!");
+               close($clientfh);
+               next;
            }
 
            if (!$self->{trusted_env} && !$self->check_host_access($reqstate->{peer_host})) {
-               print "$$: ABORT request from $reqstate->{peer_host} - access denied\n" if $self->{debug};
+               $self->dprint("ABORT request from $reqstate->{peer_host} - access denied");
                $reqstate->{log}->{code} = 403;
                $self->log_request($reqstate);
+               close($clientfh);
                next;
            }
 
+           # Increment conn_count before creating new handle, since creation
+           # triggers callbacks, which can potentialy decrement (e.g.
+           # on_error) conn_count before AnyEvent::Handle->new() returns.
+           $handle_creation = 1;
+           $self->{conn_count}++;
            $reqstate->{hdl} = AnyEvent::Handle->new(
                fh => $clientfh,
                rbuf_max => 64*1024,
@@ -1536,8 +1761,9 @@ sub accept_connections {
                    if (my $err = $@) { syslog('err', "$err"); }
                },
                ($self->{tls_ctx} ? (tls => "accept", tls_ctx => $self->{tls_ctx}) : ()));
+           $handle_creation = 0;
 
-           print "$$: ACCEPT FH" .  $clientfh->fileno() . " CONN$self->{conn_count}\n" if $self->{debug};
+           $self->dprint("ACCEPT FH" .  $clientfh->fileno() . " CONN$self->{conn_count}");
 
            $self->push_request_header($reqstate);
        }
@@ -1545,6 +1771,15 @@ sub accept_connections {
 
     if (my $err = $@) {
        syslog('err', $err);
+       $self->dprint("connection accept error: $err");
+       close($clientfh);
+       if ($handle_creation) {
+           if ($self->{conn_count} <= 0) {
+               warn "connection count <= 0 not decrementing!\n";
+           } else {
+               $self->{conn_count}--;
+           }
+       }
        $self->{end_loop} = 1;
     }
 
@@ -1609,6 +1844,7 @@ sub new {
     my $self = bless { %args }, $class;
 
     $self->{cookie_name} //= 'PVEAuthCookie';
+    $self->{apitoken_name} //= 'PVEAPIToken';
     $self->{base_uri} //= "/api2";
     $self->{dirs} //= {};
     $self->{title} //= 'API Inspector';
@@ -1616,17 +1852,18 @@ sub new {
 
     # formatter_config: we pass some configuration values to the Formatter
     $self->{formatter_config} = {};
-    foreach my $p (qw(cookie_name base_uri title)) {
+    foreach my $p (qw(apitoken_name cookie_name base_uri title)) {
        $self->{formatter_config}->{$p} = $self->{$p};
     }
     $self->{formatter_config}->{csrfgen_func} =
        $self->can('generate_csrf_prevention_token');
 
     # add default dirs which includes jquery and bootstrap
-    my $base = '/usr/share/libpve-http-server-perl';
-    add_dirs($self->{dirs}, '/css/' => "$base/css/");
-    add_dirs($self->{dirs}, '/js/' => "$base/js/");
-    add_dirs($self->{dirs}, '/fonts/' => "$base/fonts/");
+    my $jsbase = '/usr/share/javascript';
+    add_dirs($self->{dirs}, '/js/' => "$jsbase/");
+    # libjs-bootstrap uses symlinks for this, which we do not want to allow..
+    my $glyphicons = '/usr/share/fonts/truetype/glyphicons/';
+    add_dirs($self->{dirs}, '/js/bootstrap/fonts/' => "$glyphicons");
 
     # init inotify
     PVE::INotify::inotify_init();
@@ -1646,6 +1883,24 @@ sub new {
     $self->{end_cond} = AnyEvent->condvar;
 
     if ($self->{ssl}) {
+       my $ssl_defaults = {
+           # Note: older versions are considered insecure, for example
+           # search for "Poodle"-Attack
+           method => 'any',
+           sslv2 => 0,
+           sslv3 => 0,
+           cipher_list => 'ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256',
+           honor_cipher_order => 1,
+       };
+
+       foreach my $k (keys %$ssl_defaults) {
+           $self->{ssl}->{$k} //= $ssl_defaults->{$k};
+       }
+
+       if (!defined($self->{ssl}->{dh_file})) {
+           $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} ) {
            $tls_ctx_flags |= &Net::SSLeay::OP_CIPHER_SERVER_PREFERENCE;
@@ -1732,7 +1987,7 @@ sub generate_csrf_prevention_token {
 }
 
 sub auth_handler {
-    my ($self, $method, $rel_uri, $ticket, $token, $peer_host) = @_;
+    my ($self, $method, $rel_uri, $ticket, $token, $api_token, $peer_host) = @_;
 
     die "implement me";
 
@@ -1742,6 +1997,7 @@ sub auth_handler {
     #    userid => $username,
     #    age => $age,
     #    isUpload => $isUpload,
+    #    api_token => $api_token,
     #};
 }