#!/usr/bin/perl -w
##############################################################################
#
# Script to export a list of all email addresses from Active Directory
# Brian Landers <brian@packetslave.com>
# Modified by Ben Scott:
# - Move Sendmail-specific comments out to other locations
# - Read site-dependant configuration from an external file
# - Include email addresses for AD "Contact" objects
#
# Specifiy config file as first and only argument.
# Format of config file:
# Line 1: LDAP user in DN form (example: cn=JSMITH,ou=Users,dc=example,dc=com)
# Line 2: password for LDAP user
# Line 3: base LDAP context (example: dc=example,dc=com)
# Line 4: list of LDAP servers (Active Directory Domain Controllers), separated by spaces
#
##############################################################################

use strict;
use Fatal qw(open readline close);

$|++; # flush output channel after every output statement

use Net::LDAP;
use Net::LDAP::Control::Paged;
use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED );

# constants
our $filter  = '(|' .
    '(objectClass=publicFolder)' .
    '(objectClass=contact)' .
    '(&(sAMAccountName=*)(mail=*))' .
    ')';

# globals
our $ldapuser;
our $passwd;
our $base;
our $servers;
our @servers;

# arguments
(@ARGV == 1) or die "wrong number of arguments";
my $conffile = $ARGV[0];

# get configuration from file
open CONFIG_FILE, '<', $conffile;
$ldapuser = <CONFIG_FILE>;
$passwd = <CONFIG_FILE>;
$base = <CONFIG_FILE>;
$servers = <CONFIG_FILE>;
close CONFIG_FILE;
chomp ($ldapuser, $passwd, $base, $servers);
@servers = split ' ', $servers;
(@servers > 0) or die "no servers specified in config file";

# We use this to keep track of addresses we've seen
my %gSeen;

# Connect to the server, try each one until we succeed
my $ldap = undef;
foreach( @servers ) {
  $ldap = Net::LDAP->new( $_ );
  last if $ldap;
}

die "Unable to connect to any LDAP servers!\n" if not defined $ldap;

# Create our paging control.  Exchange has a maximum recordset size of
# 1000 records by default.  We have to use paging to get the full list.

my $page = Net::LDAP::Control::Paged->new( size => 100 );

# Try to bind (login) to the server now that we're connected
my $msg = $ldap->bind( dn       => $ldapuser,
                       password => $passwd
                     );

# If we can't bind, we can't continue
if( $msg->code() ) {
  die( "error while binding:", $msg->error_text(), "\n" );
}

# Build the args for the search
my @args = ( base     => $base,
             scope    => "subtree",
             filter   => $filter,
             attrs    => [ "proxyAddresses" ],
             callback => \&handle_object,
             control  => [ $page ],
           );

# Now run the search in a loop until we run out of results.  This code
# is taken pretty much directly from the example code in the perldoc
# page for Net::LDAP::Control::Paged

my $cookie;
while(1) {
  # Perform search
  my $mesg = $ldap->search( @args );

  # Only continue on LDAP_SUCCESS
  $mesg->code and last;

  # Get cookie from paged control
  my($resp)  = $mesg->control( LDAP_CONTROL_PAGED ) or last;
  $cookie    = $resp->cookie or last;

  # Set cookie in paged control
  $page->cookie($cookie);
}

if( $cookie ) {
  # We had an abnormal exit, so let the server know we do not want any more
  $page->cookie($cookie);
  $page->size(0);
  $ldap->search( @args );
}

# Finally, unbind from the server
$ldap->unbind;

# ------------------------------------------------------------------------
# Callback function that gets called for each record we get from the server
# as we get it.  We look at the type of object and call the appropriate
# handler function
#

sub handle_object {

  my $msg  = shift;       # Net::LDAP::Message object
  my $data = shift;       # May be Net::LDAP::Entry or Net::LDAP::Reference

  # Only process if we actually got data
  return unless $data;

  return handle_entry( $msg, $data )     if $data->isa("Net::LDAP::Entry");
  return handle_reference( $msg, $data ) if $data->isa("Net::LDAP::Reference");

  # If we get here, it was something we're not prepared to handle,
  # so just return silently.

  return;
}

# ------------------------------------------------------------------------
# Handler for a Net::LDAP::Entry object.  This is an actual record.  We
# extract all email addresses from the record and output only the SMTP
# ones we haven't seen before.

sub handle_entry {

  my $msg  = shift;
  my $data = shift;

  # Extract the email addressess, selecting only the SMTP ones, and
  # filter them so that we only get unique addresses

  my @mails = grep { /^smtp:/i && !$gSeen{$_}++ }
                   $data->get_value( "proxyAddresses" );

  # If we found any, strip off the SMTP: identifier and print them out
  if( @mails ) {
    print map { s/^smtp:(.+)$/\L$1\n/i; $_ } @mails;
  }
}

# ------------------------------------------------------------------------
# Handler for a Net::LDAP::Reference object.  This is a 'redirect' to
# another portion of the directory.  We simply extract the references
# from the object and resubmit them to the handle_object function for
# processing.

sub handle_reference {

  my $msg  = shift;
  my $data = shift;

  foreach my $obj( $data->references() ) {

    # Oooh, recursion!  Might be a reference to another reference, after all
    return handle_object( $msg, $obj );
  }
}