Mail-Message-4.03/0000755000175000001440000000000015135671052014427 5ustar00markovusers00000000000000Mail-Message-4.03/lib/0000755000175000001440000000000015135671052015175 5ustar00markovusers00000000000000Mail-Message-4.03/lib/Mail/0000755000175000001440000000000015135671052016057 5ustar00markovusers00000000000000Mail-Message-4.03/lib/Mail/Message/0000755000175000001440000000000015135671052017443 5ustar00markovusers00000000000000Mail-Message-4.03/lib/Mail/Message/Field/0000755000175000001440000000000015135671052020466 5ustar00markovusers00000000000000Mail-Message-4.03/lib/Mail/Message/Field/Flex.pm0000644000175000001440000000423115135671037021725 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 4.03. # The POD got stripped from this file by OODoc version 3.06. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2026 by Mark Overmeer. # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later package Mail::Message::Field::Flex;{ our $VERSION = '4.03'; } use parent 'Mail::Message::Field'; use strict; use warnings; use Log::Report 'mail-message', import => [ qw// ]; #-------------------- sub new($;$$@) { my $class = shift; my $args = @_ <= 2 || ! ref $_[-1] ? {} : ref $_[-1] eq 'ARRAY' ? { @{pop @_} } : pop @_; my ($name, $body) = $class->consume(@_==1 ? (shift) : (shift, shift)); defined $body or return (); # Attributes preferably stored in array to protect order. my $attr = $args->{attributes}; $attr = [ %$attr ] if defined $attr && ref $attr eq 'HASH'; push @$attr, @_; $class->SUPER::new(%$args, name => $name, body => $body, attributes => $attr); } sub init($) { my ($self, $args) = @_; @$self{ qw/MMFF_name MMFF_body/ } = @$args{ qw/name body/ }; $self->comment($args->{comment}) if exists $args->{comment}; my $attr = $args->{attributes}; $self->attribute(shift @$attr, shift @$attr) while @$attr; $self; } sub clone() { my $self = shift; (ref $self)->new($self->Name, $self->body); } sub length() { my $self = shift; length($self->{MMFF_name}) + 1 + length($self->{MMFF_body}); } sub name() { lc($_[0]->{MMFF_name}) } sub Name() { $_[0]->{MMFF_name} } sub folded(;$) { my $self = shift; wantarray or return $self->{MMFF_name}.':'.$self->{MMFF_body}; my @lines = $self->foldedBody; my $first = $self->{MMFF_name}. ':'. shift @lines; ($first, @lines); } sub unfoldedBody($;@) { my $self = shift; $self->{MMFF_body} = $self->fold($self->{MMFF_name}, @_) if @_; $self->unfold($self->{MMFF_body}); } sub foldedBody($) { my ($self, $body) = @_; if(@_==2) { $self->{MMFF_body} = $body } else { $body = $self->{MMFF_body} } wantarray ? (split /^/, $body) : $body; } 1; Mail-Message-4.03/lib/Mail/Message/Field/Flex.pod0000644000175000001440000002112215135671040022063 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::Flex - one line of a message header =head1 INHERITANCE Mail::Message::Field::Flex is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS =head1 DESCRIPTION This is the flexible implementation of a field: it can easily be extended because it stores its data in a hash and the constructor (C) and initializer (C) are split. However, you pay the price in performance. L is faster (as the name predicts). Extends L<"DESCRIPTION" in Mail::Message::Field|Mail::Message::Field/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field|Mail::Message::Field/"OVERLOADED">. =over 4 =item overload: B<""> stringification Inherited, see L =item overload: B<0+> numification Inherited, see L =item overload: B<<=>> numeric comparison Inherited, see L =item overload: B boolean Inherited, see L =item overload: B string comparison Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field|Mail::Message::Field/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field|Mail::Message::Field/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item $class-EB($line | ($name, ($body|$object|\@objects), [@attributes], [\%options|\@options])) If you stick to this flexible class of header fields, you have a bit more facilities than with L. Amongst it, you can specify options with the creation. Possible arguments: =over 4 =item * B C<$line> Pass a C<$line> as it could be found in a file: a (possibly folded) line which is terminated by a new-line. =item * B C<$name>, (C<$body>|C<$object>|\C<@objects>), [C<@attributes>], [\C<%options>|\C<@options>] A set of values which shape the line. =back To be able to distinguish the different parameters, you will have to specify the C<@options> as ARRAY of option PAIRS, or HASH of C<%options>. The C<@attributes> are a flat LIST of key-value PAIRS. The C<$body> is specified as one string, one C<$object>, or an ARRAY of C<@objects>. See L. Improves base, see L -Option --Default attributes +[ ] comment undef =over 2 =item attributes => \@attributes|\%attributes An ARRAY with contains of key-value pairs representing C<@attributes>, or reference to a HASH containing these pairs. This is an alternative notation for specifying C<@attributes> directly as method arguments. =item comment => $text A pre-formatted list of attributes. =back =back =head2 Attributes Extends L<"Attributes" in Mail::Message::Field|Mail::Message::Field/"Attributes">. =head2 The field Extends L<"The field" in Mail::Message::Field|Mail::Message::Field/"The field">. =over 4 =item $any-EB( [$name] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field|Mail::Message::Field/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field|Mail::Message::Field/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $any-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field|Mail::Message::Field/"Access to the content">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( $name, [$value] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field|Mail::Message::Field/"Other methods">. =over 4 =item $any-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field|Mail::Message::Field/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $any-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field|Mail::Message::Field/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field|Mail::Message::Field/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field|Mail::Message::Field/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Error: class $package does not implement method $method. Fatal error: the specific C<$package> (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Warning: field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. Cast by C =item Error: field name too long (max $count), in '$name'. It is not specified in the RFCs how long a field name can be, but at least it should be a few characters shorter than the line wrap. Cast by C =item Warning: illegal character in field name $name. A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. Cast by C =back =head1 SEE ALSO This module is part of Mail-Message version 4.03, built on January 26, 2026. Website: F =head1 LICENSE For contributors see file ChangeLog. This software is copyright (c) 2001-2026 by Mark Overmeer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Mail-Message-4.03/lib/Mail/Message/Field/Full.pm0000644000175000001440000002436715135671037021745 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 4.03. # The POD got stripped from this file by OODoc version 3.06. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2026 by Mark Overmeer. # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later package Mail::Message::Field::Full;{ our $VERSION = '4.03'; } use parent 'Mail::Message::Field'; use strict; use warnings; use utf8; use Log::Report 'mail-message', import => [ qw/__x error warning/ ]; use Encode (); use MIME::QuotedPrint (); use Storable qw/dclone/; use Mail::Message::Field::Addresses (); use Mail::Message::Field::AuthResults (); #use Mail::Message::Field::AuthRecChain (); use Mail::Message::Field::Date (); use Mail::Message::Field::DKIM (); use Mail::Message::Field::Structured (); use Mail::Message::Field::Unstructured (); use Mail::Message::Field::URIs (); my $atext = q[a-zA-Z0-9!#\$%&'*+\-\/=?^_`{|}~]; # from RFC5322 my $utf8_atext = q[\p{Alnum}!#\$%&'*+\-\/=?^_`{|}~]; # from RFC5335 my $atext_ill = q/\[\]/; # illegal, but still used (esp spam) #-------------------- use overload '""' => sub { shift->decodedBody }; #-------------------- my %implementation; BEGIN { $implementation{$_} = 'Addresses' for qw/from to sender cc bcc reply-to envelope-to resent-from resent-to resent-cc resent-bcc resent-reply-to resent-sender x-beenthere errors-to mail-follow-up x-loop delivered-to original-sender x-original-sender/; $implementation{$_} = 'URIs' for qw/list-help list-post list-subscribe list-unsubscribe list-archive list-owner/; $implementation{$_} = 'Structured' for qw/content-disposition content-type content-id/; $implementation{$_} = 'Date' for qw/date resent-date/; $implementation{$_} = 'AuthResults' for qw/authentication-results/; $implementation{$_} = 'DKIM' for qw/dkim-signature/; # $implementation{$_} = 'AuthRecChain' for qw/arc-authentication-results arc-message-signature arc-seal/; } sub new($;$$@) { my $class = shift; my $name = shift; my $body = @_ % 2 ? shift : undef; my %args = @_; $body = delete $args{body} if defined $args{body}; unless(defined $body) { (my $n, $body) = split /\s*\:\s*/s, $name, 2; $name = $n if defined $body; } $class eq __PACKAGE__ or return $class->SUPER::new(%args, name => $name, body => $body); # Look for best class to suit this field my $myclass = 'Mail::Message::Field::' . ($implementation{lc $name} || 'Unstructured'); $myclass->SUPER::new(%args, name => $name, body => $body); } sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{MMFF_name} = $args->{name}; my $body = $args->{body}; if(!defined $body || !length $body || ref $body) { ; } # no body yet elsif(index($body, "\n") >= 0) { $self->foldedBody($body) } # body is already folded else { $self->unfoldedBody($body) } # body must be folded $self; } sub clone() { dclone(shift) } sub name() { lc shift->{MMFF_name}} sub Name() { $_[0]->{MMFF_name} } sub folded() { my $self = shift; wantarray or return $self->{MMFF_name}.':'.$self->foldedBody; my @lines = $self->foldedBody; my $first = $self->{MMFF_name}. ':'. shift @lines; ($first, @lines); } sub unfoldedBody($;$) { my ($self, $body) = (shift, shift); if(defined $body) { $self->foldedBody(scalar $self->fold($self->{MMFF_name}, $body)); return $body; } $self->foldedBody =~ s/\r?\n(\s)/$1/gr =~ s/\r?\n/ /gr =~ s/^\s+//r =~ s/\s+$//r; } sub foldedBody($) { my ($self, $body) = @_; if(@_==2) { $self->parse($body); $body =~ s/^\s*/ /m; $self->{MMFF_body} = $body; } elsif(defined($body = $self->{MMFF_body})) { ; } else { # Create a new folded body from the parts. $self->{MMFF_body} = $body = $self->fold($self->{MMFF_name}, $self->produceBody); } wantarray ? (split /^/, $body) : $body; } #-------------------- sub from($@) { my ($class, $field) = (shift, shift); defined $field ? $class->new($field->Name, $field->foldedBody, @_) : (); } #-------------------- sub decodedBody() { my $self = shift; $self->decode($self->unfoldedBody, @_); } #-------------------- sub createComment($@) { my ($thing, $comment) = (shift, shift); $comment = $thing->encode($comment, @_) if @_; # encoding required... # Correct dangling parenthesis local $_ = $comment; # work with a copy s#\\[()]#xx#g; # remove escaped parens s#[^()]#x#g; # remove other chars while( s#\(([^()]*)\)#x$1x# ) {;} # remove pairs of parens substr($comment, CORE::length($_), 0, '\\') while s#[()][^()]*$##; # add escape before remaining parens $comment =~ s#\\+$##; # backslash at end confuses "($comment)"; } sub createPhrase($) { my $self = shift; local $_ = shift; # I do not case whether it gets a but sloppy in the header string, # as long as it is functionally correct: no folding inside phrase quotes. return $_ = $self->encode($_, @_, force => 1) if length $_ > 50; $_ = $self->encode($_, @_) if @_; # encoding required... if( m/[^$atext]/ ) { s#\\#\\\\#g; s#"#\\"#g; $_ = qq["$_"]; } $_; } sub beautify() { $_[0] } #-------------------- sub _mime_word($$) { "$_[0]$_[1]?=" } sub _encode_b($) { MIME::Base64::encode_base64(shift, '') } sub _encode_q($) # RFC2047 sections 4.2 and 5 { my $chunk = shift; $chunk =~ s#([^a-zA-Z0-9!*+/_ -])#sprintf "=%02X", ord $1#ge; $chunk =~ s#([_\?,"])#sprintf "=%02X", ord $1#ge; $chunk =~ s/ /_/g; # special case for =? ?= use $chunk; } sub encode($@) { my ($self, $utf8, %args) = @_; my ($charset, $lang, $encoding); if($charset = $args{charset}) { warning __x"illegal character in charset '{name}'.", name => $charset if $charset =~ m/[\x00-\ ()<>@,;:"\/[\]?.=\\]/; } else { $charset = $utf8 =~ /\P{ASCII}/ ? 'utf8' : 'us-ascii'; } if($lang = $args{language}) { warning __x"illegal character in language '{name}'.", name => $lang if $lang =~ m/[\x00-\ ()<>@,;:"\/[\]?.=\\]/; } if($encoding = $args{encoding}) { unless($encoding =~ m/^[bBqQ]$/ ) { warning __x"illegal encoding '{name}', using 'q'.", name => $encoding; $encoding = 'q'; } } else { $encoding = 'q' } my $name = $args{name}; my $lname = defined $name ? length($name)+1 : 0; return $utf8 if lc($encoding) eq 'q' && length $utf8 < 70 && ($utf8 =~ m/\A[\p{IsASCII}]+\z/ms && !$args{force}); my $pre = '=?'. $charset. ($lang ? '*'.$lang : '') .'?'.$encoding.'?'; my @result; if(lc($encoding) eq 'q') { my $chunk = ''; my $llen = 73 - length($pre) - $lname; while(length(my $chr = substr($utf8, 0, 1, ''))) { $chr = _encode_q Encode::encode($charset, $chr, 0); if(bytes::length($chunk) + bytes::length($chr) > $llen) { push @result, _mime_word($pre, $chunk); $chunk = ''; $llen = 73 - length $pre; } $chunk .= $chr; } push @result, _mime_word($pre, $chunk) if length($chunk); } else { my $chunk = ''; my $llen = int((73 - length($pre) - $lname) / 4) * 3; while(length(my $chr = substr($utf8, 0, 1, ''))) { my $chr = Encode::encode($charset, $chr, 0); if(bytes::length($chunk) + bytes::length($chr) > $llen) { push @result, _mime_word($pre, _encode_b($chunk)); $chunk = ''; $llen = int((73 - length $pre) / 4) * 3; } $chunk .= $chr; } push @result, _mime_word($pre, _encode_b($chunk)) if length $chunk; } join ' ', @result; } sub _decoder($$$) { my ($charset, $encoding, $encoded) = @_; $charset =~ s/\*[^*]+$//; # language component not used my $to_utf8 = Encode::find_encoding($charset || 'us-ascii'); $to_utf8 or return $encoded; my $decoded; if($encoding !~ /\S/) { $decoded = $encoded; } elsif(lc($encoding) eq 'q') { # Quoted-printable encoded specific to mime-fields $decoded = MIME::QuotedPrint::decode_qp($encoded =~ s/_/ /gr); } elsif(lc($encoding) eq 'b') { # Base64 encoded require MIME::Base64; $decoded = MIME::Base64::decode_base64($encoded); } else { # unknown encodings ignored return $encoded; } $to_utf8->decode($decoded, Encode::FB_DEFAULT); # error-chars -> '?' } sub decode($@) { my $thing = shift; my @encoded = split /(\=\?[^?\s]*\?[bqBQ]?\?[^?]*\?\=)/, shift; @encoded or return ''; my %args = @_; my $is_text = exists $args{is_text} ? $args{is_text} : 1; my @decoded = shift @encoded; while(@encoded) { shift(@encoded) =~ /\=\?([^?\s]*)\?([^?\s]*)\?([^?]*)\?\=/; push @decoded, _decoder $1, $2, $3; @encoded or last; # in text, blanks between encoding must be removed, but otherwise kept if($is_text && $encoded[0] !~ m/\S/) { shift @encoded } else { push @decoded, shift @encoded } } join '', @decoded; } #-------------------- sub parse($) { $_[0] } sub consumePhrase($) { my ($thing, $string) = @_; my $phrase; if($string =~ s/^\s*\" ((?:[^"\r\n\\]*|\\.)*) (?:\"|\s*$)//x ) { ($phrase = $1) =~ s/\\\"/"/g; } elsif($string =~ s/^\s*((?:\=\?.*?\?\=|[${utf8_atext}${atext_ill}\ \t.])+)//o ) { ($phrase = $1) =~ s/\s+$//; CORE::length($phrase) or undef $phrase; } defined $phrase ? ($thing->decode($phrase), $string) : (undef, $string); } sub consumeComment($) { my ($thing, $string) = @_; # Backslashes are officially not permitted in comments, but not everyone # knows that. Nested parens are supported. $string =~ s/^\s* \( ((?:\\.|[^)])*) (?:\)|$) //x or return (undef, $string); # allow unterminated comments my $comment = $1; # Continue consuming characters until we have balanced parens, for # nested comments which are permitted. while(1) { (my $count = $comment) =~ s/\\./xx/g; last if +( $count =~ tr/(// ) == ( $count =~ tr/)// ); last if $string !~ s/^((?:\\.|[^)])*) \)//x; # cannot satisfy $comment .= ')'.$1; } for($comment) { s/^\s+//; s/\s+$//; s/\\ ( [()] )/$1/gx; # Remove backslashes before nested comment. } ($comment, $string); } sub consumeDotAtom($) { my ($self, $string) = @_; my ($atom, $comment); while(1) { (my $c, $string) = $self->consumeComment($string); if(defined $c) { $comment .= $c; next } $string =~ s/^\s*([$atext]+(?:\.[$atext]+)*)//o or last; $atom .= $1; } ($atom, $string, $comment); } sub produceBody() { $_[0]->{MMFF_body} } #-------------------- 1; Mail-Message-4.03/lib/Mail/Message/Field/Attribute.pm0000644000175000001440000001131215135671037022770 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 4.03. # The POD got stripped from this file by OODoc version 3.06. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2026 by Mark Overmeer. # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later package Mail::Message::Field::Attribute;{ our $VERSION = '4.03'; } use parent 'Mail::Reporter'; use strict; use warnings; use Log::Report 'mail-message', import => [ qw/__x error warning/ ]; use Encode (); #-------------------- use overload '""' => sub { $_[0]->value }, cmp => sub { my ($self, $other) = @_; UNIVERSAL::isa($other, 'Mail::Message::Field') ? (lc($_[0])->name cmp lc($_[1]->name) || $_[0]->value cmp $_[1]->value) : $_[0]->value cmp $_[1]; }, fallback => 1; #-------------------- sub new($$@) { my ($class, $attr) = (shift, shift); my $value = @_ % 2 == 1 ? shift : undef; $class->SUPER::new(attr => $attr, value => $value, @_); } sub init($$) { my ($self, $args) = @_; $self->SUPER::init($args); my ($attr, $value, $cont) = @$args{ qw/attr value use_continuations/ }; my $name = ($attr =~ m/^(.*?)(?:\*\d+)?\*?\s*\=\s*/ ? $1 : $attr); warning __x"illegal character in parameter name '{name}'.", name => $name if $name !~ m/^[!#-'*+\-.0-9A-Z^-~]+$/; $self->{MMFF_name} = $name; $self->{MMFF_usecont} = $cont // 1; $self->{MMFF_charset} = $args->{charset} if defined $args->{charset}; $self->{MMFF_language} = $args->{language} if defined $args->{language}; $self->value(defined $value ? "$value" : ''); # enforce stringification $self->addComponent($attr) if $attr ne $name; $self; } #-------------------- sub name() { $_[0]->{MMFF_name} } sub value(;$) { my $self = shift; if(@_) { delete $self->{MMFF_cont}; return $self->{MMFF_value} = shift; } exists $self->{MMFF_value} ? $self->{MMFF_value} : $self->decode; } sub addComponent($) { my ($self, $component) = @_; defined $component or return; delete $self->{MMFF_value}; my ($name, $value) = split /\=/, $component, 2; if( substr($name, -1) eq '*' && $value =~ m/^([^']*)\'([^']*)\'/ ) { $self->{MMFF_charset} = length $1 ? $1 : undef; $self->{MMFF_language} = length $2 ? $2 : undef; } if( $name =~ m/\*([0-9]+)\*?$/ ) { $self->{MMFF_cont}[$1] = $component } else { $self->{MMFF_cont} = [ $component ] } $component; } sub charset() { $_[0]->{MMFF_charset} } sub language() { $_[0]->{MMFF_language} } sub string() { my $self = shift; my $cont = $self->{MMFF_cont} || $self->encode; wantarray? @$cont : (join '; ', '', @$cont); } #-------------------- sub encode() { my $self = shift; my $value = $self->{MMFF_value}; my @lines; my ($pre, $encoded); my $charset = $self->{MMFF_charset} || ''; my $lang = $self->{MMFF_language} || ''; my $name = $self->{MMFF_name}; my $cont = $self->{MMFF_usecont}; if($charset || $lang) { $pre = "$name*0*=$charset'$lang'"; $value = Encode::encode($charset, $value, 0); $encoded = 1; } elsif(grep m/[^\x20-\x7E]/, $value) { $pre = "$name*0*=''"; $encoded = 1; } else { $pre = "$name*0="; $value =~ s/"/\\"/g; $encoded = 0; } if($encoded) { # Use encoding my @c = split //, $value; while(@c) { my $c = shift @c; $c = '%'. sprintf "%02X", ord $c unless $c =~ m/[a-zA-Z0-9]/; if($cont && length($pre) + length($c)> 76) { push @lines, $pre; $pre = $name . '*' . @lines . '*=' . $c; } else { $pre .= $c } } push @lines, $pre; } elsif($cont) { # Simple string, but with continuations while(1) { push @lines, $pre.'"'. substr($value, 0, 75-length($pre), '') .'"'; length $value or last; $pre = $name . '*' . @lines . '='; } } else { # Single string only push @lines, $pre . $value; } $lines[0] =~ s/\*0// if @lines==1; $self->{MMFF_cont} = \@lines; } sub decode() { my $self = shift; my $value = ''; foreach my $cont ( @{$self->{MMFF_cont}} ) { unless(defined $cont) { $value .= "[continuation missing]"; next; } (my $name, local $_) = split /\=/, $cont, 2; if(substr($name, -1) eq '*') { s/^[^']*\'[^']*\'//; s/\%([a-fA-F0-9]{2})/chr hex $1/ge; } elsif( s/^\"(.*)\"$/$1/ ) { s/\\\"/"/g } elsif( s/^\'(.*)\'$/$1/ ) { s/\\\'/'/g } $value .= $_; } my $charset = $self->{MMFF_charset}; $value = Encode::decode($charset, $value, 0) if $charset; $self->{MMFF_value} = $value; } #-------------------- sub mergeComponent($) { my ($self, $comp) = @_; my $cont = $self->{MMFF_cont} or error __x"too late to merge: value already changed."; $self->addComponent($_) for @{$comp->{MMFF_cont}}; $self; } 1; Mail-Message-4.03/lib/Mail/Message/Field/Unstructured.pm0000644000175000001440000000206715135671037023543 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 4.03. # The POD got stripped from this file by OODoc version 3.06. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2026 by Mark Overmeer. # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later package Mail::Message::Field::Unstructured;{ our $VERSION = '4.03'; } use parent 'Mail::Message::Field::Full'; use strict; use warnings; use Log::Report 'mail-message', import => [ qw/__x warning/ ]; #-------------------- sub init($) { my ($self, $args) = @_; if($args->{body} && ($args->{encoding} || $args->{charset})) { $args->{body} = $self->encode($args->{body}, %$args); } $self->SUPER::init($args); ! defined $args->{attributes} or warning __x"attributes are not supported for unstructured fields."; ! defined $args->{extra} or warning __x"no extras for unstructured fields."; $self; } #-------------------- 1; Mail-Message-4.03/lib/Mail/Message/Field/URIs.pod0000644000175000001440000002746515135671040022027 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::URIs - message header field with uris =head1 INHERITANCE Mail::Message::Field::URIs is a Mail::Message::Field::Structured is a Mail::Message::Field::Full is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS my $f = Mail::Message::Field->new('List-Post' => 'http://x.org/'); my $g = Mail::Message::Field->new('List-Post'); $g->addURI('http://x.org'); my $uri = URI->new(...); $g->addURI($uri); my @uris = $g->URIs; =head1 DESCRIPTION More recent RFCs prefer uri field notation over the various differentiated syntaxes. Especially the mailing-list RFCs use these fields all the time. This class can maintain these fields. Extends L<"DESCRIPTION" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"OVERLOADED">. =over 4 =item overload: B<""> stringification Inherited, see L =item overload: B<0+> numification Inherited, see L =item overload: B<<=>> numeric comparison Inherited, see L =item overload: B boolean Inherited, see L =item overload: B string comparison Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item $class-EB($field, %options) Inherited, see L =item $class-EB($data) Inherited, see L -Option --Defined in --Default attributes Mail::Message::Field::Structured charset Mail::Message::Field::Full undef datum Mail::Message::Field::Structured undef encoding Mail::Message::Field::Full 'q' force Mail::Message::Field::Full false language Mail::Message::Field::Full undef =over 2 =item attributes => \@attributes|\%attributes =item charset => $charset =item datum => $date =item encoding => 'q'|'Q'|'b'|'B' =item force => BOOLEAN =item language => $language =back » example: my $mmfu = 'Mail::Message::Field::URIs; my $f = $mmfu->new('List-Post' => 'mailto:x@y.com'); my $f = $mmfu->new('List-Post' => ''); my $f = $mmfu->new('List-Post: '); my $f = $mmfu->new('List-Post' => [ $uri, 'http://x.org' ]); =back =head2 Attributes Extends L<"Attributes" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Attributes">. =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $any-EB( [$name] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $any-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the content">. =over 4 =item $obj-EB() Returns a list with all URIs defined by the field. Mind the lower-case 's' at the enc of the name. » example: my @uris = $field->URIs; =item $obj-EB(...) Attributes are not supported for URI fields. =item $obj-EB($uri) Add an C<$uri> to the field. The C<$uri> can be specified as URI object or as string which will be turned into an C<$uri> object. The added C<$uri> is returned. » example: adding an URI to an URI field my $f = Mail::Message::Field::URI->new('List-Post'); my $uri = URI->new("http://x.org"); $f->addURI($uri); $f->addURI("http://y.org"); # simpler $f->addURI("//y.org", "http"); =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( $object||<$name,$value,%options> ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Other methods">. =over 4 =item $any-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING, %options) Inherited, see L =item $any-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Parsing Extends L<"Parsing" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Parsing">. =over 4 =item $any-EB(STRING) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $any-EB(STRING) Inherited, see L =item $obj-EB( [$value] ) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Error: class $package does not implement method $method. Fatal error: the specific C<$package> (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Warning: field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. Cast by C =item Error: field name too long (max $count), in '$name'. It is not specified in the RFCs how long a field name can be, but at least it should be a few characters shorter than the line wrap. Cast by C =item Warning: illegal character in charset '$name'. The field is created with an utf8 string which only contains data from the specified character set. However, that character set can never be a valid name because it contains characters which are not permitted. Cast by C =item Warning: illegal character in field name $name. A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. Cast by C =item Warning: illegal character in language '$name'. The field is created with data which is specified to be in a certain language, however, the name of the language cannot be valid: it contains characters which are not permitted by the RFCs. Cast by C =item Warning: illegal encoding '$name', using 'q'. The RFCs only permit base64 (C or C) or quoted-printable (C or C) encoding. Other than these four options are illegal. Cast by C =item Error: no attributes for URI fields. Is is not possible to add attributes to URI fields: it is not permitted by the RFCs. Cast by C =back =head1 SEE ALSO This module is part of Mail-Message version 4.03, built on January 26, 2026. Website: F =head1 LICENSE For contributors see file ChangeLog. This software is copyright (c) 2001-2026 by Mark Overmeer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Mail-Message-4.03/lib/Mail/Message/Field/DKIM.pod0000644000175000001440000003150215135671040021714 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::DKIM - message header field for dkim signatures =head1 INHERITANCE Mail::Message::Field::DKIM is a Mail::Message::Field::Structured is a Mail::Message::Field::Full is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS my $f = Mail::Message::Field->new('DKIM-Signature' => '...'); my $g = Mail::Message::Field->new('DKIM-Signature'); $g->add... =head1 DESCRIPTION Decode the information contained in a DKIM header. You can also construct DKIM-Signature headers this way. However, verification and signing is not yet implemented. This implementation is based on RFC6376. Extends L<"DESCRIPTION" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"OVERLOADED">. =over 4 =item overload: B<""> stringification Inherited, see L =item overload: B<0+> numification Inherited, see L =item overload: B<<=>> numeric comparison Inherited, see L =item overload: B boolean Inherited, see L =item overload: B string comparison Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item $class-EB($field, %options) Inherited, see L =item $class-EB($data) Inherited, see L -Option --Defined in --Default attributes Mail::Message::Field::Structured charset Mail::Message::Field::Full undef datum Mail::Message::Field::Structured undef encoding Mail::Message::Field::Full 'q' force Mail::Message::Field::Full false language Mail::Message::Field::Full undef =over 2 =item attributes => \@attributes|\%attributes =item charset => $charset =item datum => $date =item encoding => 'q'|'Q'|'b'|'B' =item force => BOOLEAN =item language => $language =back =back =head2 Attributes Extends L<"Attributes" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Attributes">. =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $any-EB( [$name] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $any-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the content">. =over 4 =item $obj-EB(...) Attributes are not supported here. =item $obj-EB($name, $value|@values) Add a tag to the set. When the tag already exists, it is replaced. Names are (converted to) lower-case. When multiple values are given, they will be concatenated with a blank (and may get folded there later) =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( $object||<$name,$value,%options> ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($name) Returns the value for the named tag. =item $any-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head3 DKIM-Signature tags The tag methods return the tag-value content without any validation or modification. For many situations, the actual content does not need (expensive) validation and interpretation. =over 4 =item $obj-EB() The Agent or User Identifier (AUID). Defaults to C<@$domain> =item $obj-EB() Signature algorithm. Should be rsa-sha(1|256): check before use. Required. =item $obj-EB() The number of octets which where used to calculate the hash. By default, the whole body was used. =item $obj-EB() The canonicalization method used. Defaults to 'simple/simple'. =item $obj-EB() The sub-domain (SDID) which claims responsibility for this signature. Required. =item $obj-EB() The timestamp when the signature will expire. Recommended. =item $obj-EB() Some headers from the original message packed together. =item $obj-EB() A colon-separated list of method which can be used to retrieve the public key. The default is "dns/txt" (currently the only valid option) =item $obj-EB() The selector subdividing the domain tag. Required. =item $obj-EB() Z<> =item $obj-EB() Message signature in base64, with whitespaces removed. Required. =item $obj-EB() The colon separated list of headers which need to be included in the signature. Required. =item $obj-EB() When the signature was created in UNIX-like seconds (since 1970). Recommended. =item $obj-EB() Signature header syntax version (usually 1) =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Other methods">. =over 4 =item $any-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING, %options) Inherited, see L =item $any-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Parsing Extends L<"Parsing" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Parsing">. =over 4 =item $any-EB(STRING) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $any-EB(STRING) Inherited, see L =item $obj-EB( [$value] ) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Error: class $package does not implement method $method. Fatal error: the specific C<$package> (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Warning: field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. Cast by C =item Error: field name too long (max $count), in '$name'. It is not specified in the RFCs how long a field name can be, but at least it should be a few characters shorter than the line wrap. Cast by C =item Warning: illegal character in charset '$name'. The field is created with an utf8 string which only contains data from the specified character set. However, that character set can never be a valid name because it contains characters which are not permitted. Cast by C =item Warning: illegal character in field name $name. A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. Cast by C =item Warning: illegal character in language '$name'. The field is created with data which is specified to be in a certain language, however, the name of the language cannot be valid: it contains characters which are not permitted by the RFCs. Cast by C =item Warning: illegal encoding '$name', using 'q'. The RFCs only permit base64 (C or C) or quoted-printable (C or C) encoding. Other than these four options are illegal. Cast by C =item Error: no attributes for DKIM headers. Is is not possible to add attributes to this field. Cast by C =back =head1 SEE ALSO This module is part of Mail-Message version 4.03, built on January 26, 2026. Website: F =head1 LICENSE For contributors see file ChangeLog. This software is copyright (c) 2001-2026 by Mark Overmeer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Mail-Message-4.03/lib/Mail/Message/Field/Addresses.pm0000644000175000001440000001325015135671037022745 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 4.03. # The POD got stripped from this file by OODoc version 3.06. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2026 by Mark Overmeer. # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later package Mail::Message::Field::Addresses;{ our $VERSION = '4.03'; } use parent 'Mail::Message::Field::Structured'; use strict; use warnings; use Log::Report 'mail-message', import => [ qw/__x error info warning/ ]; use Mail::Message::Field::AddrGroup (); use Mail::Message::Field::Address (); use List::Util qw/first/; use Scalar::Util qw/blessed/; #-------------------- # what is permitted for each field. my $address_list = +{ groups => 1, multi => 1 }; my $mailbox_list = +{ multi => 1 }; my $mailbox = +{ }; my %accepted = ( # defaults to $address_list from => $mailbox_list, sender => $mailbox, ); sub init($) { my ($self, $args) = @_; $self->{MMFF_groups} = []; my $def = lc $args->{name} =~ s/^resent\-//r; $self->{MMFF_defaults} = $accepted{$def} || $address_list; my ($body, @body); if($body = $args->{body}) { @body = ref $body eq 'ARRAY' ? @$body : ($body); @body or return (); } if(@body > 1 || ref $body[0]) { $self->addAddress($_) for @body; delete $args->{body}; } $self->SUPER::init($args); } #-------------------- sub addAddress(@) { my $self = shift; my $email = blessed $_[0] ? shift : undef; my %args = @_; my $group = delete $args{group} // ''; $email //= Mail::Message::Field::Address->new(%args); my $set = $self->group($group) // $self->addGroup(name => $group); $set->addAddress($email); $email; } sub addGroup(@) { my $self = shift; my $group = @_ == 1 ? shift : Mail::Message::Field::AddrGroup->new(@_); push @{$self->{MMFF_groups}}, $group; $group; } sub group($) { my ($self, $name) = @_; $name //= ''; first { lc($_->name) eq lc($name) } $self->groups; } sub groups() { @{ $_[0]->{MMFF_groups}} } sub groupNames() { map $_->name, $_[0]->groups } sub addresses() { map $_->addresses, $_[0]->groups } sub addAttribute($;@) { my $self = shift; error __x"no attributes for address fields."; } #-------------------- sub parse($) { my ($self, $string) = @_; my ($group, $email) = ('', undef); $string =~ s/\s+/ /gs; ADDRESS: while(1) { (my $comment, $string) = $self->consumeComment($string); my $start_length = length $string; if($string =~ s/^\s*\;//s ) { $group = ''; next ADDRESS } # end group if($string =~ s/^\s*\,//s ) { next ADDRESS} # end address (my $email, $string) = $self->consumeAddress($string); if(defined $email) { # Pattern starts with e-mail address ($comment, $string) = $self->consumeComment($string); $email->comment($comment) if defined $comment; } else { # Pattern not plain address my $real_phrase = $string =~ m/^\s*\"/; my @words; # In rfc2822 obs-phrase, we can have more than one word with # comments inbetween. WORD: while(1) { (my $word, $string) = $self->consumePhrase($string); defined $word or last; push @words, $word if length $word; ($comment, $string) = $self->consumeComment($string); if($string =~ s/^\s*\://s ) { $group = $word; # even empty groups must appear $self->addGroup(name => $group) unless $self->group($group); next ADDRESS; } } my $phrase = @words ? join ' ', @words : undef; my $angle; if($string =~ s/^\s*\<([^>]*)\>//s) { $angle = $1 } elsif($real_phrase) { warning __x"ignoring addressless phrase '{phrase}'.", phrase => $1 if $string =~ s/^\s*\"(.*?)\r?\n//; next ADDRESS; } elsif(defined $phrase) { ($angle = $phrase) =~ s/\s+/./g; undef $phrase; } ($comment, $string) = $self->consumeComment($string); # remove obsoleted route info. defined $angle or return 1; $angle =~ s/^\@.*?\://; ($email, $angle) = $self->consumeAddress($angle, phrase => $phrase, comment => $comment); } $self->addAddress($email, group => $group) if defined $email; return 1 if $string =~ m/^\s*$/s; # Do not get stuck on illegal characters last if $start_length == length $string; } warning __x"illegal part in address field {name}: {part}.", name => $self->Name, part => $string; 0; } sub produceBody() { my $self = shift; my @groups = sort { $a->name cmp $b->name } $self->groups; @groups or return ''; @groups > 1 or return $groups[0]->string; my $plain = $groups[0]->name eq '' && $groups[0]->addresses ? (shift @groups)->string.',' : ''; join ' ', $plain, (map $_->string, @groups); } sub consumeAddress($@) { my ($self, $string, @options) = @_; my ($local, $shorter, $loccomment); if($string =~ s/^\s*"((?:\\.|[^"])*)"\s*\@/@/) { # local part is quoted-string rfc2822 ($local, $shorter) = ($1, $string); $local =~ s/\\"/"/g; } else { ($local, $shorter, $loccomment) = $self->consumeDotAtom($string); $local =~ s/\s//g if defined $local; } defined $local && $shorter =~ s/^\s*\@// or return (undef, $string); (my $domain, $shorter, my $domcomment) = $self->consumeDomain($shorter); defined $domain or return (undef, $string); # loccomment and domcomment ignored my $email = Mail::Message::Field::Address->new(username => $local, domain => $domain, @options); ($email, $shorter); } sub consumeDomain($) { my ($self, $string) = @_; return ($self->stripCFWS($1), $string) if $string =~ s/\s*(\[(?:[^[]\\]*|\\.)*\])//; my ($atom, $rest, $comment) = $self->consumeDotAtom($string); $atom =~ s/\s//g if defined $atom; ($atom, $rest, $comment); } #-------------------- 1; Mail-Message-4.03/lib/Mail/Message/Field/AuthResults.pod0000644000175000001440000002761415135671040023464 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::AuthResults - message header field authentication result =head1 INHERITANCE Mail::Message::Field::AuthResults is a Mail::Message::Field::Structured is a Mail::Message::Field::Full is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS my $f = Mail::Message::Field->new('Authentication-Results' => '...'); my $g = Mail::Message::Field->new('Authentication-Results'); $g->addResult(method => 'dkim', result => 'fail'); =head1 DESCRIPTION Mail Transfer Agents may check the authenticity of an incoming message. They add 'Authentication-Results' headers, maybe more than one. This implementation is based on RFC7601. Extends L<"DESCRIPTION" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"OVERLOADED">. =over 4 =item overload: B<""> stringification Inherited, see L =item overload: B<0+> numification Inherited, see L =item overload: B<<=>> numeric comparison Inherited, see L =item overload: B boolean Inherited, see L =item overload: B string comparison Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item $class-EB($field, %options) Inherited, see L =item $class-EB(%options) Inherited, see L -Option --Defined in --Default attributes Mail::Message::Field::Structured charset Mail::Message::Field::Full undef datum Mail::Message::Field::Structured undef encoding Mail::Message::Field::Full 'q' force Mail::Message::Field::Full false language Mail::Message::Field::Full undef results [] server version undef =over 2 =item attributes => \@attributes|\%attributes =item charset => $charset =item datum => $date =item encoding => 'q'|'Q'|'b'|'B' =item force => BOOLEAN =item language => $language =item results => ARRAY Each authentication method is represented by a HASH, which contains the 'method' and 'result' keys. Sometimes, there is a 'comment'. Properties of form 'ptype.pname' will be there as well. =item server => $domain Where the authentication tool ran. This should be your local service, otherwise you may accept spoofed headers! =item version => INTEGER =back =back =head2 Attributes Extends L<"Attributes" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Attributes">. =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $any-EB( [$name] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $any-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the content">. =over 4 =item $obj-EB(...) Attributes are not supported here. =item $obj-EB(HASH|PAIRS) Add new results to this header. Invalid results are ignored. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( $object||<$name,$value,%options> ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $obj-EB() Returns a LIST of result HASHes. Each HASH at least contains keys 'method', 'method_version', and 'result'. =item $obj-EB() The hostname which ran this authentication tool. =item $obj-EB() Inherited, see L =item $any-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() The version of the 'Authentication-Results' header, which may be different from '1' (default) for successors of RFC7601. =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Other methods">. =over 4 =item $any-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING, %options) Inherited, see L =item $any-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Parsing Extends L<"Parsing" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Parsing">. =over 4 =item $any-EB(STRING) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $any-EB(STRING) Inherited, see L =item $obj-EB( [$value] ) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Error: class $package does not implement method $method. Fatal error: the specific C<$package> (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Warning: field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. Cast by C =item Error: field name too long (max $count), in '$name'. It is not specified in the RFCs how long a field name can be, but at least it should be a few characters shorter than the line wrap. Cast by C =item Warning: illegal character in charset '$name'. The field is created with an utf8 string which only contains data from the specified character set. However, that character set can never be a valid name because it contains characters which are not permitted. Cast by C =item Warning: illegal character in field name $name. A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. Cast by C =item Warning: illegal character in language '$name'. The field is created with data which is specified to be in a certain language, however, the name of the language cannot be valid: it contains characters which are not permitted by the RFCs. Cast by C =item Warning: illegal encoding '$name', using 'q'. The RFCs only permit base64 (C or C) or quoted-printable (C or C) encoding. Other than these four options are illegal. Cast by C =item Error: no attributes for Authentication-Results. Is is not possible to add attributes to this field. Cast by C =back =head1 SEE ALSO This module is part of Mail-Message version 4.03, built on January 26, 2026. Website: F =head1 LICENSE For contributors see file ChangeLog. This software is copyright (c) 2001-2026 by Mark Overmeer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Mail-Message-4.03/lib/Mail/Message/Field/Structured.pm0000644000175000001440000000637015135671037023201 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 4.03. # The POD got stripped from this file by OODoc version 3.06. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2026 by Mark Overmeer. # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later package Mail::Message::Field::Structured;{ our $VERSION = '4.03'; } use parent 'Mail::Message::Field::Full'; use strict; use warnings; use Log::Report 'mail-message', import => [ qw// ]; use Mail::Message::Field::Attribute (); use Storable qw/dclone/; #-------------------- sub init($) { my ($self, $args) = @_; $self->{MMFS_attrs} = {}; $self->{MMFS_datum} = $args->{datum}; $self->SUPER::init($args); my $attr = $args->{attributes} || []; $attr = [ %$attr ] if ref $attr eq 'HASH'; while(@$attr) { my $name = shift @$attr; if(ref $name) { $self->attribute($name) } else { $self->attribute($name, shift @$attr) } } $self; } sub clone() { dclone(shift) } #-------------------- sub attribute($;$) { my ($self, $attr) = (shift, shift); my $name; if(ref $attr) { $name = $attr->name } elsif( !@_ ) { return $self->{MMFS_attrs}{lc $attr} } else { $name = $attr; $attr = Mail::Message::Field::Attribute->new($name, @_); } delete $self->{MMFF_body}; $self->{MMFS_attrs}{lc $name} = $attr; } sub attributes() { values %{$_[0]->{MMFS_attrs}} } sub beautify() { delete $_[0]->{MMFF_body} } sub attrPairs() { map +($_->name, $_->value), $_[0]->attributes } #-------------------- sub parse($) { my ($self, $string) = @_; for($string) { # remove FWS, even within quoted strings s/\r?\n(\s)/$1/gs; s/\r?\n/ /gs; s/\s+$//; } my $datum = ''; while(length $string && substr($string, 0, 1) ne ';') { (undef, $string) = $self->consumeComment($string); $datum .= $1 if $string =~ s/^([^;(]+)//; } $self->{MMFS_datum} = $datum; my $found = ''; while($string =~ m/\S/) { my $len = length $string; if($string =~ s/^\s*\;\s*// && length $found) { my ($name) = $found =~ m/^([^*]+)\*/; if($name && (my $cont = $self->attribute($name))) { $cont->addComponent($found); # continuation } else { my $attr = Mail::Message::Field::Attribute->new($found); $self->attribute($attr); } $found = ''; } (undef, $string) = $self->consumeComment($string); $string =~ s/^\n//; (my $text, $string) = $self->consumePhrase($string); $found .= $text if defined $text; if(length($string) == $len) { # nothing consumed, remove character to avoid endless loop $string =~ s/^\s*\S//; } } if(length $found) { my ($name) = $found =~ m/^([^*]+)\*/; if($name && (my $cont = $self->attribute($name))) { $cont->addComponent($found); # continuation } else { my $attr = Mail::Message::Field::Attribute->new($found); $self->attribute($attr); } } 1; } sub produceBody() { my $self = shift; my $attrs = $self->{MMFS_attrs}; my $datum = $self->{MMFS_datum}; join '; ', ($datum // ''), map $_->string, @{$attrs}{sort keys %$attrs}; } sub datum(@) { my $self = shift; @_ or return $self->{MMFS_datum}; delete $self->{MMFF_body}; $self->{MMFS_datum} = shift; } 1; Mail-Message-4.03/lib/Mail/Message/Field/Date.pod0000644000175000001440000002613015135671040022046 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::Date - message header field with uris =head1 INHERITANCE Mail::Message::Field::Date is a Mail::Message::Field::Structured is a Mail::Message::Field::Full is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS my $f = Mail::Message::Field->new(Date => time); my $date = $f->date; # cleaned-up and validated. =head1 DESCRIPTION Dates are a little more tricky than it should be: the formatting permits a few constructs more than other RFCs use for timestamps. For instance, a small subset of timezone abbreviations are permitted. The studied date field will reformat the content into a standard form. Extends L<"DESCRIPTION" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"OVERLOADED">. =over 4 =item overload: B<""> stringification Inherited, see L =item overload: B<0+> numification Inherited, see L =item overload: B<<=>> numeric comparison Inherited, see L =item overload: B boolean Inherited, see L =item overload: B string comparison Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item $class-EB($field, %options) Inherited, see L =item $class-EB($data) Inherited, see L -Option --Defined in --Default attributes Mail::Message::Field::Structured charset Mail::Message::Field::Full undef datum Mail::Message::Field::Structured undef encoding Mail::Message::Field::Full 'q' force Mail::Message::Field::Full false language Mail::Message::Field::Full undef =over 2 =item attributes => \@attributes|\%attributes =item charset => $charset =item datum => $date =item encoding => 'q'|'Q'|'b'|'B' =item force => BOOLEAN =item language => $language =back » example: my $mmfd = 'Mail::Message::Field::Date'; my $f = $mmfd->new(Date => time); =back =head2 Attributes Extends L<"Attributes" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Attributes">. =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $any-EB( [$name] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $any-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the content">. =over 4 =item $obj-EB(...) Attributes are not supported for date fields. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( $object||<$name,$value,%options> ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $any-EB(STRING, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB