The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

AKXLIX / Sisimai-v4.25.17 / lib / Sisimai / Lhost / IMailServer.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
—
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157

              
package Sisimai::Lhost::IMailServer;
use parent 'Sisimai::Lhost';
use feature ':5.10';
use strict;
use warnings;
sub description { 'IPSWITCH IMail Server' }
sub make {
    # Detect an error from IMailServer
    # @param    [Hash] mhead    Message headers of a bounce email
    # @param    [String] mbody  Message body of a bounce email
    # @return   [Hash]          Bounce data list and message/rfc822 part
    # @return   [Undef]         failed to parse or the arguments are missing
    # @since v4.1.1
    my $class = shift;
    my $mhead = shift // return undef;
    my $mbody = shift // return undef;
    my $match = 0;
    # X-Mailer: <SMTP32 v8.22>
    $match ||= 1 if $mhead->{'subject'} =~ /\AUndeliverable Mail[ ]*\z/;
    $match ||= 1 if defined $mhead->{'x-mailer'} && index($mhead->{'x-mailer'}, '<SMTP32 v') == 0;
    return undef unless $match;
    state $rebackbone = qr|^Original[ ]message[ ]follows[.]|m;
    state $startingof = { 'error' => ['Body of message generated response:'] };
    state $recommands = {
        'conn' => qr/(?:SMTP connection failed,|Unexpected connection response from server:)/,
        'ehlo' => qr|Unexpected response to EHLO/HELO:|,
        'mail' => qr|Server response to MAIL FROM:|,
        'rcpt' => qr|Additional RCPT TO generated following response:|,
        'data' => qr|DATA command generated response:|,
    };
    state $refailures = {
        'hostunknown'   => qr/Unknown host/,
        'userunknown'   => qr/\A(?:Unknown user|Invalid final delivery userid)/,
        'mailboxfull'   => qr/\AUser mailbox exceeds allowed size/,
        'virusdetected' => qr/\ARequested action not taken: virus detected/,
        'undefined'     => qr/\Aundeliverable to/,
        'expired'       => qr/\ADelivery failed \d+ attempts/,
    };
    my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
    my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
    my $recipients = 0;     # (Integer) The number of 'Final-Recipient' header
    my $v = undef;
    for my $e ( split("\n", $emailsteak->[0]) ) {
        # Read error messages and delivery status lines from the head of the email
        # to the previous line of the beginning of the original message.
        # Unknown user: kijitora@example.com
        #
        # Original message follows.
        $v = $dscontents->[-1];
        if( $e =~ /\A([^ ]+)[ ](.+)[:][ \t]*([^ ]+[@][^ ]+)/ ) {
            # Unknown user: kijitora@example.com
            if( $v->{'recipient'} ) {
                # There are multiple recipient addresses in the message body.
                push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
                $v = $dscontents->[-1];
            }
            $v->{'diagnosis'} = $1.' '.$2;
            $v->{'recipient'} = $3;
            $recipients++;
        } elsif( $e =~ /\Aundeliverable[ ]+to[ ]+(.+)\z/ ) {
            # undeliverable to kijitora@example.com
            if( $v->{'recipient'} ) {
                # There are multiple recipient addresses in the message body.
                push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
                $v = $dscontents->[-1];
            }
            $v->{'recipient'} = Sisimai::Address->s3s4($1);
            $recipients++;
        } else {
            # Other error message text
            $v->{'alterrors'} //= '';
            $v->{'alterrors'}  .= ' '.$e if $v->{'alterrors'};
            $v->{'alterrors'}   = $e if index($e, $startingof->{'error'}->[0]) > -1;
        }
    }
    return undef unless $recipients;
    for my $e ( @$dscontents ) {
        if( exists $e->{'alterrors'} && $e->{'alterrors'} ) {
            # Copy alternative error message
            $e->{'diagnosis'} = $e->{'alterrors'}.' '.$e->{'diagnosis'};
            $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
            delete $e->{'alterrors'};
        }
        $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
        COMMAND: for my $r ( keys %$recommands ) {
            # Detect SMTP command from the message
            next unless $e->{'diagnosis'} =~ $recommands->{ $r };
            $e->{'command'} = uc $r;
            last;
        }
        SESSION: for my $r ( keys %$refailures ) {
            # Verify each regular expression of session errors
            next unless $e->{'diagnosis'} =~ $refailures->{ $r };
            $e->{'reason'} = $r;
            last;
        }
    }
    return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
}
1;
__END__
=encoding utf-8
=head1 NAME
Sisimai::Lhost::IMailServer - bounce mail parser class for C<IMail Server>.
=head1 SYNOPSIS
    use Sisimai::Lhost::IMailServer;
=head1 DESCRIPTION
Sisimai::Lhost::IMailServer parses a bounce email which created by
C<Ipswitch IMail Server>. Methods in the module are called from only
Sisimai::Message.
=head1 CLASS METHODS
=head2 C<B<description()>>
C<description()> returns description string of this module.
    print Sisimai::Lhost::IMailServer->description;
=head2 C<B<make(I<header data>, I<reference to body string>)>>
C<make()> method parses a bounced email and return results as a array reference.
See Sisimai::Message for more details.
=head1 AUTHOR
azumakuniyuki
=head1 COPYRIGHT
Copyright (C) 2014-2022 azumakuniyuki, All rights reserved.
=head1 LICENSE
This software is distributed under The BSD 2-Clause License.
=cut