|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
  
 
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Sisimai::Lhost::Yahoo;  | 
| 
2
 | 
21
 | 
 
 | 
 
 | 
  
21
  
 | 
 
 | 
5571
 | 
 use parent 'Sisimai::Lhost';  | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
    | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
160
 | 
    | 
| 
3
 | 
21
 | 
 
 | 
 
 | 
  
21
  
 | 
 
 | 
1172
 | 
 use feature ':5.10';  | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
33
 | 
    | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1376
 | 
    | 
| 
4
 | 
21
 | 
 
 | 
 
 | 
  
21
  
 | 
 
 | 
95
 | 
 use strict;  | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
29
 | 
    | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
374
 | 
    | 
| 
5
 | 
21
 | 
 
 | 
 
 | 
  
21
  
 | 
 
 | 
93
 | 
 use warnings;  | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
29
 | 
    | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12825
 | 
    | 
| 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
7
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
  
1
  
 | 
970
 | 
 sub description { 'Yahoo! MAIL: https://www.yahoo.com' }  | 
| 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub make {  | 
| 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Detect an error from Yahoo! MAIL  | 
| 
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.3  | 
| 
15
 | 
356
 | 
 
 | 
 
 | 
  
356
  
 | 
  
1
  
 | 
854
 | 
     my $class = shift;  | 
| 
16
 | 
356
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
800
 | 
     my $mhead = shift // return undef;  | 
| 
17
 | 
355
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
814
 | 
     my $mbody = shift // return undef;  | 
| 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # X-YMailISG: YtyUVyYWLDsbDh...  | 
| 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # X-YMail-JAS: Pb65aU4VM1mei...  | 
| 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # X-YMail-OSG: bTIbpDEVM1lHz...  | 
| 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # X-Originating-IP: [192.0.2.9]  | 
| 
23
 | 
355
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
940
 | 
     return undef unless $mhead->{'x-ymailisg'};  | 
| 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
25
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
185
 | 
     state $indicators = __PACKAGE__->INDICATORS;  | 
| 
26
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
109
 | 
     state $rebackbone = qr|^--- Below this line is a copy of the message[.]|m;  | 
| 
27
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
155
 | 
     state $startingof = { 'message' => ['Sorry, we were unable to deliver your message'] };  | 
| 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
29
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
248
 | 
     my $dscontents = [__PACKAGE__->DELIVERYSTATUS];  | 
| 
30
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
389
 | 
     my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);  | 
| 
31
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
126
 | 
     my $readcursor = 0;     # (Integer) Points the current cursor position  | 
| 
32
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
127
 | 
     my $recipients = 0;     # (Integer) The number of 'Final-Recipient' header  | 
| 
33
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
117
 | 
     my $v = undef;  | 
| 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
35
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
370
 | 
     for my $e ( split("\n", $emailsteak->[0]) ) {  | 
| 
36
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         # Read error messages and delivery status lines from the head of the email  | 
| 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         # to the previous line of the beginning of the original message.  | 
| 
38
 | 
514
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
653
 | 
         unless( $readcursor ) {  | 
| 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             # Beginning of the bounce message or message/delivery-status part  | 
| 
40
 | 
261
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
687
 | 
             $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;  | 
| 
41
 | 
261
 | 
 
 | 
 
 | 
 
 | 
 
 | 
275
 | 
             next;  | 
| 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
43
 | 
253
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
381
 | 
         next unless $readcursor & $indicators->{'deliverystatus'};  | 
| 
44
 | 
253
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
398
 | 
         next unless length $e;  | 
| 
45
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         # Sorry, we were unable to deliver your message to the following address.  | 
| 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         #  | 
| 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         # :  | 
| 
49
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         # Remote host said: 550 5.1.1 ... User Unknown [RCPT_TO]  | 
| 
50
 | 
182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
210
 | 
         $v = $dscontents->[-1];  | 
| 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
52
 | 
182
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
485
 | 
         if( $e =~ /\A[<](.+[@].+)[>]:[ \t]*\z/ ) {  | 
| 
53
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             # :  | 
| 
54
 | 
71
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
177
 | 
             if( $v->{'recipient'} ) {  | 
| 
55
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 # There are multiple recipient addresses in the message body.  | 
| 
56
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;  | 
| 
57
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                 $v = $dscontents->[-1];  | 
| 
58
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             }  | 
| 
59
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
217
 | 
             $v->{'recipient'} = $1;  | 
| 
60
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
110
 | 
             $recipients++;  | 
| 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         } else {  | 
| 
63
 | 
111
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
275
 | 
             if( index($e, 'Remote host said:') == 0 ) {  | 
| 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 # Remote host said: 550 5.1.1 ... User Unknown [RCPT_TO]  | 
| 
65
 | 
36
 | 
 
 | 
 
 | 
 
 | 
 
 | 
57
 | 
                 $v->{'diagnosis'} = $e;  | 
| 
66
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
67
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 # Get SMTP command from the value of "Remote host said:"  | 
| 
68
 | 
36
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
165
 | 
                 $v->{'command'} = $1 if $e =~ /\[([A-Z]{4}).*\]\z/;  | 
| 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             } else {  | 
| 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 # :  | 
| 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 # Remote host said:  | 
| 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 # 550 5.2.2 ... Mailbox Full  | 
| 
73
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 # [RCPT_TO]  | 
| 
74
 | 
75
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
192
 | 
                 if( $v->{'diagnosis'} eq 'Remote host said:' ) {  | 
| 
75
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     # Remote host said:  | 
| 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     # 550 5.2.2 ... Mailbox Full  | 
| 
77
 | 
20
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
64
 | 
                     if( $e =~ /\[([A-Z]{4}).*\]\z/ ) {  | 
| 
78
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         # [RCPT_TO]  | 
| 
79
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                         $v->{'command'} = $1;  | 
| 
80
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
81
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     } else {  | 
| 
82
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         # 550 5.2.2 ... Mailbox Full  | 
| 
83
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
33
 | 
                         $v->{'diagnosis'} = $e;  | 
| 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     }  | 
| 
85
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 } else {  | 
| 
86
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     # Error message which does not start with 'Remote host said:'  | 
| 
87
 | 
55
 | 
 
 | 
 
 | 
 
 | 
 
 | 
177
 | 
                     $v->{'diagnosis'} .= ' '.$e;  | 
| 
88
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 }  | 
| 
89
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             }  | 
| 
90
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
92
 | 
76
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
217
 | 
     return undef unless $recipients;  | 
| 
93
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
94
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
134
 | 
     for my $e ( @$dscontents ) {  | 
| 
95
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
140
 | 
         $e->{'diagnosis'} =~ y/\n/ /;  | 
| 
96
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
403
 | 
         $e->{'diagnosis'} =  Sisimai::String->sweep($e->{'diagnosis'});  | 
| 
97
 | 
71
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
413
 | 
         $e->{'command'} ||=  'RCPT' if $e->{'diagnosis'} =~ /[<].+[@].+[>]/;  | 
| 
98
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
99
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
309
 | 
     return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };  | 
| 
100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
101
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
102
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  | 
| 
103
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 __END__  |