#****************************************************************************************
#* jwDCLocator.PL                                                                       *
#*======================================================================================*
#* Author : support@joeware.net                                                         *
#* Version: V01.04.00                                                                   *
#* Modification History:                                                                *
#*    V00.99.00   2018.12.22  joe         o Original Version                            *
#*    V00.99.01   2019.02.07  joe         o Still working on it                         *
#*    V00.99.02   2019.03.03  joe         o Getting close                               *
#*    V01.00.00   2019.03.05  joe         o First revision                              *
#*    V01.01.00   2019.03.xx  joe         o Added next closest site functionality       *
#*    V01.02.00   2019.03.xx  joe         o Changes for Centos7/FreeBSD12               *
#*    V01.03.00   2019.03.31  joe         o Updated usage, added a bunch more comments  *
#*                                        o Added more debugging                        *
#*                                        o Exclude Duplicate DCs from list output      *
#*    V01.04.00   2019.04.01  joe         o Final cleanup, last pass initial publish    *
#*--------------------------------------------------------------------------------------*
#* This script is a demonstration script to show how to dynamically finds domain        *
#* controllers versus hardcoding domain controllers which is inherently BAD.            *
#*--------------------------------------------------------------------------------------*
#* Notes:                                                                               *
#*   This code is more "drawn out" than it may otherwise be for illustrative purposes.  *
#*                                                                                      *
#*   TO BE CLEAR, IT DOES NOT TAKE ALL OF THIS CODE TO FIND DOMAIN CONTROLLERS.         *
#*                                                                                      *
#*   The goal is to produce something developers can look at to write their own code in *
#*   whatever language on whatever platform to implement proper AD Domain Controller    *
#*   locator functionality for the best redundancy possible for their application.      *
#*                                                                                      *
#*   To my knowledge, no one has posted simple clear code examples of performing        *
#*   site location via anonymous LDAP queries. That is probably the coolest part of     *
#*   this code because all of the rest of it is basic logical steps if you look at what *
#*   is registered in DNS.                                                              *
#*                                                                                      *
#* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,  *
#* INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A        *
#* PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT   *
#* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF *
#* CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE *
#* OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.                                        *
#*                                                                                      *
#****************************************************************************************
#* Requirements:                                                                        *
#*   * PERL VERSION: 5.26 or newer required for "experimental::declared_refs"           *
#*   * PERL MODULES: Net::DNS and Net::Perl will likely need to be installed            *
#*                                                                                      *
#****************************************************************************************
#* Future Version Updates                                                               *
#*    o Make the script run under older common perl versions                            *
#*    o Add DC Timed Caching                                                            *
#*    o Add CLDAP functionality  (Net::LDAP does not currently support CLDAP)           *
#****************************************************************************************
#****************************************************************************************
$|=1;
use v5.26.0;    # Need 5.26 for the experimental hash ref stuff. 

#****************************************************************************************
#* Packages:                                                                            *
#*--------------------------------------------------------------------------------------*
#****************************************************************************************
eval {require strict;strict->import()}; # Strict isn't available when using perl exe/dll
eval {require Win32::IPHelper;IPHelper->import()}; #Used by Win Net::DNS, not on *nix

use Time::HiRes qw(gettimeofday tv_interval); # High Resolution timer for logging,ETimer
use Net::DNS;                           # For DNS lookups
use Net::LDAP;                          # LDAP "Ping"
use Data::Dumper;                       # For Debugging/Logging

# Being a little lazy for this version so need this experimental stuff
# Used in the ValidateDCs function for storage into the hash of hashes
# This is specific to storage in this script, not the DC Locator process
no warnings "experimental::declared_refs"; # Declared Refs... V5.26 Required
no warnings "experimental::refaliasing";# Aliasing...         V5.22 Required
use feature "declared_refs";            # Declared Refs...  
use feature "refaliasing";              # Aliasing...

#****************************************************************************************
#* Revision Level Script Constant Definitions:                                          *
#*--------------------------------------------------------------------------------------*
#*    $SCRIPTNAME   : Name of script for header                                         *
#*    $SCRIPTVERSION: Version of script for header                                      *
#*    $AUTHOR       : Author (or contact) for this version of the script                *
#*    $LASTREVDATE  : Last revision date of script                                      *
#****************************************************************************************
my $SCRIPTNAME="jwDCLocator";
my $SCRIPTVERSION="V01.04.00pl";
my $AUTHOR="Joe Richards (support\@joeware.net)";
my $LASTREVDATE="April 2019";


#****************************************************************************************
#* Definitions:                                                                         *
#*--------------------------------------------------------------------------------------*
#*    $TRUE         : Define True for testing.                                          *
#*    $FALSE        : Define False for testing.                                         *
#*    $YES          : Define Yes for testing.                                           *
#*    $NO           : Define No for testing.                                            *
#*    $SCRIPTPATH   : Path to script.                                                   *
#*    $HEADER       : Header string printed at start of run                             *
#*    $DEFAULT_LDAPTimeout : The default timeout for contacting domain controllers      *
#****************************************************************************************
my $TRUE=1;
my $FALSE=0;
my $YES=1;
my $NO=0;
my ($SCRIPTPATH)=($0=~/(^.*)\\.*$/);
my $HEADER="$SCRIPTNAME $SCRIPTVERSION  $AUTHOR  $LASTREVDATE";
my $DEFAULT_LDAPTimeout=5;   # 120 seconds is OS default LDAP timeout, use 5 seconds


#****************************************************************************************
#* Vars:                                                                                *
#*--------------------------------------------------------------------------------------*
#****************************************************************************************
my $StartTimeStamp=StringTime("YYYYMMDD-HHmm");
my %g_ETimerHash=();
my $g_bDebug=$FALSE;
my $g_bVerbose=$FALSE;
my $g_bQuiet=$FALSE;


#****************************************************************************************
#* Main Body                                                                            *
#*--------------------------------------------------------------------------------------*
#****************************************************************************************

#
# Display header
#
print "\n$HEADER\n\n";

#
# Set up basic parameter variables
#
my $bHelp=$FALSE;
my $bMoreHelp=$FALSE;
my $strLogFileName="TIMESTAMP-".$SCRIPTNAME.".log";
my $strConfigFile="jwDCLocator.config";

#
# Process basic parameters
#
map {
     if (/\/(help|h|\?)$/i) {$bHelp=$TRUE};
     if (/\/debug/i) {$g_bDebug=$TRUE};
     if (/\/quiet/i) {$g_bQuiet=$TRUE};
     if (/\/verbose/i) {$g_bVerbose=$TRUE};
     if (/\/configfile:(.+)/i) {$strConfigFile=$1};
     if (/\/logfile:(.+)/i) {$strLogFileName=$1};
    } @ARGV;

# Help
if ($bHelp) {DisplayUsage()};
if ($bMoreHelp) {DisplayMoreHelp()}; 


# Expand Log file name with timestamp
# Open Log File and set up immediate autoflush
$strLogFileName=~s/TIMESTAMP/$StartTimeStamp/;
if (!$g_bQuiet) {print "Initializing Logging to logfile $strLogFileName...\n"};
open LOGFILE,">$strLogFileName" or die("ERROR: Couldn't open logfile - $strLogFileName: $!\n");
SetAutoFlush(*LOGFILE);

# Log Basic info
LOG($HEADER);
LOG("CONFIGFILE    : $strConfigFile");


#
# Start the real work
#

# Read in and process Config File if exists
my %ConfigFileHash=();
my %Config=();
LOG_CONSOLE("Reading configuration file $strConfigFile...");
if ($strConfigFile)
 {
  if (ReadConfig(\%ConfigFileHash,$strConfigFile))
   {
    LOG_CONSOLE("Processing configuration file...");
   } 
  # Even if no config file still need to set up data structures 
  ProcessConfig(\%Config,\%ConfigFileHash,\@ARGV);
 }

#
# Grab final settings from config 
#
my @domainControllers=@{$Config{'ACTIVE'}{'DOMAINCONTROLLERS'}};
my @arrBootDCs=@{$Config{'ACTIVE'}{'BOOTDCS'}} or @domainControllers;
my @siteList=@{$Config{'ACTIVE'}{'SITES'}};
my @addonSiteList=@{$Config{'ACTIVE'}{'ADDONSITES'}};

if ($g_bDebug) 
 {
  LOG("domainControllers : @domainControllers\n");
  LOG("arrBootDCs        : @arrBootDCs\n");
  LOG("   config_BootDCs : @{$Config{'ACTIVE'}{'BOOTDCS'}}\n");
  LOG("siteList          : @siteList\n");
  LOG("addonSiteList     : @addonSiteList");
 }


#
# If no domain specified, we need to stop
#
if ($Config{'ACTIVE'}{DOMAIN} eq "" ) 
 {
  BailOut("ERROR: No Domain Specified in Config file ($strConfigFile) or as a parameter with /domain:xxxx.");
 }


#
# Domain Controllers specified so a lot of this work doesn't need to happen.
#
if (scalar(@domainControllers)) 
 {
  LOG_CONSOLE("Domain Controllers specified, skipping all dynamic discovery processes.");
  LOG_CONSOLE("  Domain Controllers: @domainControllers");
 }


#
# If we don't have any boot DCs specified, dynamically find some
#    Note if domain controllers specified, they are also considered boot DCs
#
if (!scalar(@arrBootDCs)) 
 {
  # Get BootStrap DCs from DNS based on domain name
  LOG_CONSOLE("Determining bootstrap domain controllers via DNS for $Config{'ACTIVE'}{DOMAIN}...");
  @arrBootDCs=GetBootStrapDCs($Config{'ACTIVE'}{'DOMAIN'});
 }
LOG_CONSOLE("  BootStrap Hosts: @arrBootDCs");


