#!/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 = &not_implemented;
   return $output;
}

sub add_local_alias {
   my $output = &not_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
[download]