← Back to branch summary

~ubuntu-branches/ubuntu/utopic/spamassassin/utopic-proposed

« back to all changes in this revision

Viewing changes to lib/Mail/SpamAssassin/Client.pm

  • Committer: Bazaar Package Importer
  • Author(s): Noah Meyerhans
  • Date: 2010-01-26 22:53:12 UTC
  • mfrom: (1.1.13 upstream) (5.1.7 sid)
  • Revision ID: james.westby@ubuntu.com-20100126225312-wkftb10idc1kz2aq
Tags: 3.3.0-1
* New upstream version.
* Switch to dpkg-source 3.0 (quilt) format

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Mail/SpamAssassin/Client.pm
1
 
# NOTE: This interface is alpha at best, and almost guaranteed to change
2
1
# <@LICENSE>
3
2
# Licensed to the Apache Software Foundation (ASF) under one or more
4
3
# contributor license agreements.  See the NOTICE file distributed with
20
19
 
21
20
Mail::SpamAssassin::Client - Client for spamd Protocol
22
21
 
23
 
NOTE: This interface is alpha at best, and almost guaranteed to change
24
 
 
25
22
=head1 SYNOPSIS
26
23
 
27
 
  my $client = new Mail::SpamAssassin::Client({port => 783,
28
 
                                               host => 'localhost',
29
 
                                               username => 'someuser'});
 
24
  my $client = new Mail::SpamAssassin::Client({
 
25
                                port => 783,
 
26
                                host => 'localhost',
 
27
                                username => 'someuser'});
 
28
  or
 
