Howdy monks. I'm writing an application for a web and e-mail hosting company that will allow customers to change the e-mail settings for their domain. I've come up with some code, and I'd like to submit it here for general comments. Also, I'd obviously like to add some form of authentication/authorization to the application, and I'd really appreciate some suggestions for appropriate modules to use.
#!/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 = "<h1>Sorry, this function isn't implemented yet</h1>";
$output .= '<a href="mail.cgi">Return home</a>';
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
Any kind of constructive criticism is greatly appreciated. Thanks. :)