#
# If we don't have domain controllers or sites specified, dynamically find site
#   Do NOT use config file or command line timeout as that is for validation
#
if (!scalar(@domainControllers) and !scalar(@siteList))
 {
  my %NetLogonHash=();
  LOG_CONSOLE("Dynamically determining site...");
  my ($strServerSite,$strClientSite,$strClientNextClosestSite)=
                 GetSiteFromLDAPPing(120,$Config{'ACTIVE'}{'DOMAIN'},\@arrBootDCs," " x 2,\%NetLogonHash);
  LOG_CONSOLE("  AutoDetected Server Site             : $strServerSite");    
  LOG_CONSOLE("  AutoDetected Client Site             : $strClientSite");    
  LOG_CONSOLE("  AutoDetected Client Next Closest Site: $strClientNextClosestSite");    
  @siteList=($strClientSite,$strClientNextClosestSite); 

  # Grab the forest name while here in case we need it for global catalog DNS lookup actions
  $Config{'ACTIVE'}{'FOREST'}=$NetLogonHash{'DNSForestName'};

  # Addon sites
  if (scalar(@addonSiteList)) 
   {
    LOG_CONSOLE("Addon Sites specified, added along with detected site(s) [@addonSiteList]...");
    push @siteList,@addonSiteList;
   }
 }


# 
#  Get site specific DNS Records if Domain Controllers not specified
#    If Domain Controllers are specified, load up proper data structure
#
my @arrSiteDCs=();
if (!scalar(@domainControllers))
 {
  #   @arrSiteDCs is an array of hash values
  #       Site
  #          COUNT         - Site Count #, 0 based array
  #          Host          - FQDN of host
  #            PORT        - Port Number of SRV records
  #            ORDER       - Order record was returned
  #            PRIORITY    - Priority of record
  #            TTL         - TTL of record
  #            WEIGHT      - Weight of record  
  #
  LOG_CONSOLE("Determining site specific DNS records...");
  my $strResults=GetDNSRecords(DomainPartition(\%Config),$Config{'ACTIVE'}{'GCLIST'},\@siteList,\@arrSiteDCs);
 }
else
 {
  # Domain Controllers were specified in config, set up @arrSiteDCs in proper format for later operations
  #  
  LOG_CONSOLE("Loading Site DC Structure with specified domain controllers...");
  $arrSiteDCs[0]{'*NOSITE*'}{'*COUNT*'}=0;
  my $ordercount=0;
  foreach my $thisdc (@domainControllers) 
   {
    $arrSiteDCs[0]{'*NOSITE*'}{$thisdc}{'*ORDER*'}=$ordercount++;
    $arrSiteDCs[0]{'*NOSITE*'}{$thisdc}{'PRIORITY'}=0;
    $arrSiteDCs[0]{'*NOSITE*'}{$thisdc}{'WEIGHT'}=100;
   }
 }

if ($g_bDebug) 
 {
  LOG_CONSOLE("DEBUG: ");
  LOG_CONSOLE("DEBUG: Site Specific DNS arrSiteDCs -- ".Dumper(\@arrSiteDCs));
  LOG_CONSOLE("DEBUG: ");
 }


#
# Validate Site Specific Domain Controllers
#
my %ValidatedHash=();
my @arrValidatedDCs=ValidateDCs($Config{'ACTIVE'}{'LDAPTIMEOUT'},DomainPartition(\%Config),
                         $Config{'ACTIVE'}{'GCLIST'},$Config{'ACTIVE'}{'FILTERPDC'},\@arrSiteDCs,\%ValidatedHash);



#
# If we didn't get any validated site specific domain controllers
# need to open up and look at the entire domain or forest (for GCs) 
#
if (!scalar(@arrValidatedDCs))
 {
  #   @arrNonSiteDCs is an array of hash values
  #       Site             "NO SPECIFIC SITE" - FAKE SITE FOR CONSISTENCY WITH @arrSiteDCs for other functions                             
  #          COUNT         - 0
  #          Host          - FQDN of host
  #            PORT        - Port Number of SRV records
  #            ORDER       - Order record was returned
  #            PRIORITY    - Priority of record
  #            TTL         - TTL of record
  #            WEIGHT      - Weight of record  
  #
  my @arrNonSiteDCs=();
  LOG_CONSOLE("Determining non-site specific DNS records...");
  my @arrFakeSiteList=("NO SPECIFIC SITE");
  my $strResults=GetDNSRecords(DomainPartition(\%Config),$Config{'ACTIVE'}{'GCLIST'},\@arrFakeSiteList,\@arrNonSiteDCs);


  if ($g_bDebug) 
   {
    LOG_CONSOLE("DEBUG: ");
    LOG_CONSOLE("DEBUG: Non-Site Specific DNS arrNonSiteDCs -- ".Dumper(\@arrNonSiteDCs));
    LOG_CONSOLE("DEBUG: ");
   }

  #
  # Validate Site Specific Domain Controllers
  #
  my %ValidatedHash=();
  @arrValidatedDCs=ValidateDCs($Config{'ACTIVE'}{'LDAPTIMEOUT'},DomainPartition(\%Config),
                           $Config{'ACTIVE'}{'GCLIST'},$Config{'ACTIVE'}{'FILTERPDC'},\@arrNonSiteDCs,\%ValidatedHash);
 }


if ($g_bDebug) 
 {
  LOG_CONSOLE("DEBUG:");
  LOG_CONSOLE("DEBUG: Final ValidatedHash -- ".Dumper(\%ValidatedHash));
  LOG_CONSOLE("DEBUG:");
 }


my %DupeHash=();

