#!/usr/local/bin/perl5.8.8
#-------------------------------------------------------------------------
# $Id: manage.cgi,v 1.9 2002/01/13 18:54:12 psisson Exp $
# $Revision: 1.9 $
#
# Developed by VPOP Technologies, Inc. <admin@vpop.net>
# Author: Paul Sisson <psisson@users.sourceforge.net>
#-------------------------------------------------------------------------
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation,
# Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#-------------------------------------------------------------------------

require 5.005;

BEGIN {
	# edit the path to the config and lib directories
	$PATH_CONF = '/usr/local/www/htdocs/opensrs/etc/OpenSRS.conf';
	$PATH_LIB = '/usr/local/www/htdocs/opensrs/lib';

    srand( time() ^ ($$ + ($$ << 15)) );
    select(STDOUT);  $| = 1;
}

#=========================================================================

use lib $PATH_LIB;
use CGI qw(-oldstyle_urls); 
use CGI::Carp 'fatalsToBrowser';
use Util::Base;
use Util::EncryptHash;
use Domain::Manage;
use Session::Input;
use Session::Cookie;
use Session::Config;
use Session::Environment;

use strict;
use vars qw($PATH_CONF $PATH_LIB $DO_EXIT $REQUEST $HANDLING_REQUEST 
            %CONFIG $NO_SSL_CGI $SSL_CGI $SELF_URL $CGI $DEBUG 
            %COOKIES %in $AUTOLOAD $UTIL $MANAGE @UNPRIV_ACTIONS 
		    $INPUT $COOKIE $CONF $EHASH $ENV);

#=========================================================================
# setup exception handlers for persistence

$DO_EXIT = $HANDLING_REQUEST = 0;

sub sig_handler { $DO_EXIT = 1; exit(0) unless $HANDLING_REQUEST; }

$SIG{USR1} = \&sig_handler;
$SIG{TERM} = \&sig_handler;
$SIG{PIPE} = 'IGNORE';

sub _EXIT {
	no strict 'subs';
	goto ($CONFIG{use_fcgi} ? FCGI_NEXT : REQ_EXIT);
}

#=========================================================================
# LOCAL CONFIG

# utility flag
$DEBUG = 0;

# actions that do not require authentication
@UNPRIV_ACTIONS = qw(login logout send_password);

#=========================================================================
# MAIN LOGIC

# do startup initializations
check_referer();
init();

# do the magic
if ($CONFIG{use_fcgi}) {
	require FCGI;
	CGI->compile(':all');

	# start the request loop
	$REQUEST = FCGI::Request();

	while ($HANDLING_REQUEST = ($REQUEST->Accept() >= 0)) {
		handler();
        FCGI_NEXT:
		$REQUEST->Finish();
		$HANDLING_REQUEST = 0;
		last if $DO_EXIT;
	}
}
else {
	handler();
}

REQ_EXIT:
exit(0);

#=========================================================================
# SUBROUTINES
#=========================================================================

sub init {

	# check conf file
    unless (-f $PATH_CONF) {
        die "PATH_CONF invalid or not defined in $0\n";
    }

	# create persistent objects
	$ENV    = new Session::Environment;
	$CONF   = new Session::Config(path_conf => $PATH_CONF);
	%CONFIG = $CONF->getval();
	$EHASH  = new Util::EncryptHash(secret_key => $CONFIG{private_key});
	$UTIL   = new Util::Base(config => \%CONFIG);

	my $os = $ENV->getval('os');

    if ($os =~ /^(WINDOWS|VMS|OS2)$/) {
        binmode(STDOUT);
        binmode(STDIN);
        binmode(STDERR);
    }
	elsif ($os eq 'UNIX') {
		umask(022);
		delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
		$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin:/usr/sbin';
        $ENV{IFS}  = '/';
	}

	# set DoS limiters
	$CGI::POST_MAX        = 1024 * 1024;
	$CGI::DISABLE_UPLOADS = 1;

	# require hooks file
	if (-f $CONFIG{path_hooks} && -s _ && -r _) {
		require "$CONFIG{path_hooks}";
	}
}

