view release on metacpan or  search on metacpan

lib/Apache/DnsZone.pm  view on Meta::CPAN

package Apache::DnsZone;

# $Id: DnsZone.pm,v 1.41 2001/06/26 19:58:04 thomas Exp $

use strict;
use Exporter;
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA);

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(Debug);
%EXPORT_TAGS = ();
$VERSION = '0.2';

use Apache ();
use Apache::Constants qw(:common REDIRECT);
use Apache::Request ();
use Apache::DnsZone::Config;
use Apache::DnsZone::Resolver;
use Apache::DnsZone::DB;
use Apache::DnsZone::Language;
use Apache::DnsZone::AuthCookie;
use Net::DNS;
use Net::IP qw(:PROC);
use HTML::Entities;
use Email::Valid;
use CGI::FastTemplate;
use Data::Dumper;

my %lang = ();
my $cfg;
my $res;
my $dbh;
my $apr;
my $DebugLevel = 1;

sub init {
    my $r = shift || Apache->request();
    $cfg = Apache::DnsZone::Config->new($r);
    $res = Apache::DnsZone::Resolver->new();
    $dbh = Apache::DnsZone::DB->new($cfg);
    $apr = Apache::Request->instance($r, DISABLE_UPLOADS => 1, POST_MAX => 1024);
    my $status = $apr->parse;
    if ($status) {
	my $errmsg = $apr->notes("error-notes");
	Debug(1, qq{Apache::Request error: $errmsg});
	return $status;
    }
}

sub Debug {
    my $level = shift;
    if ($level <= $Apache::DnsZone::DebugLevel) {
	if ($_[-1] !~ /\n$/) {
	    warn("[DnsZone]: ", @_, "\n");
	} else {
	    warn("[DnsZone]: ", @_);
	}
    }
}

sub lang {
    my $lang = shift;
    return Apache::DnsZone::Language->fetch($cfg, $lang);
}

sub apr {
    return $apr;
}

sub cfg {
    return $cfg->{'cfg'};
}

###############################################
# check_ip(ip)                                #
# Checks ip for a valid ip address for a host #
# returns 0 on anything else than valid ip    #
###############################################

# might be swithced out with some of Net::IP's functions
sub check_ip ($) {

lib/Apache/DnsZone.pm  view on Meta::CPAN

#		$r->push_handlers(PerlHandler => \&help);
#		return OK;
	    } 
	}
	if ($action eq 'view') {
	    Debug(3, qq{pushing view_domain() to PerlHandler});
	    $r->push_handlers(PerlHandler => \&view_domain);
	} elsif ($action eq 'edit') {
	    Debug(3, qq{pushing edit_record() to PerlHandler});
	    $r->push_handlers(PerlHandler => \&edit_record);
	} elsif ($action eq 'add') {
	    Debug(3, qq{pushing add_record() to PerlHandler});
	    $r->push_handlers(PerlHandler => \&add_record);
        } elsif ($action eq 'delete') {
  	    Debug(3, qq{pushing delete_record() to PerlHandler});
	    $r->push_handlers(PerlHandler => \&delete_record);
        } elsif ($action eq 'settings') {
  	    Debug(3, qq{pushing settings() to PerlHandler});
	    $r->push_handlers(PerlHandler => \&settings);
	} elsif ($action eq 'logout') {
	    Debug(3, qq{pushing logout() to PerlHandler});
	    $r->push_handlers(PerlHandler => \&logout);
	} else {
  	    Debug(3, qq{pushing default_page_handler() to PerlHandler});
	    $r->push_handlers(PerlHandler => \&default_page_handler);
	}
    } else {
        Debug(3, qq{pushing default_page_handler() to PerlHandler});
	$r->push_handlers(PerlHandler => \&default_page_handler);
    }
    return OK;
}

sub default_page_handler {
    my $r = shift || Apache->request();
    Debug(3, qq{calling default_page_handler()});
    init($r);
    my $user = $r->connection->user;
    my ($uid, $email, $lang_id, $lang) = $dbh->get_user_info($user);
    my $dom_count = $dbh->get_domain_count($uid);
    if ($dom_count == 1) {
	# In case the user only has one domain we redirect to his admin page right away
	my $dom_id = $dbh->get_one_domain_id($uid);
	output_redirect($r, 1, qq{/admin?action=view&dom_id=$dom_id});
	$dbh->close();
	return REDIRECT;
    } else {
	# make a list of domains to manage
	$r->push_handlers(PerlHandler => \&list_domains);
    }
    $dbh->close();
    return OK;
}

sub logout {
    my $r = shift || Apache->request();
    Debug(3, qq{calling logout()});
    init($r);
    output_redirect($r, 1, $cfg->{'cfg'}->{DnsZoneLogoutHandler});
#    $r->push_handlers(PerlHandler => sub {
#      Apache::DnsZone::AuthCookie->logout(Apache->request);
#    });
    $dbh->close();
    return REDIRECT;
}

sub list_domains {
    my $r = shift || Apache->request();
    Debug(3, qq{calling list_domains()});
    init($r); 
    my ($uid, $email, $lang_id, $lang) = $dbh->get_user_info($r->connection->user);

    my $sth_dom = $dbh->list_domains_prepare($uid);

    my $tpl = new CGI::FastTemplate($cfg->{'cfg'}->{DnsZoneTemplateDir});
    $tpl->define(layout => 'layout.tpl', list => 'list_domain.tpl', record => 'list_domain_record.tpl', menu => 'menu.tpl');
    $tpl->assign(%lang);
    $tpl->assign(TITLE => $lang{'PAGE_LIST_DOMAIN'});
    $tpl->assign(DEBUG => '');
    
    if ($dbh->get_domain_count($uid) == 1) {
	$tpl->assign(ADDITIONAL_MENU => '');
    } else {
	$tpl->assign(ADDITIONAL_MENU => qq{<a href="/admin?action=default">$lang{LIST_DOMAIN}</a> | });
    }

    while (my ($dom_id, $domain) = $sth_dom->fetchrow_array()) {
	$tpl->assign(DOMAIN => qq{<a href="/admin?action=view&dom_id=$dom_id">$domain</a><br>\n});
	$tpl->parse(LIST => ".record");
    }
    $sth_dom->finish();

    $tpl->parse(MENU => "menu");
    $tpl->parse(MAIN => ["list", "layout"]);

    my $content_ref = $tpl->fetch("MAIN");

    output_headers($r, 1, length(${$content_ref}));

    $r->print(${$content_ref});

    $dbh->close();
    return OK;
}

#sub help {
#    my $r = shift || Apache->request();
#    Debug(3, qq{calling help()});
#    init($r);
#
#    unless (apr()->param('type')) {
#	$r->log_reason("No type specified for help");
#	output_redirect($r, 0, '/admin');
#	$dbh->close();
#	return REDIRECT;
#    }
#    my $type = uc apr()->param('type');
#    ($type) = ($type =~ /(\w+)/)[0];
#    if ($type !~ /^\w+$/) {
#	$r->log_reason("User tried to supply bogus type data in the help");
#	output_redirect($r, 0, '/admin');