Mail-Message-3.019/0000755000175000001440000000000015111124101014473 5ustar00markovusers00000000000000Mail-Message-3.019/lib/0000755000175000001440000000000015111124101015241 5ustar00markovusers00000000000000Mail-Message-3.019/lib/Mail/0000755000175000001440000000000015111124101016123 5ustar00markovusers00000000000000Mail-Message-3.019/lib/Mail/Message/0000755000175000001440000000000015111124101017507 5ustar00markovusers00000000000000Mail-Message-3.019/lib/Mail/Message/Field/0000755000175000001440000000000015111124101020532 5ustar00markovusers00000000000000Mail-Message-3.019/lib/Mail/Message/Field/Address.pm0000644000175000001440000000400515111124066022466 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 3.019. # The POD got stripped from this file by OODoc version 3.05. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2025 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::Address;{ our $VERSION = '3.019'; } use base 'Mail::Identity'; use strict; use warnings; use Mail::Message::Field::Addresses (); use Mail::Message::Field::Full (); use Scalar::Util qw/blessed/; my $format = 'Mail::Message::Field::Full'; #-------------------- use overload '""' => 'string', bool => sub {1}, cmp => sub { lc($_[0]->address) cmp lc($_[1]) }; #-------------------- sub coerce($@) { my ($class, $addr, %args) = @_; return () unless defined $addr; blessed $addr or return $class->parse($addr); $addr->isa($class) and return $addr; my $from = $class->from($addr, %args); Mail::Reporter->log(ERROR => "Cannot coerce a ".ref($addr)." into a $class"), return () unless defined $from; bless $from, $class; } sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{MMFA_encoding} = delete $args->{encoding}; $self; } sub parse($) { my $self = shift; my $parsed = Mail::Message::Field::Addresses->new(To => shift); defined $parsed ? ($parsed->addresses)[0] : (); } #-------------------- sub encoding() { $_[0]->{MMFA_encoding} } #-------------------- sub string() { my $self = shift; my @opts = (charset => $self->charset, encoding => $self->encoding); # language => $self->language my @parts; my $phrase = $self->phrase; push @parts, $format->createPhrase($phrase, @opts) if defined $phrase; my $address = $self->address; push @parts, @parts ? '<'.$address.'>' : $address; my $comment = $self->comment; push @parts, $format->createComment($comment, @opts) if defined $comment; join ' ', @parts; } 1; Mail-Message-3.019/lib/Mail/Message/Field/Full.pm0000644000175000001440000002423315111124066022010 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 3.019. # The POD got stripped from this file by OODoc version 3.05. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2025 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 = '3.019'; } use base 'Mail::Message::Field'; use strict; use warnings; use utf8; 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}) { $self->log(WARNING => "Illegal character in charset '$charset'") if $charset =~ m/[\x00-\ ()<>@,;:"\/[\]?.=\\]/; } else { $charset = $utf8 =~ /\P{ASCII}/ ? 'utf8' : 'us-ascii'; } if($lang = $args{language}) { $self->log(WARNING => "Illegal character in language '$lang'") if $lang =~ m/[\x00-\ ()<>@,;:"\/[\]?.=\\]/; } if($encoding = $args{encoding}) { unless($encoding =~ m/^[bBqQ]$/ ) { $self->log(WARNING => "Illegal encoding '$encoding', used 'q'"); $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-3.019/lib/Mail/Message/Field/DKIM.pod0000644000175000001440000003361315111124067022003 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 log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =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 log => LEVEL =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =back =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $any-EB() 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($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) 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 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 $length), 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 '$charset' 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 '$lang' 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 '$encoding', used '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 =item Error: Package $package does not implement $method. Fatal error: the specific 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 =back =head1 SEE ALSO This module is part of Mail-Message version 3.019, built on November 24, 2025. Website: F =head1 LICENSE For contributors see file ChangeLog. This software is copyright (c) 2001-2025 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-3.019/lib/Mail/Message/Field/URIs.pod0000644000175000001440000003157715111124067022110 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 log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =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 log => LEVEL =item trace => LEVEL =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">. =over 4 =item $obj-EB() Inherited, see L =back =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $any-EB() 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($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) 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 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 $length), 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 '$charset' 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 '$lang' 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 '$encoding', used '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 =item Error: Package $package does not implement $method. Fatal error: the specific 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 =back =head1 SEE ALSO This module is part of Mail-Message version 3.019, built on November 24, 2025. Website: F =head1 LICENSE For contributors see file ChangeLog. This software is copyright (c) 2001-2025 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-3.019/lib/Mail/Message/Field/Address.pod0000644000175000001440000001435515111124067022646 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::Address - One e-mail address =head1 INHERITANCE Mail::Message::Field::Address is a Mail::Identity is a User::Identity::Item =head1 SYNOPSIS my $addr = Mail::Message::Field::Address->new(...); my $ui = User::Identity->new(...); my $addr = Mail::Message::Field::Address->coerce($ui); my $mi = Mail::Identity->new(...); my $addr = Mail::Message::Field::Address->coerce($mi); print $addr->address; print $addr->fullName; # possibly unicode! print $addr->domain; =head1 DESCRIPTION Many header fields can contain e-mail addresses. Each e-mail address can be represented by an object of this class. These objects will handle interpretation and character set encoding and decoding for you. Extends L<"DESCRIPTION" in Mail::Identity|Mail::Identity/"DESCRIPTION">. =head1 OVERLOADED =over 4 =item overload: B<""> stringification When the object is used in string context, it will return the encoded representation of the e-mail address, just like L does. =item overload: B true/falase The object used as boolean will always return C =item overload: B string comparison Two address objects are the same when their email addresses are the same. =back =head1 METHODS Extends L<"METHODS" in Mail::Identity|Mail::Identity/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Identity|Mail::Identity/"Constructors">. =over 4 =item $obj-EB( , %options ) Try to coerce the C<$object> into a C. In case of a C, it is interpreted as an email address. The C<%options> are passed to the object creation, and overrule the values found in the C<$object>. The result may be C or a newly created object. If the C<$object> is already of the correct type, it is returned unmodified. The C<$object> may currently be a L, a L, or a L. In case of the latter, one of the user's addresses is chosen at random. =item $class-EB( [$name], %options ) Inherited, see L =item $obj-EB(STRING) Parse the string for an address. You never know whether one or more addresses are specified on a line (often applications are wrong), therefore, the C is first parsed for as many addresses as possible and then the one is taken at random. =back =head2 Attributes Extends L<"Attributes" in Mail::Identity|Mail::Identity/"Attributes">. =over 4 =item $obj-EB
() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$newname] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Collections Extends L<"Collections" in Mail::Identity|Mail::Identity/"Collections">. =over 4 =item $obj-EB($collection, $role) Inherited, see L =item $obj-EB( $object | <[$type], %options> ) Inherited, see L =item $obj-EB($name) Inherited, see L =item $obj-EB( [$parent] ) Inherited, see L =item $obj-EB($object|$name) Inherited, see L =item $any-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Searching Extends L<"Searching" in Mail::Identity|Mail::Identity/"Searching">. =over 4 =item $obj-EB($collection, $role) Inherited, see L =back =head2 Accessors =over 4 =item $obj-EB() Character-set encoding, like 'q' and 'b', to be used when non-ascii characters are to be transmitted. =back =head2 Access to the content =over 4 =item $obj-EB() Returns an RFC compliant e-mail address, which will have character set encoding if needed. The objects are also overloaded to call this method in string context. » example: print $address->string; print $address; # via overloading =back =head1 DIAGNOSTICS =over 4 =item Error: Cannot coerce a $type into a Mail::Message::Field::Address When addresses are specified to be included in header fields, they may be coerced into L objects first. What you specify is not accepted as address specification. This may be an internal error. Cast by C =item Error: cannot load collection module for $type ($class): $err Either the specified C<$type> does not exist, or that module named C<$class> returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. Cast by C =item Error: nvalid collection $name. The collection with C<$name> does not exist and can not be created. Cast by C =item Error: this $object is not a collection. Cast by C =back =head1 SEE ALSO This module is part of Mail-Message version 3.019, built on November 24, 2025. Website: F =head1 LICENSE For contributors see file ChangeLog. This software is copyright (c) 2001-2025 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-3.019/lib/Mail/Message/Field/AuthResults.pm0000644000175000001440000001112615111124066023366 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 3.019. # The POD got stripped from this file by OODoc version 3.05. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2025 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::AuthResults;{ our $VERSION = '3.019'; } use base 'Mail::Message::Field::Structured'; use warnings; use strict; use URI; #-------------------- #-------------------- sub init($) { my ($self, $args) = @_; $self->{MMFA_server} = delete $args->{server}; $self->{MMFA_version} = delete $args->{version}; $self->{MMFA_results} = []; $self->addResult($_) for @{delete $args->{results} || []}; $self->SUPER::init($args); } sub parse($) { my ($self, $string) = @_; $string =~ s/\r?\n/ /g; (undef, $string) = $self->consumeComment($string); $self->{MMFA_server} = $string =~ s/^\s*([.\w-]*\w)// ? $1 : 'unknown'; (undef, $string) = $self->consumeComment($string); $self->{MMFA_version} = $string =~ s/^\s*([0-9]+)// ? $1 : 1; (undef, $string) = $self->consumeComment($string); $string =~ s/^.*?\;/;/; # remove accidents my @results; while( $string =~ s/^\s*\;// ) { (undef, $string) = $self->consumeComment($string); if($string =~ s/^\s*none//) { (undef, $string) = $self->consumeComment($string); next; } my %result; push @results, \%result; $string =~ s/^\s*([\w-]*\w)// or next; $result{method} = $1; (undef, $string) = $self->consumeComment($string); if($string =~ s!^\s*/!!) { (undef, $string) = $self->consumeComment($string); $result{method_version} = $1 if $string =~ s/^\s*([0-9]+)//; } (undef, $string) = $self->consumeComment($string); if($string =~ s/^\s*\=//) { (undef, $string) = $self->consumeComment($string); $result{result} = $1 if $string =~ s/^\s*(\w+)//; } (my $comment, $string) = $self->consumeComment($string); if($comment) { $result{comment} = $comment; (undef, $string) = $self->consumeComment($string); } if($string =~ s/\s*reason//) { (undef, $string) = $self->consumeComment($string); if($string =~ s/\s*\=//) { (undef, $string) = $self->consumeComment($string); $result{reason} = $1 if $string =~ s/^\"([^"]*)\"// || $string =~ s/^\'([^']*)\'// || $string =~ s/^(\w+)//; } } while($string =~ /\S/) { (undef, $string) = $self->consumeComment($string); last if $string =~ /^\s*\;/; my $ptype = $string =~ s/^\s*([\w-]+)// ? $1 : last; (undef, $string) = $self->consumeComment($string); my ($property, $value); if($string =~ s/^\s*\.//) { (undef, $string) = $self->consumeComment($string); $property = $string =~ s/^\s*([\w-]+)// ? $1 : last; (undef, $string) = $self->consumeComment($string); if($string =~ s/^\s*\=//) { (undef, $string) = $self->consumeComment($string); $string =~ s/^\s+//; $string =~ s/^\"([^"]*)\"// || $string =~ s/^\'([^']*)\'// || $string =~ s/^([\w@.-]+)// or last; $value = $1; } } if(defined $value) { $result{"$ptype.$property"} = $value; } else { $string =~ s/^.*?\;/;/g; # recover from parser problem } } } $self->addResult($_) for @results; $self; } sub produceBody() { my $self = shift; my $source = $self->server; my $version = $self->version; $source .= " $version" if $version!=1; my @results; foreach my $r ($self->results) { my $method = $r->{method}; $method .= "/$r->{method_version}" if $r->{method_version} != 1; my $result = "$method=$r->{result}"; $result .= ' ' . $self->createComment($r->{comment}) if defined $r->{comment}; if(my $reason = $r->{reason}) { $reason =~ s/"/\\"/g; $result .= qq{ reason="$reason"}; } foreach my $prop (sort keys %$r) { index($prop, '.') > -1 or next; my $value = $r->{$prop}; $value =~ s/"/\\"/g; $result .= qq{ $prop="$value"}; } push @results, $result; } push @results, 'none' unless @results; join '; ', $source, @results; } #-------------------- sub addAttribute($;@) { my $self = shift; $self->log(ERROR => 'No attributes for Authentication-Results.'); $self; } sub server() { $_[0]->{MMFA_server} } sub version() { $_[0]->{MMFA_version} } sub results() { @{ $_[0]->{MMFA_results}} } sub addResult($) { my $self = shift; my $r = @_==1 ? shift : {@_}; $r->{method} && $r->{result} or return (); $r->{method_version} ||= 1; push @{$self->{MMFA_results}}, $r; delete $self->{MMFF_body}; $r; } #-------------------- 1; Mail-Message-3.019/lib/Mail/Message/Field/Addresses.pm0000644000175000001440000001306515111124066023024 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 3.019. # The POD got stripped from this file by OODoc version 3.05. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2025 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 = '3.019'; } use base 'Mail::Message::Field::Structured'; use strict; use warnings; use Mail::Message::Field::AddrGroup (); use Mail::Message::Field::Address (); use List::Util qw/first/; #-------------------- # 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) or return; $self; } #-------------------- sub addAddress(@) { my $self = shift; my $email = @_ && ref $_[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; $self->log(ERROR => 'No attributes for address fields.'); $self; } #-------------------- 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) { $self->log(WARNING => "Ignore unrelated 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. return 1 unless defined $angle; $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; } $self->log(WARNING => 'Illegal part in address field '.$self->Name. ": $string\n"); 0; } sub produceBody() { my @groups = sort {$a->name cmp $b->name} shift->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-3.019/lib/Mail/Message/Field/URIs.pm0000644000175000001440000000330015111124066021720 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 3.019. # The POD got stripped from this file by OODoc version 3.05. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2025 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::URIs;{ our $VERSION = '3.019'; } use base 'Mail::Message::Field::Structured'; use warnings; use strict; use URI (); use Scalar::Util qw/blessed/; #-------------------- #-------------------- sub init($) { my ($self, $args) = @_; my ($body, @body); if($body = delete $args->{body}) { @body = ref $body eq 'ARRAY' ? @$body : ($body); @body or return (); } $self->{MMFU_uris} = []; if(@body > 1 || blessed $body[0]) { $self->addURI($_) for @body; } elsif(defined $body) { $body = "<$body>\n" unless index($body, '<') >= 0; $args->{body} = $body; } $self->SUPER::init($args); } sub parse($) { my ($self, $string) = @_; my @raw = $string =~ m/\<([^>]+)\>/g; # simply ignore all but <> $self->addURI($_) for @raw; $self; } sub produceBody() { my @uris = sort map $_->as_string, $_[0]->URIs; local $" = '>, <'; @uris ? "<@uris>" : undef; } #-------------------- sub addURI(@) { my $self = shift; my $uri = blessed $_[0] ? shift : URI->new(@_); push @{$self->{MMFU_uris}}, $uri->canonical if defined $uri; delete $self->{MMFF_body}; $uri; } sub URIs() { @{ $_[0]->{MMFU_uris}} } sub addAttribute($;@) { my $self = shift; $self->log(ERROR => 'No attributes for URI fields.'); $self; } #-------------------- 1; Mail-Message-3.019/lib/Mail/Message/Field/DKIM.pm0000644000175000001440000000370615111124066021634 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Message version 3.019. # The POD got stripped from this file by OODoc version 3.05. # For contributors see file ChangeLog. # This software is copyright (c) 2001-2025 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::DKIM;{ our $VERSION = '3.019'; } use base 'Mail::Message::Field::Structured'; use warnings; use strict; use URI (); #-------------------- sub init($) { my ($self, $args) = @_; $self->{MMFD_tags} = +{ v => 1, a => 'rsa-sha256' }; $self->SUPER::init($args); $self; } sub parse($) { my ($self, $string) = @_; my $tags = $self->{MMFD_tags}; foreach (split /\;/, $string) { m/^\s*([a-z][a-z0-9_]*)\s*\=\s*([\s\x21-\x7E]+?)\s*$/is or next; # tag-values stay unparsed (for now) $self->addTag($1, $2); } (undef, $string) = $self->consumeComment($string); $self; } sub produceBody() { my $self = shift; } #-------------------- sub addAttribute($;@) { my $self = shift; $self->log(ERROR => 'No attributes for DKIM headers.'); $self; } sub addTag($$) { my ($self, $name) = (shift, lc shift); $self->{MMFD_tags}{$name} = join ' ', @_; $self; } sub tag($) { $_[0]->{MMFD_tags}{lc $_[1]} } #-------------------- sub tagAlgorithm() { $_[0]->tag('a') } sub tagSignData() { $_[0]->tag('b') } sub tagSignature() { $_[0]->tag('bh') } sub tagC14N() { $_[0]->tag('c') } sub tagDomain() { $_[0]->tag('d') } sub tagSignedHeaders() { $_[0]->tag('h') } sub tagAgentID() { $_[0]->tag('i') } sub tagBodyLength(){ $_[0]->tag('l') } sub tagQueryMethods() { $_[0]->tag('q') } sub tagSelector() { $_[0]->tag('s') } sub tagTimestamp() { $_[0]->tag('t') } sub tagExpires() { $_[0]->tag('x') } sub tagVersion() { $_[0]->tag('v') } sub tagExtract() { $_[0]->tag('z') } #-------------------- 1; Mail-Message-3.019/lib/Mail/Message/Field/Date.pod0000644000175000001440000003015615111124067022133 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); =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 log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =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 log => LEVEL =item trace => LEVEL =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">. =over 4 =item $obj-EB() Inherited, see L =back =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $any-EB() 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