View file File name : rbld Content :#!/usr/bin/perl ########################################################################## # rbld - Daemon that reads and serves IP based blacklists and whitelists # Copyright 2006, Bluehost, Inc. # # Authors and Contributers: # # Spencer Candland <spencer@bluehost.com> # Ryan Chaudhry <rchaudhry@bluehost.com> # Erick Cantwell <erick@bluehost.com> # # http://www.bluehost.com # https://github.com/bluehost/rbld # ########################################################################## # # This file is part of rbld # # Rbld free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA02111-1307, USA. # ########################################################################## use strict; use warnings; use IO::File; use IO::Socket; use Fcntl qw(F_SETFD); use Proc::Daemon; use Proc::PID::File; use Data::Dumper; use Getopt::Long; use YAML::Syck qw(LoadFile); use Time::HiRes qw(gettimeofday tv_interval); use POSIX; my $config = {}; my $settings = {}; my $defaults = { rbld_conf => '/etc/rbld.conf', log => '/var/log/rbld.log', infile => '/etc/inrbld', listconf => '/etc/rbld.d/rbldlists.conf', run_path => '/usr/sbin/rbld', sock_path => '/var/tmp/rbld.sock', sock_owner => 'mailnull', sock_group => 'nobody', debug => 0, }; # Get cli options GetOptions ( 'c|config=s' => \$config->{rbld_conf}, 'o|log=s' => \$config->{log}, 'i|infile=s' => \$config->{infile}, 'l|listconf=s' => \$config->{listconf}, 'r|runpath=s' => \$config->{run_path}, 's|socketpath=s' => \$config->{sock_path}, 'u|socketowner=s' => \$config->{sock_owner}, 'g|socketgroup=s' => \$config->{sock_group}, 'd|debug' => \$config->{debug}, 'h|help' => \&help, ) || &help; # Start my @start = gettimeofday(); my $DEBUG = 0; my ($dfh, $in_pid); my %lists; my %all; my %info = ( blacklist => {}, infile => {}, metastats => {}, starttime => time(), stats => {}, whitelist => {}, ); my %run = ( DEBUG => sub { $DEBUG = shift; return; }, DUMP => sub { return Dumper (%info, %lists); }, LOAD_CONF => \&load_conf, LOAD_LIST => \&load_list, CIDR => \&check_cidr, IP => \&check_ip, TRIE => \&check_trie, META => \&check_meta, ALL => \&check_all, WHITELIST => \&check_whitelist, STAT => \&give_stats, STATS => \&give_stats, ); my %load = ( CIDR => \&load_cidr, IP => \&load_ip, TRIE => \&load_trie, META => \&load_meta, ); sub debug { return unless $DEBUG; warn scalar(localtime).": [$$] @_"; } sub main { # Load default or cli specified configuration file if ($config->{rbld_conf}) { $settings = LoadFile($config->{rbld_conf}); } else { $settings = LoadFile($defaults->{rbld_conf}); } # Merge to config hash # These/this should be moved to a subroutine my @vals = ('log', 'infile', 'listconf', 'run_path', 'sock_path', 'sock_owner', 'sock_group', 'debug'); # First, merge conf file to cli foreach (@vals) { my $val = $_; unless ($config->{$val}) { if ($settings->{$val}) { $config->{$val} = $settings->{$val}; } } } # Next merge defaults into the config foreach (@vals) { my $val = $_; unless ($config->{$val}) { if ($defaults->{$val}) { $config->{$val} = $defaults->{$val}; } } } $DEBUG = 1 if $config->{debug}; $0 = "rbld"; Proc::Daemon::Init() unless $ENV{BIND_FD}; umask 0117; exit 1 if Proc::PID::File->running(); open_log(); $SIG{TERM} = $SIG{INT} = sub { exit 0 }; $SIG{PIPE} = sub { die "PIPE" }; my $sigset = POSIX::SigSet->new(); POSIX::sigaction(&POSIX::SIGUSR2, POSIX::SigAction->new('open_log', $sigset, &POSIX::SA_NODEFER)); POSIX::sigaction(&POSIX::SIGHUP, POSIX::SigAction->new('reload', $sigset, &POSIX::SA_NODEFER)); reset_infile(); my @rblstart = gettimeofday(); warn scalar(localtime).": [$$] Loading Conf and Lists...\n"; load_conf($config->{listconf}); &link_meta; warn scalar(localtime).": [$$] load completed in (".tv_interval (\@rblstart).").\n"; my $listen; if (exists $ENV{BIND_FD} and $ENV{BIND_FD} =~ /^(\d+)$/) { my $bind_fd = $1; debug "Reusing fd($bind_fd)\n"; $listen = IO::Socket::UNIX->new(); $listen->fdopen($bind_fd, "r") or die "Socket: $!"; } else { unlink $config->{sock_path}; $listen = IO::Socket::UNIX->new( Local => $config->{sock_path}, Listen => SOMAXCONN, ) or die "Socket: $!"; chown ( ((getpwnam("$config->{sock_owner}"))[2]), ((getgrnam("$config->{sock_group}"))[2]), $config->{sock_path}) || warn "Could not chown socket: $!"; } warn scalar(localtime).": [$$] $0 startup completed in (".tv_interval (\@start)."). Now Listening.\n"; my ($conn, $req, $bvec, $rw, $timeleft, $nfound, $buffer, $data, $msg); while (1) { eval { $conn = $listen->accept() or die "Accept error: $!\n"; $req = $bvec = ''; vec($bvec, $conn->fileno, 1) = 1; $timeleft = 0.2; while ($timeleft > 0) { ($nfound, $timeleft) = select($rw=$bvec, undef, undef, $timeleft); $buffer = ''; if ($nfound != 0) { sysread($conn, $buffer, 8192) or die "EOF on connection\n"; } $req .= $buffer; last if index($buffer, "\n") > 0; } die "Timed out on request\n" if $timeleft == 0; $req =~ s/\n.*//; }; if ($@) { debug $@; $conn->shutdown(2) if $conn; next; } $info{requests}++; my ($cmd, $args) = split (/\s+/, $req, 2); $msg = ''; if ($run{$cmd}) { debug "Running command [$req]\n"; $msg = &{$run{$cmd}}($args); } else { debug "Unknown command [$req]\n"; } eval { $timeleft = 0.5; $buffer = 0; if ($msg) { do { ($nfound, $timeleft) = select(undef, $rw=$bvec, undef, $timeleft); if ($nfound != 0) { $buffer += syswrite($conn, $msg, length($msg)); } } until ($timeleft == 0 or $buffer == length($msg)); } $conn->shutdown(2); }; } } # NAME TYPE [whitelist|blacklist] FILE FILE_FORMAT[IP|CIDR|TRIE|META]:[EXPIRE|TRIE_SPLIT|LIST] [STAT_ONLY] sub load_conf { my $cfile = shift; debug "Loading config file $cfile\n"; my %nlists; if (-e $cfile) { # read the config open (CF, "<$cfile"); flock (CF, 2); while (<CF>) { chomp($_); next unless ($_); next if (substr($_, 0, 1) eq "#"); my @tmp = split (/\s+/, $_); my $file = $tmp[2]; # Make sure we have a valid type my $type = $tmp[1]; next unless (($type eq "whitelist") or ($type eq "blacklist")); # Make sure we have a valid format my @split = split (/:/, $tmp[3]); my $format = $split[0]; next unless (exists ($load{$format})); $nlists{$file}{"file"} = $file; $nlists{$file}{"name"} = $tmp[0]; $nlists{$file}{"type"} = $type; $nlists{$file}{"format"} = $format; $nlists{$file}{"split"} = $split[1] || 0; $nlists{$file}{"stat_only"} = $tmp[4] || 0; $nlists{$file}{"cfile"} = $cfile; # So we can get at data through name as well, which # is how queries to the list actually come through $nlists{$tmp[0]} = \%{$nlists{$file}}; } flock (CF, 8); close (CF); foreach my $file (keys %nlists) { # See if conf changed if (exists $lists{$file}) { my $diff = 0; foreach (keys %{$nlists{$file}}) { $diff = 1 if ($nlists{$file}{$_} ne $lists{$file}{$_}); } next unless ($diff == 1); } my $name = $nlists{$file}{"name"}; $lists{$file} = $nlists{$file}; load_list ($file); # Create our inwatch watches my $realfile = $lists{$file}{"file"}; add_to_infile ($realfile, "LOAD_LIST") unless (exists $nlists{$name}{"meta"}); # Create a run command for the list $run{$name} = sub { return check_list($name, shift); }, } # Find and delete options that were removed foreach my $file (keys %lists) { next unless ($lists{$file}{"cfile"} eq $cfile); unless (exists $nlists{$file}) { debug "$file was removed from conf $cfile, removing\n"; my $type = $lists{$file}{"type"}; my $name = $lists{$file}{"name"}; delete ($info{$type}{$name}); delete ($info{"stats"}{$name}); delete ($lists{$file}); delete ($run{$name}); } } } # Even if it doesn't exist we want to add it, that way # we can create it and then watch it. Mainly useful # for things like our local whitelists, which may not # exist yet on new servers add_to_infile ($cfile, "LOAD_CONF"); } # Take any list, and call correct routine based on format sub load_list { my $file = shift; debug "Caught load_list on $file\n"; my $format = $lists{$file}{"format"}; if ($load{$format}) { my $name = $lists{$file}{"name"}; warn scalar(localtime).": [$$] Loading $name $file (".$lists{$file}{"type"}." $format)\n"; return &{$load{$format}}($file); } } sub load_cidr { my $file = shift; if (-e $file) { open (LST, "<$file"); flock (LST, 2); my $type = $lists{$file}{"type"}; my $name = $lists{$file}{"name"}; my $split = $lists{$file}{"split"}; my $expire = 0; delete ($info{$type}{$name}); while (<LST>) { chomp($_); next unless ($_); next if (substr($_, 0, 1) eq "#"); my $line = $_; if ($split) { my @tmp = split (/\s+/, $_); if (time >= $tmp[0]) { $expire = 1; next; } $line = $tmp[1]; } my ($ip, $mask) = split (/\//, $line); if ($mask < 8) { warn scalar(localtime).": [$$] CIDR range is too large ($ip/$mask), skipping.\n"; next; } # Handle ranges bigger then 16 my $range = 0; if ($mask < 16) { $range = ((2 ** (16 - $mask)) - 1); } foreach (0 .. $range) { my $adjm = (32 - $mask); my @oct = split (/\./, $ip); $oct[1] += $_; # Make sure we have some minimum and maximum values $info{$type}{$name}{$oct[0]}{$oct[1]}{min} = $adjm unless (exists $info{$type}{$name}{$oct[0]}{$oct[1]}{min}); $info{$type}{$name}{$oct[0]}{$oct[1]}{max} = $adjm unless (exists $info{$type}{$name}{$oct[0]}{$oct[1]}{max}); $info{$type}{$name}{$oct[0]}{$oct[1]}{min} = $adjm if ($adjm < $info{$type}{$name}{$oct[0]}{$oct[1]}{min}); $info{$type}{$name}{$oct[0]}{$oct[1]}{max} = $adjm if ($adjm > $info{$type}{$name}{$oct[0]}{$oct[1]}{max}); my $pack = unpack("N", pack("C4", @oct)) >> $adjm; $info{$type}{$name}{$oct[0]}{$oct[1]}{$adjm}{$pack} = 1; } } if ($expire == 1) { seek (LST, 0, 0); foreach (keys %{$info{$type}{$name}}) { print LST "$info{$type}{$name}{$_} $_\n"; } truncate LBT, tell(LBT); } flock (LST, 8); close (LST); $all{$name} = 1; } } sub load_ip { my $file = shift; if (-e $file) { open (LST, "+<$file"); flock (LST, 2); my $type = $lists{$file}{"type"}; my $name = $lists{$file}{"name"}; my $split = $lists{$file}{"split"}; my $expire = 0; delete ($info{$type}{$name}); while (<LST>) { chomp($_); next unless ($_); next if (substr($_, 0, 1) eq "#"); if ($split) { my @tmp = split (/\s+/, $_); if (time >= $tmp[0]) { $expire = 1; next; } $info{$type}{$name}{$tmp[1]} = $tmp[0]; } else { $info{$type}{$name}{$_} = 1; } } if ($expire == 1) { seek (LST, 0, 0); foreach (keys %{$info{$type}{$name}}) { print LST "$info{$type}{$name}{$_} $_\n"; } truncate LBT, tell(LBT); } flock (LST, 8); close (LST); $all{$name} = 1; } } sub load_meta { my $file = shift; @{$lists{$file}{"meta"}} = split (/,/, $lists{$file}{"split"}); } sub load_trie { my $file = shift; if (-e $file) { open (LST, "<$file"); flock (LST, 2); my $type = $lists{$file}{"type"}; my $name = $lists{$file}{"name"}; delete ($info{$type}{$name}); while (<LST>) { chomp($_); next unless ($_); next if (substr($_, 0, 1) eq "#"); my ($key, $value) = split (/\s+/); $info{$type}{$name}{$key} = $value; } flock (LST, 8); close (LST); $all{$name} = 1; } } # Make fake meta_list masquarade as a real list, primarily for stats sub link_meta { foreach (keys %lists) { if ($lists{$_}{"format"} eq "META") { my $meta_name = $lists{$_}{"name"}; foreach my $list_name (@{$lists{$meta_name}{"meta"}}) { $lists{$meta_name."_".$list_name} = \%{$lists{$list_name}}; } } } } # Whitelists are global, so checks all whitelists. sub check_whitelist { my $ip = shift; foreach my $name (keys %{$info{whitelist}}) { $info{"stats"}{$name}{"requests"}++; my $format = $lists{$name}{"format"}; if (&{$run{$format}}($name, $ip)) { $info{"stats"}{$name}{"rejections"}++; return 1; } } return 0; } # Check any list, will call correct routine based on format sub check_list { my $name = shift; my $ip = shift; my $format = $lists{$name}{"format"}; # Increment requests $info{"stats"}{$name}{"requests"}++; my $ret = &{$run{$format}}($name, $ip); if ($ret) { my $type = $lists{$name}{"type"}; # If type is not a blacklist we don't need to check whitelist if ($type ne "blacklist") { $info{"stats"}{$name}{"rejections"}++; # Don't block if we are setup as stats only return 0 if ($lists{$name}{"stat_only"}); return 1; } # If we were on a blacklist, check the whitelist. # We do it in this order to get good whitelist stats. return 0 if (check_whitelist($ip)); $info{"stats"}{$name}{"rejections"}++; if ($ret ne 1) { $info{"stats"}{$ret}{"rejections"}++ if ($ret ne 1); return 0 if ($lists{$ret}{"stat_only"}); } # Don't block if we are setup as stats only return 0 if ($lists{$name}{"stat_only"}); return 1; } return 0 } sub check_all { # TODO, gather stats, requests and rejections, on # the exact lists inside the "all" list. # TODO, make it so you can specify a "all" list # in the conf my $ip = shift; my $hits = ""; foreach my $list_name (keys %all) { my $format = $lists{$list_name}{"format"}; $hits .= "$list_name " if (&{$run{$format}}($list_name, $ip)); } return 0 if (check_whitelist($ip)); return $hits; } sub check_cidr { my $name = shift; my $ip = shift; my $type = $lists{$name}{"type"}; my @oct = split (/\./, $ip); return 0 unless (exists $info{$type}{$name}{$oct[0]}); return 0 unless (exists $info{$type}{$name}{$oct[0]}{$oct[1]}); # bitshift from my min mask to max to do the check foreach ($info{$type}{$name}{$oct[0]}{$oct[1]}{min} .. $info{$type}{$name}{$oct[0]}{$oct[1]}{max}) { my $pack = unpack("N", pack("C4", @oct)) >> $_; return 1 if ($info{$type}{$name}{$oct[0]}{$oct[1]}{$_}{$pack}); } return 0; } sub check_ip { my $name = shift; my $ip = shift; my $type = $lists{$name}{"type"}; return 1 if ($info{$type}{$name}{$ip}); return 0; } sub check_meta { my $name = shift; my $ip = shift; foreach my $list_name (@{$lists{$name}{"meta"}}) { # Make sure list actually exists next unless (exists $lists{$list_name}); my $format = $lists{$list_name}{"format"}; $info{"stats"}{$name."_".$list_name}{"requests"}++; return $name."_".$list_name if (&{$run{$format}}($list_name, $ip)); } return 0; } sub check_trie { my $name = shift; my $ip = shift; my $type = $lists{$name}{"type"}; my $split = $lists{$name}{"split"}; my @oct = split (/\./, $ip); my $data = unpack("N", pack("C4", @oct)); my $key = substr $data, 0, $split; my $value = substr $data, $split; return 0 unless (exists $info{$type}{$name}{$key}); return 1 if (1+index( $info{$type}{$name}{$key}, ":$value:" )); return 0; } sub give_stats { my $running = time - $info{"starttime"}; return unless ($running); my (@time) = gmtime($running); my $stats .= sprintf ("\n%30s:\t%d Days %d Hours %d Min %d Sec\n", "Uptime", $time[7], $time[2], $time[1], $time[0], $running); $stats .= sprintf ("%30s:\t%d\n", "Total Requests", $info{"requests"}); $stats .= sprintf ("%30s:\t%.2f\n", "Requests Per Second", ($info{"requests"} / $running)); foreach my $name (sort keys %{$info{"stats"}}) { my $wording = "Rejections"; $stats .= sprintf ("\n%30s:\t%d (%.2f%%)", "$name Requests", $info{"stats"}{$name}{"requests"}, (($info{"stats"}{$name}{"requests"} / $info{"requests"})*100)); # It is kind of awkward to call a whitelist save a "rejection" # so we update the wording as appropriate $wording = "Saves" if ($lists{$name}{"type"} eq "whitelist"); # Avoid uninitialized errors if (exists $info{"stats"}{$name}{"rejections"}) { $stats .= sprintf ("\n%30s:\t%d (%.2f%%)\n", "$name $wording", $info{"stats"}{$name}{"rejections"}, (($info{"stats"}{$name}{"rejections"} / $info{"stats"}{$name}{"requests"}) * 100)); } else { $stats .= sprintf ("\n%30s:\t%d\n", "$name $wording", 0); } $stats .= sprintf ("%30s:\t%.2f\n", "$name RPS", ($info{"stats"}{$name}{"requests"} / $running)); } return $stats; } # Add a watch on a file via inwatch sub add_to_infile { my $file = shift; return if ($info{"infile"}{$file}); my $cmd = shift; open (INF, ">>$config->{infile}"); print INF "$file IN_MODIFY|IN_CREATE_SELF SOCK RBLD $cmd $file\n"; close (INF); $info{"infile"}{$file} = 1; return; } sub reset_infile { delete $info{"infile"}; open (INF, ">$config->{infile}"); close (INF); } sub open_log { warn scalar(localtime).": [$$] $0 Reseting log file...\n"; close (STDERR); open STDERR, ">>$config->{log}"; chmod 0600, $config->{log}; warn scalar(localtime).": [$$] $0 Log file open.\n"; # TODO, Make this reload on the next request after # something expires instead of once a day. # Reload lists with entries that expire. foreach my $file (keys %lists) { next unless ($lists{$file}{"split"}); next if ($lists{$file}{"format"} eq "TRIE"); load_list ($file); } } sub reload { warn scalar(localtime).": [$$] $0 reloading...\n"; exit if fork; sleep 2; exec "$config->{run_path}" or die "exec: $!"; } # HELP ME!!! sub help { print <<EOF; -c|--config Path to rbld daemon configuration file -o|--log=s Path to rbld log -i|--infile Path to rbld infile -l|--listconf Path to rbld list configuration file -r|--runpath Path to run path of script (/usr/sbin/rbld) -s|--socketpath Path to rbld socket -u|--socketowner Who the rbld socket owner will be set to -g|--socketgroup Which group the rbld socket will be set to -d|--debug Debug output -h|--help This lovely help message EOF exit 0; } END { debug "Exiting...\n"; $dfh->close if defined $dfh; exit 0; } main();