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 Digest::MD5;
  12 # use AnyEvent::Strict; # only use this for debugging
  13 use AnyEvent::Util qw(guard fh_nonblocking WSAEWOULDBLOCK WSAEINPROGRESS);
  14 use AnyEvent::Handle;
  15 use AnyEvent::TLS;
  16 use AnyEvent::IO;
  17 use AnyEvent::HTTP;
  18 use Fcntl ();
  19 use Compress::Zlib;
  20 use PVE::SafeSyslog;
  21 use PVE::INotify;
  22 use PVE::RPCEnvironment;
  23 use PVE::REST;
  24
  25 use Net::IP;
  26 use URI;
  27 use HTTP::Status qw(:constants);
  28 use HTTP::Headers;
  29 use HTTP::Response;
  30 use Data::Dumper;
  31
  32 my $limit_max_headers = 30;
  33 my $limit_max_header_size = 8*1024;
  34 my $limit_max_post = 16*1024;
  35
  36
  37 my $known_methods = {
  38     GET => 1,
  39     POST => 1,
  40     PUT => 1,
  41     DELETE => 1,
  42 };
  43
  44 my $baseuri = "/api2";
  45
  46 sub split_abs_uri {
  47     my ($abs_uri) = @_;
  48
  49     my ($format, $rel_uri) = $abs_uri =~ m/^\Q$baseuri\E\/+(html|text|json|extjs|png|htmljs)(\/.*)?$/;
  50     $rel_uri = '/' if !$rel_uri;
  51
  52     return wantarray ? ($rel_uri, $format) : $rel_uri;
  53 }
  54
  55 sub log_request {
  56     my ($self, $reqstate) = @_;
  57
  58     my $loginfo = $reqstate->{log};
  59
  60     # like apache2 common log format
  61     # LogFormat "%h %l %u %t \"%r\" %>s %b \"%{Referer}i\" \"%{User-agent}i\""
  62
  63     my $peerip = $reqstate->{peer_host} || '-';
  64     my $userid = $loginfo->{userid} || '-';
  65     my $content_length = defined($loginfo->{content_length}) ? $loginfo->{content_length} : '-';
  66     my $code =  $loginfo->{code} || 500;
  67     my $requestline = $loginfo->{requestline} || '-';
  68     my $timestr = strftime("%d/%b/%Y:%H:%M:%S %z", localtime());
  69
  70     my $msg = "$peerip - $userid [$timestr] \"$requestline\" $code $content_length\n";
  71
  72     $self->write_log($msg);
  73 }
  74
  75 sub log_aborted_request {
  76     my ($self, $reqstate, $error) = @_;
  77
  78     my $r = $reqstate->{request};
  79     return if !$r; # no active request
  80
  81     if ($error) {
  82         syslog("err", "problem with client $reqstate->{peer_host}; $error");
  83     }
  84
  85     $self->log_request($reqstate);
  86 }
  87
  88 sub client_do_disconnect {
  89     my ($self, $reqstate) = @_;
  90
  91     if ($reqstate->{tmpfilename}) {
  92         unlink $reqstate->{tmpfilename};
  93         delete $reqstate->{tmpfilename};
  94     }
  95
  96     my $hdl = delete $reqstate->{hdl};
  97
  98     if (!$hdl) {
  99         syslog('err', "detected empty handle");
 100         return;
 101     }
 102
 103     #print "close connection $hdl\n";
 104
 105     shutdown($hdl->{fh}, 1);
 106     # clear all handlers
 107     $hdl->on_drain(undef);
 108     $hdl->on_read(undef);
 109     $hdl->on_eof(undef);
 110     $self->{conn_count}--;
 111
 112     print "$$: CLOSE FH" .  $hdl->{fh}->fileno() . " CONN$self->{conn_count}\n" if $self->{debug};
 113 }
 114
 115 sub finish_response {
 116     my ($self, $reqstate) = @_;
 117
 118     my $hdl = $reqstate->{hdl};
 119
 120     delete $reqstate->{log};
 121     delete $reqstate->{request};
 122     delete $reqstate->{proto};
 123     delete $reqstate->{accept_gzip};
 124
 125     if ($reqstate->{tmpfilename}) {
 126         unlink $reqstate->{tmpfilename};
 127         delete $reqstate->{tmpfilename};
 128     }
 129
 130     if (!$self->{end_loop} && $reqstate->{keep_alive} > 0) {
 131         # print "KEEPALIVE $reqstate->{keep_alive}\n" if $self->{debug};
 132         $hdl->on_read(sub {
 133             eval { $self->push_request_header($reqstate); };
 134             warn $@ if $@;
 135         });
 136     } else {
 137         $hdl->on_drain (sub {
 138             eval {
 139                 $self->client_do_disconnect($reqstate);
 140             };
 141             warn $@ if $@;
 142         });
 143     }
 144 }
 145
 146 sub response {
 147     my ($self, $reqstate, $resp, $mtime, $nocomp) = @_;
 148
 149     #print "$$: send response: " . Dumper($resp);
 150
 151     $nocomp = 1 if !$reqstate->{accept_gzip};
 152
 153     my $code = $resp->code;
 154     my $msg = $resp->message || HTTP::Status::status_message($code);
 155     ($msg) = $msg =~m/^(.*)$/m;
 156     my $content = $resp->content;
 157
 158     if ($code =~ /^(1\d\d|[23]04)$/) {
 159         # make sure content we have no content
 160         $content = "";
 161     }
 162
 163     $reqstate->{keep_alive} = 0 if ($code >= 400) || $self->{end_loop};
 164
 165     $reqstate->{log}->{code} = $code;
 166
 167     my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.0';
 168     my $res = "$proto $code $msg\015\012";
 169
 170     my $ctime = time();
 171     my $date = HTTP::Date::time2str($ctime);
 172     $resp->header('Date' => $date);
 173     if ($mtime) {
 174         $resp->header('Last-Modified' => HTTP::Date::time2str($mtime));
 175     } else {
 176         $resp->header('Expires' => $date);
 177         $resp->header('Cache-Control' => "max-age=0");
 178         $resp->header("Pragma", "no-cache");
 179     }
 180
 181     $resp->header('Server' => "pve-api-daemon/3.0");
 182
 183     my $content_length;
 184     if ($content) {
 185
 186         $content_length = length($content);
 187
 188         if (!$nocomp && ($content_length > 1024)) {
 189             my $comp = Compress::Zlib::memGzip($content);
 190             $resp->header('Content-Encoding', 'gzip');
 191             $content = $comp;
 192             $content_length = length($content);
 193         }
 194         $resp->header("Content-Length" => $content_length);
 195         $reqstate->{log}->{content_length} = $content_length;
 196
 197     } else {
 198         $resp->remove_header("Content-Length");
 199     }
 200
 201     if ($reqstate->{keep_alive} > 0) {
 202         $resp->push_header('Connection' => 'Keep-Alive');
 203     } else {
 204         $resp->header('Connection' => 'close');
 205     }
 206
 207     $res .= $resp->headers_as_string("\015\012");
 208     #print "SEND(without content) $res\n" if $self->{debug};
 209
 210     $res .= "\015\012";
 211     $res .= $content;
 212
 213     $self->log_request($reqstate, $reqstate->{request});
 214
 215     $reqstate->{hdl}->push_write($res);
 216     $self->finish_response($reqstate);
 217 }
 218
 219 sub error {
 220     my ($self, $reqstate, $code, $msg, $hdr, $content) = @_;
 221
 222     eval {
 223         my $resp = HTTP::Response->new($code, $msg, $hdr, $content);
 224         $self->response($reqstate, $resp);
 225     };
 226     warn $@ if $@;
 227 }
 228
 229 sub send_file_start {
 230     my ($self, $reqstate, $filename) = @_;
 231
 232     eval {
 233         # print "SEND FILE $filename\n";
 234         # Note: aio_load() this is not really async unless we use IO::AIO!
 235         eval {
 236
 237             my $r = $reqstate->{request};
 238
 239             my $fh = IO::File->new($filename, '<') ||
 240                 die "$!\n";
 241             my $stat = File::stat::stat($fh) ||
 242                 die "$!\n";
 243
 244             my $mtime = $stat->mtime;
 245
 246             if (my $ifmod = $r->header('if-modified-since')) {
 247                 my $iftime = HTTP::Date::str2time($ifmod);
 248                 if ($mtime <= $iftime) {
 249                     my $resp = HTTP::Response->new(304, "NOT MODIFIED");
 250                     $self->response($reqstate, $resp, $mtime);
 251                     return;
 252                 }
 253             }
 254
 255             my $data;
 256             my $len = sysread($fh, $data,  $stat->size);
 257             die "got short file\n" if !defined($len) || $len != $stat->size;
 258
 259             my $ct;
 260             if ($filename =~ m/\.css$/) {
 261                 $ct = 'text/css';
 262             } elsif ($filename =~ m/\.js$/) {
 263                 $ct = 'application/javascript';
 264             } elsif ($filename =~ m/\.png$/) {
 265                 $ct = 'image/png';
 266             } elsif ($filename =~ m/\.gif$/) {
 267                 $ct = 'image/gif';
 268             } elsif ($filename =~ m/\.jar$/) {
 269                 $ct = 'application/java-archive';
 270             } else {
 271                 die "unable to detect content type";
 272             }
 273
 274             my $header = HTTP::Headers->new(Content_Type => $ct);
 275             my $resp = HTTP::Response->new(200, "OK", $header, $data);
 276             $self->response($reqstate, $resp, $mtime);
 277         };
 278         if (my $err = $@) {
 279             $self->error($reqstate, 501, $err);
 280         }
 281     };
 282
 283     warn $@ if $@;
 284 }
 285
 286 sub proxy_request {
 287     my ($self, $reqstate, $clientip, $host, $method, $uri, $ticket, $token, $params) = @_;
 288
 289     eval {
 290         my $target;
 291         my $keep_alive = 1;
 292         if ($host eq 'localhost') {
 293             $target = "http://$host:85$uri";
 294             # keep alive for localhost is not worth (connection setup is about 0.2ms)
 295             $keep_alive = 0;
 296         } else {
 297             $target = "https://$host:8006$uri";
 298         }
 299
 300         my $headers = {
 301             PVEDisableProxy => 'true',
 302             PVEClientIP => $clientip,
 303         };
 304
 305         my $cookie_name = 'PVEAuthCookie';
 306
 307         $headers->{'cookie'} = PVE::REST::create_auth_cookie($ticket) if $ticket;
 308         $headers->{'CSRFPreventionToken'} = $token if $token;
 309         $headers->{'Accept-Encoding'} = 'gzip' if $reqstate->{accept_gzip};
 310
 311         my $content;
 312
 313         if  ($method eq 'POST' || $method eq 'PUT') {
 314             $headers->{'Content-Type'} = 'application/x-www-form-urlencoded';
 315             # use URI object to format application/x-www-form-urlencoded content.
 316             my $url = URI->new('http:');
 317             $url->query_form(%$params);
 318             $content = $url->query;
 319             if (defined($content)) {
 320                 $headers->{'Content-Length'} = length($content);
 321             }
 322         }
 323
 324         my $w; $w = http_request(
 325             $method => $target,
 326             headers => $headers,
 327             timeout => 30,
 328             recurse => 0,
 329             keepalive => $keep_alive,
 330             body => $content,
 331             tls_ctx => $self->{tls_ctx},
 332             sub {
 333                 my ($body, $hdr) = @_;
 334
 335                 undef $w;
 336
 337                 if (!$reqstate->{hdl}) {
 338                     warn "proxy detected vanished client connection\n";
 339                     return;
 340                 }
 341
 342                 eval {
 343                     my $code = delete $hdr->{Status};
 344                     my $msg = delete $hdr->{Reason};
 345                     delete $hdr->{URL};
 346                     delete $hdr->{HTTPVersion};
 347                     my $header = HTTP::Headers->new(%$hdr);
 348                     my $resp = HTTP::Response->new($code, $msg, $header, $body);
 349                     # Note: disable compression, because body is already compressed
 350                     $self->response($reqstate, $resp, undef, 1);
 351                 };
 352                 warn $@ if $@;
 353             });
 354     };
 355     warn $@ if $@;
 356 }
 357
 358 # return arrays as \0 separated strings (like CGI.pm)
 359 sub decode_urlencoded {
 360     my ($data) = @_;
 361
 362     my $res = {};
 363
 364     return $res if !$data;
 365
 366     foreach my $kv (split(/[\&\;]/, $data)) {
 367         my ($k, $v) = split(/=/, $kv);
 368         $k =~s/\+/ /g;
 369         $k =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
 370         $v =~s/\+/ /g;
 371         $v =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
 372
 373         if (defined(my $old = $res->{$k})) {
 374             $res->{$k} = "$old\0$v";
 375         } else {
 376             $res->{$k} = $v;
 377         }
 378     }
 379     return $res;
 380 }
 381
 382 sub extract_params {
 383     my ($r, $method) = @_;
 384
 385     my $params = {};
 386
 387     if ($method eq 'PUT' || $method eq 'POST') {
 388         $params = decode_urlencoded($r->content);
 389     }
 390
 391     my $query_params = decode_urlencoded($r->url->query());
 392
 393     foreach my $k (keys %{$query_params}) {
 394         $params->{$k} = $query_params->{$k};
 395     }
 396
 397     return PVE::Tools::decode_utf8_parameters($params);
 398 }
 399
 400 sub handle_api2_request {
 401     my ($self, $reqstate, $auth, $upload_state) = @_;
 402
 403     eval {
 404         my $r = $reqstate->{request};
 405         my $method = $r->method();
 406         my $path = $r->uri->path();
 407
 408         my ($rel_uri, $format) = split_abs_uri($path);
 409         if (!$format) {
 410             $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such uri");
 411             return;
 412         }
 413
 414         #print Dumper($upload_state) if $upload_state;
 415
 416         my $rpcenv = $self->{rpcenv};
 417
 418         my $params;
 419
 420         if ($upload_state) {
 421             $params = $upload_state->{params};
 422         } else {
 423             $params = extract_params($r, $method);
 424         }
 425
 426         delete $params->{_dc}; # remove disable cache parameter
 427
 428         my $clientip = $reqstate->{peer_host};
 429
 430         $rpcenv->init_request();
 431
 432         my $res = PVE::REST::rest_handler($rpcenv, $clientip, $method, $rel_uri, $auth, $params);
 433
 434         $rpcenv->set_user(undef); # clear after request
 435
 436         if ($res->{proxy}) {
 437
 438             if ($self->{trusted_env}) {
 439                 $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy not allowed");
 440                 return;
 441             }
 442
 443             $res->{proxy_params}->{tmpfilename} = $reqstate->{tmpfilename} if $upload_state;
 444
 445             $self->proxy_request($reqstate, $clientip, $res->{proxy}, $method,
 446                                  $r->uri, $auth->{ticket}, $auth->{token}, $res->{proxy_params});
 447             return;
 448
 449         }
 450
 451         PVE::REST::prepare_response_data($format, $res);
 452         my ($raw, $ct) = PVE::REST::format_response_data($format, $res, $path);
 453
 454         my $resp = HTTP::Response->new($res->{status}, $res->{message});
 455         $resp->header("Content-Type" => $ct);
 456         $resp->content($raw);
 457         $self->response($reqstate, $resp);
 458     };
 459     if (my $err = $@) {
 460         $self->error($reqstate, 501, $err);
 461     }
 462 }
 463
 464 sub handle_request {
 465     my ($self, $reqstate, $auth) = @_;
 466
 467     eval {
 468         my $r = $reqstate->{request};
 469         my $method = $r->method();
 470         my $path = $r->uri->path();
 471
 472         if ($path =~ m!$baseuri!) {
 473             $self->handle_api2_request($reqstate, $auth);
 474             return;
 475         }
 476
 477         if ($self->{pages} && ($method eq 'GET') && (my $handler = $self->{pages}->{$path})) {
 478             if (ref($handler) eq 'CODE') {
 479                 my $params = decode_urlencoded($r->url->query());
 480                 my ($resp, $userid) = &$handler($self, $reqstate->{request}, $params);
 481                 $self->response($reqstate, $resp);
 482             } elsif (ref($handler) eq 'HASH') {
 483                 if (my $filename = $handler->{file}) {
 484                     my $fh = IO::File->new($filename) ||
 485                         die "unable to open file '$filename' - $!\n";
 486                     send_file_start($self, $reqstate, $filename);
 487                 } else {
 488                     die "internal error - no handler";
 489                 }
 490             } else {
 491                 die "internal error - no handler";
 492             }
 493             return;
 494         }
 495
 496         if ($self->{dirs} && ($method eq 'GET')) {
 497             # we only allow simple names
 498             if ($path =~ m!^(/\S+/)([a-zA-Z0-9\-\_\.]+)$!) {
 499                 my ($subdir, $file) = ($1, $2);
 500                 if (my $dir = $self->{dirs}->{$subdir}) {
 501                     my $filename = "$dir$file";
 502                     my $fh = IO::File->new($filename) ||
 503                         die "unable to open file '$filename' - $!\n";
 504                     send_file_start($self, $reqstate, $filename);
 505                     return;
 506                 }
 507             }
 508         }
 509
 510         die "no such file '$path'";
 511     };
 512     if (my $err = $@) {
 513         $self->error($reqstate, 501, $err);
 514     }
 515 }
 516
 517 sub file_upload_multipart {
 518     my ($self, $reqstate, $auth, $rstate) = @_;
 519
 520     eval {
 521         my $boundary = $rstate->{boundary};
 522         my $hdl = $reqstate->{hdl};
 523
 524         my $startlen = length($hdl->{rbuf});
 525
 526         if ($rstate->{phase} == 0) { # skip everything until start
 527             if ($hdl->{rbuf} =~ s/^.*?--\Q$boundary\E  \015?\012
 528                        ((?:[^\015]+\015\012)* ) \015?\012//xs) {
 529                 my $header = $1;
 530                 my ($ct, $disp, $name, $filename);
 531                 foreach my $line (split(/\015?\012/, $header)) {
 532                     # assume we have single line headers
 533                     if ($line =~ m/^Content-Type\s*:\s*(.*)/i) {
 534                         $ct = parse_content_type($1);
 535                     } elsif ($line =~ m/^Content-Disposition\s*:\s*(.*)/i) {
 536                         ($disp, $name, $filename) = parse_content_disposition($1);
 537                     }
 538                 }
 539
 540                 if (!($disp && $disp eq 'form-data' && $name)) {
 541                     syslog('err', "wrong content disposition in multipart - abort upload");
 542                     $rstate->{phase} = -1;
 543                 } else {
 544
 545                     $rstate->{fieldname} = $name;
 546
 547                     if ($filename) {
 548                         if ($name eq 'filename') {
 549                             # found file upload data
 550                             $rstate->{phase} = 1;
 551                             $rstate->{filename} = $filename;
 552                         } else {
 553                             syslog('err', "wrong field name for file upload - abort upload");
 554                             $rstate->{phase} = -1;
 555                         }
 556                     } else {
 557                         # found form data for field $name
 558                         $rstate->{phase} = 2;
 559                     }
 560                 }
 561             } else {
 562                 my $len = length($hdl->{rbuf});
 563                 substr($hdl->{rbuf}, 0, $len - $rstate->{maxheader}, '')
 564                     if $len > $rstate->{maxheader}; # skip garbage
 565             }
 566         } elsif ($rstate->{phase} == 1) { # inside file - dump until end marker
 567             if ($hdl->{rbuf} =~ s/^(.*?)\015?\012(--\Q$boundary\E(--)? \015?\012(.*))$/$2/xs) {
 568                 my ($rest, $eof) = ($1, $3);
 569                 my $len = length($rest);
 570                 die "write to temporary file failed - $!"
 571                     if syswrite($rstate->{outfh}, $rest) != $len;
 572                 $rstate->{ctx}->add($rest);
 573                 $rstate->{params}->{filename} = $rstate->{filename};
 574                 $rstate->{md5sum} = $rstate->{ctx}->hexdigest;
 575                 $rstate->{bytes} += $len;
 576                 $rstate->{phase} =  $eof ? 100 : 0;
 577             } else {
 578                 my $len = length($hdl->{rbuf});
 579                 my $wlen = $len - $rstate->{boundlen};
 580                 if ($wlen > 0) {
 581                     my $data = substr($hdl->{rbuf}, 0, $wlen, '');
 582                     die "write to temporary file failed - $!"
 583                         if syswrite($rstate->{outfh}, $data) != $wlen;
 584                     $rstate->{bytes} += $wlen;
 585                     $rstate->{ctx}->add($data);
 586                 }
 587             }
 588         } elsif ($rstate->{phase} == 2) { # inside normal field
 589
 590             if ($hdl->{rbuf} =~ s/^(.*?)\015?\012(--\Q$boundary\E(--)? \015?\012(.*))$/$2/xs) {
 591                 my ($rest, $eof) = ($1, $3);
 592                 my $len = length($rest);
 593                 $rstate->{post_size} += $len;
 594                 if ($rstate->{post_size} < $limit_max_post) {
 595                     $rstate->{params}->{$rstate->{fieldname}} = $rest;
 596                     $rstate->{phase} = $eof ? 100 : 0;
 597                 } else {
 598                     syslog('err', "form data to large - abort upload");
 599                     $rstate->{phase} = -1; # skip
 600                 }
 601             }
 602         } else { # skip
 603             my $len = length($hdl->{rbuf});
 604             substr($hdl->{rbuf}, 0, $len, ''); # empty rbuf
 605         }
 606
 607         $rstate->{read} += ($startlen - length($hdl->{rbuf}));
 608
 609         if (!$rstate->{done} && ($rstate->{read} + length($hdl->{rbuf})) >= $rstate->{size}) {
 610             $rstate->{done} = 1; # make sure we dont get called twice
 611             if ($rstate->{phase} < 0 || !$rstate->{md5sum}) {
 612                 die "upload failed\n";
 613             } else {
 614                 my $elapsed = tv_interval($rstate->{starttime});
 615
 616                 my $rate = int($rstate->{bytes}/($elapsed*1024*1024));
 617                 syslog('info', "multipart upload complete " .
 618                        "(size: %d time: %ds rate: %.2fMiB/s md5sum: $rstate->{md5sum})",
 619                        $rstate->{bytes}, $elapsed, $rate);
 620                 $self->handle_api2_request($reqstate, $auth, $rstate);
 621             }
 622         }
 623     };
 624     if (my $err = $@) {
 625         syslog('err', $err);
 626         $self->error($reqstate, 501, $err);
 627     }
 628 }
 629
 630 sub parse_content_type {
 631     my ($ctype) = @_;
 632
 633     my ($ct, @params) = split(/\s*[;,]\s*/o, $ctype);
 634
 635     foreach my $v (@params) {
 636         if ($v =~ m/^\s*boundary\s*=\s*(\S+?)\s*$/o) {
 637             return wantarray ? ($ct, $1) : $ct;
 638         }
 639     }
 640
 641     return  wantarray ? ($ct) : $ct;
 642 }
 643
 644 sub parse_content_disposition {
 645     my ($line) = @_;
 646
 647     my ($disp, @params) = split(/\s*[;,]\s*/o, $line);
 648     my $name;
 649     my $filename;
 650
 651     foreach my $v (@params) {
 652         if ($v =~ m/^\s*name\s*=\s*(\S+?)\s*$/o) {
 653             $name = $1;
 654             $name =~ s/^"(.*)"$/$1/;
 655         } elsif ($v =~ m/^\s*filename\s*=\s*(.+?)\s*$/o) {
 656             $filename = $1;
 657             $filename =~ s/^"(.*)"$/$1/;
 658         }
 659     }
 660
 661     return  wantarray ? ($disp, $name, $filename) : $disp;
 662 }
 663
 664 my $tmpfile_seq_no = 0;
 665
 666 sub get_upload_filename {
 667     # choose unpredictable tmpfile name
 668
 669     $tmpfile_seq_no++;
 670     return "/var/tmp/pveupload-" . Digest::MD5::md5_hex($tmpfile_seq_no . time() . $$);
 671 }
 672
 673 sub unshift_read_header {
 674     my ($self, $reqstate, $state) = @_;
 675
 676     $state = { size => 0, count => 0 } if !$state;
 677
 678     $reqstate->{hdl}->unshift_read(line => sub {
 679         my ($hdl, $line) = @_;
 680
 681         eval {
 682             # print "$$: got header: $line\n" if $self->{debug};
 683
 684             die "to many http header lines\n" if ++$state->{count} >= $limit_max_headers;
 685             die "http header too large\n" if ($state->{size} += length($line)) >= $limit_max_header_size;
 686
 687             my $r = $reqstate->{request};
 688             if ($line eq '') {
 689
 690                 my $path = $r->uri->path();
 691                 my $method = $r->method();
 692
 693                 $r->push_header($state->{key}, $state->{val})
 694                     if $state->{key};
 695
 696                 if (!$known_methods->{$method}) {
 697                     my $resp = HTTP::Response->new(HTTP_NOT_IMPLEMENTED, "method '$method' not available");
 698                     $self->response($reqstate, $resp);
 699                     return;
 700                 }
 701
 702                 my $conn = $r->header('Connection');
 703                 my $accept_enc = $r->header('Accept-Encoding');
 704                 $reqstate->{accept_gzip} = ($accept_enc && $accept_enc =~ m/gzip/) ? 1 : 0;
 705
 706                 if ($conn) {
 707                     $reqstate->{keep_alive} = 0 if $conn =~ m/close/oi;
 708                 } else {
 709                     if ($reqstate->{proto}->{ver} < 1001) {
 710                         $reqstate->{keep_alive} = 0;
 711                     }
 712                 }
 713
 714                 my $te  = $r->header('Transfer-Encoding');
 715                 if ($te && lc($te) eq 'chunked') {
 716                     # Handle chunked transfer encoding
 717                     $self->error($reqstate, 501, "chunked transfer encoding not supported");
 718                     return;
 719                 } elsif ($te) {
 720                     $self->error($reqstate, 501, "Unknown transfer encoding '$te'");
 721                     return;
 722                 }
 723
 724                 my $pveclientip = $r->header('PVEClientIP');
 725
 726                 # fixme: how can we make PVEClientIP header trusted?
 727                 if ($self->{trusted_env} && $pveclientip) {
 728                     $reqstate->{peer_host} = $pveclientip;
 729                 } else {
 730                     $r->header('PVEClientIP', $reqstate->{peer_host});
 731                 }
 732
 733                 my $len = $r->header('Content-Length');
 734
 735                 # header processing complete - authenticate now
 736
 737                 my $auth = {};
 738                 if ($path =~ m!$baseuri!) {
 739                     my $token = $r->header('CSRFPreventionToken');
 740                     my $cookie = $r->header('Cookie');
 741                     my $ticket = PVE::REST::extract_auth_cookie($cookie);
 742
 743                     my ($rel_uri, $format) = split_abs_uri($path);
 744                     if (!$format) {
 745                         $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such uri");
 746                         return;
 747                     }
 748
 749                     eval {
 750                         $auth = PVE::REST::auth_handler($self->{rpcenv}, $reqstate->{peer_host}, $method,
 751                                                         $rel_uri, $ticket, $token);
 752                     };
 753                     if (my $err = $@) {
 754                         $self->error($reqstate, HTTP_UNAUTHORIZED, $err);
 755                         return;
 756                     }
 757                 }
 758
 759                 $reqstate->{log}->{userid} = $auth->{userid};
 760
 761                 if ($len) {
 762
 763                     if (!($method eq 'PUT' || $method eq 'POST')) {
 764                         $self->error($reqstate, 501, "Unexpected content for method '$method'");
 765                         return;
 766                     }
 767
 768                     my $ctype = $r->header('Content-Type');
 769                     my ($ct, $boundary) = parse_content_type($ctype) if $ctype;
 770
 771                     if ($auth->{isUpload} && !$self->{trusted_env}) {
 772                         die "upload 'Content-Type '$ctype' not implemented\n"
 773                             if !($boundary && $ct && ($ct eq 'multipart/form-data'));
 774
 775                         die "upload without content length header not supported" if !$len;
 776
 777                         die "upload without content length header not supported" if !$len;
 778
 779                         print "start upload $path $ct $boundary\n" if $self->{debug};
 780
 781                         my $tmpfilename = get_upload_filename();
 782                         my $outfh = IO::File->new($tmpfilename, O_RDWR|O_CREAT|O_EXCL, 0600) ||
 783                             die "unable to create temporary upload file '$tmpfilename'";
 784
 785                         $reqstate->{keep_alive} = 0;
 786
 787                         my $boundlen = length($boundary) + 8; # \015?\012--$boundary--\015?\012
 788
 789                         my $state = {
 790                             size => $len,
 791                             boundary => $boundary,
 792                             ctx => Digest::MD5->new,
 793                             boundlen =>  $boundlen,
 794                             maxheader => 2048 + $boundlen, # should be large enough
 795                             params => decode_urlencoded($r->url->query()),
 796                             phase => 0,
 797                             read => 0,
 798                             post_size => 0,
 799                             starttime => [gettimeofday],
 800                             outfh => $outfh,
 801                         };
 802                         $reqstate->{tmpfilename} = $tmpfilename;
 803                         $reqstate->{hdl}->on_read(sub { $self->file_upload_multipart($reqstate, $auth, $state); });
 804                         return;
 805                     }
 806
 807                     if ($len > $limit_max_post) {
 808                         $self->error($reqstate, 501, "for data too large");
 809                         return;
 810                     }
 811
 812                     if (!$ct || $ct eq 'application/x-www-form-urlencoded') {
 813                         $reqstate->{hdl}->unshift_read(chunk => $len, sub {
 814                             my ($hdl, $data) = @_;
 815                             $r->content($data);
 816                             $self->handle_request($reqstate, $auth);
 817                         });
 818                     } else {
 819                         $self->error($reqstate, 506, "upload 'Content-Type '$ctype' not implemented");
 820                     }
 821                 } else {
 822                     $self->handle_request($reqstate, $auth);
 823                 }
 824             } elsif ($line =~ /^([^:\s]+)\s*:\s*(.*)/) {
 825                 $r->push_header($state->{key}, $state->{val}) if $state->{key};
 826                 ($state->{key}, $state->{val}) = ($1, $2);
 827                 $self->unshift_read_header($reqstate, $state);
 828             } elsif ($line =~ /^\s+(.*)/) {
 829                 $state->{val} .= " $1";
 830                 $self->unshift_read_header($reqstate, $state);
 831             } else {
 832                 $self->error($reqstate, 506, "unable to parse request header");
 833             }
 834         };
 835         warn $@ if $@;
 836     });
 837 };
 838
 839 sub push_request_header {
 840     my ($self, $reqstate) = @_;
 841
 842     eval {
 843         $reqstate->{hdl}->push_read(line => sub {
 844             my ($hdl, $line) = @_;
 845
 846             eval {
 847                 # print "got request header: $line\n" if $self->{debug};
 848
 849                 $reqstate->{keep_alive}--;
 850
 851                 if ($line =~ /(\S+)\040(\S+)\040HTTP\/(\d+)\.(\d+)/o) {
 852                     my ($method, $uri, $maj, $min) = ($1, $2, $3, $4);
 853
 854                     if ($maj != 1) {
 855                         $self->error($reqstate, 506, "http protocol version $maj.$min not supported");
 856                         return;
 857                     }
 858
 859                     $self->{request_count}++; # only count valid request headers
 860                     if ($self->{request_count} >= $self->{max_requests}) {
 861                         $self->{end_loop} = 1;
 862                     }
 863                     $reqstate->{log} = { requestline => $line };
 864                     $reqstate->{proto}->{str} = "HTTP/$maj.$min";
 865                     $reqstate->{proto}->{maj} = $maj;
 866                     $reqstate->{proto}->{min} = $min;
 867                     $reqstate->{proto}->{ver} = $maj*1000+$min;
 868                     $reqstate->{request} = HTTP::Request->new($method, $uri);
 869
 870                     $self->unshift_read_header($reqstate);
 871                 } elsif ($line eq '') {
 872                     # ignore empty lines before requests (browser bugs?)
 873                     $self->push_request_header($reqstate);
 874                 } else {
 875                     $self->error($reqstate, 400, 'bad request');
 876                 }
 877             };
 878             warn $@ if $@;
 879         });
 880     };
 881     warn $@ if $@;
 882 }
 883
 884 sub accept {
 885     my ($self) = @_;
 886
 887     my $clientfh;
 888
 889     return if $self->{end_loop};
 890
 891     # we need to m make sure that only one process calls accept
 892     while (!flock($self->{lockfh}, Fcntl::LOCK_EX())) {
 893         next if $! == EINTR;
 894         die "could not get lock on file '$self->{lockfile}' -  $!\n";
 895     }
 896
 897     my $again = 0;
 898     my $errmsg;
 899     eval {
 900         while (!$self->{end_loop} &&
 901                !defined($clientfh = $self->{socket}->accept()) &&
 902                ($! == EINTR)) {};
 903
 904         if ($self->{end_loop}) {
 905             $again = 0;
 906         } else {
 907             $again = ($! == EAGAIN || $! == WSAEWOULDBLOCK);
 908             if (!defined($clientfh)) {
 909                 $errmsg = "failed to accept connection: $!\n";
 910             }
 911         }
 912     };
 913     warn $@ if $@;
 914
 915     flock($self->{lockfh}, Fcntl::LOCK_UN());
 916
 917     if (!defined($clientfh)) {
 918         return if $again;
 919         die $errmsg if $errmsg;
 920     }
 921
 922     fh_nonblocking $clientfh, 1;
 923
 924     $self->{conn_count}++;
 925
 926     return $clientfh;
 927 }
 928
 929 sub wait_end_loop {
 930     my ($self) = @_;
 931
 932     $self->{end_loop} = 1;
 933
 934     undef $self->{socket_watch};
 935
 936     if ($self->{conn_count} <= 0) {
 937         $self->{end_cond}->send(1);
 938         return;
 939     }
 940
 941     # else we need to wait until all open connections gets closed
 942     my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub {
 943         eval {
 944             # todo: test for active connections instead (we can abort idle connections)
 945             if ($self->{conn_count} <= 0) {
 946                 undef $w;
 947                 $self->{end_cond}->send(1);
 948             }
 949         };
 950         warn $@ if $@;
 951     });
 952 }
 953
 954
 955 sub check_host_access {
 956     my ($self, $clientip) = @_;
 957
 958     my $cip = Net::IP->new($clientip);
 959
 960     my $match_allow = 0;
 961     my $match_deny = 0;
 962
 963     if ($self->{allow_from}) {
 964         foreach my $t (@{$self->{allow_from}}) {
 965             if ($t->overlaps($cip)) {
 966                 $match_allow = 1;
 967                 last;
 968             }
 969         }
 970     }
 971
 972     if ($self->{deny_from}) {
 973         foreach my $t (@{$self->{deny_from}}) {
 974             if ($t->overlaps($cip)) {
 975                 $match_deny = 1;
 976                 last;
 977             }
 978         }
 979     }
 980
 981     if ($match_allow == $match_deny) {
 982         # match both allow and deny, or no match
 983         return $self->{policy} && $self->{policy} eq 'allow' ? 1 : 0;
 984     }
 985
 986     return $match_allow;
 987 }
 988
 989 sub accept_connections {
 990     my ($self) = @_;
 991
 992     eval {
 993
 994         while (my $clientfh = $self->accept()) {
 995
 996             my $reqstate = { keep_alive => $self->{keep_alive} };
 997
 998             # stop keep-alive when there are many open connections
 999             if ($self->{conn_count} >= $self->{max_conn_soft_limit}) {
1000                 $reqstate->{keep_alive} = 0;
1001             }
1002
1003             if (my $sin = getpeername($clientfh)) {
1004                 my ($pport, $phost) = Socket::unpack_sockaddr_in($sin);
1005                 ($reqstate->{peer_port}, $reqstate->{peer_host}) = ($pport,  Socket::inet_ntoa($phost));
1006             }
1007
1008             if (!$self->{trusted_env} && !$self->check_host_access($reqstate->{peer_host})) {
1009                 print "$$: ABORT request from $reqstate->{peer_host} - access denied\n" if $self->{debug};
1010                 $reqstate->{log}->{code} = 403;
1011                 $self->log_request($reqstate);
1012                 next;
1013             }
1014
1015             $reqstate->{hdl} = AnyEvent::Handle->new(
1016                 fh => $clientfh,
1017                 rbuf_max => 64*1024,
1018                 timeout => $self->{timeout},
1019                 linger => 0, # avoid problems with ssh - really needed ?
1020                 on_eof   => sub {
1021                     my ($hdl) = @_;
1022                     eval {
1023                         $self->log_aborted_request($reqstate);
1024                         $self->client_do_disconnect($reqstate);
1025                     };
1026                     if (my $err = $@) { syslog('err', $err); }
1027                 },
1028                 on_error => sub {
1029                     my ($hdl, $fatal, $message) = @_;
1030                     eval {
1031                         $self->log_aborted_request($reqstate, $message);
1032                         $self->client_do_disconnect($reqstate);
1033                     };
1034                     if (my $err = $@) { syslog('err', "$err"); }
1035                 },
1036                 ($self->{tls_ctx} ? (tls => "accept", tls_ctx => $self->{tls_ctx}) : ()));
1037
1038             print "$$: ACCEPT FH" .  $clientfh->fileno() . " CONN$self->{conn_count}\n" if $self->{debug};
1039
1040             $self->push_request_header($reqstate);
1041         }
1042     };
1043
1044     if (my $err = $@) {
1045         syslog('err', $err);
1046         $self->{end_loop} = 1;
1047     }
1048
1049     $self->wait_end_loop() if $self->{end_loop};
1050 }
1051
1052 # Note: We can't open log file in non-blocking mode and use AnyEvent::Handle,
1053 # because we write from multiple processes, and that would arbitrarily mix output
1054 # of all processes.
1055 sub open_access_log {
1056     my ($self, $filename) = @_;
1057
1058     my $old_mask = umask(0137);;
1059     my $logfh = IO::File->new($filename, ">>") ||
1060         die "unable to open log file '$filename' - $!\n";
1061     umask($old_mask);
1062
1063     $logfh->autoflush(1);
1064
1065     $self->{logfh} = $logfh;
1066 }
1067
1068 sub write_log {
1069     my ($self, $data) = @_;
1070
1071     return if !defined($self->{logfh}) || !$data;
1072
1073     my $res = $self->{logfh}->print($data);
1074
1075     if (!$res) {
1076         delete $self->{logfh};
1077         syslog('err', "error writing access log");
1078         $self->{end_loop} = 1; # terminate asap
1079     }
1080 }
1081
1082 sub atfork_handler {
1083     my ($self) = @_;
1084
1085     eval {
1086         # something else do to ?
1087         close($self->{socket});
1088     };
1089     warn $@ if $@;
1090 }
1091
1092 sub new {
1093     my ($this, %args) = @_;
1094
1095     my $class = ref($this) || $this;
1096
1097     foreach my $req (qw(socket lockfh lockfile)) {
1098         die "misssing required argument '$req'" if !defined($args{$req});
1099     }
1100
1101     my $self = bless { %args }, $class;
1102
1103     # init inotify
1104     PVE::INotify::inotify_init();
1105
1106     $self->{rpcenv} = PVE::RPCEnvironment->init(
1107         $self->{trusted_env} ? 'priv' : 'pub', atfork =>  sub { $self-> atfork_handler() });
1108
1109     fh_nonblocking($self->{socket}, 1);
1110
1111     $self->{end_loop} = 0;
1112     $self->{conn_count} = 0;
1113     $self->{request_count} = 0;
1114     $self->{timeout} = 5 if !$self->{timeout};
1115     $self->{keep_alive} = 0 if !defined($self->{keep_alive});
1116     $self->{max_conn} = 800 if !$self->{max_conn};
1117     $self->{max_requests} = 8000 if !$self->{max_requests};
1118
1119     $self->{policy} = 'allow' if !$self->{policy};
1120
1121     $self->{end_cond} = AnyEvent->condvar;
1122
1123     if ($self->{ssl}) {
1124         $self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}});
1125     }
1126
1127     $self->open_access_log($self->{logfile}) if $self->{logfile};
1128
1129     $self->{max_conn_soft_limit} = $self->{max_conn} > 100 ? $self->{max_conn} - 20 : $self->{max_conn};
1130
1131     $self->{socket_watch} = AnyEvent->io(fh => $self->{socket}, poll => 'r', cb => sub {
1132         eval {
1133             if ($self->{conn_count} >= $self->{max_conn}) {
1134                 my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub {
1135                     if ($self->{conn_count} < $self->{max_conn}) {
1136                         undef $w;
1137                         $self->accept_connections();
1138                     }
1139                 });
1140             } else {
1141                 $self->accept_connections();
1142             }
1143         };
1144         warn $@ if $@;
1145     });
1146
1147     $self->{term_watch} = AnyEvent->signal(signal => "TERM", cb => sub {
1148         undef $self->{term_watch};
1149         $self->wait_end_loop();
1150     });
1151
1152     $self->{quit_watch} = AnyEvent->signal(signal => "QUIT", cb => sub {
1153         undef $self->{quit_watch};
1154         $self->wait_end_loop();
1155     });
1156
1157     $self->{inotify_poll} = AnyEvent->timer(after => 5, interval => 5, cb => sub {
1158         PVE::INotify::poll(); # read inotify events
1159     });
1160
1161     return $self;
1162 }
1163
1164 sub run {
1165     my ($self) = @_;
1166
1167     $self->{end_cond}->recv;
1168 }
1169
1170 1;