Signed-off-by: Dietmar Maurer <diet...@proxmox.com>
---
 PVE/API2/Formatter/Bootstrap.pm |  238 ------
 PVE/API2/Formatter/HTML.pm      |  288 -------
 PVE/API2/Formatter/Makefile     |   17 -
 PVE/API2/Formatter/Standard.pm  |  142 ----
 PVE/API2/Makefile               |    1 -
 PVE/HTTPServer.pm               | 1731 +--------------------------------------
 PVE/Service/pvedaemon.pm        |    4 +-
 PVE/Service/pveproxy.pm         |    8 +-
 debian/control.in               |    2 +-
 9 files changed, 30 insertions(+), 2401 deletions(-)
 delete mode 100644 PVE/API2/Formatter/Bootstrap.pm
 delete mode 100644 PVE/API2/Formatter/HTML.pm
 delete mode 100644 PVE/API2/Formatter/Makefile
 delete mode 100644 PVE/API2/Formatter/Standard.pm

diff --git a/PVE/API2/Formatter/Bootstrap.pm b/PVE/API2/Formatter/Bootstrap.pm
deleted file mode 100644
index 2d656b8..0000000
--- a/PVE/API2/Formatter/Bootstrap.pm
+++ /dev/null
@@ -1,238 +0,0 @@
-package PVE::API2::Formatter::Bootstrap;
-
-use strict;
-use warnings;
-use URI::Escape;
-use HTML::Entities;
-use JSON;
-
-use PVE::AccessControl; # to generate CSRF token
-
-# Helpers to generate simple html pages using Bootstrap markup.
-
-my $jssrc = <<_EOJS;
-PVE = {
-    delete_auth_cookie: function() {
-       document.cookie = "PVEAuthCookie=; expires=Thu, 01 Jan 1970 00:00:01 
GMT; path=/; secure;";
-    },
-    open_vm_console: function(node, vmid) {
-       console.log("open vm " + vmid + " on node " + node);
-
-       var downloadWithName = function(uri, name) {
-           var link =  jQuery('#pve_console_anchor');
-           link.attr("href", uri);
-
-           // Note: we need to tell android the correct file name extension
-           // but we do not set 'download' tag for other environments, because
-           // It can have strange side effects (additional user prompt on 
firefox)
-           var andriod = navigator.userAgent.match(/Android/i) ? true : false;
-           if (andriod) {
-               link.attr("download", name);
-           }
-
-           if (document.createEvent) {
-               var evt = document.createEvent("MouseEvents");
-                evt.initMouseEvent('click', true, true, window, 1, 0, 0, 0, 0, 
false, false, false, false, 0, null);
-               link.get(0).dispatchEvent(evt);
-           } else {
-               link.get(0).fireEvent('onclick');
-           }
-       };
-
-       jQuery.ajax("/api2/json/console", {
-           data: { vmid: vmid, node: node },
-           headers: { CSRFPreventionToken: PVE.CSRFPreventionToken },
-           dataType: 'json',
-           type: 'POST',
-           error: function(jqXHR, textStatus, errorThrown) {
-               // fixme: howto view JS errors ?
-               console.log("ERROR " +  textStatus + ": " + errorThrown);
-           },
-           success:   function(data) {
-               var raw = "[virt-viewer]\\n";
-               jQuery.each(data.data, function(k, v) {
-                   raw += k + "=" + v + "\\n";
-               });
-               var url = 'data:application/x-virt-viewer;charset=UTF-8,' +
-                   encodeURIComponent(raw);
-
-               downloadWithName(url, "pve-spice.vv");
-           }
-       });
-    }
-};
-_EOJS
-
-sub new {
-    my ($class, $res, $url) = @_;
-
-    my $self = bless {
-       url => $url,
-       js => '',
-    };
-
-    if (my $username = $res->{auth}->{userid}) {
-       $self->{csrftoken} = 
PVE::AccessControl::assemble_csrf_prevention_token($username);
-    }
-
-    return $self;
-}
-  
-sub body {
-    my ($self, $html) = @_;
-
-    my $jssetup = '';
-
-    if ($self->{csrftoken}) {
-       $jssetup .= "PVE.CSRFPreventionToken = '$self->{csrftoken}';\n";
-    }
-
-    return <<_EOD;
-<!DOCTYPE html>
-<html lang="en">
-  <head>
-    <meta charset="utf-8">
-    <meta http-equiv="X-UA-Compatible" content="IE=edge">
-    <meta name="viewport" content="width=device-width, initial-scale=1">
-    <title>Proxmox VE API</title>
-
-    <!-- Bootstrap -->
-    <link href="/pve2/css/bootstrap.min.css" rel="stylesheet">
-
-    <script type="text/javascript">
-    $jssrc
-    $jssetup
-    </script>
-
-    <style>
-body {
-       padding-top: 70px;
-}
-    </style>
-
-    <!-- HTML5 Shim and Respond.js IE8 support of HTML5 elements and media 
queries -->
-    <!-- WARNING: Respond.js doesn't work if you view the page via file:// -->
-    <!--[if lt IE 9]>
-      <script 
src="https://oss.maxcdn.com/libs/html5shiv/3.7.0/html5shiv.js";></script>
-      <script 
src="https://oss.maxcdn.com/libs/respond.js/1.4.2/respond.min.js";></script>
-    <![endif]-->
-
-    <!-- jQuery (necessary for Bootstrap's JavaScript plugins) -->
-    <script 
src="https://ajax.googleapis.com/ajax/libs/jquery/1.11.0/jquery.min.js";></script>
-    <!-- Include all compiled plugins (below), or include individual files as 
needed -->
-    <script src="/pve2/js/bootstrap.min.js"></script>
-
-  </head>
-  <body>
-    <a class="hidden" id="pve_console_anchor"></a>
-    $html
-    <script type="text/javascript">
-      $self->{js}
-    </script>
-  </body>
-</html>
-_EOD
-}
-
-my $comp_id_counter = 0;
-
-sub el {
-    my ($self, %param) = @_;
-    
-    $param{tag} = 'div' if !$param{tag};
-
-    my $id;
-
-    my $html = "<$param{tag}";
-
-    if (wantarray) {
-       $comp_id_counter++;
-       $id = "pveid$comp_id_counter";
-       $html .= " id=$id";
-    }
-
-    my $skip = {
-       tag => 1,
-       cn => 1,
-       html => 1,
-       text => 1,
-    };
-
-    my $boolattr = {
-       required => 1,
-       autofocus => 1,
-    };
-
-    my $noescape = {
-       placeholder => 1,
-    };
-
-    foreach my $attr (keys %param)  {
-       next if $skip->{$attr};
-       my $v = $noescape->{$attr} ? $param{$attr} : 
uri_escape_utf8($param{$attr},"[^\/\ A-Za-z0-9\-\._~]");
-       next if !defined($v);
-       if ($boolattr->{$attr}) {
-           $html .= " $attr" if $v;
-       } else {
-           $html .= " $attr=\"$v\"";
-       }
-    }
-
-    $html .= ">";
-
-
-    if (my $cn = $param{cn}) {  
-       if(ref($cn) eq 'ARRAY'){ 
-           foreach my $rec (@$cn) {
-               $html .= $self->el(%$rec);
-           }
-       } else {
-           $html .= $self->el(%$cn);
-       }
-    } elsif ($param{html}) {
-       $html .= $param{html};
-    } elsif ($param{text}) {
-       $html .= encode_entities($param{text});
-    }
-
-    $html .= "</$param{tag}>";
-
-    return wantarray ? ($html, $id) : $html;
-}
-
-sub alert {
-    my ($self, %param) = @_;
-
-    return $self->el(class => "alert alert-danger", %param);
-}
-
-sub add_js {
-    my ($self, $js) = @_;
-
-    $self->{js} .= $js . "\n";
-}
-
-my $format_event_callback = sub {
-    my ($info) = @_;
-       
-    my $pstr = encode_json($info->{param});
-    return "function(e){$info->{fn}.apply(e, $pstr);}";
-};
-
-sub button {
-    my ($self, %param) = @_;
-
-    $param{tag} = 'button';
-    $param{class} = "btn btn-default btn-xs";
-
-    if (my $click = delete $param{click}) {
-       my ($html, $id) = $self->el(%param);
-       my $cb = &$format_event_callback($click);
-       $self->add_js("jQuery('#$id').on('click', $cb);");          
-       return $html;
-    } else {
-       return $self->el(%param);
-    }
-}
-
-1;
diff --git a/PVE/API2/Formatter/HTML.pm b/PVE/API2/Formatter/HTML.pm
deleted file mode 100644
index 69c0d97..0000000
--- a/PVE/API2/Formatter/HTML.pm
+++ /dev/null
@@ -1,288 +0,0 @@
-package PVE::API2::Formatter::HTML;
-
-use strict;
-use warnings;
-
-use PVE::HTTPServer;
-use HTTP::Status;
-use JSON;
-use HTML::Entities;
-use PVE::JSONSchema;
-use PVE::API2::Formatter::Bootstrap;
-use PVE::API2::Formatter::Standard;
-
-my $portal_format = 'html';
-my $portal_ct = 'text/html;charset=UTF-8';
-
-my $baseurl = "/api2/$portal_format";
-my $login_url = "$baseurl/access/ticket";
-
-sub render_page {
-    my ($doc, $html) = @_;
-
-    my $items = [];
-
-    push @$items, {
-       tag => 'li',
-       cn => {
-           tag => 'a',
-           href => $login_url,
-           onClick => "PVE.delete_auth_cookie();",
-           text => "Logout",
-       }};
-
-
-    my $title = "Proxmox VE";
-
-    my $nav = $doc->el(
-       class => "navbar navbar-inverse navbar-fixed-top",
-       role => "navigation", cn => {
-           class => "container", cn => [
-               {
-                   class => "navbar-header", cn => [
-                       {
-                           tag => 'button',
-                           type => 'button',
-                           class => "navbar-toggle",
-                           'data-toggle' => "collapse",
-                           'data-target' => ".navbar-collapse",
-                           cn => [
-                               { tag => 'span', class => 'sr-only', text => 
"Toggle navigation" },
-                               { tag => 'span', class => 'icon-bar' },
-                               { tag => 'span', class => 'icon-bar' },
-                               { tag => 'span', class => 'icon-bar' },
-                           ],
-                       },
-                       {
-                           tag => 'a',
-                           class => "navbar-brand",
-                           href => $baseurl,
-                           text => $title,
-                       },
-                   ],
-               },
-               {
-                   class => "collapse navbar-collapse",
-                   cn => {
-                       tag => 'ul',
-                       class => "nav navbar-nav",
-                       cn => $items,
-                   },
-               },
-           ],
-       });
-
-    $items = [];
-    my @pcomp = split('/', $doc->{url});
-    shift @pcomp; # empty
-    shift @pcomp; # api2
-    shift @pcomp; # $format
-
-    my $href = $baseurl;
-    push @$items, { tag => 'li', cn => {
-       tag => 'a',
-       href => $href,
-       text => 'Home'}};
- 
-    foreach my $comp (@pcomp) {
-       $href .= "/$comp";
-       push @$items, { tag => 'li', cn => {
-           tag => 'a',
-           href => $href,
-           text => $comp}};
-    }
-
-    my $breadcrumbs = $doc->el(tag => 'ol', class => 'breadcrumb container', 
cn => $items);
-
-    return $doc->body($nav . $breadcrumbs . $html);
-}
-
-my $login_form = sub {
-    my ($doc, $param, $errmsg) = @_;
-
-    $param = {} if !$param;
-
-    my $username = $param->{username} || '';
-    my $password = $param->{password} || '';
-
-    my $items = [
-       {
-           tag => 'label', 
-           text => "Please sign in",
-       }, 
-       { 
-           tag => 'input', 
-           type => 'text', 
-           class => 'form-control',
-           name => 'username', 
-           value => $username, 
-           placeholder => "Enter user name", 
-           required => 1, 
-           autofocus => 1,
-       },
-       {
-           tag => 'input',
-           type => 'password',
-           class => 'form-control',
-           name => 'password',
-           value => $password,
-           placeholder => 'Password',
-           required => 1,
-       },
-    ];
-
-    my $html = '';
-
-    $html .= $doc->alert(text => $errmsg) if ($errmsg);
-
-    $html .= $doc->el(
-       class => 'container',
-       cn => {
-           tag => 'form', 
-           role => 'form', 
-           method => 'POST', 
-           action => $login_url,
-           cn => [
-               {
-                   class => 'form-group',
-                   cn => $items,
-               },
-               {
-                   tag => 'button',
-                   type => 'submit',
-                   class => 'btn btn-lg btn-primary btn-block',
-                   text => "Sign in",
-               },
-           ],
-       });
-
-    return $html;
-};
-
-PVE::HTTPServer::register_login_formatter($portal_format, sub {
-    my ($path, $auth) = @_;
-
-    my $headers = HTTP::Headers->new(Location => $login_url);
-    return HTTP::Response->new(301, "Moved", $headers);
-});
-
-PVE::HTTPServer::register_formatter($portal_format, sub {
-    my ($res, $data, $param, $path, $auth) = @_;
-
-    # fixme: clumsy!
-    PVE::API2::Formatter::Standard::prepare_response_data($portal_format, 
$res);
-    $data = $res->{data};
-
-    my $html = '';
-    my $doc = PVE::API2::Formatter::Bootstrap->new($res, $path);
-
-    if (!HTTP::Status::is_success($res->{status})) {
-       $html .= $doc->alert(text => "Error $res->{status}: $res->{message}");
-    }
-
-    my $info = $res->{info};
-
-    $html .= $doc->el(tag => 'h3', text => 'Description');
-    $html .= $doc->el(tag => 'p', text => $info->{description});
-
-    my $lnk = PVE::JSONSchema::method_get_child_link($info);
-
-    if ($lnk && $data && $data->{data} && 
HTTP::Status::is_success($res->{status})) {
-
-       my $href = $lnk->{href};
-       if ($href =~ m/^\{(\S+)\}$/) {
-
-           my $items = [];
-
-           my $prop = $1;
-           $path =~ s/\/+$//; # remove trailing slash
-
-           foreach my $elem (sort {$a->{$prop} cmp $b->{$prop}} 
@{$data->{data}}) {
-               next if !ref($elem);
-               
-               if (defined(my $value = $elem->{$prop})) {
-                   my $tv = to_json($elem, {pretty => 1, allow_nonref => 1, 
canonical => 1});
-
-                   push @$items, {
-                       tag => 'a', 
-                       class => 'list-group-item',
-                       href => "$path/$value",
-                       cn => [
-                           {
-                               tag => 'h4',
-                               class => 'list-group-item-heading',
-                               text => $value,
-                           },
-                           {
-                               tag => 'pre',
-                               class => 'list-group-item',
-                               text => $tv,
-                           },
-                       ],
-                   };
-               }
-           }
-
-           $html .= $doc->el(class => 'list-group', cn => $items);
-
-       } else {
-
-           my $json = to_json($data, {allow_nonref => 1, pretty => 1});
-           $html .= $doc->el(tag => 'pre', text => $json);
-       }
-
-    } else {
-
-       my $json = to_json($data, {allow_nonref => 1, pretty => 1});
-       $html .= $doc->el(tag => 'pre', text => $json);
-    }
-
-    $html = $doc->el(class => 'container', html => $html);
-
-    my $raw = render_page($doc, $html);
-    return ($raw, $portal_ct);
-});
-
-PVE::API2->register_page_formatter(
-    'format' => $portal_format,
-    method => 'GET',
-    path => "/access/ticket",
-    code => sub {
-       my ($res, $data, $param, $path, $auth) = @_;
-
-       my $doc = PVE::API2::Formatter::Bootstrap->new($res, $path);
-
-       my $html = &$login_form($doc);
-
-       my $raw = render_page($doc, $html);
-       return ($raw, $portal_ct);
-    });
-
-PVE::API2->register_page_formatter(
-    'format' => $portal_format,
-    method => 'POST',
-    path => "/access/ticket",
-    code => sub {
-       my ($res, $data, $param, $path, $auth) = @_;
-
-       if (HTTP::Status::is_success($res->{status})) {
-           my $cookie = PVE::HTTPServer::create_auth_cookie(
-               $data->{ticket}, $auth->{cookie_name});
-
-           my $headers = HTTP::Headers->new(Location => $baseurl,
-                                            'Set-Cookie' => $cookie);
-           return HTTP::Response->new(301, "Moved", $headers);
-       }
-
-       # Note: HTTP server redirects to 'GET /access/ticket', so below
-       # output is not really visible.
-
-       my $doc = PVE::API2::Formatter::Bootstrap->new($res, $path);
-
-       my $html = &$login_form($doc);
-
-       my $raw = render_page($doc, $html);
-       return ($raw, $portal_ct);
-    });
-
-1;
diff --git a/PVE/API2/Formatter/Makefile b/PVE/API2/Formatter/Makefile
deleted file mode 100644
index 08a0666..0000000
--- a/PVE/API2/Formatter/Makefile
+++ /dev/null
@@ -1,17 +0,0 @@
-include ../../../defines.mk
-
-PERLSOURCE =                   \
-       Bootstrap.pm            \
-       HTML.pm                 \
-       Standard.pm
-
-all:
-
-.PHONY: clean
-clean:
-       rm -rf *~
-
-.PHONY: install 
-install: ${PERLSOURCE}
-       install -d ${PERLLIBDIR}/PVE/API2/Formatter
-       install -m 0644 ${PERLSOURCE} ${PERLLIBDIR}/PVE/API2/Formatter
diff --git a/PVE/API2/Formatter/Standard.pm b/PVE/API2/Formatter/Standard.pm
deleted file mode 100644
index f1cec1a..0000000
--- a/PVE/API2/Formatter/Standard.pm
+++ /dev/null
@@ -1,142 +0,0 @@
-package PVE::API2::Formatter::Standard;
-
-use strict;
-use warnings;
-
-use PVE::HTTPServer;
-use HTTP::Status;
-use JSON;
-use HTML::Entities;
-use PVE::JSONSchema;
-
-# register result formatters
-
-sub prepare_response_data {
-    my ($format, $res) = @_;
-
-    my $success = 1;
-    my $new = {
-       data => $res->{data},
-    };
-    if (scalar(keys %{$res->{errors}})) {
-       $success = 0;
-       $new->{errors} = $res->{errors};
-    }
-
-    if ($format eq 'extjs' || $format eq 'htmljs') {
-       # HACK: extjs wants 'success' property instead of useful HTTP status 
codes
-       if (HTTP::Status::is_error($res->{status})) {
-           $success = 0;
-           $new->{message} = $res->{message} || status_message($res->{status});
-           $new->{status} = $res->{status} || 200;
-           $res->{message} = undef;
-           $res->{status} = 200;
-       }
-       $new->{success} = $success;
-    }
-
-    if ($success && $res->{total}) {
-       $new->{total} = $res->{total};
-    }
-
-    if ($success && $res->{changes}) {
-       $new->{changes} = $res->{changes};
-    }
-
-    $res->{data} = $new;
-}
-
-PVE::HTTPServer::register_formatter('json', sub {
-    my ($res, $data, $param, $path, $auth) = @_;
-
-    my $nocomp = 0;
-
-    my $ct = 'application/json;charset=UTF-8';
-
-    prepare_response_data('json', $res);
-
-    my $raw = to_json($res->{data}, {utf8 => 1, allow_nonref => 1});
-   
-    return ($raw, $ct, $nocomp);                            
-});
-
-
-PVE::HTTPServer::register_formatter('extjs', sub {
-    my ($res, $data, $param, $path, $auth) = @_;
-
-    my $nocomp = 0;
-
-    my $ct = 'application/json;charset=UTF-8';
-
-    prepare_response_data('extjs', $res);
-
-    my $raw = to_json($res->{data}, {utf8 => 1, allow_nonref => 1});
-   
-    return ($raw, $ct, $nocomp);                            
-});
-
-PVE::HTTPServer::register_formatter('htmljs', sub {
-    my ($res, $data, $param, $path, $auth) = @_;
- 
-    my $nocomp = 0;
-
-    # we use this for extjs file upload forms
-    
-    my $ct = 'text/html;charset=UTF-8';
-
-    prepare_response_data('htmljs', $res);
-
-    my $raw = encode_entities(to_json($res->{data}, {allow_nonref => 1}));
-   
-    return ($raw, $ct, $nocomp);
-});
-
-
-PVE::HTTPServer::register_formatter('spiceconfig', sub {
-    my ($res, $data, $param, $path, $auth) = @_;
-
-    my $nocomp = 0;
-
-    my $ct = 'application/x-virt-viewer;charset=UTF-8';
-
-    prepare_response_data('spiceconfig', $res);
-
-    $data = $res->{data};
-
-    my $raw;
-
-    if ($data && ref($data) && ref($data->{data})) {
-       $raw = "[virt-viewer]\n";
-       while (my ($key, $value) = each %{$data->{data}}) {
-           $raw .= "$key=$value\n" if defined($value);
-       }
-    }
-   
-    return ($raw, $ct, $nocomp);
-});
-
-PVE::HTTPServer::register_formatter('png', sub {
-    my ($res, $data, $param, $path, $auth) = @_;
-
-    my $nocomp = 1;
-
-    my $ct =  'image/png';
-
-    prepare_response_data('png', $res);
-
-    $data = $res->{data};
-
-    # fixme: better to revove that whole png thing ?
-
-    my $filename;
-    my $raw = '';
-
-    if ($data && ref($data) && ref($data->{data}) && 
-       $data->{data}->{filename} && defined($data->{data}->{image})) {
-       $filename = $data->{data}->{filename};
-       $raw = $data->{data}->{image};
-    }
-   
-    return ($raw, $ct, $nocomp);
-});
-
diff --git a/PVE/API2/Makefile b/PVE/API2/Makefile
index 9777d28..4dfcbb5 100644
--- a/PVE/API2/Makefile
+++ b/PVE/API2/Makefile
@@ -24,4 +24,3 @@ clean:
 install: ${PERLSOURCE}
        install -d ${PERLLIBDIR}/PVE/API2
        install -m 0644 ${PERLSOURCE} ${PERLLIBDIR}/PVE/API2
-       make -C Formatter install
diff --git a/PVE/HTTPServer.pm b/PVE/HTTPServer.pm
index ff3d99f..ef533fc 100755
--- a/PVE/HTTPServer.pm
+++ b/PVE/HTTPServer.pm
@@ -2,1728 +2,47 @@ package PVE::HTTPServer;
 
 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 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::Handle;
-use Net::SSLeay;
-use AnyEvent::TLS;
-use AnyEvent::IO;
-use AnyEvent::HTTP;
-use Fcntl ();
-use Compress::Zlib;
-use PVE::SafeSyslog;
-use PVE::INotify;
-use PVE::Tools;
-use PVE::RPCEnvironment;
-use PVE::Cluster;
-
-use Net::IP;
-use URI;
-use URI::Escape;
-use HTTP::Status qw(:constants);
-use HTTP::Date;
-use HTTP::Headers;
-use HTTP::Request;
-use HTTP::Response;
-use Data::Dumper;
-
-my $limit_max_headers = 30;
-my $limit_max_header_size = 8*1024;
-my $limit_max_post = 16*1024;
-
-
-my $known_methods = {
-    GET => 1,
-    POST => 1,
-    PUT => 1,
-    DELETE => 1,
-};
-
-my $split_abs_uri = sub {
-    my ($abs_uri, $base_uri) = @_;
-
-    my ($format, $rel_uri) = $abs_uri =~ 
m/^\Q$base_uri\E\/+([a-z][a-z0-9]+)(\/.*)?$/;
-    $rel_uri = '/' if !$rel_uri;
-
-    return wantarray ? ($rel_uri, $format) : $rel_uri;
-};
-
-# generic formatter support
-
-my $formatter_hash = {};
-
-sub register_formatter {
-    my ($format, $func) = @_;
-
-    die "formatter '$format' already defined" if $formatter_hash->{$format};
-
-    $formatter_hash->{$format} = {
-       func => $func,
-    };
-}
-
-sub get_formatter {
-    my ($format) = @_; 
-
-     return undef if !$format;
-
-    my $info = $formatter_hash->{$format};
-    return undef if !$info;
-
-    return $info->{func};
-}
-
-my $login_formatter_hash = {};
-
-sub register_login_formatter {
-    my ($format, $func) = @_;
-
-    die "login formatter '$format' already defined" if 
$login_formatter_hash->{$format};
-
-    $login_formatter_hash->{$format} = {
-       func => $func,
-    };
-}
-
-sub get_login_formatter {
-    my ($format) = @_; 
-
-    return undef if !$format;
-
-    my $info = $login_formatter_hash->{$format};
-    return undef if !$info;
-
-    return $info->{func};
-}
-
-
-# server implementation
-
-sub log_request {
-    my ($self, $reqstate) = @_;
-
-    my $loginfo = $reqstate->{log};
-
-    # like apache2 common log format
-    # LogFormat "%h %l %u %t \"%r\" %>s %b \"%{Referer}i\" \"%{User-agent}i\""
-
-    return if $loginfo->{written}; # avoid duplicate logs
-    $loginfo->{written} = 1;
-
-    my $peerip = $reqstate->{peer_host} || '-';
-    my $userid = $loginfo->{userid} || '-';
-    my $content_length = defined($loginfo->{content_length}) ? 
$loginfo->{content_length} : '-';
-    my $code =  $loginfo->{code} || 500;
-    my $requestline = $loginfo->{requestline} || '-';
-    my $timestr = strftime("%d/%b/%Y:%H:%M:%S %z", localtime());
-
-    my $msg = "$peerip - $userid [$timestr] \"$requestline\" $code 
$content_length\n";
-
-    $self->write_log($msg);
-}
-
-sub log_aborted_request {
-    my ($self, $reqstate, $error) = @_;
-
-    my $r = $reqstate->{request};
-    return if !$r; # no active request
-
-    if ($error) {
-       syslog("err", "problem with client $reqstate->{peer_host}; $error");
-    }
-
-    $self->log_request($reqstate);
-}
-
-sub extract_auth_cookie {
-    my ($cookie, $cookie_name) = @_;
-
-    return undef if !$cookie;
-
-    my $ticket = ($cookie =~ /(?:^|\s)\Q$cookie_name\E=([^;]*)/)[0];
-
-    if ($ticket && $ticket =~ m/^PVE%3A/) {
-       $ticket = uri_unescape($ticket);
-    }
-
-    return $ticket;
-}
-
-sub create_auth_cookie {
-    my ($ticket, $cookie_name) = @_;
-
-    my $encticket = uri_escape($ticket);
-
-    return "${cookie_name}=$encticket; path=/; secure;";
-}
-
-sub cleanup_reqstate {
-    my ($reqstate) = @_;
-
-    delete $reqstate->{log};
-    delete $reqstate->{request};
-    delete $reqstate->{proto};
-    delete $reqstate->{accept_gzip};
-    delete $reqstate->{starttime};
-
-    if ($reqstate->{tmpfilename}) {
-       unlink $reqstate->{tmpfilename};
-       delete $reqstate->{tmpfilename};
-    }
-}
-
-sub client_do_disconnect {
-    my ($self, $reqstate) = @_;
-
-    cleanup_reqstate($reqstate);
-
-    my $shutdown_hdl = sub {
-       my $hdl = shift;
-
-       shutdown($hdl->{fh}, 1);
-       # clear all handlers
-       $hdl->on_drain(undef);
-       $hdl->on_read(undef);
-       $hdl->on_eof(undef);
-    };
-
-    if (my $proxyhdl = delete $reqstate->{proxyhdl}) {
-       &$shutdown_hdl($proxyhdl);
-    }
-
-    my $hdl = delete $reqstate->{hdl};
-
-    if (!$hdl) {
-       syslog('err', "detected empty handle");
-       return;
-    }
-
-    print "close connection $hdl\n" if $self->{debug};
-
-    &$shutdown_hdl($hdl);
-
-    $self->{conn_count}--;
-
-    print "$$: CLOSE FH" .  $hdl->{fh}->fileno() . " 
CONN$self->{conn_count}\n" if $self->{debug};
-}
-
-sub finish_response {
-    my ($self, $reqstate) = @_;
-
-    my $hdl = $reqstate->{hdl};
-
-    cleanup_reqstate($reqstate);
-
-    if (!$self->{end_loop} && $reqstate->{keep_alive} > 0) {
-       # print "KEEPALIVE $reqstate->{keep_alive}\n" if $self->{debug};
-       $hdl->on_read(sub {
-           eval { $self->push_request_header($reqstate); };
-           warn $@ if $@;
-       });
-    } else {
-       $hdl->on_drain (sub {
-           eval {
-               $self->client_do_disconnect($reqstate);
-           };
-           warn $@ if $@;
-       });
-    }
-}
-
-sub response {
-    my ($self, $reqstate, $resp, $mtime, $nocomp, $delay) = @_;
-
-    #print "$$: send response: " . Dumper($resp);
-
-    # activate timeout
-    $reqstate->{hdl}->timeout_reset();
-    $reqstate->{hdl}->timeout($self->{timeout});
-
-    $nocomp = 1 if !$reqstate->{accept_gzip};
-
-    my $code = $resp->code;
-    my $msg = $resp->message || HTTP::Status::status_message($code);
-    ($msg) = $msg =~m/^(.*)$/m;
-    my $content = $resp->content;
-
-    if ($code =~ /^(1\d\d|[23]04)$/) {
-       # make sure content we have no content
-       $content = "";
-    }
-
-    $reqstate->{keep_alive} = 0 if ($code >= 400) || $self->{end_loop};
-
-    $reqstate->{log}->{code} = $code;
-
-    my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.0';
-    my $res = "$proto $code $msg\015\012";
-
-    my $ctime = time();
-    my $date = HTTP::Date::time2str($ctime);
-    $resp->header('Date' => $date);
-    if ($mtime) {
-       $resp->header('Last-Modified' => HTTP::Date::time2str($mtime));
-    } else {
-       $resp->header('Expires' => $date);
-       $resp->header('Cache-Control' => "max-age=0");
-       $resp->header("Pragma", "no-cache");
-    }
-
-    $resp->header('Server' => "pve-api-daemon/3.0");
-
-    my $content_length;
-    if ($content) {
-
-       $content_length = length($content);
-
-       if (!$nocomp && ($content_length > 1024)) {
-           my $comp = Compress::Zlib::memGzip($content);
-           $resp->header('Content-Encoding', 'gzip');
-           $content = $comp;
-           $content_length = length($content);
-       }
-       $resp->header("Content-Length" => $content_length);
-       $reqstate->{log}->{content_length} = $content_length;
-
-    } else {
-       $resp->remove_header("Content-Length");
-    }
-
-    if ($reqstate->{keep_alive} > 0) {
-       $resp->push_header('Connection' => 'Keep-Alive');
-    } else {
-       $resp->header('Connection' => 'close');
-    }
-
-    $res .= $resp->headers_as_string("\015\012");
-    #print "SEND(without content) $res\n" if $self->{debug};
-
-    $res .= "\015\012";
-    $res .= $content if $content;
-
-    $self->log_request($reqstate, $reqstate->{request});
-    
-    if ($delay && $delay > 0) {
-       my $w; $w = AnyEvent->timer(after => $delay, cb => sub {
-           undef $w; # delete reference
-           $reqstate->{hdl}->push_write($res);
-           $self->finish_response($reqstate);
-       });
-    } else {
-       $reqstate->{hdl}->push_write($res);
-       $self->finish_response($reqstate);
-    }
-}
-
-sub error {
-    my ($self, $reqstate, $code, $msg, $hdr, $content) = @_;
-
-    eval {
-       my $resp = HTTP::Response->new($code, $msg, $hdr, $content);
-       $self->response($reqstate, $resp);
-    };
-    warn $@ if $@;
-}
-
-my $file_extension_info = {
-    css   => { ct => 'text/css' },
-    html  => { ct => 'text/html' },
-    js    => { ct => 'application/javascript' },
-    png   => { ct => 'image/png' , nocomp => 1 },
-    ico   => { ct => 'image/x-icon', nocomp => 1},
-    gif   => { ct => 'image/gif', nocomp => 1},
-    jar   => { ct => 'application/java-archive', nocomp => 1},
-    woff  => { ct => 'application/font-woff', nocomp => 1},
-    woff2 => { ct => 'application/font-woff2', nocomp => 1},
-    ttf   => { ct => 'application/font-snft', nocomp => 1},
-    pdf   => { ct => 'application/pdf', nocomp => 1},
-    epub  => { ct => 'application/epub+zip', nocomp => 1},
-};
-
-sub send_file_start {
-    my ($self, $reqstate, $filename) = @_;
-
-    eval {
-       # print "SEND FILE $filename\n";
-       # Note: aio_load() this is not really async unless we use IO::AIO!
-       eval {
-
-           my $r = $reqstate->{request};
-
-           my $fh = IO::File->new($filename, '<') ||
-               die "$!\n";
-           my $stat = File::stat::stat($fh) ||
-               die "$!\n";
-           
-           my $mtime = $stat->mtime;
-
-           if (my $ifmod = $r->header('if-modified-since')) {
-               my $iftime = HTTP::Date::str2time($ifmod);
-               if ($mtime <= $iftime) {
-                   my $resp = HTTP::Response->new(304, "NOT MODIFIED");
-                   $self->response($reqstate, $resp, $mtime);
-                   return;
-               }
-           }
-
-           my $data;
-           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 $resp = HTTP::Response->new(200, "OK", $header, $data);
-           $self->response($reqstate, $resp, $mtime, $ext_info->{nocomp});
-       };
-       if (my $err = $@) {
-           $self->error($reqstate, 501, $err);
-       }
-    };
-
-    warn $@ if $@;
-}
-
-sub websocket_proxy {
-    my ($self, $reqstate, $wsaccept, $wsproto, $param) = @_;
-
-    eval {
-       my $remhost;
-       my $remport;
-
-       my $max_payload_size = 65536;
-
-       my $binary;
-       if ($wsproto eq 'binary') {
-           $binary = 1;
-       } elsif ($wsproto eq 'base64') {
-           $binary = 0;
-       } else {
-           die "websocket_proxy: unsupported protocol '$wsproto'\n";
-       }
-
-       if ($param->{port}) {
-           $remhost = 'localhost';
-           $remport = $param->{port};
-       } elsif ($param->{socket}) {
-           $remhost = 'unix/';
-           $remport = $param->{socket};
-       } else {
-           die "websocket_proxy: missing port or socket\n";
-       }
-
-       tcp_connect $remhost, $remport, sub {
-           my ($fh) = @_ 
-               or die "connect to '$remhost:$remport' failed: $!";
-       
-           print "$$: CONNECTed to '$remhost:$remport'\n" if $self->{debug};
-
-           $reqstate->{proxyhdl} = AnyEvent::Handle->new(
-               fh => $fh,
-               rbuf_max => 64*1024,
-               wbuf_max => 64*10*1024,
-               timeout => 5,
-               on_eof => sub {
-                   my ($hdl) = @_;
-                   eval {
-                       $self->log_aborted_request($reqstate);
-                       $self->client_do_disconnect($reqstate);
-                   };
-                   if (my $err = $@) { syslog('err', $err); }
-               },
-               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"); }
-               });
-
-           my $proxyhdlreader = sub {
-               my ($hdl) = @_;
-               
-               my $len = length($hdl->{rbuf});
-               my $data = substr($hdl->{rbuf}, 0, $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;
-
-               $reqstate->{hdl}->push_write($string) if $reqstate->{hdl};
-           };
-
-           my $hdlreader = sub {
-               my ($hdl) = @_;
-
-               my $len = length($hdl->{rbuf});
-               return if $len < 2;
-
-               my $hdr = unpack('C', substr($hdl->{rbuf}, 0, 1));
-               my $opcode = $hdr & 0b00001111;
-               my $fin = $hdr & 0b10000000;
-
-               die "received fragmented websocket frame\n" if !$fin;
-
-               my $rsv = $hdr & 0b01110000;
-               die "received websocket frame with RSV flags\n" if $rsv;
-
-               my $payload_len = unpack 'C', substr($hdl->{rbuf}, 1, 1);
-
-               my $masked = $payload_len & 0b10000000;
-               die "received unmasked websocket frame from client\n" if 
!$masked;
-
-               my $offset = 2;
-               $payload_len = $payload_len & 0b01111111;
-               if ($payload_len == 126) {
-                   return if $len < 4;
-                   $payload_len = unpack('n', substr($hdl->{rbuf}, $offset, 
2));
-                   $offset += 2;
-               } elsif ($payload_len == 127) {
-                   return if $len < 10;
-                   $payload_len = unpack('Q>', substr($hdl->{rbuf}, $offset, 
8));
-                   $offset += 8;
-               }
-
-               die "received too large websocket frame (len = $payload_len)\n" 
-                   if ($payload_len > $max_payload_size) || ($payload_len < 0);
-
-               return if $len < ($offset + 4 + $payload_len);
-
-               my $data = substr($hdl->{rbuf}, 0, $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)));
-
-               $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));
-               }
-
-               $payload = decode_base64($payload) if !$binary;
-
-               if ($opcode == 1 || $opcode == 2) {
-                   $reqstate->{proxyhdl}->push_write($payload) if 
$reqstate->{proxyhdl};
-               } elsif ($opcode == 8) {
-                   print "websocket received close\n" if $self->{debug};
-                   if ($reqstate->{proxyhdl}) {
-                       $reqstate->{proxyhdl}->push_write($payload);
-                       $reqstate->{proxyhdl}->push_shutdown();
-                   }
-                   $hdl->push_shutdown();
-               } else {
-                   die "received unhandled websocket opcode $opcode\n";
-               }
-           };
-
-           my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 
'HTTP/1.1';
-
-           $reqstate->{proxyhdl}->timeout(0);
-           $reqstate->{proxyhdl}->on_read($proxyhdlreader);
-           $reqstate->{hdl}->on_read($hdlreader);
-
-           # todo: use stop_read/start_read if write buffer grows to much
-
-           my $res = "$proto 101 Switching Protocols\015\012" .
-               "Upgrade: websocket\015\012" .
-               "Connection: upgrade\015\012" .
-               "Sec-WebSocket-Accept: $wsaccept\015\012" .
-               "Sec-WebSocket-Protocol: $wsproto\015\012" .
-               "\015\012";
-
-           print $res if $self->{debug};
-
-           $reqstate->{hdl}->push_write($res);
-
-           # log early
-           $reqstate->{log}->{code} = 101;
-           $self->log_request($reqstate);
-       };
-
-    };
-    if (my $err = $@) {
-       warn $err;
-       $self->log_aborted_request($reqstate, $err);
-       $self->client_do_disconnect($reqstate);
-    }
-}
-
-sub proxy_request {
-    my ($self, $reqstate, $clientip, $host, $node, $method, $uri, $ticket, 
$token, $params) = @_;
-
-    eval {
-       my $target;
-       my $keep_alive = 1;
-       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;
-       } elsif (Net::IP::ip_is_ipv6($host)) {
-           $target = "https://[$host]:8006$uri";;
-       } else {
-           $target = "https://$host:8006$uri";;
-       }
-
-       my $headers = {
-           PVEDisableProxy => 'true',
-           PVEClientIP => $clientip,
-       };
-
-       $headers->{'cookie'} = create_auth_cookie($ticket, 
$self->{cookie_name}) if $ticket;
-       $headers->{'CSRFPreventionToken'} = $token if $token;
-       $headers->{'Accept-Encoding'} = 'gzip' if $reqstate->{accept_gzip};
-
-       my $content;
-
-       if  ($method eq 'POST' || $method eq 'PUT') {
-           $headers->{'Content-Type'} = 'application/x-www-form-urlencoded';
-           # use URI object to format application/x-www-form-urlencoded 
content.
-           my $url = URI->new('http:');
-           $url->query_form(%$params);
-           $content = $url->query;
-           if (defined($content)) {
-               $headers->{'Content-Length'} = length($content);
-           }
-       }
-
-       my $tls = {
-           # TLS 1.x only, with certificate pinning
-           method => 'any',
-           sslv2 => 0,
-           sslv3 => 0,
-           verify => 1,
-           verify_cb => sub {
-               my (undef, undef, undef, $depth, undef, undef, $cert) = @_;
-               # we don't care about intermediate or root certificates
-               return 1 if $depth != 0;
-               # check server certificate against cache of pinned FPs
-               return $self->check_cert_fingerprint($cert);
-           },
-       };
-
-       # load and cache cert fingerprint if first time we proxy to this node
-       $self->initialize_cert_cache($node);
-
-       my $w; $w = http_request(
-           $method => $target,
-           headers => $headers,
-           timeout => 30,
-           recurse => 0,
-           proxy => undef, # avoid use of $ENV{HTTP_PROXY}
-           keepalive => $keep_alive,
-           body => $content,
-           tls_ctx => AnyEvent::TLS->new(%{$tls}),
-           sub {
-               my ($body, $hdr) = @_;
-
-               undef $w;
-
-               if (!$reqstate->{hdl}) {
-                   warn "proxy detected vanished client connection\n";
-                   return;
-               }
-
-               eval {
-                   my $code = delete $hdr->{Status};
-                   my $msg = delete $hdr->{Reason};
-                   delete $hdr->{URL};
-                   delete $hdr->{HTTPVersion};
-                   my $header = HTTP::Headers->new(%$hdr);
-                   if (my $location = $header->header('Location')) {
-                       $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);
-               };
-               warn $@ if $@;
-           });
-    };
-    warn $@ if $@;
-}
-
-# return arrays as \0 separated strings (like CGI.pm)
-sub decode_urlencoded {
-    my ($data) = @_;
-
-    my $res = {};
-
-    return $res if !$data;
-
-    foreach my $kv (split(/[\&\;]/, $data)) {
-       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;
-
-       if (defined(my $old = $res->{$k})) {
-           $res->{$k} = "$old\0$v";
-       } else {
-           $res->{$k} = $v;
-       }       
-    }
-    return $res;
-}
-
-sub extract_params {
-    my ($r, $method) = @_;
-
-    my $params = {};
-
-    if ($method eq 'PUT' || $method eq 'POST') {
-       $params = decode_urlencoded($r->content);
-    }
-
-    my $query_params = decode_urlencoded($r->url->query());
-
-    foreach my $k (keys %{$query_params}) {
-       $params->{$k} = $query_params->{$k};
-    }
-
-    return PVE::Tools::decode_utf8_parameters($params);
-}
-
-sub handle_api2_request {
-    my ($self, $reqstate, $auth, $method, $path, $upload_state) = @_;
-
-    eval {
-       my $r = $reqstate->{request};
-
-       my ($rel_uri, $format) = &$split_abs_uri($path, $self->{base_uri});
-
-       my $formatter = get_formatter($format);
-
-       if (!defined($formatter)) {
-           $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such uri 
$rel_uri, $format");
-           return;
-       }
-
-       #print Dumper($upload_state) if $upload_state;
-
-       my $rpcenv = $self->{rpcenv};
-
-       my $params;
-
-       if ($upload_state) {
-           $params = $upload_state->{params};
-       } else {
-           $params = extract_params($r, $method);
-       }
-
-       delete $params->{_dc}; # remove disable cache parameter
-
-       my $clientip = $reqstate->{peer_host};
-
-       $rpcenv->init_request();
-
-       my $res = $self->rest_handler($clientip, $method, $rel_uri, $auth, 
$params);
-
-       AnyEvent->now_update(); # in case somebody called sleep()
-
-       $rpcenv->set_user(undef); # clear after request
-
-       my $upgrade = $r->header('upgrade');
-       $upgrade = lc($upgrade) if $upgrade;
-
-       if (my $host = $res->{proxy}) {
-
-           if ($self->{trusted_env}) {
-               $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy not 
allowed");
-               return;
-           }
-
-           if ($host ne 'localhost' && $r->header('PVEDisableProxy')) {
-               $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy loop 
detected");
-               return;
-           }
-
-           $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});
-           return;
-
-       } elsif ($upgrade && ($method eq 'GET') && ($path =~ m|websocket$|)) {
-           die "unable to upgrade to protocol '$upgrade'\n" if !$upgrade || 
($upgrade ne 'websocket');
-           my $wsver = $r->header('sec-websocket-version');
-           die "unsupported websocket-version '$wsver'\n" if !$wsver || 
($wsver ne '13');
-           my $wsproto_str = $r->header('sec-websocket-protocol');
-           die "missing websocket-protocol header" if !$wsproto_str;
-           my $wsproto;
-           foreach my $p (PVE::Tools::split_list($wsproto_str)) {
-               $wsproto = $p if !$wsproto && $p eq 'base64';
-               $wsproto = $p if $p eq 'binary';
-           }
-           die "unsupported websocket-protocol protocol '$wsproto_str'\n" if 
!$wsproto;
-           my $wskey = $r->header('sec-websocket-key');
-           die "missing websocket-key\n" if !$wskey;
-           # Note: Digest::SHA::sha1_base64 has wrong padding
-           my $wsaccept = 
Digest::SHA::sha1_base64("${wskey}258EAFA5-E914-47DA-95CA-C5AB0DC85B11") . "=";
-           if ($res->{status} == HTTP_OK) {
-               $self->websocket_proxy($reqstate, $wsaccept, $wsproto, 
$res->{data});
-               return;
-           }
-       }
-
-       my $delay = 0;
-       if ($res->{status} == HTTP_UNAUTHORIZED) {
-           # always delay unauthorized calls by 3 seconds
-           $delay = 3 - tv_interval($reqstate->{starttime});
-           $delay = 0 if $delay < 0;
-       }
-
-       if ($res->{info} && $res->{info}->{formatter}) {
-           if (defined(my $func = $res->{info}->{formatter}->{$format})) {
-               $formatter = $func;
-           }
-       }
-
-       my ($raw, $ct, $nocomp) = &$formatter($res, $res->{data}, $params, 
$path, $auth);
-
-       my $resp;
-       if (ref($raw) && (ref($raw) eq 'HTTP::Response')) {
-           $resp = $raw;
-       } else {
-           $resp = HTTP::Response->new($res->{status}, $res->{message});
-           $resp->header("Content-Type" => $ct);
-           $resp->content($raw);
-       }
-       $self->response($reqstate, $resp, undef, $nocomp, $delay);
-    };
-    if (my $err = $@) {
-       $self->error($reqstate, 501, $err);
-    }
-}
-
-sub handle_spice_proxy_request {
-    my ($self, $reqstate, $connect_str, $vmid, $node, $spiceport) = @_;
-
-    eval {
-
-        die "Port $spiceport is not allowed" if ($spiceport < 61000 || 
$spiceport > 61099);
-
-       my $rpcenv = $self->{rpcenv};
-       $rpcenv->init_request();
-
-       my $clientip = $reqstate->{peer_host};
-       my $r = $reqstate->{request};
-
-        my $remip;
-
-        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};
-        } else {
-           print "$$: CONNECT $vmid, $node, $spiceport\n" if $self->{debug};
-       }
-
-       if ($remip && $r->header('PVEDisableProxy')) {
-           $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy loop 
detected");
-           return;
-       }
-
-       $reqstate->{hdl}->timeout(0);
-       $reqstate->{hdl}->wbuf_max(64*10*1024);
-
-       my $remhost = $remip ? $remip : "localhost";
-       my $remport = $remip ? 3128 : $spiceport;
-
-       tcp_connect $remhost, $remport, sub {
-           my ($fh) = @_ 
-               or die "connect to '$remhost:$remport' failed: $!";
-
-           print "$$: CONNECTed to '$remhost:$remport'\n" if $self->{debug};
-           $reqstate->{proxyhdl} = AnyEvent::Handle->new(
-               fh => $fh,
-               rbuf_max => 64*1024,
-               wbuf_max => 64*10*1024,
-               timeout => 5,
-               on_eof => sub {
-                   my ($hdl) = @_;
-                   eval {
-                       $self->log_aborted_request($reqstate);
-                       $self->client_do_disconnect($reqstate);
-                   };
-                   if (my $err = $@) { syslog('err', $err); }
-               },
-               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"); }
-               });
-
-
-           my $proxyhdlreader = sub {
-               my ($hdl) = @_;
-
-               my $len = length($hdl->{rbuf});
-               my $data = substr($hdl->{rbuf}, 0, $len, '');
-
-               #print "READ1 $len\n";
-               $reqstate->{hdl}->push_write($data) if $reqstate->{hdl};
-           };
-
-           my $hdlreader = sub {
-               my ($hdl) = @_;
-
-               my $len = length($hdl->{rbuf});
-               my $data = substr($hdl->{rbuf}, 0, $len, '');
-
-               #print "READ0 $len\n";
-               $reqstate->{proxyhdl}->push_write($data) if 
$reqstate->{proxyhdl};
-           };
-
-           my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 
'HTTP/1.0';
-
-           my $startproxy = sub {
-               $reqstate->{proxyhdl}->timeout(0);
-               $reqstate->{proxyhdl}->on_read($proxyhdlreader);
-               $reqstate->{hdl}->on_read($hdlreader);
-
-               # todo: use stop_read/start_read if write buffer grows to much
-
-               my $res = "$proto 200 OK\015\012"; # hope this is the right 
answer?
-               $reqstate->{hdl}->push_write($res);
-
-               # log early
-               $reqstate->{log}->{code} = 200;
-               $self->log_request($reqstate);
-           };
-
-           if ($remip) {
-               my $header = "CONNECT ${connect_str} $proto\015\012" .
-                   "Host: ${connect_str}\015\012" .
-                   "Proxy-Connection: keep-alive\015\012" .
-                   "User-Agent: spiceproxy\015\012" .
-                   "PVEDisableProxy: true\015\012" .
-                   "PVEClientIP: $clientip\015\012" .
-                   "\015\012";
-
-               $reqstate->{proxyhdl}->push_write($header);
-               $reqstate->{proxyhdl}->push_read(line => sub {
-                   my ($hdl, $line) = @_;
-                   
-                   if ($line =~ m!^$proto 200 OK$!) {
-                       &$startproxy();
-                   } else {
-                       $reqstate->{hdl}->push_write($line);
-                       $self->client_do_disconnect($reqstate);
-                   }
-                });
-           } else {
-               &$startproxy();
-           }
-
-       };
-    };
-    if (my $err = $@) {
-       warn $err;
-       $self->log_aborted_request($reqstate, $err);
-       $self->client_do_disconnect($reqstate);
-    }
-}
-
-sub handle_request {
-    my ($self, $reqstate, $auth, $method, $path) = @_;
-
-    my $base_uri = $self->{base_uri};
-
-    eval {
-       my $r = $reqstate->{request};
-       
-       # disable timeout on handle (we already have all data we need)
-       # we re-enable timeout in response()
-       $reqstate->{hdl}->timeout(0);
-
-       if ($path =~ m/^\Q$base_uri\E/) {
-           $self->handle_api2_request($reqstate, $auth, $method, $path);
-           return;
-       }
-
-       if ($self->{pages} && ($method eq 'GET') && (my $handler = 
$self->{pages}->{$path})) {
-           if (ref($handler) eq 'CODE') {
-               my $params = decode_urlencoded($r->url->query());
-               my ($resp, $userid) = &$handler($self, $reqstate->{request}, 
$params);
-               $self->response($reqstate, $resp);
-           } elsif (ref($handler) eq 'HASH') {
-               if (my $filename = $handler->{file}) {
-                   my $fh = IO::File->new($filename) ||
-                       die "unable to open file '$filename' - $!\n";
-                   send_file_start($self, $reqstate, $filename);
-               } else {
-                   die "internal error - no handler";
-               }
-           } else {
-               die "internal error - no handler";
-           }
-           return;
-       }
-
-       if ($self->{dirs} && ($method eq 'GET')) {
-           # we only allow simple names
-           if ($path =~ m!^(/\S+/)([a-zA-Z0-9\-\_\.]+)$!) {
-               my ($subdir, $file) = ($1, $2);
-               if (my $dir = $self->{dirs}->{$subdir}) {
-                   my $filename = "$dir$file";
-                   my $fh = IO::File->new($filename) ||
-                       die "unable to open file '$filename' - $!\n";
-                   send_file_start($self, $reqstate, $filename);
-                   return;
-               }
-           }
-       }
-
-       die "no such file '$path'";
-    };
-    if (my $err = $@) {
-       $self->error($reqstate, 501, $err);
-    }
-}
-
-sub file_upload_multipart {
-    my ($self, $reqstate, $auth, $method, $path, $rstate) = @_;
-
-    eval {
-       my $boundary = $rstate->{boundary};
-       my $hdl = $reqstate->{hdl};
-
-       my $startlen = length($hdl->{rbuf});
-
-       if ($rstate->{phase} == 0) { # skip everything until start
-           if ($hdl->{rbuf} =~ s/^.*?--\Q$boundary\E  \015?\012
-                       ((?:[^\015]+\015\012)* ) \015?\012//xs) {
-               my $header = $1;
-               my ($ct, $disp, $name, $filename);
-               foreach my $line (split(/\015?\012/, $header)) {
-                   # assume we have single line headers
-                   if ($line =~ m/^Content-Type\s*:\s*(.*)/i) {
-                       $ct = parse_content_type($1);
-                   } elsif ($line =~ m/^Content-Disposition\s*:\s*(.*)/i) {
-                       ($disp, $name, $filename) = 
parse_content_disposition($1);
-                   }
-               }
-
-               if (!($disp && $disp eq 'form-data' && $name)) {
-                   syslog('err', "wrong content disposition in multipart - 
abort upload");
-                   $rstate->{phase} = -1;
-               } else {
-
-                   $rstate->{fieldname} = $name;
-
-                   if ($filename) {
-                       if ($name eq 'filename') {
-                           # found file upload data
-                           $rstate->{phase} = 1;
-                           $rstate->{filename} = $filename;
-                       } else {
-                           syslog('err', "wrong field name for file upload - 
abort upload");
-                           $rstate->{phase} = -1;
-                       }
-                   } else {
-                       # found form data for field $name
-                       $rstate->{phase} = 2;
-                   }
-               }
-           } else {
-               my $len = length($hdl->{rbuf});
-               substr($hdl->{rbuf}, 0, $len - $rstate->{maxheader}, '') 
-                   if $len > $rstate->{maxheader}; # skip garbage
-           }
-       } elsif ($rstate->{phase} == 1) { # inside file - dump until end marker
-           if ($hdl->{rbuf} =~ s/^(.*?)\015?\012(--\Q$boundary\E(--)? 
\015?\012(.*))$/$2/xs) {
-               my ($rest, $eof) = ($1, $3);
-               my $len = length($rest);
-               die "write to temporary file failed - $!" 
-                   if syswrite($rstate->{outfh}, $rest) != $len;
-               $rstate->{ctx}->add($rest);
-               $rstate->{params}->{filename} = $rstate->{filename};
-               $rstate->{md5sum} = $rstate->{ctx}->hexdigest;
-               $rstate->{bytes} += $len;
-               $rstate->{phase} =  $eof ? 100 : 0;
-           } else {
-               my $len = length($hdl->{rbuf});
-               my $wlen = $len - $rstate->{boundlen};
-               if ($wlen > 0) {
-                   my $data = substr($hdl->{rbuf}, 0, $wlen, '');
-                   die "write to temporary file failed - $!" 
-                       if syswrite($rstate->{outfh}, $data) != $wlen;
-                   $rstate->{bytes} += $wlen;
-                   $rstate->{ctx}->add($data);
-               }
-           }
-       } elsif ($rstate->{phase} == 2) { # inside normal field
-
-           if ($hdl->{rbuf} =~ s/^(.*?)\015?\012(--\Q$boundary\E(--)? 
\015?\012(.*))$/$2/xs) {
-               my ($rest, $eof) = ($1, $3);
-               my $len = length($rest);
-               $rstate->{post_size} += $len;
-               if ($rstate->{post_size} < $limit_max_post) {
-                   $rstate->{params}->{$rstate->{fieldname}} = $rest;
-                   $rstate->{phase} = $eof ? 100 : 0;
-               } else {
-                   syslog('err', "form data to large - abort upload");
-                   $rstate->{phase} = -1; # skip
-               }
-           }
-       } else { # skip 
-           my $len = length($hdl->{rbuf});
-           substr($hdl->{rbuf}, 0, $len, ''); # empty rbuf
-       }
-
-       $rstate->{read} += ($startlen - length($hdl->{rbuf}));
-
-       if (!$rstate->{done} && ($rstate->{read} + length($hdl->{rbuf})) >= 
$rstate->{size}) {
-           $rstate->{done} = 1; # make sure we dont get called twice 
-           if ($rstate->{phase} < 0 || !$rstate->{md5sum}) {
-               die "upload failed\n"; 
-           } 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);
-               $self->handle_api2_request($reqstate, $auth, $method, $path, 
$rstate);
-           }
-       }
-    };
-    if (my $err = $@) {
-       syslog('err', $err);
-       $self->error($reqstate, 501, $err);
-    }
-}
-
-sub parse_content_type {
-    my ($ctype) = @_;
-
-    my ($ct, @params) = split(/\s*[;,]\s*/o, $ctype);
-    
-    foreach my $v (@params) {
-       if ($v =~ m/^\s*boundary\s*=\s*(\S+?)\s*$/o) {
-           return wantarray ? ($ct, $1) : $ct;
-       }
-    }
- 
-    return  wantarray ? ($ct) : $ct;
-}
-
-sub parse_content_disposition {
-    my ($line) = @_;
-
-    my ($disp, @params) = split(/\s*[;,]\s*/o, $line);
-    my $name;
-    my $filename;
-
-    foreach my $v (@params) {
-       if ($v =~ m/^\s*name\s*=\s*(\S+?)\s*$/o) {
-           $name = $1;
-           $name =~ s/^"(.*)"$/$1/;
-       } elsif ($v =~ m/^\s*filename\s*=\s*(.+?)\s*$/o) {
-           $filename = $1;
-           $filename =~ s/^"(.*)"$/$1/;
-       }
-    }
- 
-    return  wantarray ? ($disp, $name, $filename) : $disp;
-}
-
-my $tmpfile_seq_no = 0;
-
-sub get_upload_filename {
-    # choose unpredictable tmpfile name
-  
-    $tmpfile_seq_no++;
-    return "/var/tmp/pveupload-" . Digest::MD5::md5_hex($tmpfile_seq_no . 
time() . $$);
-}
-
-sub unshift_read_header {
-    my ($self, $reqstate, $state) = @_;
-
-    $state = { size => 0, count => 0 } if !$state;
-
-    $reqstate->{hdl}->unshift_read(line => sub {
-       my ($hdl, $line) = @_;
-
-       eval {
-           # print "$$: got header: $line\n" if $self->{debug};
-
-           die "to many http header lines\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};
-           if ($line eq '') {
-
-               my $path = uri_unescape($r->uri->path());
-               my $method = $r->method();
-
-               $r->push_header($state->{key}, $state->{val})
-                   if $state->{key};
-
-               if (!$known_methods->{$method}) {
-                   my $resp = HTTP::Response->new(HTTP_NOT_IMPLEMENTED, 
"method '$method' not available");
-                   $self->response($reqstate, $resp);
-                   return;
-               }
-
-               my $conn = $r->header('Connection');
-               my $accept_enc = $r->header('Accept-Encoding');
-               $reqstate->{accept_gzip} = ($accept_enc && $accept_enc =~ 
m/gzip/) ? 1 : 0;
-
-               if ($conn) {
-                   $reqstate->{keep_alive} = 0 if $conn =~ m/close/oi;
-               } else {
-                   if ($reqstate->{proto}->{ver} < 1001) {
-                       $reqstate->{keep_alive} = 0;
-                   }
-               }
-
-               my $te  = $r->header('Transfer-Encoding');
-               if ($te && lc($te) eq 'chunked') {
-                   # Handle chunked transfer encoding
-                   $self->error($reqstate, 501, "chunked transfer encoding not 
supported");
-                   return;
-               } elsif ($te) {
-                   $self->error($reqstate, 501, "Unknown transfer encoding 
'$te'");
-                   return;
-               }
-
-               my $pveclientip = $r->header('PVEClientIP');
-               my $base_uri = $self->{base_uri};
-
-               # fixme: how can we make PVEClientIP header trusted?
-               if ($self->{trusted_env} && $pveclientip) {
-                   $reqstate->{peer_host} = $pveclientip;
-               } else {
-                   $r->header('PVEClientIP', $reqstate->{peer_host});
-               }
-
-               my $len = $r->header('Content-Length');
-
-               # header processing complete - authenticate now
-
-               my $auth = {};
-               if ($self->{spiceproxy}) {
-                   my $connect_str = $r->header('Host');
-                   my ($vmid, $node, $port) = 
PVE::AccessControl::verify_spice_connect_url($connect_str);
-                   if (!(defined($vmid) && $node && $port)) {
-                       $self->error($reqstate, HTTP_UNAUTHORIZED, "invalid 
ticket");
-                       return;
-                   }
-                   $self->handle_spice_proxy_request($reqstate, $connect_str, 
$vmid, $node, $port);
-                   return;
-               } elsif ($path =~ m/^\Q$base_uri\E/) {
-                   my $token = $r->header('CSRFPreventionToken');
-                   my $cookie = $r->header('Cookie');
-                   my $ticket = extract_auth_cookie($cookie, 
$self->{cookie_name});
-
-                   my ($rel_uri, $format) = &$split_abs_uri($path, 
$self->{base_uri});
-                   if (!$format) {
-                       $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such 
uri");
-                       return;
-                   }
-
-                   my $rpcenv = $self->{rpcenv};
-                   # set environment variables
-                   $rpcenv->set_user(undef);
-                   $rpcenv->set_language('C');
-                   $rpcenv->set_client_ip($reqstate->{peer_host});
-
-                   eval {
-                       $auth = $self->auth_handler($method, $rel_uri, $ticket, 
$token);
-                   };
-                   if (my $err = $@) {
-                       # always delay unauthorized calls by 3 seconds
-                       my $delay = 3;
-                       if (my $formatter = get_login_formatter($format)) {
-                           my ($raw, $ct, $nocomp) = &$formatter($path, $auth);
-                           my $resp;
-                           if (ref($raw) && (ref($raw) eq 'HTTP::Response')) {
-                               $resp = $raw;
-                           } else {
-                               $resp = HTTP::Response->new(HTTP_UNAUTHORIZED, 
"Login Required");
-                               $resp->header("Content-Type" => $ct);
-                               $resp->content($raw);
-                           }
-                           $self->response($reqstate, $resp, undef, $nocomp, 
3);
-                       } else {
-                           my $resp = HTTP::Response->new(HTTP_UNAUTHORIZED, 
$err);
-                           $self->response($reqstate, $resp, undef, 0, $delay);
-                       }
-                       return;
-                   }
-               }
-
-               $reqstate->{log}->{userid} = $auth->{userid};
-
-               if ($len) {
-
-                   if (!($method eq 'PUT' || $method eq 'POST')) {
-                       $self->error($reqstate, 501, "Unexpected content for 
method '$method'");
-                       return;
-                   }
-
-                   my $ctype = $r->header('Content-Type');
-                   my ($ct, $boundary) = parse_content_type($ctype) if $ctype;
-
-                   if ($auth->{isUpload} && !$self->{trusted_env}) {
-                       die "upload 'Content-Type '$ctype' not implemented\n" 
-                           if !($boundary && $ct && ($ct eq 
'multipart/form-data'));
-
-                       die "upload without content length header not 
supported" if !$len;
-
-                       die "upload without content length header not 
supported" if !$len;
-
-                       print "start upload $path $ct $boundary\n" if 
$self->{debug};
-
-                       my $tmpfilename = get_upload_filename();
-                       my $outfh = IO::File->new($tmpfilename, 
O_RDWR|O_CREAT|O_EXCL, 0600) ||
-                           die "unable to create temporary upload file 
'$tmpfilename'";
-
-                       $reqstate->{keep_alive} = 0;
-
-                       my $boundlen = length($boundary) + 8; # 
\015?\012--$boundary--\015?\012
-
-                       my $state = {
-                           size => $len,
-                           boundary => $boundary,
-                           ctx => Digest::MD5->new,
-                           boundlen =>  $boundlen,
-                           maxheader => 2048 + $boundlen, # should be large 
enough
-                           params => decode_urlencoded($r->url->query()),
-                           phase => 0,
-                           read => 0,
-                           post_size => 0,
-                           starttime => [gettimeofday],
-                           outfh => $outfh,
-                       };
-                       $reqstate->{tmpfilename} = $tmpfilename;
-                       $reqstate->{hdl}->on_read(sub { 
$self->file_upload_multipart($reqstate, $auth, $method, $path, $state); });
-                       return;
-                   }
 
-                   if ($len > $limit_max_post) {
-                       $self->error($reqstate, 501, "for data too large");
-                       return;
-                   }
-
-                   if (!$ct || $ct eq 'application/x-www-form-urlencoded') {
-                       $reqstate->{hdl}->unshift_read(chunk => $len, sub {
-                           my ($hdl, $data) = @_;
-                           $r->content($data);
-                           $self->handle_request($reqstate, $auth, $method, 
$path);
-                       });
-                   } else {
-                       $self->error($reqstate, 506, "upload 'Content-Type 
'$ctype' not implemented");
-                   }
-               } else {
-                   $self->handle_request($reqstate, $auth, $method, $path);
-               }
-           } elsif ($line =~ /^([^:\s]+)\s*:\s*(.*)/) {
-               $r->push_header($state->{key}, $state->{val}) if $state->{key};
-               ($state->{key}, $state->{val}) = ($1, $2);
-               $self->unshift_read_header($reqstate, $state);
-           } elsif ($line =~ /^\s+(.*)/) {
-               $state->{val} .= " $1";
-               $self->unshift_read_header($reqstate, $state);
-           } else {
-               $self->error($reqstate, 506, "unable to parse request header");
-           }
-       };
-       warn $@ if $@;
-    });
-};
-
-sub push_request_header {
-    my ($self, $reqstate) = @_;
-
-    eval {
-       $reqstate->{hdl}->push_read(line => sub {
-           my ($hdl, $line) = @_;
-
-           eval {
-               # print "got request header: $line\n" if $self->{debug};
-
-               $reqstate->{keep_alive}--;
-
-               if ($line =~ /(\S+)\040(\S+)\040HTTP\/(\d+)\.(\d+)/o) {
-                   my ($method, $url, $maj, $min) = ($1, $2, $3, $4);
-
-                   if ($maj != 1) {
-                       $self->error($reqstate, 506, "http protocol version 
$maj.$min not supported");
-                       return;
-                   }
-
-                   $self->{request_count}++; # only count valid request headers
-                   if ($self->{request_count} >= $self->{max_requests}) {
-                       $self->{end_loop} = 1;
-                   }
-                   $reqstate->{log} = { requestline => $line };
-                   $reqstate->{proto}->{str} = "HTTP/$maj.$min";
-                   $reqstate->{proto}->{maj} = $maj;
-                   $reqstate->{proto}->{min} = $min;
-                   $reqstate->{proto}->{ver} = $maj*1000+$min;
-                   $reqstate->{request} = HTTP::Request->new($method, $url);
-                   $reqstate->{starttime} = [gettimeofday],
-
-                   $self->unshift_read_header($reqstate);
-               } elsif ($line eq '') {
-                   # ignore empty lines before requests (browser bugs?)
-                   $self->push_request_header($reqstate);
-               } else {
-                   $self->error($reqstate, 400, 'bad request');
-               }
-           };
-           warn $@ if $@;
-       });
-    };
-    warn $@ if $@;
-}
-
-sub accept {
-    my ($self) = @_;
-
-    my $clientfh;
-
-    return if $self->{end_loop};
-
-    # we need to m make sure that only one process calls accept
-    while (!flock($self->{lockfh}, Fcntl::LOCK_EX())) {
-       next if $! == EINTR;
-       die "could not get lock on file '$self->{lockfile}' -  $!\n";
-    }
-
-    my $again = 0;
-    my $errmsg;
-    eval {
-       while (!$self->{end_loop} &&
-              !defined($clientfh = $self->{socket}->accept()) &&
-              ($! == EINTR)) {};
-
-       if ($self->{end_loop}) {
-           $again = 0;
-       } else {
-           $again = ($! == EAGAIN || $! == WSAEWOULDBLOCK);
-           if (!defined($clientfh)) {
-               $errmsg = "failed to accept connection: $!\n";
-           }
-       }
-    };
-    warn $@ if $@;
-
-    flock($self->{lockfh}, Fcntl::LOCK_UN());
-
-    if (!defined($clientfh)) {
-       return if $again;
-       die $errmsg if $errmsg;
-    }
-
-    fh_nonblocking $clientfh, 1;
-
-    $self->{conn_count}++;
-
-    return $clientfh;
-}
-
-sub wait_end_loop {
-    my ($self) = @_;
-
-    $self->{end_loop} = 1;
-
-    undef $self->{socket_watch};
-
-    $0 = "$0 (shutdown)" if $0 !~ m/\(shutdown\)$/;
-
-    if ($self->{conn_count} <= 0) {
-       $self->{end_cond}->send(1);
-       return;
-    }
-
-    # fork and exit, so that parent starts a new worker
-    if (fork()) {
-       exit(0);
-    }
-
-    # else we need to wait until all open connections gets closed
-    my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub {
-       eval {
-           # todo: test for active connections instead (we can abort idle 
connections)
-           if ($self->{conn_count} <= 0) {
-               undef $w;
-               $self->{end_cond}->send(1);
-           }
-       };
-       warn $@ if $@;
-    });
-}
-
-
-sub check_host_access {
-    my ($self, $clientip) = @_;
-    
-    my $cip = Net::IP->new($clientip);
-
-    my $match_allow = 0;
-    my $match_deny = 0;
-
-    if ($self->{allow_from}) {
-       foreach my $t (@{$self->{allow_from}}) {
-           if ($t->overlaps($cip)) {
-               $match_allow = 1;
-               last;
-           }
-       }
-    }
-
-    if ($self->{deny_from}) {
-       foreach my $t (@{$self->{deny_from}}) {
-           if ($t->overlaps($cip)) {
-               $match_deny = 1;
-               last;
-           }
-       }
-    }
-
-    if ($match_allow == $match_deny) {
-       # match both allow and deny, or no match
-       return $self->{policy} && $self->{policy} eq 'allow' ? 1 : 0;
-    }
-
-    return $match_allow;
-}
-
-sub accept_connections {
-    my ($self) = @_;
-
-    eval {
-
-       while (my $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}) {
-               $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));
-           }
-
-           if (!$self->{trusted_env} && 
!$self->check_host_access($reqstate->{peer_host})) {
-               print "$$: ABORT request from $reqstate->{peer_host} - access 
denied\n" if $self->{debug};
-               $reqstate->{log}->{code} = 403;
-               $self->log_request($reqstate);
-               next;
-           }
-
-           $reqstate->{hdl} = AnyEvent::Handle->new(
-               fh => $clientfh,
-               rbuf_max => 64*1024,
-               timeout => $self->{timeout},
-               linger => 0, # avoid problems with ssh - really needed ?
-               on_eof   => sub {
-                   my ($hdl) = @_;
-                   eval {
-                       $self->log_aborted_request($reqstate);
-                       $self->client_do_disconnect($reqstate);
-                   };
-                   if (my $err = $@) { syslog('err', $err); }
-               },
-               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"); }
-               },
-               ($self->{tls_ctx} ? (tls => "accept", tls_ctx => 
$self->{tls_ctx}) : ()));
-
-           print "$$: ACCEPT FH" .  $clientfh->fileno() . " 
CONN$self->{conn_count}\n" if $self->{debug};
-
-           $self->push_request_header($reqstate);
-       }
-    };
-
-    if (my $err = $@) {
-       syslog('err', $err);
-       $self->{end_loop} = 1;
-    }
-
-    $self->wait_end_loop() if $self->{end_loop};
-}
-
-# Note: We can't open log file in non-blocking mode and use AnyEvent::Handle,
-# because we write from multiple processes, and that would arbitrarily mix 
output
-# of all processes.
-sub open_access_log {
-    my ($self, $filename) = @_;
-
-    my $old_mask = umask(0137);;
-    my $logfh = IO::File->new($filename, ">>") ||
-       die "unable to open log file '$filename' - $!\n";
-    umask($old_mask);
-
-    $logfh->autoflush(1);
-
-    $self->{logfh} = $logfh;
-}
-
-sub write_log {
-    my ($self, $data) = @_;
-
-    return if !defined($self->{logfh}) || !$data;
+use PVE::SafeSyslog;
+use PVE::INotify;
+use PVE::Tools;
+use PVE::APIServer::AnyEvent;
 
-    my $res = $self->{logfh}->print($data);
+use PVE::RPCEnvironment;
+use PVE::AccessControl;
+use PVE::Cluster;
 
-    if (!$res) {
-       delete $self->{logfh};
-       syslog('err', "error writing access log");
-       $self->{end_loop} = 1; # terminate asap
-    }
-}
+use Data::Dumper;
 
