soepkiptng_httpd

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