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 my $wlib = "$progdir/soepkiptng_web.lib";
  43
  44 require "$progdir/soepkiptng.lib";
  45
  46 my $cgiquery;
  47
  48 ############################################################################
  49 # SUBROUTINES
  50
  51 sub printhttphdr($) {
  52         my ($cookies) = @_;
  53
  54         my $cookie;
  55         if($cookies) {
  56                 $cookie = $cgiquery->cookie(
  57                         -name=>'sv',
  58                         -value=>$cookies,
  59                         -path=>'/',
  60                         -expires=>'+365d');
  61         }
  62         print $cgiquery->header(
  63                 -type=>"text/html; charset=ISO-8859-15",
  64                 -cookie=>$cookie);
  65 }
  66
  67 sub require_write_access() {
  68 return; #FIXME
  69         if($conf{write_access_func} &&
  70                 !eval $conf{write_access_func}) {
  71
  72                 printhtmlhdr;
  73                 printhdr($conf{allstyle});
  74                 print "<b>Access Denied.</b>\n";
  75                 printftr;
  76                 exit;
  77         }
  78 }
  79
  80 sub reloadlib()
  81 {
  82         local $mtime;
  83
  84         my ($m, $c) = (stat $wlib)[9,10];
  85         if($c > $m) { $m = $c };
  86         return if $m <= $mtime;
  87         $mtime = $m;
  88         delete $INC{$wlib};
  89         require $wlib;
  90 }
  91
  92 sub send_file($$$)
  93 {
  94         my ($h, $f, $m) = @_;
  95         local *F;
  96
  97         open F, $f or do {
  98                 warn "send_file: $f: $!\n";
  99                 return;
 100         };
 101         $conn->print(sprintf(<<EOF, $m, (-s F)));
 102 HTTP/1.0 200 OK
 103 Content-Type: %s
 104 Content-Length: %d
 105
 106 EOF
 107         my $buf;
 108         while(read F, $buf, 4096) {
 109                 $conn->print($buf);
 110         }
 111         close F;
 112 }
 113
 114 sub run_instance() {
 115         local $lifetime = $opt_l || $conf{httpd_lifetime} || 100;
 116         local $conn;
 117
 118         $SIG{HUP} = sub {
 119                 if(defined($conn)) {
 120                         # busy, exit after finishing current request
 121                         $lifetime = 0;
 122                 } else {
 123                         warn "\n=====pid$$ SIGHUP caught, exiting\n";
 124                         exit 0;
 125                 }
 126         };
 127
 128         my $dbh = DBI->connect("DBI:$conf{db_type}:$conf{db_name}:$conf{db_host}",
 129                 $conf{db_user}, $conf{db_pass}) or die "can't connect to database";
 130
 131         my $i;
 132         for($i = 0; $i < $lifetime; $i++) {
 133                 $conn = $daemon->accept or die "accept: $!\n";
 134                 reloadlib();
 135                 if(!$dbh->ping) {
 136                         $dbh->disconnect;
 137                         $dbh = DBI->connect("DBI:$conf{db_type}:$conf{db_name}:$conf{db_host}",
 138                                 $conf{db_user}, $conf{db_pass}) or die "can't connect to database";
 139                 }
 140
 141                 my $r = $conn->get_request or next;
 142                 warn "\n=====pid$$->$i===== r->uri=[" . $r->uri . "]===\n";
 143                 my $content;
 144                 if($r->method eq "GET") {
 145                         $r->uri =~ /\?(.*)/ and $content = $1;
 146                         if($r->uri =~ m~^/(\w+\.(gif|ico))$~) {
 147                                 send_file($conn, "$progdir/web/$1", "image/gif");
 148                                 $conn->close;
 149                                 next;
 150                         }
 151                 } elsif($r->method eq "POST") {
 152                         $content = $r->content;
 153                 } else {
 154                         die "invalid request\n";
 155                 }
 156
 157                 $ENV{HTTP_COOKIE} = $r->header('cookie');
 158                 $cgiquery = new CGI($content || "");
 159
 160                 my $req;
 161                 $req->{dbh} = $dbh;
 162                 $req->{cgiquery} = $cgiquery;
 163                 $req->{self} = "/";
 164                 $req->{host} = inet_ntoa($conn->peeraddr);
 165                 my %cookies = $cgiquery->cookie('sv');
 166                 $req->{cookies} = \%cookies;
 167                 open STDOUT, ">&=" . $conn->fileno;
 168                 handle_request($req);
 169                 close STDOUT;
 170
 171                 $conn->close;
 172         }
 173         warn "$i connections served, exiting.\n";
 174 }
 175
 176
 177 ############################################################################
 178 # MAIN
 179
 180 getopts('dhp:i:l:c:F');
 181
 182 $opt_h and die <<EOF;
 183
 184 Usage: soepkiptng_httpd [-dFh] [-p port] [-i servers] [-l maxrequests]
 185
 186 Options:
 187  -d             : don't daemonize, log to stdout/stderr.
 188  -F             : stay in foreground
 189  -h             : get this help
 190  -p port        : port to listen on
 191  -i servers     : number of child processes the parent process will spawn
 192  -l maxrequests : the number of requests each child process is allowed to
 193                   process before it dies (to avoid problems like memory leaks
 194                   after prolonged use)
 195
 196 EOF
 197
 198 read_configfile(\%conf, $opt_c);
 199
 200 my $port = $opt_p || $conf{httpd_port} || 80;
 201 $daemon = new HTTP::Daemon(LocalPort => $port, ReuseAddr => 1)
 202         or die "port $port: $!\n";
 203
 204 if(!$opt_d) {
 205         if(!$opt_F) { fork && exit; }
 206         setpgrp;
 207         chdir "/";
 208         open STDIN, "</dev/null";
 209         if(defined($conf{httpd_errfile})) {
 210                 rename $conf{httpd_errfile}, "$conf{httpd_errfile}.old";
 211                 open STDOUT, ">$conf{httpd_errfile}";
 212         } else {
 213                 open STDOUT, ">/dev/null";
 214         }
 215         open STDERR, ">&STDOUT";
 216 }
 217
 218 local %pids;
 219
 220 $SIG{HUP} = sub {
 221         $reread = 1;
 222         kill 1, keys %pids;
 223 };
 224
 225 $SIG{USR1} = sub {
 226         warn "master: killing -9 all children\n";
 227         kill 9, keys %pids;
 228         $doexec = 1;
 229 };
 230
 231 my $httpd_instances = $opt_i || $conf{httpd_instances} || 2;
 232 warn "master starting, pid=$$\n";
 233 for(;;) {
 234         my $pid;
 235
 236         if($doexec) {
 237                 warn "master $$: exec self [$0]\n";
 238                 exec $0, @ARGV;
 239                 warn "master $$: exec self: $!\n";
 240         }
 241         if($reread) {
 242                 %conf = undef;
 243                 warn "master: rereading configfile\n";
 244                 read_configfile(\%conf, $opt_c);
 245                 $reread = 0;
 246         }
 247
 248         while(keys %pids < $httpd_instances) {
 249                 if(($pid = fork) == 0) {
 250                         %pids = ();
 251                         run_instance();
 252                         exit 0;
 253                 }
 254                 next if !defined($pid);
 255                 warn "forked child, pid=$pid\n";
 256                 $pids{$pid} = 1;
 257         }
 258         my $pid = wait;
 259         delete $pids{$pid};
 260         if($?) { sleep 1; } # rate-limit failing children
 261 }