#! /usr/bin/perl -wT

# Nick Urbanik <nicku@vtc.edu.hk>, Sunday 1 December 2002

# Run like this:
# watch-ldap-log
# __not__ like this anymore:
# nohup watch-ldap-log >> ~/watch-ldap-log-stdout-stderr.log 2>&1 &
# Error messages will be in the file ~/watch-ldap-log-stdout-stderr.log

# A tool to analyse slapd logs.  The aim: at regular periods,
# determine the number of search requests during each period, and to
# further categorise these search requests by search filter type.  I
# have also provided a way to determine which uid some of these
# requests are for, and from which IP address they originate.

# TODO:
# the ultimate aim is to produce RRD graphs of the data.  This is a
# comparatively minor step now.

# Make so not dependent on arrival of requests before output data:
# better to print output at intervals of time (use an alarm SIGnal?)

# Also, make monitoring more flexible.
# For example, alert if requests in any selected category rise above
# a settable threshhold
# Provide easily selectable alert methods; integrate with mon?
# send SNMP Notifications?
# analyse data further?

use strict;
use Time::Local;
use Net::LDAP;
use MIME::Entity;
use FileHandle;
use Fcntl qw/ :flock /;
use File::Tail 0.8;

# enable autoflush:
$|=1;

$ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin:/usr/local/bin:/usr/local/sbin";
$ENV{ENV} = "";
our $last_time;
# Measure every $period seconds:
our $period = 60; # seconds
our $threshold = $period * 50; # 50 per second.
our $email_frequency = 30 * 60; # send email every 30 minutes
our $count = 0;
our ( $rootuid, $mailmanuid, $group, $gidnum, $uidnum, $uid,
      $obj_pres, $badgroup, $posixac, $shadac, $auto, $other,
      %users, %ipaddrs, %ipaddress, $hour, $min, $time,
    );
our $year = 2002;
our %months = (
               Jan => 0,
               Feb => 1,
               Mar => 2,
               Apr => 3,
               May => 4,
               Jun => 5,
               Jul => 6,
               Aug => 7,
               Sep => 8,
               Oct => 9,
               Nov => 10,
               Dec => 11
              );

$rootuid = $mailmanuid = $group = $gidnum = $uidnum
    = $other = $uid = $obj_pres = $badgroup = $posixac
    = $auto = $shadac = 0;

our @mail_recipients = qw/ thchan smcheung samsonc khcheung cmho kennyho
    henryl wkliu cpsiu hklee nicku /;
our $logfile_towatch = "/var/log/slapd";
our $logfile_summary = "/var/log/slapd-analysis";
our $errorfile = "/home/nicku/watch-ldap-log-stdout-stderr.log";

open ERROR_FILE, ">> $errorfile" or die "Cannot write to $errorfile: $!";
print ERROR_FILE "$0 starting up on ", scalar localtime, "\n";
# Need lock it:
open LOGFILE, ">> $logfile_summary" or die "Cannot open $logfile_summary: $!";
flock LOGFILE, LOCK_EX|LOCK_NB or die "$0 already running: $!";
# flock LOGFILE, LOCK_EX or die "Cannot lock $logfile_summary: $!";
our $oldhandle = select LOGFILE;
LOGFILE->autoflush( 1 );

sub exit_handler
{
    my $sig = shift;
    print LOGFILE "Caught a SIG$sig--shutting down\n";
    select $oldhandle;
    close LOGFILE;
    close ERROR_FILE;
    exit 0;
}

$SIG{INT}  = \&exit_handler;
$SIG{QUIT} = \&exit_handler;
$SIG{TERM} = \&exit_handler;
$SIG{HUP}  = 'IGNORE';
$SIG{PIPE} = 'IGNORE';