if ($g_bVerbose) 
 {
  LOG_CONSOLE("Verbose Sorted Validated Domain Controller Information");
  foreach my $thissite (sort {$ValidatedHash{$a}{'*ORDER*'} <=> $ValidatedHash{$b}{'*ORDER*'}} keys %ValidatedHash) 
   {
    next if $thissite=~/^\*/;
    LOG_CONSOLE("SITE: $thissite");
    foreach my $thishost (sort {if ($a=~/^*/ or $a=~/^*/) {return 0};$ValidatedHash{$thissite}{$a}{'*ORDER*'} <=> $ValidatedHash{$thissite}{$b}{'*ORDER*'}} keys %{$ValidatedHash{$thissite}}) 
     {
      next if $thishost=~/^\*/;

      # Possible to have duplicates if DC is covering multiple sites
      # We don't want to output duplicates  
      if (!exists $DupeHash{$thishost}) 
       {
        $DupeHash{$thishost}=1;
       }
      else
       {
        LOG_CONSOLE("    HOST: $thishost  --- DUPLICATE");
        next;
       }

      LOG_CONSOLE("    HOST: $thishost");
      LOG_CONSOLE("            AVG RESP    :  ".${$ValidatedHash{$thissite}{$thishost}}{'AVG_RESPONSE_TIME'});
      LOG_CONSOLE("            DNS INFORMATION");
      LOG_CONSOLE("              PRIORITY  : ".${$ValidatedHash{$thissite}{$thishost}{'dns'}}{'PRIORITY'});
      LOG_CONSOLE("              WEIGHT    : ".${$ValidatedHash{$thissite}{$thishost}{'dns'}}{'WEIGHT'});
      LOG_CONSOLE("              PORT      : ".${$ValidatedHash{$thissite}{$thishost}{'dns'}}{'PORT'});
      LOG_CONSOLE("              TTL       : ".${$ValidatedHash{$thissite}{$thishost}{'dns'}}{'TTL'});
      LOG_CONSOLE("            TCP PING INFORMATION");
      LOG_CONSOLE("              RESP TIME : ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'RESPONSE_TIME'});
      LOG_CONSOLE("              FLAGS     : 0x".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'FLAGS'});
      LOG_CONSOLE("              SRV SITE  : ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'ServerSiteName'});
      LOG_CONSOLE("              CLT SITE  : ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'ClientSiteName'});
      LOG_CONSOLE("              DNS FOREST: ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'DNSForestName'});
      LOG_CONSOLE("              NBT DOM   : ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'NetBIOSDomainName'});
      LOG_CONSOLE("              DNS DOM   : ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'DNSDomainName'});
      LOG_CONSOLE("              GUID DOM  : ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'DOMAINGUID'});
      LOG_CONSOLE("              NBT CMP   : ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'NetBIOSComputerName'});
      LOG_CONSOLE("              DNS CMP   : ".${$ValidatedHash{$thissite}{$thishost}{'tcpping'}}{'DNSHostName'});
      LOG_CONSOLE("            ROOTDSE INFORMATION");
      LOG_CONSOLE("              RESP TIME : ".${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'RESPONSE_TIME'});
      LOG_CONSOLE("              SYNCED    : ".${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'isSynchronized'});
      LOG_CONSOLE("              GC READY  : ".${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'isGlobalCatalogReady'});
      LOG_CONSOLE("              FSMO      : ".FSMOLIST(${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'validFSMOs'}));
      LOG_CONSOLE("              ROOT NC   : ".${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'rootDomainNamingContext'});
      LOG_CONSOLE("              DEFAULT NC: ".${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'defaultNamingContext'});
      LOG_CONSOLE("              FORESTFUNC: ".${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'forestFunctionality'});
      LOG_CONSOLE("              DOMAINFUNC: ".${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'domainFunctionality'});
      LOG_CONSOLE("              DCFUNC    : ".${$ValidatedHash{$thissite}{$thishost}{'rootdse'}}{'domainControllerFunctionality'});
      LOG_CONSOLE("");
     }
   }
 }
else
 {
  LOG_CONSOLE("Sorted Validated Domain Controller List");
  map {
       # Possible to have duplicates if DC is covering multiple sites
       # We don't want to output duplicates  
       if (!exists $DupeHash{$_}) 
        {
         $DupeHash{$_}=1;
         LOG_CONSOLEEx("$_");
        }
      } @arrValidatedDCs;
 }

LOG_CONSOLE("");
LOG_CONSOLE("The command completed.");

exit;



#****************************************************************************************
#****************************************************************************************
# FUNCTIONS                                                                             *
#****************************************************************************************
#****************************************************************************************

#
#
#
sub DomainPartition
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter DomainPartition...")};
  my $Config_ptr=shift;
  return ($$Config_ptr{'ACTIVE'}{'GCLIST'}?$$Config_ptr{'ACTIVE'}{'FOREST'}:$$Config_ptr{'ACTIVE'}{'DOMAIN'})
 }


#
# Function GetSiteFromLDAPPing
#
sub GetSiteFromLDAPPing
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter GetSiteFromLDAPPing...")};
  my $iTimeout=shift;
  my $strDomain=shift;
  my $arrQueryDCs_ptr=shift;
  my $strSpacing=shift;
  my $NetLogonHash_ptr=shift;

  my @sites=();
  foreach my $thishost (@$arrQueryDCs_ptr) 
   {
    @sites=AnonLDAPPing($iTimeout,$strDomain,$thishost,$NetLogonHash_ptr,undef,undef,$strSpacing);
    last if (scalar(@sites)>0);
   }
  return @sites;   
 }


#
# Function AnonLDAPPing
#  Requires the Net::LDAP module
#   This is where the totally cool stuff starts!!!
#   No seriously, I don't think I have ever seen 
#   this in simple basic open code anywhere before. It 
#   uses the same dynamic underlying processes to 
#   determine the site the client is in that is used 
#   by Windows. 
#   
#
sub AnonLDAPPing
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter AnonLDAPPing...")};
  my $iTimeout=shift;
  my $strDomain=shift;
  my $strHost=shift;
  my $Hash_ptr=shift;
  my $strPort=shift;
  my $Elapsed_ptr=shift;  # optional for timing info
  my $strSpacing=shift;

  if (!$strPort) {$strPort="389"};

  my $bSSL=$FALSE;
  if ($strPort == 636 or $strPort == 3269) {$bSSL=$TRUE}; 

  my $hostURI=($bSSL?"LDAPS":"LDAP")."://".$strHost.":".$strPort;

  #
  # Create and send LDAP "Ping" Packet to get NetLogon attribute
  #
  LOG_CONSOLE($strSpacing."Sending LDAP Ping to $hostURI..."); 

  # Chop FQDN down to short hostname 
  my ($strShortHost)=($strHost=~/^(.+?)\./);

  my $ldap;
  # The following could be done with DNS Domain or HostName
  # HostName is already known for sure by anything that calls this
  # function so it is easier to use.
  #  One of the following queries: 
  #    my $strQuery="(&(DnsDomain=$strDomain)(NtVer=\\14\\00\\00\\00))";
  #    my $strQuery="(&(Host=$strShortHost)(NtVer=\\14\\00\\00\\00))";
  #
  # The NtVer is NETLOGON_NT_VERSION_5EX | NETLOGON_NT_VERSION_WITH_CLOSEST_SITE
  # Which is 0x14. If you don't want next closest site returned as well
  # then just use 0x04 (NETLOGON_NT_VERSION_5EX).
  # Note that specifying next closest site doesn't guarantee three sites
  # always being returned. 
  # NetLogon returned as NETLOGON_SAM_LOGON_RESPONSE_EX
  my $strQuery="(&(Host=$strShortHost)(NtVer=\\14\\00\\00\\00))";
  if ($g_bDebug) {LOG("DEBUG:   LDAP Query: $strQuery")};

  # Try to open the LDAP Connection
  if ($g_bDebug) {LOG("DEBUG:   LDAP->new......(timeout=$iTimeout)...")};

  my $timername="ANONLDAPPING_$strHost";
  ELAPSEDTIMER_START($timername);
  
  $ldap=Net::LDAP->new($hostURI, timeout => $iTimeout); # $strHost

  # Return on failure
  LOG("ERROR: Failed to open LDAP connection to $hostURI : $@") if !$ldap;
  return "ERROR: Failed to open LDAP connection to $hostURI : $@" if !$ldap;
  if ($g_bDebug) {LOG("DEBUG:   LDAP->new completed.")};

  if ($g_bDebug) {LOG("DEBUG:   LDAP->bind...")};
  $ldap->bind;
  if ($g_bDebug) {LOG("DEBUG:   LDAP->bind completed.")};

  if ($g_bDebug) {LOG("DEBUG:   LDAP->search...")};
  # try the LDAP search
  my $mesg = $ldap->search( # perform a search
                        scope  => 'base',
                        base   => "",
                        filter => $strQuery,
                        attrs  => ['netlogon']
                       );
  $$Elapsed_ptr=ELAPSEDTIMER_STOP($timername,"raw");
  LOG("ELAPSEDTIMER ANONLDAPPING RAW = ".$$Elapsed_ptr);
  LOG("ELAPSEDTIMER ANONLDAPPING = ".ELAPSEDTIME_ELAPSED($timername));
  if ($g_bDebug) {LOG_CONSOLE($strSpacing."DEBUG: LDAP Ping Response Time: ".ELAPSEDTIME_ELAPSED($timername,"raw")." seconds.")};
  
  # Return on failure
  LOG("RETURN CODE: ".$mesg->code);
  if ($mesg->code) 
   {
    LOG("ERROR: Failed to execute search : ".$mesg->error);   
    $$Elapsed_ptr=-1;
    return "ERROR: Failed to execute search :".$mesg->error;   
   }
  if ($g_bDebug) {LOG("DEBUG:   LDAP->search completed.")};

  # Success, need to parse the returned BLOB
  my $netlogon = ($mesg->entries)[0]->get_value('netlogon');
  if ($g_bDebug) {LOG("DEBUG: NETLOGON = $netlogon\n")};
  my @Sites=ParseNetLogon($Hash_ptr,$netlogon);
  return @Sites;
 }


#
# Function ParseNetLogon
#   Assume format NETLOGON_SAM_LOGON_RESPONSE_EX (opcode=23 (0x17))
#   Assume ntver=NETLOGON_NT_VERSION_5EX | NETLOGON_NT_VERSION_WITH_CLOSEST_SITE
#   If you use NETLOGON_NT_VERSION_5EX_WITH_IP it changes the decode of the returned
#   NETLOGON_SAM_LOGON_RESPONSE_EX structure. 
#   (&(DnsDomain=$strDomain)(NtVer=\\14\\00\\00\\00))
#     [MS-ADTS] 6.3.1.9
#     https://msdn.microsoft.com/en-us/library/cc223807.aspx?f=255&MSPPError=-2147217396
#
#   Note: While there is documentation on what this structure is supposed to be
#         as indicated above, I tend to look at the binary and reverse out what
#         I personally find it to be. If there is a delta between what I do below
#         and what is in the documentation it could be a doc issue or it could be
#         that that data wasn't ever returned to me in a few thousands of tests 
#
#
sub ParseNetLogon
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter ParseNetLogon...")};
  my $Hash_ptr=shift;
  my $netlogon=shift;
  my ($hex) = unpack('H*',$netlogon);
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: ParseNetLogon HEX=$hex")};

  # Unpack some of the netlogon attribute that is fixed length
  my ($opcode,$junk1,$junk2,$flags,$domainGuidRaw,$therest) = unpack ('H2H2H4H8H32H*',$netlogon);
  my $domainGuid=UUIDHexStrToString($domainGuidRaw);  
  my $flagsbin=sprintf("%b",hex($flags));
  $$Hash_ptr{'OPCODE'}=hex($opcode);
  $$Hash_ptr{'FLAGS'}=uc($flags);
  $$Hash_ptr{'FLAGSBIN'}=$flagsbin;
  $$Hash_ptr{'DOMAINGUIDRAW'}=$domainGuidRaw;
  $$Hash_ptr{'DOMAINGUID'}=$domainGuid;
  if ($g_bDebug and $g_bVerbose) 
   {
    LOG("DEBUG: ParseNetLogon Hash Static Size Values - ".Dumper($Hash_ptr));
    LOG("DEBUG: NETLOGON REMAINING=$therest");
   }

  # Set up compressed name hash for host names and sites strings
  my %NamesHash=();
  $NamesHash{'ROOT'}=24;   # Base of compressed names  H2H2H4H8H32 (48/2)
  $NamesHash{'CURRENT'}=$NamesHash{'ROOT'};   # Set current compressed names pointer to base

  # DNS Forest Name
  my $DNSForestNamePart=GetCompressedName(\$therest,\%NamesHash);
  $$Hash_ptr{'DNSForestName'}=$DNSForestNamePart;

  # DNS Domain Name
  my $DNSDomainNamePart=GetCompressedName(\$therest,\%NamesHash);
  $$Hash_ptr{'DNSDomainName'}=$DNSDomainNamePart;
  
  # DNS Host Name
  my $DNSHostNamePart=GetCompressedName(\$therest,\%NamesHash);
  $$Hash_ptr{'DNSHostName'}=$DNSHostNamePart;

  # NetBIOS Domain Name
  my $NetBIOSDomainNamePart=GetCompressedName(\$therest,\%NamesHash);
  $$Hash_ptr{'NetBIOSDomainName'}=$NetBIOSDomainNamePart;

  # NetBIOS Computer Name
  my $NetBIOSComputerNamePart=GetCompressedName(\$therest,\%NamesHash);
  $$Hash_ptr{'NetBIOSComputerName'}=$NetBIOSComputerNamePart;

  # User Name
  my $UserNamePart=GetCompressedName(\$therest,\%NamesHash);
  $$Hash_ptr{'UserName'}=$UserNamePart;

  # Server Site Name
  my $ServerSiteNamePart=GetCompressedName(\$therest,\%NamesHash);
  $$Hash_ptr{'ServerSiteName'}=$ServerSiteNamePart;

  # Client Site Name
  #   If no value, it is the same as the Server Site
  my $ClientSiteNamePart=GetCompressedName(\$therest,\%NamesHash) || $$Hash_ptr{'ServerSiteName'};
  $$Hash_ptr{'ClientSiteName'}=$ClientSiteNamePart;

  # Next Closest Site Name
  #   Check length of remaining string, will be length=16 if no next closest site info 
  my $ClientNextClosestSiteNamePart="";
  if (length($therest) > 16) 
   {
    if ($g_bDebug) {LOG("DEBUG: Retrieving Next Closest Site...")};
    $ClientNextClosestSiteNamePart=GetCompressedName(\$therest,\%NamesHash) || $$Hash_ptr{'ClientSiteName'};
   }
  $$Hash_ptr{'ClientNextClosestSiteName'}=$ClientNextClosestSiteNamePart;

  # We don't care about the rest of the structure
  # It is just version flags detailing the request and a couple of "tokens"
  #  that appear to always be 0xFFFF

  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: ParseNetLogon Hash Final - ".Dumper($Hash_ptr))};

  # No clear thing to return so this is good, everyting else in hash
  return ($ServerSiteNamePart,$ClientSiteNamePart,$ClientNextClosestSiteNamePart);
 }


#
# Function UUIDHexStrToString
#   Simple string manipulation of raw hex string GUID to friendly format
#
sub UUIDHexStrToString
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter UUIDHexStrToString...")};
  my $rawGUID=uc(shift);

  # Blow apart raw GUID 
  # Example                   90  11  fd  98  67  e1  34  47  a585  7981238a135e         
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: RAWGUID=$rawGUID")};
  my @arrRawGUID=($rawGUID=~/(..)(..)(..)(..)(..)(..)(..)(..)(....)(.+)/);

  # Reassemble GUID in friendly format
  # Re-assembly order = 03 02 01 00 - 05 04 - 07 06 - 0008 - 000000000009
  # Example             98 FD 11 90 - E1 67 - 47 34 - A585 - 7981238A135E               
  my @arrGUID=($arrRawGUID[3],$arrRawGUID[2],$arrRawGUID[1],$arrRawGUID[0],"-",
                 $arrRawGUID[5],$arrRawGUID[4],"-",$arrRawGUID[7],$arrRawGUID[6],"-",
                   $arrRawGUID[8],"-",$arrRawGUID[9]);
  my $GUID=join("",@arrGUID);  
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: GUID=$GUID")};

  return $GUID;
 }


#
# Function GetCompressedName
#   Unpack strings from the compressed name blob 
#     Basically there is a series of strings
#     and when you have some strings like 
#       forestname.com
#       domain.forestname.com
#       host.domain.forestname.com
#    you can save space and store them like 
#      [size]forestname.com[00] at offset 0
#      [size]domain[offset 0] at offset x
#      [size]host[offset x] at offset y
#
#  More information on this can be found at
#    MS-ADTS Protocol Documentation, 6.3.7 Name Compression and Decompression
#    https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-adts/b0ef9479-78d8-40c1-b6d2-0baad834ed39
#    This is all related to RFC1035 - https://www.ietf.org/rfc/rfc1035.txt
#  You should be able to decode these values with Net::DNS::DomainName
#  however the intent of this script is to allow someone to take the code
#  and implement this in any language on any platform so I figured doing it all
#  manually was the best path
#
#
sub GetCompressedName
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter GetCompressedName...")};
  my $Data_ptr=shift;
  my $NameSpaceHash_ptr=shift;

  my $pos=0.0;
  my $bDone=0;
  my $strFullName="";

 # Loop through characters until hit end of word or run out of characters
 # Should never run out of characters but just in case.... 
 while (!$bDone && length($$Data_ptr)) 
   {
    if ($g_bDebug and $g_bVerbose) 
     {
      LOG("DEBUG: +++++++++++++++++++++");
      LOG("DEBUG: Start Data     : $$Data_ptr");
     }

    # Pull off hint
    my $hint=GetXChars(1,$Data_ptr,\$pos);
    if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Short Hint     : $hint")};

    # Look at the "hint" data. This could be a pointer.
    # If it is a pointer, handle it here.
    #   Pointer to offset to pull off previous string
    #     xxyy yyyy yyyy yyyy
    #      where xx flags it is an offset and y's are offset value
    #     Value is binary 1100 where only the first two bits matter
    #     to flag that we have an offset decompression to perform 
    #     Note for this use the offset value will likely never exceed
    #     255 (two "characters") in size but still do it right. 
    # This is also the end of the string
    if ($hint=~/^([c-fC-F])/)
     {
      my $offset=GetXChars(3,$Data_ptr,\$pos);
      
      # Prepend the value from the two low
      # order bits from the initial "hint" character.
      # Effectively this is val & 0x3FFF
      my $loworder=chr(48+(ord(lc($hint))-ord('c')));
      $offset=$loworder.$offset; 
      my $offsetval=hex($offset);
      if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Full Hint - Offset --- 0x$offset -- ".$offsetval)};
 
      # Grab the rest of the name from Hash
      $strFullName.=$$NameSpaceHash_ptr{$offsetval};  

      $bDone=1;
      next;
     }

    # Pull the rest of the "hint" which will be OO or 
    # XX length of string in structure to grab next
    $hint.=GetXChars(1,$Data_ptr,\$pos);
    if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Full Hint (len): $hint")};


    # Full Hint is 00 so end of the string
    if ($hint eq '00') 
     {
      $bDone=1; 
      next;
     }

    # Full hint is length XX of string to unpack
    my $iLen=hex($hint);
    my $string=HexToASCII(GetXChars($iLen*2,$Data_ptr,\$pos));
    $strFullName.=$string.".";

    if ($g_bDebug and $g_bVerbose) 
     {
      LOG("DEBUG: String         : $string");
      LOG("DEBUG: Full String    : $strFullName");
      LOG("DEBUG: ---------------------");
     }
   }

  $strFullName=~s/\.$//;
  if ($g_bDebug and $g_bVerbose) 
   {
    LOG("DEBUG: FINAL Full String: $strFullName");
    LOG("DEBUG: Inserting [$strFullName] into position $$NameSpaceHash_ptr{'CURRENT'}");
   }
  $$NameSpaceHash_ptr{$$NameSpaceHash_ptr{'CURRENT'}}=$strFullName;
  $$NameSpaceHash_ptr{'CURRENT'}=$$NameSpaceHash_ptr{'CURRENT'}+$pos;
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: NameSpace Hash - ".Dumper($NameSpaceHash_ptr))};

  return $strFullName;
 }


#
# Function GetXChars
#    Every HEX string char is a nibble so .5 increment 
#
sub GetXChars
 {  
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter GetXChars...")};
  my $charcount=shift;
  my $Data_ptr=shift;
  my $pos=shift;

  my $rv=substr($$Data_ptr,0,$charcount);
  $$Data_ptr=substr($$Data_ptr,$charcount);
  $$pos+=$charcount/2;
  return $rv;
 }


#
# Function HexToASCII
#
sub HexToASCII
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter HexToASCII...")};
  my $hexstring=shift;
  my $packed=pack('H*',$hexstring."00");
  my $unpacked=unpack('Z*',$packed);
  return $unpacked;
 }


