####################################################
# It works on a Windows ME machine with dmail
# 2.8z5 and mysql, perl and DBI::Mysql.
# This module I name it niagaauth  and it supports the basic
# check,lookup,search and exit commands.
# It should work on any platform, I suppose. And the fact that it uses DBI
# means it will support any DBI compliance database such as Msql, Mysql
# and Oracle.
# 
# In the dmail.conf -> I used
# authent_process perl /auth/niagaauth.pl
# 
# I attached the file in this email if any of your users find it useful.
# 
# Thanks
# 
# Dean Wong
# (Please contact support-dmail@netwinsite.com in the first instance for 
# support questions)
####################################################
# NiagaAuth - A perl based external authentication 
#       module for Dmail - http://netwinsite.com/dmail/authprot.htm
# Version   - 0.2b
# Author    - Dean Wong 
# Email     - deanwong@niagasoft.com
####################################################
# History 
# ---------
# 0.1 - Only support the basic command 
#        check,lookup, exit
# 0.2 - Support Search 
#     - Use DBI - support any DBI compliance database
#                 (Mysql,mysql,Oracle .....)
#     - Works on Windows as well as Unix
# 
# Call the module in dmail.conf 
#    Eg. authent_process /usr/bin/perl /auth/niagaauth.pl
# 
####################################################

####################################################
# CONFIGURATION
####################################################
my $log=0; ## set 1 for debugging and logging
my $logfile="e:/dmail/niagaauth/log.txt2";    ## set the logfile
my $db_username='root';    ## d/b username
my $db_password='';     ## d/b password
my $db_host='localhost';  ## d/b hostname 
my $db_database='oneline';  ## d/b table name 
my $db_table='memberm';                 ## mail user table
my $db_type='mysql';   ## type of d/b
my $domain='';                          ## default domain to be appended
my $field_username='mm_user';  ## The label of the username field in your table. 
my $field_password='mm_passwd';  ## The label of the password field in your table.  
####################################################
# END CONFIGURATION
####################################################


####################################################
# IMPORT MODULES
####################################################
use strict;
use DBI;
$| =1;
####################################################
# INITIALIZE
####################################################
my $command;
my $exit=0;
my $cmdline;

####################################################
# MAIN ROUTINE
####################################################

my $count=0;
while (!$exit) {
 
 ## reading command
 chomp($command=<STDIN>);
 
 ## process command -- add extra command here
        if ($command eq 'exit') {
  $exit=1;
  print "+OK\n";
 } elsif ($command =~ m"check") {
  my ($cmd,$user_name,$password)=split(/\s+/,$command);
  my ($match,$info)=check($user_name,$password);
  if ($match) {
   print "+OK $user_name  config  0  $info\n";
  } else {
   print "-ERR $info\n";
  }
 } elsif ($command =~ m"lookup") {
  my ($cmd,$user_name)=split(/\s+/,$command);
  my ($match,$info)=lookup($user_name);
  $user_name=$user_name.'@'.$domain if ($domain ne '');
  if ($match) {
   print "+OK $user_name  config  0  $info\n";
  } else {
   print "-ERR $user_name $info\n";
  }
 } elsif ($command =~ m"search") {
  my ($cmd,$string)=split(/\s+/,$command);
  my @result=search($string);
  print join("\n",@result),"\n";
  print "+OK Search Complete ", scalar @result ," items found\n";
 }
} 


####################################################
# SUB ROUTINE
####################################################
sub check {
 my ($user_name,$password)=@_;
 my ($match,$info);
 my ($db_user,$db_pass)=retrieve_user($user_name);
 if (($user_name eq $db_user) &&
  ($password eq $db_pass)) {
  $match=1;
 } elsif ($db_user eq '')  {
  $match=0;
  $info="**Invalid username $user_name";
 } else {
  $match=0;
  $info="**Invalid password";
 } 
 return ($match,$info);
}

sub lookup {
 my $user_name=shift;
 my ($match,$info);
 my ($db_user,$db_pass)=retrieve_user($user_name);
 $user_name=$user_name.'@'.$domain if ($domain ne '');
 if ($user_name eq $db_user) {
  $match=1;
 } elsif ($db_user eq '')  {
  $match=0;
  $info="**Invalid username $user_name";
 }  
 return ($match,$info);
}

sub search {
 my $user_name=shift;
 my @result;
 my $dsn = "DBI:$db_type:$db_database:$db_host";
 my $dbh = DBI->connect($dsn, $db_username, $db_password); 
 my $drh = DBI->install_driver($db_type); 
 my $sql_statement = qq{
  select $field_username,$field_password from $db_table 
  where $field_username like  '%$user_name%'
 }; 
 my $sth = $dbh->prepare($sql_statement) || print FH "Can't prepare statement: $DBI::errstr";
 my $rc = $sth->execute
  || print FH "Can't execute statement: $DBI::errstr"; 
 while (my ($user,$pass)=$sth->fetchrow_array)  {
  $user=$user.'@'.$domain if ($domain ne '');
  push(@result,"+DATA $user");
 }  
 $dbh->disconnect();
 return @result;
}

sub retrieve_user {
 open (FH,">>$logfile") if ($log);
 my $user_name=shift;
 my $dsn = "DBI:$db_type:$db_database:$db_host";
 my $dbh = DBI->connect($dsn, $db_username, $db_password);

 my $drh = DBI->install_driver($db_type); 
 my $sql_statement = qq{
  select $field_username,$field_password from $db_table 
  where $field_username = '$user_name'
 };
 print FH scalar localtime(), " : Execute sql - ", $sql_statement,"\n" if ($log);

 my $sth = $dbh->prepare($sql_statement) || 
  print FH "Can't prepare statement: $DBI::errstr";
 my $rc = $sth->execute
  || print FH "Can't execute statement: $DBI::errstr"; 
 my ($user,$pass)=$sth->fetchrow_array;
 $user=$user.'@'.$domain if ($domain ne '');
 $sth->finish(); 
 $dbh->disconnect();
 close FH if ($log);
 return ($user,$pass);
}