#!/usr/bin/perl

use strict;
use warnings;
use Net::LDAP;
use Net::DNS;
use Net::Ping;
use IO::Socket::PortState qw(check_ports);
use Config::INI::Reader;
use Term::ANSIColor qw(:constants);

use Data::Dumper;

my %all = ();
my %dcs = ();

my $timeout = 10;

my %port_hash = (
    tcp => {
        88   => { name => 'Kerberos (tcp)' },
        53   => { name => 'DNS (tcp)' },
        389  => { name => 'LDAP (tcp)' },
        636  => { name => 'LDAPS' },
        135  => { name => 'DCE/RPC Locator Service' },
        137  => { name => 'NetBIOS Name Service' },
        138  => { name => 'NetBIOS Datagram' },
        139  => { name => 'NetBIOS Session' },
        445  => { name => 'SMB over TCP' },
        464  => { name => 'Kerberos (tcp)' },
        3268 => { name => 'Global Catalog' },
        3269 => { name => 'Global Catalog (tcp)' }
    },
    udp => {
        53  => { name => 'DNS (udp)' },
        88  => { name => 'Kerberos (udp)' },
        123 => { name => 'NTP' },
        389 => { name => 'LDAP (udp)' },
        464 => { name => 'Kerberos (udp)' }
    },
);

my $_proto = shift @ARGV;

if ( defined $_proto && $_proto =~ /^(\-h|\-{2}help)/s ) {
    print join "\n", 
      "Usage: pre-join-check [PROTO]",
      "where PROTO - optional, protocol for ping request (tcp, udp, icmp (root only!), syn)",
      "Note - for root protocol set is ICMP by default (can be overridden)\n";
    exit 0;
}

my $config_file = '/etc/pre-join-check.conf';

open my $fh, '<', $config_file or die "Не удалось открыть конфиг $config_file: $!";
my $cleaned_content = "";

