home *** CD-ROM | disk | FTP | other *** search
/ linuxmafia.com 2016 / linuxmafia.com.tar / linuxmafia.com / pub / linux / security / sshd_sentry / sshd_sentry_server < prev    next >
Text File  |  2004-10-28  |  19KB  |  567 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # Copyright 2004 Victor Danilchenko <danilche@cs.umass.edu>
  4. #
  5. # This code may be distributed under the terms of GPL version 2,
  6. # or at your option any subsequent version.
  7.  
  8. use lib "/exp/rcf/common";
  9. use strict;
  10. use Socket;
  11. use Fcntl;
  12. use Fcntl qw(:DEFAULT);
  13. use Getopt::Long;
  14. use IO::Socket::INET;
  15. use POSIX ":errno_h";
  16.  
  17. $SIG{CHLD} = 'IGNORE';
  18.  
  19. my $name = "sshd_sentry_server";
  20. my $pidfile = "/var/run/$name.pid";
  21. my $spooldir = "/var/spool/$name";
  22. my $hosts = {};
  23. my ($help, $restart, $threshold, $duration, $server_port, $interval, $verbose);
  24.  
  25. my $threshold_default = 2;
  26. my $duration_default = "1 day";
  27. my $server_port_default = 6094;
  28. my $interval_default = "1 min";
  29. my $verbose_default = 0;
  30. my $blacklist = {};
  31. my $clients = {};
  32. my $last_distrib = 0;
  33. my $children = {};
  34. my %old_blist = ();
  35.  
  36. my $lhost = (`/bin/hostname`)[0]; chomp $lhost;
  37. my $shost = (split(/\./, $lhost))[0];
  38. my $domain = 'cs.umass.edu';
  39. my $mail_server = "mail.$domain";
  40. my @sysmail = ("sysscript\@$domain"); 
  41.  
  42.  
  43. sub help () {
  44.     my $filr = " " x length($name);
  45.     return << "EOT";
  46. Usage: $name [-h | --help]
  47.        $filr [-r | --restart ]
  48.        $filr [-t | --threshold <threshold number of failures> ]
  49.        $filr [-d | --duration <duration to disable host for> ]
  50.        $filr [-s | --server_port <port> ]
  51.        $filr [-i | --interval <duration between distributions>]
  52.        $filr [-v | --verbose <verbosity level> ]
  53.  
  54. help        Show this message
  55. restart     Focibly restart $name, kill current process if needed
  56. threshold   Number of times a given host is reported, before it\'s
  57.             blacklisted globally
  58.             default: $threshold_default.
  59. duration    Duration of time for which the host which went over the failure
  60.             threshold should be blocked. Must be a number followed by units
  61.             (e.g. '1 hr' or '3 days'). Unqualified number is treated as hours.
  62.         default: $duration_default
  63. server_port Port on which to listen to blacklisting reports
  64.         default: $server_port_default
  65. interval    length of time to wait between distributing blacklist updates
  66.             default: $interval_default
  67. verbose     verbosity level. Can be indicated either numerically, or by
  68.             using multiple '-v' options.
  69.         default: $verbose_default
  70. EOT
  71. }
  72.  
  73. sub log_prefix() {
  74.     return  localtime()." $name\[$$\]: ";
  75. }
  76.  
  77. sub log_out {
  78.     my $prefix = log_prefix();
  79.     my @out = @_;
  80.     s/^/$prefix/gsm for @out;
  81.     return @out;
  82. }
  83.  
  84. sub log_strings {
  85.     my @out = log_out (@_);
  86.     print STDERR (join("\n", @out), "\n");
  87. }
  88.  
  89. sub mail_to_users {
  90.     my $text = shift;
  91.     my $subject = shift;
  92.     my @users = @_; @users = @sysmail unless @users;
  93.  
  94.     my $socket=IO::Socket::INET->new("$mail_server:25");
  95.     #my $socket = \*STDOUT;
  96.     print $socket ("HELO $shost.$domain\n");
  97.     print $socket ("MAIL FROM: root\@$shost.$domain\n");
  98.     print $socket ("RCPT TO: ", join ("\nRCPT TO: ", @users), "\n");
  99.     print $socket ("DATA\n");
  100.     print $socket ("To: ", join (",", @users), "\n");
  101.     print $socket ("Subject: $subject\n\n");
  102.     print $socket($text);
  103.     print $socket ("\n.\nQUIT\n");
  104.     close $socket;
  105. }
  106.  
  107. sub die_with_mail($;@) {
  108.     my $text = shift;
  109.     my @users = @_; @users = @sysmail unless @users;
  110.     my $subject = "$name died on $shost";
  111.     mail_to_users ($text, $subject, @users);
  112.     if (-t STDIN) { die $text;}
  113.     else          { exit 1;   }
  114. }
  115.  
  116. sub max ($;@) { my $max = shift; for my $i (@_) { $max = $i if $max < $i; } return $max;}
  117. sub min ($;@) { my $min = shift; for my $i (@_) { $min = $i if $min > $i; } return $min;}
  118.  
  119. sub ObjectContents ($;$$$);
  120.  
  121. sub ObjectContents ($;$$$) {
  122.     # Print the content of the hash reference. Recurse on any members
  123.     # which are also hash references, until the specified $depth is
  124.     # reached. Useful for examining object content.
  125.     #
  126.     # $offset is used internally to offset children from a parent for
  127.     # easier visual processing by humans
  128.  
  129.     my $object = shift;
  130.     my $depth  = shift; if (!defined $depth)  { $depth  = 1   ;}
  131.     my $offset = shift; if (!defined $offset) { $offset = "  ";}
  132.     my $force_long_array_output = shift || 0;
  133.     my $output = "";
  134.  
  135.     if ($depth > 0) {
  136.         if ("$object" =~ /HASH/) {
  137.             my $maxlen = 0;
  138.             foreach my $i (sort keys %$object) { $maxlen = max ($maxlen, length ($i));}
  139.             foreach my $i (sort keys %$object) {
  140.                 my $head = sprintf ("%s%-${maxlen}s =",$offset, $i) ;
  141.                 $output .= "$head> ";
  142.                 if (defined $object->{$i}) {
  143.                     my $string = $object->{$i};
  144.                     if (ref ($string) =~ /array/i) {
  145.                         $string = "$string   (".scalar @$string." members)";
  146.                     } elsif (ref ($string) =~ /hash|::/i) {
  147.                         $string = "$string   (".scalar keys (%$string)." members)";
  148.                     }
  149.                     my $pad = " " x length ($head); 
  150.                     $string =~ s/\n/\n$pad\> /gm;
  151.                     $output .= "$string\n";
  152.                     $output .= ObjectContents ($object->{$i}, $depth - 1, $offset."   ", $force_long_array_output)
  153.                         if ref $object->{$i};
  154. #                   if ($depth > 1) { $output .= "\n";}
  155.                 } else { $output .= "undefined\n";}
  156.             }
  157.         } elsif ("$object" =~ /ARRAY/) {
  158.             my $isref = 0;
  159.             for (my $index = 0; $index < scalar @$object; ++$index) {
  160.                 my $head = sprintf ("%s%-4s =", $offset, "[".$index."]");
  161.                 $output .= "$head> ";
  162.                 if (defined $object->[$index]) {
  163.                     my $string = $object->[$index];
  164.                     if (ref ($string) =~ /array/i) {
  165.                         $string = "$string   (".scalar @$string." members)";
  166.                     } elsif (ref ($string) =~ /hash|::/i) {
  167.                         $string = "$string   (".scalar keys (%$string)." members)";
  168.                     }
  169.                     my $pad = " " x length ($head); $string =~ s/\n$//m;
  170.                     $string =~ s/\n/\n$pad\> /gm;
  171.                     $output .= "$string\n";
  172.                     $output .= ObjectContents ($object->[$index], $depth - 1, $offset."   ", $force_long_array_output
  173. )
  174.                         if ref $object->[$index];
  175. #                   if ($depth > 1) { $output .= "\n";}             
  176.                 } else  { $output .= "undefined\n";}
  177.             }
  178.         } elsif ("$object" =~ /SCALAR/) {
  179.         my $string = $$object;
  180.         $string =~ s/\n\s*$//gsm;
  181.         my $pad = ($string =~ /\n/m) ? "> " : "";
  182.         $string =~ s/\n/\n$offset$pad/g;
  183.         $output .= sprintf ("%s%s%-12s\n",$offset, $pad, $string) ;
  184.         } else {
  185.             $output .= sprintf ("%s+%-12s\n",$offset, $object) ;
  186.         }
  187.     }
  188.     return $output;
  189. }
  190.  
  191. sub negotiate_pid ($) {
  192.     my $restart = shift;
  193.     # Negotiate over possible prior instances
  194.     if (-s $pidfile) {
  195.     # PID file exists and is not empty
  196.     open (PID, $pidfile) or die "Cannot read PID file $pidfile\n";
  197.     chomp (my $pid = <PID>);
  198.     close PID;
  199.     die "Corrupt PID file! (read '$pid' from it)\n" unless $pid =~ /^\d+$/;
  200.     if (kill (0, $pid)) {
  201.         # The process is alive
  202.         if ($restart) {
  203.         # We are gonna kill the current process
  204.         kill (9, $pid);
  205.         sleep 1;
  206.         if (kill (0, $pid)) { die "Cannot kill predecessor, PID $pid\n";}
  207.         else                { unlink $pidfile; }
  208.         } else {
  209.         # There's another instance already running, leave it alone.
  210.         exit 1;
  211.         }
  212.     } else {
  213.         # PID file exists but the process is dead, proceed
  214.         unlink $pidfile;
  215.     }
  216.     } elsif (-e $pidfile) {
  217.     # PID file exists but it empty, ignore it.
  218.     unlink $pidfile;
  219.     }
  220.  
  221.     if (-e $pidfile) { die "PID file $pidfile unepectedly exists!\n"; }
  222.     elsif (open (PID, "> $pidfile")) {
  223.     print PID "$$\n";
  224.     close PID;
  225.     } else { die "Couldn't write my PID ($$) to $pidfile\n"; }
  226.  
  227. }
  228.  
  229. sub normalize_duration ($) {
  230.     my $duration = shift()."h";
  231.     $duration =~ s/\s//g;
  232.     my ($num, $unit) = (lc($duration) =~ /^(\d+)(\w)/);
  233.     return undef unless ($num && $unit);
  234.     my $multiplier = 0;
  235.     if    ($unit eq "s") { $multiplier = 1;}
  236.     elsif ($unit eq "m") { $multiplier = 60;}
  237.     elsif ($unit eq "h") { $multiplier = 60*60;}
  238.     elsif ($unit eq "d") { $multiplier = 60*60*24;}
  239.     elsif ($unit eq "w") { $multiplier = 60*60*24*7;}
  240.     elsif ($unit eq "m") { $multiplier = 60*60*24*30;}
  241.     elsif ($unit eq "y") { $multiplier = 60*60*24*365;}
  242.     else                 { return undef;}
  243.     return $num * $multiplier; 
  244. }
  245.  
  246. sub read_blacklist () {
  247.     open (LIST, "/etc/$name-blacklist") or return {};
  248.     my $blacklist = {};
  249.     while (my $line = <LIST>) {
  250.     chomp $line;
  251.     $line =~ s/\#.*//;
  252.     my ($host, $client, $time) = split (/\s+/, $line);
  253.     next unless ($host && $client && $time && ($time =~ /^\d+$/));
  254.     if ($time > time()) {
  255.         $blacklist->{$host} ||= {};
  256.         $blacklist->{$host}->{$client} = $time;
  257.     }
  258.     }
  259.     close LIST;
  260.     return $blacklist;
  261. }
  262.  
  263. sub write_blacklist ($) {
  264.     my $blacklist = shift;
  265.     open (LIST, "> /etc/$name-blacklist") or return undef;
  266.     for my $host (sort keys %$blacklist) {
  267.     for my $client (sort keys %{$blacklist->{$host}}) {
  268.         printf LIST ("%-15s %-15s %s   # %s\n",
  269.              $host, $client, $blacklist->{$host}->{$client},
  270.              scalar(localtime($blacklist->{$host}->{$client})));
  271.     }
  272.     }
  273.     close LIST;
  274.     return $blacklist;
  275. }
  276.  
  277. sub read_clientlist () {
  278.     open (LIST, "/etc/$name-clientlist") or return {};
  279.     my $list = {};
  280.     while (my $line = <LIST>) {
  281.     chomp $line;
  282.     $line =~ s/\#.*//;
  283.     my ($client, $port) = split (/[\s:]+/, $line);
  284.     next unless ($client && $port && ($port =~ /^\d+$/));
  285.     $list->{$client} = $port;
  286.     }
  287.     close LIST;
  288.     return $list;
  289. }
  290.  
  291. sub write_clientlist ($) {
  292.     my $clients = shift;
  293.     open (LIST, "> /etc/$name-clientlist") or return undef;
  294.     for my $client (sort keys %$clients) {
  295.     my $ip = inet_aton($client);
  296.     my $name = gethostbyaddr ($ip, AF_INET);
  297.     printf LIST ("%-30s # %s\n", "$client:$clients->{$client}", $name);
  298.     }
  299.     close LIST;
  300.     return $blacklist;
  301. }
  302.  
  303. sub read_line_nonblock ($;$) {
  304.     my $handle = shift;
  305.     my $delay = shift || 1;
  306.     # First, make the socket non-blocking.
  307.     my $flags = 0; 
  308.     unless (fcntl ($handle, F_GETFL, $flags)) {close $handle; warn "Couldn't get flags\n"; return undef;}
  309.     my $newflags = $flags | O_NONBLOCK;
  310.     unless (fcntl ($handle, F_SETFL, $newflags)) {close $handle; warn "Couldn't set flags\n"; return undef;}
  311.  
  312.     my $start = time();
  313.     my $buffer;
  314.     for (;;) {
  315.     # Spin, trying to read the socket. If we spin for longer
  316.     # than two seconds, close the connection.
  317.     my $rv = sysread ($handle, $buffer, 128);
  318.     if (!defined($rv) && $! == EAGAIN) {
  319.         if (($start + $delay) < time()) { $buffer = ""; last; }
  320.     } else {
  321.         last;
  322.     }
  323.     }
  324.     unless (fcntl ($handle, F_SETFL, $flags)) { warn "Couldn't reset flags\n";}
  325.     return $buffer;
  326. }
  327.  
  328. sub cleanup_children ($) {
  329.     my $children = shift;
  330.     for my $child (keys %$children) {
  331.     if (kill (0, $child) && open (CHILD, "/proc/$child/stat")) {
  332.         # the process is alive, see if it's ours
  333.         my $CPPID = (split (/\s+/, <CHILD>))[3];
  334.         if ($CPPID = $$) {
  335.         # this child's PPID is me!
  336.         warn "Killing recalcitrant $child...\n";
  337.         kill (9, $child);
  338.         }
  339.     }
  340.     delete $children->{$child};
  341.     }
  342.     return $children;
  343. }
  344.  
  345. sub cleanup_clients ($) {
  346.     # Clean up clients which have not been contactable for three tries
  347.     my $clients = shift;
  348.     for my $client (%$clients) {
  349.     my @bans = glob ("$spooldir/$client*");
  350.     if (@bans > 2) {
  351.         unlink $_ for @bans;
  352.         delete $clients->{$client};
  353.     }
  354.     }
  355.     write_clientlist ($clients);
  356. }
  357.  
  358. sub push_list_to_clients ($$) {
  359.     # This function is ran by each forked child
  360.     my $list = shift;
  361.     my $queue = shift;
  362.     my @strs = split (/\n/, sprintf ("------------ Child $$ reporting:\n%s", ObjectContents ({blacklist => $list, queue => $queue}, 3)));
  363.  
  364.     for my $client (keys %$queue) {
  365.     next unless my $port = $queue->{$client};
  366.     push (@strs,  "Contacting $client:$port...");
  367.     if (my $socket = IO::Socket::INET->new(PeerAddr => $client,
  368.                            PeerPort => $queue->{$client},
  369.                            Proto => 'tcp',
  370.                            Type => SOCK_STREAM,
  371.                            Timeout => 1)) {
  372.         $strs[-1] .= " Success!";
  373.         for my $host (keys %$list) {
  374.         print $socket "$host $list->{$host}\n";
  375.         }
  376.         close $socket;
  377.     } else {
  378.         $strs[-1] .= " Failure!";
  379.         open (TMP, "> $spooldir/$client-$$-".time()) and close TMP;
  380.     }
  381.     }
  382.  
  383.     log_strings(@strs);
  384. }
  385.  
  386. sub distribute_blacklist ($$;$) {
  387.     my $list = shift;
  388.     my $clients = shift;
  389.     my $force = shift;
  390.     my $sizebase = 10;
  391.     my $blist = {};
  392.  
  393.     my $report = "Blacklist distribution in progress.\n\n";
  394.  
  395.     # extract actual blacklist from the list of reports
  396.     for my $host (keys %$list) {
  397.     if (keys (%{$list->{$host}}) > 1) {
  398.         my $maxtime = 0;
  399.         for my $key (keys %{$list->{$host}}) {
  400.         # Find the highest time reported by any client blacklisting this host
  401.         $maxtime = $list->{$host}->{$key} if ($list->{$host}->{$key} > $maxtime);
  402.         }
  403.         if ($maxtime > time()) { $blist->{$host} = $maxtime; } 
  404.         else                   { delete $list->{$host}; }
  405.     }
  406.     }
  407.  
  408.     my @new_hosts = ();
  409.     for my $key (keys %$blist) { push (@new_hosts, $key) unless $old_blist{$key}; }
  410.  
  411.     $report .= sprintf ("The following host has just been added to the blacklist:\n%s\n",
  412.             join ("\n", @new_hosts)."\n\nThe entire blacklist is:")
  413.     if  @new_hosts;
  414.  
  415.     for my $host (keys %$blist) {
  416.     $report .= sprintf ("    %-20s -- expires %s\n", $host, scalar (localtime($blist->{$host})));
  417.     }
  418.  
  419.     $report .= "\n";
  420.  
  421.     # FIXME
  422.     $report .= "the old list was:\n" if %old_blist;
  423.     for my $host (keys %old_blist) {
  424.     $report .= sprintf ("    %-20s -- expires %s\n", $host, scalar (localtime($old_blist{$host})));
  425.     }
  426.  
  427.     if ((time() - $last_distrib > $interval) && %$clients) {
  428.     # $interval seconds has passed since the last distribution, proceed
  429.     $last_distrib = time();
  430.     cleanup_children ($children);
  431.     cleanup_clients ($clients);
  432.     log_strings ("--- Distribute the data:", ObjectContents ({clients => $clients, blacklist => $blist}, 5));
  433.  
  434.     my @clients = sort keys %$clients;
  435.     my @cbk = @clients;
  436.     my @clists = ();
  437.     my $numqueues = int(sqrt (@clients)); #int(log(scalar @clients)/log($sizebase) + 1);
  438.     my $queuesize = int ((@clients - 1) / $numqueues + 1);
  439.     log_strings ("$numqueues queues of up to $queuesize clients each");
  440.     $report .= "$numqueues queues of up to $queuesize clients each\n";
  441.     for (my $queue = 0; @clients; ++$queue) {
  442.         # Split the list of clients into separate queues, each to be handled by a forked child
  443.         for (my $i = $queuesize; $i && @clients; --$i) {
  444.         my $client =  pop(@clients);
  445.         $clists[$queue]->{$client} = $clients->{$client};
  446.         }
  447.     }
  448.  
  449.     $report .= "See /var/log/sshd_sentry_server.log for detailed info\n\n".
  450.         ObjectContents ({raw_blacklist => $list}, 5);
  451.  
  452.     if ( @new_hosts) {
  453.         mail_to_users ($report, "Blacklisting report", @sysmail);
  454.         %old_blist = %$blist;
  455.     }
  456.  
  457.     # die ObjectContents ({num => $numqueues, clients => \@cbk, lists => \@clists}, 4);
  458.     for my $queue (@clists) {
  459.         if (my $child = fork()) {
  460.         # we are the parent
  461.         $children->{$child} = 1;
  462.         } else {
  463.         # we are the child
  464.         push_list_to_clients ($blist, $queue);
  465.         exit 0;
  466.         }
  467.     }
  468.     } else {
  469.     # The update came too soon, we are not ready to distribute
  470.     log_strings ("--- Skipping distribution at this time...");
  471.     return 0;
  472.     }
  473. }
  474.  
  475. #############################
  476. #                           #
  477. #   Execution begins here   #
  478. #                           #
  479. #############################
  480. GetOptions ("help"            => \$help,
  481.         "restart"         => \$restart,
  482.         "threshold=i"     => \$threshold,
  483.         "duration=s"      => \$duration,
  484.         "server_port=i"   => \$server_port,
  485.         "interval=s"      => \$interval,
  486.         "verbose"         => \$verbose
  487. );
  488.  
  489. mkdir $spooldir unless -d $spooldir;
  490.  
  491. die "The server can currently only run on Linux.\n" unless grep (/linux/i, `/bin/uname`);
  492.  
  493. if ($help) { print help(); exit 0;}
  494.  
  495. negotiate_pid($restart);
  496.  
  497. # Activate $<option>_default values
  498. eval "no strict 'vars'; \$$_ ||= \$${_}_default"
  499.     for qw(file interval threshold duration penalty server_port interval);
  500. $interval = normalize_duration ($interval);
  501. $duration = normalize_duration ($duration);
  502.  
  503. die "Bad duration spec ($duration)\n" unless $duration;
  504. die "Bad interval spec ($interval)\n" unless $interval;
  505.  
  506. $blacklist = read_blacklist();
  507. $clients = read_clientlist();
  508.  
  509. log_strings ("Listening on port $server_port");
  510. my $server = IO::Socket::INET->new (LocalPort => $server_port,
  511.                     Type => SOCK_STREAM,
  512.                     Reuse => 1,
  513.                     Listen => 10)
  514.                     #Blocking => 0)
  515.     or die "Cannot bind $name to port $server_port: $@\n";
  516. while (my $client = $server->accept()) {
  517.     my $got_update = 0;
  518.     my $peer = inet_ntoa($client->peeraddr());
  519.     log_strings ("Accepted from $peer");
  520.  
  521.     if ($peer =~ /^(128.119.24[01234567])|(128.119.4[12])/) {
  522.     # one of ours, talk to them
  523.  
  524.     # Each line consists of a port to upload blacklists on, followed by a new
  525.     # blacklist entry. Note that it's safe to supply just a port number -- this
  526.     # will effectively register the connecting host as a client for future
  527.     # blacklist distributions.
  528.     #    i.e.
  529.     # <callback port>:<blacklisted host>
  530.     my $line = read_line_nonblock ($client);
  531.     chomp $line;
  532.     my ($port, $host) = split (/[:\n\r]+/sm, $line);
  533.     unless ($clients->{$peer}) {
  534.         # This client just registered, distribute the blacklist to them right away
  535.         log_strings ("Distributing NOW...");
  536.         distribute_blacklist ($blacklist, {$peer => $port}, 1);
  537.     }
  538.  
  539.     $clients->{$peer} = $port;
  540.     write_clientlist ($clients);  $clients = read_clientlist();
  541.     if ($host && $port =~ /^\d+$/ &&
  542.         $host !~ /(^(128.119.24[01234567])|(128.119.4[12]))|(\.cs\.umass\.edu)/) {
  543.         $blacklist->{$host} ||= {};
  544.  
  545.         # Don't automatically distribute updates if we only got a repeat blacklist
  546.         # entry from a host which had already reported it
  547.         $got_update = 1; # unless $blacklist->{$host}->{$peer}; # FIXME
  548.  
  549.         $blacklist->{$host}->{$peer} = time() + $duration;
  550.         print $client "Gotcha.\n";
  551.     } else {
  552.         # Line is not valid, likely due to a timeout issue.
  553.         print $client "Bad line (idle timeout?)\n";
  554.     }
  555.     } else {
  556.     # the client is from outside our domain
  557.     print $client "You are not authorized, go away\n";
  558.     }
  559.     close $client;
  560.  
  561.     if ($got_update) {
  562.     $got_update = 0;
  563.     write_blacklist ($blacklist); $blacklist = read_blacklist();
  564.     distribute_blacklist ($blacklist, $clients);
  565.     }
  566. }
  567.