29
 
 
30
  my $client = new Mail::SpamAssassin::Client({
 
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.
30
36
 
31
37
  if ($client->ping()) {
32
38
    print "Ping is ok\n";
40
46
 
41
47
=head1 DESCRIPTION
42
48
 
43
 
Mail::SpamAssassin::Client is a module that provides a perl implementation for
 
49
Mail::SpamAssassin::Client is a module which provides a perl implementation of
44
50
the spamd protocol.
45
51
 
46
52
=cut
47
53
 
48
54
package Mail::SpamAssassin::Client;
49
55
 
 
56
use strict;
 
57
use warnings;
 
58
use re 'taint';
 
59
 
50
60
use IO::Socket;
 
61
use Errno qw(EBADF);
51
62
 
52
63
my $EOL = "\015\012";
53
64
my $BLANK = $EOL x 2;
54
 
my $PROTOVERSION = 'SPAMC/1.3';
 
65
my $PROTOVERSION = 'SPAMC/1.5';
55
66
 
56
67
=head1 PUBLIC METHODS
57
68
 
80
91
    $self->{host} = $args->{host};
81
92
  }
82
93
 
83
 
  if ($args->{username}) {
 
94
  if (defined $args->{username}) {
84
95
    $self->{username} = $args->{username};
85
96
  }
86
97
 
 
98
  if ($args->{timeout}) {
 
99
    $self->{timeout} = $args->{timeout} || 30;
 
100
  }
 
101
 
87
102
  bless($self, $class);
88
103
 
89
104
  $self;
91
106
 
92
107
=head2 process
93
108
 
94
 
public instance (\%) process (String $msg, Boolean $is_check_p)
 
109
public instance (\%) process (String $msg)
95
110
 
96
111
Description:
97
 
This method makes a call to the spamd server and depending on the value of
98
 
C<$is_check_p> either calls PROCESS or CHECK.
 
112
This method calls the spamd server with the PROCESS command.
99
113
 
100
114
The return value is a hash reference containing several pieces of information,
101
115
if available:
115
129
sub process {
116
130
  my ($self, $msg, $is_check_p) = @_;
117
131
 
118
 
  my %data;
119
 
 
120
 
  my $command = $is_check_p ? 'CHECK' : 'PROCESS';
121
 
 
122
 
  $self->_clear_errors();
123
 
 
124
 
  my $remote = $self->_create_connection();
125
 
 
126
 
  return 0 unless ($remote);
127
 
 
128
 
  my $msgsize = length($msg.$EOL);
129
 
 
130
 
  print $remote "$command $PROTOVERSION$EOL";
131
 
  print $remote "Content-length: $msgsize$EOL";
132
 
  print $remote "User: $self->{username}$EOL" if ($self->{username});
133
 
  print $remote "$EOL";
134
 
  print $remote $msg;
135
 
  print $remote "$EOL";
136
 
 
137
 
  my $line = <$remote>;
138
 
  return undef unless (defined $line);
139
 
 
140
 
  my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
141
 
 
142
 
  $self->{resp_code} = $resp_code;
143
 
  $self->{resp_msg} = $resp_msg;
144
 
 
145
 
  return undef unless ($resp_code == 0);
146
 
 
147
 
  while ($line = <$remote>) {
148
 
    if ($line =~ /Content-length: (\d+)/) {
149
 
      $data{content_length} = $1;
150
 
    }
151
 
    elsif ($line =~ m!Spam: (\S+) ; (\S+) / (\S+)!) {
152
 
      $data{isspam} = $1;
153
 
      $data{score} = $2 + 0;
154
 
      $data{threshold} = $3 + 0;
155
 
    }
156
 
    elsif ($line =~ /^${EOL}$/) {
157
 
      last;
158
 
    }
159
 
  }
160
 
 
161
 
  my $return_msg;
162
 
  while(<$remote>) {
163
 
    $return_msg .= $_;
164
 
  }
165
 
 
166
 
  $data{message} = $return_msg if ($return_msg);
167
 
 
168
 
  close $remote;
169
 
 
170
 
  return \%data;
 
132
  my $command = 'PROCESS';
 
133
 
 
134
  if ($is_check_p) {
 
135
    warn "Passing in \$is_check_p is deprecated, just call the check method instead.\n";
 
136
    $command = 'CHECK';
 
137
  }
 
138
 
 
139
  return $self->_filter($msg, $command);
171
140
}
172
141
 
173
142
=head2 check
177
146
Description:
178
147
The method implements the check call.
179
148
 
180
 
Since check and process are so similar, we simply pass this
181
 
call along to the process method with a flag to indicate
182
 
to actually make the CHECK call.
183
 
 
184
149
See the process method for the return value.
185
150
 
186
151
=cut
188
153
sub check {
189
154
  my ($self, $msg) = @_;
190
155
 
191
 
  return $self->process($msg, 1);
 
156
  return $self->_filter($msg, 'CHECK');
 
157
}
 
158
 
 
159
=head2 headers
 
160
 
 
161
public instance (\%) headers (String $msg)
 
162
 
 
163
Description:
 
164
This method implements the headers call.
 
165
 
 
166
See the process method for the return value.
 
167
 
 
168
=cut
 
169
 
 
170
sub headers {
 
171
  my ($self, $msg) = @_;
 
172
 
 
173
  return $self->_filter($msg, 'HEADERS');
192
174
}
193
175
 
194
176
=head2 learn
219
201
 
220
202
  print $remote "TELL $PROTOVERSION$EOL";
221
203
  print $remote "Content-length: $msgsize$EOL";
222
 
  print $remote "User: $self->{username}$EOL" if ($self->{username});
 
204
  print $remote "User: $self->{username}$EOL" if defined $self->{username};
223
205
 
224
206
  if ($learntype == 0) {
225
207
    print $remote "Message-class: spam$EOL";
242
224
  print $remote $msg;
243
225
  print $remote "$EOL";
244
226
 
245
 
  my $line = <$remote>;
 
227
  $! = 0; my $line = <$remote>;
 
228
  # deal gracefully with a Perl I/O bug which may return status EBADF at eof
 
229
  defined $line || $!==0  or
 
230
    $!==EBADF ? dbg("error reading from spamd (1): $!")
 
231
              : die "error reading from spamd (1): $!";
246
232
  return undef unless (defined $line);
247
233
 
248
234
  my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
252
238
 
253
239
  return undef unless ($resp_code == 0);
254
240
 
255
 
  my $did_set;
256
 
  my $did_remove;
 
241
  my $did_set = '';
 
242
  my $did_remove = '';
257
243
 
258
 
  while ($line = <$remote>) {
 
244
  for ($!=0; defined($line=<$remote>); $!=0) {
 
245
    local $1;
259
246
    if ($line =~ /DidSet: (.*)/i) {
260
247
      $did_set = $1;
261
248
    }
266
253
      last;
267
254
    }
268
255
  }
269
 
 
270
 
  close $remote;
 
256
  defined $line || $!==0  or
 
257
    $!==EBADF ? dbg("error reading from spamd (2): $!")
 
258
              : die "error reading from spamd (2): $!";
 
259
  close $remote  or die "error closing socket: $!";
271
260
 
272
261
  if ($learntype == 0 || $learntype == 1) {
273
262
    return $did_set =~ /local/;
299
288
 
300
289
  print $remote "TELL $PROTOVERSION$EOL";
301
290
  print $remote "Content-length: $msgsize$EOL";
302
 
  print $remote "User: $self->{username}$EOL" if ($self->{username});
 
291
  print $remote "User: $self->{username}$EOL" if defined $self->{username};
303
292
  print $remote "Message-class: spam$EOL";
304
293
  print $remote "Set: local,remote$EOL";
305
294
  print $remote "$EOL";
306
295
  print $remote $msg;
307
296
  print $remote "$EOL";
308
297
 
309
 
  my $line = <$remote>;
 
298
  $! = 0; my $line = <$remote>;
 
299
  defined $line || $!==0  or
 
300
    $!==EBADF ? dbg("error reading from spamd (3): $!")
 
301
              : die "error reading from spamd (3): $!";
310
302
  return undef unless (defined $line);
311
303
 
312
304
  my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
318
310
 
319
311
  my $reported_p = 0;
320
312
 
321
 
  while (($line = <$remote>)) {
 
313
  for ($!=0; defined($line=<$remote>); $!=0) {
322
314
    if ($line =~ /DidSet:\s+.*remote/i) {
323
315
      $reported_p = 1;
324
316
      last;
327
319
      last;
328
320
    }
329
321
  }
330
 
 
331
 
  close $remote;
 
322
  defined $line || $!==0  or
 
323
    $!==EBADF ? dbg("error reading from spamd (4): $!")
 
324
              : die "error reading from spamd (4): $!";
 
325
  close $remote  or die "error closing socket: $!";
332
326
 
333
327
  return $reported_p;
334
328
}
355
349
 
356
350
  print $remote "TELL $PROTOVERSION$EOL";
357
351
  print $remote "Content-length: $msgsize$EOL";
358
 
  print $remote "User: $self->{username}$EOL" if ($self->{username});
 
352
  print $remote "User: $self->{username}$EOL" if defined $self->{username};
359
353
  print $remote "Message-class: ham$EOL";
360
354
  print $remote "Set: local$EOL";
361
355
  print $remote "Remove: remote$EOL";
363
357
  print $remote $msg;
364
358
  print $remote "$EOL";
365
359
 
366
 
  my $line = <$remote>;
 
360
  $! = 0; my $line = <$remote>;
 
361
  defined $line || $!==0  or
 
362
    $!==EBADF ? dbg("error reading from spamd (5): $!")
 
363
              : die "error reading from spamd (5): $!";
367
364
  return undef unless (defined $line);
368
365
 
369
366
  my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
375
372
 
376
373
  my $revoked_p = 0;
377
374
 
378
 
  while (!$revoked_p && ($line = <$remote>)) {
 
375
  for ($!=0; defined($line=<$remote>); $!=0) {
379
376
    if ($line =~ /DidRemove:\s+remote/i) {
380
377
      $revoked_p = 1;
381
378
      last;
384
381
      last;
385
382
    }
386
383
  }
387
 
 
388
 
  close $remote;
 
384
  defined $line || $!==0  or
 
385
    $!==EBADF ? dbg("error reading from spamd (6): $!")
 
386
              : die "error reading from spamd (6): $!";
 
387
  close $remote  or die "error closing socket: $!";
389
388
 
390
389
  return $revoked_p;
391
390
}
409
408
  return 0 unless ($remote);
410
409
 
411
410
  print $remote "PING $PROTOVERSION$EOL";
412
 
  print $remote "$EOL";
 
411
  print $remote "$EOL";  # bug 6187, bumps protocol version to 1.5
413
412
 
414
 
  my $line = <$remote>;
415
 
  close $remote;
 
413
  $! = 0; my $line = <$remote>;
 
414
  defined $line || $!==0  or
 
415
    $!==EBADF ? dbg("error reading from spamd (7): $!")
 
416
              : die "error reading from spamd (7): $!";
 
417
  close $remote  or die "error closing socket: $!";
416
418
  return undef unless (defined $line);
417
419
 
418
420
  my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
429
431
 
430
432
Description:
431
433
This method sets up a proper IO::Socket connection based on the arguments
432
 
used when greating the client object.
 
434
used when creating the client object.
433
435
 
434
436
On failure, it sets an internal error code and returns undef.
435
437
 
443
445
  if ($self->{socketpath}) {
444
446
    $remote = IO::Socket::UNIX->new( Peer => $self->{socketpath},
445
447
                                     Type => SOCK_STREAM,
 
448
                                     Timeout => $self->{timeout},
446
449
                                   );
447
450
  }
448
451
  else {
449
452
    $remote = IO::Socket::INET->new( Proto     => "tcp",
450
453
                                     PeerAddr  => $self->{host},
451
454
                                     PeerPort  => $self->{port},
 
455
                                     Timeout   => $self->{timeout},
452
456
                                   );
453
457
  }
454
458
 
468
472
This method parses the initial response line/header from the server
469
473
and returns its parts.
470
474
 
471
 
We have this as a seperate method in case we ever decide to get fancy
 
475
We have this as a separate method in case we ever decide to get fancy
472
476
with the response line.
473
477
 
474
478
=cut
496
500
  $self->{resp_msg} = undef;
497
501
}
498
502
 
 
503
=head2 _filter
 
504
 
 
505
private instance (\%) _filter (String $msg, String $command)
 
506
 
 
507
Description:
 
508
Makes the actual call to the spamd server for the various filter method
 
509
(ie PROCESS, CHECK, HEADERS, etc).  The command that is passed in is
 
510
sent to the spamd server.
 
511
 
 
512
The return value is a hash reference containing several pieces of information,
 
513
if available:
 
514
 
 
515
content_length
 
516
 
 
517
isspam
 
518
 
 
519
score
 
520
 
 
521
threshold
 
522
 
 
523
message (if available)
 
524
 
 
525
=cut
 
526
 
 
527
sub _filter {
 
528
  my ($self, $msg, $command) = @_;
 
529
 
 
530
  my %data;
 
531
 
 
532
  $self->_clear_errors();
 
533
 
 
534
  my $remote = $self->_create_connection();
 
535
 
 
536
  return 0 unless ($remote);
 
537
 
 
538
  my $msgsize = length($msg.$EOL);
 
539
 
 
540
  print $remote "$command $PROTOVERSION$EOL";
 
541
  print $remote "Content-length: $msgsize$EOL";
 
542
  print $remote "User: $self->{username}$EOL" if defined $self->{username};
 
543
  print $remote "$EOL";
 
544
  print $remote $msg;
 
545
  print $remote "$EOL";
 
546
 
 
547
  $! = 0; my $line = <$remote>;
 
548
  defined $line || $!==0  or
 
549
    $!==EBADF ? dbg("error reading from spamd (8): $!")
 
550
              : die "error reading from spamd (8): $!";
 
551
  return undef unless (defined $line);
 
552
 
 
553
  my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
 
554
  
 
555
  $self->{resp_code} = $resp_code;
 
556
  $self->{resp_msg} = $resp_msg;
 
557
 
 
558
  return undef unless ($resp_code == 0);
 
559
 
 
560
  for ($!=0; defined($line=<$remote>); $!=0) {
 
561
    local($1,$2,$3);
 
562
    if ($line =~ /Content-length: (\d+)/) {
 
563
      $data{content_length} = $1;
 
564
    }
 
565
    elsif ($line =~ m!Spam: (\S+) ; (\S+) / (\S+)!) {
 
566
      $data{isspam} = $1;
 
567
      $data{score} = $2 + 0;
 
568
      $data{threshold} = $3 + 0;
 
569
    }
 
570
    elsif ($line =~ /^${EOL}$/) {
 
571
      last;
 
572
    }
 
573
  }
 
574
  defined $line || $!==0  or
 
575
    $!==EBADF ? dbg("error reading from spamd (9): $!")
 
576
              : die "error reading from spamd (9): $!";
 
577
 
 
578
  my $return_msg;
 
579
  for ($!=0; defined($line=<$remote>); $!=0) {
 
580
    $return_msg .= $line;
 
581
  }
 
582
  defined $line || $!==0  or
 
583
    $!==EBADF ? dbg("error reading from spamd (10): $!")
 
584
              : die "error reading from spamd (10): $!";
 
585
 
 
586
  $data{message} = $return_msg if ($return_msg);
 
587
 
 
588
  close $remote  or die "error closing socket: $!";
 
589
 
 
590
  return \%data;
 
591
}
 
592
 
499
593
1;
500
594