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 LWP::UserAgent;
  32 use Socket;
  33
  34 # find program directory
  35 $_ = $0;
  36 while(-l) {
  37         my $l = readlink or die "readlink $_: $!\n";
  38         if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  39 }
  40 m|(.*)/|;
  41 my $progdir = abs_path($1);
  42
  43 require "$progdir/soepkiptng.lib";
  44 require "$progdir/soepkiptng_web.lib";
  45
  46 my $cgiquery;
  47
  48 ############################################################################
  49 # SUBROUTINES
  50
  51 sub get_host($) {
  52         my ($req) = @_;
  53
  54         return scalar gethostbyaddr($req->peeraddr, AF_INET);
  55 }
  56
  57 sub printhttphdr() {
  58         print $cgiquery->header("text/html");
  59 }
  60
  61 sub require_write_access() {
  62 return; #FIXME
  63         if($conf{write_access_func} &&
  64                 !eval $conf{write_access_func}) {
  65
  66                 printhtmlhdr;
  67                 printhdr($conf{allstyle});
  68                 print "<b>Access Denied.</b>\n";
  69                 printftr;
  70                 exit;
  71         }
  72 }
  73
  74 sub run_instance() {
  75         local $lifetime = $opt_l || $conf{httpd_lifetime} || 100;
  76         local $conn;
  77
  78         $SIG{HUP} = sub {
  79                 if(defined($conn)) {
  80                         # busy, exit after finishing current request
  81                         $lifetime = 0;
  82                 } else {
  83                         warn "\n=====pid$$ SIGHUP caught, exiting\n";
  84                         exit 0;
  85                 }
  86         };
  87
  88         my $dbh = DBI->connect("DBI:$conf{db_type}:$conf{db_name}:$conf{db_host}",
  89                 $conf{db_user}, $conf{db_pass}) or die "can't connect to database";
  90
  91         my $i;
  92         for($i = 0; $i < $lifetime; $i++) {
  93                 $conn = $daemon->accept or die "accept: $!\n";
  94                 my $req = $conn->get_request or next;
  95                 warn "\n=====pid$$->$i===== req->uri=[" . $req->uri . "]===\n";
  96                 my $content;
  97                 if($req->method eq "GET") {
  98                         ($content = $req->uri) =~ s/.*?\?//;
  99                 } elsif($req->method eq "POST") {
 100                         $content = $req->content;
 101                 } else {
 102                         die "invalid request\n";
 103                 }
 104                 $cgiquery = new CGI($content);
 105                 open STDOUT, ">&=" . $conn->fileno;
 106                 handle_request($dbh, $cgiquery, "/", $conn);
 107                 close STDOUT;
 108                 $conn = undef;
 109         }
 110         warn "$i connections served, exiting.\n";
 111 }
 112
 113
 114 ############################################################################
 115 # MAIN
 116
 117 getopts('dhp:i:l:c:');
 118
 119 $opt_h and die <<EOF;
 120
 121 Usage: soepkiptng_httpd [-dh] [-p port] [-i servers] [-l maxrequests]
 122
 123 Options:
 124  -d             : don't daemonize, log to stdout/stderr.
 125  -h             : get this help
 126  -p port        : port to listen on
 127  -i servers     : number of child processes the parent process will spawn
 128  -l maxrequests : the number of requests each child process is allowed to
 129                   process before it dies (to avoid problems like memory leaks
 130                   after prolonged use)
 131
 132 EOF
 133
 134 read_configfile(\%conf, $opt_c);
 135
 136 my $port = $opt_p || $conf{httpd_port} || 80;
 137 $daemon = new HTTP::Daemon(LocalPort => $port, ReuseAddr => 1)
 138         or die "port $port: $!\n";
 139
 140 if(!$opt_d) {
 141         fork && exit;
 142         setpgrp;
 143         chdir "/";
 144         open STDIN, "</dev/null";
 145         if(defined($conf{httpd_errfile})) {
 146                 rename $conf{httpd_errfile}, "$conf{httpd_errfile}.old";
 147                 open STDOUT, ">$conf{httpd_errfile}";
 148         } else {
 149                 open STDOUT, ">/dev/null";
 150         }
 151         open STDERR, ">&STDOUT";
 152 }
 153
 154 local %pids;
 155
 156 $SIG{HUP} = sub {
 157         $reread = 1;
 158         kill 1, keys %pids;
 159 };
 160
 161 $SIG{USR1} = sub {
 162         warn "master: killing -9 all children\n";
 163         kill 9, keys %pids;
 164         $doexec = 1;
 165 };
 166
 167 my $httpd_instances = $opt_i || $conf{httpd_instances} || 2;
 168 warn "master starting, pid=$$\n";
 169 for(;;) {
 170         my $pid;
 171
 172         if($doexec) {
 173                 warn "master $$: exec self [$0]\n";
 174                 exec $0, @ARGV;
 175                 warn "master $$: exec self: $!\n";
 176         }
 177         if($reread) {
 178                 %conf = undef;
 179                 warn "master: rereading configfile\n";
 180                 read_configfile(\%conf, $opt_c);
 181                 $reread = 0;
 182         }
 183
 184         while(keys %pids < $httpd_instances) {
 185                 if(($pid = fork) == 0) {
 186                         %pids = ();
 187                         run_instance();
 188                         exit 0;
 189                 }
 190                 next if !defined($pid);
 191                 warn "forked child, pid=$pid\n";
 192                 $pids{$pid} = 1;
 193         }
 194         my $pid = wait;
 195         delete $pids{$pid};
 196         if($?) { sleep 1; } # rate-limit failing children
 197 }