andre/scripts
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

init III

Browse Source
This commit is contained in:
Andre Geißler
2024-10-14 00:08:40 +02:00
parent dbfba56f66
commit 1462d52e13
4572 changed files with 2658864 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

332
Perl OTRS/Kernel/cpan-lib/Sisimai/RFC5322.pm Normal file
View File

@@ -0,0 +1,332 @@
package Sisimai::RFC5322;
use feature ':5.10';
use strict;
use warnings;
# Regular expression of valid RFC-5322 email address(<addr-spec>)
my $Re = { 'rfc5322' => undef, 'ignored' => undef, 'domain' => undef, };
BUILD_REGULAR_EXPRESSIONS: {
# See http://www.ietf.org/rfc/rfc5322.txt
# or http://www.ex-parrot.com/pdw/Mail-RFC822-Address.html ...
# addr-spec = local-part "@" domain
# local-part = dot-atom / quoted-string / obs-local-part
# domain = dot-atom / domain-literal / obs-domain
# domain-literal = [CFWS] "[" *([FWS] dcontent) [FWS] "]" [CFWS]
# dcontent = dtext / quoted-pair
# dtext = NO-WS-CTL / ; Non white space controls
# %d33-90 / ; The rest of the US-ASCII
# %d94-126 ; characters not including "[",
# ; "]", or "\"
my $atom = qr;[a-zA-Z0-9_!#\$\%&'*+/=?\^`{}~|\-]+;o;
my $quoted_string = qr/"(?:\\[^\r\n]|[^\\"])*"/o;
my $domain_literal = qr/\[(?:\\[\x01-\x09\x0B-\x0c\x0e-\x7f]|[\x21-\x5a\x5e-\x7e])*\]/o;
my $dot_atom = qr/$atom(?:[.]$atom)*/o;
my $local_part = qr/(?:$dot_atom|$quoted_string)/o;
my $domain = qr/(?:$dot_atom|$domain_literal)/o;
$Re->{'rfc5322'} = qr/\A$local_part[@]$domain\z/o;
$Re->{'ignored'} = qr/\A$local_part[.]*[@]$domain\z/o;
$Re->{'domain'} = qr/\A$domain\z/o;
}
my $LONGHEADERS = __PACKAGE__->LONGFIELDS;
my $HEADERINDEX = {};
my $HEADERTABLE = {
'messageid' => ['Message-Id'],
'subject' => ['Subject'],
'listid' => ['List-Id'],
'date' => [qw|Date Posted-Date Posted Resent-Date|],
'addresser' => [qw|From Return-Path Reply-To Errors-To Reverse-Path X-Postfix-Sender Envelope-From X-Envelope-From|],
'recipient' => [qw|To Delivered-To Forward-Path Envelope-To X-Envelope-To Resent-To Apparently-To|],
};
BUILD_FLATTEN_RFC822HEADER_LIST: {
# Convert $HEADER: hash reference to flatten hash reference for being
# called from Sisimai::Bite::Email::*
for my $v ( values %$HEADERTABLE ) {
$HEADERINDEX->{ lc $_ } = 1 for @$v;
}
}
sub HEADERFIELDS {
# Grouped RFC822 headers
# @param [String] group RFC822 Header group name
# @return [Array,Hash] RFC822 Header list
my $class = shift;
my $group = shift || return $HEADERINDEX;
return $HEADERTABLE->{ $group } if exists $HEADERTABLE->{ $group };
return $HEADERTABLE;
}
sub LONGFIELDS {
# Fields that might be long
# @return [Hash] Long filed(email header) list
return { 'to' => 1, 'from' => 1, 'subject' => 1, 'message-id' => 1 };
}
sub is_emailaddress {
# Check that the argument is an email address or not
# @param [String] email Email address string
# @return [Integer] 0: Not email address
# 1: Email address
my $class = shift;
my $email = shift // return 0;
return 0 if $email =~ /(?:[\x00-\x1f]|\x1f)/;
return 0 if length $email > 254;
return 1 if $email =~ $Re->{'ignored'};
return 0;
}
sub is_domainpart {
# Check that the argument is an domain part of email address or not
# @param [String] dpart Domain part of the email address
# @return [Integer] 0: Not domain part
# 1: Valid domain part
my $class = shift;
my $dpart = shift // return 0;
return 0 if $dpart =~ /(?:[\x00-\x1f]|\x1f)/;
return 0 if rindex($dpart, '@') > -1;
return 1 if $dpart =~ $Re->{'domain'};
return 0;
}
sub is_mailerdaemon {
# Check that the argument is mailer-daemon or not
# @param [String] email Email address
# @return [Integer] 0: Not mailer-daemon
# 1: Mailer-daemon
my $class = shift;
my $email = shift // return 0;
my $rxmds = qr{(?>
(?:mailer-daemon|postmaster)[@]
|[<(](?:mailer-daemon|postmaster)[)>]
|\A(?:mailer-daemon|postmaster)\z
|[ ]?mailer-daemon[ ]
)
}x;
return 1 if lc($email) =~ $rxmds;
return 0;
}
sub received {
# Convert Received headers to a structured data
# @param [String] argv1 Received header
# @return [Array] Received header as a structured data
my $class = shift;
my $argv1 = shift || return [];
my $hosts = [];
my $value = { 'from' => '', 'by' => '' };
# Received: (qmail 10000 invoked by uid 999); 24 Apr 2013 00:00:00 +0900
return [] if $argv1 =~ /qmail[ \t]+.+invoked[ \t]+/;
if( $argv1 =~ /\Afrom[ \t]+(.+)[ \t]+by[ \t]+([^ ]+)/ ) {
# Received: from localhost (localhost)
# by nijo.example.jp (V8/cf) id s1QB5ma0018057;
# Wed, 26 Feb 2014 06:05:48 -0500
$value->{'from'} = $1;
$value->{'by'} = $2;
} elsif( $argv1 =~ /\bby[ \t]+([^ ]+)(.+)/ ) {
# Received: by 10.70.22.98 with SMTP id c2mr1838265pdf.3; Fri, 18 Jul 2014
# 00:31:02 -0700 (PDT)
$value->{'from'} = $1.$2;
$value->{'by'} = $1;
}
if( $value->{'from'} =~ / / ) {
# Received: from [10.22.22.222] (smtp-gateway.kyoto.ocn.ne.jp [192.0.2.222])
# (authenticated bits=0)
# by nijo.example.jp (V8/cf) with ESMTP id s1QB5ka0018055;
# Wed, 26 Feb 2014 06:05:47 -0500
my @received = split(' ', $value->{'from'});
my @namelist = ();
my @addrlist = ();
my $hostname = '';
my $hostaddr = '';
while( my $e = shift @received ) {
# Received: from [10.22.22.222] (smtp-gateway.kyoto.ocn.ne.jp [192.0.2.222])
if( $e =~ /\A[(\[]\d+[.]\d+[.]\d+[.]\d+[)\]]\z/ ) {
# [192.0.2.1] or (192.0.2.1)
$e =~ y/[]()//d;
push @addrlist, $e;
} else {
# hostname
$e =~ y/()//d;
push @namelist, $e;
}
}
while( my $e = shift @namelist ) {
# 1. Hostname takes priority over all other IP addresses
next unless rindex($e, '.') > -1;
$hostname = $e;
last;
}
unless( $hostname ) {
# 2. Use IP address as a remote host name
for my $e ( @addrlist ) {
# Skip if the address is a private address
next if index($e, '10.') == 0;
next if index($e, '127.') == 0;
next if index($e, '192.168.') == 0;
next if $e =~ /\A172[.](?:1[6-9]|2[0-9]|3[0-1])[.]/;
$hostaddr = $e;
last;
}
}
$value->{'from'} = $hostname || $hostaddr || $addrlist[-1];
}
for my $e ('from', 'by') {
# Copy entries into $hosts
next unless defined $value->{ $e };
$value->{ $e } =~ y/()[];?//d;
push @$hosts, $value->{ $e };
}
return $hosts;
}
sub weedout {
# Weed out rfc822/message header fields excepct necessary fields
# @param [Array] argv1 each line divided message/rc822 part
# @return [String] Selected fields
my $class = shift;
my $argv1 = shift // return undef;
return undef unless ref $argv1 eq 'ARRAY';
my $rfc822next = { 'from' => 0, 'to' => 0, 'subject' => 0 };
my $rfc822part = ''; # (String) message/rfc822-headers part
my $previousfn = ''; # (String) Previous field name
for my $e ( @$argv1 ) {
# After "message/rfc822"
if( $e =~ /\A([-0-9A-Za-z]+?)[:][ ]*.*/ ) {
# Get required headers
my $lhs = lc $1;
$previousfn = '';
next unless exists $HEADERINDEX->{ $lhs };
$previousfn = $lhs;
$rfc822part .= $e."\n";
} elsif( $e =~ /\A[ \t]+/ ) {
# Continued line from the previous line
next if $rfc822next->{ $previousfn };
$rfc822part .= $e."\n" if exists $LONGHEADERS->{ $previousfn };
} else {
# Check the end of headers in rfc822 part
next unless exists $LONGHEADERS->{ $previousfn };
next if length $e;
$rfc822next->{ $previousfn } = 1;
}
}
return \$rfc822part;
}
1;
__END__
=encoding utf-8
=head1 NAME
Sisimai::RFC5322 - Email address related utilities
=head1 SYNOPSIS
use Sisimai::RFC5322;
print Sisimai::RFC5322->is_emailaddress('neko@example.jp'); # 1
print Sisimai::RFC5322->is_domainpart('example.jp'); # 1
print Sisimai::RFC5322->is_mailerdaemon('neko@example.jp'); # 0
=head1 DESCRIPTION
Sisimai::RFC5322 provide methods for checking email address.
=head1 CLASS METHODS
=head2 C<B<is_emailaddress(I<email address>)>>
C<is_emailaddress()> checks the argument is valid email address or not.
print Sisimai::RFC5322->is_emailaddress('neko@example.jp'); # 1
print Sisimai::RFC5322->is_emailaddress('neko%example.jp'); # 0
my $addr_with_name = [
'Stray cat <neko@example.jp',
'=?UTF-8?B?55m954yr?= <shironeko@example.co.jp>',
];
for my $e ( @$addr_with_name ) {
print Sisimai::RFC5322->is_emailaddress($e); # 1
}
=head2 C<B<is_domainpart(I<Domain>)>>
C<is_domainpart()> checks the argument is valid domain part of an email address
or not.
print Sisimai::RFC5322->is_domainpart('neko@example.jp'); # 0
print Sisimai::RFC5322->is_domainpart('neko.example.jp'); # 1
=head2 C<B<is_domainpart(I<Domain>)>>
C<is_mailerdaemon()> checks the argument is mailer-daemon or not.
print Sisimai::RFC5322->is_mailerdaemon('neko@example.jp'); # 0
print Sisimai::RFC5322->is_mailerdaemon('mailer-daemon@example.jp'); # 1
=head2 C<B<received(I<String>)>>
C<received()> returns array reference which include host names in the Received
header.
my $v = 'from mx.example.org (c1.example.net [192.0.2.1]) by mx.example.jp';
my $r = Sisimai::RFC5322->received($v);
warn Dumper $r;
$VAR1 = [
'mx.example.org',
'mx.example.jp'
];
=head2 C<B<weedout(I<Array>)>>
C<weedout()> returns string including only necessary fields from message/rfc822
part. This method is called from only Sisimai::Bite::Email::* modules.
my $v = <<'EOM';
From: postmaster@nyaan.example.org
To: kijitora@example.jp
Subject: Delivery failure
X-Mailer: Neko mailer v2.22
EOM
my $r = Sisimai::RFC5322->weedout([split("\n", $v)]);
print $$r;
From: postmaster@nyaan.example.org
To: kijitora@example.jp
Subject: Delivery failure
=head1 AUTHOR
azumakuniyuki
=head1 COPYRIGHT
Copyright (C) 2014-2018 azumakuniyuki, All rights reserved.
=head1 LICENSE
This software is distributed under The BSD 2-Clause License.
=cut