PVE/HTTPServer.pm

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