-sub atfork_handler {
-    my ($self) = @_;
+use base('PVE::APIServer::AnyEvent');
 
-    eval {
-       # something else do to ?
-       close($self->{socket});
-    };
-    warn $@ if $@;
-}
+use HTTP::Status qw(:constants);
 
 sub new {
     my ($this, %args) = @_;
 
     my $class = ref($this) || $this;
 
-    foreach my $req (qw(base_handler_class socket lockfh lockfile)) {
-       die "misssing required argument '$req'" if !defined($args{$req});
-    }
-
-    my $self = bless { %args }, $class;
-
-    $self->{cookie_name} //= 'PVEAuthCookie';
-    $self->{base_uri} //= "/api2";
-
-    # init inotify
-    PVE::INotify::inotify_init();
-
+    my $self = $class->SUPER::new(%args);
+    
     $self->{rpcenv} = PVE::RPCEnvironment->init(
        $self->{trusted_env} ? 'priv' : 'pub', atfork =>  sub { $self-> 
atfork_handler() });
 
-    fh_nonblocking($self->{socket}, 1);
-
-    $self->{end_loop} = 0;
-    $self->{conn_count} = 0;
-    $self->{request_count} = 0;
-    $self->{timeout} = 5 if !$self->{timeout};
-    $self->{keep_alive} = 0 if !defined($self->{keep_alive});
-    $self->{max_conn} = 800 if !$self->{max_conn};
-    $self->{max_requests} = 8000 if !$self->{max_requests};
-
-    $self->{policy} = 'allow' if !$self->{policy};
-
-    $self->{end_cond} = AnyEvent->condvar;
-
-    if ($self->{ssl}) {
-       $self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}});
-       # TODO : openssl >= 1.0.2 supports SSL_CTX_set_ecdh_auto to select a 
curve depending on 
-       # server and client availability from SSL_CTX_set1_curves. 
-       # that way other curves like 25519 can be used.
-       # openssl 1.0.1 can only support 1 curve at a time.
-       my $curve = Net::SSLeay::OBJ_txt2nid('prime256v1');
-       my $ecdh = Net::SSLeay::EC_KEY_new_by_curve_name($curve);
-       Net::SSLeay::CTX_set_options($self->{tls_ctx}->{ctx}, 
&Net::SSLeay::OP_NO_COMPRESSION | &Net::SSLeay::OP_SINGLE_ECDH_USE | 
&Net::SSLeay::OP_SINGLE_DH_USE);
-       Net::SSLeay::CTX_set_tmp_ecdh($self->{tls_ctx}->{ctx}, $ecdh);
-       Net::SSLeay::EC_KEY_free($ecdh);
-    }
-
-    if ($self->{spiceproxy}) {
-       $known_methods = { CONNECT => 1 };
-    }
-
-    $self->open_access_log($self->{logfile}) if $self->{logfile};
-
-    $self->{max_conn_soft_limit} = $self->{max_conn} > 100 ? $self->{max_conn} 
- 20 : $self->{max_conn};
+    return $self;
+}
 
