File Coverage

lib/Sisimai/Lhost/V5sendmail.pm
Criterion Covered Total %
statement 89 96 92.7
branch 35 46 76.0
condition 25 33 75.7
subroutine 6 6 100.0
pod 2 2 100.0
total 157 183 85.7


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::V5sendmail;
2 34     34   4451 use parent 'Sisimai::Lhost';
  34         76  
  34         235  
3 34     34   2895 use v5.26;
  34         126  
4 34     34   213 use strict;
  34         94  
  34         1974  
5 34     34   220 use warnings;
  34         60  
  34         52400  
6              
7 1     1 1 5 sub description { 'Sendmail version 5' }
8             sub inquire {
9             # Detect an error from V5sendmail
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 decode or the arguments are missing
14             # @since v4.1.2
15 908     908 1 3966 my $class = shift;
16 908   100     2447 my $mhead = shift // return undef;
17 907   100     2486 my $mbody = shift // return undef;
18              
19 906 100       3064 return undef unless $mhead->{'subject'};
20 889 100       4210 return undef if index($mhead->{'subject'}, 'Returned mail: ') != 0;
21              
22 81         256 state $indicators = __PACKAGE__->INDICATORS;
23 81         153 state $boundaries = [' ----- Unsent message follows -----', ' ----- No message was collected -----'];
24 81         159 state $startingof = {
25             # Error text regular expressions which defined in src/savemail.c
26             # savemail.c:485| (void) fflush(stdout);
27             # savemail.c:486| p = queuename(e->e_parent, 'x');
28             # savemail.c:487| if ((xfile = fopen(p, "r")) == NULL)
29             # savemail.c:488| {
30             # savemail.c:489| syserr("Cannot open %s", p);
31             # savemail.c:490| fprintf(fp, " ----- Transcript of session is unavailable -----\n");
32             # savemail.c:491| }
33             # savemail.c:492| else
34             # savemail.c:493| {
35             # savemail.c:494| fprintf(fp, " ----- Transcript of session follows -----\n");
36             # savemail.c:495| if (e->e_xfp != NULL)
37             # savemail.c:496| (void) fflush(e->e_xfp);
38             # savemail.c:497| while (fgets(buf, sizeof buf, xfile) != NULL)
39             # savemail.c:498| putline(buf, fp, m);
40             # savemail.c:499| (void) fclose(xfile);
41             'error' => ['While talking to '],
42             'message' => ['----- Transcript of session follows -----'],
43             };
44              
45 81         519 my $emailparts = Sisimai::RFC5322->part($mbody, $boundaries);
46 81 100       457 return undef unless length $emailparts->[1] > 0;
47              
48 36         207 require Sisimai::RFC1123;
49 36         129 require Sisimai::SMTP::Command;
50 36         264 my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; my $v = undef;
  36         84  
51 36         72 my $readcursor = 0; # (Integer) Points the current cursor position
52 36         71 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
53 36         66 my $anotherone = {}; # (Ref->Hash) Another error information
54 36         74 my $remotehost = ""; # (String) The last remote hostname
55 36         72 my $curcommand = ""; # (String) The last SMTP command
56              
57 36         224 for my $e ( split("\n", $emailparts->[0]) ) {
58             # Read error messages and delivery status lines from the head of the email to the previous
59             # line of the beginning of the original message.
60 262 100       595 unless( $readcursor ) {
61             # Beginning of the bounce message or message/delivery-status part
62 36 50       262 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) > -1;
63 36         69 next;
64             }
65 226 50 33     1165 next if ($readcursor & $indicators->{'deliverystatus'}) == 0 || $e eq "";
66              
67             # ----- Transcript of session follows -----
68             # While talking to smtp.example.com:
69             # >>> RCPT To:
70             # <<< 550 , User Unknown
71             # 550 ... User unknown
72             # 421 example.org (smtp)... Deferred: Connection timed out during user open with example.org
73 226         343 $v = $dscontents->[-1];
74 226 100       858 $curcommand = Sisimai::SMTP::Command->find(substr($e, 4,)) if index($e, ">>> ") == 0;
75              
76 226 100 100     1196 if( Sisimai::String->aligned(\$e, [' <', '@', '>...']) || index(uc $e, ">>> RCPT TO:") > -1 ) {
77             # 550 ... User unknown
78             # >>> RCPT To:
79 85         167 my $p0 = index($e, " ");
80 85         185 my $p1 = index($e, "<", $p0);
81 85         142 my $p2 = index($e, ">", $p1);
82 85         536 my $cv = Sisimai::Address->s3s4(substr($e, $p1, $p2 - $p1 + 1));
83              
84 85 100       357 if( $remotehost eq "" ) {
85             # Keep error messages before "While talking to ..." line
86 15         45 $anotherone->{ $recipients } .= " ".$e;
87 15         65 next;
88             }
89              
90 70 100 100     444 if( $cv eq $v->{"recipient"} || ($curcommand eq "MAIL" && index($e, "<<< ") == 0) ) {
      100        
91             # The recipient address is the same address with the last appeared address
92             # like "550 ... User unknown"
93             # Append this line to the string which is keeping error messages
94 25         82 $v->{"diagnosis"} .= " ".$e;
95 25         123 $v->{"replycode"} = Sisimai::SMTP::Reply->find($e);
96 25         89 $curcommand = "";
97              
98             } else {
99             # The recipient address in this line differs from the last appeared address
100             # or is the first recipient address in this bounce message
101 45 100       128 if( $v->{'recipient'} ) {
102             # There are multiple recipient addresses in the message body.
103 25         156 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
104 25         87 $v = $dscontents->[-1];
105             }
106 45         122 $v->{"recipient"} = $cv;
107 45         77 $v->{"rhost"} = $remotehost;
108 45         262 $v->{"replycode"} = Sisimai::SMTP::Reply->find($e);
109 45         161 $v->{"diagnosis"} .= " ".$e;
110 45   66     312 $v->{"command"} ||= $curcommand;
111 45         152 $recipients++
112             }
113             } else {
114             # This line does not include a recipient address
115 141 100       764 if( index($e, $startingof->{"error"}->[0]) > -1 ) {
116             # ... while talking to mta.example.org.:
117 35         220 my $cv = Sisimai::RFC1123->find($e);
118 35 50       169 $remotehost = $cv if Sisimai::RFC1123->is_internethost($cv);
119              
120             } else {
121             # Append this line into the error message string
122 106 100 100     418 if( index($e, ">>> ") == 0 || index($e, "<<< ") == 0 ) {
123             # >>> DATA
124             # <<< 550 Your E-Mail is redundant. You cannot send E-Mail to yourself (shironeko@example.jp).
125             # >>> QUIT
126             # <<< 421 dns.example.org Sorry, unable to contact destination SMTP daemon.
127             # <<< 550 Requested User Mailbox not found. No such user here.
128 45         219 $v->{"diagnosis"} .= " ".$e
129              
130             } else {
131             # 421 Other error message
132 61         393 $anotherone->{ $recipients } .= " ".$e;
133             }
134             }
135             }
136             }
137              
138 36 100       234 if( $recipients == 0 ) {
139             # There is no recipient address in the error message
140 16         53 for my $e ( keys %$anotherone ) {
141             # Try to pick an recipient address, a reply code, and error messages
142 16 100       82 my $cv = Sisimai::Address->s3s4($anotherone->{ $e }); next unless Sisimai::Address->is_emailaddress($cv);
  16         79  
143 10   50     131 my $cr = Sisimai::SMTP::Reply->find($anotherone->{ $e }) || "";
144              
145 10         61 $dscontents->[ $e ]->{"recipient"} = $cv;
146 10         25 $dscontents->[ $e ]->{"replycode"} = $cr;
147 10         24 $dscontents->[ $e ]->{"diagnosis"} = $anotherone->{ $e };
148 10         23 $recipients++;
149             }
150              
151 16 100       81 if( $recipients == 0 ) {
152             # Try to pick an recipient address from the original message
153 6         40 my $p1 = index($emailparts->[1], "\nTo: ");
154 6         16 my $p2 = index($emailparts->[1], "\n", $p1 + 6);
155              
156 6 50       22 if( $p1 > 0 ) {
157             # Get the recipient address from "To:" header at the original message
158 6         38 my $cv = Sisimai::Address->s3s4(substr($emailparts->[1], $p1, $p2 - $p1 - 5));
159 6 50       46 return undef unless Sisimai::Address->is_emailaddress($cv);
160 0         0 $dscontents->[0]->{'recipient'} = $cv;
161 0         0 $recipients++;
162             }
163             }
164             }
165 30 50       98 return undef unless $recipients;
166              
167 30         68 my $j = 0; for my $e ( @$dscontents ) {
  30         136  
168             # Tidy up the error message in e.Diagnosis
169 55   33     166 $e->{"diagnosis"} ||= $anotherone->{ $j };
170 55         254 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
171 55   100     270 $e->{"command"} ||= Sisimai::SMTP::Command->find($e->{"diagnosis"});
172 55   33     197 $e->{'replycode'} = Sisimai::SMTP::Reply->find($e->{'diagnosis'}) || $anotherone->{'replycode'};
173              
174             # @example.jp, no local part
175             # Get email address from the value of Diagnostic-Code header
176 55 50       229 next if index($e->{'recipient'}, '@') > 0;
177 0 0       0 my $p1 = index($e->{'diagnosis'}, '<'); next if $p1 == -1;
  0         0  
178 0 0       0 my $p2 = index($e->{'diagnosis'}, '>'); next if $p2 == -1;
  0         0  
179 0         0 $e->{'recipient'} = Sisimai::Address->s3s4(substr($e->{'diagnosis'}, $p1, $p2 - $p1));
180             }
181 30         270 return {"ds" => $dscontents, "rfc822" => $emailparts->[1]};
182             }
183              
184             1;
185             __END__