soepkiptng_httpd

   1 #!/usr/bin/perl
   2 ############################################################################
   3 # soepkiptng (c) copyright 2000 Eric Lammerts <eric@lammerts.org>.
   4 # $Id$
   5
   6 ############################################################################
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License, version 2, as
   9 # published by the Free Software Foundation.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20 ############################################################################
  21
  22 # $Id$
  23
  24 use Cwd 'abs_path';
  25 use CGI qw/-nph/;
  26 use DBI;
  27 use Getopt::Std;
  28 use HTTP::Daemon;
  29 use HTTP::Status;
  30 use IO::Socket;
  31 use Socket;
  32
  33 # find program directory
  34 $_ = $0;
  35 while(-l) {
  36         my $l = readlink or die "readlink $_: $!\n";
  37         if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  38 }
  39 m|(.*)/|;
  40 my $progdir = abs_path($1);
  41
  42 require "$progdir/soepkiptng.lib";
  43 require "$progdir/soepkiptng_web.lib";
  44
  45 my $cgiquery;
  46
  47 ############################################################################
  48 # SUBROUTINES
  49
  50 sub get_host($) {
  51         my ($req) = @_;
  52
  53         return scalar gethostbyaddr($req->peeraddr, AF_INET);
  54 }
  55
  56 sub printhttphdr() {
  57         print $cgiquery->header("text/html");
  58 }
  59
  60 sub require_write_access() {
  61 return; #FIXME
  62         if($conf{write_access_func} &&
  63                 !eval $conf{write_access_func}) {
  64
  65                 printhtmlhdr;
  66                 printhdr($conf{allstyle});
  67                 print "<b>Access Denied.</b>\n";
  68                 printftr;
  69                 exit;
  70         }
  71 }
  72
  73 sub run_instance() {
  74         local $lifetime = $opt_l || $conf{httpd_lifetime} || 100;
  75         local $conn;
  76
  77         $SIG{HUP} = sub {
  78                 if(defined($conn)) {
  79                         # busy, exit after finishing current request
  80                         $lifetime = 0;
  81                 } else {
  82                         warn "\n=====pid$$ SIGHUP caught, exiting\n";
  83                         exit 0;
  84                 }
  85         };
  86
  87         my $dbh = DBI->connect("DBI:$conf{db_type}:$conf{db_name}:$conf{db_host}",
  88                 $conf{db_user}, $conf{db_pass}) or die "can't connect to database";
  89
  90         my $i;
  91         for($i = 0; $i < $lifetime; $i++) {
  92                 $conn = $daemon->accept or die "accept: $!\n";
  93                 my $req = $conn->get_request or next;
  94                 warn "\n=====pid$$->$i===== req->uri=[" . $req->uri . "]===\n";
  95                 my $content;
  96                 if($req->method eq "GET") {
  97                         ($content = $req->uri) =~ s/.*?\?//;
  98                 } elsif($req->method eq "POST") {
  99                         $content = $req->content;
 100                 } else {
 101                         die "invalid request\n";
 102                 }
 103                 $cgiquery = new CGI($content);
 104                 open STDOUT, ">&=" . $conn->fileno;
 105                 handle_request($dbh, $cgiquery, "/", $conn);
 106                 close STDOUT;
 107                 $conn = undef;
 108         }
 109         warn "$i connections served, exiting.\n";
 110 }
 111
 112
 113 ############################################################################
 114 # MAIN
 115
 116 getopts('dhp:i:l:c:');
 117
 118 $opt_h and die <<EOF;
 119
 120 Usage: soepkiptng_httpd [-dh] [-p port] [-i servers] [-l maxrequests]
 121
 122 Options:
 123  -d             : don't daemonize, log to stdout/stderr.
 124  -h             : get this help
 125  -p port        : port to listen on
 126  -i servers     : number of child processes the parent process will spawn
 127  -l maxrequests : the number of requests each child process is allowed to
 128                   process before it dies (to avoid problems like memory leaks
 129                   after prolonged use)
 130
 131 EOF
 132
 133 read_configfile(\%conf, $opt_c);
 134
 135 my $port = $opt_p || $conf{httpd_port} || 80;
 136 $daemon = new HTTP::Daemon(LocalPort => $port, ReuseAddr => 1)
 137         or die "port $port: $!\n";
 138
 139 if(!$opt_d) {
 140         fork && exit;
 141         setpgrp;
 142         chdir "/";
 143         open STDIN, "</dev/null";
 144         if(defined($conf{httpd_errfile})) {
 145                 rename $conf{httpd_errfile}, "$conf{httpd_errfile}.old";
 146                 open STDOUT, ">$conf{httpd_errfile}";
 147         } else {
 148                 open STDOUT, ">/dev/null";
 149         }
 150         open STDERR, ">&STDOUT";
 151 }
 152
 153 local %pids;
 154
 155 $SIG{HUP} = sub {
 156         $reread = 1;
 157         kill 1, keys %pids;
 158 };
 159
 160 $SIG{USR1} = sub {
 161         warn "master: killing -9 all children\n";
 162         kill 9, keys %pids;
 163         $doexec = 1;
 164 };
 165
 166 my $httpd_instances = $opt_i || $conf{httpd_instances} || 2;
 167 warn "master starting, pid=$$\n";
 168 for(;;) {
 169         my $pid;
 170
 171         if($doexec) {
 172                 warn "master $$: exec self [$0]\n";
 173                 exec $0, @ARGV;
 174                 warn "master $$: exec self: $!\n";
 175         }
 176         if($reread) {
 177                 %conf = undef;
 178                 warn "master: rereading configfile\n";
 179                 read_configfile(\%conf, $opt_c);
 180                 $reread = 0;
 181         }
 182
 183         while(keys %pids < $httpd_instances) {
 184                 if(($pid = fork) == 0) {
 185                         %pids = ();
 186                         run_instance();
 187                         exit 0;
 188                 }
 189                 next if !defined($pid);
 190                 warn "forked child, pid=$pid\n";
 191                 $pids{$pid} = 1;
 192         }
 193         my $pid = wait;
 194         delete $pids{$pid};
 195         if($?) { sleep 1; } # rate-limit failing children
 196 }