-    $self->{socket_watch} = AnyEvent->io(fh => $self->{socket}, poll => 'r', 
cb => sub {
-       eval {
-           if ($self->{conn_count} >= $self->{max_conn}) {
-               my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => 
sub {
-                   if ($self->{conn_count} < $self->{max_conn}) {
-                       undef $w;
-                       $self->accept_connections();
-                   }
-               });
-           } else {
-               $self->accept_connections();
-           }
-       };
-       warn $@ if $@;
-    });
+sub verify_spice_connect_url {
+    my ($self, $connect_str) = @_;
 
-    $self->{term_watch} = AnyEvent->signal(signal => "TERM", cb => sub {
-       undef $self->{term_watch};
-       $self->wait_end_loop();
-    });
+    my ($vmid, $node, $port) = 
PVE::AccessControl::verify_spice_connect_url($connect_str);
 
-    $self->{quit_watch} = AnyEvent->signal(signal => "QUIT", cb => sub {
-       undef $self->{quit_watch};
-       $self->wait_end_loop();
-    });
+    return ($vmid, $node, $port);
+}
 
-    $self->{inotify_poll} = AnyEvent->timer(after => 5, interval => 5, cb => 
sub {
-       PVE::INotify::poll(); # read inotify events
-    });
+sub generate_csrf_prevention_token {
+    my ($username) = @_;
 
-    return $self;
+    return PVE::AccessControl::assemble_csrf_prevention_token($username);
 }
 
 sub auth_handler {
@@ -1900,10 +219,4 @@ sub remote_node_ip {
     return $remip;
 }
 
-sub run {
-    my ($self) = @_;
-
-    $self->{end_cond}->recv;
-}
-
 1;
diff --git a/PVE/Service/pvedaemon.pm b/PVE/Service/pvedaemon.pm
index 433845d..173a89c 100755
--- a/PVE/Service/pvedaemon.pm
+++ b/PVE/Service/pvedaemon.pm
@@ -6,8 +6,8 @@ use warnings;
 use PVE::SafeSyslog;
 use PVE::Daemon;
 use PVE::API2;
-use PVE::API2::Formatter::Standard;
-use PVE::API2::Formatter::HTML;
+use PVE::APIServer::Formatter::Standard;
+use PVE::APIServer::Formatter::HTML;
 use PVE::HTTPServer;
 
 use base qw(PVE::Daemon);
diff --git a/PVE/Service/pveproxy.pm b/PVE/Service/pveproxy.pm
index 6a6be84..fe133d5 100755
--- a/PVE/Service/pveproxy.pm
+++ b/PVE/Service/pveproxy.pm
@@ -13,8 +13,10 @@ use File::Find;
 use Data::Dumper;
 use PVE::API2Tools;
 use PVE::API2;
-use PVE::API2::Formatter::Standard;
-use PVE::API2::Formatter::HTML;
+use PVE::APIServer::Formatter;
+use PVE::APIServer::Formatter::Standard;
+use PVE::APIServer::Formatter::HTML;
+use PVE::APIServer::AnyEvent;
 use PVE::HTTPServer;
 
 use PVE::ExtJSIndex;
@@ -181,7 +183,7 @@ sub get_index {
                $lang = $newlang;
            }
        }