#
# Function DNSLookup
#  Requires the Net::DNS module
#
sub DNSLookup
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter DNSLookup...")};
  my $strRecordName=shift;
  my $strRecordType=shift;
  my $RSHash_ptr=shift;

  if ($g_bDebug) {LOG("DEBUG: DNSLookup - $strRecordType - $strRecordName")};

  my $bLoadHash=(ref($RSHash_ptr) eq 'HASH');
  my @results=();

  my $res = Net::DNS::Resolver->new;
  my $query=$res->search($strRecordName, $strRecordType);
  if (!$query) 
   {
    LOG("ERROR: DNSLookup - ".$res->errorstring);
    return (-1,$res->errorstring);
   }
  my @answers=$query->answer;

  #
  # Process A/HOST record. 
  #
  if ($strRecordType eq "A")
   {
    foreach my $rr (@answers)
     {
      if ($rr->can('address'))
       {
        my $address=$rr->address;
        push @results,$address;

        if ($bLoadHash) 
         {
          $$RSHash_ptr{$address}{TTL}=$rr->ttl;
         }
       }
     }
   }

  #
  # Process SRV record. 
  #
  if ($strRecordType eq "SRV") 
   {
    my @ordered = rrsort("SRV", "priority", @answers);
    my $order=0; 
    foreach my $rr (@ordered) 
     {
      my $host=$rr->target;
      push @results,$host;
      if ($g_bDebug) {LOG("DEBUG: Detected Host: $host")};
      if ($bLoadHash) 
       {
        $$RSHash_ptr{$host}{'*ORDER*'}=$order++;
        $$RSHash_ptr{$host}{'TTL'}=$rr->ttl;
        $$RSHash_ptr{$host}{'PRIORITY'}=$rr->priority;
        $$RSHash_ptr{$host}{'WEIGHT'}=$rr->weight;
        $$RSHash_ptr{$host}{'PORT'}=$rr->port;
       }
     }
   }
  if ($g_bDebug && $bLoadHash) {LOG("DEBUG: DNSLookup Hash - ".Dumper($RSHash_ptr))};
  if ($g_bDebug) {LOG("DEBUG: DNSLookup Results - @results")};
  return @results;
 }


#
# Function GetDNSRecords
#   Note: If $strGetGCList is TRUE then $strDomain must be forest root domain
#
#   Note: Bit of a trick here, if site "NO SPECIFIC SITE" is passed into 
#         this function it will really look for DCs/GCs across all sites. 
#
sub GetDNSRecords
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter GetDNSRecords...")};
  my $strDomain=shift;
  my $strGetGCList=shift;
  my $arrSiteList_ptr=shift;
  my $arrDNSRecords_ptr=shift;
  my @resultset=();

  my $iSiteCount=0;
  my @arrDCs=();
  foreach my $thissite (@$arrSiteList_ptr) 
   {
    next unless $thissite=~/\w/;

    my $strDNSName="";
    if ($thissite eq "NO SPECIFIC SITE") 
     {
      LOG_CONSOLE("Dynamically determining domain $strDomain non-site specific ".
                 ($strGetGCList eq "TRUE"?"global catalogs":"domain controllers")."...");
      $strDNSName=($strGetGCList eq "TRUE"?"_gc":"_ldap")."._tcp.".$strDomain;
     }
    else
     {
      LOG_CONSOLE("Dynamically determining domain $strDomain site specific ".
              ($strGetGCList eq "TRUE"?"global catalogs":"domain controllers")." for site $thissite...");
      $strDNSName=($strGetGCList eq "TRUE"?"_gc":"_ldap")."._tcp.".$thissite."._sites.".$strDomain;
     }

    $$arrDNSRecords_ptr[$iSiteCount]{$thissite}{'*COUNT*'}=$iSiteCount;
    my $thisentry=\%{$$arrDNSRecords_ptr[$iSiteCount]{$thissite}};
    @arrDCs=DNSLookup($strDNSName,"SRV",$thisentry); 
    $iSiteCount++;
    if ($arrSiteDCs[0] == -1) 
     {
      LOG_CONSOLE("ERROR: Couldn't resolve $strDNSName : $arrDCs[1]");
      @arrDCs=();
     }
    else {@resultset=(@resultset,@arrDCs)};
   }

  if ($g_bDebug and $g_bVerbose) 
   {
    LOG("*" x 80);
    LOG("DNS RECORDS LOOKUP");
    LOG(Dumper($arrDNSRecords_ptr));
    LOG("*" x 80);
   }

  return @arrDCs;
 }