#=========================================================================
# handler() - MAIN HANDLER - encapsulate the main logic here for 
#                            mod_fastcgi or mod_perl persistence

sub handler {
    undef $CGI;
    undef %COOKIES;
    undef %in;
	undef $MANAGE;

    CGI->initialize_globals();
    $CGI = new CGI;

	# /// provided for hooks and main:: scope /// 

	$INPUT  = new Session::Input(data => $CGI);
	$COOKIE = new Session::Cookie(cgi => $CGI);

	%in = $INPUT->getval();
	%COOKIES = $COOKIE->fetch();

	# gather new private input
	my $priv = $EHASH->decrypt($in{$CONFIG{enchash_key}});

	for (keys %in) {
		next unless /^$CONFIG{enchash_prefix}(.*)$/;
		$priv->{$1} = $INPUT->getval($_) unless defined($priv->{$1});
	}

	$INPUT->setval({$CONFIG{enchash_key} => $EHASH->encrypt($priv)});
	%in = $INPUT->getval();

    $NO_SSL_CGI = $ENV{SCRIPT_NAME};

	if ($CONFIG{ssl_server}) {
		$CONFIG{ssl_server} =~ s/\/$//;
		$SSL_CGI = $CONFIG{ssl_server} . $ENV{SCRIPT_NAME};
	} else {
		$SSL_CGI = $NO_SSL_CGI;
	}

    $SELF_URL = $NO_SSL_CGI;

	# ///////////////////////////// 
    # handle the request

	$MANAGE = new Domain::Manage( input  => $INPUT,
								  cookie => $COOKIE,
								  conf   => $CONF,
								);

	my @actions = $MANAGE->actions();

	if (grep(/^$in{action}$/, @actions)) {
		my $haction = 'h_' . $in{action};
		local(*sym) = $main::{$haction};
		$in{action} = $haction if defined(&sym);
	}

	# check hooks first
	if ($in{action} =~ /^h_/) {
		local(*sym) = $main::{$in{action}};

		unless (defined &sym) {
			die "No such subroutine '$in{action}' in hooks file\n";
		}

		no strict 'refs';
		return $in{action}->();
	}

	# not a hook
	if ($in{action} && grep(/^$in{action}$/, @UNPRIV_ACTIONS)) {
		return if do_action($in{action});
	}

	my $is_auth = $MANAGE->authenticate();

	return $MANAGE->print_login() if not $is_auth;
	return $MANAGE->main_menu()   if not $in{action};

	return if do_action($in{action});
	$MANAGE->main_menu("Invalid action: <b>$in{action}</b>");
}

#=========================================================================

sub do_action {
	my $action = shift;
	return 0 unless $action && $MANAGE->is_valid_action($action);

	eval "\$MANAGE->$action()";
	errexit("Internal Error: $@") if $@;
	return 1;
}

#=========================================================================

sub check_referer {

	return unless $ENV{HTTP_REFERER};
	return unless $CONFIG{check_referer} && $CONFIG{valid_referers};

	my @hosts = (ref($CONFIG{valid_referers}) eq 'ARRAY') ? 
                   @{$CONFIG{valid_referers}}             : 
                    ($CONFIG{valid_referers});

	push(@hosts, $CONFIG{cookie_domain}) unless @hosts;

	my $valid = join('|', map { quotemeta($_) } @hosts);
	return if $ENV{HTTP_REFERER} =~ /($valid)/;

	print "Status: 204 No Response\n";
	print "Content-type: text/html\n\n";
	_EXIT();
}

#=========================================================================

sub errexit {
	my $errstr = shift;
	my $errtpl = $UTIL->build_path('common','error.html');
	my %html   = ( error  => $errstr,
                   mailto => $CONFIG{email}{support} );

	my %tpl_args = ( base => $CONFIG{base_templates}{common},
                     page => $errtpl,
                     hash => \%html,
                   );
  
	$UTIL->print_tpl(%tpl_args);
	_EXIT;
}