#!/usr/bin/perl -w
package MailAdmin;
use strict;
use DBI;
use Pod::Usage;
use HTML::Template;
use base 'CGI::Application';
# constants
my $TITLE = 'Biosysadmin.com E-mail Configuration';
my $dbh = &get_dbh;
my $template = HTML::Template->new( filename => 'mail.tmpl' );
# set up everything correctly
sub setup {
my $self = shift;
$self->start_mode( 'mode1' );
$self->run_modes( 'mode1' => 'print_aliases',
'mode2' => 'add_remote_alias',
'mode3' => 'add_local_alias'
);
$self->param( 'dbh' => $dbh );
$self->param( 'template' => $template );
}
# shut down everything after application exits
sub teardown {
my $self = shift;
$self->param('dbh')->disconnect;
}
sub print_aliases {
my $self = shift;
# get the CGI query object
my $q = $self->query();
my $domain;
if ( $q->param( 'domain' ) ) {
$domain = $q->param( 'domain' );
$template->param( 'DOMAIN' => $domain );
$template->param( 'TABLE' => 1 );
} else {
$template->param( 'TABLE' => 0 );
}
# get a list of the local aliases
my %aliases = %{ get_domain_addresses( $domain ) };
my @loop_data; $tmpl_hash{'ADDRESS'} = $address;
push @loop_data, \%tmpl_hash;
}
$template->param( 'ALIASES' => \@loop_data );
$template->param( 'TITLE' => $TITLE );
# form a list of printed domains
my @domains = @{ &get_valid_domains };
my @form_loop;
foreach my $domain ( @domains ) {
my %tmpl_hash;
$tmpl_hash{'DOMAIN'} = $domain;
push @form_loop, \%tmpl_hash;
}
$template->param( 'DOMAINS' => \@form_loop );
# develop the printed output
my $output = $template->output;
return $output;
}
sub not_implemented {
my $output = "
Sorry, this function isn't implemented yet
";
$output .= 'Return home';
return $output;
}
sub add_remote_alias {
my $output = ¬_implemented;
return $output;
}
sub add_local_alias {
my $output = ¬_implemented;
return $output;
}
###################
# DBI subroutines #
###################
sub add_alias {
my ($user,$alias) = shift;
print "Delivering mail to $alias for user $user ...\n";
my $uid = uid( $user );
my $gid = gid( $user );
my $sql;
$sql = "INSERT INTO aliases (vuid,vgid,alias,maildir) ";
$sql .= "VALUES (?,?,?,?);";
my $sth = $dbh->prepare( $sql ) or die $dbh->errstr;
$sth->execute( $uid,$gid,$alias,$user ) or warn $sth->errstr;
if ($@) {
print "Error executing SQL statement!\n";
}
}
sub get_valid_domains {
my($sql, $domain);
$sql = "SELECT domain FROM transport";
my $sth = $dbh->prepare( $sql ) or die $dbh->errstr;
$sth->execute();
$sth->bind_columns( \($domain) );
my @domains;
while ( $sth->fetch ) {
push @domains, $domain;
}
return \@domains;
}
sub get_local_aliases {
my $user = shift;
# local aliases
my ($vuid,$vgid,$address,$maildir);
my $sql = 'SELECT vuid,vgid,alias,maildir FROM aliases';
$sql .= " WHERE maildir='$user'";
my $sth = $dbh->prepare( $sql ) or die $dbh->errstr;
$sth->execute() or warn $sth->errstr;
$sth->bind_columns( \($vuid,$vgid,$address,$maildir) );
my @addresses;
while ( $sth->fetch ) {
push @addresses, $address;
}
return \@addresses;sub get_domain_addresses {
my $domain = shift;
# get the remote aliases
my ($alias,$rcpt,$sql);
$sql = 'SELECT alias,rcpt FROM remote_aliases ';
$sql .= "WHERE alias LIKE \"%\@$domain\"";
my $sth = $dbh->prepare( $sql ) or die $dbh->errstr;
$sth->execute() or warn $sth->errstr;
$sth->bind_columns( \($alias, $rcpt) );
my %addresses;
while( $sth->fetch ) {
$addresses{ $alias } = $rcpt;
}
# get the local aliases
my ($vuid,$vgid,$address,$maildir);
$sql = 'SELECT vuid,vgid,alias,maildir FROM aliases ';
$sql .= "WHERE alias LIKE \"%\@$domain\"";
$sth = $dbh->prepare( $sql ) or die $dbh->errstr;
$sth->execute() or warn $sth->errstr;
$sth->bind_columns( \($vuid,$vgid,$address,$maildir) );
while ( $sth->fetch ) {
$addresses{ $address } = $maildir;
}
return \%addresses;
}
sub get_dbh {
my $db_user = 'user';
my $db_pass = 'password';
my $db_table = 'table';
my $dsn = "DBI:mysql:$db_table";
my $dbh = DBI->connect( $dsn, $db_user, $db_pass )
or die "Error connecting to database\n";
return $dbh;
}
sub uid {
my $username = shift;
my $retval = `id -u $username`;
print $retval;
if ( $retval eq '' ) {
warn "Error obtaining gid information for $username\n";
} else {
return $retval;
}
}
sub gid {
my $username = shift;
my $retval = `id -g $username`;
if ( $retval eq '' ) {
warn "Error obtaining gid information for $username\n";
} else {
return $retval;
}
}
1