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