web/index.cgi

   1 #!/usr/bin/perl
   2
   3 ############################################################################
   4 # soepkiptng (c) copyright 2000 Eric Lammerts <eric@lammerts.org>.
   5 # $Id$
   6
   7 ############################################################################
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License, version 2, as
  10 # published by the Free Software Foundation.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 ############################################################################
  22
  23 BEGIN {
  24         # find program directory
  25         $_ = $0;
  26         while(-l) {
  27                 my $l = readlink or die "readlink $_: $!\n";
  28                 if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  29         }
  30         m|(.*)/|;
  31         (my $progdir = Cwd::abs_path($1)) =~ s|/+[^/]+$||;
  32
  33         require "$progdir/soepkiptng.lib";
  34         require "$progdir/soepkiptng_web.lib";
  35 }
  36
  37 ############################################################################
  38 # SUBROUTINES
  39
  40 sub printhttphdr() {
  41         my $r = Apache->request;
  42         $r->content_type("text/html; charset=ISO-8859-15");
  43         $r->send_http_header;
  44 }
  45
  46 sub require_write_access() {
  47         if($conf{write_access_func} &&
  48                 !eval $conf{write_access_func}) {
  49
  50                 printhtmlhdr;
  51                 printhdr($conf{allstyle});
  52                 print "<b>Access Denied.</b>\n";
  53                 printftr;
  54                 exit;
  55         }
  56 }
  57
  58
  59 ############################################################################
  60 # MAIN
  61
  62 read_configfile(\%conf);
  63
  64 my $dbh = DBI->connect("DBI:mysql:$conf{db_name}:$conf{db_host}",
  65         $conf{db_user},$conf{db_pass}, {mysql_client_found_rows =>1 })
  66         or die "can't connect to database...$!\n";
  67
  68 my $cgiquery = new CGI;
  69
  70 my $r = Apache->request;
  71 $r->no_cache(1);
  72
  73 my $req;
  74 $req->{dbh} = $dbh;
  75 $req->{cgiquery} = $cgiquery;
  76 $req->{self} = $cgiquery->script_name();
  77 $req->{host} = $r->header_in('X-Forwarded-For') || $r->get_remote_host();
  78
  79 handle_request($req);
  80
  81 untie %session;
  82
  83 $dbh->disconnect();