PVE/HTTPServer.pm

   1 package PVE::HTTPServer;
   2
   3 use strict;
   4 use warnings;
   5 use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN);
   6 use POSIX qw(strftime EINTR EAGAIN);
   7 use Fcntl;
   8 use File::stat qw();
   9 use AnyEvent::Strict;
  10 use AnyEvent::Util qw(guard fh_nonblocking WSAEWOULDBLOCK WSAEINPROGRESS);
  11 use AnyEvent::Handle;
  12 use AnyEvent::TLS;
  13 use AnyEvent::IO;
  14 use AnyEvent::HTTP;
  15 use Fcntl ();
  16 use Compress::Zlib;
  17 use PVE::SafeSyslog;
  18 use PVE::INotify;
  19 use PVE::RPCEnvironment;
  20 use PVE::REST;
  21
  22 use URI;
  23 use HTTP::Status qw(:constants);
  24 use HTTP::Headers;
  25 use HTTP::Response;
  26
  27 use CGI; # fixme: remove this!
  28 # DOS attack prevention
  29 # fixme: remove CGI.pm
  30 $CGI::DISABLE_UPLOADS = 1; # no uploads
  31 $CGI::POST_MAX = 1024 * 10; # max 10K posts
  32
  33 use Scalar::Util qw/weaken/; # fixme: remove?
  34 use Data::Dumper; # fixme: remove
  35
  36 my $known_methods = {
  37     GET => 1,
  38     POST => 1,
  39     PUT => 1,
  40     DELETE => 1,
  41 };
  42
  43 sub log_request {
  44     my ($self, $reqstate) = @_;
  45
  46     my $loginfo = $reqstate->{log};
  47
  48     # like apache2 common log format
  49     # LogFormat "%h %l %u %t \"%r\" %>s %b \"%{Referer}i\" \"%{User-agent}i\""
  50
  51     my $peerip = $reqstate->{peer_host} || '-';
  52     my $userid = $loginfo->{userid} || '-';
  53     my $content_length = defined($loginfo->{content_length}) ? $loginfo->{content_length} : '-';
  54     my $code =  $loginfo->{code} || 500;
  55     my $requestline = $loginfo->{requestline} || '-';
  56     my $timestr = strftime("%d/%b/%Y:%H:%M:%S %z", localtime());
  57
  58     my $msg = "$peerip - $userid [$timestr] \"$requestline\" $code $content_length\n";
  59
  60     $self->write_log($msg);
  61 }
  62
  63 sub log_aborted_request {
  64     my ($self, $reqstate, $error) = @_;
  65
  66     my $r = $reqstate->{request};
  67     return if !$r; # no active request
  68
  69     if ($error) {
  70         syslog("err", "problem with client $reqstate->{peer_host}; $error");
  71     }
  72
  73     $self->log_request($reqstate);
  74 }
  75
  76 sub client_do_disconnect {
  77     my ($self, $reqstate) = @_;
  78
  79     my $hdl = delete $reqstate->{hdl};
  80
  81     if (!$hdl) {
  82         syslog('err', "detected empty handle");
  83         return;
  84     }
  85
  86     #print "close connection $hdl\n";
  87
  88     shutdown($hdl->{fh}, 1);
  89     # clear all handlers
  90     $hdl->on_drain(undef);
  91     $hdl->on_read(undef);
  92     $hdl->on_eof(undef);
  93     $self->{conn_count}--;
  94
  95     #print "$$: client_do_disconnect $self->{conn_count} $hdl\n";
  96 }
  97
  98 sub finish_response {
  99     my ($self, $reqstate) = @_;
 100
 101     my $hdl = $reqstate->{hdl};
 102
 103     delete $reqstate->{log};
 104     delete $reqstate->{request};
 105     delete $reqstate->{proto};
 106
 107     if (!$self->{end_loop} && $reqstate->{keep_alive} > 0) {
 108         # print "KEEPALIVE $reqstate->{keep_alive}\n";
 109         $hdl->on_read(sub {
 110             eval { $self->push_request_header($reqstate); };
 111             warn $@ if $@;
 112         });
 113     } else {
 114         $hdl->on_drain (sub {
 115             eval {
 116                 $self->client_do_disconnect($reqstate);
 117             };
 118             warn $@ if $@;
 119         });
 120     }
 121 }
 122
 123 sub response {
 124     my ($self, $reqstate, $resp, $mtime, $nocomp) = @_;
 125
 126     #print "$$: send response: " . Dumper($resp);
 127
 128     my $code = $resp->code;
 129     my $msg = $resp->message || HTTP::Status::status_message($code);
 130     ($msg) = $msg =~m/^(.*)$/m;
 131     my $content = $resp->content;
 132
 133     if ($code =~ /^(1\d\d|[23]04)$/) {
 134         # make sure content we have no content
 135         $content = "";
 136     }
 137
 138     $reqstate->{keep_alive} = 0 if ($code >= 300) || $self->{end_loop};
 139
 140     $reqstate->{log}->{code} = $code;
 141
 142     my $res = "HTTP/1.0 $code $msg\015\012";
 143
 144     my $ctime = time();
 145     my $date = HTTP::Date::time2str($ctime);
 146     $resp->header('Date' => $date);
 147     if ($mtime) {
 148         $resp->header('Last-Modified' => HTTP::Date::time2str($mtime));
 149     } else {
 150         $resp->header('Expires' => $date);
 151         $resp->header('Cache-Control' => "max-age=0");
 152         $resp->header("Pragma", "no-cache");
 153     }
 154
 155     $resp->header('Server' => "pve-api-daemon/3.0");
 156
 157     my $content_length;
 158     if (ref($content) eq "CODE") {
 159         $reqstate->{keep_alive} = 0;
 160
 161         # fixme:
 162
 163     } elsif ($content) {
 164
 165         $content_length = length($content);
 166
 167         if (!$nocomp && ($content_length > 1024)) {
 168             my $comp = Compress::Zlib::memGzip($content);
 169             $resp->header('Content-Encoding', 'gzip');
 170             $content = $comp;
 171             $content_length = length($content);
 172         }
 173         $resp->header("Content-Length" => $content_length);
 174         $reqstate->{log}->{content_length} = $content_length;
 175     } else {
 176         $resp->remove_header("Content-Length");
 177     }
 178
 179     if ($reqstate->{keep_alive} > 0) {
 180         $resp->push_header('Connection' => 'Keep-Alive');
 181     } else {
 182         $resp->header('Connection' => 'close');
 183     }
 184
 185     $res .= $resp->headers_as_string("\015\012");
 186     #print "SEND(supress content) $res\n";
 187
 188     $res .= "\015\012";
 189     $res .= $content;
 190
 191     $self->log_request($reqstate, $reqstate->{request});
 192
 193     $reqstate->{hdl}->push_write($res);
 194     $self->finish_response($reqstate);
 195 }
 196
 197 sub error {
 198     my ($self, $reqstate, $code, $msg, $hdr, $content) = @_;
 199
 200     eval {
 201         my $resp = HTTP::Response->new($code, $msg, $hdr, $content);
 202         $self->response($reqstate, $resp);
 203     };
 204     warn $@ if $@;
 205 }
 206
 207 sub send_file_start {
 208     my ($self, $reqstate, $filename) = @_;
 209
 210     eval {
 211         # print "SEND FILE $filename\n";
 212         # Note: aio_load() this is not really async unless we use IO::AIO!
 213         eval {
 214
 215             my $fh = IO::File->new($filename, '<') ||
 216                 die "$!\n";
 217             my $stat = File::stat::stat($fh) ||
 218                 die "$!\n";
 219
 220             my $data;
 221             my $len = sysread($fh, $data,  $stat->size);
 222             die "got short file\n" if !defined($len) || $len != $stat->size;
 223
 224             my $ct;
 225             if ($filename =~ m/\.css$/) {
 226                 $ct = 'text/css';
 227             } elsif ($filename =~ m/\.js$/) {
 228                 $ct = 'application/javascript';
 229             } elsif ($filename =~ m/\.png$/) {
 230                 $ct = 'image/png';
 231             } elsif ($filename =~ m/\.gif$/) {
 232                 $ct = 'image/gif';
 233             } elsif ($filename =~ m/\.jar$/) {
 234                 $ct = 'application/java-archive';
 235             } else {
 236                 die "unable to detect content type";
 237             }
 238
 239             my $header = HTTP::Headers->new(Content_Type => $ct);
 240             my $resp = HTTP::Response->new(200, "OK", $header, $data);
 241             $self->response($reqstate, $resp, $stat->mtime);
 242         };
 243         if (my $err = $@) {
 244             $self->error($reqstate, 501, $err);
 245         }
 246     };
 247
 248     warn $@ if $@;
 249 }
 250
 251 sub proxy_request {
 252     my ($self, $reqstate, $r, $clientip, $host, $method, $abs_uri, $ticket, $token, $params) = @_;
 253
 254     eval {
 255         my $target;
 256         if ($host eq 'localhost') {
 257             $target = "http://$host:85$abs_uri";
 258         } else {
 259             $target = "https://$host:8006$abs_uri";
 260         }
 261
 262         my $headers = {
 263             PVEDisableProxy => 'true',
 264             PVEClientIP => $clientip,
 265         };
 266
 267         my $cookie_name = 'PVEAuthCookie';
 268
 269         $headers->{'cookie'} = PVE::REST::create_auth_cookie($ticket) if $ticket;
 270         $headers->{'CSRFPreventionToken'} = $token if $token;
 271
 272         my $content;
 273
 274         if  ($method eq 'POST' || $method eq 'PUT') {
 275             $headers->{'Content-Type'} = 'application/x-www-form-urlencoded';
 276             # We use a temporary URI object to format
 277             # the application/x-www-form-urlencoded content.
 278             my $url = URI->new('http:');
 279             $url->query_form(%$params);
 280             $content = $url->query;
 281             if (defined($content)) {
 282                 $headers->{'Content-Length'} = length($content);
 283             }
 284         }
 285
 286         # fixme: tls_ctx;
 287
 288         my $w; $w = http_request(
 289             $method => $target,
 290             headers => $headers,
 291             timeout => 30,
 292             resurse => 0,
 293             body => $content,
 294             sub {
 295                 my ($body, $hdr) = @_;
 296
 297                 undef $w;
 298
 299                 eval {
 300                     my $code = delete $hdr->{Status};
 301                     my $msg = delete $hdr->{Reason};
 302                     delete $hdr->{URL};
 303                     delete $hdr->{HTTPVersion};
 304                     my $header = HTTP::Headers->new(%$hdr);
 305                     my $resp = HTTP::Response->new($code, $msg, $header, $body);
 306                     $self->response($reqstate, $resp, undef, 1);
 307                 };
 308                 warn $@ if $@;
 309             });
 310     };
 311     warn $@ if $@;
 312 }
 313
 314 my $extract_params = sub {
 315     my ($r, $method) = @_;
 316
 317     # NOTE: HTTP::Request::Params return undef instead of ''
 318     #my $parser = HTTP::Request::Params->new({req => $r});
 319     #my $params = $parser->params;
 320
 321     my $post_params = {};
 322
 323     if ($method eq 'PUT' || $method eq 'POST') {
 324         $post_params = CGI->new($r->content())->Vars;
 325     }
 326
 327     my $query_params = CGI->new($r->url->query)->Vars;
 328     my $params = $post_params || {};
 329
 330     foreach my $k (keys %{$query_params}) {
 331         $params->{$k} = $query_params->{$k};
 332     }
 333
 334     return PVE::Tools::decode_utf8_parameters($params);
 335 };
 336
 337 sub handle_api2_request {
 338     my ($self, $reqstate) = @_;
 339
 340     eval {
 341         my $r = $reqstate->{request};
 342         my $method = $r->method();
 343         my $path = $r->uri->path();
 344
 345         my ($rel_uri, $format) = PVE::REST::split_abs_uri($path);
 346         if (!$format) {
 347             $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such uri");
 348             return;
 349         }
 350
 351         my $rpcenv = $self->{rpcenv};
 352         my $headers = $r->headers;
 353
 354         my $token = $headers->header('CSRFPreventionToken');
 355
 356         my $cookie = $headers->header('Cookie');
 357
 358         my $ticket = PVE::REST::extract_auth_cookie($cookie);
 359
 360         my $params = &$extract_params($r, $method);
 361
 362         my $clientip = $headers->header('PVEClientIP');
 363
 364         $rpcenv->init_request(params => $params);
 365
 366         my $res = PVE::REST::rest_handler($rpcenv, $clientip, $method, $path, $rel_uri, $ticket, $token);
 367
 368         # fixme: eval { $userid = $rpcenv->get_user(); };
 369         my $userid = $rpcenv->{user}; # this is faster
 370         $rpcenv->set_user(undef); # clear after request
 371
 372         $reqstate->{log}->{userid} = $userid;
 373
 374         if ($res->{proxy}) {
 375
 376             if ($self->{trusted_env}) {
 377                 $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy not allowed");
 378                 return;
 379             }
 380
 381             $self->proxy_request($reqstate, $r, $clientip, $res->{proxy}, $method,
 382                                  $r->uri, $ticket, $token, $res->{proxy_params});
 383             return;
 384
 385         }
 386
 387         PVE::REST::prepare_response_data($format, $res);
 388         my ($raw, $ct) = PVE::REST::format_response_data($format, $res, $path);
 389
 390         my $resp = HTTP::Response->new($res->{status}, $res->{message});
 391         $resp->header("Content-Type" => $ct);
 392         $resp->content($raw);
 393         $self->response($reqstate, $resp);
 394
 395         return;
 396     };
 397     warn $@ if $@;
 398 }
 399
 400 sub handle_request {
 401     my ($self, $reqstate) = @_;
 402
 403     #print "REQUEST" . Dumper($reqstate->{request});
 404
 405     eval {
 406         my $r = $reqstate->{request};
 407         my $method = $r->method();
 408         my $path = $r->uri->path();
 409
 410         # print "REQUEST $path\n";
 411
 412         if (!$known_methods->{$method}) {
 413             my $resp = HTTP::Response->new(HTTP_NOT_IMPLEMENTED, "method '$method' not available");
 414             $self->response($reqstate, $resp);
 415             return;
 416         }
 417
 418         if ($path =~ m!/api2!) {
 419             $self->handle_api2_request($reqstate);
 420             return;
 421         }
 422
 423         if ($self->{pages} && ($method eq 'GET') && (my $handler = $self->{pages}->{$path})) {
 424             if (ref($handler) eq 'CODE') {
 425                 my ($resp, $userid) = &$handler($self, $reqstate->{request});
 426                 $self->response($reqstate, $resp);
 427             } elsif (ref($handler) eq 'HASH') {
 428                 if (my $filename = $handler->{file}) {
 429                     my $fh = IO::File->new($filename) ||
 430                         die "unable to open file '$filename' - $!\n";
 431                     send_file_start($self, $reqstate, $filename);
 432                 } else {
 433                     die "internal error - no handler";
 434                 }
 435             } else {
 436                 die "internal error - no handler";
 437             }
 438             return;
 439         }
 440
 441         if ($self->{dirs} && ($method eq 'GET')) {
 442             # we only allow simple names
 443             if ($path =~ m!^(/\S+/)([a-zA-Z0-9\-\_\.]+)$!) {
 444                 my ($subdir, $file) = ($1, $2);
 445                 if (my $dir = $self->{dirs}->{$subdir}) {
 446                     my $filename = "$dir$file";
 447                     my $fh = IO::File->new($filename) ||
 448                         die "unable to open file '$filename' - $!\n";
 449                     send_file_start($self, $reqstate, $filename);
 450                     return;
 451                 }
 452             }
 453         }
 454
 455         die "no such file '$path'";
 456     };
 457     if (my $err = $@) {
 458         $self->error($reqstate, 501, $err);
 459     }
 460 }
 461
 462 sub unshift_read_header {
 463     my ($self, $reqstate, $state) = @_;
 464
 465     $state = {} if !$state;
 466
 467     $reqstate->{hdl}->unshift_read(line => sub {
 468         my ($hdl, $line) = @_;
 469
 470         eval {
 471             #print "$$: got header: $line\n";
 472
 473             my $r = $reqstate->{request};
 474             if ($line eq '') {
 475
 476                 $r->push_header($state->{key}, $state->{val})
 477                     if $state->{key};
 478
 479                 my $conn = $r->header('Connection');
 480
 481                 if ($conn) {
 482                     $reqstate->{keep_alive} = 0 if $conn =~ m/close/oi;
 483                 } else {
 484                     if ($reqstate->{proto}->{ver} < 1001) {
 485                         $reqstate->{keep_alive} = 0;
 486                     }
 487                 }
 488
 489                 # how much content to read?
 490                 my $te  = $r->header('Transfer-Encoding');
 491                 my $len = $r->header('Content-Length');
 492                 my $pveclientip = $r->header('PVEClientIP');
 493
 494                 # fixme:
 495                 if ($self->{trusted_env} && $pveclientip) {
 496                     $reqstate->{peer_host} = $pveclientip;
 497                 } else {
 498                     $r->header('PVEClientIP', $reqstate->{peer_host});
 499                 }
 500
 501                 if ($te && lc($te) eq 'chunked') {
 502                     # Handle chunked transfer encoding
 503                     $self->error($reqstate, 501, "chunked transfer encoding not supported");
 504                 } elsif ($te) {
 505                     $self->error($reqstate, 501, "Unknown transfer encoding '$te'");
 506                 } elsif (defined($len)) {
 507                     $reqstate->{hdl}->unshift_read (chunk => $len, sub {
 508                         my ($hdl, $data) = @_;
 509                         $r->content($data);
 510                         $self->handle_request($reqstate);
 511                                                     });
 512                 } else {
 513                     $self->handle_request($reqstate);
 514                 }
 515             } elsif ($line =~ /^([^:\s]+)\s*:\s*(.*)/) {
 516                 $r->push_header($state->{key}, $state->{val}) if $state->{key};
 517                 ($state->{key}, $state->{val}) = ($1, $2);
 518                 $self->unshift_read_header($reqstate, $state);
 519             } elsif ($line =~ /^\s+(.*)/) {
 520                 $state->{val} .= " $1";
 521                 $self->unshift_read_header($reqstate, $state);
 522             } else {
 523                 $self->error($reqstate, 506, "unable to parse request header");
 524             }
 525         };
 526         warn $@ if $@;
 527     });
 528 };
 529
 530 sub push_request_header {
 531     my ($self, $reqstate) = @_;
 532
 533     eval {
 534         $reqstate->{hdl}->push_read(line => sub {
 535             my ($hdl, $line) = @_;
 536
 537             eval {
 538                 #print "got request header: $line\n";
 539
 540                 $reqstate->{keep_alive}--;
 541
 542                 if ($line =~ /(\S+)\040(\S+)\040HTTP\/(\d+)\.(\d+)/o) {
 543                     my ($method, $uri, $maj, $min) = ($1, $2, $3, $4);
 544
 545                     if ($maj != 1) {
 546                         $self->error($reqstate, 506, "http protocol version $maj.$min not supported");
 547                         return;
 548                     }
 549
 550                     $self->{request_count}++; # only count valid request headers
 551                     if ($self->{request_count} >= $self->{max_requests}) {
 552                         $self->{end_loop} = 1;
 553                     }
 554                     $reqstate->{log} = { requestline => $line };
 555                     $reqstate->{proto}->{maj} = $maj;
 556                     $reqstate->{proto}->{min} = $min;
 557                     $reqstate->{proto}->{ver} = $maj*1000+$min;
 558                     $reqstate->{request} = HTTP::Request->new($method, $uri);
 559
 560                     $self->unshift_read_header($reqstate);
 561                 } elsif ($line eq '') {
 562                     # ignore empty lines before requests (browser bugs?)
 563                     $self->push_request_header($reqstate);
 564                 } else {
 565                     $self->error($reqstate, 400, 'bad request');
 566                 }
 567             };
 568             warn $@ if $@;
 569         });
 570     };
 571     warn $@ if $@;
 572 }
 573
 574 sub accept {
 575     my ($self) = @_;
 576
 577     my $clientfh;
 578
 579     return if $self->{end_loop};
 580
 581     # we need to m make sure that only one process calls accept
 582     while (!flock($self->{lockfh}, Fcntl::LOCK_EX())) {
 583         next if $! == EINTR;
 584         die "could not get lock on file '$self->{lockfile}' -  $!\n";
 585     }
 586
 587     my $again = 0;
 588     my $errmsg;
 589     eval {
 590         while (!$self->{end_loop} &&
 591                !defined($clientfh = $self->{socket}->accept()) &&
 592                ($! == EINTR)) {};
 593
 594         if ($self->{end_loop}) {
 595             $again = 0;
 596         } else {
 597             $again = ($! == EAGAIN || $! == WSAEWOULDBLOCK);
 598             if (!defined($clientfh)) {
 599                 $errmsg = "failed to accept connection: $!\n";
 600             }
 601         }
 602     };
 603     warn $@ if $@;
 604
 605     flock($self->{lockfh}, Fcntl::LOCK_UN());
 606
 607     if (!defined($clientfh)) {
 608         return if $again;
 609         die $errmsg if $errmsg;
 610     }
 611
 612     fh_nonblocking $clientfh, 1;
 613
 614     $self->{conn_count}++;
 615
 616     print "$$: ACCEPT OK $self->{conn_count} FH" .  $clientfh->fileno() . "\n";
 617
 618     return $clientfh;
 619 }
 620
 621 sub wait_end_loop {
 622     my ($self) = @_;
 623
 624     $self->{end_loop} = 1;
 625
 626     undef $self->{socket_watch};
 627
 628     if ($self->{conn_count} <= 0) {
 629         $self->{end_cond}->send(1);
 630         return;
 631     }
 632
 633     # else we need to wait until all open connections gets closed
 634     my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub {
 635         eval {
 636             # fixme: test for active connections instead?
 637             if ($self->{conn_count} <= 0) {
 638                 undef $w;
 639                 $self->{end_cond}->send(1);
 640             }
 641         };
 642         warn $@ if $@;
 643     });
 644 }
 645
 646 sub accept_connections {
 647     my ($self) = @_;
 648
 649     eval {
 650
 651         while (my $clientfh = $self->accept()) {
 652
 653             my $reqstate = { keep_alive => $self->{keep_alive} };
 654
 655             if (my $sin = getpeername($clientfh)) {
 656                 my ($pport, $phost) = Socket::unpack_sockaddr_in($sin);
 657                 ($reqstate->{peer_port}, $reqstate->{peer_host}) = ($pport,  Socket::inet_ntoa($phost));
 658             }
 659
 660             $reqstate->{hdl} = AnyEvent::Handle->new(
 661                 fh => $clientfh,
 662                 rbuf_max => 32768, # fixme: set smaller max read buffer ?
 663                 timeout => $self->{timeout},
 664                 linger => 0, # avoid problems with ssh - really needed ?
 665                 on_eof   => sub {
 666                     my ($hdl) = @_;
 667                     eval {
 668                         $self->log_aborted_request($reqstate);
 669                         $self->client_do_disconnect($reqstate);
 670                     };
 671                     if (my $err = $@) { syslog('err', $err); }
 672                 },
 673                 on_error => sub {
 674                     my ($hdl, $fatal, $message) = @_;
 675                     eval {
 676                         $self->log_aborted_request($reqstate, $message);
 677                         $self->client_do_disconnect($reqstate);
 678                     };
 679                     if (my $err = $@) { syslog('err', "$err"); }
 680                 },
 681                 ($self->{tls_ctx} ? (tls => "accept", tls_ctx => $self->{tls_ctx}) : ()));
 682
 683             print "$$: ACCEPT OK $reqstate->{hdl} $self->{conn_count}\n";
 684
 685             $self->push_request_header($reqstate);
 686         }
 687     };
 688
 689     if (my $err = $@) {
 690         syslog('err', $err);
 691         $self->{end_loop} = 1;
 692     }
 693
 694     $self->wait_end_loop() if $self->{end_loop};
 695 }
 696
 697 # Note: We can't open log file in non-blocking mode and use AnyEvent::Handle,
 698 # because we write from multiple processes, and that would arbitrarily mix output
 699 # of all processes.
 700 sub open_access_log {
 701     my ($self, $filename) = @_;
 702
 703     my $old_mask = umask(0137);;
 704     my $logfh = IO::File->new($filename, ">>") ||
 705         die "unable to open log file '$filename' - $!\n";
 706     umask($old_mask);
 707
 708     $logfh->autoflush(1);
 709
 710     $self->{logfh} = $logfh;
 711 }
 712
 713 sub write_log {
 714     my ($self, $data) = @_;
 715
 716     return if !defined($self->{logfh}) || !$data;
 717
 718     my $res = $self->{logfh}->print($data);
 719
 720     if (!$res) {
 721         delete $self->{logfh};
 722         syslog('err', "error writing access log");
 723         $self->{end_loop} = 1; # terminate asap
 724     }
 725 }
 726
 727 sub new {
 728     my ($this, %args) = @_;
 729
 730     my $class = ref($this) || $this;
 731
 732     foreach my $req (qw(rpcenv socket lockfh lockfile)) {
 733         die "misssing required argument '$req'" if !defined($args{$req});
 734     }
 735
 736     my $self = bless { %args }, $class;
 737
 738     fh_nonblocking($self->{socket}, 1);
 739
 740     $self->{end_loop} = 0;
 741     $self->{conn_count} = 0;
 742     $self->{request_count} = 0;
 743     $self->{timeout} = 5 if !$self->{timeout};
 744     $self->{keep_alive} = 0 if !defined($self->{keep_alive});
 745     $self->{max_conn} = 800 if !$self->{max_conn};
 746     $self->{max_requests} = 8000 if !$self->{max_requests};
 747
 748     $self->{end_cond} = AnyEvent->condvar;
 749
 750     if ($self->{ssl}) {
 751         $self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}});
 752     }
 753
 754     $self->open_access_log($self->{logfile}) if $self->{logfile};
 755
 756     $self->{socket_watch} = AnyEvent->io(fh => $self->{socket}, poll => 'r', cb => sub {
 757         eval {
 758             if ($self->{conn_count} >= $self->{max_conn}) {
 759                 my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub {
 760                     if ($self->{conn_count} < $self->{max_conn}) {
 761                         undef $w;
 762                         $self->accept_connections();
 763                     }
 764                 });
 765             } else {
 766                 $self->accept_connections();
 767             }
 768         };
 769         warn $@ if $@;
 770     });
 771
 772     $self->{term_watch} = AnyEvent->signal(signal => "TERM", cb => sub {
 773         undef $self->{term_watch};
 774         $self->wait_end_loop();
 775     });
 776
 777     $self->{quit_watch} = AnyEvent->signal(signal => "QUIT", cb => sub {
 778         undef $self->{quit_watch};
 779         $self->wait_end_loop();
 780     });
 781
 782     return $self;
 783 }
 784
 785 sub run {
 786     my ($self) = @_;
 787
 788     $self->{end_cond}->recv;
 789 }
 790
 791 1;