File Coverage

lib/Sisimai/Lhost/SurfControl.pm
Criterion Covered Total %
statement 54 58 93.1
branch 26 36 72.2
condition 3 4 75.0
subroutine 6 6 100.0
pod 2 2 100.0
total 91 106 85.8


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::SurfControl;
2 20     20   5295 use parent 'Sisimai::Lhost';
  20         41  
  20         112  
3 20     20   1208 use feature ':5.10';
  20         40  
  20         1357  
4 20     20   113 use strict;
  20         40  
  20         438  
5 20     20   93 use warnings;
  20         51  
  20         15539  
6              
7 2     2 1 949 sub description { 'WebSense SurfControl' }
8             sub make {
9             # Detect an error from SurfControl
10             # @param [Hash] mhead Message headers of a bounce email
11             # @param [String] mbody Message body of a bounce email
12             # @return [Hash] Bounce data list and message/rfc822 part
13             # @return [Undef] failed to parse or the arguments are missing
14             # @since v4.1.2
15 229     229 1 687 my $class = shift;
16 229   100     688 my $mhead = shift // return undef;
17 228   50     539 my $mbody = shift // return undef;
18              
19             # X-SEF-ZeroHour-RefID: fgs=000000000
20             # X-SEF-Processed: 0_0_0_000__2010_04_29_23_34_45
21             # X-Mailer: SurfControl E-mail Filter
22 228 100       815 return undef unless $mhead->{'x-sef-processed'};
23 16 50       61 return undef unless $mhead->{'x-mailer'};
24 16 50       58 return undef unless $mhead->{'x-mailer'} eq 'SurfControl E-mail Filter';
25              
26 16         48 state $indicators = __PACKAGE__->INDICATORS;
27 16         37 state $rebackbone = qr|^Content-Type:[ ]message/rfc822|m;
28 16         38 state $startingof = { 'message' => ['Your message could not be sent.'] };
29              
30 16         338 require Sisimai::RFC1894;
31 16         84 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
32 16         70 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
33 16         84 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
34 16         38 my $readcursor = 0; # (Integer) Points the current cursor position
35 16         26 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
36 16         27 my $v = undef;
37 16         32 my $p = '';
38              
39 16         177 for my $e ( split("\n", $emailsteak->[0]) ) {
40             # Read error messages and delivery status lines from the head of the email
41             # to the previous line of the beginning of the original message.
42 272 100       391 unless( $readcursor ) {
43             # Beginning of the bounce message or message/delivery-status part
44 32 100       126 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
45 32         54 next;
46             }
47 240 50       392 next unless $readcursor & $indicators->{'deliverystatus'};
48 240 100       344 next unless length $e;
49              
50             # Your message could not be sent.
51             # A transcript of the attempts to send the message follows.
52             # The number of attempts made: 1
53             # Addressed To: kijitora@example.com
54             #
55             # Thu 29 Apr 2010 23:34:45 +0900
56             # Failed to send to identified host,
57             # kijitora@example.com: [192.0.2.5], 550 kijitora@example.com... No such user
58             # --- Message non-deliverable.
59 192         216 $v = $dscontents->[-1];
60              
61 192 100       718 if( $e =~ /\AAddressed To:[ \t]*([^ ]+?[@][^ ]+?)\z/ ) {
    100          
    100          
62             # Addressed To: kijitora@example.com
63 16 50       68 if( $v->{'recipient'} ) {
64             # There are multiple recipient addresses in the message body.
65 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
66 0         0 $v = $dscontents->[-1];
67             }
68 16         57 $v->{'recipient'} = $1;
69 16         29 $recipients++;
70              
71             } elsif( $e =~ /\A(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ \t,]/ ) {
72             # Thu 29 Apr 2010 23:34:45 +0900
73 16         40 $v->{'date'} = $e;
74              
75             } elsif( $e =~ /\A[^ ]+[@][^ ]+:[ \t]*\[(\d+[.]\d+[.]\d+[.]\d)\],[ \t]*(.+)\z/ ) {
76             # kijitora@example.com: [192.0.2.5], 550 kijitora@example.com... No such user
77 11         41 $v->{'rhost'} = $1;
78 11         34 $v->{'diagnosis'} = $2;
79              
80             } else {
81             # Fallback, parse RFC3464 headers.
82 149 100       300 if( my $f = Sisimai::RFC1894->match($e) ) {
83             # $e matched with any field defined in RFC3464
84 64 50       143 next unless my $o = Sisimai::RFC1894->field($e);
85 64 100       177 next if $o->[0] eq 'final-recipient';
86 48 50       152 next unless exists $fieldtable->{ $o->[0] };
87 48         138 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
88              
89             } else {
90             # Continued line of the value of Diagnostic-Code field
91 85 50       203 next unless index($p, 'Diagnostic-Code:') == 0;
92 0 0       0 next unless $e =~ /\A[ \t]+(.+)\z/;
93 0         0 $v->{'diagnosis'} .= ' '.$1;
94             }
95             }
96             } continue {
97             # Save the current line for the next loop
98 272         395 $p = $e;
99             }
100 16 50       66 return undef unless $recipients;
101              
102 16         134 $_->{'diagnosis'} = Sisimai::String->sweep($_->{'diagnosis'}) for @$dscontents;
103 16         117 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
104             }
105              
106             1;
107             __END__