diff options
author | Vsevolod Stakhov <vsevolod@rambler-co.ru> | 2009-11-16 18:43:30 +0300 |
---|---|---|
committer | Vsevolod Stakhov <vsevolod@rambler-co.ru> | 2009-11-16 18:43:30 +0300 |
commit | 751116959b5b547c96e24574d20ecc89cd1dbccb (patch) | |
tree | f7a89f9f30809ec326db288e54069f8f37999a7c /perl/lib/Mail | |
parent | 092a40dcf813accb11a0b6bb600dccea0b35fb1d (diff) | |
download | rspamd-751116959b5b547c96e24574d20ecc89cd1dbccb.tar.gz rspamd-751116959b5b547c96e24574d20ecc89cd1dbccb.zip |
* Perl fixes:
- remove XS API, it seems that I would never support it
- use sys(write|read) for IO in Mail::Rspamd::Client
- add proper installation process for Mail::Rspamd::Client
- remove some other legacy
--HG--
rename : perl/Client.pm => perl/lib/Mail/Rspamd/Client.pm
Diffstat (limited to 'perl/lib/Mail')
-rw-r--r-- | perl/lib/Mail/Rspamd/Client.pm | 470 |
1 files changed, 470 insertions, 0 deletions
diff --git a/perl/lib/Mail/Rspamd/Client.pm b/perl/lib/Mail/Rspamd/Client.pm new file mode 100644 index 000000000..bb405a7b4 --- /dev/null +++ b/perl/lib/Mail/Rspamd/Client.pm @@ -0,0 +1,470 @@ + +=head1 NAME + +Mail::Rspamd::Client - Client for rspamd Protocol + + +=head1 SYNOPSIS + + my $client = new Mail::Rspamd::Client({port => 11333, + host => 'localhost', + ip => '127.0.0.1'}); + + if ($client->ping()) { + print "Ping is ok\n"; + } + + my $result = $client->check($testmsg); + + if ($result->{'default'}->{isspam} eq 'True') { + do something with spam message here + } + +=head1 DESCRIPTION + +Mail::Rspamd::Client is a module that provides a perl implementation for +the spamd protocol. + +=cut + +package Mail::Rspamd::Client; + +use IO::Socket; +use IO::Select; + +use vars qw($VERSION); +$VERSION = "1.00"; + +my $EOL = "\015\012"; +my $BLANK = $EOL x 2; +my $PROTOVERSION = 'RSPAMC/1.0'; + +=head1 PUBLIC METHODS + +=head2 new + +public class (Mail::Rspamd::Client) new (\% $args) + +Description: +This method creates a new Mail::Rspamd::Client object. + +=cut + +sub new { + my ($class, $args) = @_; + + $class = ref($class) || $class; + + my $self = {}; + + # with a sockets_path set then it makes no sense to set host and port + if ($args->{socketpath}) { + $self->{socketpath} = $args->{socketpath}; + } + else { + $self->{hosts} = $args->{hosts}; + $self->{alive_hosts} = $self->{hosts}; + } + + if ($args->{username}) { + $self->{username} = $args->{username}; + } + if ($args->{ip}) { + $self->{ip} = $args->{ip}; + } + if ($args->{from}) { + $self->{from} = $args->{from}; + } + if ($args->{subject}) { + $self->{subject} = $args->{subject}; + } + if ($args->{rcpt}) { + $self->{rcpt} = $args->{rcpt}; + } + if ($args->{timeout}) { + $self->{timeout} = $args->{timeout}; + } + else { + $self->{timeout} = 5; + } + if ($args->{password}) { + $self->{password} = $args->{password}; + } + + bless($self, $class); + + $self; +} + +=head2 check + +public instance (\%) check (String $msg) + +Description: +This method makes a call to the spamd server and depending on the value of +C<$is_check_p> either calls PROCESS or CHECK. + +The return value is a hash reference containing metrics indexed by name. Each metric +is hash that contains data: + +isspam + +score + +threshold + +symbols - array of symbols + +=cut + +sub check { + my ($self, $msg) = @_; + + my %metrics; + + my $command = 'SYMBOLS'; + + $self->_clear_errors(); + + my $remote = $self->_create_connection(); + + return 0 unless ($remote); + + my $msgsize = length($msg.$EOL); + + local $SIG{PIPE} = 'IGNORE'; + + if (!(syswrite($remote, "$command $PROTOVERSION$EOL"))) { + $self->_mark_dead($remote); + return 0; + } + syswrite $remote, "Content-length: $msgsize$EOL"; + syswrite $remote, "User: $self->{username}$EOL" if ($self->{username}); + syswrite $remote, "From: $self->{from}$EOL" if ($self->{from}); + syswrite $remote, "IP: $self->{ip}$EOL" if ($self->{ip}); + syswrite $remote, "Subject: $self->{subject}$EOL" if ($self->{subject}); + if (ref $self->{rcpt} eq "ARRAY") { + foreach ($self->{rcpt}) { + syswrite $remote, "Rcpt: $_ $EOL"; + } + } + syswrite $remote, $EOL; + syswrite $remote, $msg; + syswrite $remote, $EOL; + + return undef unless $self->_get_io_readiness($remote, 0); + + my $in; + return undef unless sysread($remote, $in, 512); + + my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($in); + + $self->{resp_code} = $resp_code; + $self->{resp_msg} = $resp_msg; + + return undef unless ($resp_code == 0); + + my $cur_metric; + my @lines = split (/^/, $in); + foreach my $line (@lines) { + if ($line =~ m!Metric: (\S+); (\S+); (\S+) / (\S+)!) { + $metrics{$1} = { + isspam => $2, + score => $3 + 0, + threshold => $4 + 0, + symbols => [], + }; + $cur_metric = $1; + } + elsif ($line =~ /^Symbol: (\S+)/ && $cur_metric) { + my $symref = $metrics{$cur_metric}->{'symbols'}; + push(@$symref, $1); + } + elsif ($line =~ /^${EOL}$/) { + last; + } + } + + close $remote; + + return \%metrics; +} + +sub _auth { + my ($self, $sock) = @_; + + local $SIG{PIPE} = 'IGNORE'; + + if (!(syswrite($sock, "PASSWORD $self->{password}$EOL"))) { + $self->_mark_dead($remote); + return 0; + } + + return 0 unless $self->_get_io_readiness($sock, 0); + + if (sysread($sock, $reply, 255)) { + if ($reply =~ /^password accepted/) { + return 1; + } + } + + return 0; + +} + +=head2 learn + +public instance (\%) check (String $msg, String $statfile, Boolean in_class) + +Description: +This method makes a call to the spamd learning a statfile with message. + +=cut + +sub learn { + my ($self, $msg, $statfile, $in_class) = @_; + + my %metrics; + + my $command = 'LEARN'; + + $self->_clear_errors(); + + my $remote = $self->_create_connection(); + + return 0 unless ($remote); + + return 0 unless $self->_auth($remote); + + my $msgsize = length($msg.$EOL); + + local $SIG{PIPE} = 'IGNORE'; + + if (!(syswrite ($remote, "$command $statfile $msgsize$EOL"))) { + $self->_mark_dead($remote); + return 0; + } + + syswrite($remote, $msg); + syswrite($remote, $EOL); + + return undef unless $self->_get_io_readiness($remote, 0); + if (sysread ($remote, $reply, 255)) { + if ($reply =~ /^learn ok/) { + close $remote; + return 1; + } + } + + close $remote; + return 0; +} + +=head2 ping + +public instance (Boolean) ping () + +Description: +This method performs a server ping and returns 0 or 1 depending on +if the server responded correctly. + +=cut + +sub ping { + my ($self) = @_; + + my $remote = $self->_create_connection(); + + return 0 unless ($remote); + local $SIG{PIPE} = 'IGNORE'; + + if (!(syswrite($remote, "PING $PROTOVERSION$EOL"))) { + $self->_mark_dead($remote); + return 0; + } + syswrite($remote, $EOL); + + return undef unless $self->_get_io_readiness($remote, 0); + my $line; + sysread ($remote, $line, 255); + close $remote; + return undef unless $line; + + my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); + return 0 unless ($resp_msg eq 'PONG'); + + return 1; +} + +=head1 PRIVATE METHODS + +=head2 _create_connection + +private instance (IO::Socket) _create_connection () + +Description: +This method sets up a proper IO::Socket connection based on the arguments +used when greating the client object. + +On failure, it sets an internal error code and returns undef. + +=cut + +sub _create_connection { + my ($self) = @_; + + my $remote; + my $tries = 0; + + if ($self->{socketpath}) { + $remote = IO::Socket::UNIX->new( Peer => $self->{socketpath}, + Type => SOCK_STREAM, + Blocking => 0, + ); + # Get write readiness + if ($self->_get_io_readiness($remote, 1) == 0) { + print "Connection timed out: $!\n"; + return undef; + } + } + else { + my $server; + + do { + $server = $self->_select_server(); + $tries ++; + + $remote = IO::Socket::INET->new( Proto => "tcp", + PeerAddr => $server->{host}, + PeerPort => $server->{port}, + Blocking => 0, + ); + # Get write readiness + if ($self->_get_io_readiness($remote, 1) != 0) { + return $remote; + } + else { + next; + } + } while ($tries < 5); + + return undef unless $server; + } + unless ($remote) { + print "Failed to create connection to spamd daemon: $!\n"; + return undef; + } + $remote; +} + +sub _revive_dead { + my ($self) = @_; + + my $now = time(); + foreach my $s ($self->{dead_hosts}) { + # revive after minute of downtime + if (defined($s->{dead}) && $s->{dead} == 1 && $now - $s->{t} > 60) { + $s->{dead} = 0; + push(@{$self->{alive_hosts}}, $s->{host}); + } + } + + 1; +} + +sub _select_server { + my($self) = @_; + + $self->_revive_dead(); + my $alive_num = scalar(@{$self->{alive_hosts}}); + if (!$alive_num) { + $self->{alive_hosts} = $self->{hosts}; + $self->{dead_hosts} = (); + $alive_num = scalar($self->{alive_hosts}); + } + + my $selected = $self->{alive_hosts}[int(rand($alive_num))]; + if ($selected =~ /^(\S+):(\d+)$/) { + my $server = { + host => $1, + port => $2, + }; + return $server; + } + + undef; +} + + +sub _mark_dead { + my ($self, $server) = @_; + + my $now = time(); + $self->{dead_hosts}->{$server} = { + host => $server, + dead => 1, + t => $now, + }; + for (my $i = 0; $i < scalar (@{$self->{alive_hosts}}); $i ++) { + if ($self->{alive_hosts} == $server) { + splice(@{$self->{alive_hosts}}, $i, 1); + last; + } + } +} + +sub _get_io_readiness { + my ($self, $sock, $is_write) = @_; + my $s = IO::Select->new(); + $s->add($sock); + + if ($is_write) { + @ready = $s->can_write($self->{timeout}); + } + else { + @ready = $s->can_read($self->{timeout}); + } + + + scalar(@ready); +} + +=head2 _parse_response_line + +private instance (@) _parse_response_line (String $line) + +Description: +This method parses the initial response line/header from the server +and returns its parts. + +We have this as a seperate method in case we ever decide to get fancy +with the response line. + +=cut + +sub _parse_response_line { + my ($self, $line) = @_; + + $line =~ s/\r?\n$//; + return split(/\s+/, $line, 3); +} + +=head2 _clear_errors + +private instance () _clear_errors () + +Description: +This method clears out any current errors. + +=cut + +sub _clear_errors { + my ($self) = @_; + + $self->{resp_code} = undef; + $self->{resp_msg} = undef; +} + +1; + + |