[pve-devel] [PATCH pve-manager 1/9] use new libpve-http-server-perl package

Dietmar Maurer dietmar at proxmox.com
Mon Jan 16 10:59:31 CET 2017


Signed-off-by: Dietmar Maurer <dietmar at 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 at -@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




More information about the pve-devel mailing list