sub getLDAP_info($)
{
    my $uid = shift;
    #my $uid = $ENV{REMOTE_USER};
    my $BASE = 'dc=tyict,dc=vtc,dc=edu,dc=hk';
    my $ldap = Net::LDAP->new( "ldap.tyict.vtc.edu.hk" ) or die "$@";
    my $mesg = $ldap->bind();         # use for searches
    if ( my $error = $mesg->code() )
    {
        die "Cannot connect to LDAP server: ", $mesg->error(),
        " This may indicate a network problem\nTell Nick.\nASAP.\n";
    }
    $mesg = $ldap->search(
                          base => "ou=People,$BASE",
                          scope => 'one',
                          filter => "(uid=$uid)",
                          attrs =>  [ 'givenName', 'cn', 'course' ]
                         );
    if ( my $error = $mesg->code() )
    {
        die "Cannot find $uid in LDAP server: ", $mesg->error(),
        " This may indicate a network problem\nTell Nick.\nNow.\n";
    }
    $mesg->count() == 1 || die "Cannot get one entry for $uid\n";
    # return ($mesg->pop_entry())->get_value( 'course' );
    my $entry = $mesg->pop_entry();
    return ( $entry->get_value( 'givenName' ),
             $entry->get_value( 'cn' ),
             $entry->get_value( 'course' ) );
}

sub get_mac($)
{
    my $ip = shift;
    my $mac;
    open ARP, "arp $ip |" or die "Cannot start arp $ip: $!";
    ARP: while ( <ARP> )
    {
        # print;
        if ( /\b((?:[\da-fA-F]{2}:){5}[\da-fA-F]{2})\b/ )
        {
            $mac = $1;
            last ARP;
        }
    }
    close ARP;
    return;
}

sub canonicalise_mac($)
{
    my $mac = shift;
    my @bytes = split /[-: ]/, $mac, 6;
    $mac = join ':', @bytes;
    return lc $mac;
}

use constant ADDR_TEXT_FILE
    => "/var/named/hosts/ict-mac-ip-address-computer-list-text.txt";

# Accept MAC address in a number of different formats:
sub get_location_of_computer($)
{
    my $naughty = shift;
    $naughty = canonicalise_mac( $naughty );
    my $naughty_info;

    open ADDR, ADDR_TEXT_FILE or die "Cannot open @{[ADDR_TEXT_FILE]}: $!";
    ADDR: while ( <ADDR> )
    {
        my (
            $location,
            $machine_id,
            $mac,
            $type,
            $junk
            ) =  split /\t/;
        $mac = canonicalise_mac( $mac );
        if ( $mac eq $naughty )
        {
            # s/[\r\n]//g;
            $naughty_info = join "\t", (
                                        $location,
                                        $machine_id,
                                        $mac,
                                        $type
                                        );
            last ADDR;
        }
    }
    close ADDR;
    return $naughty_info;
}

