#!/usr/bin/perl -w

#  Sample External Authenticaton program for CommuniGate Pro 
#  that employs LDAP "bind", supports the account creation
#  via NEW command and supports SASL authentication. For SASL 
#  to work the script must be able to retrieve account password
#  in plain text from the LDAP server.
#
#  See for more info:
#  <http://www.stalker.com/CommuniGatePro/Security.html#External>
#  Please mail your comments to <support@communigate.com>
 

#  You may need to install the following modules:
#  ASN1 from <http://www.cpan.org/modules/by-module/Convert/>
#  LDAP from <http://www.cpan.org/modules/by-module/Net/>
use Net::LDAP;
use strict;
use threads;
use threads::shared;
use Thread::Queue; 

#  Get the CLI.pm module from <http://www.stalker.com/CGPerl/>
use CLI;

#
# You should redefine these values
#

my %domains=( # e-mail domains
  'company.com' => { # need to create this for every domain you use with external authentication
    address=>'ldaps://127.0.0.1:636',  #the URI or address of LDAP server
    backupAddress=>'192.168.0.2',  # backup LDAP server URI (optional)
    timeout=>5, # timeout in seconds, 20 by default
    adminDN=>'CN=Administrator,CN=Users,DC=company,DC=com',     # the DN for admin bind
    adminPassword=>'password',

    searchBase=>'cn=<domain>',  # search base for NEW and SASL commands
    searchFilter=>'(&(uid=<user>)(objectclass=*))',

    bindDN=>'uid=<user>,cn=<domain>', # the account DN for direct bind for VRFY command
    updatePasswords=>1,  #if need to update CommuniGate internal password
  },
  'another.domain.com' => { 
    address=>'127.0.0.1',  
    adminDN=>'CN=Administrator,CN=Users,DC=new,DC=company,DC=com',    
    adminPassword=>'password',

    searchBase=>'CN=Users,DC=new,DC=company,DC=com',                                             
    searchFilter=>'(&(mail=<user>@<domain>)(objectclass=user))',
    bindDN=>'uid=<user>,cn=<domain>',
    updatePasswords=>0,
  },

);



my $CGServerAddress =  '127.0.0.1';   # You should redefine these values
my $CLILogin = 'postmaster';
my $CLIPassword = 'pass';

my $cacheTimeout=60*10; # in seconds
my $nThreads=5;	 
#
# END of user customiseable parameters 
#


$| = 1;     #force STDOUT autoflush after each write

print "* authLDAPNew.pl started\n";

my %passwordCache:shared;
my $mainQueue = Thread::Queue->new();

foreach my $i (1..$nThreads) {
  my $thr = threads->create(\&threadProc, "thread#$i" );
}

   
while(<STDIN>) {
  chomp;    # remove \n from the end of line
  my ($prefix,$method,@eargs) = split(/ /);
  next unless($prefix && $method);
  if($method eq 'VRFY') {
    unless($prefix && $method && $eargs[0] && $eargs[1]) {  
      print "$prefix ERROR Expected: nnn VRFY (mode) user\@domain password\n";    
    } else {
      if($eargs[0] =~ /^\(.*\)$/) {
        shift @eargs;  
      }
      $mainQueue->enqueue(['VRFY',$prefix,$eargs[0],$eargs[1]]);
    }    
  } elsif($method =~ /^SASL/) {
    unless($prefix && $method && $eargs[0] && $eargs[1]) {  
      print "$prefix ERROR Expected: nnn SASL(method) (mode) user\@domain key\n";    
    } else {
      if($eargs[0] =~ /^\(.*\)$/) {
        shift @eargs;  
      }
      $mainQueue->enqueue(['SASL',$prefix,$eargs[0] ]);
    }
  } elsif($method =~ /^READPLAIN/) {
    unless($prefix && $method && $eargs[0]) {  
      print "$prefix ERROR Expected: nnn READPLAIN user\@domain\n";    
    } else {
      $mainQueue->enqueue(['SASL',$prefix,$eargs[0] ]);
    }    
        
  } elsif($method eq 'NEW') {
    unless($prefix && $method && $eargs[0]) {  
      print "$prefix ERROR Expected: nnn NEW user\@domain\n";    
    } else {
      $mainQueue->enqueue(['NEW',$prefix,$eargs[0] ]);
    }
  } elsif($method eq 'INTF') {
    print "$prefix INTF 7\n";

  } elsif($method eq 'QUIT') {
    print "$prefix OK\n";
    last;
  } else {
    print "$prefix ERROR Only INTF, VRFY, SASL, READPLAIN and NEW commands supported\n";    
  }   
}