-       my $ticket = PVE::HTTPServer::extract_auth_cookie($cookie, 
$server->{cookie_name});
+       my $ticket = PVE::APIServer::Formatter::extract_auth_cookie($cookie, 
$server->{cookie_name});
        if (($username = PVE::AccessControl::verify_ticket($ticket, 1))) {
            $token = 
PVE::AccessControl::assemble_csrf_prevention_token($username);
        }
diff --git a/debian/control.in b/debian/control.in
index 99580a6..6a0dade 100644
--- a/debian/control.in
+++ b/debian/control.in
@@ -3,7 +3,7 @@ Version: @VERSION@-@PACKAGERELEASE@
 Section: admin
 Priority: optional
 Architecture: amd64
-Depends: perl (>= 5.10.0-19), libtimedate-perl, libauthen-pam-perl, 
libintl-perl, rsync, libjson-perl, liblockfile-simple-perl, vncterm, 
qemu-server (>= 1.1-1), libwww-perl (>= 6.04-1), libnet-http-perl (>= 6.06-1), 
libhttp-daemon-perl, wget, libnet-dns-perl, ifenslave (>= 2.6), 
liblinux-inotify2-perl, debconf (>= 0.5) | debconf-2.0, netcat-traditional, 
pve-cluster (>= 1.0-29), libpve-common-perl, libpve-storage-perl, 
libterm-readline-gnu-perl, libpve-access-control (>= 3.0-2), 
libio-socket-ssl-perl, libfilesys-df-perl, libfile-readbackwards-perl, 
libfile-sync-perl, cstream, postfix | mail-transport-agent, libxml-parser-perl, 
lzop, dtach, libanyevent-perl, liburi-perl, logrotate, libanyevent-http-perl, 
apt-transport-https, ca-certificates, libapt-pkg-perl, libcrypt-ssleay-perl, 
liblwp-protocol-https-perl, spiceterm, libuuid-perl, hdparm, gdisk, 
librados2-perl, pve-firewall, novnc-pve, libev-perl, systemd, pve-ha-manager, 
pve-container, pve-docs
+Depends: perl (>= 5.10.0-19), libtimedate-perl, libauthen-pam-perl, 
libintl-perl, rsync, libjson-perl, liblockfile-simple-perl, vncterm, 
qemu-server (>= 1.1-1), libwww-perl (>= 6.04-1), libnet-http-perl (>= 6.06-1), 
libhttp-daemon-perl, wget, libnet-dns-perl, ifenslave (>= 2.6), 
liblinux-inotify2-perl, debconf (>= 0.5) | debconf-2.0, netcat-traditional, 
pve-cluster (>= 1.0-29), libpve-common-perl, libpve-storage-perl, 
libterm-readline-gnu-perl, libpve-access-control (>= 3.0-2), 
libio-socket-ssl-perl, libfilesys-df-perl, libfile-readbackwards-perl, 
libfile-sync-perl, cstream, postfix | mail-transport-agent, libxml-parser-perl, 
lzop, dtach, libpve-http-server-perl, liburi-perl, logrotate, 
apt-transport-https, ca-certificates, libapt-pkg-perl, libcrypt-ssleay-perl, 
liblwp-protocol-https-perl, spiceterm, libuuid-perl, hdparm, gdisk, 
librados2-perl, pve-firewall, novnc-pve, libev-perl, systemd, pve-ha-manager, 
pve-container, pve-docs
 Build-Depends: liblocale-po-perl
 Conflicts: netcat-openbsd, vzdump, vlan
 Replaces: vzdump, vlan
-- 
2.1.4

_______________________________________________
pve-devel mailing list
pve-devel@pve.proxmox.com
http://pve.proxmox.com/cgi-bin/mailman/listinfo/pve-devel

Reply via email to