747 lines
23 KiB
Perl
747 lines
23 KiB
Perl
#!/usr/bin/perl
|
|
|
|
##############################################
|
|
# iauthd for doing DNSBL lookups, implimented in perl. Can be extended easily to also handle LOC/SASL
|
|
#
|
|
# Requirements:
|
|
# You need to install some perl dependancies for this to run.
|
|
#
|
|
# Debian/ubuntu/mint:
|
|
# apt-get install libpoe-perl libpoe-component-client-dns-perl libterm-readkey-perl libfile-slurp-perl libtime-duration-perl
|
|
#
|
|
# fedora/redhat/centos:
|
|
# yum install perl-POE perl-POE-Component-Client-DNS perl-TermReadKey perl-slurp perl-Time-Duration
|
|
#
|
|
# freebsd:
|
|
# ports dns/p5-POE-Component-Client-DNS devel/p5-Time-Duration devel/p5-File-Slurp devel/p5-Term-ReadKey
|
|
#
|
|
# or via cpan:
|
|
# cpan install Term::ReadKey POE::Component::Client::DNS File::Slurp Time::Duration
|
|
#
|
|
# Installation:
|
|
# Copy somewhere convenient
|
|
#
|
|
# Usage:
|
|
# iauth.pl -f /path/to/config
|
|
#
|
|
# Configuration:
|
|
#
|
|
# * Config directives begin with #IAUTHD and are one per line
|
|
# * Because configuration begins with a #, it can piggy back on existing
|
|
# ircd.conf file. ircd will ignore it. Handy for those using linesync.
|
|
# * Syntax is: #IAUTHD <directive> <arguments>
|
|
#
|
|
#
|
|
# Description of config directives:
|
|
#
|
|
# POLICY:
|
|
# see docs/readme.iauth section on Set Policy Options
|
|
#
|
|
# DNSTIMEOUT:
|
|
# seconds to time out for DNSBL lookups. Default is 5
|
|
#
|
|
# DNSBL <key=value [key=value..]>
|
|
# where keys are:
|
|
# server - dnsbl server to look up, eg dnsbl.sorbs.net
|
|
# bitmask - matches if response is true after being bitwise-and'ed with mask
|
|
# index - matches if response is exactly index (comma seperated values ok)
|
|
# class - assigns the user to the named class
|
|
# mark - marks the user with the given mark
|
|
# block - all - blocks connection if matched
|
|
# anonymous - blocks connection unless LOC/SASL
|
|
# whitelist- listed users wont be blocked by any rbl
|
|
# cachetime - Override default cache timeout. Useful for whitelists you run yourself
|
|
#
|
|
# DEBUG: - values greater than 0 turn iauth debugging on in the ircd
|
|
#
|
|
# Example:
|
|
|
|
#IAUTH POLICY RTAWUwFr
|
|
#IAUTH CACHETIME 86400
|
|
#IAUTH BLOCKMSG Sorry! Your connection has been rejected because of your internet address's poor reputation.
|
|
#IAUTH DNSBL server=dnsbl.sorbs.net index=2,3,4,5,6,7,9 mark=sorbs block=anonymous
|
|
#IAUTH DNSBL server=dnsbl.dronebl.org index=2,3,5,6,7,8,9,10,13,14,15 mark=dronebl block=anonymous
|
|
#IAUTH DNSBL server=rbl.efnetrbl.org index=4 mark=tor
|
|
#IAUTH DNSBL server=rbl.efnetrbl.org index=1,2,3,5 mark=efnetrbl block=anonymous
|
|
|
|
#
|
|
# ircd.conf:
|
|
#
|
|
# IAuth {
|
|
# program = "/usr/bin/perl" "iauthd.pl" "-v" "-d" "-c" "ircd.conf";
|
|
# };
|
|
#
|
|
# Debugging:
|
|
# * oper up first
|
|
# * set snomask /quote mode yournick +s 262144
|
|
#
|
|
########################3
|
|
|
|
=head1 NAME
|
|
|
|
iauthd.pl - a perl based iauthd daemon supporting DNSBL lookups
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
iauthd.pl [options] --config=configfile.conf
|
|
|
|
Options: (short)
|
|
--help (-h) Print this message
|
|
--config (-c) Config file to read
|
|
--debug (-d) Turn on debugging in the ircd
|
|
--verbose (-v) Turn on debugging in iauthd
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Getopt::Long;
|
|
use Pod::Usage;
|
|
|
|
use POE qw ( Wheel::SocketFactory Wheel::ReadWrite Filter::Line Driver::SysRW );
|
|
use POE::Driver::SysRW;
|
|
use POE::Filter::Line;
|
|
use POE::Wheel::ReadWrite;
|
|
use POE::Component::Client::DNS;
|
|
|
|
use Term::ReadKey;
|
|
use POSIX;
|
|
use File::Slurp;
|
|
use Data::Dumper;
|
|
|
|
use Time::Duration;
|
|
|
|
my $DEFAULT_CACHETIME = 60 * 60 * 24;
|
|
|
|
my $STARTTIME = time();
|
|
|
|
my $VERSION = "7";
|
|
|
|
my %clients;
|
|
my %dnsbl_cache;
|
|
|
|
my $count_pass = 0;
|
|
my $count_reject = 0;
|
|
|
|
my %dnsbl_counters;
|
|
|
|
my $poe_heap;
|
|
|
|
|
|
my %options;
|
|
GetOptions( \%options, 'help', 'config:s', 'debug', 'verbose') or confess("Error");
|
|
|
|
pod2usage(1) if ($options{'help'} or !$options{'config'});
|
|
|
|
my %config = read_configfile($options{'config'});
|
|
|
|
my $named = POE::Component::Client::DNS->spawn(
|
|
Alias => "named",
|
|
Timeout => ($config{'dnstimeout'} ? $config{'dnstimeout'} : 5)
|
|
);
|
|
|
|
# Create the POE object with callbacks
|
|
POE::Session->create (
|
|
inline_states => {
|
|
_start => \&poe_start,
|
|
#_stop => \&poe_stop,
|
|
myinput_event => \&myinput_event,
|
|
myerror_event => \&myerror_event,
|
|
myint_event => \&myint_event,
|
|
myresponse_event => \&myresponse_event,
|
|
}
|
|
);
|
|
|
|
# Start the event loop
|
|
POE::Kernel->run();
|
|
exit 0;
|
|
|
|
|
|
#####
|
|
#
|
|
# Subs
|
|
#
|
|
#####
|
|
|
|
sub poe_print {
|
|
my $str = join(' ', @_);
|
|
if($poe_heap) {
|
|
$poe_heap->{stdio}->put($str);
|
|
}
|
|
else {
|
|
print "$str\n";
|
|
}
|
|
}
|
|
|
|
sub debug {
|
|
my $str = join(' ', @_);
|
|
if($options{'debug'}) {
|
|
poe_print("> :$str");
|
|
}
|
|
}
|
|
|
|
sub poe_start {
|
|
my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
|
|
|
|
handle_startup();
|
|
|
|
# Start the terminal reader/writer.
|
|
$heap->{stdio} = POE::Wheel::ReadWrite->new (
|
|
InputHandle => \*STDIN,
|
|
OutputHandle => \*STDOUT,
|
|
InputEvent => "myinput_event",
|
|
Filter => POE::Filter::Line->new(),
|
|
ErrorEvent => "myerror_event",
|
|
);
|
|
$kernel->sig(INT => "myint_event");
|
|
|
|
$poe_heap = $heap;
|
|
}
|
|
|
|
sub poe_stop {
|
|
my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
|
|
poe_print "Doing poe_stop";
|
|
#$kernel->alias_remove($fileio_uuid);
|
|
}
|
|
|
|
sub myinput_event {
|
|
my ( $kernel, $heap, $line ) = @_[ KERNEL, HEAP, ARG0 ];
|
|
#debug("read a line...... '$line'");
|
|
return unless($line);
|
|
|
|
my @line = split / /, $line;
|
|
|
|
my $source = shift @line;
|
|
my $message = shift @line;
|
|
my $args = join(' ', @line);
|
|
|
|
return unless(defined $message);
|
|
|
|
# warning, this one can contain passwords...
|
|
#debug("<-- $line");
|
|
|
|
#print "Parsed source=$source, message=$message\n";
|
|
if($message eq 'C') { #client introduction: <remoteip> <remoteport> <localip> <localport>
|
|
my ($ip, $port, $serverip, $serverport) = split( / /, $args);
|
|
|
|
if(!defined $ip) {
|
|
debug("Got a C without a valid IP. Ignoring");
|
|
return;
|
|
}
|
|
handle_client($kernel, $heap, $source, $ip, $port, $serverip, $serverport);
|
|
}
|
|
elsif($message eq 'D') { #Client disconnect
|
|
debug("Client $source disconnected.");
|
|
if(exists $clients{$source}) {
|
|
client_delete($clients{$source});
|
|
}
|
|
}
|
|
elsif($message eq 'F') { #Client has ssl cert: <fingerprint>
|
|
}
|
|
elsif($message eq 'R') { #Client authed with sasl or loc: <account>
|
|
my $account = $args;
|
|
handle_auth($kernel, $heap, $source, $account);
|
|
}
|
|
elsif($message eq 'N') { #hostname received: <hostname>
|
|
}
|
|
elsif($message eq 'd') { #hostname timed out
|
|
}
|
|
elsif($message eq 'P') { #Client Password: :<password>
|
|
}
|
|
elsif($message eq 'U') { #client username: <username> <hostname> <servername> :<user info ...>
|
|
}
|
|
elsif($message eq 'u') { #client username: <username>
|
|
}
|
|
elsif($message eq 'n') { #client nickname: <nickname>
|
|
}
|
|
elsif($message eq 'H') { #Hurry up: <class>
|
|
handle_hurry($source, $args);
|
|
}
|
|
elsif($message eq 'T') { #Client Registered
|
|
}
|
|
elsif($message eq 'E') { #Error: :<aditional text>
|
|
debug("ircd complaining of error: $args");
|
|
}
|
|
elsif($message eq 'e') { #Error: :<aditional text>
|
|
if($args eq 'rehash') {
|
|
debug("Got a rehash. Rereading config file");
|
|
%config = read_configfile($options{'config'});
|
|
}
|
|
}
|
|
elsif($message eq 'M') { #Server name an dcapacity: <servername> <capacity>
|
|
}
|
|
elsif($message eq 'X') { #extension query reply: <servername> <routing> :<reply>
|
|
}
|
|
elsif($message eq 'x') { #extension query reply not linked: <servername> <routing> :Server not online
|
|
}
|
|
elsif($message eq 'W' || $message eq 'w') { #webirc received from client (or W trusted client): <pass> <user> <host> <ip>
|
|
my ($pass, $user, $host, $ip) = split(/ /, $args);
|
|
debug("Got a W line: $source - pass=<notshown>, user=$user, host=$host, ip=$ip");
|
|
if($message eq 'W') { #untrusted ones are ignored TODO: send a kill? (k)
|
|
debug("Got an untrusted WEBIRC attempt. Ignoring.");
|
|
}
|
|
else {
|
|
handle_webirc($kernel, $heap, $source, $pass, $user, $host, $ip);
|
|
}
|
|
|
|
}
|
|
else {
|
|
debug("Got unknown message '$message' from server");
|
|
}
|
|
}
|
|
|
|
sub myerror_event {
|
|
my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
|
|
debug("Everything either went to hell or we got to the end. Shutting down...");
|
|
exit 0;
|
|
#delete $heap->{wheels}->{$fileio_uuid};
|
|
$kernel->yield("_stop");
|
|
}
|
|
|
|
sub myresponse_event {
|
|
my ( $kernel, $heap, $response ) = @_[ KERNEL, HEAP, ARG0 ];
|
|
#debug("Got a response ... ");
|
|
my @result;
|
|
if(!defined $response->{response}) {
|
|
debug("got an empty response.. probably a timeout");
|
|
}
|
|
else {
|
|
foreach my $answer ($response->{response}->answer()) {
|
|
debug(
|
|
"$response->{host} = ",
|
|
$answer->type(), " ",
|
|
$answer->rdatastr(),
|
|
);
|
|
push @result, $answer->rdatastr();
|
|
}
|
|
}
|
|
handle_dnsbl_response($kernel, $heap, $response->{'host'}, \@result, 0);
|
|
}
|
|
|
|
|
|
|
|
sub read_configfile {
|
|
my $file = shift;
|
|
my %config;
|
|
my @dnsbls;
|
|
my $cfgnum = 0;
|
|
$config{'dnsbls'} = \@dnsbls;
|
|
$config{'blockmsg'} = "Your internet address has been rejected due to reputation (DNSBL).";
|
|
$config{'cachetime'} = $DEFAULT_CACHETIME;
|
|
debug("Reading $file...");
|
|
send_newconfig();
|
|
poe_print "A * version :Nefarious iauthd.pl $VERSION";
|
|
foreach my $line (read_file($file)) {
|
|
chomp $line;
|
|
if($line =~ /^\#IAUTH\s(\w+)(\s+(.+))?/) {
|
|
my $directive = $1;
|
|
my $args = $3;
|
|
$cfgnum++;
|
|
send_config("$cfgnum: $directive $args");
|
|
#debug("Got a config line: $line");
|
|
#debug(" directive is $directive");
|
|
#debug(" arg is $args");
|
|
if($directive eq 'POLICY') {
|
|
$config{'policy'} = $args;
|
|
}
|
|
elsif($directive eq 'DNSBL') {
|
|
my %dnsblconfig;
|
|
foreach my $arg (split /\s+/, $args) {
|
|
if($arg =~ /(\w+)\=(.+)/) { #key=val pair
|
|
my $k = $1;
|
|
my $v = $2;
|
|
$dnsblconfig{$k} = $v;
|
|
}
|
|
else {
|
|
$dnsblconfig{$arg} = 1;
|
|
}
|
|
}
|
|
$dnsblconfig{'cfgnum'} = $cfgnum;
|
|
push @dnsbls, \%dnsblconfig;
|
|
$dnsbl_counters{$dnsblconfig{'cfgnum'}} = 0;
|
|
}
|
|
elsif($directive eq 'DEBUG') {
|
|
$config{'debug'} = 1;
|
|
}
|
|
elsif($directive eq 'DNSTIMEOUT') {
|
|
$config{'dnstimeout'} = $args;
|
|
}
|
|
elsif($directive eq 'BLOCKMSG') {
|
|
$config{'blockmsg'} = $args;
|
|
}
|
|
elsif($directive eq 'CACHETIME') {
|
|
$config{'cachetime'} = $args;
|
|
}
|
|
else {
|
|
debug("Unknown IAUTH directive '$directive'");
|
|
}
|
|
}
|
|
}
|
|
#print Dumper(\%config);
|
|
return %config;
|
|
}
|
|
|
|
sub handle_startup {
|
|
poe_print "G 1";
|
|
poe_print "V :Nefarious2 iauthd.pl version $VERSION";
|
|
|
|
#TODO: send the config version of this..
|
|
poe_print "O RTAWUwFr";
|
|
|
|
#print "a\n";
|
|
#print "s\n";
|
|
debug("Starting up");
|
|
send_stats();
|
|
}
|
|
|
|
|
|
sub handle_client {
|
|
my ($kernel, $heap, $source, $ip, $port, $serverip, $serverport) = @_;
|
|
debug("Handling client connect: $source from $ip");
|
|
|
|
if(exists $clients{$source}){ #existing entry.
|
|
debug("ERROR: Found existing entry for client $source (ip=$ip). Something got left hanging? Exiting..");
|
|
exit 1;
|
|
}
|
|
#add client to list
|
|
debug("Adding new entry for client $source (ip=$ip)");
|
|
my $client = { id=>$source,
|
|
ip=>$ip,
|
|
port=>$port,
|
|
serverip=>$serverip,
|
|
serverport=>$serverport,
|
|
whitelist=>0,
|
|
block=>0,
|
|
marks=>{},
|
|
class=>undef,
|
|
hurry=>0,
|
|
lookups=>{},
|
|
};
|
|
$clients{$source} = $client;
|
|
|
|
if($ip =~ /^(?:[0-9]{1,3}\.){3}[0-9]{1,3}$/) {
|
|
my $pi = join('.', reverse(split(/\./,$ip)));
|
|
|
|
foreach my $dnsbl (@{$config{'dnsbls'}}) {
|
|
my $server = $dnsbl->{'server'};
|
|
|
|
#Mark the lookup as pending.. (1)
|
|
$client->{'lookups'}->{$dnsbl->{'cfgnum'}} = 1;
|
|
debug("Looking up client $source: $pi.$server");
|
|
|
|
#Use global or specific cachetime setting
|
|
my $cachetime = $config{'cachetime'};
|
|
if(exists $dnsbl->{'cachetime'}) {
|
|
$cachetime = $dnsbl->{'cachetime'};
|
|
}
|
|
|
|
#purge from the cache if it matches...
|
|
if( exists $dnsbl_cache{"$pi.$server"}
|
|
&& exists $dnsbl_cache{"$pi.$server"}->{'ts'}
|
|
&& $dnsbl_cache{"$pi.$server"}->{'ts'} < ( time() - $cachetime) ) {
|
|
|
|
debug("Deleting stale cache entry for $pi.$server");
|
|
delete $dnsbl_cache{"$pi.$server"};
|
|
}
|
|
|
|
#Look up in the cache
|
|
if(exists $dnsbl_cache{"$pi.$server"}) { #Found a cache entry
|
|
my $cache_entry = $dnsbl_cache{"$pi.$server"};
|
|
debug("Found dnsbl cache entry for $pi.$server");
|
|
if(defined $cache_entry->{'result'}) { #got a completed lookup in the cache
|
|
handle_dnsbl_response($kernel, $heap, "$pi.$server", $cache_entry->{'result'}, 1);
|
|
}
|
|
else { #we started looking it up but no reply yet
|
|
debug("Cache pending... on $pi.$server");
|
|
}
|
|
}
|
|
else { #This lookup is not in the cache yet
|
|
#Adding pending cache entry
|
|
debug("Adding cache entry for pending lookup $pi.$server");
|
|
$dnsbl_cache{"$pi.$server"} = { result=>undef, ts=>time()};
|
|
|
|
#Begin a POE lookup on the dnsbl
|
|
my $response = $named->resolve(
|
|
event => "myresponse_event",
|
|
host => "$pi.$server",
|
|
context => { },
|
|
);
|
|
if($response) {
|
|
$kernel->yield(response => $response);
|
|
}
|
|
}
|
|
} #each dnsbl
|
|
}
|
|
else {
|
|
debug("Unknown IP format: $ip, probably ipv6 or something... ignoring");
|
|
}
|
|
}
|
|
|
|
sub handle_webirc {
|
|
my ($kernel, $heap, $source, $pass, $user, $newhost, $newip) = @_;
|
|
|
|
if(exists $clients{$source}) {
|
|
my $client = $clients{$source};
|
|
|
|
#Save some values to recreate the client
|
|
my $port = $client->{'port'};
|
|
my $serverip = $client->{'serverip'};
|
|
my $serverport = $client->{'serverport'};
|
|
my $washurry = $client->{'hurry'};
|
|
|
|
#Delete the client record, we need to start over
|
|
client_delete($clients{$source});
|
|
#Create a new client and start fresh
|
|
handle_client($kernel, $heap, $source, $newip, $port, $serverip, $serverport);
|
|
if($washurry) {
|
|
$clients{$source}->{'hurry'} = 1;
|
|
}
|
|
}
|
|
else {
|
|
debug("Got a webirc for a client we don't know about? Ignored.");
|
|
}
|
|
|
|
}
|
|
|
|
sub handle_auth {
|
|
my ( $kernel, $heap, $source, $account ) = @_;
|
|
my $client = $clients{$source};
|
|
|
|
debug("Client authed as $account");
|
|
$client->{'account'} = $account;
|
|
handle_client_update($client);
|
|
}
|
|
|
|
#Got a DNS reply, or found a cached one.
|
|
sub handle_dnsbl_response {
|
|
my ( $kernel, $heap, $host, $results, $iscached ) = @_;
|
|
my $lookup_string;
|
|
#Save the answer in the cache.
|
|
|
|
$dnsbl_cache{$host} = { result=>$results, ts=>time()} unless($iscached);
|
|
|
|
$host =~ /^([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.(.+)$/;
|
|
|
|
my $host_ip = "$4.$3.$2.$1";
|
|
my $dnsbl_server = "$5";
|
|
debug("Got a ". ($iscached?"cache hit":"DNS reply") . " for $host_ip from $dnsbl_server..." . @$results . " replies...");
|
|
|
|
#If this result is a hit for any dnsbls, find related clients and mark/block/whitelist etc
|
|
foreach my $ip (@$results) {
|
|
if($ip =~ /^([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})$/) {
|
|
my $value = $4;
|
|
#debug("Looking at response value $value from $host");
|
|
|
|
foreach my $config_dnsbl (@{$config{'dnsbls'}}) {
|
|
next unless($config_dnsbl->{'server'} eq $dnsbl_server);
|
|
my $flag;
|
|
if(exists $config_dnsbl->{'index'}) {
|
|
foreach my $index (split(/,/, $config_dnsbl->{'index'})) {
|
|
if($value eq $index) {
|
|
$flag++;
|
|
}
|
|
}
|
|
}
|
|
if(exists $config_dnsbl->{'bitmask'}) {
|
|
foreach my $bitmask (split(/,/, $config_dnsbl->{'bitmask'})) {
|
|
if($bitmask & $value) {
|
|
$flag++;
|
|
}
|
|
}
|
|
}
|
|
if($flag) {
|
|
#Go through all the client records. Check if this positive dnsbl hit affects them
|
|
foreach my $client_id (keys %clients) {
|
|
my $client = $clients{$client_id};
|
|
if($client->{'ip'} eq $host_ip) {
|
|
#We found a client in the queue which matches this
|
|
#dnsbl. Mark them and flag them etc
|
|
debug("client $client->{id} matches $config_dnsbl->{server} result $value");
|
|
#$dnsbl_counters{$config_dnsbl->{'cfgnum'}}++;
|
|
foreach my $field (qw( whitelist block class )) {
|
|
if($config_dnsbl->{$field}) {
|
|
$client->{$field} = $config_dnsbl->{$field};
|
|
}
|
|
}
|
|
if($config_dnsbl->{'mark'}) {
|
|
$client->{'marks'}->{$config_dnsbl->{'mark'}} = $config_dnsbl;
|
|
}
|
|
$client->{'hits'}->{$config_dnsbl->{'cfgnum'}} = 1;
|
|
} #client matches reply
|
|
} #each client
|
|
}
|
|
# #each index
|
|
} #each dnsbl
|
|
|
|
}
|
|
else {
|
|
debug("Unable to parse dnsbl result: $ip");
|
|
}
|
|
} #foreach @results
|
|
foreach my $client (values %clients) {
|
|
if($client->{'hits'}) {
|
|
foreach my $cfgnum (keys %{$client->{'hits'}}) {
|
|
$dnsbl_counters{$cfgnum}++;
|
|
delete $client->{'hits'};
|
|
}
|
|
}
|
|
}
|
|
|
|
#Clear all pending states on all clients with matching ips waiting on any related dnsbls.
|
|
foreach my $dnsbl (@{$config{'dnsbls'}}) {
|
|
if($dnsbl_server eq $dnsbl->{'server'}) {
|
|
foreach my $client (values %clients) {
|
|
if($client->{'ip'} eq $host_ip) {
|
|
if($client->{'lookups'}->{$dnsbl->{'cfgnum'}}) {
|
|
$client->{'lookups'}->{$dnsbl->{'cfgnum'}} = 0;
|
|
handle_client_update($client);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
#The client has been updated. Check if its done
|
|
sub handle_client_update {
|
|
my $client = shift;
|
|
my $pending = 0;
|
|
foreach my $v (values %{$client->{'lookups'}}) {
|
|
$pending += $v;
|
|
}
|
|
if($client->{'hurry'}) {
|
|
debug("Client $client->{id} has Hurry set and $pending pending requests");
|
|
if($pending < 1) {
|
|
if($client->{'whitelist'}) {
|
|
client_pass($client);
|
|
}
|
|
elsif( ($client->{'block'} eq 'all')
|
|
|| ($client->{'block'} eq 'anonymous' && !$client->{'account'})) {
|
|
client_reject($client, $config{'blockmsg'});
|
|
}
|
|
else {
|
|
client_pass($client);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
debug("Client $client->{id} has $pending pending requests");
|
|
}
|
|
}
|
|
|
|
sub handle_hurry {
|
|
my $source = shift;
|
|
my $class = shift;
|
|
my $client = $clients{$source};
|
|
|
|
if(!$client) {
|
|
debug("ERROR: Got a hurry for a client we arent even holding on to!");
|
|
return;
|
|
}
|
|
debug("Handling a hurry on $source");
|
|
|
|
$client->{'hurry'} = 1;
|
|
handle_client_update($client);
|
|
}
|
|
|
|
sub client_pass {
|
|
my $client = shift;
|
|
debug("Passing client ". $client->{'id'} . ' ('. $client->{'ip'} . ')');
|
|
#print Dumper($client);
|
|
foreach my $mark (keys %{$client->{'marks'}}) {
|
|
send_mark($client->{'id'}, $client->{'ip'}, $client->{'port'}, 'MARK', $mark);
|
|
}
|
|
send_done($client->{'id'}, $client->{'ip'}, $client->{'port'}, $client->{'class'}?$client->{'class'}:undef);
|
|
$count_pass++;
|
|
client_delete($client);
|
|
send_stats();
|
|
}
|
|
|
|
sub client_reject {
|
|
my $client = shift;
|
|
my $reason = shift;
|
|
debug("Rejecting client " . $client->{'id'} . ' ('. $client->{'ip'} . "): $reason");
|
|
send_kill($client->{'id'}, $client->{'ip'}, $client->{'port'}, $reason);
|
|
$count_reject++;
|
|
client_delete($client);
|
|
send_stats();
|
|
}
|
|
|
|
sub client_delete {
|
|
my $client = shift;
|
|
debug("Deleting client from hash tables");
|
|
delete($clients{$client->{'id'}});
|
|
}
|
|
|
|
sub send_mark {
|
|
my $id = shift;
|
|
my $remoteip = shift;
|
|
my $remoteport = shift;
|
|
my $marktype = shift;
|
|
my $markdata = shift;
|
|
|
|
return unless($markdata);
|
|
|
|
poe_print "m $id $remoteip $remoteport $marktype $markdata";
|
|
}
|
|
|
|
sub send_done {
|
|
my $id = shift;
|
|
my $remoteip = shift;
|
|
my $remoteport = shift;
|
|
my $class = shift;
|
|
|
|
if($class) {
|
|
poe_print "D $id $remoteip $remoteport $class";
|
|
}
|
|
else {
|
|
poe_print "D $id $remoteip $remoteport";
|
|
}
|
|
}
|
|
|
|
sub send_kill {
|
|
my $id = shift;
|
|
my $remoteip = shift;
|
|
my $remoteport = shift;
|
|
my $reason = shift;
|
|
|
|
poe_print "k $id $remoteip $remoteport :$reason";
|
|
}
|
|
|
|
sub send_newconfig {
|
|
poe_print "a";
|
|
}
|
|
sub send_config {
|
|
my $config = shift;
|
|
poe_print "A * iauthd.pl :$config";
|
|
}
|
|
|
|
sub send_stats {
|
|
my $up = POSIX::strftime "%a %b %e %H:%M:%S %Y", localtime($STARTTIME);
|
|
my $uptime = duration(time() - $STARTTIME);
|
|
poe_print "s";
|
|
poe_print "S iauthd.pl :Up since $up ($uptime)";
|
|
poe_print "S iauthd.pl :Cache size: ". %dnsbl_cache . "";
|
|
poe_print "S iauthd.pl :Total Passed: $count_pass";
|
|
poe_print "S iauthd.pl :Total Rejected: $count_reject";
|
|
foreach my $config_dnsbl (@{$config{'dnsbls'}}) {
|
|
my $d = $config_dnsbl->{'server'};
|
|
if(exists $config_dnsbl->{'index'}) {
|
|
$d .= " (" . $config_dnsbl->{'index'}. ")";
|
|
}
|
|
if(exists $config_dnsbl->{'bitmask'}) {
|
|
$d .= " (" . $config_dnsbl->{'bitmask'}. ")";
|
|
}
|
|
my $c = 0;
|
|
if( exists $dnsbl_counters{$config_dnsbl->{'cfgnum'}}) {
|
|
$c = $dnsbl_counters{$config_dnsbl->{'cfgnum'}};
|
|
}
|
|
|
|
poe_print "S iauthd.pl :$d: $c";
|
|
}
|
|
}
|
|
|
|
|