#
# Function GetBootStrapDCs
#   Get bootstrap DCs from domain name in DNS
#
sub GetBootStrapDCs
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter GetBootStrapDCs...")};
  my $config_SystemDomain=shift;
  my @arrayBootDCs=();
 
  # Try to look up SRV records for _ldap._tcp.domain
  # This is preferred for finding the bootstrap domain controller
  # It is unlikely this will not work.
  my $dnsname="_ldap._tcp.".$config_SystemDomain;
  LOG("Looking up DNS SRV Record: $dnsname");
  @arrayBootDCs=DNSLookup($dnsname,"SRV");
  if ($arrayBootDCs[0] == -1) 
   {
    LOG_CONSOLE("ERROR: Couldn't resolve $dnsname : $arrayBootDCs[1]");
    @arrayBootDCs=();
   }
  LOG("Results: ".join("::",@arrayBootDCs));
  

  if (scalar(@arrayBootDCs) == 0) 
   {
    # SRV record failed, instead use the domain group host record
    # Less preferred, should work but not guaranteed 
    LOG("Looking up DNS A Record: $config_SystemDomain");
    @arrayBootDCs=DNSLookup($config_SystemDomain,"A");
    if ($arrayBootDCs[0] == -1) 
     {
      BailOut("Couldn't resolve $config_SystemDomain : $arrayBootDCs[1]");
     } 
    LOG("Results: ".join("::",@arrayBootDCs));
   }
  return @arrayBootDCs;
 }


#
# Function GetRootDSE
#
sub GetRootDSE
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter GetRootDSE...")};
  my $iTimeout=shift;
  my $strHost=shift;
  my $rootdse_ptr=shift;
  my $strPort=shift || 389;
  my $Elapsed_ptr=shift;  # optional for timing info
  my $strRVAttr=shift;


  my $bSSL=$FALSE;
  if ($strPort == 636 or $strPort == 3269) {$bSSL=$TRUE}; 

  my $hostURI=($bSSL?"LDAPS":"LDAP")."://".$strHost.":".$strPort;

  if ($g_bDebug) {LOG("DEBUG: Retrieving RootDSE from HOST=$hostURI")};

  if ($strRVAttr ne "") {$$rootdse_ptr{$strRVAttr}=""}; 

  my @arrAttributes=keys %$rootdse_ptr;
  LOG("ATTRIBUTES: @arrAttributes");

  my $ldap;

  # Try to open the LDAP Connection
  if ($g_bDebug) {LOG("DEBUG:   LDAP->new......(timeout=$iTimeout)...")};
  my $timername="GETROOTDSE_$strHost";
  ELAPSEDTIMER_START($timername);
  $ldap=Net::LDAP->new($hostURI, timeout => $iTimeout); # $strHost

  # Return on failure
  LOG("ERROR: Failed to open LDAP connection to $hostURI : $@") if !$ldap;
  return "ERROR: Failed to open LDAP connection to $hostURI : $@" if !$ldap;

  if ($g_bDebug) {LOG("DEBUG:   LDAP->new completed.")};
  if ($g_bDebug) {LOG("DEBUG:   LDAP->bind...")};
  $ldap->bind;
  if ($g_bDebug) {LOG("DEBUG:   LDAP->bind completed.")};
  if ($g_bDebug) {LOG("DEBUG:   LDAP->search...")};
  # try the LDAP search
  my $mesg = $ldap->search( # perform a search
                        scope  => 'base',
                        base   => "",
                        filter => "objectclass=*",
                        attrs  => [@arrAttributes]
                       );
  $$Elapsed_ptr=ELAPSEDTIMER_STOP($timername,"raw");
  LOG("ELAPSEDTIMER GETROOTDSE RAW = ".$$Elapsed_ptr);
  LOG("ELAPSEDTIMER GETROOTDSE = ".ELAPSEDTIME_ELAPSED($timername));
  if ($g_bDebug) {LOG_CONSOLE("DEBUG: LDAP Response Time: ".ELAPSEDTIME_ELAPSED($timername,"raw")." seconds.")};

  # Return on failure
  LOG("RETURN CODE: ".$mesg->code);
  LOG("ERROR: Failed to execute search : ".$mesg->error) if $mesg->code;   
  return "ERROR: Failed to execute search :".$mesg->error if $mesg->code;   
  if ($g_bDebug) {LOG("DEBUG:   LDAP->search completed.")};

  foreach my $strAttr (@arrAttributes) 
   {
    my $attr=join(";",($mesg->entries)[0]->get_value($strAttr));
    if ($g_bDebug) {LOG_CONSOLE("DEBUG: $strAttr = $attr")} else {LOG("$strAttr = $attr")};
    $$rootdse_ptr{$strAttr}=$attr;
   }

  if ($g_bDebug and $g_bVerbose) 
   {
    LOG("DEBUG: ".Dumper($rootdse_ptr));
    LOG("DEBUG: strRVAttr = $strRVAttr == $$rootdse_ptr{$strRVAttr}");
   }
  if ($strRVAttr) {return $$rootdse_ptr{$strRVAttr}}
  else {return 0};
 }


#
# Function FSMOLIST
#
sub FSMOLIST
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter FSMOLIST...")};
  my $fsmostrings=shift;

  my @FSMOStrings=();
  my @fsmos=split(/;/,$fsmostrings);
  if (grep(/^DC=/,@fsmos)) {push @FSMOStrings,"PDC"};
  if (grep(/^CN=RID/,@fsmos)) {push @FSMOStrings,"RID"};
  if (grep(/^CN=Schema/,@fsmos)) {push @FSMOStrings,"PDC"};
  if (grep(/^CN=Partitions/,@fsmos)) {push @FSMOStrings,"DOMMSTR"};
  if (grep(/^CN=Infrastructure/,@fsmos)) {push @FSMOStrings,"INFMSTR"};
  return join(";",@FSMOStrings);
 }


#
# Function IsThisPDC
#
sub IsThisPDC
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter IsThisPDC...")};
  my $hash_ptr=shift;
  my @fsmos=split(/;/,$$hash_ptr{'rootdse'}{'validFSMOs'});
  if (grep(/^DC=/,@fsmos)) 
   {
    # This is a PDC
    $$hash_ptr{'PDC'}=$TRUE;
   }
  return $$hash_ptr{'PDC'};
 }