foreach (1..$nThreads) {
  $mainQueue->enqueue(undef);
}    
foreach my $thr (threads->list()) {
  $thr->join();
}

print "* authLDAPNew.pl done\n";
exit(0);


sub threadProc {
  my ($name)=@_;
#  print "* $name started\n";
  while (my $data = $mainQueue->dequeue()) {
  
    my ($name,$domain)=("",""); 
    if($data->[2] =~ /(.+)\@(.+)/) {  
      $name=$1;
      $domain=$2;
    } else {
      print "$data->[1] ERROR Full account name with \@ and domain part expected\n";
      next;
    }
    unless($domains{$domain}) {
      print "$data->[1] ERROR the domain '$domain' is not served, check settings.\n";
      next;
    }
    
    my $errorMsg;
    
    if($data->[0] eq 'VRFY') {
      $errorMsg=vrfy_command($name,$data->[1],$data->[2],$data->[3],$name,$domain);
    }elsif($data->[0] eq 'SASL') {
      $errorMsg=sasl_command($name,$data->[1],$data->[2],$name,$domain);
    }elsif($data->[0] eq 'NEW') {
      $errorMsg=new_command($name,$data->[1],$data->[2],$name,$domain);
    }else{
      $errorMsg="unknown command $data->[0]";
    }

    if(defined $errorMsg) {
      print "$data->[1] ERROR $errorMsg\n";
    }
  }
#  print "* $name quitting\n";
}



sub tryConnectServer {
  my ($thrName,$domain)=@_;
  my $domData=$domains{$domain};
  my $adr=$domData->{address};

  if($domData->{backupSwitchTime}) {
    if($domData->{backupSwitchTime}+60 > time() ) { #use backup for 60 seconds 
      $adr=$domData->{backupAddress};
    } else {
      delete $domData->{backupSwitchTime};
    }
  }
  print "* ($thrName) trying to connect to $adr\n";
  
  my $ldap = Net::LDAP->new($adr,timeout=>($domData->{timeout} || 20),inet4=>1,inet6=>0 );
  unless($ldap) {
    if($domData->{backupAddress}) {
      print "* ($thrName) connection failed, trying backup at $domData->{backupAddress}\n";
      $ldap = Net::LDAP->new($domData->{backupAddress},timeout=>($domData->{timeout} || 20),inet4=>1,inet6=>0 );
      $domData->{backupSwitchTime}=time() if($ldap); 
    }
  }  
  return $ldap;
}


