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 = DBI->connect("DBI:$conf{db_type}:$conf{db_name}:$conf{db_host}",
 127                 $conf{db_user}, $conf{db_pass}) or die "can't connect to database";
 128
 129         my $i;
 130         for($i = 0; $i < $lifetime; $i++) {
 131                 $conn = $daemon->accept or die "accept: $!\n";
 132                 reloadlib();
 133                 if(!$dbh->ping) {
 134                         $dbh->disconnect;
 135                         $dbh = DBI->connect("DBI:$conf{db_type}:$conf{db_name}:$conf{db_host}",
 136                                 $conf{db_user}, $conf{db_pass}) or die "can't connect to database";
 137                 }
 138
 139                 my $r = $conn->get_request or next;
 140                 warn "\n=====pid$$->$i===== r->uri=[" . $r->uri . "]===\n";
 141                 my $content;
 142                 if($r->method eq "GET") {
 143                         $r->uri =~ /\?(.*)/ and $content = $1;
 144                         if($r->uri =~ m~^/(\w+\.(gif|ico))$~) {
 145                                 send_file($conn, "$progdir/web/$1", "image/gif");
 146                                 $conn->close;
 147                                 next;
 148                         }
 149                 } elsif($r->method eq "POST") {
 150                         $content = $r->content;
 151                 } else {
 152                         die "invalid request\n";
 153                 }
 154
 155                 $ENV{HTTP_COOKIE} = $r->header('cookie');
 156                 $cgiquery = new CGI($content || "");
 157
 158                 my $req;
 159                 $req->{dbh} = $dbh;
 160                 $req->{cgiquery} = $cgiquery;
 161                 $req->{self} = "/";
 162                 $req->{host} = inet_ntoa($conn->peeraddr);
 163                 my %cookies = $cgiquery->cookie('sv');
 164                 $req->{cookies} = \%cookies;
 165                 open STDOUT, ">&=" . $conn->fileno;
 166                 handle_request($req);
 167                 close STDOUT;
 168
 169                 $conn->close;
 170         }
 171         warn "$i connections served, exiting.\n";
 172 }
 173
 174
 175 ############################################################################
 176 # MAIN
 177
 178 getopts('dhp:i:l:c:F');
 179
 180 $opt_h and die <<EOF;
 181
 182 Usage: soepkiptng_httpd [-dFh] [-p port] [-i servers] [-l maxrequests]
 183
 184 Options:
 185  -d             : don't daemonize, log to stdout/stderr.
 186  -F             : stay in foreground
 187  -h             : get this help
 188  -p port        : port to listen on
 189  -i servers     : number of child processes the parent process will spawn
 190  -l maxrequests : the number of requests each child process is allowed to
 191                   process before it dies (to avoid problems like memory leaks
 192                   after prolonged use)
 193
 194 EOF
 195
 196 read_configfile(\%conf, $opt_c);
 197
 198 my $port = $opt_p || $conf{httpd_port} || 80;
 199 $daemon = new HTTP::Daemon(LocalPort => $port, ReuseAddr => 1)
 200         or die "port $port: $!\n";
 201
 202 if(!$opt_d) {
 203         if(!$opt_F) { fork && exit; }
 204         setpgrp;
 205         chdir "/";
 206         open STDIN, "</dev/null";
 207         if(defined($conf{httpd_errfile})) {
 208                 rename $conf{httpd_errfile}, "$conf{httpd_errfile}.old";
 209                 open STDOUT, ">$conf{httpd_errfile}";
 210         } else {
 211                 open STDOUT, ">/dev/null";
 212         }
 213         open STDERR, ">&STDOUT";
 214 }
 215
 216 local %pids;
 217
 218 $SIG{HUP} = sub {
 219         $reread = 1;
 220         kill 1, keys %pids;
 221 };
 222
 223 $SIG{USR1} = sub {
 224         warn "master: killing -9 all children\n";
 225         kill 9, keys %pids;
 226         $doexec = 1;
 227 };
 228
 229 my $httpd_instances = $opt_i || $conf{httpd_instances} || 2;
 230 warn "master starting, pid=$$\n";
 231 for(;;) {
 232         my $pid;
 233
 234         if($doexec) {
 235                 warn "master $$: exec self [$0]\n";
 236                 exec $0, @ARGV;
 237                 warn "master $$: exec self: $!\n";
 238         }
 239         if($reread) {
 240                 %conf = undef;
 241                 warn "master: rereading configfile\n";
 242                 read_configfile(\%conf, $opt_c);
 243                 $reread = 0;
 244         }
 245
 246         while(keys %pids < $httpd_instances) {
 247                 if(($pid = fork) == 0) {
 248                         %pids = ();
 249                         run_instance();
 250                         exit 0;
 251                 }
 252                 next if !defined($pid);
 253                 warn "forked child, pid=$pid\n";
 254                 $pids{$pid} = 1;
 255         }
 256         my $pid = wait;
 257         delete $pids{$pid};
 258         if($?) { sleep 1; } # rate-limit failing children
 259 }