#
# Function ValidateDCs
#   Validate DCs with required validation tests
#   Order DCs in ValidatedHash in preference order
#
sub ValidateDCs
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter ValidateDCs...")};
  my $iTimeout=shift;
  my $strDomain=shift;
  my $strGetGCs=shift;
  my $strFilterPDC=shift;
  my $arrSiteDCs_ptr=shift;
  my $ValidatedHash_ptr=shift;

  my @arrResultSet=();

  # Loop through all DCs sending validation checks
  # Should be done multi-threaded for best perf
  # Add DNS and validation info to %ValidatedHash for validated DCs
  #   Possible Validation Tests that could be produced (not necessarily 
  #   implemented in this code)
  #      UDP "Ping"  (not currently possible with Net::LDAP)
  #      TCP "Ping"
  #      Retrieve RootDSE and validate specific attributes 
  #        isSynchronized
  #        isGlobalCatalogReady
  #        defaultNamingContext
  #        forestFunctionality
  #        domainFunctionality
  #        domainControllerFunctionality
  #        validFSMOs
  #        
  #     TCP "Ping" via LDAPS
  #     Retrieve RootDSE and validate specific attributes via LDAPS


  if ($g_bDebug and $g_bVerbose) 
   {
    LOG_CONSOLE("DEBUG: ");
    LOG_CONSOLE("DEBUG:: ===Initial DC List For Validation arrSiteDCs===");
    LOG_CONSOLE("DEBUG: ValidateDCs ".Dumper(\@arrSiteDCs));
    LOG_CONSOLE("DEBUG: ");
   }


  # Create alias for ValidatedHash Pointer passed in as param
  # Need some experimental stuff enabled up top - aliasing and declared refs
  # This may be lazy but it shouldn't require experimental functions either
  # Because messing with Hash Pointers can be painful, you know it's true
  # Still better than a global...
  my \%tmpValidationHash=$ValidatedHash_ptr;

  # Process Validation Tests
  my @dclist=();
  foreach my $currententry_ptr (@$arrSiteDCs_ptr) 
   {
    foreach my $currentsite (keys %$currententry_ptr)
     { 
      my $currentsite_order=$$currententry_ptr{$currentsite}{"*COUNT*"};
      LOG_CONSOLE("Validating DCs for $currentsite...(Order=$currentsite_order)");
      foreach my $currenthost (keys %{$$currententry_ptr{$currentsite}})
       {
        next if $currenthost=~/^\*/;   # Skip any embedded variables in site hash
        LOG_CONSOLE("      $currenthost...");

        # TCP LDAP Ping
        LOG_CONSOLE("        TCP LDAP PING...");
        my $tcpping_elapsedtime=-1;
        my %tcppingHash=();


        # For GC Ping need to specify the domain name of the actual DC, not the forest name
        # Interesting twist because the FQDN isn't guaranteed to be the same as the domain name of the DC
        my @tcpping_rv=(AnonLDAPPing($iTimeout,$strDomain,$currenthost,\%tcppingHash,
                                ($strGetGCs?"3268":"389"),\$tcpping_elapsedtime," " x 10));


        my $tcpping_dcsite=$tcpping_rv[0];
        LOG_CONSOLE("          DC Site     = $tcpping_dcsite");
        LOG_CONSOLE("          ElapsedTime = $tcpping_elapsedtime");
        $tcppingHash{'RESPONSE_TIME'}=$tcpping_elapsedtime;      

        if ($tcpping_rv[0]!~/ERROR:/) 
         {
          # RootDSE Attribs
          LOG_CONSOLE("     Retrieving RootDSE...");
          my $rootdse_elapsedtime=-1;
          my %rootDSEHash=("isSynchronized"=>"",
                           "rootDomainNamingContext"=>"",
                           "defaultNamingContext"=>"",
                           "isGlobalCatalogReady"=>"",
                           "domainControllerFunctionality"=>"",
                           "domainFunctionality"=>"",
                           "forestFunctionality"=>"",
                           "validFSMOs"=>"");
          my $rootdse_isSynchronized=(GetRootDSE($iTimeout,$currenthost,\%rootDSEHash,
                            ($strGetGCs?"3268":"389"),\$rootdse_elapsedtime,"isSynchronized"));
          LOG_CONSOLE("          Synchronized = $rootdse_isSynchronized");
          LOG_CONSOLE("          ElapsedTime  = $rootdse_elapsedtime");
          $rootDSEHash{'RESPONSE_TIME'}=$rootdse_elapsedtime;      

          my $bSaveInfo=$TRUE;

          # If not synced, bail out
          if ($rootDSEHash{'isSynchronized'} ne "TRUE") 
           {
            LOG("ERROR: Validation Fail: Domain Controller not synchronized - $currentsite - ".
                                    "$currenthost - isSynchronized = $rootDSEHash{'isSynchronized'}");
            $bSaveInfo=$FALSE;
           }

          # If GC is selected, make sure GC is ready, if not ready, bail out
          if ($strGetGCs eq "TRUE" and $rootDSEHash{'isGlobalCatalogReady'} ne "TRUE") 
           {
            LOG("ERROR: Validation Fail: Global Catalog is not ready - $currentsite - ".
                         "$currenthost - isGlobalCatalogReady = $rootDSEHash{'isGlobalCatalogReady'}");
            $bSaveInfo=$FALSE;
           }

          ##
          ## Example of checking for minimum domain controller OS version
          ##
          #my $iMinDCOSVersion=7;     # Minimum required OS functionality level is Windows Server 2016
          #if ($rootDSEHash{'domainControllerFunctionality'} < $iMinDCOSVersion) 
          # {
          #  LOG("ERROR: Validation Fail: Domain Controller Version too low - $currentsite - $currenthost" .
          #         " - iMinDCOSVersion = $iMinDCOSVersion - Current Version: $rootDSEHash{'domainControllerFunctionality'}");
          #  $bSaveInfo=$FALSE;
          # }


          if ($bSaveInfo) 
           {
            # Copy data into temp hash
            map {$tmpValidationHash{$currentsite}{$currenthost}{'tcpping'}{$_}=$tcppingHash{$_}} keys %tcppingHash;
            map {$tmpValidationHash{$currentsite}{$currenthost}{'rootdse'}{$_}=$rootDSEHash{$_}} keys %rootDSEHash;
            $tmpValidationHash{$currentsite}{'*ORDER*'}=$currentsite_order;
            $tmpValidationHash{$currentsite}{$currenthost}{'AVG_RESPONSE_TIME'}=($tcpping_elapsedtime + $rootdse_elapsedtime)/2;
            push @dclist,$currenthost;
            map {next if $_ eq "*COUNT*";$tmpValidationHash{$currentsite}{$currenthost}{'dns'}{$_}=
                    $$currententry_ptr{$currentsite}{$currenthost}{$_}} keys %{$$currententry_ptr{$currentsite}{$currenthost}};
           }
         }
       }      
     }
   }

  # Dump out the intermediate info from basic tests
  if ($g_bDebug) 
   {
    LOG_CONSOLE("DEBUG:: ");
    LOG_CONSOLE("DEBUG: ===Intermediate tmpValidationHash===");
    LOG_CONSOLE("DEBUG: tmpValidationHash ".Dumper(\%tmpValidationHash));
    LOG_CONSOLE("DEBUG: ");
    LOG_CONSOLE("DEBUG: Validated DCs = @dclist");
    LOG_CONSOLE("DEBUG: ");
   }


  # If multiple DCs are validated and Filter PDCs enabled remove PDCs
  if (scalar(@dclist) > 1) 
   {
    LOG_CONSOLE("Checking Validation List for PDC domain controllers");
    foreach my $thissite (keys %tmpValidationHash) 
     {
      my @sitehosts=grep(!/^\*/,keys %{$tmpValidationHash{$thissite}});
      my @pdcs=();
      foreach my $thishost (@sitehosts) 
       {
        if (IsThisPDC($tmpValidationHash{$thissite}{$thishost})) 
         { # Machine is a PDC
          if ($strFilterPDC) {push @pdcs,$thishost};
         }
       }
      # Remove PDCs if needed
      if (scalar(@pdcs) and (scalar(@sitehosts) > scalar(@pdcs))) 
       {
        foreach my $thispdc (@pdcs) 
         {
          if ($g_bDebug) {LOG_CONSOLE("DEBUG: Removing PDC host $thispdc from Validation List")};
          LOG("Removing PDC host $thispdc from Validation List");
          delete $tmpValidationHash{$thissite}{$thispdc};
         }
       }  
     }
   }

  # Dump out the intermediate info after PDC removals
  if ($g_bDebug) 
   {
    LOG_CONSOLE("DEBUG: ");
    LOG_CONSOLE("DEBUG: ===Intermediate tmpValidationHash - PDCs ===");
    LOG_CONSOLE("DEBUG: tmpValidationHash ".Dumper(\%tmpValidationHash));
    LOG_CONSOLE("DEBUG: ");
   }


  # Set up ordering of ValidatedHash
  LOG_CONSOLE("Ordering DCs by Site | Priority | Avg Elapsed Response Time...");
  foreach my $thissite (sort {$tmpValidationHash{$a}{'*ORDER*'} <=> $tmpValidationHash{$b}{'*ORDER*'}} keys %tmpValidationHash) 
   {
    # Sort DCs in site by 
    #    1. Priority
    #    2. Response time 
    #    3. If not filter out PDCs entirely, drop their sort priority anyway
    my %SortHash=();
    foreach my $thishost (keys %{$tmpValidationHash{$thissite}}) 
     {
      next if $thishost=~/^\*/;   # skip anything with a leading * - it is a variable
      my $prio=$tmpValidationHash{$thissite}{$thishost}{'dns'}{'PRIORITY'};
      my $avgresponse=$tmpValidationHash{$thissite}{$thishost}{'AVG_RESPONSE_TIME'};
      my $pdcmodifier=$tmpValidationHash{$thissite}{$thishost}{'PDC'} || 0;
      my $sortval=($pdcmodifier*100000)+($prio*100) + $avgresponse;

      if ($g_bDebug) 
       {
        LOG("SITE=$thissite HOST=$thishost PDC=$pdcmodifier PRIO=$prio AVGRESPONSE=$avgresponse SORTVAL=$sortval");
       }
      $SortHash{$thishost}=$sortval;
     }
    my @arrSorted=sort {$SortHash{$a} <=> $SortHash{$a}} keys %SortHash;
    push @arrResultSet,@arrSorted;
    my $sortorder=0;
    map {$tmpValidationHash{$thissite}{$_}{'*SORTEDORDER*'}=$sortorder++} @arrSorted;
    if ($g_bDebug) 
     { 
      LOG("DEBUG: SORTED LIST FOR SITE - $thissite");
      map {LOG("DEBUG: HOST=$_\n")} @arrSorted;
     }
   }


  # Copy temp Hash to Final Validated Hash Variable
  #   Not necessary because using reference aliasing up top of function

  # Dump out the final validation hash that is returned
  if ($g_bDebug) 
   {
    LOG_CONSOLE("DEBUG:: ");
    LOG_CONSOLE("DEBUG: === Final ValidationHash===");
    LOG_CONSOLE("DEBUG: ValidationHash ".Dumper($ValidatedHash_ptr));
    LOG_CONSOLE("DEBUG: ");
   }


  if ($g_bDebug and $g_bVerbose) 
   { 
    LOG("DEBUG: ENTIRE SORTED LIST");
    map {LOG("DEBUG: HOST=$_\n")} @arrResultSet;
   }

  return @arrResultSet;
 }


