/lib/HTTP/Proxy/Engine/Legacy.pm

https://github.com/gitpan/HTTP-Proxy · Perl · 178 lines · 117 code · 53 blank · 8 comment · 18 complexity · c1a8f7ce7a27ea604d03d2b3802b23eb MD5 · raw file

  1. package HTTP::Proxy::Engine::Legacy;
  2. use strict;
  3. use POSIX 'WNOHANG';
  4. use HTTP::Proxy;
  5. our @ISA = qw( HTTP::Proxy::Engine );
  6. our %defaults = (
  7. max_clients => 12,
  8. );
  9. __PACKAGE__->make_accessors( qw( kids select ), keys %defaults );
  10. sub start {
  11. my $self = shift;
  12. $self->kids( [] );
  13. $self->select( IO::Select->new( $self->proxy->daemon ) );
  14. }
  15. sub run {
  16. my $self = shift;
  17. my $proxy = $self->proxy;
  18. my $kids = $self->kids;
  19. # check for new connections
  20. my @ready = $self->select->can_read(1);
  21. for my $fh (@ready) { # there's only one, anyway
  22. # single-process proxy (useful for debugging)
  23. if ( $self->max_clients == 0 ) {
  24. $proxy->max_keep_alive_requests(1); # do not block simultaneous connections
  25. $proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
  26. "No fork allowed, serving the connection" );
  27. $proxy->serve_connections($fh->accept);
  28. $proxy->new_connection;
  29. next;
  30. }
  31. if ( @$kids >= $self->max_clients ) {
  32. $proxy->log( HTTP::Proxy::ERROR, "PROCESS",
  33. "Too many child process, serving the connection" );
  34. $proxy->serve_connections($fh->accept);
  35. $proxy->new_connection;
  36. next;
  37. }
  38. # accept the new connection
  39. my $conn = $fh->accept;
  40. my $child = fork;
  41. if ( !defined $child ) {
  42. $conn->close;
  43. $proxy->log( HTTP::Proxy::ERROR, "PROCESS", "Cannot fork" );
  44. $self->max_clients( $self->max_clients - 1 )
  45. if $self->max_clients > @$kids;
  46. next;
  47. }
  48. # the parent process
  49. if ($child) {
  50. $conn->close;
  51. $proxy->log( HTTP::Proxy::PROCESS, "PROCESS", "Forked child process $child" );
  52. push @$kids, $child;
  53. }
  54. # the child process handles the whole connection
  55. else {
  56. $SIG{INT} = 'DEFAULT';
  57. $proxy->serve_connections($conn);
  58. exit; # let's die!
  59. }
  60. }
  61. $self->reap_zombies if @$kids;
  62. }
  63. sub stop {
  64. my $self = shift;
  65. my $kids = $self->kids;
  66. # wait for remaining children
  67. # EOLOOP
  68. kill INT => @$kids;
  69. $self->reap_zombies while @$kids;
  70. }
  71. # private reaper sub
  72. sub reap_zombies {
  73. my $self = shift;
  74. my $kids = $self->kids;
  75. my $proxy = $self->proxy;
  76. while (1) {
  77. my $pid = waitpid( -1, WNOHANG );
  78. last if $pid == 0 || $pid == -1; # AS/Win32 returns negative PIDs
  79. @$kids = grep { $_ != $pid } @$kids;
  80. $proxy->{conn}++; # Cannot use the interface for RO attributes
  81. $proxy->log( HTTP::Proxy::PROCESS, "PROCESS", "Reaped child process $pid" );
  82. $proxy->log( HTTP::Proxy::PROCESS, "PROCESS", @$kids . " remaining kids: @$kids" );
  83. }
  84. }
  85. 1;
  86. __END__
  87. =head1 NAME
  88. HTTP::Proxy::Engine::Legacy - The "older" HTTP::Proxy engine
  89. =head1 SYNOPSIS
  90. my $proxy = HTTP::Proxy->new( engine => 'Legacy' );
  91. =head1 DESCRIPTION
  92. This engine reproduces the older child creation algorithm of L<HTTP::Proxy>.
  93. Angelos Karageorgiou C<< <angelos@unix.gr> >> reports:
  94. I<I got the Legacy engine to work really fast under C<Win32> with the following trick:>
  95. max_keep_alive_requests(1);
  96. max_clients(120);
  97. $HTTP::VERSION(1.0); # just in case
  98. I<and it smokes.>
  99. I<It seems that forked children are really slow when calling select for handling C<keep-alive>d requests!>
  100. =head1 METHODS
  101. The module defines the following methods, used by L<HTTP::Proxy> main loop:
  102. =over 4
  103. =item start()
  104. Initialise the engine.
  105. =item run()
  106. Implements the forking logic: a new process is forked for each new
  107. incoming TCP connection.
  108. =item stop()
  109. Reap remaining child processes.
  110. =back
  111. The following method is used by the engine internally:
  112. =over 4
  113. =item reap_zombies()
  114. Process the dead child processes.
  115. =back
  116. =head1 SEE ALSO
  117. L<HTTP::Proxy>, L<HTTP::Proxy::Engine>.
  118. =head1 AUTHOR
  119. Philippe "BooK" Bruhat, C<< <book@cpan.org> >>.
  120. =head1 COPYRIGHT
  121. Copyright 2005-2013, Philippe Bruhat.
  122. =head1 LICENSE
  123. This module is free software; you can redistribute it or modify it under
  124. the same terms as Perl itself.
  125. =cut