sub email_alert_of_attack(\%\%$$$$$)
{
    my ( $ipaddrs, $users, $obj_pres, $time, $hour, $min, $sec ) = @_;
    our $last_called;
    if ( $time - $last_called > $email_frequency )
    {
        $last_called = $time;
        my $body = "Possible attack from these IP addresses:\n";
        
        foreach my $addr ( sort keys %$ipaddrs )
        {
            my $mac = get_mac( $addr );
            $mac = "" unless $mac;
            my $info = get_location_of_computer( $mac ) if $mac;
            $body .= "$addr: number of queries in last 60 seconds: "
                . "$$ipaddrs{$addr}";
            $body .= " MAC=$mac" if $mac;
            $body .= "\nLocation info = $info" if $info;
            $body .= "\n";
        }
        $body .= "base includes these user ids:\n";
        foreach my $user ( sort keys %$users )
        {
            $body .= "$user: number of queries: $$users{$user}\n";
        }
        $body .= "\nPlease identify the source of these requests.\n"
            . "From my investigations so far, it seems to be caused by\n"
            . "the sgi_fam service on Red Hat 7.3 systems.\n"
            . "If you track it to a machine running RH7.3, please\n"
            . "use the ntsysv program to turn off the sgi_fam service,\n"
            . "then do:\n"
            . "/sbin/service xinetd restart\n"
            . "and see if this terminates the problems from this machine.\n"
            . "Please let me know of the result.\n\n"
            . "This email is sent at "
            . scalar localtime( $time ) . "\n\n"
            . "This email was sent by the program $0 written by Nick Urbanik\n"
            . "<nicku\@vtc.edu.hk> that is running on ictlab watching the\n"
            . "directory server log files.\n";
        print $body;
        foreach my $tech ( @mail_recipients )
        {
            my ( $given_name, $cn, undef ) = getLDAP_info( $tech );
            my $address = "\"$cn\" <$tech\@vtc.edu.hk>";
            my $body_with_name = "Dear $given_name,\n" . $body;
            my $msg = MIME::Entity->build(
            Sender              => '"Nick Urbanik" <nicku@vtc.edu.hk>',
            'Return-Path'       => '"Nick Urbanik" <nicku@vtc.edu.hk>',
            From                => '"Nick Urbanik" <nicku@vtc.edu.hk>',
            Subject             => 'POSSIBLE ATTACK ON ICTLAB IN PROGRESS',
            To                  => $address,
            # To                  => 'nicku@vtc.edu.hk',
            Data                => $body_with_name,
            );
            eval {
                $msg->send( 'sendmail' ) or die "Could not send: $!";
            };
            print ERROR_FILE $@ if $@;
            print "Sent email alert to $address\n";
            print ERROR_FILE "Sent email alert to $address\n";
        }
    }
}

format LOGFILE_TOP =
time      time_t total   r  m   g  G  U  u objpr    b   p   s  a  o
-------------------------------------------------------------------
.

format LOGFILE =
@<:@< @>>>>>>>>> @>>>> @>> @> @>> @> @> @> @>>>> @>>> @>> @>> @> @>
{
    $hour, $min, $time, $count, $rootuid, $mailmanuid, $group, $gidnum,
    $uidnum, $uid, $obj_pres, $badgroup, $posixac, $shadac, $auto, $other
}
.
#19:10 1038827400 73166 r=11 m=6 g=27 G=4 U=1 u=14 o=72890 b=198 p=2 s=8 a=3 o=1

# See the Perl Cookbook, page 634, "Making a Daemon Server"
our $pid = fork;
exit if $pid;
die "Couldn't fork: $!" unless defined $pid;

use POSIX;
POSIX::setsid() or die "Cannot start a new session: $!";

our $tail = File::Tail->new(
                            name        => $logfile_towatch,
                            interval    => 1,
                            maxinterval => 5,
                            adjustafter => 20,
                            errmode     => "return"
                           ) or die "Could not open $logfile_towatch: $!";

# open WATCH, "tail -f $logfile_towatch |" or die "cannot run tail: $!";
#while ( <WATCH> )
while ( $_ = $tail->read )
{
    my ( $mon, $mday, $sec, $start_conn,
         $ip, $search_conn, $base, $scope, $filter );
    if (
         m{
              ^([A-Z][a-z][a-z])   # Month
              \s
              ([\s123]\d)          # day of month
              \s
              (\d\d):(\d\d):(\d\d) # hrs:min:sec
              \s
              .*
              \s
              daemon:\sconn=
              (\d+)                # connection number
              \s
              .*
              \s
              connection\sfrom\sIP=
              (\d+\.\d+\.\d+\.\d+) # IP address of client
              :(\d+).*             # client port
              accepted\.
          }x
      )
    {
        ( $mon, $mday, $hour, $min, $sec, $start_conn, $ip )
            = ( $1, $2, $3, $4, $5, $6, $7 );
        $ipaddress{$start_conn} = $ip;
        # print "$ip, $start_conn \n";
        next;
    }
    next unless m{
                     ^([A-Z][a-z][a-z])   # Month
                     \s
                     ([\s123]\d)          # day of month
                     \s
                     (\d\d):(\d\d):(\d\d) # hrs:min:sec
                     \s
                     .*                   # server, process info
                     \s
                     conn=
                     (\d+)                # connection number
                     \s
                     .*                   # op number
                     \s
                     SRCH\sbase=
                     "([^"]*)"            # base
                     \s
                     scope=
                     (\d+)                # scope
                     \sfilter=
                     "([^"]*)"            # filter
                }x;