#
# Function ProcessConfig
#
sub ProcessConfig
 { 
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter ProcessConfig...")};
  my $Config_ptr=shift;
  my $ConfigFileHash_ptr=shift;
  my $InputParams_ptr=shift;

  my $strInputGetGCList="";
  my $strInputFilterPDC="";
  my $strInputDomain="";
  my $strInputBootDCs="";
  my $strInputSites="";
  my $strInputAddonSites="";
  my $strInputLDAPTimeout="";

  #
  # Process parameters
  #
  map {
       if (/\/gclist/i) {$strInputGetGCList="TRUE"};
       if (/\/filterpdc/i) {$strInputFilterPDC="TRUE"};
       if (/\/domain:(.+)/i) {$strInputDomain=$1};
       if (/\/bootdcs:(.+)/i) {$strInputBootDCs=$1};
       if (/\/sites:(.+)/i) {$strInputSites=$1};
       if (/\/addonsites:(.+)/i) {$strInputAddonSites=$1};
       if (/\/timeout:(.+)/i) {$strInputLDAPTimeout=$1};
      } @ARGV;

  # Determine LDAP Timeout
  # From INI File 
  #    Section APPLICATION | SYSTEM
  #    Keyvalue LDAPTIMEOUT
  # Override INI file with command line if specified
  my $timeout=$strInputLDAPTimeout || $$ConfigFileHash_ptr{'APPLICATION'}{'LDAPTIMEOUT'} || 
                   $$ConfigFileHash_ptr{'SYSTEM'}{'LDAPTIMEOUT'} || $DEFAULT_LDAPTimeout; 
  $$Config_ptr{'ACTIVE'}{'LDAPTIMEOUT'}=$timeout;
  LOG("LDAP Timeout                     : $$Config_ptr{'ACTIVE'}{'LDAPTIMEOUTC'}");

  # Determine if should filter PDCs out of results
  # From INI File 
  #    Section APPLICATION
  #    Keyvalue FILTERPDC
  # Override INI file with command line if specified
  my $filterpdc=$strInputFilterPDC || $$ConfigFileHash_ptr{'APPLICATION'}{'FILTERPDC'};
  $$Config_ptr{'ACTIVE'}{'FILTERPDC'}=$filterpdc;
  LOG("Filter PDC(s)                    : $$Config_ptr{'ACTIVE'}{'FILTERPDC'}");

  # Determine Domain
  # From INI File 
  #    Section APPLICATION | SYSTEM
  #    Keyvalue DOMAIN
  # Override INI file with command line if specified
  my $domain=$strInputDomain || $$ConfigFileHash_ptr{'APPLICATION'}{'DOMAIN'} || $$ConfigFileHash_ptr{'SYSTEM'}{'DOMAIN'}; 
  $$Config_ptr{'ACTIVE'}{'DOMAIN'}=$domain;
  LOG("Domain                           : $$Config_ptr{'ACTIVE'}{'DOMAIN'}");

  # Determine Boot DC from Config
  # From INI File 
  #    Section APPLICATION | SYSTEM
  #    Keyvalue BOOTDCS
  # Override INI file with command line if specified
  my $bootdcs=$strInputBootDCs || $$ConfigFileHash_ptr{'APPLICATION'}{'BOOTDCS'} || $$ConfigFileHash_ptr{'SYSTEM'}{'BOOTDCS'};
  my @arrBootDCs=split(/,/,$bootdcs); 
  @{$$Config_ptr{'ACTIVE'}{'BOOTDCS'}}=@arrBootDCs;
  my $tmpbootdcs=join(",",@{$$Config_ptr{'ACTIVE'}{'BOOTDCS'}});
  LOG("Boot DC                          : $tmpbootdcs");

  # Determine if your application has been configured to use specific named Domain Controllers
  # From INI File 
  #    Section APPLICATION
  #    Keyvalue DOMAINCONTROLLERS
  @{$$Config_ptr{'ACTIVE'}{'DOMAINCONTROLLERS'}}=split(/,/,$$ConfigFileHash_ptr{'APPLICATION'}{'DOMAINCONTROLLERS'});
  my $tmpdomaincontrollers=join(",",@{$$Config_ptr{'ACTIVE'}{'DOMAINCONTROLLERS'}});
  LOG("DomainControllers                : $tmpdomaincontrollers");

  # Determine if looking for GCs only
  # From INI File 
  #    Section APPLICATION | SYSTEM
  #    Keyvalue GCLIST
  # Override INI file with command line if specified
  my $GCList=$strInputGetGCList || $$ConfigFileHash_ptr{'APPLICATION'}{'GCLIST'} || $$ConfigFileHash_ptr{'SYSTEM'}{'GCLIST'};
  $$Config_ptr{'ACTIVE'}{'GCLIST'}=$GCList;
  LOG("GCList                           : $$Config_ptr{'ACTIVE'}{'GCLIST'}");

  # Determine if hardcoded site(s) string specified
  # From INI File 
  #    Section APPLICATION | SYSTEM
  #    Keyvalue SITES
  # Override INI file with command line if specified
  my $sitelist=$strInputSites || $$ConfigFileHash_ptr{'APPLICATION'}{'SITES'} || $$ConfigFileHash_ptr{'SYSTEM'}{'SITES'};
  my @arrSiteList=split(/,/,$sitelist); 
  @{$$Config_ptr{'ACTIVE'}{'SITES'}}=@arrSiteList;
  my $tempsitelist=join(",",@{$$Config_ptr{'ACTIVE'}{'SITES'}});
  LOG("Sites                            : $tempsitelist");

  # Determine if addon site(s) string specified
  # From INI File 
  #    Section APPLICATION | SYSTEM
  #    Keyvalue ADDONSITES
  # Override INI file with command line if specified
  my $addonsitelist=$strInputAddonSites || $$ConfigFileHash_ptr{'APPLICATION'}{'ADDONSITES'} || $$ConfigFileHash_ptr{'SYSTEM'}{'ADDONSITES'};
  my @arrAddonSiteList=split(/,/,$addonsitelist); 
  @{$$Config_ptr{'ACTIVE'}{'ADDONSITES'}}=@arrAddonSiteList;
  my $tempaddonsitelist=join(",",@{$$Config_ptr{'ACTIVE'}{'ADDONSITES'}});
  LOG("Addon Sites                      : $tempaddonsitelist");

  if ($g_bDebug and $g_bVerbose) 
   {
    LOG("*" x 80);
    LOG("FINAL CONFIGURATION HASH");
    LOG(Dumper($Config_ptr));
    LOG("*" x 80);
   }

  return;
 }


#
#  Function ReadConfig
#
#  Read config file
#    Simple Key Value file parse function is called
#    This could be replaced with code to read
#    from a json or xml or whatever config file
#    type that is desired. Populate the Config 
#    Hash as needed and fix anything being driven
#    by the config. 
#
#    LAYOUT OF KEY/VALUE INI FILE
#      [SYSTEM]
#      # System level configuration settings
#      DOMAIN=k16tstchld.k16tst.test.loc
#      #DEBUG SETTING # BOOTDCS=k16tst-dc1.k16tst.test.loc
#
#      [APPLICATION]
#      # Application level configuration settings
#      #DEBUG SETTING # DOMAINCONTROLLERS=k16-dc1.k16tst.test.loc,k16-dc2.k16tst.test.loc
#      #DEBUG SETTING # SITES=Default-First-Site
#      LDAPTIMEOUT=5
#      FILTERPDC=FALSE
#
sub ReadConfig
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter ReadConfig...")};
  my $ConfigHash_ptr=shift;
  my $strConfigFile=shift;

  LOG("Reading Cong File $strConfigFile...");

  if (-e $strConfigFile) 
   {
    open CFG,"<$strConfigFile"  or BailOut("Couldn't read Config File $strConfigFile : $!");
    my @ConfigFile=<CFG>;
    close CFG;
    chomp @ConfigFile;
    ParseINI($ConfigHash_ptr,\@ConfigFile);
    return 1;
   }
  else 
   {
    LOG_CONSOLE("Configuration file does not exist, skipping...");
    return 0;
   }
 }


#
# Function ParseINI
#
#    Simple Key Value file parse function
#    This could be replaced with code to read
#    from a json or xml or whatever config file
#    type that is desired. Populate the Config 
#    Hash as needed and fix anything being driven
#    by the config. 
#
sub ParseINI
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter ParseINI...")};
  my $Hash_ptr=shift;
  my $ConfigFile_ptr=shift;

  LOG("Parsing Cong File...");
  my @INIFile=@{$ConfigFile_ptr};

  my $strSection="";
  my $strKeyName="";
  my $strKeyValue="";

  foreach (@INIFile)
   {
    next unless /\w/;           # blank line
    next if /^(#|;)/;           # comments 
    if (/^\[(.+)\]/)            # new section
     {
      $strSection=$1;     
      LOG("Processing $_");
      next;
     }

    #
    # No section defined yet
    #
    if ($strSection eq "")                                    
     {
      LOG("Skipping $_, [SECTION] not defined!");
      next;
     }    

    ($strKeyName,$strKeyValue)=split/=/;
    if ($strKeyValue eq "") {next};
    $$Hash_ptr{$strSection}{$strKeyName}=$strKeyValue;
    LOG("  Adding $strSection : $strKeyName=$strKeyValue...");
   }

  if ($g_bDebug and $g_bVerbose) 
   {
    LOG("*" x 80);
    LOG("FINAL INI FILE HASH");
    LOG(Dumper($ConfigFile_ptr));
    LOG("*" x 80);
   }

 }


#
# Function BailOut
#   Use instead of die
#
sub BailOut
 {
  if ($g_bDebug and $g_bVerbose) {LOG("DEBUG: Enter BailOut...")};
  LOG_CONSOLE("ERROR:");
  foreach my $strMsg (@_)
   {
    LOG_CONSOLE("ERROR: $strMsg");
   }
  LOG_CONSOLE("ERROR: Exiting program.");
  LOG_CONSOLE("ERROR:");
  LOG_CONSOLE("");
  LOG_CONSOLE("The command did not complete successfully.");
  exit -1;
 }


#****************************************************************************************
#                                                                                       *
# Log Functions                                                                         *
#                                                                                       *
#****************************************************************************************

#
# Function LOG_CONSOLEEx
#    Write to console and log file even if Quiet enabled
#
sub LOG_CONSOLEEx
 {
  map 
   { 
    print $_.(/\n$/?"":"\n");
    print LOGFILE StringTime("YYYYMMDD-HHmmss.uuuuu: ").$_.(/\n$/?"":"\n");
   } @_;
 }


#
# Function LOG_CONSOLE
#    Write to console and log file
#
sub LOG_CONSOLE
 {
  map 
   { 
    if (!$g_bQuiet) {print $_.(/\n$/?"":"\n")};
    print LOGFILE StringTime("YYYYMMDD-HHmmss.uuuuu: ").$_.(/\n$/?"":"\n");
   } @_;
 }


#
# Function LOG
#    Write to log file
#
sub LOG
 {
  map 
   { 
    print LOGFILE StringTime("YYYYMMDD-HHmmss.uuuuu: ").$_.(/\n$/?"":"\n");
   } @_;
 }

