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