sub vrfy_command {
  my ($thrName,$prefix,$user,$password,$name,$domain)=@_;

  if($passwordCache{"$user/p"}) {
    if($passwordCache{"$user/t"} + $cacheTimeout > time() && $passwordCache{"$user/p"} eq $password) {
      print "* user $user found in cache, ttl=".int($passwordCache{"$user/t"}+$cacheTimeout-time() )."\n";
      print "$prefix OK\n";
      return;
    } else {
      delete $passwordCache{"$user/p"};
      delete $passwordCache{"$user/t"};
    }
  }
  

  my $ldap = tryConnectServer($thrName,$domain);
  unless($ldap) {
    return "Failed to connect to LDAP server";
  }
  


  my $bindDN=$domains{$domain}->{bindDN};
  $bindDN=~s/<user>/$name/;
  $bindDN=~s/<domain>/$domain/;
  $password=decodeString($password);
  print "* ($thrName) binding $bindDN with password=$password\n";
  my $result;
  $result=$ldap->bind($bindDN,password=>$password)
    || return "Can't bind: ".$result->error;

  $ldap->unbind();                        # unbind & disconnect
  #$ldap->disconnect();
  
  $result->code && return $result->error; # return error message if failed

  $passwordCache{"$user/t"}=time();
  $passwordCache{"$user/p"}=$password; 
  print "$prefix OK\n";
  if($domains{$domain}->{updatePasswords}) {
    my $cli = new CGP::CLI( { PeerAddr => $CGServerAddress,
                            PeerPort => 106,
                            login    => $CLILogin,
                            password => $CLIPassword
                          } );
    unless($cli) {  
     print "* Can't login to CGPro via CLI: ".$CGP::ERR_STRING."\n";
     return undef;
    }
    unless($cli->SetAccountPassword($user,$password)) {
      print "* Can't set password:".$cli->getErrMessage."\n";
    }
    $cli->Logout();
  }
  return undef;                           # return "undef" on success
}



sub sasl_command {
  my ($thrName,$prefix,$user,$name,$domain)=@_;

  if($passwordCache{"$user/p"}) {
    if($passwordCache{"$user/t"} + $cacheTimeout > time() ) {
      print "* user $user found in cache, ttl=".int($passwordCache{"$user/t"}+$cacheTimeout-time() )."\n";
      print "$prefix PLAIN ".encodeString($passwordCache{"$user/p"})."\n";
      return;
    } else {
      delete $passwordCache{"$user/p"};
      delete $passwordCache{"$user/t"};
    }
  }

  my $ldap = tryConnectServer($thrName,$domain);
  unless($ldap) {
    return "Failed to connect to LDAP server";
  }
  
  my $adminDN=$domains{$domain}->{adminDN};
  my $adminPassword=$domains{$domain}->{adminPassword};
 
  my $result;
  $result=$ldap->bind($adminDN,password=>$adminPassword)
    || return "Can't bind as admin: ".$result->error;
  $result->code && return "Can't bind as admin: ".$result->error;

  my $searchBase=$domains{$domain}->{searchBase};
  $searchBase=~s/<user>/$name/g;
  $searchBase=~s/<domain>/$domain/g;
  my $searchFilter=$domains{$domain}->{searchFilter};
  $searchFilter=~s/<user>/$name/g;
  $searchFilter=~s/<domain>/$domain/g;
  print "* ($thrName) searching $searchBase for $searchFilter\n";
 
  my $mesg = $ldap->search (  # perform a search
               base   => $searchBase,
               filter => $searchFilter
             );


  $ldap->unbind();                        # unbind & disconnect

  unless(defined $mesg) {
    return "LDAP search failed";   
  } 
  if($mesg->all_entries() eq 0) {
    return "LDAP: nothing found for $searchFilter";
  }
  my $password;  
  foreach my $entry ($mesg->all_entries) {
    my $ref1=@$entry{'asn'};
    my $attrs=@$ref1{'attributes'};
    foreach my $atrRef (@$attrs) {
      my $type=@$atrRef{'type'};
      my $vals=@$atrRef{'vals'};
#      $realName=@$vals[0] if($type eq 'cn');
      $password=@$vals[0] if($type eq 'userPassword');
    }
    last; # we need only 1 entry
  }
  unless($password) {
    return "no plain text password was found";
  }
  $passwordCache{"$user/t"}=time();
  $passwordCache{"$user/p"}=$password; 
  print "$prefix PLAIN ".encodeString($password)."\n";

  if($domains{$domain}->{updatePasswords}) {
    my $cli = new CGP::CLI( { PeerAddr => $CGServerAddress,
                            PeerPort => 106,
                            login    => $CLILogin,
                            password => $CLIPassword
                          } );
    unless($cli) {  
     print "* Can't login to CGPro via CLI: ".$CGP::ERR_STRING."\n";
     return undef;
    }
    unless($cli->SetAccountPassword($user,$password)) {
      print "* Can't set password:".$cli->getErrMessage."\n";
    }
    $cli->Logout();
  }
  
  return undef;
}