while ( my $line = <$fh> ) {
    if ( $line =~ /^([^=]+?)\s*=\s*(.*?)\s*$/ ) {
        my ( $key, $value ) = ( $1, $2 );
        $value =~ s/^["'](.*)["']$/$1/;
        $line = "$key=$value\n";
    }
    $cleaned_content .= $line;
}
close $fh;

my $cfg = Config::INI::Reader->read_string($cleaned_content);

my $ldap_host        = $cfg->{ldap}->{ldap_host};
my $ldap_root        = $cfg->{ldap}->{ldap_root};        # root DN
my $ldap_base        = $cfg->{ldap}->{ldap_base};        # start search DN for problem records
my ( $ldap_user, $ldap_passwd ) = ( $cfg->{ldap}->{ldap_user}, $cfg->{ldap}->{ldap_passwd} );
my $forward_dns_zone = $cfg->{ldap}->{forward_dns_zone}; # domain zone

sub check_msdcs {
    my $res = Net::DNS::Resolver->new;
    $res->tcp_timeout($timeout);
    $res->nameservers($ldap_host);
    print "-" x 53, "\n", "Check zone (_msdcs.$forward_dns_zone)\n";
    my $reply = $res->query( '_msdcs.' . $forward_dns_zone, "NS" );
    
    if ($reply) {
        foreach my $rr ( grep { $_->type eq "NS" } $reply->answer ) {
            print GREEN, '[OK] ', RESET;
            print '_msdcs.' . $forward_dns_zone . ' in NS ', GREEN, '[',
              $rr->nsdname . ']', RESET "\n";
        }
    }
    else {
        print RED, '[FAIL]', RESET, " _msdcs.$forward_dns_zone NOT present. (",
          $res->errorstring, ")\n";
    }
}

sub getIP {
    my $host = shift;
    my $_tmp;

    my $res = Net::DNS::Resolver->new;
    $res->tcp_timeout($timeout);
    $res->nameservers($ldap_host);

    my $reply = $res->search( $host . '.' . $forward_dns_zone, "A" );
    if ($reply) {
        foreach my $rr ( grep { $_->can("address") } $reply->answer ) {
            $dcs{$host} = $rr->address;
            $_tmp = ' (' . GREEN . ( $rr->address ) . RESET . ')';
        }
    }
    else {
        $_tmp = ' (' . GREEN . ( $res->errorstring ) . RESET . ')';
    }

    return $_tmp || ' (No IP found)';
}

sub getAllDC {
    my $ldap = Net::LDAP->new( $ldap_host, version => 3 ) or die "LDAP Connect error: $@";
    my $mesg = $ldap->bind( $ldap_user, password => $ldap_passwd );
    $mesg->code and die "Bind error: " . $mesg->error;

    my $srch = $ldap->search(
        base   => 'ou=domain controllers,' . $ldap_root,
        filter => "(objectClass=computer)",
        attrs  => ['cn']
    );

    if ( scalar( $srch->entries ) == 0 ) {
        print RED, '[FAIL]', RESET,
          ' No DC found in OU=Domain controllers,' . $ldap_root . "\n";
    }
    else {
        printf 'Found ' . ( scalar( $srch->entries ) ) . ' domain controllers' . "\n";
    }

    foreach my $entry ( $srch->entries ) {
        foreach my $item ( $entry->attributes ) {
            my $dc_name = $entry->get_value($item);
            printf "%-25s : %s\n", $dc_name, getIP($dc_name);
        }
    }
}

sub check_DCs {
    getAllDC();

    my $is_root = ( $< == 0 );

    if ( not defined $_proto ) {
        $_proto = $is_root ? 'icmp' : 'tcp';
    }
    else {
        if ( $_proto !~ /^(tcp|icmp|udp|syn)$/i ) {
            $_proto = 'tcp';
        }
    }

    # Fallback to tcp if unprivileged user requests icmp/syn
    if ( $_proto =~ /^(icmp|syn)$/i && !$is_root ) {
        print YELLOW, "Warning: $_proto ping requires root privileges. Falling back to tcp.", RESET, "\n";
        $_proto = 'tcp';
    }

    my $_uid_name = $ENV{LOGNAME} || $ENV{USER} || getpwuid($<) || 'unknown';

    print "\n" . BOLD . "Сheck host availability" . RESET . "\n";
    print "Using $_proto ping for current user ($_uid_name)\n";
    
    my $ping = Net::Ping->new( $_proto, 3 );
    foreach my $dc ( keys %dcs ) {
        if ( $ping->ping( $dcs{$dc} ) ) {
            printf "%-25s : %s\n", $dcs{$dc}, RESET . GREEN . "UP" . RESET;
        }
        else {
            printf "%-25s : %s\n", $dcs{$dc}, RESET . RED . "DOWN" . RESET;
        }
    }
    $ping->close();
}


sub check_records {
    my $ldap = Net::LDAP->new( $ldap_host, version => 3 ) or die "$@";
    my $mesg = $ldap->bind( $ldap_user, password => $ldap_passwd );
    $mesg->code and die $mesg->error;

    my $srch = $ldap->search(
        base   => $ldap_base,
        scope  => 'sub',
        filter => '(name=* *)',
    );

    foreach my $entry ( $srch->entries ) {
        ( my $_tmp = $entry->{'asn'}->{'objectName'} ) =~ s/[\s\t\\]+//g;
        push @{ $all{$_tmp} }, $entry->{'asn'}->{'objectName'};
    }
    $mesg = $ldap->unbind;

    print "Find problem ldap records (method1)";
    my $_tmp = 0;
    foreach my $items ( keys %all ) {
        if ( scalar( @{ $all{$items} } ) > 1 ) {
            print join "\n", RED, sort { $b cmp $a } @{ $all{$items} }, RESET,
              "\n";
            $_tmp = 1;
        }
    }
    print "\n", GREEN, '[OK]', RESET, " no problems records found\n"
      if ( $_tmp == 0 );
}

sub check_records2 {
    my $problem_found = 0;
    my $ldap = Net::LDAP->new($ldap_host) or die "Не удалось подключиться к LDAP: $@";
    my $mesg = $ldap->bind( $ldap_user, password => $ldap_passwd );
    $mesg->code and die "Ошибка авторизации: ", $mesg->error;

    my $objects_search = $ldap->search(
        base   => $ldap_base,
        scope  => 'sub',
        filter => '(name=* *)',
        attrs  => [ 'name', 'distinguishedName' ]
    );

    $objects_search->code and die RED, "Ошибка базового поиска: ", $objects_search->error, RESET;

    my %processed_regex_list;

    print RESET, "Find problem ldap records (method2)";

    foreach my $entry ( $objects_search->entries ) {
        my $dn   = $entry->dn;
        my $name = $entry->get_value('name');

        my $container = $dn;
        $container =~ s/^(?:[^\\,]|\\.)+,//;

        my $base_name = $name;
        $base_name =~ s/^\s+|\s+$//g;

        my $object_regex_str = quotemeta($base_name);
        $object_regex_str =~ s/(?:\\ )+/\\s+/g;

        my $object_regex = qr/^\s*$object_regex_str\s*$/i;

        my $hash_key = "$container|$object_regex_str";
        next if $processed_regex_list{$hash_key};

        my $object_tpl = $base_name;

        $object_tpl =~ s/\\/\\5c/g;
        $object_tpl =~ s/\(/\\28/g;
        $object_tpl =~ s/\)/\\29/g;
        $object_tpl =~ s/\x00/\\00/g;

        $object_tpl =~ s/\s+/*/g;
        $object_tpl =~ s/"/*/g;
        $object_tpl =~ s/\*+/*/g;

        $object_tpl = "*$object_tpl*";

        my $similar_search = $ldap->search(
            base   => $container,
            scope  => 'one',
            filter => "(name=$object_tpl)",
            attrs  => [ 'name', 'distinguishedName' ]
        );

        next if $similar_search->code;

        my @objects_similar = $similar_search->entries;

        if ( @objects_similar > 1 ) {
            my @objects_real_similar;

            foreach my $obj_similar ( sort { $b cmp $a } @objects_similar ) {
                my $sim_name = $obj_similar->get_value('name') || '';
                if ( $sim_name =~ $object_regex ) {
                    push @objects_real_similar, $obj_similar;
                }
            }

            if ( @objects_real_similar > 1 ) {
                $processed_regex_list{$hash_key} = 1;
                $problem_found = 1;
                foreach my $real_similar (@objects_real_similar) {
                    print "\n", RED, $real_similar->dn,  RESET;
                }
            }
        }
    }
    
    if ( $problem_found == 0 ) {
        print "\n", GREEN, '[OK]', RESET, " no problems records found\n";
    } else { print "\n" }
    $ldap->unbind;
}

sub check_dc_ports {
    my $host_hr = check_ports( $ldap_host, $timeout, \%port_hash );
    print "Check open ports: $ldap_host\n";
    foreach my $_proto (qw(tcp udp)) {
        for my $port ( sort { $a <=> $b } keys %{ $host_hr->{$_proto} } ) {
            my $yesno = $host_hr->{$_proto}{$port}{open} ? GREEN . "YES" : RED . "NO";
            printf "%-25s (%5s/$_proto) : %5s\n",
              $host_hr->{$_proto}{$port}{name}, $port, RESET . $yesno . RESET;
        }
    }
}

sub check_srv_records {
    my @records = qw(_kerberos._udp _kerberos._tcp _ldap._tcp _kpasswd._tcp _kpasswd._udp);

    foreach my $rec (@records) {
        my $res = Net::DNS::Resolver->new( nameservers => [$ldap_host] );
        $res->tcp_timeout($timeout);
        $res->udp_timeout($timeout);

        my $query_target = $rec . '.' . $forward_dns_zone;

        print "\n" . 'Check SRV record: ' . RESET . GREEN . $query_target . RESET . ".\n";
        print "-" x 53, "\n";

        my $reply = $res->query( $query_target, "SRV" );
        
        unless ($reply) {
            printf "%-25s : %s\n", $query_target . '.', RESET . RED . "FAIL" . RESET;
            next;
        }

        my @rr = grep { $_->type eq 'SRV' } $reply->answer;
        
        unless (@rr) {
            printf "%-25s : %s\n", $query_target . '.', RESET . RED . "FAIL" . RESET;
            next;
        }

        # Нативная сортировка вместо устаревшего rrsort
        my @rrs = sort { 
            $a->priority <=> $b->priority || 
            $b->weight <=> $a->weight 
        } @rr;

        print RESET . GREEN . $query_target . RESET . "\n";
        print "-" x 53, "\n";
        printf "%-25s | %3s | %6s | %5s\n", "Value", "Priority", "Weight", "Port";
        print "-" x 53, "\n";
        
        foreach my $rrsingle (@rrs) {
            printf "%-25s | %8d | %6s | %5d\n", 
              $rrsingle->target,
              $rrsingle->priority, 
              $rrsingle->weight, 
              $rrsingle->port;
        }
    }
}

# Основное выполнение
check_dc_ports();
print "-" x 53, "\n";
check_DCs();
print "-" x 53, "\n";
check_msdcs();
print "-" x 53, "\n";
check_srv_records();
print "-" x 53, "\n";
check_records();
print "-" x 53, "\n";
check_records2();