ÿØÿà JFIF    ÿÛ „ ( %!1!%*+...983,7(-.- Address/XS.pm000044400000051567152344353310007040 0ustar00# Copyright (c) 2015-2018 by Pali package Email::Address::XS; use 5.006; use strict; use warnings; our $VERSION = '1.05'; use Carp; use base 'Exporter'; our @EXPORT_OK = qw(parse_email_addresses parse_email_groups format_email_addresses format_email_groups compose_address split_address); use XSLoader; XSLoader::load(__PACKAGE__, $VERSION); =head1 NAME Email::Address::XS - Parse and format RFC 5322 email addresses and groups =head1 SYNOPSIS use Email::Address::XS; my $winstons_address = Email::Address::XS->new(phrase => 'Winston Smith', user => 'winston.smith', host => 'recdep.minitrue', comment => 'Records Department'); print $winstons_address->address(); # winston.smith@recdep.minitrue my $julias_address = Email::Address::XS->new('Julia', 'julia@ficdep.minitrue'); print $julias_address->format(); # Julia my $users_address = Email::Address::XS->parse('user '); print $users_address->host(); # oceania my $goldsteins_address = Email::Address::XS->parse_bare_address('goldstein@brotherhood.oceania'); print $goldsteins_address->user(); # goldstein my @addresses = Email::Address::XS->parse('"Winston Smith" (Records Department), Julia '); # ($winstons_address, $julias_address) use Email::Address::XS qw(format_email_addresses format_email_groups parse_email_addresses parse_email_groups); my $addresses_string = format_email_addresses($winstons_address, $julias_address, $users_address); # "Winston Smith" (Records Department), Julia , user my @addresses = map { $_->address() } parse_email_addresses($addresses_string); # ('winston.smith@recdep.minitrue', 'julia@ficdep.minitrue', 'user@oceania') my $groups_string = format_email_groups('Brotherhood' => [ $winstons_address, $julias_address ], undef() => [ $users_address ]); # Brotherhood: "Winston Smith" (Records Department), Julia ;, user my @groups = parse_email_groups($groups_string); # ('Brotherhood' => [ $winstons_address, $julias_address ], undef() => [ $users_address ]) use Email::Address::XS qw(compose_address split_address); my ($user, $host) = split_address('julia(outer party)@ficdep.minitrue'); # ('julia', 'ficdep.minitrue') my $string = compose_address('charrington"@"shop', 'thought.police.oceania'); # "charrington\"@\"shop"@thought.police.oceania =head1 DESCRIPTION This module implements L parser and formatter of email addresses and groups. It parses an input string from email headers which contain a list of email addresses or a groups of email addresses (like From, To, Cc, Bcc, Reply-To, Sender, ...). Also it can generate a string value for those headers from a list of email addresses objects. Module is backward compatible with L and L. Parser and formatter functionality is implemented in XS and uses shared code from Dovecot IMAP server. It is a drop-in replacement for L which has several security issues. E.g. issue L, which allows remote attackers to cause denial of service, is still present in L version 1.908. Email::Address::XS module was created to finally fix CVE-2015-7686. Existing applications that use Email::Address module could be easily switched to Email::Address::XS module. In most cases only changing C to C and replacing every C occurrence with C is sufficient. So unlike L, this module does not use regular expressions for parsing but instead native XS implementation parses input string sequentially according to RFC 5322 grammar. Additionally it has support also for named groups and so can be use instead of L. If you are looking for the module which provides object representation for the list of email addresses suitable for the MIME email headers, see L. =head2 EXPORT None by default. Exportable functions are: L|/parse_email_addresses>, L|/parse_email_groups>, L|/format_email_addresses>, L|/format_email_groups>, L|/compose_address>, L|/split_address>. =head2 Exportable Functions =over 4 =item format_email_addresses use Email::Address::XS qw(format_email_addresses); my $winstons_address = Email::Address::XS->new(phrase => 'Winston Smith', address => 'winston@recdep.minitrue'); my $julias_address = Email::Address::XS->new(phrase => 'Julia', address => 'julia@ficdep.minitrue'); my @addresses = ($winstons_address, $julias_address); my $string = format_email_addresses(@addresses); print $string; # "Winston Smith" , Julia Takes a list of email address objects and returns one formatted string of those email addresses. =cut sub format_email_addresses { my (@args) = @_; return format_email_groups(undef, \@args); } =item format_email_groups use Email::Address::XS qw(format_email_groups); my $winstons_address = Email::Address::XS->new(phrase => 'Winston Smith', user => 'winston.smith', host => 'recdep.minitrue'); my $julias_address = Email::Address::XS->new('Julia', 'julia@ficdep.minitrue'); my $users_address = Email::Address::XS->new(address => 'user@oceania'); my $groups_string = format_email_groups('Brotherhood' => [ $winstons_address, $julias_address ], undef() => [ $users_address ]); print $groups_string; # Brotherhood: "Winston Smith" , Julia ;, user@oceania my $undisclosed_string = format_email_groups('undisclosed-recipients' => []); print $undisclosed_string; # undisclosed-recipients:; Like L|/format_email_addresses> but this method takes pairs which consist of a group display name and a reference to address list. If a group is not undef then address list is formatted inside named group. =item parse_email_addresses use Email::Address::XS qw(parse_email_addresses); my $string = '"Winston Smith" , Julia , user@oceania'; my @addresses = parse_email_addresses($string); # @addresses now contains three Email::Address::XS objects, one for each address Parses an input string and returns a list of Email::Address::XS objects. Optional second string argument specifies class name for blessing new objects. =cut sub parse_email_addresses { my (@args) = @_; my $t = 1; return map { @{$_} } grep { $t ^= 1 } parse_email_groups(@args); } =item parse_email_groups use Email::Address::XS qw(parse_email_groups); my $string = 'Brotherhood: "Winston Smith" , Julia ;, user@oceania, undisclosed-recipients:;'; my @groups = parse_email_groups($string); # @groups now contains list ('Brotherhood' => [ $winstons_object, $julias_object ], undef() => [ $users_object ], 'undisclosed-recipients' => []) Like L|/parse_email_addresses> but this function returns a list of pairs: a group display name and a reference to a list of addresses which belongs to that named group. An undef value for a group means that a following list of addresses is not inside any named group. An output is in a same format as a input for the function L|/format_email_groups>. This function preserves order of groups and does not do any de-duplication or merging. =item compose_address use Email::Address::XS qw(compose_address); my $string_address = compose_address($user, $host); Takes an unescaped user part and unescaped host part of an address and returns escaped address. Available since version 1.01. =item split_address use Email::Address::XS qw(split_address); my ($user, $host) = split_address($string_address); Takes an escaped address and split it into pair of unescaped user part and unescaped host part of address. If splitting input address into these two parts is not possible then this function returns pair of undefs. Available since version 1.01. =back =head2 Class Methods =over 4 =item new my $empty_address = Email::Address::XS->new(); my $winstons_address = Email::Address::XS->new(phrase => 'Winston Smith', user => 'winston.smith', host => 'recdep.minitrue', comment => 'Records Department'); my $julias_address = Email::Address::XS->new('Julia', 'julia@ficdep.minitrue'); my $users_address = Email::Address::XS->new(address => 'user@oceania'); my $only_name = Email::Address::XS->new(phrase => 'Name'); my $copy_of_winstons_address = Email::Address::XS->new(copy => $winstons_address); Constructs and returns a new C object. Takes named list of arguments: phrase, address, user, host, comment and copy. An argument address takes precedence over user and host. When an argument copy is specified then it is expected an Email::Address::XS object and a cloned copy of that object is returned. All other parameters are ignored. Old syntax L is supported too. Takes one to four positional arguments: phrase, address comment, and original string. Passing an argument original is deprecated, ignored and throws a warning. =cut sub new { my ($class, @args) = @_; my %hash_keys = (phrase => 1, address => 1, user => 1, host => 1, comment => 1, copy => 1); my $is_hash; if ( scalar @args == 2 and defined $args[0] ) { $is_hash = 1 if exists $hash_keys{$args[0]}; } elsif ( scalar @args == 4 and defined $args[0] and defined $args[2] ) { $is_hash = 1 if exists $hash_keys{$args[0]} and exists $hash_keys{$args[2]}; } elsif ( scalar @args > 4 ) { $is_hash = 1; } my %args; if ( $is_hash ) { %args = @args; } else { carp 'Argument original is deprecated and ignored' if scalar @args > 3; $args{comment} = $args[2] if scalar @args > 2; $args{address} = $args[1] if scalar @args > 1; $args{phrase} = $args[0] if scalar @args > 0; } my $invalid; my $original; if ( exists $args{copy} ) { if ( $class->is_obj($args{copy}) ) { $args{phrase} = $args{copy}->phrase(); $args{comment} = $args{copy}->comment(); $args{user} = $args{copy}->user(); $args{host} = $args{copy}->host(); $invalid = $args{copy}->{invalid}; $original = $args{copy}->{original}; delete $args{address}; } else { carp 'Named argument copy does not contain a valid object'; } } my $self = bless {}, $class; $self->phrase($args{phrase}); $self->comment($args{comment}); if ( exists $args{address} ) { $self->address($args{address}); } else { $self->user($args{user}); $self->host($args{host}); } $self->{invalid} = 1 if $invalid; $self->{original} = $original; return $self; } =item parse my $winstons_address = Email::Address::XS->parse('"Winston Smith" (Records Department)'); my @users_addresses = Email::Address::XS->parse('user1@oceania, user2@oceania'); Parses an input string and returns a list of an Email::Address::XS objects. Same as the function L|/parse_email_addresses> but this one is class method. In scalar context this function returns just first parsed object. If more then one object was parsed then L|/is_valid> method on returned object returns false. If no object was parsed then empty Email::Address::XS object is returned. Prior to version 1.01 return value in scalar context is undef when no object was parsed. =cut sub parse { my ($class, $string) = @_; my @addresses = parse_email_addresses($string, $class); return @addresses if wantarray; my $self = @addresses ? $addresses[0] : Email::Address::XS->new(); $self->{invalid} = 1 if scalar @addresses != 1; $self->{original} = $string unless defined $self->{original}; return $self; } =item parse_bare_address my $winstons_address = Email::Address::XS->parse_bare_address('winston.smith@recdep.minitrue'); Parses an input string as one bare email address (addr spec) which does not allow phrase part or angle brackets around email address and returns an Email::Address::XS object. It is just a wrapper around L|/address> method. Method L|/is_valid> can be used to check if parsing was successful. Available since version 1.01. =cut sub parse_bare_address { my ($class, $string) = @_; my $self = $class->new(); if ( defined $string ) { $self->address($string); $self->{original} = $string; } else { carp 'Use of uninitialized value for string'; } return $self; } =back =head2 Object Methods =over 4 =item format my $string = $address->format(); Returns formatted Email::Address::XS object as a string. This method throws a warning when L|/user> or L|/host> part of the email address is invalid or empty string. =cut sub format { my ($self) = @_; return format_email_addresses($self); } =item is_valid my $is_valid = $address->is_valid(); Returns true if the parse function or method which created this Email::Address::XS object had not received any syntax error on input string and also that L|/user> and L|/host> part of the email address are not empty strings. Thus this function can be used for checking if Email::Address::XS object is valid before calling L|/format> method on it. Available since version 1.01. =cut sub is_valid { my ($self) = @_; my $user = $self->user(); my $host = $self->host(); return (defined $user and defined $host and length $host and not $self->{invalid}); } =item phrase my $phrase = $address->phrase(); $address->phrase('Winston Smith'); Accessor and mutator for the phrase (display name). =cut sub phrase { my ($self, @args) = @_; return $self->{phrase} unless @args; delete $self->{invalid} if exists $self->{invalid}; return $self->{phrase} = $args[0]; } =item user my $user = $address->user(); $address->user('winston.smith'); Accessor and mutator for the unescaped user (local/mailbox) part of an address. =cut sub user { my ($self, @args) = @_; return $self->{user} unless @args; delete $self->{cached_address} if exists $self->{cached_address}; delete $self->{invalid} if exists $self->{invalid}; return $self->{user} = $args[0]; } =item host my $host = $address->host(); $address->host('recdep.minitrue'); Accessor and mutator for the unescaped host (domain) part of an address. Since version 1.03 this method checks if setting a new value is syntactically valid. If not undef is set and returned. =cut sub host { my ($self, @args) = @_; return $self->{host} unless @args; delete $self->{cached_address} if exists $self->{cached_address}; delete $self->{invalid} if exists $self->{invalid}; if (defined $args[0] and $args[0] =~ /^(?:\[.*\]|[^\x00-\x20\x7F()<>\[\]:;@\\,"]+)$/) { return $self->{host} = $args[0]; } else { return $self->{host} = undef; } } =item address my $string_address = $address->address(); $address->address('winston.smith@recdep.minitrue'); Accessor and mutator for the escaped address (addr spec). Internally this module stores a user and a host part of an address separately. Function L|/compose_address> is used for composing full address and function L|/split_address> for splitting into a user and a host parts. If splitting new address into these two parts is not possible then this method returns undef and sets both parts to undef. =cut sub address { my ($self, @args) = @_; my $user; my $host; if ( @args ) { delete $self->{invalid} if exists $self->{invalid}; ($user, $host) = split_address($args[0]) if defined $args[0]; if ( not defined $user or not defined $host ) { $user = undef; $host = undef; } $self->{user} = $user; $self->{host} = $host; } else { return $self->{cached_address} if exists $self->{cached_address}; $user = $self->user(); $host = $self->host(); } if ( defined $user and defined $host and length $host ) { return $self->{cached_address} = compose_address($user, $host); } else { return $self->{cached_address} = undef; } } =item comment my $comment = $address->comment(); $address->comment('Records Department'); Accessor and mutator for the comment which is formatted after an address. A comment can contain another nested comments in round brackets. When setting new comment this method check if brackets are balanced. If not undef is set and returned. =cut sub comment { my ($self, @args) = @_; return $self->{comment} unless @args; delete $self->{invalid} if exists $self->{invalid}; return $self->{comment} = undef unless defined $args[0]; my $count = 0; my $cleaned = $args[0]; $cleaned =~ s/(?:\\.|[^\(\)\x00])//g; foreach ( split //, $cleaned ) { $count++ if $_ eq '('; $count-- if $_ eq ')'; $count = -1 if $_ eq "\x00"; last if $count < 0; } return $self->{comment} = undef if $count != 0; return $self->{comment} = $args[0]; } =item name my $name = $address->name(); This method tries to return a name which belongs to the address. It returns either L|/phrase> or L|/comment> or L|/user> part of the address or empty string (first defined value in this order). But it never returns undef. =cut sub name { my ($self) = @_; my $phrase = $self->phrase(); return $phrase if defined $phrase and length $phrase; my $comment = $self->comment(); return $comment if defined $comment and length $comment; my $user = $self->user(); return $user if defined $user; return ''; } =item as_string my $address = Email::Address::XS->new(phrase => 'Winston Smith', address => 'winston.smith@recdep.minitrue'); my $stringified = $address->as_string(); This method is used for object L. It returns string representation of object. By default object is stringified to L|/format>. Available since version 1.01. =cut our $STRINGIFY; # deprecated sub as_string { my ($self) = @_; return $self->format() unless defined $STRINGIFY; carp 'Variable $Email::Address::XS::STRINGIFY is deprecated; subclass instead'; my $method = $self->can($STRINGIFY); croak 'Stringify method ' . $STRINGIFY . ' does not exist' unless defined $method; return $method->($self); } =item original my $address = Email::Address::XS->parse('(Winston) "Smith" (Minitrue)'); my $original = $address->original(); # (Winston) "Smith" (Minitrue) my $format = $address->format(); # Smith (Minitrue) This method returns original part of the string which was used for parsing current Email::Address::XS object. If object was not created by parsing input string, then this method returns undef. Note that L|/format> method does not have to return same original string. Available since version 1.01. =cut sub original { my ($self) = @_; return $self->{original}; } =back =head2 Overloaded Operators =over 4 =item stringify my $address = Email::Address::XS->new(phrase => 'Winston Smith', address => 'winston.smith@recdep.minitrue'); print "Winston's address is $address."; # Winston's address is "Winston Smith" . Stringification is done by method L|/as_string>. =cut use overload '""' => \&as_string; =back =head2 Deprecated Functions and Variables For compatibility with L there are defined some deprecated functions and variables. Do not use them in new code. Their usage throws warnings. Altering deprecated variable C<$Email::Address::XS::STRINGIFY> changes method which is called for objects stringification. Deprecated cache functions C, C and C are noop and do nothing. =cut sub purge_cache { carp 'Function purge_cache is deprecated and does nothing'; } sub disable_cache { carp 'Function disable_cache is deprecated and does nothing'; } sub enable_cache { carp 'Function enable_cache is deprecated and does nothing'; } =head1 SEE ALSO L, L, L, L, L, L, L =head1 AUTHOR Pali Epali@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2015-2018 by Pali Epali@cpan.orgE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.6.0 or, at your option, any later version of Perl 5 you may have available. Dovecot parser is licensed under The MIT License and copyrighted by Dovecot authors. =cut 1; Abstract/EmailSimple.pm000044400000004263152345204470011057 0ustar00use strict; use warnings; package Email::Abstract::EmailSimple; # ABSTRACT: Email::Abstract wrapper for Email::Simple $Email::Abstract::EmailSimple::VERSION = '3.010'; use Email::Abstract::Plugin; BEGIN { @Email::Abstract::EmailSimple::ISA = 'Email::Abstract::Plugin' }; sub target { "Email::Simple" } sub construct { require Email::Simple; my ($class, $rfc822) = @_; Email::Simple->new($rfc822); } sub get_header { my ($class, $obj, $header) = @_; $obj->header($header); } sub get_body { my ($class, $obj) = @_; $obj->body(); } sub set_header { my ($class, $obj, $header, @data) = @_; $obj->header_set($header, @data); } sub set_body { my ($class, $obj, $body) = @_; $obj->body_set($body); } sub as_string { my ($class, $obj) = @_; $obj->as_string(); } 1; #pod =head1 DESCRIPTION #pod #pod This module wraps the Email::Simple mail handling library with an #pod abstract interface, to be used with L #pod #pod =head1 SEE ALSO #pod #pod L, L. #pod #pod =cut __END__ =pod =encoding UTF-8 =head1 NAME Email::Abstract::EmailSimple - Email::Abstract wrapper for Email::Simple =head1 VERSION version 3.010 =head1 DESCRIPTION This module wraps the Email::Simple mail handling library with an abstract interface, to be used with L =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 SEE ALSO L, L. =head1 AUTHORS =over 4 =item * Ricardo SIGNES =item * Simon Cozens =item * Casey West =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2004 by Simon Cozens. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Abstract/MailMessage.pm000044400000004360152345204470011043 0ustar00use strict; package Email::Abstract::MailMessage; # ABSTRACT: Email::Abstract wrapper for Mail::Message $Email::Abstract::MailMessage::VERSION = '3.010'; use Email::Abstract::Plugin; BEGIN { @Email::Abstract::MailMessage::ISA = 'Email::Abstract::Plugin' }; sub target { "Mail::Message" } sub construct { require Mail::Message; my ($class, $rfc822) = @_; Mail::Message->read($rfc822); } sub get_header { my ($class, $obj, $header) = @_; $obj->head->get($header); } sub get_body { my ($class, $obj) = @_; $obj->decoded->string; } sub set_header { my ($class, $obj, $header, @data) = @_; $obj->head->delete($header); $obj->head->add($header, $_) for @data; } sub set_body { my ($class, $obj, $body) = @_; $obj->body(Mail::Message::Body->new(data => $body)); } sub as_string { my ($class, $obj) = @_; $obj->string; } 1; #pod =head1 DESCRIPTION #pod #pod This module wraps the Mail::Message mail handling library with an #pod abstract interface, to be used with L #pod #pod =head1 SEE ALSO #pod #pod L, L. #pod #pod =cut __END__ =pod =encoding UTF-8 =head1 NAME Email::Abstract::MailMessage - Email::Abstract wrapper for Mail::Message =head1 VERSION version 3.010 =head1 DESCRIPTION This module wraps the Mail::Message mail handling library with an abstract interface, to be used with L =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 SEE ALSO L, L. =head1 AUTHORS =over 4 =item * Ricardo SIGNES =item * Simon Cozens =item * Casey West =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2004 by Simon Cozens. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Abstract/Plugin.pm000044400000003114152345204470010106 0ustar00use strict; use warnings; package Email::Abstract::Plugin; # ABSTRACT: a base class for Email::Abstract plugins $Email::Abstract::Plugin::VERSION = '3.010'; #pod =method is_available #pod #pod This method returns true if the plugin should be considered available for #pod registration. Plugins that return false from this method will not be #pod registered when Email::Abstract is loaded. #pod #pod =cut sub is_available { 1 } 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Abstract::Plugin - a base class for Email::Abstract plugins =head1 VERSION version 3.010 =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 METHODS =head2 is_available This method returns true if the plugin should be considered available for registration. Plugins that return false from this method will not be registered when Email::Abstract is loaded. =head1 AUTHORS =over 4 =item * Ricardo SIGNES =item * Simon Cozens =item * Casey West =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2004 by Simon Cozens. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Abstract/EmailMIME.pm000044400000003673152345204470010361 0ustar00use strict; use warnings; package Email::Abstract::EmailMIME; # ABSTRACT: Email::Abstract wrapper for Email::MIME $Email::Abstract::EmailMIME::VERSION = '3.010'; use Email::Abstract::EmailSimple; BEGIN { @Email::Abstract::EmailMIME::ISA = 'Email::Abstract::EmailSimple' }; sub target { "Email::MIME" } sub construct { require Email::MIME; my ($class, $rfc822) = @_; Email::MIME->new($rfc822); } sub get_body { my ($class, $obj) = @_; # Return the same thing you'd get from Email::Simple. # # Ugh. -- rjbs, 2014-12-27 return $obj->body_raw; } 1; #pod =head1 DESCRIPTION #pod #pod This module wraps the Email::MIME mail handling library with an #pod abstract interface, to be used with L #pod #pod =head1 SEE ALSO #pod #pod L, L. #pod #pod =cut __END__ =pod =encoding UTF-8 =head1 NAME Email::Abstract::EmailMIME - Email::Abstract wrapper for Email::MIME =head1 VERSION version 3.010 =head1 DESCRIPTION This module wraps the Email::MIME mail handling library with an abstract interface, to be used with L =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 SEE ALSO L, L. =head1 AUTHORS =over 4 =item * Ricardo SIGNES =item * Simon Cozens =item * Casey West =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2004 by Simon Cozens. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Abstract/MIMEEntity.pm000044400000004520152345204470010576 0ustar00use strict; package Email::Abstract::MIMEEntity; # ABSTRACT: Email::Abstract wrapper for MIME::Entity $Email::Abstract::MIMEEntity::VERSION = '3.010'; use Email::Abstract::Plugin; BEGIN { @Email::Abstract::MIMEEntity::ISA = 'Email::Abstract::MailInternet' }; my $is_avail; sub is_available { return $is_avail if defined $is_avail; eval { require MIME::Entity; MIME::Entity->VERSION(5.508); 1 }; return $is_avail = $@ ? 0 : 1; } sub target { "MIME::Entity" } sub construct { require MIME::Parser; my $parser = MIME::Parser->new; $parser->output_to_core(1); my ($class, $rfc822) = @_; $parser->parse_data($rfc822); } sub get_body { my ($self, $obj) = @_; my $handle = $obj->bodyhandle; return $handle ? $handle->as_string : join('', @{ $obj->body }); } sub set_body { my ($class, $obj, $body) = @_; my @lines = split /\n/, $body; my $io = $obj->bodyhandle->open("w"); foreach (@lines) { $io->print($_."\n") } $io->close; } 1; #pod =head1 DESCRIPTION #pod #pod This module wraps the MIME::Entity mail handling library with an #pod abstract interface, to be used with L #pod #pod =head1 SEE ALSO #pod #pod L, L. #pod #pod =cut __END__ =pod =encoding UTF-8 =head1 NAME Email::Abstract::MIMEEntity - Email::Abstract wrapper for MIME::Entity =head1 VERSION version 3.010 =head1 DESCRIPTION This module wraps the MIME::Entity mail handling library with an abstract interface, to be used with L =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 SEE ALSO L, L. =head1 AUTHORS =over 4 =item * Ricardo SIGNES =item * Simon Cozens =item * Casey West =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2004 by Simon Cozens. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Abstract/MailInternet.pm000044400000005447152345204470011256 0ustar00use strict; package Email::Abstract::MailInternet; # ABSTRACT: Email::Abstract wrapper for Mail::Internet $Email::Abstract::MailInternet::VERSION = '3.010'; use Email::Abstract::Plugin; BEGIN { @Email::Abstract::MailInternet::ISA = 'Email::Abstract::Plugin' }; sub target { "Mail::Internet" } # We need 1.77 because otherwise headers unfold badly. my $is_avail; sub is_available { return $is_avail if defined $is_avail; require Mail::Internet; eval { Mail::Internet->VERSION(1.77) }; return $is_avail = $@ ? 0 : 1; } sub construct { require Mail::Internet; my ($class, $rfc822) = @_; Mail::Internet->new([ map { "$_\x0d\x0a" } split /\x0d\x0a/, $rfc822]); } sub get_header { my ($class, $obj, $header) = @_; my @values = $obj->head->get($header); return unless @values; # No reason to s/// lots of values if we're just going to return one. $#values = 0 if not wantarray; chomp @values; s/(?:\x0d\x0a|\x0a\x0d|\x0a|\x0d)\s+/ /g for @values; return wantarray ? @values : $values[0]; } sub get_body { my ($class, $obj) = @_; join "", @{$obj->body()}; } sub set_header { my ($class, $obj, $header, @data) = @_; my $count = 0; $obj->head->replace($header, shift @data, ++$count) while @data; } sub set_body { my ($class, $obj, $body) = @_; $obj->body( map { "$_\n" } split /\n/, $body ); } sub as_string { my ($class, $obj) = @_; $obj->as_string(); } 1; #pod =head1 DESCRIPTION #pod #pod This module wraps the Mail::Internet mail handling library with an #pod abstract interface, to be used with L #pod #pod =head1 SEE ALSO #pod #pod L, L. #pod #pod =cut __END__ =pod =encoding UTF-8 =head1 NAME Email::Abstract::MailInternet - Email::Abstract wrapper for Mail::Internet =head1 VERSION version 3.010 =head1 DESCRIPTION This module wraps the Mail::Internet mail handling library with an abstract interface, to be used with L =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 SEE ALSO L, L. =head1 AUTHORS =over 4 =item * Ricardo SIGNES =item * Simon Cozens =item * Casey West =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2004 by Simon Cozens. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Sender.pm000044400000012656152345204470006340 0ustar00package Email::Sender 2.601; # ABSTRACT: a library for sending email use Moo::Role; requires 'send'; #pod =head1 SYNOPSIS #pod #pod my $message = Email::MIME->create( ... ); #pod # produce an Email::Abstract compatible message object, #pod # e.g. produced by Email::Simple, Email::MIME, Email::Stuff #pod #pod use Email::Sender::Simple qw(sendmail); #pod use Email::Sender::Transport::SMTP qw(); #pod use Try::Tiny; #pod #pod try { #pod sendmail( #pod $message, #pod { #pod from => $SMTP_ENVELOPE_FROM_ADDRESS, #pod transport => Email::Sender::Transport::SMTP->new({ #pod host => $SMTP_HOSTNAME, #pod port => $SMTP_PORT, #pod }) #pod } #pod ); #pod } catch { #pod warn "sending failed: $_"; #pod }; #pod #pod =head1 OVERVIEW #pod #pod Email::Sender replaces the old and sometimes problematic Email::Send library, #pod which did a decent job at handling very simple email sending tasks, but was not #pod suitable for serious use, for a variety of reasons. #pod #pod Most users will be able to use L to send mail. Users #pod with more specific needs should look at the available Email::Sender::Transport #pod classes. #pod #pod Documentation may be found in L, and new users should #pod start with L. #pod #pod =head1 IMPLEMENTING #pod #pod Email::Sender itself is a Moo role. Any class that implements Email::Sender #pod is required to provide a method called C. This method should accept any #pod input that can be understood by L, followed by a hashref #pod containing C and C arguments to be used as the envelope. The method #pod should return an L object on success or throw an #pod L on failure. #pod #pod =cut no Moo::Role; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender - a library for sending email =head1 VERSION version 2.601 =head1 SYNOPSIS my $message = Email::MIME->create( ... ); # produce an Email::Abstract compatible message object, # e.g. produced by Email::Simple, Email::MIME, Email::Stuff use Email::Sender::Simple qw(sendmail); use Email::Sender::Transport::SMTP qw(); use Try::Tiny; try { sendmail( $message, { from => $SMTP_ENVELOPE_FROM_ADDRESS, transport => Email::Sender::Transport::SMTP->new({ host => $SMTP_HOSTNAME, port => $SMTP_PORT, }) } ); } catch { warn "sending failed: $_"; }; =head1 OVERVIEW Email::Sender replaces the old and sometimes problematic Email::Send library, which did a decent job at handling very simple email sending tasks, but was not suitable for serious use, for a variety of reasons. Most users will be able to use L to send mail. Users with more specific needs should look at the available Email::Sender::Transport classes. Documentation may be found in L, and new users should start with L. =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 IMPLEMENTING Email::Sender itself is a Moo role. Any class that implements Email::Sender is required to provide a method called C. This method should accept any input that can be understood by L, followed by a hashref containing C and C arguments to be used as the envelope. The method should return an L object on success or throw an L on failure. =head1 AUTHOR Ricardo Signes =head1 CONTRIBUTORS =for stopwords Alex Efros Aristotle Pagaltzis Bernhard Graf Christian Walde David Golden Steinbrunner Erik Huelsmann Hans Dieter Pearcey HIROSE Masaaki James E Keenan Justin Hunter Karen Etheridge Kenichi Ishigaki kga Kris Matthews Marc Bradshaw Ricardo Signes Stefan Hornburg (Racke) William Blunn =over 4 =item * Alex Efros =item * Aristotle Pagaltzis =item * Bernhard Graf =item * Christian Walde =item * David Golden =item * David Steinbrunner =item * Erik Huelsmann =item * Hans Dieter Pearcey =item * HIROSE Masaaki =item * James E Keenan =item * Justin Hunter =item * Karen Etheridge =item * Kenichi Ishigaki =item * kga =item * Kris Matthews =item * Marc Bradshaw =item * Ricardo Signes =item * Ricardo Signes =item * Stefan Hornburg (Racke) =item * William Blunn =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Simple.pm000044400000040671152345204470006347 0ustar00use v5.12.0; use warnings; package Email::Simple 2.218; # ABSTRACT: simple parsing of RFC2822 message format and headers use Carp (); use Email::Simple::Creator; use Email::Simple::Header; our $GROUCHY = 0; # We are liberal in what we accept. sub __crlf_re { qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/; } #pod =head1 SYNOPSIS #pod #pod use Email::Simple; #pod my $email = Email::Simple->new($text); #pod #pod my $from_header = $email->header("From"); #pod my @received = $email->header("Received"); #pod #pod $email->header_set("From", 'Simon Cozens '); #pod #pod my $old_body = $email->body; #pod $email->body_set("Hello world\nSimon"); #pod #pod print $email->as_string; #pod #pod ...or, to create a message from scratch... #pod #pod my $email = Email::Simple->create( #pod header => [ #pod From => 'casey@geeknest.com', #pod To => 'drain@example.com', #pod Subject => 'Message in a bottle', #pod ], #pod body => '...', #pod ); #pod #pod $email->header_set( 'X-Content-Container' => 'bottle/glass' ); #pod #pod print $email->as_string; #pod #pod =head1 DESCRIPTION #pod #pod The Email:: namespace was begun as a reaction against the increasing complexity #pod and bugginess of Perl's existing email modules. C modules are meant #pod to be simple to use and to maintain, pared to the bone, fast, minimal in their #pod external dependencies, and correct. #pod #pod =method new #pod #pod my $email = Email::Simple->new($message, \%arg); #pod #pod This method parses an email from a scalar containing an RFC2822 formatted #pod message and returns an object. C<$message> may be a reference to a message #pod string, in which case the string will be altered in place. This can result in #pod significant memory savings. #pod #pod If you want to create a message from scratch, you should use the C> #pod method. #pod #pod Valid arguments are: #pod #pod header_class - the class used to create new header objects #pod The named module is not 'require'-ed by Email::Simple! #pod #pod =cut sub new { my ($class, $text, $arg) = @_; $arg ||= {}; Carp::croak 'Unable to parse undefined message' if ! defined $text; my $text_ref = (ref $text || '' eq 'SCALAR') ? $text : \$text; Carp::carp 'Message with wide characters' if ${$text_ref} =~ /[^\x00-\xFF]/; my ($pos, $mycrlf) = $class->_split_head_from_body($text_ref); my $self = bless { mycrlf => $mycrlf } => $class; my $head; if (defined $pos) { $head = substr $$text_ref, 0, $pos, ''; substr($head, -(length $mycrlf)) = ''; } else { $head = $$text_ref; $text_ref = \''; } my $header_class = $arg->{header_class} || $self->default_header_class; $self->header_obj_set( $header_class->new(\$head, { crlf => $self->crlf }) ); $self->body_set($text_ref); return $self; } # Given the text of an email, return ($pos, $crlf) where $pos is the position # at which the body text begins and $crlf is the type of newline used in the # message. sub _split_head_from_body { my ($self, $text_ref) = @_; # For body/header division, see RFC 2822, section 2.1 # # Honestly, are we *ever* going to have LFCR messages?? -- rjbs, 2015-10-11 my $re = qr{\x0a\x0d\x0a\x0d|\x0d\x0a\x0d\x0a|\x0d\x0d|\x0a\x0a}; if ($$text_ref =~ /($re)/gsm) { my $crlf = substr $1, 0, length($1)/2; return (pos($$text_ref), $crlf); } else { # The body is, of course, optional. my $re = $self->__crlf_re; $$text_ref =~ /($re)/gsm; return (undef, ($1 || "\n")); } } #pod =method create #pod #pod my $email = Email::Simple->create(header => [ @headers ], body => '...'); #pod #pod This method is a constructor that creates an Email::Simple object #pod from a set of named parameters. The C
parameter's value is a #pod list reference containing a set of headers to be created. The C #pod parameter's value is a scalar value holding the contents of the message #pod body. Line endings in the body will normalized to CRLF. #pod #pod If no C header is specified, one will be provided for you based on the #pod C of the local machine. This is because the C field is a required #pod header and is a pain in the neck to create manually for every message. The #pod C field is also a required header, but it is I provided for you. #pod #pod =cut our $CREATOR = 'Email::Simple::Creator'; sub create { my ($class, %args) = @_; # We default it in here as well as below because by having it here, then we # know that if there are no other headers, we'll get the proper CRLF. # Otherwise, we get a message with incorrect CRLF. -- rjbs, 2007-07-13 my $headers = $args{header} || [ Date => $CREATOR->_date_header ]; my $body = $args{body} || ''; my $empty = q{}; my $header = \$empty; for my $idx (map { $_ * 2 } 0 .. @$headers / 2 - 1) { my ($key, $value) = @$headers[ $idx, $idx + 1 ]; $CREATOR->_add_to_header($header, $key, $value); } $CREATOR->_finalize_header($header); my $email = $class->new($header); $email->header_raw_set(Date => $CREATOR->_date_header) unless defined $email->header_raw('Date'); $body = (join $CREATOR->_crlf, split /\x0d\x0a|\x0a\x0d|\x0a|\x0d/, $body) . $CREATOR->_crlf; $email->body_set($body); return $email; } #pod =method header_obj #pod #pod my $header = $email->header_obj; #pod #pod This method returns the object representing the email's header. For the #pod interface for this object, see L. #pod #pod =cut sub header_obj { my ($self) = @_; return $self->{header}; } # Probably needs to exist in perpetuity for modules released during the "__head # is tentative" phase, until we have a way to force modules below us on the # dependency tree to upgrade. i.e., never and/or in Perl 6 -- rjbs, 2006-11-28 BEGIN { *__head = \&header_obj } #pod =method header_obj_set #pod #pod $email->header_obj_set($new_header_obj); #pod #pod This method substitutes the given new header object for the email's existing #pod header object. #pod #pod =cut sub header_obj_set { my ($self, $obj) = @_; $self->{header} = $obj; } #pod =method header #pod #pod my @values = $email->header($header_name); #pod my $first = $email->header($header_name); #pod my $value = $email->header($header_name, $index); #pod #pod In list context, this returns every value for the named header. In scalar #pod context, it returns the I value for the named header. If second #pod parameter is specified then instead I value it returns value at #pod position C<$index> (negative C<$index> is from the end). #pod #pod =method header_set #pod #pod $email->header_set($field, $line1, $line2, ...); #pod #pod Sets the header to contain the given data. If you pass multiple lines #pod in, you get multiple headers, and order is retained. If no values are given to #pod set, the header will be removed from to the message entirely. #pod #pod =method header_raw #pod #pod This is another name (and the preferred one) for C
. #pod #pod =method header_raw_set #pod #pod This is another name (and the preferred one) for C. #pod #pod =method header_raw_prepend #pod #pod $email->header_raw_prepend($field => $value); #pod #pod This method adds a new instance of the name field as the first field in the #pod header. #pod #pod =method header_names #pod #pod my @header_names = $email->header_names; #pod #pod This method returns the list of header names currently in the email object. #pod These names can be passed to the C
method one-at-a-time to get header #pod values. You are guaranteed to get a set of headers that are unique. You are not #pod guaranteed to get the headers in any order at all. #pod #pod For backwards compatibility, this method can also be called as B. #pod #pod =method header_pairs #pod #pod my @headers = $email->header_pairs; #pod #pod This method returns a list of pairs describing the contents of the header. #pod Every other value, starting with and including zeroth, is a header name and the #pod value following it is the header value. #pod #pod =method header_raw_pairs #pod #pod This is another name (and the preferred one) for C. #pod #pod =cut BEGIN { no strict 'refs'; for my $method (qw( header_raw header header_raw_set header_set header_raw_prepend header_raw_pairs header_pairs header_names )) { *$method = sub { (shift)->header_obj->$method(@_) }; } *headers = \&header_names; } #pod =method body #pod #pod Returns the body text of the mail. #pod #pod =cut sub body { my ($self) = @_; return (defined ${ $self->{body} }) ? ${ $self->{body} } : ''; } #pod =method body_set #pod #pod Sets the body text of the mail. #pod #pod =cut sub body_set { my ($self, $text) = @_; my $text_ref = ref $text ? $text : \$text; Carp::carp 'Body with wide characters' if defined ${$text_ref} and ${$text_ref} =~ /[^\x00-\xFF]/; $self->{body} = $text_ref; return; } #pod =method as_string #pod #pod Returns the mail as a string, reconstructing the headers. #pod #pod =cut sub as_string { my $self = shift; return $self->header_obj->as_string . $self->crlf . $self->body; } #pod =method crlf #pod #pod This method returns the type of newline used in the email. It is an accessor #pod only. #pod #pod =cut sub crlf { $_[0]->{mycrlf} } #pod =method default_header_class #pod #pod This returns the class used, by default, for header objects, and is provided #pod for subclassing. The default default is Email::Simple::Header. #pod #pod =cut sub default_header_class { 'Email::Simple::Header' } 1; =pod =encoding UTF-8 =head1 NAME Email::Simple - simple parsing of RFC2822 message format and headers =head1 VERSION version 2.218 =head1 SYNOPSIS use Email::Simple; my $email = Email::Simple->new($text); my $from_header = $email->header("From"); my @received = $email->header("Received"); $email->header_set("From", 'Simon Cozens '); my $old_body = $email->body; $email->body_set("Hello world\nSimon"); print $email->as_string; ...or, to create a message from scratch... my $email = Email::Simple->create( header => [ From => 'casey@geeknest.com', To => 'drain@example.com', Subject => 'Message in a bottle', ], body => '...', ); $email->header_set( 'X-Content-Container' => 'bottle/glass' ); print $email->as_string; =head1 DESCRIPTION The Email:: namespace was begun as a reaction against the increasing complexity and bugginess of Perl's existing email modules. C modules are meant to be simple to use and to maintain, pared to the bone, fast, minimal in their external dependencies, and correct. =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 METHODS =head2 new my $email = Email::Simple->new($message, \%arg); This method parses an email from a scalar containing an RFC2822 formatted message and returns an object. C<$message> may be a reference to a message string, in which case the string will be altered in place. This can result in significant memory savings. If you want to create a message from scratch, you should use the C> method. Valid arguments are: header_class - the class used to create new header objects The named module is not 'require'-ed by Email::Simple! =head2 create my $email = Email::Simple->create(header => [ @headers ], body => '...'); This method is a constructor that creates an Email::Simple object from a set of named parameters. The C
parameter's value is a list reference containing a set of headers to be created. The C parameter's value is a scalar value holding the contents of the message body. Line endings in the body will normalized to CRLF. If no C header is specified, one will be provided for you based on the C of the local machine. This is because the C field is a required header and is a pain in the neck to create manually for every message. The C field is also a required header, but it is I provided for you. =head2 header_obj my $header = $email->header_obj; This method returns the object representing the email's header. For the interface for this object, see L. =head2 header_obj_set $email->header_obj_set($new_header_obj); This method substitutes the given new header object for the email's existing header object. =head2 header my @values = $email->header($header_name); my $first = $email->header($header_name); my $value = $email->header($header_name, $index); In list context, this returns every value for the named header. In scalar context, it returns the I value for the named header. If second parameter is specified then instead I value it returns value at position C<$index> (negative C<$index> is from the end). =head2 header_set $email->header_set($field, $line1, $line2, ...); Sets the header to contain the given data. If you pass multiple lines in, you get multiple headers, and order is retained. If no values are given to set, the header will be removed from to the message entirely. =head2 header_raw This is another name (and the preferred one) for C
. =head2 header_raw_set This is another name (and the preferred one) for C. =head2 header_raw_prepend $email->header_raw_prepend($field => $value); This method adds a new instance of the name field as the first field in the header. =head2 header_names my @header_names = $email->header_names; This method returns the list of header names currently in the email object. These names can be passed to the C
method one-at-a-time to get header values. You are guaranteed to get a set of headers that are unique. You are not guaranteed to get the headers in any order at all. For backwards compatibility, this method can also be called as B. =head2 header_pairs my @headers = $email->header_pairs; This method returns a list of pairs describing the contents of the header. Every other value, starting with and including zeroth, is a header name and the value following it is the header value. =head2 header_raw_pairs This is another name (and the preferred one) for C. =head2 body Returns the body text of the mail. =head2 body_set Sets the body text of the mail. =head2 as_string Returns the mail as a string, reconstructing the headers. =head2 crlf This method returns the type of newline used in the email. It is an accessor only. =head2 default_header_class This returns the class used, by default, for header objects, and is provided for subclassing. The default default is Email::Simple::Header. =head1 CAVEATS Email::Simple handles only RFC2822 formatted messages. This means you cannot expect it to cope well as the only parser between you and the outside world, say for example when writing a mail filter for invocation from a .forward file (for this we recommend you use L anyway). =head1 AUTHORS =over 4 =item * Simon Cozens =item * Casey West =item * Ricardo SIGNES =back =head1 CONTRIBUTORS =for stopwords Brian Cassidy Christian Walde Marc Bradshaw Michael Stevens Pali Ricardo Signes Ronald F. Guilmette William Yardley =over 4 =item * Brian Cassidy =item * Christian Walde =item * Marc Bradshaw =item * Michael Stevens =item * Pali =item * Ricardo Signes =item * Ricardo Signes =item * Ronald F. Guilmette =item * William Yardley =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2003 by Simon Cozens. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #pod =head1 CAVEATS #pod #pod Email::Simple handles only RFC2822 formatted messages. This means you cannot #pod expect it to cope well as the only parser between you and the outside world, #pod say for example when writing a mail filter for invocation from a .forward file #pod (for this we recommend you use L anyway). #pod #pod =cut Date/Format.pm000044400000011226152345204470007215 0ustar00use v5.12.0; use warnings; package Email::Date::Format 1.008; # ABSTRACT: produce RFC 2822 date strings our @EXPORT_OK = qw[email_date email_gmdate]; use Exporter 5.57 'import'; use Time::Local 1.27 (); #pod =head1 SYNOPSIS #pod #pod use Email::Date::Format qw(email_date); #pod #pod my $header = email_date($date->epoch); #pod #pod Email::Simple->create( #pod header => [ #pod Date => $header, #pod ], #pod body => '...', #pod ); #pod #pod =head1 DESCRIPTION #pod #pod This module provides a simple means for generating an RFC 2822 compliant #pod datetime string. (In case you care, they're not RFC 822 dates, because they #pod use a four digit year, which is not allowed in RFC 822.) #pod #pod =func email_date #pod #pod my $date = email_date; # now #pod my $date = email_date( time - 60*60 ); # one hour ago #pod #pod C accepts an epoch value, such as the one returned by C