1# <@LICENSE> 2# Licensed to the Apache Software Foundation (ASF) under one or more 3# contributor license agreements. See the NOTICE file distributed with 4# this work for additional information regarding copyright ownership. 5# The ASF licenses this file to you under the Apache License, Version 2.0 6# (the "License"); you may not use this file except in compliance with 7# the License. You may obtain a copy of the License at: 8# 9# http://www.apache.org/licenses/LICENSE-2.0 10# 11# Unless required by applicable law or agreed to in writing, software 12# distributed under the License is distributed on an "AS IS" BASIS, 13# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14# See the License for the specific language governing permissions and 15# limitations under the License. 16# </@LICENSE> 17 18=head1 NAME 19 20Mail::SpamAssassin::Client - Client for spamd Protocol 21 22=head1 SYNOPSIS 23 24 my $client = Mail::SpamAssassin::Client->new({ 25 port => 783, 26 host => 'localhost', 27 username => 'someuser'}); 28 or 29 30 my $client = Mail::SpamAssassin::Client->new({ 31 socketpath => '/path/to/socket', 32 username => 'someuser'}); 33 34 Optionally takes timeout, which is applied to IO::Socket for the 35 initial connection. If not supplied, it defaults to 30 seconds. 36 37 if ($client->ping()) { 38 print "Ping is ok\n"; 39 } 40 41 my $result = $client->process($testmsg); 42 43 if ($result->{isspam} eq 'True') { 44 do something with spam message here 45 } 46 47=head1 DESCRIPTION 48 49Mail::SpamAssassin::Client is a module which provides a perl implementation of 50the spamd protocol. 51 52=cut 53 54package Mail::SpamAssassin::Client; 55 56use strict; 57use warnings; 58use re 'taint'; 59 60use IO::Socket; 61use Errno qw(EBADF); 62 63our($io_socket_module_name); 64BEGIN { 65 if (eval { require IO::Socket::IP }) { 66 $io_socket_module_name = 'IO::Socket::IP'; 67 } elsif (eval { require IO::Socket::INET6 }) { 68 $io_socket_module_name = 'IO::Socket::INET6'; 69 } elsif (eval { require IO::Socket::INET }) { 70 $io_socket_module_name = 'IO::Socket::INET'; 71 } 72} 73 74my $EOL = "\015\012"; 75my $BLANK = $EOL x 2; 76my $PROTOVERSION = 'SPAMC/1.5'; 77 78=head1 PUBLIC METHODS 79 80=head2 new 81 82public class (Mail::SpamAssassin::Client) new (\% $args) 83 84Description: 85This method creates a new Mail::SpamAssassin::Client object. 86 87=cut 88 89sub new { 90 my ($class, $args) = @_; 91 92 $class = ref($class) || $class; 93 94 my $self = {}; 95 96 # with a sockets_path set then it makes no sense to set host and port 97 if ($args->{socketpath}) { 98 $self->{socketpath} = $args->{socketpath}; 99 } 100 else { 101 $self->{port} = $args->{port}; 102 $self->{host} = $args->{host}; 103 } 104 105 if (defined $args->{username}) { 106 $self->{username} = $args->{username}; 107 } 108 109 if ($args->{timeout}) { 110 $self->{timeout} = $args->{timeout} || 30; 111 } 112 113 bless($self, $class); 114 115 $self; 116} 117 118=head2 process 119 120public instance (\%) process (String $msg) 121 122Description: 123This method calls the spamd server with the PROCESS command. 124 125The return value is a hash reference containing several pieces of information, 126if available: 127 128content_length 129 130isspam 131 132score 133 134threshold 135 136message 137 138=cut 139 140sub process { 141 my ($self, $msg, $is_check_p) = @_; 142 143 my $command = 'PROCESS'; 144 145 if ($is_check_p) { 146 warn "Passing in \$is_check_p is deprecated, just call the check method instead.\n"; 147 $command = 'CHECK'; 148 } 149 150 return $self->_filter($msg, $command); 151} 152 153=head2 check 154 155public instance (\%) check (String $msg) 156 157Description: 158The method implements the check call. 159 160See the process method for the return value. 161 162=cut 163 164sub check { 165 my ($self, $msg) = @_; 166 167 return $self->_filter($msg, 'CHECK'); 168} 169 170=head2 headers 171 172public instance (\%) headers (String $msg) 173 174Description: 175This method implements the headers call. 176 177See the process method for the return value. 178 179=cut 180 181sub headers { 182 my ($self, $msg) = @_; 183 184 return $self->_filter($msg, 'HEADERS'); 185} 186 187=head2 learn 188 189public instance (Boolean) learn (String $msg, Integer $learntype) 190 191Description: 192This method implements the learn call. C<$learntype> should be 193an integer, 0 for spam, 1 for ham and 2 for forget. The return 194value is a boolean indicating if the message was learned or not. 195 196An undef return value indicates that there was an error and you 197should check the resp_code/resp_msg values to determine what 198the error was. 199 200=cut 201 202sub learn { 203 my ($self, $msg, $learntype) = @_; 204 205 $self->_clear_errors(); 206 207 my $remote = $self->_create_connection(); 208 209 return unless $remote; 210 211 my $msgsize = length($msg.$EOL); 212 213 print $remote "TELL $PROTOVERSION$EOL"; 214 print $remote "Content-length: $msgsize$EOL"; 215 print $remote "User: $self->{username}$EOL" if defined $self->{username}; 216 217 if ($learntype == 0) { 218 print $remote "Message-class: spam$EOL"; 219 print $remote "Set: local$EOL"; 220 } 221 elsif ($learntype == 1) { 222 print $remote "Message-class: ham$EOL"; 223 print $remote "Set: local$EOL"; 224 } 225 elsif ($learntype == 2) { 226 print $remote "Remove: local$EOL"; 227 } 228 else { # bad learntype 229 $self->{resp_code} = 00; 230 $self->{resp_msg} = 'do not know'; 231 return; 232 } 233 234 print $remote "$EOL"; 235 print $remote $msg; 236 print $remote "$EOL"; 237 238 $! = 0; my $line = <$remote>; 239 # deal gracefully with a Perl I/O bug which may return status EBADF at eof 240 defined $line || $!==0 or 241 $!==EBADF ? dbg("error reading from spamd (1): $!") 242 : die "error reading from spamd (1): $!"; 243 return unless defined $line; 244 245 my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); 246 247 $self->{resp_code} = $resp_code; 248 $self->{resp_msg} = $resp_msg; 249 250 return unless $resp_code == 0; 251 252 my $did_set = ''; 253 my $did_remove = ''; 254 255 for ($!=0; defined($line=<$remote>); $!=0) { 256 local $1; 257 if ($line =~ /DidSet: (.*)/i) { 258 $did_set = $1; 259 } 260 elsif ($line =~ /DidRemove: (.*)/i) { 261 $did_remove = $1; 262 } 263 elsif ($line =~ /^${EOL}$/) { 264 last; 265 } 266 } 267 defined $line || $!==0 or 268 $!==EBADF ? dbg("error reading from spamd (2): $!") 269 : die "error reading from spamd (2): $!"; 270 close $remote or die "error closing socket: $!"; 271 272 if ($learntype == 0 || $learntype == 1) { 273 return index($did_set, 'local') >= 0; 274 } 275 else { #safe since we've already checked the $learntype values 276 return index($did_remove, 'local') >= 0; 277 } 278} 279 280=head2 report 281 282public instance (Boolean) report (String $msg) 283 284Description: 285This method provides the report interface to spamd. 286 287=cut 288 289sub report { 290 my ($self, $msg) = @_; 291 292 $self->_clear_errors(); 293 294 my $remote = $self->_create_connection(); 295 296 return unless $remote; 297 298 my $msgsize = length($msg.$EOL); 299 300 print $remote "TELL $PROTOVERSION$EOL"; 301 print $remote "Content-length: $msgsize$EOL"; 302 print $remote "User: $self->{username}$EOL" if defined $self->{username}; 303 print $remote "Message-class: spam$EOL"; 304 print $remote "Set: local,remote$EOL"; 305 print $remote "$EOL"; 306 print $remote $msg; 307 print $remote "$EOL"; 308 309 $! = 0; my $line = <$remote>; 310 defined $line || $!==0 or 311 $!==EBADF ? dbg("error reading from spamd (3): $!") 312 : die "error reading from spamd (3): $!"; 313 return unless defined $line; 314 315 my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); 316 317 $self->{resp_code} = $resp_code; 318 $self->{resp_msg} = $resp_msg; 319 320 return unless $resp_code == 0; 321 322 my $reported_p = 0; 323 324 for ($!=0; defined($line=<$remote>); $!=0) { 325 if ($line =~ /DidSet:\s+.*remote/i) { 326 $reported_p = 1; 327 last; 328 } 329 elsif ($line =~ /^${EOL}$/) { 330 last; 331 } 332 } 333 defined $line || $!==0 or 334 $!==EBADF ? dbg("error reading from spamd (4): $!") 335 : die "error reading from spamd (4): $!"; 336 close $remote or die "error closing socket: $!"; 337 338 return $reported_p; 339} 340 341=head2 revoke 342 343public instance (Boolean) revoke (String $msg) 344 345Description: 346This method provides the revoke interface to spamd. 347 348=cut 349 350sub revoke { 351 my ($self, $msg) = @_; 352 353 $self->_clear_errors(); 354 355 my $remote = $self->_create_connection(); 356 357 return unless $remote; 358 359 my $msgsize = length($msg.$EOL); 360 361 print $remote "TELL $PROTOVERSION$EOL"; 362 print $remote "Content-length: $msgsize$EOL"; 363 print $remote "User: $self->{username}$EOL" if defined $self->{username}; 364 print $remote "Message-class: ham$EOL"; 365 print $remote "Set: local$EOL"; 366 print $remote "Remove: remote$EOL"; 367 print $remote "$EOL"; 368 print $remote $msg; 369 print $remote "$EOL"; 370 371 $! = 0; my $line = <$remote>; 372 defined $line || $!==0 or 373 $!==EBADF ? dbg("error reading from spamd (5): $!") 374 : die "error reading from spamd (5): $!"; 375 return unless defined $line; 376 377 my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); 378 379 $self->{resp_code} = $resp_code; 380 $self->{resp_msg} = $resp_msg; 381 382 return unless $resp_code == 0; 383 384 my $revoked_p = 0; 385 386 for ($!=0; defined($line=<$remote>); $!=0) { 387 if ($line =~ /DidRemove:\s+remote/i) { 388 $revoked_p = 1; 389 last; 390 } 391 elsif ($line =~ /^${EOL}$/) { 392 last; 393 } 394 } 395 defined $line || $!==0 or 396 $!==EBADF ? dbg("error reading from spamd (6): $!") 397 : die "error reading from spamd (6): $!"; 398 close $remote or die "error closing socket: $!"; 399 400 return $revoked_p; 401} 402 403 404=head2 ping 405 406public instance (Boolean) ping () 407 408Description: 409This method performs a server ping and returns 0 or 1 depending on 410if the server responded correctly. 411 412=cut 413 414sub ping { 415 my ($self) = @_; 416 417 my $remote = $self->_create_connection(); 418 419 return 0 unless ($remote); 420 421 print $remote "PING $PROTOVERSION$EOL"; 422 print $remote "$EOL"; # bug 6187, bumps protocol version to 1.5 423 424 $! = 0; my $line = <$remote>; 425 defined $line || $!==0 or 426 $!==EBADF ? dbg("error reading from spamd (7): $!") 427 : die "error reading from spamd (7): $!"; 428 close $remote or die "error closing socket: $!"; 429 return unless defined $line; 430 431 my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); 432 return 0 unless ($resp_msg eq 'PONG'); 433 434 return 1; 435} 436 437=head1 PRIVATE METHODS 438 439=head2 _create_connection 440 441private instance (IO::Socket) _create_connection () 442 443Description: 444This method sets up a proper IO::Socket connection based on the arguments 445used when creating the client object. 446 447On failure, it sets an internal error code and returns undef. 448 449=cut 450 451sub _create_connection { 452 my ($self) = @_; 453 454 my $remote; 455 456 if ($self->{socketpath}) { 457 $remote = IO::Socket::UNIX->new( Peer => $self->{socketpath}, 458 Type => SOCK_STREAM, 459 Timeout => $self->{timeout}, 460 ); 461 } 462 else { 463 my %params = ( Proto => "tcp", 464 PeerAddr => $self->{host}, 465 PeerPort => $self->{port}, 466 Timeout => $self->{timeout}, 467 ); 468 $remote = $io_socket_module_name->new(%params); 469 } 470 471 unless ($remote) { 472 print "Failed to create connection to spamd daemon: $!\n"; 473 return; 474 } 475 476 $remote; 477} 478 479=head2 _parse_response_line 480 481private instance (@) _parse_response_line (String $line) 482 483Description: 484This method parses the initial response line/header from the server 485and returns its parts. 486 487We have this as a separate method in case we ever decide to get fancy 488with the response line. 489 490=cut 491 492sub _parse_response_line { 493 my ($self, $line) = @_; 494 495 $line =~ s/\r?\n$//; 496 return split(/\s+/, $line, 3); 497} 498 499=head2 _clear_errors 500 501private instance () _clear_errors () 502 503Description: 504This method clears out any current errors. 505 506=cut 507 508sub _clear_errors { 509 my ($self) = @_; 510 511 $self->{resp_code} = undef; 512 $self->{resp_msg} = undef; 513} 514 515=head2 _filter 516 517private instance (\%) _filter (String $msg, String $command) 518 519Description: 520Makes the actual call to the spamd server for the various filter method 521(ie PROCESS, CHECK, HEADERS, etc). The command that is passed in is 522sent to the spamd server. 523 524The return value is a hash reference containing several pieces of information, 525if available: 526 527content_length 528 529isspam 530 531score 532 533threshold 534 535message (if available) 536 537=cut 538 539sub _filter { 540 my ($self, $msg, $command) = @_; 541 542 my %data; 543 544 $self->_clear_errors(); 545 546 my $remote = $self->_create_connection(); 547 548 return 0 unless ($remote); 549 550 my $msgsize = length($msg.$EOL); 551 552 print $remote "$command $PROTOVERSION$EOL"; 553 print $remote "Content-length: $msgsize$EOL"; 554 print $remote "User: $self->{username}$EOL" if defined $self->{username}; 555 print $remote "$EOL"; 556 print $remote $msg; 557 print $remote "$EOL"; 558 559 $! = 0; my $line = <$remote>; 560 defined $line || $!==0 or 561 $!==EBADF ? dbg("error reading from spamd (8): $!") 562 : die "error reading from spamd (8): $!"; 563 return unless defined $line; 564 565 my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); 566 567 $self->{resp_code} = $resp_code; 568 $self->{resp_msg} = $resp_msg; 569 570 return unless $resp_code == 0; 571 572 for ($!=0; defined($line=<$remote>); $!=0) { 573 local($1,$2,$3); 574 if ($line =~ /Content-length: (\d+)/) { 575 $data{content_length} = $1; 576 } 577 elsif ($line =~ m!Spam: (\S+) ; (\S+) / (\S+)!) { 578 $data{isspam} = $1; 579 $data{score} = $2 + 0; 580 $data{threshold} = $3 + 0; 581 } 582 elsif ($line =~ /^${EOL}$/) { 583 last; 584 } 585 } 586 defined $line || $!==0 or 587 $!==EBADF ? dbg("error reading from spamd (9): $!") 588 : die "error reading from spamd (9): $!"; 589 590 my $return_msg; 591 for ($!=0; defined($line=<$remote>); $!=0) { 592 $return_msg .= $line; 593 } 594 defined $line || $!==0 or 595 $!==EBADF ? dbg("error reading from spamd (10): $!") 596 : die "error reading from spamd (10): $!"; 597 598 $data{message} = $return_msg if ($return_msg); 599 600 close $remote or die "error closing socket: $!"; 601 602 return \%data; 603} 604 6051; 606 607