]> git.proxmox.com Git - pve-manager.git/blame - PVE/HTTPServer.pm
Fix warning in Browser console due to missing meta entry
[pve-manager.git] / PVE / HTTPServer.pm
CommitLineData
57f93db1
DM
1package PVE::HTTPServer;
2
3use strict;
4use warnings;
d06a1c62 5use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
57f93db1
DM
6use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN);
7use POSIX qw(strftime EINTR EAGAIN);
8use Fcntl;
d06a1c62 9use IO::File;
57f93db1 10use File::stat qw();
e60b9647 11use MIME::Base64;
d06a1c62 12use Digest::MD5;
e60b9647 13use Digest::SHA;
15903af6 14# use AnyEvent::Strict; # only use this for debugging
57f93db1 15use AnyEvent::Util qw(guard fh_nonblocking WSAEWOULDBLOCK WSAEINPROGRESS);
33afb29b 16use AnyEvent::Socket;
57f93db1 17use AnyEvent::Handle;
943776b0 18use Net::SSLeay;
57f93db1
DM
19use AnyEvent::TLS;
20use AnyEvent::IO;
21use AnyEvent::HTTP;
22use Fcntl ();
23use Compress::Zlib;
24use PVE::SafeSyslog;
25use PVE::INotify;
26use PVE::RPCEnvironment;
27use PVE::REST;
28
a908636e 29use Net::IP;
57f93db1 30use URI;
9195c8f9 31use URI::Escape;
57f93db1
DM
32use HTTP::Status qw(:constants);
33use HTTP::Headers;
34use HTTP::Response;
f6c357cf 35use Data::Dumper;
57f93db1 36
209b203e
DM
37my $limit_max_headers = 30;
38my $limit_max_header_size = 8*1024;
39my $limit_max_post = 16*1024;
57f93db1 40
57f93db1
DM
41
42my $known_methods = {
43 GET => 1,
44 POST => 1,
45 PUT => 1,
46 DELETE => 1,
47};
48
d06a1c62
DM
49my $baseuri = "/api2";
50
51sub split_abs_uri {
52 my ($abs_uri) = @_;
53
3ed61033 54 my ($format, $rel_uri) = $abs_uri =~ m/^\Q$baseuri\E\/+([a-z][a-z0-9]+)(\/.*)?$/;
d06a1c62
DM
55 $rel_uri = '/' if !$rel_uri;
56
57 return wantarray ? ($rel_uri, $format) : $rel_uri;
58}
59
6fcbe87a 60# generic formatter support
1370ec61 61
6fcbe87a 62my $formatter_hash = {};
1370ec61 63
6fcbe87a 64sub register_formatter {
1370ec61
DM
65 my ($format, $func) = @_;
66
6fcbe87a 67 die "formatter '$format' already defined" if $formatter_hash->{$format};
1370ec61 68
6fcbe87a 69 $formatter_hash->{$format} = {
1370ec61
DM
70 func => $func,
71 };
72}
73
6fcbe87a 74sub get_formatter {
1370ec61
DM
75 my ($format) = @_;
76
77 return undef if !$format;
78
6fcbe87a 79 my $info = $formatter_hash->{$format};
1370ec61
DM
80 return undef if !$info;
81
82 return $info->{func};
83}
84
6fcbe87a 85my $login_formatter_hash = {};
1370ec61 86
6fcbe87a 87sub register_login_formatter {
1370ec61
DM
88 my ($format, $func) = @_;
89
6fcbe87a 90 die "login formatter '$format' already defined" if $login_formatter_hash->{$format};
1370ec61 91
6fcbe87a 92 $login_formatter_hash->{$format} = {
1370ec61
DM
93 func => $func,
94 };
95}
96
6fcbe87a 97sub get_login_formatter {
1370ec61
DM
98 my ($format) = @_;
99
100 return undef if !$format;
101
6fcbe87a 102 my $info = $login_formatter_hash->{$format};
1370ec61
DM
103 return undef if !$info;
104
105 return $info->{func};
106}
107
108# server implementation
109
57f93db1
DM
110sub log_request {
111 my ($self, $reqstate) = @_;
112
57f93db1
DM
113 my $loginfo = $reqstate->{log};
114
115 # like apache2 common log format
116 # LogFormat "%h %l %u %t \"%r\" %>s %b \"%{Referer}i\" \"%{User-agent}i\""
117
8d5310c1
DM
118 return if $loginfo->{written}; # avoid duplicate logs
119 $loginfo->{written} = 1;
120
57f93db1
DM
121 my $peerip = $reqstate->{peer_host} || '-';
122 my $userid = $loginfo->{userid} || '-';
123 my $content_length = defined($loginfo->{content_length}) ? $loginfo->{content_length} : '-';
124 my $code = $loginfo->{code} || 500;
125 my $requestline = $loginfo->{requestline} || '-';
126 my $timestr = strftime("%d/%b/%Y:%H:%M:%S %z", localtime());
127
128 my $msg = "$peerip - $userid [$timestr] \"$requestline\" $code $content_length\n";
129
c2e9823c 130 $self->write_log($msg);
57f93db1
DM
131}
132
133sub log_aborted_request {
134 my ($self, $reqstate, $error) = @_;
135
136 my $r = $reqstate->{request};
137 return if !$r; # no active request
138
139 if ($error) {
140 syslog("err", "problem with client $reqstate->{peer_host}; $error");
141 }
f91072d5 142
57f93db1
DM
143 $self->log_request($reqstate);
144}
145
23699d1e
DM
146sub cleanup_reqstate {
147 my ($reqstate) = @_;
148
149 delete $reqstate->{log};
150 delete $reqstate->{request};
151 delete $reqstate->{proto};
152 delete $reqstate->{accept_gzip};
8dc1715b 153 delete $reqstate->{starttime};
57f93db1 154
d06a1c62
DM
155 if ($reqstate->{tmpfilename}) {
156 unlink $reqstate->{tmpfilename};
157 delete $reqstate->{tmpfilename};
158 }
23699d1e
DM
159}
160
161sub client_do_disconnect {
162 my ($self, $reqstate) = @_;
163
164 cleanup_reqstate($reqstate);
d06a1c62 165
89634434
DM
166 my $shutdown_hdl = sub {
167 my $hdl = shift;
168
169 shutdown($hdl->{fh}, 1);
170 # clear all handlers
171 $hdl->on_drain(undef);
172 $hdl->on_read(undef);
173 $hdl->on_eof(undef);
174 };
175
176 if (my $proxyhdl = delete $reqstate->{proxyhdl}) {
177 &$shutdown_hdl($proxyhdl);
178 }
179
57f93db1
DM
180 my $hdl = delete $reqstate->{hdl};
181
182 if (!$hdl) {
183 syslog('err', "detected empty handle");
184 return;
185 }
186
89634434
DM
187 print "close connection $hdl\n" if $self->{debug};
188
189 &$shutdown_hdl($hdl);
57f93db1 190
57f93db1
DM
191 $self->{conn_count}--;
192
f91072d5 193 print "$$: CLOSE FH" . $hdl->{fh}->fileno() . " CONN$self->{conn_count}\n" if $self->{debug};
57f93db1
DM
194}
195
196sub finish_response {
197 my ($self, $reqstate) = @_;
198
199 my $hdl = $reqstate->{hdl};
200
23699d1e 201 cleanup_reqstate($reqstate);
d06a1c62 202
57f93db1 203 if (!$self->{end_loop} && $reqstate->{keep_alive} > 0) {
d06a1c62 204 # print "KEEPALIVE $reqstate->{keep_alive}\n" if $self->{debug};
f91072d5 205 $hdl->on_read(sub {
57f93db1
DM
206 eval { $self->push_request_header($reqstate); };
207 warn $@ if $@;
208 });
209 } else {
210 $hdl->on_drain (sub {
f91072d5
DM
211 eval {
212 $self->client_do_disconnect($reqstate);
213 };
57f93db1
DM
214 warn $@ if $@;
215 });
216 }
217}
218
219sub response {
8dc1715b 220 my ($self, $reqstate, $resp, $mtime, $nocomp, $delay) = @_;
57f93db1
DM
221
222 #print "$$: send response: " . Dumper($resp);
223
23699d1e
DM
224 # activate timeout
225 $reqstate->{hdl}->timeout_reset();
226 $reqstate->{hdl}->timeout($self->{timeout});
227
5c495833
DM
228 $nocomp = 1 if !$reqstate->{accept_gzip};
229
57f93db1
DM
230 my $code = $resp->code;
231 my $msg = $resp->message || HTTP::Status::status_message($code);
232 ($msg) = $msg =~m/^(.*)$/m;
233 my $content = $resp->content;
234
235 if ($code =~ /^(1\d\d|[23]04)$/) {
236 # make sure content we have no content
237 $content = "";
238 }
239
88ad4103 240 $reqstate->{keep_alive} = 0 if ($code >= 400) || $self->{end_loop};
57f93db1
DM
241
242 $reqstate->{log}->{code} = $code;
243
1319da81
DM
244 my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.0';
245 my $res = "$proto $code $msg\015\012";
f91072d5 246
57f93db1
DM
247 my $ctime = time();
248 my $date = HTTP::Date::time2str($ctime);
249 $resp->header('Date' => $date);
250 if ($mtime) {
251 $resp->header('Last-Modified' => HTTP::Date::time2str($mtime));
252 } else {
253 $resp->header('Expires' => $date);
254 $resp->header('Cache-Control' => "max-age=0");
255 $resp->header("Pragma", "no-cache");
256 }
257
258 $resp->header('Server' => "pve-api-daemon/3.0");
259
260 my $content_length;
f91072d5 261 if ($content) {
57f93db1
DM
262
263 $content_length = length($content);
264
265 if (!$nocomp && ($content_length > 1024)) {
266 my $comp = Compress::Zlib::memGzip($content);
267 $resp->header('Content-Encoding', 'gzip');
268 $content = $comp;
269 $content_length = length($content);
270 }
271 $resp->header("Content-Length" => $content_length);
272 $reqstate->{log}->{content_length} = $content_length;
f91072d5 273
57f93db1
DM
274 } else {
275 $resp->remove_header("Content-Length");
276 }
f91072d5 277
57f93db1
DM
278 if ($reqstate->{keep_alive} > 0) {
279 $resp->push_header('Connection' => 'Keep-Alive');
280 } else {
281 $resp->header('Connection' => 'close');
282 }
283
284 $res .= $resp->headers_as_string("\015\012");
f91072d5 285 #print "SEND(without content) $res\n" if $self->{debug};
57f93db1
DM
286
287 $res .= "\015\012";
33afb29b 288 $res .= $content if $content;
57f93db1
DM
289
290 $self->log_request($reqstate, $reqstate->{request});
8dc1715b
DM
291
292 if ($delay && $delay > 0) {
293 my $w; $w = AnyEvent->timer(after => $delay, cb => sub {
294 undef $w; # delete reference
295 $reqstate->{hdl}->push_write($res);
296 $self->finish_response($reqstate);
297 });
298 } else {
299 $reqstate->{hdl}->push_write($res);
300 $self->finish_response($reqstate);
301 }
57f93db1
DM
302}
303
304sub error {
305 my ($self, $reqstate, $code, $msg, $hdr, $content) = @_;
306
307 eval {
f91072d5 308 my $resp = HTTP::Response->new($code, $msg, $hdr, $content);
57f93db1
DM
309 $self->response($reqstate, $resp);
310 };
311 warn $@ if $@;
312}
313
314sub send_file_start {
315 my ($self, $reqstate, $filename) = @_;
316
317 eval {
318 # print "SEND FILE $filename\n";
f91072d5 319 # Note: aio_load() this is not really async unless we use IO::AIO!
57f93db1
DM
320 eval {
321
88ad4103
DM
322 my $r = $reqstate->{request};
323
57f93db1
DM
324 my $fh = IO::File->new($filename, '<') ||
325 die "$!\n";
326 my $stat = File::stat::stat($fh) ||
327 die "$!\n";
88ad4103
DM
328
329 my $mtime = $stat->mtime;
330
331 if (my $ifmod = $r->header('if-modified-since')) {
332 my $iftime = HTTP::Date::str2time($ifmod);
333 if ($mtime <= $iftime) {
334 my $resp = HTTP::Response->new(304, "NOT MODIFIED");
335 $self->response($reqstate, $resp, $mtime);
336 return;
337 }
338 }
f91072d5 339
57f93db1
DM
340 my $data;
341 my $len = sysread($fh, $data, $stat->size);
342 die "got short file\n" if !defined($len) || $len != $stat->size;
343
344 my $ct;
0ebf2fa8 345 my $nocomp;
57f93db1
DM
346 if ($filename =~ m/\.css$/) {
347 $ct = 'text/css';
657b2c27
DM
348 } elsif ($filename =~ m/\.html$/) {
349 $ct = 'text/html';
f91072d5 350 } elsif ($filename =~ m/\.js$/) {
57f93db1 351 $ct = 'application/javascript';
f91072d5 352 } elsif ($filename =~ m/\.png$/) {
57f93db1 353 $ct = 'image/png';
0ebf2fa8 354 $nocomp = 1;
e88a5cde
DM
355 } elsif ($filename =~ m/\.ico$/) {
356 $ct = 'image/x-icon';
357 $nocomp = 1;
f91072d5 358 } elsif ($filename =~ m/\.gif$/) {
57f93db1 359 $ct = 'image/gif';
0ebf2fa8 360 $nocomp = 1;
f91072d5 361 } elsif ($filename =~ m/\.jar$/) {
57f93db1 362 $ct = 'application/java-archive';
a49706cb 363 $nocomp = 1;
a9acb2ba
DM
364 } elsif ($filename =~ m/\.woff$/) {
365 $ct = 'application/font-woff';
366 $nocomp = 1;
7a552a9e
EK
367 } elsif ($filename =~ m/\.woff2$/) {
368 $ct = 'application/font-woff2';
369 $nocomp = 1;
a9acb2ba 370 } elsif ($filename =~ m/\.ttf$/) {
7a552a9e 371 $ct = 'application/font-snft';
a9acb2ba 372 $nocomp = 1;
57f93db1
DM
373 } else {
374 die "unable to detect content type";
375 }
376
377 my $header = HTTP::Headers->new(Content_Type => $ct);
f91072d5 378 my $resp = HTTP::Response->new(200, "OK", $header, $data);
0ebf2fa8 379 $self->response($reqstate, $resp, $mtime, $nocomp);
57f93db1
DM
380 };
381 if (my $err = $@) {
382 $self->error($reqstate, 501, $err);
383 }
384 };
f91072d5 385
57f93db1
DM
386 warn $@ if $@;
387}
388
e60b9647
DM
389sub websocket_proxy {
390 my ($self, $reqstate, $wsaccept, $wsproto, $param) = @_;
391
392 eval {
393 my $remhost;
394 my $remport;
395
396 my $max_payload_size = 65536;
397
398 my $binary;
399 if ($wsproto eq 'binary') {
400 $binary = 1;
401 } elsif ($wsproto eq 'base64') {
402 $binary = 0;
403 } else {
404 die "websocket_proxy: unsupported protocol '$wsproto'\n";
405 }
406
407 if ($param->{port}) {
0e007a5d 408 $remhost = 'localhost';
e60b9647
DM
409 $remport = $param->{port};
410 } elsif ($param->{socket}) {
411 $remhost = 'unix/';
412 $remport = $param->{socket};
413 } else {
414 die "websocket_proxy: missing port or socket\n";
415 }
416
417 tcp_connect $remhost, $remport, sub {
418 my ($fh) = @_
419 or die "connect to '$remhost:$remport' failed: $!";
420
421 print "$$: CONNECTed to '$remhost:$remport'\n" if $self->{debug};
422
423 $reqstate->{proxyhdl} = AnyEvent::Handle->new(
424 fh => $fh,
425 rbuf_max => 64*1024,
426 wbuf_max => 64*10*1024,
427 timeout => 5,
428 on_eof => sub {
429 my ($hdl) = @_;
430 eval {
431 $self->log_aborted_request($reqstate);
432 $self->client_do_disconnect($reqstate);
433 };
434 if (my $err = $@) { syslog('err', $err); }
435 },
436 on_error => sub {
437 my ($hdl, $fatal, $message) = @_;
438 eval {
439 $self->log_aborted_request($reqstate, $message);
440 $self->client_do_disconnect($reqstate);
441 };
442 if (my $err = $@) { syslog('err', "$err"); }
443 });
444
445 my $proxyhdlreader = sub {
446 my ($hdl) = @_;
447
448 my $len = length($hdl->{rbuf});
449 my $data = substr($hdl->{rbuf}, 0, $len, '');
450
451 my $string;
452 my $payload;
453
454 if ($binary) {
455 $string = "\x82"; # binary frame
456 $payload = $data;
457 } else {
458 $string = "\x81"; # text frame
459 $payload = encode_base64($data, '');
460 }
461
462 my $payload_len = length($payload);
463 if ($payload_len <= 125) {
464 $string .= pack 'C', $payload_len;
465 } elsif ($payload_len <= 0xffff) {
466 $string .= pack 'C', 126;
467 $string .= pack 'n', $payload_len;
468 } else {
469 $string .= pack 'C', 127;
470 $string .= pack 'Q>', $payload_len;
471 }
472 $string .= $payload;
473
474 $reqstate->{hdl}->push_write($string) if $reqstate->{hdl};
475 };
476
477 my $hdlreader = sub {
478 my ($hdl) = @_;
479
480 my $len = length($hdl->{rbuf});
481 return if $len < 2;
482
483 my $hdr = unpack('C', substr($hdl->{rbuf}, 0, 1));
484 my $opcode = $hdr & 0b00001111;
485 my $fin = $hdr & 0b10000000;
486
487 die "received fragmented websocket frame\n" if !$fin;
488
489 my $rsv = $hdr & 0b01110000;
490 die "received websocket frame with RSV flags\n" if $rsv;
491
492 my $payload_len = unpack 'C', substr($hdl->{rbuf}, 1, 1);
493
494 my $masked = $payload_len & 0b10000000;
495 die "received unmasked websocket frame from client\n" if !$masked;
496
497 my $offset = 2;
498 $payload_len = $payload_len & 0b01111111;
499 if ($payload_len == 126) {
500 return if $len < 4;
501 $payload_len = unpack('n', substr($hdl->{rbuf}, $offset, 2));
502 $offset += 2;
503 } elsif ($payload_len == 127) {
504 return if $len < 10;
505 $payload_len = unpack('Q>', substr($hdl->{rbuf}, $offset, 8));
506 $offset += 8;
507 }
508
509 die "received too large websocket frame (len = $payload_len)\n"
510 if ($payload_len > $max_payload_size) || ($payload_len < 0);
511
512 return if $len < ($offset + 4 + $payload_len);
513
514 my $data = substr($hdl->{rbuf}, 0, $len, ''); # now consume data
515
516 my @mask = (unpack('C', substr($data, $offset+0, 1)),
517 unpack('C', substr($data, $offset+1, 1)),
518 unpack('C', substr($data, $offset+2, 1)),
519 unpack('C', substr($data, $offset+3, 1)));
520
521 $offset += 4;
522
523 my $payload = substr($data, $offset, $payload_len);
524
525 for (my $i = 0; $i < $payload_len; $i++) {
526 my $d = unpack('C', substr($payload, $i, 1));
527 my $n = $d ^ $mask[$i % 4];
528 substr($payload, $i, 1, pack('C', $n));
529 }
530
531 $payload = decode_base64($payload) if !$binary;
532
533 if ($opcode == 1 || $opcode == 2) {
534 $reqstate->{proxyhdl}->push_write($payload) if $reqstate->{proxyhdl};
535 } elsif ($opcode == 8) {
e60b9647 536 print "websocket received close\n" if $self->{debug};
9da32f12
DM
537 if ($reqstate->{proxyhdl}) {
538 $reqstate->{proxyhdl}->push_write($payload);
539 $reqstate->{proxyhdl}->push_shutdown();
540 }
541 $hdl->push_shutdown();
e60b9647
DM
542 } else {
543 die "received unhandled websocket opcode $opcode\n";
544 }
545 };
546
547 my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.1';
548
549 $reqstate->{proxyhdl}->timeout(0);
550 $reqstate->{proxyhdl}->on_read($proxyhdlreader);
551 $reqstate->{hdl}->on_read($hdlreader);
552
553 # todo: use stop_read/start_read if write buffer grows to much
554
555 my $res = "$proto 101 Switching Protocols\015\012" .
556 "Upgrade: websocket\015\012" .
557 "Connection: upgrade\015\012" .
558 "Sec-WebSocket-Accept: $wsaccept\015\012" .
559 "Sec-WebSocket-Protocol: $wsproto\015\012" .
560 "\015\012";
561
562 print $res if $self->{debug};
563
564 $reqstate->{hdl}->push_write($res);
565
566 # log early
567 $reqstate->{log}->{code} = 101;
568 $self->log_request($reqstate);
569 };
570
571 };
572 if (my $err = $@) {
573 warn $err;
574 $self->log_aborted_request($reqstate, $err);
575 $self->client_do_disconnect($reqstate);
576 }
577}
578
57f93db1 579sub proxy_request {
d06a1c62 580 my ($self, $reqstate, $clientip, $host, $method, $uri, $ticket, $token, $params) = @_;
57f93db1
DM
581
582 eval {
583 my $target;
5a68b2b2 584 my $keep_alive = 1;
57f93db1 585 if ($host eq 'localhost') {
d06a1c62 586 $target = "http://$host:85$uri";
5a68b2b2
DM
587 # keep alive for localhost is not worth (connection setup is about 0.2ms)
588 $keep_alive = 0;
232ce267
WB
589 } elsif (Net::IP::ip_is_ipv6($host)) {
590 $target = "https://[$host]:8006$uri";
57f93db1 591 } else {
d06a1c62 592 $target = "https://$host:8006$uri";
57f93db1
DM
593 }
594
595 my $headers = {
596 PVEDisableProxy => 'true',
597 PVEClientIP => $clientip,
598 };
599
57f93db1
DM
600 $headers->{'cookie'} = PVE::REST::create_auth_cookie($ticket) if $ticket;
601 $headers->{'CSRFPreventionToken'} = $token if $token;
5c495833 602 $headers->{'Accept-Encoding'} = 'gzip' if $reqstate->{accept_gzip};
57f93db1
DM
603
604 my $content;
605
606 if ($method eq 'POST' || $method eq 'PUT') {
607 $headers->{'Content-Type'} = 'application/x-www-form-urlencoded';
d06a1c62 608 # use URI object to format application/x-www-form-urlencoded content.
57f93db1
DM
609 my $url = URI->new('http:');
610 $url->query_form(%$params);
611 $content = $url->query;
612 if (defined($content)) {
613 $headers->{'Content-Length'} = length($content);
614 }
615 }
616
57f93db1 617 my $w; $w = http_request(
f91072d5
DM
618 $method => $target,
619 headers => $headers,
620 timeout => 30,
353fef24 621 recurse => 0,
139cb2da 622 proxy => undef, # avoid use of $ENV{HTTP_PROXY}
5a68b2b2 623 keepalive => $keep_alive,
f91072d5 624 body => $content,
353fef24 625 tls_ctx => $self->{tls_ctx},
57f93db1
DM
626 sub {
627 my ($body, $hdr) = @_;
628
629 undef $w;
f91072d5 630
17c8ec64
DM
631 if (!$reqstate->{hdl}) {
632 warn "proxy detected vanished client connection\n";
633 return;
634 }
635
57f93db1
DM
636 eval {
637 my $code = delete $hdr->{Status};
638 my $msg = delete $hdr->{Reason};
639 delete $hdr->{URL};
640 delete $hdr->{HTTPVersion};
641 my $header = HTTP::Headers->new(%$hdr);
7e73c93e
DM
642 if (my $location = $header->header('Location')) {
643 $location =~ s|^http://localhost:85||;
644 $header->header(Location => $location);
645 }
57f93db1 646 my $resp = HTTP::Response->new($code, $msg, $header, $body);
5c495833 647 # Note: disable compression, because body is already compressed
57f93db1
DM
648 $self->response($reqstate, $resp, undef, 1);
649 };
650 warn $@ if $@;
651 });
652 };
653 warn $@ if $@;
654}
655
d06a1c62
DM
656# return arrays as \0 separated strings (like CGI.pm)
657sub decode_urlencoded {
658 my ($data) = @_;
659
660 my $res = {};
661
662 return $res if !$data;
663
664 foreach my $kv (split(/[\&\;]/, $data)) {
665 my ($k, $v) = split(/=/, $kv);
666 $k =~s/\+/ /g;
667 $k =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
668 $v =~s/\+/ /g;
669 $v =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
670
671 if (defined(my $old = $res->{$k})) {
672 $res->{$k} = "$old\0$v";
673 } else {
674 $res->{$k} = $v;
675 }
676 }
677 return $res;
678}
679
f6c357cf 680sub extract_params {
57f93db1
DM
681 my ($r, $method) = @_;
682
d06a1c62 683 my $params = {};
57f93db1
DM
684
685 if ($method eq 'PUT' || $method eq 'POST') {
d06a1c62 686 $params = decode_urlencoded($r->content);
57f93db1
DM
687 }
688
d06a1c62 689 my $query_params = decode_urlencoded($r->url->query());
57f93db1
DM
690
691 foreach my $k (keys %{$query_params}) {
692 $params->{$k} = $query_params->{$k};
693 }
694
695 return PVE::Tools::decode_utf8_parameters($params);
f6c357cf 696}
57f93db1
DM
697
698sub handle_api2_request {
1d7f84a1 699 my ($self, $reqstate, $auth, $method, $path, $upload_state) = @_;
57f93db1
DM
700
701 eval {
702 my $r = $reqstate->{request};
57f93db1 703
d06a1c62 704 my ($rel_uri, $format) = split_abs_uri($path);
3ed61033 705
6fcbe87a 706 my $formatter = get_formatter($format);
3ed61033 707
6fcbe87a 708 if (!defined($formatter)) {
3ed61033 709 $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such uri $rel_uri, $format");
57f93db1
DM
710 return;
711 }
712
d0547f7f 713 #print Dumper($upload_state) if $upload_state;
57f93db1 714
d06a1c62 715 my $rpcenv = $self->{rpcenv};
57f93db1 716
d06a1c62 717 my $params;
57f93db1 718
d06a1c62
DM
719 if ($upload_state) {
720 $params = $upload_state->{params};
721 } else {
f6c357cf 722 $params = extract_params($r, $method);
d06a1c62 723 }
57f93db1 724
d06a1c62 725 delete $params->{_dc}; # remove disable cache parameter
57f93db1 726
d06a1c62 727 my $clientip = $reqstate->{peer_host};
57f93db1 728
d06a1c62 729 $rpcenv->init_request();
57f93db1 730
d06a1c62 731 my $res = PVE::REST::rest_handler($rpcenv, $clientip, $method, $rel_uri, $auth, $params);
57f93db1 732
23699d1e
DM
733 AnyEvent->now_update(); # in case somebody called sleep()
734
57f93db1
DM
735 $rpcenv->set_user(undef); # clear after request
736
e60b9647 737 my $upgrade = $r->header('upgrade');
a47df3e4 738 $upgrade = lc($upgrade) if $upgrade;
e60b9647 739
40ca6e9c 740 if (my $host = $res->{proxy}) {
57f93db1
DM
741
742 if ($self->{trusted_env}) {
743 $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy not allowed");
744 return;
f91072d5 745 }
57f93db1 746
40ca6e9c 747 if ($host ne 'localhost' && $r->header('PVEDisableProxy')) {
f2c8b269
DM
748 $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy loop detected");
749 return;
750 }
751
d06a1c62
DM
752 $res->{proxy_params}->{tmpfilename} = $reqstate->{tmpfilename} if $upload_state;
753
40ca6e9c 754 $self->proxy_request($reqstate, $clientip, $host, $method,
d06a1c62 755 $r->uri, $auth->{ticket}, $auth->{token}, $res->{proxy_params});
57f93db1
DM
756 return;
757
e60b9647 758 } elsif ($upgrade && ($method eq 'GET') && ($path =~ m|websocket$|)) {
a47df3e4 759 die "unable to upgrade to protocol '$upgrade'\n" if !$upgrade || ($upgrade ne 'websocket');
e60b9647
DM
760 my $wsver = $r->header('sec-websocket-version');
761 die "unsupported websocket-version '$wsver'\n" if !$wsver || ($wsver ne '13');
762 my $wsproto_str = $r->header('sec-websocket-protocol');
763 die "missing websocket-protocol header" if !$wsproto_str;
764 my $wsproto;
765 foreach my $p (PVE::Tools::split_list($wsproto_str)) {
766 $wsproto = $p if !$wsproto && $p eq 'base64';
767 $wsproto = $p if $p eq 'binary';
768 }
769 die "unsupported websocket-protocol protocol '$wsproto_str'\n" if !$wsproto;
770 my $wskey = $r->header('sec-websocket-key');
771 die "missing websocket-key\n" if !$wskey;
772 # Note: Digest::SHA::sha1_base64 has wrong padding
773 my $wsaccept = Digest::SHA::sha1_base64("${wskey}258EAFA5-E914-47DA-95CA-C5AB0DC85B11") . "=";
774 if ($res->{status} == HTTP_OK) {
775 $self->websocket_proxy($reqstate, $wsaccept, $wsproto, $res->{data});
776 return;
777 }
57f93db1
DM
778 }
779
8dc1715b
DM
780 my $delay = 0;
781 if ($res->{status} == HTTP_UNAUTHORIZED) {
782 # always delay unauthorized calls by 3 seconds
783 $delay = 3 - tv_interval($reqstate->{starttime});
784 $delay = 0 if $delay < 0;
785 }
786
6fcbe87a
DM
787 if ($res->{info} && $res->{info}->{formatter}) {
788 if (defined(my $func = $res->{info}->{formatter}->{$format})) {
789 $formatter = $func;
3ed61033
DM
790 }
791 }
792
7e73c93e 793 my ($raw, $ct, $nocomp) = &$formatter($res, $res->{data}, $params, $path, $auth);
3ed61033 794
c9c0cd34
DM
795 my $resp;
796 if (ref($raw) && (ref($raw) eq 'HTTP::Response')) {
797 $resp = $raw;
798 } else {
799 $resp = HTTP::Response->new($res->{status}, $res->{message});
800 $resp->header("Content-Type" => $ct);
801 $resp->content($raw);
802 }
8dc1715b 803 $self->response($reqstate, $resp, undef, $nocomp, $delay);
57f93db1 804 };
d06a1c62
DM
805 if (my $err = $@) {
806 $self->error($reqstate, 501, $err);
807 }
57f93db1
DM
808}
809
33afb29b 810sub handle_spice_proxy_request {
89634434 811 my ($self, $reqstate, $connect_str, $vmid, $node, $spiceport) = @_;
33afb29b
DM
812
813 eval {
814
f60bd577
AD
815 die "Port $spiceport is not allowed" if ($spiceport < 61000 || $spiceport > 61099);
816
c3b83ed1
DM
817 my $rpcenv = $self->{rpcenv};
818 $rpcenv->init_request();
819
f2c8b269
DM
820 my $clientip = $reqstate->{peer_host};
821 my $r = $reqstate->{request};
822
33afb29b
DM
823 my $remip;
824
ce429a15 825 if ($node ne 'localhost' && PVE::INotify::nodename() !~ m/^$node$/i) {
33afb29b 826 $remip = PVE::Cluster::remote_node_ip($node);
89634434
DM
827 die "unable to get remote IP address for node '$node'\n" if !$remip;
828 print "REMOTE CONNECT $vmid, $remip, $connect_str\n" if $self->{debug};
829 } else {
830 print "$$: CONNECT $vmid, $node, $spiceport\n" if $self->{debug};
831 }
33afb29b 832
64363f40 833 if ($remip && $r->header('PVEDisableProxy')) {
f2c8b269
DM
834 $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy loop detected");
835 return;
836 }
837
33afb29b 838 $reqstate->{hdl}->timeout(0);
89634434 839 $reqstate->{hdl}->wbuf_max(64*10*1024);
33afb29b 840
0e007a5d 841 my $remhost = $remip ? $remip : "localhost";
89634434 842 my $remport = $remip ? 3128 : $spiceport;
33afb29b 843
89634434 844 tcp_connect $remhost, $remport, sub {
33afb29b 845 my ($fh) = @_
89634434 846 or die "connect to '$remhost:$remport' failed: $!";
33afb29b 847
89634434 848 print "$$: CONNECTed to '$remhost:$remport'\n" if $self->{debug};
33afb29b
DM
849 $reqstate->{proxyhdl} = AnyEvent::Handle->new(
850 fh => $fh,
851 rbuf_max => 64*1024,
852 wbuf_max => 64*10*1024,
89634434 853 timeout => 5,
33afb29b
DM
854 on_eof => sub {
855 my ($hdl) = @_;
856 eval {
857 $self->log_aborted_request($reqstate);
858 $self->client_do_disconnect($reqstate);
859 };
860 if (my $err = $@) { syslog('err', $err); }
861 },
862 on_error => sub {
863 my ($hdl, $fatal, $message) = @_;
864 eval {
865 $self->log_aborted_request($reqstate, $message);
866 $self->client_do_disconnect($reqstate);
867 };
868 if (my $err = $@) { syslog('err', "$err"); }
cffad904 869 });
33afb29b 870
89634434 871
cffad904
DM
872 my $proxyhdlreader = sub {
873 my ($hdl) = @_;
33afb29b 874
cffad904
DM
875 my $len = length($hdl->{rbuf});
876 my $data = substr($hdl->{rbuf}, 0, $len, '');
877
878 #print "READ1 $len\n";
879 $reqstate->{hdl}->push_write($data) if $reqstate->{hdl};
880 };
881
882 my $hdlreader = sub {
33afb29b
DM
883 my ($hdl) = @_;
884
885 my $len = length($hdl->{rbuf});
886 my $data = substr($hdl->{rbuf}, 0, $len, '');
887
888 #print "READ0 $len\n";
889 $reqstate->{proxyhdl}->push_write($data) if $reqstate->{proxyhdl};
cffad904
DM
890 };
891
89634434 892 my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.0';
33afb29b 893
89634434
DM
894 my $startproxy = sub {
895 $reqstate->{proxyhdl}->timeout(0);
896 $reqstate->{proxyhdl}->on_read($proxyhdlreader);
897 $reqstate->{hdl}->on_read($hdlreader);
33afb29b 898
89634434 899 # todo: use stop_read/start_read if write buffer grows to much
33afb29b 900
89634434
DM
901 my $res = "$proto 200 OK\015\012"; # hope this is the right answer?
902 $reqstate->{hdl}->push_write($res);
903
904 # log early
905 $reqstate->{log}->{code} = 200;
906 $self->log_request($reqstate);
907 };
908
909 if ($remip) {
910 my $header = "CONNECT ${connect_str} $proto\015\012" .
911 "Host: ${connect_str}\015\012" .
912 "Proxy-Connection: keep-alive\015\012" .
913 "User-Agent: spiceproxy\015\012" .
f2c8b269
DM
914 "PVEDisableProxy: true\015\012" .
915 "PVEClientIP: $clientip\015\012" .
89634434 916 "\015\012";
f2c8b269 917
89634434
DM
918 $reqstate->{proxyhdl}->push_write($header);
919 $reqstate->{proxyhdl}->push_read(line => sub {
920 my ($hdl, $line) = @_;
921
922 if ($line =~ m!^$proto 200 OK$!) {
923 &$startproxy();
924 } else {
925 $reqstate->{hdl}->push_write($line);
926 $self->client_do_disconnect($reqstate);
927 }
928 });
929 } else {
930 &$startproxy();
931 }
8d5310c1 932
33afb29b
DM
933 };
934 };
935 if (my $err = $@) {
94c803f4 936 warn $err;
33afb29b
DM
937 $self->log_aborted_request($reqstate, $err);
938 $self->client_do_disconnect($reqstate);
939 }
940}
941
57f93db1 942sub handle_request {
1d7f84a1 943 my ($self, $reqstate, $auth, $method, $path) = @_;
57f93db1
DM
944
945 eval {
946 my $r = $reqstate->{request};
23699d1e
DM
947
948 # disable timeout on handle (we already have all data we need)
949 # we re-enable timeout in response()
950 $reqstate->{hdl}->timeout(0);
57f93db1 951
d06a1c62 952 if ($path =~ m!$baseuri!) {
1d7f84a1 953 $self->handle_api2_request($reqstate, $auth, $method, $path);
57f93db1
DM
954 return;
955 }
956
957 if ($self->{pages} && ($method eq 'GET') && (my $handler = $self->{pages}->{$path})) {
958 if (ref($handler) eq 'CODE') {
d06a1c62
DM
959 my $params = decode_urlencoded($r->url->query());
960 my ($resp, $userid) = &$handler($self, $reqstate->{request}, $params);
57f93db1
DM
961 $self->response($reqstate, $resp);
962 } elsif (ref($handler) eq 'HASH') {
963 if (my $filename = $handler->{file}) {
964 my $fh = IO::File->new($filename) ||
965 die "unable to open file '$filename' - $!\n";
966 send_file_start($self, $reqstate, $filename);
967 } else {
968 die "internal error - no handler";
969 }
970 } else {
971 die "internal error - no handler";
972 }
973 return;
f91072d5 974 }
57f93db1
DM
975
976 if ($self->{dirs} && ($method eq 'GET')) {
977 # we only allow simple names
978 if ($path =~ m!^(/\S+/)([a-zA-Z0-9\-\_\.]+)$!) {
979 my ($subdir, $file) = ($1, $2);
980 if (my $dir = $self->{dirs}->{$subdir}) {
981 my $filename = "$dir$file";
982 my $fh = IO::File->new($filename) ||
983 die "unable to open file '$filename' - $!\n";
984 send_file_start($self, $reqstate, $filename);
985 return;
986 }
987 }
988 }
989
990 die "no such file '$path'";
991 };
992 if (my $err = $@) {
993 $self->error($reqstate, 501, $err);
994 }
995}
996
d06a1c62 997sub file_upload_multipart {
1d7f84a1 998 my ($self, $reqstate, $auth, $method, $path, $rstate) = @_;
d06a1c62
DM
999
1000 eval {
1001 my $boundary = $rstate->{boundary};
1002 my $hdl = $reqstate->{hdl};
1003
1004 my $startlen = length($hdl->{rbuf});
1005
1006 if ($rstate->{phase} == 0) { # skip everything until start
1007 if ($hdl->{rbuf} =~ s/^.*?--\Q$boundary\E \015?\012
1008 ((?:[^\015]+\015\012)* ) \015?\012//xs) {
1009 my $header = $1;
1010 my ($ct, $disp, $name, $filename);
1011 foreach my $line (split(/\015?\012/, $header)) {
1012 # assume we have single line headers
1013 if ($line =~ m/^Content-Type\s*:\s*(.*)/i) {
1014 $ct = parse_content_type($1);
1015 } elsif ($line =~ m/^Content-Disposition\s*:\s*(.*)/i) {
1016 ($disp, $name, $filename) = parse_content_disposition($1);
1017 }
1018 }
1019
1020 if (!($disp && $disp eq 'form-data' && $name)) {
a81182b0 1021 syslog('err', "wrong content disposition in multipart - abort upload");
d06a1c62
DM
1022 $rstate->{phase} = -1;
1023 } else {
1024
1025 $rstate->{fieldname} = $name;
1026
a81182b0
DM
1027 if ($filename) {
1028 if ($name eq 'filename') {
1029 # found file upload data
1030 $rstate->{phase} = 1;
1031 $rstate->{filename} = $filename;
1032 } else {
1033 syslog('err', "wrong field name for file upload - abort upload");
1034 $rstate->{phase} = -1;
1035 }
1036 } else {
d06a1c62
DM
1037 # found form data for field $name
1038 $rstate->{phase} = 2;
d06a1c62
DM
1039 }
1040 }
1041 } else {
1042 my $len = length($hdl->{rbuf});
1043 substr($hdl->{rbuf}, 0, $len - $rstate->{maxheader}, '')
1044 if $len > $rstate->{maxheader}; # skip garbage
1045 }
1046 } elsif ($rstate->{phase} == 1) { # inside file - dump until end marker
1047 if ($hdl->{rbuf} =~ s/^(.*?)\015?\012(--\Q$boundary\E(--)? \015?\012(.*))$/$2/xs) {
1048 my ($rest, $eof) = ($1, $3);
1049 my $len = length($rest);
1050 die "write to temporary file failed - $!"
1051 if syswrite($rstate->{outfh}, $rest) != $len;
1052 $rstate->{ctx}->add($rest);
1053 $rstate->{params}->{filename} = $rstate->{filename};
1054 $rstate->{md5sum} = $rstate->{ctx}->hexdigest;
1055 $rstate->{bytes} += $len;
1056 $rstate->{phase} = $eof ? 100 : 0;
1057 } else {
1058 my $len = length($hdl->{rbuf});
1059 my $wlen = $len - $rstate->{boundlen};
1060 if ($wlen > 0) {
2c32df36 1061 my $data = substr($hdl->{rbuf}, 0, $wlen, '');
d06a1c62
DM
1062 die "write to temporary file failed - $!"
1063 if syswrite($rstate->{outfh}, $data) != $wlen;
1064 $rstate->{bytes} += $wlen;
1065 $rstate->{ctx}->add($data);
1066 }
1067 }
1068 } elsif ($rstate->{phase} == 2) { # inside normal field
1069
1070 if ($hdl->{rbuf} =~ s/^(.*?)\015?\012(--\Q$boundary\E(--)? \015?\012(.*))$/$2/xs) {
1071 my ($rest, $eof) = ($1, $3);
1072 my $len = length($rest);
209b203e
DM
1073 $rstate->{post_size} += $len;
1074 if ($rstate->{post_size} < $limit_max_post) {
d06a1c62
DM
1075 $rstate->{params}->{$rstate->{fieldname}} = $rest;
1076 $rstate->{phase} = $eof ? 100 : 0;
1077 } else {
209b203e 1078 syslog('err', "form data to large - abort upload");
d06a1c62
DM
1079 $rstate->{phase} = -1; # skip
1080 }
1081 }
1082 } else { # skip
1083 my $len = length($hdl->{rbuf});
1084 substr($hdl->{rbuf}, 0, $len, ''); # empty rbuf
1085 }
1086
1087 $rstate->{read} += ($startlen - length($hdl->{rbuf}));
1088
1089 if (!$rstate->{done} && ($rstate->{read} + length($hdl->{rbuf})) >= $rstate->{size}) {
1090 $rstate->{done} = 1; # make sure we dont get called twice
1091 if ($rstate->{phase} < 0 || !$rstate->{md5sum}) {
f6c357cf 1092 die "upload failed\n";
d06a1c62
DM
1093 } else {
1094 my $elapsed = tv_interval($rstate->{starttime});
1095
1096 my $rate = int($rstate->{bytes}/($elapsed*1024*1024));
1097 syslog('info', "multipart upload complete " .
2c32df36
DM
1098 "(size: %d time: %ds rate: %.2fMiB/s md5sum: $rstate->{md5sum})",
1099 $rstate->{bytes}, $elapsed, $rate);
1d7f84a1 1100 $self->handle_api2_request($reqstate, $auth, $method, $path, $rstate);
d06a1c62
DM
1101 }
1102 }
1103 };
1104 if (my $err = $@) {
2c32df36 1105 syslog('err', $err);
d06a1c62
DM
1106 $self->error($reqstate, 501, $err);
1107 }
1108}
1109
1110sub parse_content_type {
1111 my ($ctype) = @_;
1112
1113 my ($ct, @params) = split(/\s*[;,]\s*/o, $ctype);
1114
1115 foreach my $v (@params) {
1116 if ($v =~ m/^\s*boundary\s*=\s*(\S+?)\s*$/o) {
1117 return wantarray ? ($ct, $1) : $ct;
1118 }
1119 }
1120
1121 return wantarray ? ($ct) : $ct;
1122}
1123
1124sub parse_content_disposition {
1125 my ($line) = @_;
1126
1127 my ($disp, @params) = split(/\s*[;,]\s*/o, $line);
1128 my $name;
1129 my $filename;
1130
1131 foreach my $v (@params) {
1132 if ($v =~ m/^\s*name\s*=\s*(\S+?)\s*$/o) {
1133 $name = $1;
1134 $name =~ s/^"(.*)"$/$1/;
e3110298 1135 } elsif ($v =~ m/^\s*filename\s*=\s*(.+?)\s*$/o) {
d06a1c62
DM
1136 $filename = $1;
1137 $filename =~ s/^"(.*)"$/$1/;
1138 }
1139 }
1140
1141 return wantarray ? ($disp, $name, $filename) : $disp;
1142}
1143
1144my $tmpfile_seq_no = 0;
1145
1146sub get_upload_filename {
1147 # choose unpredictable tmpfile name
1148
1149 $tmpfile_seq_no++;
1150 return "/var/tmp/pveupload-" . Digest::MD5::md5_hex($tmpfile_seq_no . time() . $$);
1151}
1152
57f93db1
DM
1153sub unshift_read_header {
1154 my ($self, $reqstate, $state) = @_;
1155
209b203e 1156 $state = { size => 0, count => 0 } if !$state;
57f93db1
DM
1157
1158 $reqstate->{hdl}->unshift_read(line => sub {
1159 my ($hdl, $line) = @_;
1160
1161 eval {
209b203e
DM
1162 # print "$$: got header: $line\n" if $self->{debug};
1163
1164 die "to many http header lines\n" if ++$state->{count} >= $limit_max_headers;
1165 die "http header too large\n" if ($state->{size} += length($line)) >= $limit_max_header_size;
57f93db1
DM
1166
1167 my $r = $reqstate->{request};
1168 if ($line eq '') {
1169
1d7f84a1 1170 my $path = uri_unescape($r->uri->path());
d06a1c62
DM
1171 my $method = $r->method();
1172
57f93db1
DM
1173 $r->push_header($state->{key}, $state->{val})
1174 if $state->{key};
1175
d06a1c62
DM
1176 if (!$known_methods->{$method}) {
1177 my $resp = HTTP::Response->new(HTTP_NOT_IMPLEMENTED, "method '$method' not available");
1178 $self->response($reqstate, $resp);
1179 return;
1180 }
1181
57f93db1 1182 my $conn = $r->header('Connection');
5c495833
DM
1183 my $accept_enc = $r->header('Accept-Encoding');
1184 $reqstate->{accept_gzip} = ($accept_enc && $accept_enc =~ m/gzip/) ? 1 : 0;
57f93db1
DM
1185
1186 if ($conn) {
1187 $reqstate->{keep_alive} = 0 if $conn =~ m/close/oi;
1188 } else {
1189 if ($reqstate->{proto}->{ver} < 1001) {
1190 $reqstate->{keep_alive} = 0;
1191 }
1192 }
1193
57f93db1 1194 my $te = $r->header('Transfer-Encoding');
d06a1c62
DM
1195 if ($te && lc($te) eq 'chunked') {
1196 # Handle chunked transfer encoding
1197 $self->error($reqstate, 501, "chunked transfer encoding not supported");
1198 return;
1199 } elsif ($te) {
1200 $self->error($reqstate, 501, "Unknown transfer encoding '$te'");
1201 return;
1202 }
1203
57f93db1
DM
1204 my $pveclientip = $r->header('PVEClientIP');
1205
f91072d5 1206 # fixme: how can we make PVEClientIP header trusted?
57f93db1
DM
1207 if ($self->{trusted_env} && $pveclientip) {
1208 $reqstate->{peer_host} = $pveclientip;
1209 } else {
1210 $r->header('PVEClientIP', $reqstate->{peer_host});
1211 }
1212
d06a1c62
DM
1213 my $len = $r->header('Content-Length');
1214
1215 # header processing complete - authenticate now
1216
1217 my $auth = {};
33afb29b
DM
1218 if ($self->{spiceproxy}) {
1219 my $connect_str = $r->header('Host');
8a223d4f 1220 my ($vmid, $node, $port) = PVE::AccessControl::verify_spice_connect_url($connect_str);
e1bae24c 1221 if (!(defined($vmid) && $node && $port)) {
33afb29b
DM
1222 $self->error($reqstate, HTTP_UNAUTHORIZED, "invalid ticket");
1223 return;
1224 }
89634434 1225 $self->handle_spice_proxy_request($reqstate, $connect_str, $vmid, $node, $port);
33afb29b
DM
1226 return;
1227 } elsif ($path =~ m!$baseuri!) {
d06a1c62
DM
1228 my $token = $r->header('CSRFPreventionToken');
1229 my $cookie = $r->header('Cookie');
1230 my $ticket = PVE::REST::extract_auth_cookie($cookie);
1231
1232 my ($rel_uri, $format) = split_abs_uri($path);
1233 if (!$format) {
1234 $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such uri");
1235 return;
1236 }
1237
1238 eval {
1239 $auth = PVE::REST::auth_handler($self->{rpcenv}, $reqstate->{peer_host}, $method,
1240 $rel_uri, $ticket, $token);
1241 };
1242 if (my $err = $@) {
3ed61033
DM
1243 # always delay unauthorized calls by 3 seconds
1244 my $delay = 3;
6fcbe87a
DM
1245 if (my $formatter = get_login_formatter($format)) {
1246 my ($raw, $ct, $nocomp) = &$formatter($path, $auth);
3ed61033
DM
1247 my $resp;
1248 if (ref($raw) && (ref($raw) eq 'HTTP::Response')) {
1249 $resp = $raw;
1250 } else {
1251 $resp = HTTP::Response->new(HTTP_UNAUTHORIZED, "Login Required");
1252 $resp->header("Content-Type" => $ct);
1253 $resp->content($raw);
1254 }
1255 $self->response($reqstate, $resp, undef, $nocomp, 3);
1256 } else {
1257 my $resp = HTTP::Response->new(HTTP_UNAUTHORIZED, $err);
1258 $self->response($reqstate, $resp, undef, 0, $delay);
1259 }
d06a1c62
DM
1260 return;
1261 }
1262 }
1263
1264 $reqstate->{log}->{userid} = $auth->{userid};
1265
e66d68a9 1266 if ($len) {
d06a1c62
DM
1267
1268 if (!($method eq 'PUT' || $method eq 'POST')) {
1269 $self->error($reqstate, 501, "Unexpected content for method '$method'");
1270 return;
1271 }
1272
1273 my $ctype = $r->header('Content-Type');
d0547f7f 1274 my ($ct, $boundary) = parse_content_type($ctype) if $ctype;
d06a1c62
DM
1275
1276 if ($auth->{isUpload} && !$self->{trusted_env}) {
1277 die "upload 'Content-Type '$ctype' not implemented\n"
d0547f7f 1278 if !($boundary && $ct && ($ct eq 'multipart/form-data'));
d06a1c62
DM
1279
1280 die "upload without content length header not supported" if !$len;
1281
1282 die "upload without content length header not supported" if !$len;
1283
1284 print "start upload $path $ct $boundary\n" if $self->{debug};
1285
1286 my $tmpfilename = get_upload_filename();
1287 my $outfh = IO::File->new($tmpfilename, O_RDWR|O_CREAT|O_EXCL, 0600) ||
1288 die "unable to create temporary upload file '$tmpfilename'";
1289
1290 $reqstate->{keep_alive} = 0;
1291
1292 my $boundlen = length($boundary) + 8; # \015?\012--$boundary--\015?\012
1293
1294 my $state = {
1295 size => $len,
1296 boundary => $boundary,
1297 ctx => Digest::MD5->new,
1298 boundlen => $boundlen,
1299 maxheader => 2048 + $boundlen, # should be large enough
1300 params => decode_urlencoded($r->url->query()),
1301 phase => 0,
1302 read => 0,
209b203e 1303 post_size => 0,
d06a1c62
DM
1304 starttime => [gettimeofday],
1305 outfh => $outfh,
1306 };
1307 $reqstate->{tmpfilename} = $tmpfilename;
1d7f84a1 1308 $reqstate->{hdl}->on_read(sub { $self->file_upload_multipart($reqstate, $auth, $method, $path, $state); });
d06a1c62
DM
1309 return;
1310 }
1311
209b203e
DM
1312 if ($len > $limit_max_post) {
1313 $self->error($reqstate, 501, "for data too large");
1314 return;
1315 }
1316
d06a1c62
DM
1317 if (!$ct || $ct eq 'application/x-www-form-urlencoded') {
1318 $reqstate->{hdl}->unshift_read(chunk => $len, sub {
1319 my ($hdl, $data) = @_;
1320 $r->content($data);
1d7f84a1 1321 $self->handle_request($reqstate, $auth, $method, $path);
d06a1c62
DM
1322 });
1323 } else {
1324 $self->error($reqstate, 506, "upload 'Content-Type '$ctype' not implemented");
1325 }
57f93db1 1326 } else {
1d7f84a1 1327 $self->handle_request($reqstate, $auth, $method, $path);
57f93db1
DM
1328 }
1329 } elsif ($line =~ /^([^:\s]+)\s*:\s*(.*)/) {
1330 $r->push_header($state->{key}, $state->{val}) if $state->{key};
1331 ($state->{key}, $state->{val}) = ($1, $2);
1332 $self->unshift_read_header($reqstate, $state);
1333 } elsif ($line =~ /^\s+(.*)/) {
1334 $state->{val} .= " $1";
1335 $self->unshift_read_header($reqstate, $state);
1336 } else {
1337 $self->error($reqstate, 506, "unable to parse request header");
1338 }
1339 };
1340 warn $@ if $@;
1341 });
1342};
1343
1344sub push_request_header {
1345 my ($self, $reqstate) = @_;
1346
1347 eval {
1348 $reqstate->{hdl}->push_read(line => sub {
1349 my ($hdl, $line) = @_;
1350
1351 eval {
89634434 1352 # print "got request header: $line\n" if $self->{debug};
f91072d5 1353
57f93db1
DM
1354 $reqstate->{keep_alive}--;
1355
1356 if ($line =~ /(\S+)\040(\S+)\040HTTP\/(\d+)\.(\d+)/o) {
9195c8f9 1357 my ($method, $url, $maj, $min) = ($1, $2, $3, $4);
57f93db1
DM
1358
1359 if ($maj != 1) {
1360 $self->error($reqstate, 506, "http protocol version $maj.$min not supported");
1361 return;
1362 }
1363
1364 $self->{request_count}++; # only count valid request headers
1365 if ($self->{request_count} >= $self->{max_requests}) {
f91072d5 1366 $self->{end_loop} = 1;
57f93db1
DM
1367 }
1368 $reqstate->{log} = { requestline => $line };
d0547f7f 1369 $reqstate->{proto}->{str} = "HTTP/$maj.$min";
57f93db1
DM
1370 $reqstate->{proto}->{maj} = $maj;
1371 $reqstate->{proto}->{min} = $min;
1372 $reqstate->{proto}->{ver} = $maj*1000+$min;
1d7f84a1 1373 $reqstate->{request} = HTTP::Request->new($method, $url);
8dc1715b 1374 $reqstate->{starttime} = [gettimeofday],
57f93db1
DM
1375
1376 $self->unshift_read_header($reqstate);
1377 } elsif ($line eq '') {
1378 # ignore empty lines before requests (browser bugs?)
1379 $self->push_request_header($reqstate);
1380 } else {
1381 $self->error($reqstate, 400, 'bad request');
1382 }
1383 };
1384 warn $@ if $@;
1385 });
1386 };
1387 warn $@ if $@;
1388}
1389
1390sub accept {
1391 my ($self) = @_;
1392
1393 my $clientfh;
1394
1395 return if $self->{end_loop};
1396
1397 # we need to m make sure that only one process calls accept
1398 while (!flock($self->{lockfh}, Fcntl::LOCK_EX())) {
1399 next if $! == EINTR;
1400 die "could not get lock on file '$self->{lockfile}' - $!\n";
1401 }
1402
1403 my $again = 0;
1404 my $errmsg;
1405 eval {
1406 while (!$self->{end_loop} &&
1407 !defined($clientfh = $self->{socket}->accept()) &&
1408 ($! == EINTR)) {};
1409
1410 if ($self->{end_loop}) {
1411 $again = 0;
1412 } else {
1413 $again = ($! == EAGAIN || $! == WSAEWOULDBLOCK);
1414 if (!defined($clientfh)) {
1415 $errmsg = "failed to accept connection: $!\n";
1416 }
1417 }
1418 };
1419 warn $@ if $@;
1420
1421 flock($self->{lockfh}, Fcntl::LOCK_UN());
1422
1423 if (!defined($clientfh)) {
1424 return if $again;
1425 die $errmsg if $errmsg;
1426 }
1427
f91072d5 1428 fh_nonblocking $clientfh, 1;
57f93db1
DM
1429
1430 $self->{conn_count}++;
1431
57f93db1
DM
1432 return $clientfh;
1433}
1434
1435sub wait_end_loop {
1436 my ($self) = @_;
1437
1438 $self->{end_loop} = 1;
1439
1440 undef $self->{socket_watch};
f91072d5 1441
81733604
DM
1442 $0 = "$0 (shutdown)" if $0 !~ m/\(shutdown\)$/;
1443
57f93db1
DM
1444 if ($self->{conn_count} <= 0) {
1445 $self->{end_cond}->send(1);
1446 return;
1447 }
1448
9cad08ca
DM
1449 # fork and exit, so that parent starts a new worker
1450 if (fork()) {
1451 exit(0);
1452 }
1453
57f93db1
DM
1454 # else we need to wait until all open connections gets closed
1455 my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub {
1456 eval {
f91072d5 1457 # todo: test for active connections instead (we can abort idle connections)
57f93db1
DM
1458 if ($self->{conn_count} <= 0) {
1459 undef $w;
1460 $self->{end_cond}->send(1);
1461 }
1462 };
1463 warn $@ if $@;
1464 });
1465}
f91072d5 1466
a908636e
DM
1467
1468sub check_host_access {
1469 my ($self, $clientip) = @_;
1470
1471 my $cip = Net::IP->new($clientip);
1472
1473 my $match_allow = 0;
1474 my $match_deny = 0;
1475
1476 if ($self->{allow_from}) {
1477 foreach my $t (@{$self->{allow_from}}) {
1478 if ($t->overlaps($cip)) {
1479 $match_allow = 1;
1480 last;
1481 }
1482 }
1483 }
1484
1485 if ($self->{deny_from}) {
1486 foreach my $t (@{$self->{deny_from}}) {
1487 if ($t->overlaps($cip)) {
1488 $match_deny = 1;
1489 last;
1490 }
1491 }
1492 }
1493
1494 if ($match_allow == $match_deny) {
1495 # match both allow and deny, or no match
1496 return $self->{policy} && $self->{policy} eq 'allow' ? 1 : 0;
1497 }
1498
1499 return $match_allow;
1500}
1501
57f93db1
DM
1502sub accept_connections {
1503 my ($self) = @_;
1504
1505 eval {
1506
1507 while (my $clientfh = $self->accept()) {
1508
1509 my $reqstate = { keep_alive => $self->{keep_alive} };
1510
02667982
DM
1511 # stop keep-alive when there are many open connections
1512 if ($self->{conn_count} >= $self->{max_conn_soft_limit}) {
1513 $reqstate->{keep_alive} = 0;
1514 }
1515
57f93db1 1516 if (my $sin = getpeername($clientfh)) {
09316f4c
WB
1517 my ($pfamily, $pport, $phost) = PVE::Tools::unpack_sockaddr_in46($sin);
1518 ($reqstate->{peer_port}, $reqstate->{peer_host}) = ($pport, Socket::inet_ntop($pfamily, $phost));
57f93db1
DM
1519 }
1520
a908636e
DM
1521 if (!$self->{trusted_env} && !$self->check_host_access($reqstate->{peer_host})) {
1522 print "$$: ABORT request from $reqstate->{peer_host} - access denied\n" if $self->{debug};
1523 $reqstate->{log}->{code} = 403;
1524 $self->log_request($reqstate);
1525 next;
1526 }
1527
57f93db1
DM
1528 $reqstate->{hdl} = AnyEvent::Handle->new(
1529 fh => $clientfh,
d06a1c62 1530 rbuf_max => 64*1024,
57f93db1
DM
1531 timeout => $self->{timeout},
1532 linger => 0, # avoid problems with ssh - really needed ?
1533 on_eof => sub {
1534 my ($hdl) = @_;
1535 eval {
1536 $self->log_aborted_request($reqstate);
1537 $self->client_do_disconnect($reqstate);
1538 };
1539 if (my $err = $@) { syslog('err', $err); }
1540 },
f91072d5 1541 on_error => sub {
57f93db1
DM
1542 my ($hdl, $fatal, $message) = @_;
1543 eval {
1544 $self->log_aborted_request($reqstate, $message);
1545 $self->client_do_disconnect($reqstate);
1546 };
1547 if (my $err = $@) { syslog('err', "$err"); }
1548 },
1549 ($self->{tls_ctx} ? (tls => "accept", tls_ctx => $self->{tls_ctx}) : ()));
1550
f91072d5 1551 print "$$: ACCEPT FH" . $clientfh->fileno() . " CONN$self->{conn_count}\n" if $self->{debug};
57f93db1
DM
1552
1553 $self->push_request_header($reqstate);
1554 }
1555 };
1556
1557 if (my $err = $@) {
1558 syslog('err', $err);
1559 $self->{end_loop} = 1;
1560 }
1561
1562 $self->wait_end_loop() if $self->{end_loop};
1563}
1564
c2e9823c
DM
1565# Note: We can't open log file in non-blocking mode and use AnyEvent::Handle,
1566# because we write from multiple processes, and that would arbitrarily mix output
f91072d5 1567# of all processes.
57f93db1
DM
1568sub open_access_log {
1569 my ($self, $filename) = @_;
1570
1571 my $old_mask = umask(0137);;
1572 my $logfh = IO::File->new($filename, ">>") ||
1573 die "unable to open log file '$filename' - $!\n";
1574 umask($old_mask);
1575
c2e9823c
DM
1576 $logfh->autoflush(1);
1577
1578 $self->{logfh} = $logfh;
1579}
1580
1581sub write_log {
1582 my ($self, $data) = @_;
1583
1584 return if !defined($self->{logfh}) || !$data;
1585
1586 my $res = $self->{logfh}->print($data);
1587
1588 if (!$res) {
1589 delete $self->{logfh};
1590 syslog('err', "error writing access log");
1591 $self->{end_loop} = 1; # terminate asap
1592 }
57f93db1
DM
1593}
1594
353fef24
DM
1595sub atfork_handler {
1596 my ($self) = @_;
1597
1598 eval {
1599 # something else do to ?
1600 close($self->{socket});
1601 };
1602 warn $@ if $@;
1603}
1604
57f93db1
DM
1605sub new {
1606 my ($this, %args) = @_;
1607
1608 my $class = ref($this) || $this;
1609
d804d82f 1610 foreach my $req (qw(base_handler_class socket lockfh lockfile)) {
57f93db1
DM
1611 die "misssing required argument '$req'" if !defined($args{$req});
1612 }
1613
1614 my $self = bless { %args }, $class;
1615
d804d82f
DM
1616 PVE::REST::set_base_handler_class($self->{base_handler_class});
1617
f91072d5
DM
1618 # init inotify
1619 PVE::INotify::inotify_init();
1620
f91072d5 1621 $self->{rpcenv} = PVE::RPCEnvironment->init(
353fef24 1622 $self->{trusted_env} ? 'priv' : 'pub', atfork => sub { $self-> atfork_handler() });
f91072d5 1623
57f93db1
DM
1624 fh_nonblocking($self->{socket}, 1);
1625
1626 $self->{end_loop} = 0;
1627 $self->{conn_count} = 0;
1628 $self->{request_count} = 0;
1629 $self->{timeout} = 5 if !$self->{timeout};
1630 $self->{keep_alive} = 0 if !defined($self->{keep_alive});
1631 $self->{max_conn} = 800 if !$self->{max_conn};
1632 $self->{max_requests} = 8000 if !$self->{max_requests};
1633
a908636e
DM
1634 $self->{policy} = 'allow' if !$self->{policy};
1635
57f93db1
DM
1636 $self->{end_cond} = AnyEvent->condvar;
1637
1638 if ($self->{ssl}) {
f91072d5 1639 $self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}});
943776b0 1640 Net::SSLeay::CTX_set_options($self->{tls_ctx}->{ctx}, &Net::SSLeay::OP_NO_COMPRESSION);
57f93db1
DM
1641 }
1642
33afb29b
DM
1643 if ($self->{spiceproxy}) {
1644 $known_methods = { CONNECT => 1 };
1645 }
1646
57f93db1 1647 $self->open_access_log($self->{logfile}) if $self->{logfile};
f91072d5 1648
02667982
DM
1649 $self->{max_conn_soft_limit} = $self->{max_conn} > 100 ? $self->{max_conn} - 20 : $self->{max_conn};
1650
57f93db1
DM
1651 $self->{socket_watch} = AnyEvent->io(fh => $self->{socket}, poll => 'r', cb => sub {
1652 eval {
1653 if ($self->{conn_count} >= $self->{max_conn}) {
1654 my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub {
1655 if ($self->{conn_count} < $self->{max_conn}) {
1656 undef $w;
1657 $self->accept_connections();
1658 }
1659 });
1660 } else {
1661 $self->accept_connections();
f91072d5 1662 }
57f93db1
DM
1663 };
1664 warn $@ if $@;
1665 });
1666
1667 $self->{term_watch} = AnyEvent->signal(signal => "TERM", cb => sub {
1668 undef $self->{term_watch};
1669 $self->wait_end_loop();
1670 });
1671
f91072d5 1672 $self->{quit_watch} = AnyEvent->signal(signal => "QUIT", cb => sub {
57f93db1
DM
1673 undef $self->{quit_watch};
1674 $self->wait_end_loop();
1675 });
1676
f91072d5
DM
1677 $self->{inotify_poll} = AnyEvent->timer(after => 5, interval => 5, cb => sub {
1678 PVE::INotify::poll(); # read inotify events
1679 });
1680
57f93db1
DM
1681 return $self;
1682}
1683
1684sub run {
1685 my ($self) = @_;
1686
1687 $self->{end_cond}->recv;
1688}
1689
16901;