Server IP : 85.214.239.14 / Your IP : 18.220.227.250 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/Mail/SpamAssassin/ |
Upload File : |
# <@LICENSE> # Licensed to the Apache Software Foundation (ASF) under one or more # contributor license agreements. See the NOTICE file distributed with # this work for additional information regarding copyright ownership. # The ASF licenses this file to you under the Apache License, Version 2.0 # (the "License"); you may not use this file except in compliance with # the License. You may obtain a copy of the License at: # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # </@LICENSE> =head1 NAME Mail::SpamAssassin::Client - Client for spamd Protocol =head1 SYNOPSIS my $client = Mail::SpamAssassin::Client->new({ port => 783, host => 'localhost', username => 'someuser'}); or my $client = Mail::SpamAssassin::Client->new({ socketpath => '/path/to/socket', username => 'someuser'}); Optionally takes timeout, which is applied to IO::Socket for the initial connection. If not supplied, it defaults to 30 seconds. if ($client->ping()) { print "Ping is ok\n"; } my $result = $client->process($testmsg); if ($result->{isspam} eq 'True') { do something with spam message here } =head1 DESCRIPTION Mail::SpamAssassin::Client is a module which provides a perl implementation of the spamd protocol. =cut package Mail::SpamAssassin::Client; use strict; use warnings; use re 'taint'; use IO::Socket; use Errno qw(EBADF); our($io_socket_module_name); BEGIN { if (eval { require IO::Socket::IP }) { $io_socket_module_name = 'IO::Socket::IP'; } elsif (eval { require IO::Socket::INET6 }) { $io_socket_module_name = 'IO::Socket::INET6'; } elsif (eval { require IO::Socket::INET }) { $io_socket_module_name = 'IO::Socket::INET'; } } my $EOL = "\015\012"; my $BLANK = $EOL x 2; my $PROTOVERSION = 'SPAMC/1.5'; =head1 PUBLIC METHODS =head2 new public class (Mail::SpamAssassin::Client) new (\% $args) Description: This method creates a new Mail::SpamAssassin::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->{port} = $args->{port}; $self->{host} = $args->{host}; } if (defined $args->{username}) { $self->{username} = $args->{username}; } if ($args->{max_size}) { $self->{max_size} = $args->{max_size}; } if ($args->{timeout}) { $self->{timeout} = $args->{timeout} || 30; } bless($self, $class); $self; } =head2 process public instance (\%) process (String $msg) Description: This method calls the spamd server with the PROCESS command. The return value is a hash reference containing several pieces of information, if available: content_length isspam score threshold message report =cut sub process { my ($self, $msg, $is_check_p) = @_; my $command = 'PROCESS'; if ($is_check_p) { warn "Passing in \$is_check_p is deprecated, just call the check method instead.\n"; $command = 'CHECK'; } return $self->_filter($msg, $command); } =head2 spam_report public instance (\%) spam_report (String $msg) Description: The method implements the report call. See the process method for the return value. =cut sub spam_report { my ($self, $msg) = @_; return $self->_filter($msg, 'REPORT'); } =head2 spam_report_ifspam public instance (\%) spam_report_ifspam (String $msg) Description: The method implements the report_ifspam call. A report will be returned only if the message is spam. See the process method for the return value. =cut sub spam_report_ifspam { my ($self, $msg) = @_; return $self->_filter($msg, 'REPORT_IFSPAM'); } =head2 check public instance (\%) check (String $msg) Description: The method implements the check call. See the process method for the return value. =cut sub check { my ($self, $msg) = @_; return $self->_filter($msg, 'CHECK'); } =head2 headers public instance (\%) headers (String $msg) Description: This method implements the headers call. See the process method for the return value. =cut sub headers { my ($self, $msg) = @_; return $self->_filter($msg, 'HEADERS'); } =head2 learn public instance (Boolean) learn (String $msg, Integer $learntype) Description: This method implements the learn call. C<$learntype> should be an integer, 0 for spam, 1 for ham and 2 for forget. The return value is a boolean indicating if the message was learned or not. An undef return value indicates that there was an error and you should check the resp_code/resp_msg values to determine what the error was. =cut sub learn { my ($self, $msg, $learntype) = @_; $self->_clear_errors(); my $remote = $self->_create_connection(); return unless $remote; my $msgsize = length($msg.$EOL); print $remote "TELL $PROTOVERSION$EOL"; print $remote "Content-length: $msgsize$EOL"; print $remote "User: $self->{username}$EOL" if defined $self->{username}; if ($learntype == 0) { print $remote "Message-class: spam$EOL"; print $remote "Set: local$EOL"; } elsif ($learntype == 1) { print $remote "Message-class: ham$EOL"; print $remote "Set: local$EOL"; } elsif ($learntype == 2) { print $remote "Remove: local$EOL"; } else { # bad learntype $self->{resp_code} = 00; $self->{resp_msg} = 'do not know'; return; } print $remote "$EOL"; print $remote $msg; print $remote "$EOL"; $! = 0; my $line = <$remote>; # deal gracefully with a Perl I/O bug which may return status EBADF at eof defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (1): $!") : die "error reading from spamd (1): $!"; return unless defined $line; my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); $self->{resp_code} = $resp_code; $self->{resp_msg} = $resp_msg; return unless $resp_code == 0; my $did_set = ''; my $did_remove = ''; for ($!=0; defined($line=<$remote>); $!=0) { local $1; if ($line =~ /DidSet: (.*)/i) { $did_set = $1; } elsif ($line =~ /DidRemove: (.*)/i) { $did_remove = $1; } elsif ($line =~ /^${EOL}$/) { last; } } defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (2): $!") : die "error reading from spamd (2): $!"; close $remote or die "error closing socket: $!"; if ($learntype == 0 || $learntype == 1) { return index($did_set, 'local') >= 0; } else { #safe since we've already checked the $learntype values return index($did_remove, 'local') >= 0; } } =head2 report public instance (Boolean) report (String $msg) Description: This method provides the report interface to spamd. =cut sub report { my ($self, $msg) = @_; $self->_clear_errors(); my $remote = $self->_create_connection(); return unless $remote; my $msgsize = length($msg.$EOL); print $remote "TELL $PROTOVERSION$EOL"; print $remote "Content-length: $msgsize$EOL"; print $remote "User: $self->{username}$EOL" if defined $self->{username}; print $remote "Message-class: spam$EOL"; print $remote "Set: local,remote$EOL"; print $remote "$EOL"; print $remote $msg; print $remote "$EOL"; $! = 0; my $line = <$remote>; defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (3): $!") : die "error reading from spamd (3): $!"; return unless defined $line; my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); $self->{resp_code} = $resp_code; $self->{resp_msg} = $resp_msg; return unless $resp_code == 0; my $reported_p = 0; for ($!=0; defined($line=<$remote>); $!=0) { if ($line =~ /DidSet:\s+.*remote/i) { $reported_p = 1; last; } elsif ($line =~ /^${EOL}$/) { last; } } defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (4): $!") : die "error reading from spamd (4): $!"; close $remote or die "error closing socket: $!"; return $reported_p; } =head2 revoke public instance (Boolean) revoke (String $msg) Description: This method provides the revoke interface to spamd. =cut sub revoke { my ($self, $msg) = @_; $self->_clear_errors(); my $remote = $self->_create_connection(); return unless $remote; my $msgsize = length($msg.$EOL); print $remote "TELL $PROTOVERSION$EOL"; print $remote "Content-length: $msgsize$EOL"; print $remote "User: $self->{username}$EOL" if defined $self->{username}; print $remote "Message-class: ham$EOL"; print $remote "Set: local$EOL"; print $remote "Remove: remote$EOL"; print $remote "$EOL"; print $remote $msg; print $remote "$EOL"; $! = 0; my $line = <$remote>; defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (5): $!") : die "error reading from spamd (5): $!"; return unless defined $line; my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); $self->{resp_code} = $resp_code; $self->{resp_msg} = $resp_msg; return unless $resp_code == 0; my $revoked_p = 0; for ($!=0; defined($line=<$remote>); $!=0) { if ($line =~ /DidRemove:\s+remote/i) { $revoked_p = 1; last; } elsif ($line =~ /^${EOL}$/) { last; } } defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (6): $!") : die "error reading from spamd (6): $!"; close $remote or die "error closing socket: $!"; return $revoked_p; } =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); print $remote "PING $PROTOVERSION$EOL"; print $remote "$EOL"; # bug 6187, bumps protocol version to 1.5 $! = 0; my $line = <$remote>; defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (7): $!") : die "error reading from spamd (7): $!"; close $remote or die "error closing socket: $!"; return unless defined $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 creating the client object. On failure, it sets an internal error code and returns undef. =cut sub _create_connection { my ($self) = @_; my $remote; if ($self->{socketpath}) { $remote = IO::Socket::UNIX->new( Peer => $self->{socketpath}, Type => SOCK_STREAM, Timeout => $self->{timeout}, ); } else { my %params = ( Proto => "tcp", PeerAddr => $self->{host}, PeerPort => $self->{port}, Timeout => $self->{timeout}, ); $remote = $io_socket_module_name->new(%params); } unless ($remote) { print "Failed to create connection to spamd daemon: $!\n"; return; } $remote; } =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 separate 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; } =head2 _filter private instance (\%) _filter (String $msg, String $command) Description: Makes the actual call to the spamd server for the various filter method (ie PROCESS, CHECK, HEADERS, etc). The command that is passed in is sent to the spamd server. The return value is a hash reference containing several pieces of information, if available: content_length isspam score threshold message (if available) report (if available) =cut sub _filter { my ($self, $msg, $command) = @_; my %data; my $msgsize; $self->_clear_errors(); my $remote = $self->_create_connection(); return 0 unless ($remote); if(defined $self->{max_size}) { $msg = substr($msg,0,$self->{max_size}); } $msgsize = length($msg.$EOL); print $remote "$command $PROTOVERSION$EOL"; print $remote "Content-length: $msgsize$EOL"; print $remote "User: $self->{username}$EOL" if defined $self->{username}; print $remote "$EOL"; print $remote $msg; print $remote "$EOL"; $! = 0; my $line = <$remote>; defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (8): $!") : die "error reading from spamd (8): $!"; return unless defined $line; my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); $self->{resp_code} = $resp_code; $self->{resp_msg} = $resp_msg; return unless $resp_code == 0; for ($!=0; defined($line=<$remote>); $!=0) { local($1,$2,$3); if ($line =~ /Content-length: (\d+)/) { $data{content_length} = $1; } elsif ($line =~ m!Spam: (\S+) ; (\S+) / (\S+)!) { $data{isspam} = $1; $data{score} = $2 + 0; $data{threshold} = $3 + 0; } elsif ($line =~ /^${EOL}$/) { last; } } defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (9): $!") : die "error reading from spamd (9): $!"; my $return_msg; for ($!=0; defined($line=<$remote>); $!=0) { $return_msg .= $line; } defined $line || $!==0 or $!==EBADF ? dbg("error reading from spamd (10): $!") : die "error reading from spamd (10): $!"; if($command =~ /^REPORT/) { $data{report} = $return_msg if ($return_msg); } else { $data{message} = $return_msg if ($return_msg); } close $remote or die "error closing socket: $!"; return \%data; } 1;