sub new_command {
  my ($thrName,$prefix,$user,$name,$domain)=@_;

  my $ldap = tryConnectServer($thrName,$domain);
  unless($ldap) {
    return "Failed to connect to LDAP server";
  }
  
  my $adminDN=$domains{$domain}->{adminDN};
  my $adminPassword=$domains{$domain}->{adminPassword};
 
  my $result;
  $result=$ldap->bind($adminDN,password=>$adminPassword)
    || return "Can't bind as admin: ".$result->error;
  $result->code && return "Can't bind as admin: ".$result->error;

  my $searchBase=$domains{$domain}->{searchBase};
  $searchBase=~s/<user>/$name/;
  $searchBase=~s/<domain>/$domain/;
  my $searchFilter=$domains{$domain}->{searchFilter};
  $searchFilter=~s/<user>/$name/;
  $searchFilter=~s/<domain>/$domain/;
  print "* ($thrName) searching $searchBase for $searchFilter\n";
 
  my $mesg = $ldap->search (  # perform a search
               base   => $searchBase,
               filter => $searchFilter
             );


  $ldap->unbind();                        # unbind & disconnect

  unless(defined $mesg) {
    return "LDAP search failed";   
  } 
  if($mesg->all_entries() eq 0) {
    return "LDAP: nothing found for $searchFilter";
  }
  my ($realName,$password);  
  foreach my $entry ($mesg->all_entries) {
    my $ref1=@$entry{'asn'};
    my $attrs=@$ref1{'attributes'};
    foreach my $atrRef (@$attrs) {
      my $type=@$atrRef{'type'};
      my $vals=@$atrRef{'vals'};
      $realName=@$vals[0] if($type eq 'cn');
      $password=@$vals[0] if($type eq 'userPassword');
    }
    last; # we need only 1 entry
  }
  my %userData;
  $userData{'RealName'}=$realName if(defined $realName); 
  $userData{'Password'}=$password if(defined $password && $domains{$domain}->{updatePasswords}); 
  
  print "* ($thrName) found $realName\n" if(defined $realName);
  my $cli = new CGP::CLI( { PeerAddr => $CGServerAddress,
                          PeerPort => 106,
                          login    => $CLILogin,
                          password => $CLIPassword
                        } )  
   || return "Can't login to CGPro via CLI: ".$CGP::ERR_STRING;

  $cli->CreateAccount(accountName=>"$user",settings=>\%userData)
    || return "Can't create account via CLI:".$cli->getErrMessage;
  $cli->Logout();

  if($password) {
    $passwordCache{"$user/t"}=time();
    $passwordCache{"$user/p"}=$password;
  } 
  print "$prefix OK\n";
  return undef;
}

sub encodeString {
  my ($data)=@_;
  if($data =~ /\W/) {
    $data =~ s/\\/\\\\/g;
    $data =~ s/\"/\\\"/g;
    $data =~ s/([\x00-\x1F\x7F])/'\\'.('0'x(3-length(ord($1)))).ord($1)/ge;
  }
  return '"' . $data . '"';
}

sub decodeString {
  my ($data)=@_;
  my $isQuoted=0;

  unless($data=~/^\"(.*)\"$/) { # check "'s
    return $data;
  }
  $data=$1;

  my $result="";
  my $span=0;
  my $len=length($data);

  while($span < $len) {
    my $ch=substr($data,$span,1);
    if($ch eq '\\') {
      $span++;
      if(substr($data,$span,3) =~ /^(\d\d\d)/) { 
        $ch=chr($1); $span+=3;
      }else {
        $ch=substr($data,$span,1);
      }  
    }
    $result .= $ch;
    ++$span;
  }
  return $result;
}


__END__