#   }
    ( $mon, $mday, $hour, $min, $sec, $search_conn,
      $base, $scope, $filter )
        = ( $1, $2, $3, $4, $5, $6, $7, $8, $9 );

    my $month = $months{$mon};
    $time = timelocal( $sec, $min, $hour, $mday, $month, $year );
    
    #print "$filter\n";
    $last_time = $time unless $last_time;
    if ( $time - $last_time >= $period )
    {
#         print "$hour:$min $time $count r=$rootuid m=$mailmanuid g=$group ",
#             "G=$gidnum U=$uidnum u=$uid o=$obj_pres b=$badgroup p=$posixac ",
#                 "s=$shadac a=$auto o=$other\n";
        write LOGFILE;
        if ( $obj_pres > $threshold )
        {
            # Then we are probably being attacked.
            # Find out IP address of computer making these queries,
            # and email the info to the recipients:
            email_alert_of_attack( %ipaddrs, %users, $obj_pres,
                                   $time, $hour, $min, $sec );
            foreach my $addr ( sort keys %ipaddrs )
            {
                print "$addr:\t$ipaddrs{$addr} ";
                my $mac = get_mac( $addr );
                my $info = get_location_of_computer( $mac ) if $mac;
                print $mac if $mac;
                print $info if $info;
                print "\n";
            }
            foreach my $user ( sort keys %users )
            {
                # my ( $gn, $cn, $course ) = getLDAP_info( $user );
                # print "$user:\t$users{$user}\t$course\n";
                print "$user:\t$users{$user}\n";
            }
        }

        $count = 1;
        $rootuid = $mailmanuid = $group = $gidnum = $uidnum
            = $other = $uid = $obj_pres = $badgroup = $posixac
                = $auto = $shadac = 0;
        $last_time = $time;
        %users = ();
        %ipaddrs = ();
    }
    elsif ( $time < $last_time )
    {
        print ERROR_FILE "$time < $last_time: Bad time stamp; time going backwards!\n";
    }
    else
    {
        ++$count;
        for ( $filter )
        {
            if ( $_ eq "(uid=root)" ) { ++$rootuid }
            elsif ( $_ eq "(uid=mailman)" ) { ++$mailmanuid }
            elsif ( /memberUid=/ ) { ++$group }
            elsif ( /gidNumber=/ ) { ++$gidnum }
            elsif ( /uidNumber=/ ) { ++$uidnum }
            elsif ( /^\(uid=/ ) { ++$uid }
            elsif ( $_ eq '(objectClass=*)' )
            {
                #print "$filter\n";
                ++$users{$1} if $base =~ /uid=([^,]+),/;
                ++$obj_pres;
                ++$ipaddrs{$ipaddress{$search_conn}}
                    if exists $ipaddress{$search_conn};
                print "$search_conn IP not found for $uid\n"
                    unless exists $ipaddress{$search_conn};
            }
            elsif ( $_ eq '(&(objectClass=posixGroup))' ) { ++$badgroup }
            elsif ( index( $_, '(&(objectClass=posixAccount)(uid=' ) == 0 )
            {
                ++$posixac;
                # print "$filter\n";
                next;
            }
            elsif ( index( $_, '(&(objectClass=shadowAccount)(uid=' ) == 0 )
            {
                ++$shadac;
            }
            elsif ( /nisObject|nisMap|automount/ ) { ++$auto }
            else
            {
                ++$other;
                print "$filter\n";
            }
        }
    }
}
select $oldhandle;
close LOGFILE;
close ERROR_FILE;