File Coverage

lib/Sisimai/RFC3834.pm
Criterion Covered Total %
statement 75 75 100.0
branch 33 48 68.7
condition 4 7 57.1
subroutine 5 5 100.0
pod 2 2 100.0
total 119 137 86.8


line stmt bran cond sub pod time code
1             package Sisimai::RFC3834;
2 6     6   3823 use feature ':5.10';
  6         9  
  6         421  
3 6     6   33 use strict;
  6         8  
  6         109  
4 6     6   23 use warnings;
  6         9  
  6         5223  
5              
6             # http://tools.ietf.org/html/rfc3834
7 2     2 1 680 sub description { 'Detector for auto replied message' }
8             sub make {
9             # Detect auto reply message as RFC3834
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.28
15 31     31 1 287 my $class = shift;
16 31   100     87 my $mhead = shift // return undef;
17 30   50     66 my $mbody = shift // return undef;
18 30         53 my $leave = 0;
19 30         39 my $match = 0;
20              
21 30 50       92 return undef unless keys %$mhead;
22 30 50       73 return undef unless ref $mbody eq 'SCALAR';
23              
24 30         130 my $markingsof = { 'boundary' => qr/\A__SISIMAI_PSEUDO_BOUNDARY__\z/ };
25 30         80 state $autoreply1 = {
26             # http://www.iana.org/assignments/auto-submitted-keywords/auto-submitted-keywords.xhtml
27             'auto-submitted' => qr/\Aauto-(?:generated|replied|notified)/,
28             # https://msdn.microsoft.com/en-us/library/ee219609(v=exchg.80).aspx
29             'x-auto-response-suppress' => qr/(?:oof|autoreply)/,
30             'x-apple-action' => qr/\Avacation\z/,
31             'precedence' => qr/\Aauto_reply\z/,
32             'subject' => qr/\A(?>
33             auto:
34             |auto[ ]response:
35             |automatic[ ]reply:
36             |out[ ]of[ ](?:the[ ])*office:
37             )
38             /x,
39             };
40 30         62 state $excludings = {
41             'subject' => qr{(?:
42             security[ ]information[ ]for # sudo
43             |mail[ ]failure[ ][-] # Exim
44             )
45             }x,
46             'from' => qr/(?:root|postmaster|mailer-daemon)[@]/,
47             'to' => qr/root[@]/,
48             };
49 30         39 state $subjectset = qr{\A(?>
50             (?:.+?)?re:
51             |auto(?:[ ]response):
52             |automatic[ ]reply:
53             |out[ ]of[ ]office:
54             )
55             [ ]*(.+)\z
56             }x;
57              
58 30         99 DETECT_EXCLUSION_MESSAGE: for my $e ( keys %$excludings ) {
59             # Exclude message from root@
60 84 50       151 next unless exists $mhead->{ $e };
61 84 50       133 next unless defined $mhead->{ $e };
62 84 100       416 next unless lc($mhead->{ $e }) =~ $excludings->{ $e };
63 3         3 $leave = 1;
64 3         5 last;
65             }
66 30 100       98 return undef if $leave;
67              
68 27         87 DETECT_AUTO_REPLY_MESSAGE: for my $e ( keys %$autoreply1 ) {
69             # RFC3834 Auto-Submitted and other headers
70 82 100       134 next unless exists $mhead->{ $e };
71 32 50       64 next unless defined $mhead->{ $e };
72 32 100       198 next unless lc($mhead->{ $e }) =~ $autoreply1->{ $e };
73 21         34 $match++;
74 21         31 last;
75             }
76 27 100       81 return undef unless $match;
77              
78 21         81 require Sisimai::Lhost;
79 21         80 my $dscontents = [Sisimai::Lhost->DELIVERYSTATUS];
80 21         42 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
81 21         21 my $maxmsgline = 5; # (Integer) Max message length(lines)
82 21         22 my $haveloaded = 0; # (Integer) The number of lines loaded from message body
83 21         25 my $blanklines = 0; # (Integer) Counter for countinuous blank lines
84 21         22 my $countuntil = 1; # (Integer) Maximun value of blank lines in the body part
85 21         48 my $v = $dscontents->[-1];
86              
87             RECIPIENT_ADDRESS: {
88             # Try to get the address of the recipient
89 21         22 for my $e ('from', 'return-path') {
  21         37  
90             # Get the recipient address
91 21 50       63 next unless exists $mhead->{ $e };
92 21 50       47 next unless defined $mhead->{ $e };
93              
94 21         40 $v->{'recipient'} = $mhead->{ $e };
95 21         26 last;
96             }
97              
98 21 50       47 if( $v->{'recipient'} ) {
99             # Clean-up the recipient address
100 21         120 $v->{'recipient'} = Sisimai::Address->s3s4($v->{'recipient'});
101 21         50 $recipients++;
102             }
103             }
104 21 50       48 return undef unless $recipients;
105              
106 21 100       58 if( $mhead->{'content-type'} ) {
107             # Get the boundary string and set regular expression for matching with
108             # the boundary string.
109 15         66 my $b0 = Sisimai::MIME->boundary($mhead->{'content-type'}, 0);
110 15 50       49 $markingsof->{'boundary'} = qr/\A\Q$b0\E\z/ if length $b0;
111             }
112              
113             BODY_PARSER: {
114             # Get vacation message
115 21         33 for my $e ( split("\n", $$mbody) ) {
  21         95  
116             # Read the first 5 lines except a blank line
117 48 50       171 $countuntil += 1 if $e =~ $markingsof->{'boundary'};
118              
119 48 100       99 unless( length $e ) {
120             # Check a blank line
121 16 100       35 last if ++$blanklines > $countuntil;
122 11         16 next;
123             }
124 32 50       77 next unless rindex($e, ' ') > -1;
125 32 50       72 next if index($e, 'Content-Type') == 0;
126 32 50       71 next if index($e, 'Content-Transfer') == 0;
127              
128 32         81 $v->{'diagnosis'} .= $e.' ';
129 32         57 $haveloaded++;
130 32 50       67 last if $haveloaded >= $maxmsgline;
131             }
132 21   33     66 $v->{'diagnosis'} ||= $mhead->{'subject'};
133             }
134              
135 21         115 $v->{'diagnosis'} = Sisimai::String->sweep($v->{'diagnosis'});
136 21         38 $v->{'reason'} = 'vacation';
137 21         41 $v->{'date'} = $mhead->{'date'};
138 21         33 $v->{'status'} = '';
139              
140             # Get the Subject header from the original message
141 21 100       232 my $rfc822part = lc($mhead->{'subject'}) =~ $subjectset ? 'Subject: '.$1."\n" : '';
142 21         121 return { 'ds' => $dscontents, 'rfc822' => $rfc822part };
143             }
144              
145             1;
146             __END__