home *** CD-ROM | disk | FTP | other *** search
/ ftp.f-secure.com / 2014.06.ftp.f-secure.com.tar / ftp.f-secure.com / support / hotfix / fsis / IS-SpamControl.fsfix / iufssc / lib / Mail / SpamAssassin / Client.pm < prev    next >
Text File  |  2006-11-29  |  10KB  |  500 lines
  1. # NOTE: This interface is alpha at best, and almost guaranteed to change
  2. # <@LICENSE>
  3. # Licensed to the Apache Software Foundation (ASF) under one or more
  4. # contributor license agreements.  See the NOTICE file distributed with
  5. # this work for additional information regarding copyright ownership.
  6. # The ASF licenses this file to you under the Apache License, Version 2.0
  7. # (the "License"); you may not use this file except in compliance with
  8. # the License.  You may obtain a copy of the License at:
  9. # 
  10. #     http://www.apache.org/licenses/LICENSE-2.0
  11. # 
  12. # Unless required by applicable law or agreed to in writing, software
  13. # distributed under the License is distributed on an "AS IS" BASIS,
  14. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  15. # See the License for the specific language governing permissions and
  16. # limitations under the License.
  17. # </@LICENSE>
  18.  
  19. =head1 NAME
  20.  
  21. Mail::SpamAssassin::Client - Client for spamd Protocol
  22.  
  23. NOTE: This interface is alpha at best, and almost guaranteed to change
  24.  
  25. =head1 SYNOPSIS
  26.  
  27.   my $client = new Mail::SpamAssassin::Client({port => 783,
  28.                                                host => 'localhost',
  29.                                                username => 'someuser'});
  30.  
  31.   if ($client->ping()) {
  32.     print "Ping is ok\n";
  33.   }
  34.  
  35.   my $result = $client->process($testmsg);
  36.  
  37.   if ($result->{isspam} eq 'True') {
  38.     do something with spam message here
  39.   }
  40.  
  41. =head1 DESCRIPTION
  42.  
  43. Mail::SpamAssassin::Client is a module that provides a perl implementation for
  44. the spamd protocol.
  45.  
  46. =cut
  47.  
  48. package Mail::SpamAssassin::Client;
  49.  
  50. use IO::Socket;
  51.  
  52. my $EOL = "\015\012";
  53. my $BLANK = $EOL x 2;
  54. my $PROTOVERSION = 'SPAMC/1.3';
  55.  
  56. =head1 PUBLIC METHODS
  57.  
  58. =head2 new
  59.  
  60. public class (Mail::SpamAssassin::Client) new (\% $args)
  61.  
  62. Description:
  63. This method creates a new Mail::SpamAssassin::Client object.
  64.  
  65. =cut
  66.  
  67. sub new {
  68.   my ($class, $args) = @_;
  69.  
  70.   $class = ref($class) || $class;
  71.  
  72.   my $self = {};
  73.  
  74.   # with a sockets_path set then it makes no sense to set host and port
  75.   if ($args->{socketpath}) {
  76.     $self->{socketpath} = $args->{socketpath};
  77.   }
  78.   else {
  79.     $self->{port} = $args->{port};
  80.     $self->{host} = $args->{host};
  81.   }
  82.  
  83.   if ($args->{username}) {
  84.     $self->{username} = $args->{username};
  85.   }
  86.  
  87.   bless($self, $class);
  88.  
  89.   $self;
  90. }
  91.  
  92. =head2 process
  93.  
  94. public instance (\%) process (String $msg, Boolean $is_check_p)
  95.  
  96. 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.
  99.  
  100. The return value is a hash reference containing several pieces of information,
  101. if available:
  102.  
  103. content_length
  104.  
  105. isspam
  106.  
  107. score
  108.  
  109. threshold
  110.  
  111. message
  112.  
  113. =cut
  114.  
  115. sub process {
  116.   my ($self, $msg, $is_check_p) = @_;
  117.  
  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;
  171. }
  172.  
  173. =head2 check
  174.  
  175. public instance (\%) check (String $msg)
  176.  
  177. Description:
  178. The method implements the check call.
  179.  
  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. See the process method for the return value.
  185.  
  186. =cut
  187.  
  188. sub check {
  189.   my ($self, $msg) = @_;
  190.  
  191.   return $self->process($msg, 1);
  192. }
  193.  
  194. =head2 learn
  195.  
  196. public instance (Boolean) learn (String $msg, Integer $learntype)
  197.  
  198. Description:
  199. This method implements the learn call.  C<$learntype> should be
  200. an integer, 0 for spam, 1 for ham and 2 for forget.  The return
  201. value is a boolean indicating if the message was learned or not.
  202.  
  203. An undef return value indicates that there was an error and you should
  204. check the resp_code/resp_msg values to determine what the error was.
  205.  
  206. =cut
  207.  
  208. sub learn {
  209.   my ($self, $msg, $learntype) = @_;
  210.  
  211.   $self->_clear_errors();
  212.  
  213.   my $remote = $self->_create_connection();
  214.  
  215.   return undef unless ($remote);
  216.  
  217.   my $msgsize = length($msg.$EOL);
  218.  
  219.   print $remote "TELL $PROTOVERSION$EOL";
  220.   print $remote "Content-length: $msgsize$EOL";
  221.   print $remote "User: $self->{username}$EOL" if ($self->{username});
  222.  
  223.   if ($learntype == 0) {
  224.     print $remote "Message-class: spam$EOL";
  225.     print $remote "Set: local$EOL";
  226.   }
  227.   elsif ($learntype == 1) {
  228.     print $remote "Message-class: ham$EOL";
  229.     print $remote "Set: local$EOL";
  230.   }
  231.   elsif ($learntype == 2) {
  232.     print $remote "Remove: local$EOL";
  233.   }
  234.   else { # bad learntype
  235.     $self->{resp_code} = 00;
  236.     $self->{resp_msg} = 'do not know';
  237.     return undef;
  238.   }
  239.  
  240.   print $remote "$EOL";
  241.   print $remote $msg;
  242.   print $remote "$EOL";
  243.  
  244.   my $line = <$remote>;
  245.   return undef unless (defined $line);
  246.  
  247.   my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
  248.  
  249.   $self->{resp_code} = $resp_code;
  250.   $self->{resp_msg} = $resp_msg;
  251.  
  252.   return undef unless ($resp_code == 0);
  253.  
  254.   my $did_set;
  255.   my $did_remove;
  256.  
  257.   while ($line = <$remote>) {
  258.     if ($line =~ /DidSet: (.*)/i) {
  259.       $did_set = $1;
  260.     }
  261.     elsif ($line =~ /DidRemove: (.*)/i) {
  262.       $did_remove = $1;
  263.     }
  264.     elsif ($line =~ /^${EOL}$/) {
  265.       last;
  266.     }
  267.   }
  268.  
  269.   close $remote;
  270.  
  271.   if ($learntype == 0 || $learntype == 1) {
  272.     return $did_set =~ /local/;
  273.   }
  274.   else { #safe since we've already checked the $learntype values
  275.     return $did_remove =~ /local/;
  276.   }
  277. }
  278.  
  279. =head2 report
  280.  
  281. public instance (Boolean) report (String $msg)
  282.  
  283. Description:
  284. This method provides the report interface to spamd.
  285.  
  286. =cut
  287.  
  288. sub report {
  289.   my ($self, $msg) = @_;
  290.  
  291.   $self->_clear_errors();
  292.  
  293.   my $remote = $self->_create_connection();
  294.  
  295.   return undef unless ($remote);
  296.  
  297.   my $msgsize = length($msg.$EOL);
  298.  
  299.   print $remote "TELL $PROTOVERSION$EOL";
  300.   print $remote "Content-length: $msgsize$EOL";
  301.   print $remote "User: $self->{username}$EOL" if ($self->{username});
  302.   print $remote "Message-class: spam$EOL";
  303.   print $remote "Set: local,remote$EOL";
  304.   print $remote "$EOL";
  305.   print $remote $msg;
  306.   print $remote "$EOL";
  307.  
  308.   my $line = <$remote>;
  309.   return undef unless (defined $line);
  310.  
  311.   my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
  312.  
  313.   $self->{resp_code} = $resp_code;
  314.   $self->{resp_msg} = $resp_msg;
  315.  
  316.   return undef unless ($resp_code == 0);
  317.  
  318.   my $reported_p = 0;
  319.  
  320.   while (($line = <$remote>)) {
  321.     if ($line =~ /DidSet:\s+.*remote/i) {
  322.       $reported_p = 1;
  323.       last;
  324.     }
  325.     elsif ($line =~ /^${EOL}$/) {
  326.       last;
  327.     }
  328.   }
  329.  
  330.   close $remote;
  331.  
  332.   return $reported_p;
  333. }
  334.  
  335. =head2 revoke
  336.  
  337. public instance (Boolean) revoke (String $msg)
  338.  
  339. Description:
  340. This method provides the revoke interface to spamd.
  341.  
  342. =cut
  343.  
  344. sub revoke {
  345.   my ($self, $msg) = @_;
  346.  
  347.   $self->_clear_errors();
  348.  
  349.   my $remote = $self->_create_connection();
  350.  
  351.   return undef unless ($remote);
  352.  
  353.   my $msgsize = length($msg.$EOL);
  354.  
  355.   print $remote "TELL $PROTOVERSION$EOL";
  356.   print $remote "Content-length: $msgsize$EOL";
  357.   print $remote "User: $self->{username}$EOL" if ($self->{username});
  358.   print $remote "Message-class: ham$EOL";
  359.   print $remote "Set: local$EOL";
  360.   print $remote "Remove: remote$EOL";
  361.   print $remote "$EOL";
  362.   print $remote $msg;
  363.   print $remote "$EOL";
  364.  
  365.   my $line = <$remote>;
  366.   return undef unless (defined $line);
  367.  
  368.   my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
  369.  
  370.   $self->{resp_code} = $resp_code;
  371.   $self->{resp_msg} = $resp_msg;
  372.  
  373.   return undef unless ($resp_code == 0);
  374.  
  375.   my $revoked_p = 0;
  376.  
  377.   while (!$revoked_p && ($line = <$remote>)) {
  378.     if ($line =~ /DidRemove:\s+remote/i) {
  379.       $revoked_p = 1;
  380.       last;
  381.     }
  382.     elsif ($line =~ /^${EOL}$/) {
  383.       last;
  384.     }
  385.   }
  386.  
  387.   close $remote;
  388.  
  389.   return $revoked_p;
  390. }
  391.  
  392.  
  393. =head2 ping
  394.  
  395. public instance (Boolean) ping ()
  396.  
  397. Description:
  398. This method performs a server ping and returns 0 or 1 depending on
  399. if the server responded correctly.
  400.  
  401. =cut
  402.  
  403. sub ping {
  404.   my ($self) = @_;
  405.  
  406.   my $remote = $self->_create_connection();
  407.  
  408.   return 0 unless ($remote);
  409.  
  410.   print $remote "PING $PROTOVERSION$EOL";
  411.   print $remote "$EOL";
  412.  
  413.   my $line = <$remote>;
  414.   close $remote;
  415.   return undef unless (defined $line);
  416.  
  417.   my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
  418.  
  419.   return 0 unless ($resp_msg =~ /^PONG/);
  420.  
  421.   return 1;
  422. }
  423.  
  424. =head1 PRIVATE METHODS
  425.  
  426. =head2 _create_connection
  427.  
  428. private instance (IO::Socket) _create_connection ()
  429.  
  430. Description:
  431. This method sets up a proper IO::Socket connection based on the arguments
  432. used when greating the client object.
  433.  
  434. On failure, it sets an internal error code and returns undef.
  435.  
  436. =cut
  437.  
  438. sub _create_connection {
  439.   my ($self) = @_;
  440.  
  441.   my $remote;
  442.  
  443.   if ($self->{socketpath}) {
  444.     $remote = IO::Socket::UNIX->new( Peer => $self->{socketpath},
  445.                      Type => SOCK_STREAM,
  446.                    );
  447.   }
  448.   else {
  449.     $remote = IO::Socket::INET->new( Proto     => "tcp",
  450.                      PeerAddr  => $self->{host},
  451.                      PeerPort  => $self->{port},
  452.                    );
  453.   }
  454.  
  455.   unless ($remote) {
  456.     print "Failed to create connection to spamd daemon: $!\n";
  457.     return undef;
  458.   }
  459.  
  460.   $remote;
  461. }
  462.  
  463. =head2 _parse_response_line
  464.  
  465. private instance (@) _parse_response_line (String $line)
  466.  
  467. Description:
  468. This method parses the initial response line/header from the server
  469. and returns its parts.
  470.  
  471. We have this as a seperate method in case we ever decide to get fancy
  472. with the response line.
  473.  
  474. =cut
  475.  
  476. sub _parse_response_line {
  477.   my ($self, $line) = @_;
  478.  
  479.   return split(/\s+/, $line, 3);
  480. }
  481.  
  482. =head2 _clear_errors
  483.  
  484. private instance () _clear_errors ()
  485.  
  486. Description:
  487. This method clears out any current errors.
  488.  
  489. =cut
  490.  
  491. sub _clear_errors {
  492.   my ($self) = @_;
  493.  
  494.   $self->{resp_code} = undef;
  495.   $self->{resp_msg} = undef;
  496. }
  497.  
  498. 1;
  499.  
  500.