#
# Function SetAutoFlush
#    Enable immediate flush of data written to log files
#
sub SetAutoFlush
 {
  my $fh=shift;
  my $old_fh = select($fh);
  $| = 1;
  select($old_fh);
 }


#****************************************************************************************
#                                                                                       *
# Various time functions.                                                               *
#                                                                                       *
#****************************************************************************************

#
# Elapsed Time High Resolution Timer Functions
#  This should likely be in a class/module
#  Broken out into simple functions like 
#  this for simplest reading/duplication
#

#
# Function ELAPSEDTIME_START
#
sub ELAPSEDTIMER_START
 {
  my $timername=shift;
  $g_ETimerHash{$timername}{'START'}=[gettimeofday];
  $g_ETimerHash{$timername}{'END'}=[];
  return; 
 }


#
# Function ELAPSEDTIME_START
#
sub ELAPSEDTIMER_STOP
 {
  my $timername=shift;
  my $format=shift;
  $g_ETimerHash{$timername}{'END'}=[gettimeofday];
  return ELAPSEDTIME_ELAPSED($timername,$format); 
 }


#
# Function ELAPSEDTIME_START
#
sub ELAPSEDTIME_ELAPSED
 {
  my $timername=shift;
  my $format=shift || "mm:ss.uuuuu";
  my $elapsed = tv_interval($g_ETimerHash{$timername}{'START'},$g_ETimerHash{$timername}{'END'});  
  my $elapsedstr=$elapsed;
  if ($format!~/raw/) {$elapsedstr=StringTime($format,$elapsed)};
  return $elapsedstr; 
 }


#
# StringTime($format,$time)
#  StringTimeV2
#  MM   - 2 Digit Month (1-12)
#  MMM  - 3 Digit Month (Jan-Dec) 
#  DD   - 2 Digit Day
#  YY   - 2 Digit Year
#  YYYY - 4 Digit Year
#  HH   - 2 digit Hour - Miltary (0-23)
#  hh   - 2 Digit Hour - Non-Military (12-11)
#  XM   - AM or PM if hh is used.
#  mm   - 2 Digit Minute
#  ss   - 2 Digit Second
#  u    - 1 Digit MicroSeconds (new as of 20181229)
#  uu   - 2 Digit MicroSeconds (new as of 20181229)
#  uuu  - 3 Digit MicroSeconds (new as of 20181229)
#  uuuu - 4 Digit MicroSeconds (new as of 20181229)
#  uuuuu - 5 Digit MicroSeconds (new as of 20181229)
#  uuuuuu - 6 Digit MicroSeconds (new as of 20181229)
#  STRING - Return in Perl default Ex: Wed Feb 24 10:37:39 1999
#  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $ydat, $isdst)=localtime();
#
sub StringTime
 {
  my ($format,$t)=@_;
  $format="YYYY-MM-DD HH:mm:ss" unless $format;
  my $ms=0;
  if (!$t) 
   {
    if ($format=~/u/) {($t,$ms)=gettimeofday}
    else {$t=time()};
   }
  else
   {
    if ($t=~/\./) 
     {
      ($t,$ms)=($t=~/(\d+)\.(\d+)/);
     }
   }
  my @t=localtime($t);
  my $tstr=localtime($t);

  my $daystr=substr($tstr,0,3);
  my $day=sprintf("%02d",$t[3]);
  my $monthstr=substr($tstr,5,3);
  my $month=sprintf("%02d",$t[4]+1);
  my $year=$t[5];
  my $yearstr=$year+1900;
  while ($year>100) {$year-=100};
  $year=sprintf("%02d",$year);
  my $hour=sprintf("%02d",$t[2]);
  my $ampm=substr("AMPM",($hour>=12)*2,2);
  my $nonmilhour=sprintf("%02d",($hour-12*($hour>12)));
  my $minute=sprintf("%02d",$t[1]);
  my $second=sprintf("%02d",$t[0]);
  my $milliseconds=sprintf("%06d",$ms);
  my $milliseconds1=substr($milliseconds,0,1);
  my $milliseconds2=substr($milliseconds,0,2);
  my $milliseconds3=substr($milliseconds,0,3);
  my $milliseconds4=substr($milliseconds,0,4);
  my $milliseconds5=substr($milliseconds,0,5);
  my $milliseconds6=substr($milliseconds,0,6);

  $format=~s/MMM/$monthstr/;
  $format=~s/YYYY/$yearstr/;
  $format=~s/MM/$month/;
  $format=~s/DD/$day/;
  $format=~s/YY/$year/;
  $format=~s/HH/$hour/;
  $format=~s/hh/$nonmilhour/;
  $format=~s/XM/$ampm/; 
  $format=~s/mm/$minute/;
  $format=~s/ss/$second/;
  $format=~s/uuuuuu/$milliseconds6/;
  $format=~s/uuuuu/$milliseconds5/;
  $format=~s/uuuu/$milliseconds4/;
  $format=~s/uuu/$milliseconds3/;
  $format=~s/uu/$milliseconds2/;
  $format=~s/u/$milliseconds1/;
  $format=~s/STRING/$tstr/;
  return $format;
 }


#**************************************************************************************** 
#* Sub DisplayUsage:                                                                    * 
#*     Displays parameters and info on how to use script                                * 
#*                                                                                      * 
#*    Parameters:                                                                       * 
#*        None                                                                          * 
#*    Returns:                                                                          * 
#*        None                                                                          * 
#*======================================================================================* 
#*--------------------------------------------------------------------------------------* 
#****************************************************************************************
sub DisplayUsage
 {
  print "Usage: $SCRIPTNAME [options]\n\n";
  print "   [options]\n";
  print "     /?                 This usage screen.\n";
  print "     /help              This usage screen.\n";
  print "     /verbose           Enabled verbose output.\n";
  print "                        Used with /debug for very verbose debug.\n";
  print "     /debug             Enable debug output.\n";
  print "\n";
  print "     /configfile:xx     Configuration File. Default: jwDCLocator.config\n";
  print "     /logfile:xx        Log File. Default: [TIMESTAMP]-".$SCRIPTNAME.".log\n";
  print "\n";
  print "   These options override the configuration file options.\n";
  print "     /gclist            Return list of Global Catalogs\n";
  print "     /filterpdc         Filter out PDCs if there are multiple possible options\n";
  print "     /domain:xx         Domain to query for.\n";
  print "     /bootdcs:xx;yy     Domain Controllers to use to bootstrap (do not autodiscover).\n";
  print "     /site:xx;yy        Sites to use (do not autodiscover site).\n";
  print "     /addonsite:xx;yy   Sites to add to config file sites or discovered site.\n";
  print "     /timeout:xx        Timeout for LDAP queries. Default: 120 seconds.\n";
  print "\n";
  print "   NOTE: The config file is entirely optional, can run with options from\n";
  print "         the command line instead. At a minimum you need the domain FQDN\n";
  print "         that is resolveable on the machine running the script.\n";
  print "\n";
  print "   EXAMPLE:\n";
  print <<'ENDOFEXAMPLE'
            [Tue 04/02/2019  0:06:23.05]
            E:\DEV\perl\jwDCLocator>perl jwdclocator.pl /domain:k16tst.test.loc

            jwDCLocator V01.04.00pl  Joe Richards (support@joeware.net)  April 2019

            Initializing Logging to logfile 20190402-0006-jwDCLocator.log...
            Reading configuration file jwDCLocator.config...
            Configuration file does not exist, skipping...
            Determining bootstrap domain controllers via DNS for k16tst.test.loc...
              BootStrap Hosts: k16tst-scdc1.k16tst.test.loc k16tst-dc2.k16tst.test.loc k16tst-dc1.k16tst.test.loc
            Dynamically determining site...
              Sending LDAP Ping to LDAP://k16tst-scdc1.k16tst.test.loc:389...
              AutoDetected Server Site             : Site2
              AutoDetected Client Site             : joenetlogontestsite
              AutoDetected Client Next Closest Site: Default-First-Site-Name
            Determining site specific DNS records...
            Dynamically determining domain k16tst.test.loc site specific domain controllers for site joenetlogontestsite...
            Dynamically determining domain k16tst.test.loc site specific domain controllers for site Default-First-Site-Name...
            Validating DCs for joenetlogontestsite...(Order=0)
                  k16tst-dc1.k16tst.test.loc...
                    TCP LDAP PING...
                      Sending LDAP Ping to LDAP://k16tst-dc1.k16tst.test.loc:389...
                      DC Site     = Default-First-Site-Name
                      ElapsedTime = 0.009667
                 Retrieving RootDSE...
                      Synchronized = TRUE
                      ElapsedTime  = 0.011809
            Validating DCs for Default-First-Site-Name...(Order=1)
                  k16tst-dc1.k16tst.test.loc...
                    TCP LDAP PING...
                      Sending LDAP Ping to LDAP://k16tst-dc1.k16tst.test.loc:389...
                      DC Site     = Default-First-Site-Name
                      ElapsedTime = 0.01408
                 Retrieving RootDSE...
                      Synchronized = TRUE
                      ElapsedTime  = 0.013546
            Checking Validation List for PDC domain controllers
            Ordering DCs by Site | Priority | Avg Elapsed Response Time...
            Sorted Validated Domain Controller List
            k16tst-dc1.k16tst.test.loc

            The command completed.

ENDOFEXAMPLE
;
  print "\nThe command completed successfully.\n\n";
  exit;
 }



__DATA__

Sample INI File

[SYSTEM]
# System level configuration settings
DOMAIN=k16tst.test.loc
#DOMAIN=k16tstchld.k16tst.test.loc
#BOOTDCS=k16tst-dc1.k16tst.test.loc

[APPLICATION]
# Application level configuration settings
#DOMAINCONTROLLERS=k16-dc1.k16tst.test.loc,k16-dc2.k16tst.test.loc
#SITES=Default-First-Site
#ADDONSITES=site2
#GCLIST=TRUE
LDAPTIMEOUT=5
FILTERPDC=FALSE
