MailTools-2.22/0000755000175000001440000000000014716611317014067 5ustar00markovusers00000000000000MailTools-2.22/lib/0000755000175000001440000000000014716611317014635 5ustar00markovusers00000000000000MailTools-2.22/lib/Mail/0000755000175000001440000000000014716611317015517 5ustar00markovusers00000000000000MailTools-2.22/lib/Mail/Header.pm0000644000175000001440000003347314716611316017256 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Header;{ our $VERSION = '2.22'; } use strict; use Carp; my $MAIL_FROM = 'KEEP'; my %HDR_LENGTHS = (); our $FIELD_NAME = '[^\x00-\x1f\x7f-\xff :]+:'; ## ## Private functions ## sub _error { warn @_; () } # tidy up internal hash table and list sub _tidy_header { my $self = shift; my $deleted = 0; for(my $i = 0 ; $i < @{$self->{mail_hdr_list}}; $i++) { next if defined $self->{mail_hdr_list}[$i]; splice @{$self->{mail_hdr_list}}, $i, 1; $deleted++; $i--; } if($deleted) { local $_; my @del; while(my ($key,$ref) = each %{$self->{mail_hdr_hash}} ) { push @del, $key unless @$ref = grep { ref $_ && defined $$_ } @$ref; } delete $self->{'mail_hdr_hash'}{$_} for @del; } } # fold the line to the given length my %STRUCTURE = map { (lc $_ => undef) } qw{ To Cc Bcc From Date Reply-To Sender Resent-Date Resent-From Resent-Sender Resent-To Return-Path list-help list-post list-unsubscribe Mailing-List Received References Message-ID In-Reply-To Content-Length Content-Type Content-Disposition Delivered-To Lines MIME-Version Precedence Status }; sub _fold_line { my($ln,$maxlen) = @_; $maxlen = 20 if $maxlen < 20; my $max = int($maxlen - 5); # 4 for leading spcs + 1 for [\,\;] my $min = int($maxlen * 4 / 5) - 4; $_[0] =~ s/[\r\n]+//og; # Remove new-lines $_[0] =~ s/\s*\Z/\n/so; # End line with an EOLN return if $_[0] =~ /^From\s/io; if(length($_[0]) > $maxlen) { if($_[0] =~ /^([-\w]+)/ && exists $STRUCTURE{ lc $1 } ) { #Split the line up # first bias towards splitting at a , or a ; >4/5 along the line # next split a whitespace # else we are looking at a single word and probably don't want to split my $x = ""; $x .= "$1\n " while $_[0] =~ s/^\s* ( [^"]{$min,$max} [,;] | [^"]{1,$max} [,;\s] | [^\s"]*(?:"[^"]*"[ \t]?[^\s"]*)+\s ) //x; $x .= $_[0]; $_[0] = $x; $_[0] =~ s/(\A\s+|[\t ]+\Z)//sog; $_[0] =~ s/\s+\n/\n/sog; } else { $_[0] =~ s/(.{$min,$max})(\s)/$1\n$2/g; $_[0] =~ s/\s*$/\n/s; } } $_[0] =~ s/\A(\S+)\n\s*(?=\S)/$1 /so; } # Tags are case-insensitive, but there is a (slightly) preferred construction # being all characters are lowercase except the first of each word. Also # if the word is an `acronym' then all characters are uppercase. We decide # a word is an acronym if it does not contain a vowel. # In general, this change of capitalization is a bad idea, but it is in # the code for ages, and therefore probably crucial for existing # applications. sub _tag_case { my $tag = shift; $tag =~ s/\:$//; join '-' , map { /^[b-df-hj-np-tv-z]+$|^(?:MIME|SWE|SOAP|LDAP|ID)$/i ? uc($_) : ucfirst(lc($_)) } split m/\-/, $tag, -1; } # format a complete line # ensure line starts with the given tag # ensure tag is correct case # change the 'From ' tag as required # fold the line sub _fmt_line { my ($self, $tag, $line, $modify) = @_; $modify ||= $self->{mail_hdr_modify}; my $ctag = undef; ($tag) = $line =~ /^($FIELD_NAME|From )/oi unless defined $tag; if(defined $tag && $tag =~ /^From /io && $self->{mail_hdr_mail_from} ne 'KEEP') { if($self->{mail_hdr_mail_from} eq 'COERCE') { $line =~ s/^From /Mail-From: /o; $tag = "Mail-From:"; } elsif($self->{mail_hdr_mail_from} eq 'IGNORE') { return (); } elsif($self->{mail_hdr_mail_from} eq 'ERROR') { return _error "unadorned 'From ' ignored: <$line>"; } } if(defined $tag) { $tag = _tag_case($ctag = $tag); $ctag = $tag if $modify; $ctag =~ s/([^ :])$/$1:/o if defined $ctag; } defined $ctag && $ctag =~ /^($FIELD_NAME|From )/oi or croak "Bad RFC822 field name '$tag'\n"; # Ensure the line starts with tag if(defined $ctag && ($modify || $line !~ /^\Q$ctag\E/i)) { (my $xtag = $ctag) =~ s/\s*\Z//o; $line =~ s/^(\Q$ctag\E)?\s*/$xtag /i; } my $maxlen = $self->{mail_hdr_lengths}{$tag} || $HDR_LENGTHS{$tag} || $self->fold_length; if ($modify && defined $maxlen) { # folding will fix bad header continuations for us _fold_line $line, $maxlen; } elsif($line =~ /\r?\n\S/) { return _error "Bad header continuation, skipping '$tag': ", "no space after newline in '$line'\n"; } $line =~ s/\n*$/\n/so; ($tag, $line); } sub _insert { my ($self, $tag, $line, $where) = @_; if($where < 0) { $where = @{$self->{mail_hdr_list}} + $where + 1; $where = 0 if $where < 0; } elsif($where >= @{$self->{mail_hdr_list}}) { $where = @{$self->{mail_hdr_list}}; } my $atend = $where == @{$self->{mail_hdr_list}}; splice @{$self->{mail_hdr_list}}, $where, 0, $line; $self->{mail_hdr_hash}{$tag} ||= []; my $ref = \${$self->{mail_hdr_list}}[$where]; my $def = $self->{mail_hdr_hash}{$tag}; if($def && $where) { if($atend) { push @$def, $ref } else { my $i = 0; foreach my $ln (@{$self->{mail_hdr_list}}) { my $r = \$ln; last if $r == $ref; $i++ if $r == $def->[$i]; } splice @$def, $i, 0, $ref; } } else { unshift @$def, $ref; } } #------------ sub new { my $call = shift; my $class = ref($call) || $call; my $arg = @_ % 2 ? shift : undef; my %opt = @_; $opt{Modify} = delete $opt{Reformat} unless exists $opt{Modify}; my $self = bless { mail_hdr_list => [] , mail_hdr_hash => {} , mail_hdr_modify => (delete $opt{Modify} || 0) , mail_hdr_foldlen => 79 , mail_hdr_lengths => {} }, $class; $self->mail_from( uc($opt{MailFrom} || $MAIL_FROM) ); $self->fold_length($opt{FoldLength}) if exists $opt{FoldLength}; if(!ref $arg) {} elsif(ref($arg) eq 'ARRAY') { $self->extract( [ @$arg ] ) } elsif(defined fileno($arg)) { $self->read($arg) } $self; } sub dup { my $self = shift; my $dup = ref($self)->new; %$dup = %$self; $dup->empty; # rebuild tables $dup->{mail_hdr_list} = [ @{$self->{mail_hdr_list}} ]; foreach my $ln ( @{$dup->{mail_hdr_list}} ) { my $tag = _tag_case +($ln =~ /^($FIELD_NAME|From )/oi)[0]; push @{$dup->{mail_hdr_hash}{$tag}}, \$ln; } $dup; } #------------ sub extract { my ($self, $lines) = @_; $self->empty; while(@$lines) { my $line = shift @$lines; last if $line =~ /^\r?$/; $line =~ /^($FIELD_NAME|From )/o or next; my $tag = $1; $line .= shift @$lines while @$lines && $lines->[0] =~ /^[ \t]+/; ($tag, $line) = _fmt_line $self, $tag, $line; _insert $self, $tag, $line, -1 if defined $line; } $self; } sub read { my ($self, $fd) = @_; $self->empty; my ($ln, $tag, $line); while(1) { $ln = <$fd>; if(defined $ln && defined $line && $ln =~ /^[ \t]+/) { $line .= $ln; # folded line next; } if(defined $line) { ($tag, $line) = _fmt_line $self, $tag, $line; _insert $self, $tag, $line, -1 if defined $line; ($tag, $line) = (); } last if !defined $ln || $ln =~ m/^\r?$/; $ln =~ /^($FIELD_NAME|From )/o or next; ($tag, $line) = ($1, $ln); } $self; } sub empty { my $self = shift; $self->{mail_hdr_list} = []; $self->{mail_hdr_hash} = {}; $self; } sub header { my $self = shift; $self->extract(@_) if @_; $self->fold if $self->{mail_hdr_modify}; [ @{$self->{mail_hdr_list}} ]; } sub header_hashref { my ($self, $hashref) = @_; while(my ($key, $value) = each %$hashref) { $self->add($key, $_) for ref $value ? @$value : $value; } $self->fold if $self->{mail_hdr_modify}; defined wantarray # MO, added minimal optimization or return; +{ map { ($_ => [$self->get($_)] ) } # MO: Eh? keys %{$self->{mail_hdr_hash}} }; } #------------ sub modify { my $self = shift; my $old = $self->{mail_hdr_modify}; $self->{mail_hdr_modify} = 0 + shift if @_; $old; } sub mail_from { my $thing = shift; my $choice = uc shift; $choice =~ /^(IGNORE|ERROR|COERCE|KEEP)$/ or die "bad Mail-From choice: '$choice'"; if(ref $thing) { $thing->{mail_hdr_mail_from} = $choice } else { $MAIL_FROM = $choice } $thing; } sub fold_length { my $thing = shift; my $old; if(@_ == 2) { my $tag = _tag_case shift; my $len = shift; my $hash = ref $thing ? $thing->{mail_hdr_lengths} : \%HDR_LENGTHS; $old = $hash->{$tag}; $hash->{$tag} = $len > 20 ? $len : 20; } else { my $self = $thing; my $len = shift; $old = $self->{mail_hdr_foldlen}; if(defined $len) { $self->{mail_hdr_foldlen} = $len > 20 ? $len : 20; $self->fold if $self->{mail_hdr_modify}; } } $old; } #------------ sub fold { my ($self, $maxlen) = @_; while(my ($tag, $list) = each %{$self->{mail_hdr_hash}}) { my $len = $maxlen || $self->{mail_hdr_lengths}{$tag} || $HDR_LENGTHS{$tag} || $self->fold_length; foreach my $ln (@$list) { _fold_line $$ln, $len if defined $ln; } } $self; } sub unfold { my $self = shift; if(@_) { my $tag = _tag_case shift; my $list = $self->{mail_hdr_hash}{$tag} or return $self; foreach my $ln (@$list) { $$ln =~ s/\r?\n\s+/ /sog if defined $ln && defined $$ln; } return $self; } while( my ($tag, $list) = each %{$self->{mail_hdr_hash}}) { foreach my $ln (@$list) { $$ln =~ s/\r?\n\s+/ /sog if defined $ln && defined $$ln; } } $self; } sub add { my ($self, $tag, $text, $where) = @_; ($tag, my $line) = _fmt_line $self, $tag, $text; defined $tag && defined $line or return undef; defined $where or $where = -1; _insert $self, $tag, $line, $where; $line =~ /^\S+\s(.*)/os; $1; } sub replace { my $self = shift; my $idx = @_ % 2 ? pop @_ : 0; my ($tag, $line); TAG: while(@_) { ($tag,$line) = _fmt_line $self, splice(@_,0,2); defined $tag && defined $line or return undef; my $field = $self->{mail_hdr_hash}{$tag}; if($field && defined $field->[$idx]) { ${$field->[$idx]} = $line } else { _insert $self, $tag, $line, -1 } } $line =~ /^\S+\s*(.*)/os; $1; } sub combine { my $self = shift; my $tag = _tag_case shift; my $with = shift || ' '; $tag =~ /^From /io && $self->{mail_hdr_mail_from} ne 'KEEP' and return _error "unadorned 'From ' ignored"; my $def = $self->{mail_hdr_hash}{$tag} or return undef; return $def->[0] if @$def <= 1; my @lines = $self->get($tag); chomp @lines; my $line = (_fmt_line $self, $tag, join($with,@lines), 1)[1]; $self->{mail_hdr_hash}{$tag} = [ \$line ]; $line; } sub get { my $self = shift; my $tag = _tag_case shift; my $idx = shift; my $def = $self->{mail_hdr_hash}{$tag} or return (); my $l = length $tag; $l += 1 if $tag !~ / $/o; if(defined $idx || !wantarray) { $idx ||= 0; defined $def->[$idx] or return undef; my $val = ${$def->[$idx]}; defined $val or return undef; $val = substr $val, $l; $val =~ s/^\s+//; return $val; } map { my $tmp = substr $$_,$l; $tmp =~ s/^\s+//; $tmp } @$def; } sub count { my $self = shift; my $tag = _tag_case shift; my $def = $self->{mail_hdr_hash}{$tag}; defined $def ? scalar(@$def) : 0; } sub delete { my $self = shift; my $tag = _tag_case shift; my $idx = shift; my @val; if(my $def = $self->{mail_hdr_hash}{$tag}) { my $l = length $tag; $l += 2 if $tag !~ / $/; if(defined $idx) { if(defined $def->[$idx]) { push @val, substr ${$def->[$idx]}, $l; undef ${$def->[$idx]}; } } else { @val = map {my $x = substr $$_,$l; undef $$_; $x } @$def; } _tidy_header($self); } @val; } sub print { my $self = shift; my $fd = shift || \*STDOUT; foreach my $ln (@{$self->{mail_hdr_list}}) { defined $ln or next; print $fd $ln or return 0; } 1; } sub as_string { join '', grep {defined} @{shift->{mail_hdr_list}} } sub tags { keys %{shift->{mail_hdr_hash}} } sub cleanup { my $self = shift; my $deleted = 0; foreach my $key (@_ ? @_ : keys %{$self->{mail_hdr_hash}}) { my $fields = $self->{mail_hdr_hash}{$key}; foreach my $field (@$fields) { next if $$field =~ /^\S+\s+\S/s; undef $$field; $deleted++; } } _tidy_header $self if $deleted; $self; } 1; MailTools-2.22/lib/Mail/Send.pod0000644000175000001440000000626114716611316017120 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Send - Simple electronic mail interface =head1 SYNOPSIS require Mail::Send; $msg = Mail::Send->new; $msg = Mail::Send->new(Subject => 'example', To => 'timbo'); $msg->to('user@host'); $msg->to('user@host', 'user2@example.com'); $msg->subject('example subject'); $msg->cc('user@host'); $msg->bcc('someone@else'); $msg->set($header, @values); $msg->add($header, @values); $msg->delete($header); # Launch mailer and set headers. The filehandle returned # by open() is an instance of the Mail::Mailer class. # Arguments to the open() method are passed to the Mail::Mailer # constructor. $fh = $msg->open; # some default mailer $fh = $msg->open('sendmail'); # explicit print $fh "Body of message"; $fh->close # complete the message and send it or die "couldn't send whole message: $!\n"; =head1 DESCRIPTION L creates e-mail messages without using the L knowledge, which means that all escaping and folding must be done by you! Also: do not forget to escape leading dots. Simplicity has its price. When you have time, take a look at Mail::Transport which is part of the MailBox suite. =head1 METHODS =head2 Constructors =over 4 =item Mail::Send-EB(PAIRS) A list of header fields (provided as key-value PAIRS) can be used to initialize the object, limited to the few provided as method: C, C, C, and C. For other header fields, use L. =back =head2 Header fields =over 4 =item $obj-EB($fieldname, @values) Add values to the list of defined values for the $fieldname. =item $obj-EB(@values) =item $obj-EB(@values) =item $obj-EB($fieldname) =item $obj-EB($fieldname, @values) The @values will replace the old values for the $fieldname. Returned is the LIST of values after modification. =item $obj-EB(@values) =item $obj-EB(@values) =back =head2 Sending =over 4 =item $obj-EB(%options) The %options are used to initiate a mailer object via L. Then L is called with the knowledge collected in this C object. Be warned: this module implements raw smtp, which means that you have to escape lines which start with a dot, by adding one in front. =back =head1 SEE ALSO This module is part of the MailTools distribution, F. =head1 AUTHORS The MailTools bundle was developed by Graham Barr. Later, Mark Overmeer took over maintenance without commitment to further development. Mail::Cap by Gisle Aas Eaas@oslonett.noE. Mail::Field::AddrList by Peter Orbaek Epoe@cit.dkE. Mail::Mailer and Mail::Send by Tim Bunce ETim.Bunce@ig.co.ukE. For other contributors see ChangeLog. =head1 LICENSE Copyrights 1995-2000 Graham Barr Egbarr@pobox.comE and 2001-2024 Mark Overmeer Eperl@overmeer.netE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F MailTools-2.22/lib/Mail/Mailer.pod0000644000175000001440000001012114716611316017426 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Mailer - send simple emails =head1 INHERITANCE Mail::Mailer is an IO::Handle =head1 SYNOPSIS use Mail::Mailer; use Mail::Mailer qw(mail); # specifies default mailer $mailer = Mail::Mailer->new; $mailer = Mail::Mailer->new($type, @args); $mailer->open(\%headers); print $mailer $body; $mailer->close or die "couldn't send whole message: $!\n"; =head1 DESCRIPTION Sends mail using any of the built-in methods. As TYPE argument to L, you can specify any of =over 4 =item C Use the C program to deliver the mail. =item C Use the C protocol via Net::SMTP to deliver the mail. The server to use can be specified in C<@args> with $mailer = Mail::Mailer->new('smtp', Server => $server); The smtp mailer does not handle C and C lines, neither their C fellows. The C options enables debugging output from C. [added 2.21] You may also use the C<< StartTLS => 1 >> options to upgrade the connection with STARTTLS. The same for option C<< SSL => 1 >>. You may also use the C<< Auth => [ $user, $password ] >> option for SASL authentication. To make this work, you have to install the L distribution yourself: it is not automatically installed. =item C This option is B when you have C 1.28 (2014) and above. Use the smtp over ssl protocol via L to deliver the mail. Usage is identical to C. You have to install Authen::SASL as well. $mailer = Mail::Mailer->new('smtps', Server => $server); =item C Use qmail's qmail-inject program to deliver the mail. =item C Used for debugging, this displays the data to the file named in C<$Mail::Mailer::testfile::config{outfile}> which defaults to a file named C. No mail is ever sent. =back C will search for executables in the above order. The default mailer will be the first one found. =head1 METHODS =head2 Constructors =over 4 =item Mail::Mailer-EB($type, %options) The $type is one of the back-end sender implementations, as described in the DESCRIPTION chapter of this manual page. The %options are passed to that back-end. =item $obj-EB(HASH) The HASH consists of key and value pairs, the key being the name of the header field (eg, C), and the value being the corresponding contents of the header field. The value can either be a scalar (eg, C) or a reference to an array of scalars (C<< eg, ['gnat@frii.com', 'Tim.Bunce@ig.co.uk'] >>). =back =head1 DETAILS =head2 ENVIRONMENT VARIABLES =over 4 =item PERL_MAILERS Augments/override the build in choice for binary used to send out our mail messages. Format: "type1:mailbinary1;mailbinary2;...:type2:mailbinaryX;...:..." Example: assume you want you use private sendmail binary instead of mailx, one could set C to: "mail:/does/not/exists:sendmail:$HOME/test/bin/sendmail" On systems which may include C<:> in file names, use C<|> as separator between type-groups. "mail:c:/does/not/exists|sendmail:$HOME/test/bin/sendmail" =back =head2 BUGS Mail::Mailer does not help with folding, and does not protect against various web-script hacker attacks, for instance where a new-line is inserted in the content of the field. =head1 SEE ALSO This module is part of the MailTools distribution, F. =head1 AUTHORS The MailTools bundle was developed by Graham Barr. Later, Mark Overmeer took over maintenance without commitment to further development. Mail::Cap by Gisle Aas Eaas@oslonett.noE. Mail::Field::AddrList by Peter Orbaek Epoe@cit.dkE. Mail::Mailer and Mail::Send by Tim Bunce ETim.Bunce@ig.co.ukE. For other contributors see ChangeLog. =head1 LICENSE Copyrights 1995-2000 Graham Barr Egbarr@pobox.comE and 2001-2024 Mark Overmeer Eperl@overmeer.netE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F MailTools-2.22/lib/Mail/Filter.pod0000644000175000001440000000550614716611316017455 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Filter - filter mail through multiple subroutines =head1 SYNOPSIS use Mail::Filter; my $filter = Mail::Filter->new( \&filter1, \&filter2 ); my $mail = Mail::Internet->new( [<>] ); my $mail = $filter->filter($mail); my $folder = Mail::Folder->new( .... ); my $filter->filter($folder); =head1 DESCRIPTION C provides an interface to filtering Email through multiple subroutines. C filters mail by calling each filter subroutine in turn. Each filter subroutine is called with two arguments, the first is the filter object and the second is the mail or folder object being filtered. The result from each filter sub is passed to the next filter as the mail object. If a filter subroutine returns undef, then C will abort and return immediately. The function returns the result from the last subroutine to operate on the mail object. =head1 METHODS =head2 Constructors =over 4 =item Mail::Filter-EB(@filters) Create a new C object with the given filter subroutines. Each filter may be either a code reference or the name of a method to call on the object. =back =head2 Accessors =over 4 =item $obj-EB(@filters) Add the given @filters to the end of the filter list. =back =head2 Processing =over 4 =item $obj-EB($mail|$folder) If the first argument is a L object, then this object will be passed through the filter list. If the first argument is a Mail::Folder object, then each message in turn will be passed through the filter list. =item $obj-EB() While the L method is called with a Mail::Folder object, these filter subroutines can call this method to obtain the folder object that is being processed. =item $obj-EB() If the L method is called with a Mail::Folder object, then the filter subroutines may call this method to obtain the message number of the message that is being processed. =back =head1 SEE ALSO This module is part of the MailTools distribution, F. =head1 AUTHORS The MailTools bundle was developed by Graham Barr. Later, Mark Overmeer took over maintenance without commitment to further development. Mail::Cap by Gisle Aas Eaas@oslonett.noE. Mail::Field::AddrList by Peter Orbaek Epoe@cit.dkE. Mail::Mailer and Mail::Send by Tim Bunce ETim.Bunce@ig.co.ukE. For other contributors see ChangeLog. =head1 LICENSE Copyrights 1995-2000 Graham Barr Egbarr@pobox.comE and 2001-2024 Mark Overmeer Eperl@overmeer.netE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F MailTools-2.22/lib/Mail/Mailer/0000755000175000001440000000000014716611317016730 5ustar00markovusers00000000000000MailTools-2.22/lib/Mail/Mailer/smtps.pm0000644000175000001440000000437014716611316020437 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. # Based on smtp.pm, adapted by Maciej Żenczykowski package Mail::Mailer::smtps;{ our $VERSION = '2.22'; } use base 'Mail::Mailer::rfc822'; use strict; use Net::SMTP::SSL; use Mail::Util qw(mailaddress); use Carp; sub can_cc { 0 } sub exec { my ($self, $exe, $args, $to) = @_; my %opt = @$args; my $host = $opt{Server} || undef; $opt{Debug} ||= 0; $opt{Port} ||= 465; my $smtp = Net::SMTP::SSL->new($host, %opt) or return undef; if($opt{Auth}) { $smtp->auth(@{$opt{Auth}}) or return undef; } ${*$self}{sock} = $smtp; $smtp->mail($opt{From} || mailaddress); $smtp->to($_) for @$to; $smtp->data; untie *$self if tied *$self; tie *$self, 'Mail::Mailer::smtps::pipe', $self; $self; } sub set_headers($) { my ($self, $hdrs) = @_; $self->SUPER::set_headers ( { From => "<" . mailaddress() . ">" , %$hdrs , 'X-Mailer' => "Mail::Mailer[v$Mail::Mailer::VERSION] " . " Net::SMTP[v$Net::SMTP::VERSION]" . " Net::SMTP::SSL[v$Net::SMTP::SSL::VERSION]" } ); } sub epilogue() { my $self = shift; my $sock = ${*$self}{sock}; my $ok = $sock->dataend; $sock->quit; delete ${*$self}{sock}; untie *$self; $ok; } sub close(@) { my ($self, @to) = @_; my $sock = ${*$self}{sock}; $sock && fileno $sock or return 1; my $ok = $self->epilogue; # Epilogue should destroy the SMTP filehandle, # but just to be on the safe side. $sock && fileno $sock or return $ok; close $sock or croak 'Cannot destroy socket filehandle'; $ok; } package Mail::Mailer::smtps::pipe;{ our $VERSION = '2.22'; } sub TIEHANDLE { my ($class, $self) = @_; my $sock = ${*$self}{sock}; bless \$sock, $class; } sub PRINT { my $self = shift; my $sock = $$self; $sock->datasend( @_ ); } 1; MailTools-2.22/lib/Mail/Mailer/sendmail.pm0000644000175000001440000000167514716611316021072 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Mailer::sendmail;{ our $VERSION = '2.22'; } use base 'Mail::Mailer::rfc822'; use strict; sub exec($$$$) { my($self, $exe, $args, $to, $sender) = @_; # Fork and exec the mailer (no shell involved to avoid risks) # We should always use a -t on sendmail so that Cc: and Bcc: work # Rumor: some sendmails may ignore or break with -t (AIX?) # Chopped out the @$to arguments, because -t means # they are sent in the body, and postfix complains if they # are also given on command line. exec( $exe, '-t', @$args ); } 1; MailTools-2.22/lib/Mail/Mailer/testfile.pm0000644000175000001440000000251414716611316021106 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Mailer::testfile;{ our $VERSION = '2.22'; } use base 'Mail::Mailer::rfc822'; use strict; use Mail::Util qw/mailaddress/; my $num = 0; sub can_cc() { 0 } sub exec($$$) { my ($self, $exe, $args, $to) = @_; my $outfn = $Mail::Mailer::testfile::config{outfile} || 'mailer.testfile'; open F, '>>', $outfn or die "Cannot append message to testfile $outfn: $!"; print F "\n===\ntest ", ++$num, " ", (scalar localtime), "\nfrom: " . mailaddress(), "\nto: " . join(' ',@{$to}), "\n\n"; close F; untie *$self if tied *$self; tie *$self, 'Mail::Mailer::testfile::pipe', $self; $self; } sub close { 1 } package Mail::Mailer::testfile::pipe;{ our $VERSION = '2.22'; } sub TIEHANDLE { my ($class, $self) = @_; bless \$self, $class; } sub PRINT { my $self = shift; open F, '>>', $Mail::Mailer::testfile::config{outfile} || 'mailer.testfile'; print F @_; close F; } 1; MailTools-2.22/lib/Mail/Mailer/rfc822.pm0000644000175000001440000000172514716611316020300 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Mailer::rfc822;{ our $VERSION = '2.22'; } use base 'Mail::Mailer'; use strict; # Some fields are not allowed to repeat my %max_once = map +($_ => 1), qw/from to cc bcc reply-to/; sub set_headers { my ($self, $hdrs) = @_; local $\ = ""; foreach my $f (grep /^[A-Z]/, keys %$hdrs) { # s///r requires perl 5.12: too new :-) my @h = map { my $h = $_; $h =~ s/\n+\Z//; $h } $self->to_array($hdrs->{$f}); @h = join ', ', @h if @h && $max_once{lc $f}; print $self "$f: $_\n" for @h; } print $self "\n"; # end of headers } 1; MailTools-2.22/lib/Mail/Mailer/qmail.pm0000644000175000001440000000134014716611316020366 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Mailer::qmail;{ our $VERSION = '2.22'; } use base 'Mail::Mailer::rfc822'; use strict; sub exec($$$$) { my($self, $exe, $args, $to, $sender) = @_; my $address = defined $sender && $sender =~ m/\<(.*?)\>/ ? $1 : $sender; exec($exe, (defined $address ? "-f$address" : ())); die "ERROR: cannot run $exe: $!"; } 1; MailTools-2.22/lib/Mail/Mailer/smtp.pm0000644000175000001440000000425614716611316020257 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Mailer::smtp;{ our $VERSION = '2.22'; } use base 'Mail::Mailer::rfc822'; use strict; use Net::SMTP; use Mail::Util qw(mailaddress); use Carp; sub can_cc { 0 } sub exec { my ($self, $exe, $args, $to) = @_; my %opt = @$args; my $host = $opt{Server} || undef; $opt{Debug} ||= 0; my $smtp = Net::SMTP->new($host, %opt) or return undef; if($opt{StartTLS}) { $smtp->starttls or return undef; } if($opt{Auth}) { $smtp->auth(@{$opt{Auth}}) or return undef; } ${*$self}{sock} = $smtp; $smtp->mail($opt{From} || mailaddress()); $smtp->to($_) for @$to; $smtp->data; untie *$self if tied *$self; tie *$self, 'Mail::Mailer::smtp::pipe', $self; $self; } sub set_headers($) { my ($self, $hdrs) = @_; $self->SUPER::set_headers ( { From => "<" . mailaddress() . ">" , %$hdrs , 'X-Mailer' => "Mail::Mailer[v$Mail::Mailer::VERSION] Net::SMTP[v$Net::SMTP::VERSION]" } ); } sub epilogue() { my $self = shift; my $sock = ${*$self}{sock}; my $ok = $sock->dataend; $sock->quit; delete ${*$self}{sock}; untie *$self; $ok; } sub close(@) { my ($self, @to) = @_; my $sock = ${*$self}{sock}; $sock && fileno $sock or return 1; my $ok = $self->epilogue; # Epilogue should destroy the SMTP filehandle, # but just to be on the safe side. $sock && fileno $sock or return $ok; close $sock or croak 'Cannot destroy socket filehandle'; $ok; } package Mail::Mailer::smtp::pipe;{ our $VERSION = '2.22'; } sub TIEHANDLE { my ($class, $self) = @_; my $sock = ${*$self}{sock}; bless \$sock, $class; } sub PRINT { my $self = shift; my $sock = $$self; $sock->datasend( @_ ); } 1; MailTools-2.22/lib/Mail/Field.pm0000644000175000001440000001166314716611316017106 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Field;{ our $VERSION = '2.22'; } use strict; use Carp; use Mail::Field::Generic; sub _header_pkg_name { my $header = lc shift; $header =~ s/((\b|_)\w)/\U$1/g; if(length($header) > 8) { my @header = split /[-_]+/, $header; my $chars = int((7 + @header) / @header) || 1; $header = substr join('', map {substr $_,0,$chars} @header), 0, 8; } else { $header =~ s/[-_]+//g; } 'Mail::Field::' . $header; } sub _require_dir { my($class, $dir, $dir_sep) = @_; local *DIR; opendir DIR, $dir or return; my @inc; foreach my $f (readdir DIR) { $f =~ /^([\w\-]+)/ or next; my $p = $1; my $n = "$dir$dir_sep$p"; if(-d $n ) { _require_dir("${class}::$f", $n, $dir_sep); } else { $p =~ s/-/_/go; eval "require ${class}::$p"; # added next warning in 2.14, may be ignored for ancient code warn $@ if $@; } } closedir DIR; } sub import { my $class = shift; if(@_) { local $_; eval "require " . _header_pkg_name($_) || die $@ for @_; return; } my ($dir, $dir_sep); foreach my $f (grep defined $INC{$_}, keys %INC) { next if $f !~ /^Mail(\W)Field\W/i; $dir_sep = $1; # $dir = ($INC{$f} =~ /(.*Mail\W+Field)/i)[0] . $dir_sep; ($dir = $INC{$f}) =~ s/(Mail\W+Field).*/$1$dir_sep/; last; } _require_dir('Mail::Field', $dir, $dir_sep); } # register a header class, this creates a new method in Mail::Field # which will call new on that class sub register { my $thing = shift; my $method = lc shift; my $class = shift || ref($thing) || $thing; $method =~ tr/-/_/; $class = _header_pkg_name $method if $class eq "Mail::Field"; croak "Re-register of $method" if Mail::Field->can($method); no strict 'refs'; *{$method} = sub { shift; $class->can('stringify') or eval "require $class" or die $@; $class->_build(@_); }; } # the *real* constructor # if called with one argument then the `parse' method will be called # otherwise the `create' method is called sub _build { my $self = bless {}, shift; @_==1 ? $self->parse(@_) : $self->create(@_); } #------------- sub new { my $class = shift; my $field = lc shift; $field =~ tr/-/_/; $class->$field(@_); } sub combine {confess "Combine not implemented" } our $AUTOLOAD; sub AUTOLOAD { my $method = $AUTOLOAD; $method =~ s/.*:://; $method =~ /^[^A-Z\x00-\x1f\x80-\xff :]+$/ or croak "Undefined subroutine &$AUTOLOAD called"; my $class = _header_pkg_name $method; unless(eval "require $class") { my $tag = $method; $tag =~ s/_/-/g; $tag = join '-', map { /^[b-df-hj-np-tv-z]+$|^MIME$/i ? uc($_) : ucfirst(lc $_) } split /\-/, $tag; no strict; @{"${class}::ISA"} = qw(Mail::Field::Generic); *{"${class}::tag"} = sub { $tag }; } Mail::Field->can($method) or $class->register($method); goto &$AUTOLOAD; } # Of course, the functionality should have been in the Mail::Header class sub extract { my ($class, $tag, $head) = (shift, shift, shift); my $method = lc $tag; $method =~ tr/-/_/; if(@_==0 && wantarray) { my @ret; my $text; # need real copy! foreach $text ($head->get($tag)) { chomp $text; push @ret, $class->$method($text); } return @ret; } my $idx = shift || 0; my $text = $head->get($tag,$idx) or return undef; chomp $text; $class->$method($text); } #------------- # before 2.00, this method could be called as class method, however # not all extensions supported that. sub create { my ($self, %arg) = @_; %$self = (); $self->set(\%arg); } # before 2.00, this method could be called as class method, however # not all extensions supported that. sub parse { my $class = ref shift; confess "parse() not implemented"; } #------------- sub stringify { confess "stringify() not implemented" } sub tag { my $thing = shift; my $tag = ref($thing) || $thing; $tag =~ s/.*:://; $tag =~ s/_/-/g; join '-', map { /^[b-df-hj-np-tv-z]+$|^MIME$/i ? uc($_) : ucfirst(lc $_) } split /\-/, $tag; } sub set(@) { confess "set() not implemented" } # prevent the calling of AUTOLOAD for DESTROY :-) sub DESTROY {} #------------- sub text { my $self = shift; @_ ? $self->parse(@_) : $self->stringify; } #------------- 1; MailTools-2.22/lib/Mail/Send.pm0000644000175000001440000000253214716611316016747 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Send;{ our $VERSION = '2.22'; } use strict; use Mail::Mailer (); sub Version { our $VERSION } #------------------ sub new(@) { my ($class, %attr) = @_; my $self = bless {}, $class; while(my($key, $value) = each %attr) { $key = lc $key; $self->$key($value); } $self; } #--------------- sub set($@) { my ($self, $hdr, @values) = @_; $self->{$hdr} = [ @values ] if @values; @{$self->{$hdr} || []}; # return new (or original) values } sub add($@) { my ($self, $hdr, @values) = @_; push @{$self->{$hdr}}, @values; } sub delete($) { my($self, $hdr) = @_; delete $self->{$hdr}; } sub to { my $self=shift; $self->set('To', @_); } sub cc { my $self=shift; $self->set('Cc', @_); } sub bcc { my $self=shift; $self->set('Bcc', @_); } sub subject { my $self=shift; $self->set('Subject', join (' ', @_)); } #--------------- sub open(@) { my $self = shift; Mail::Mailer->new(@_)->open($self); } 1; MailTools-2.22/lib/Mail/Internet.pm0000644000175000001440000002773414716611316017661 0ustar00markovusers00000000000000# Copyrights 1995-2024 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of the bundle MailTools. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md for Copyright. # Licensed under the same terms as Perl itself. package Mail::Internet;{ our $VERSION = '2.22'; } use strict; # use warnings? probably breaking too much code use Carp; use Mail::Header; use Mail::Util qw/mailaddress/; use Mail::Address; sub new(@) { my $call = shift; my $arg = @_ % 2 ? shift : undef; my %opt = @_; my $class = ref($call) || $call; my $self = bless {}, $class; $self->{mail_inet_head} = $opt{Header} if exists $opt{Header}; $self->{mail_inet_body} = $opt{Body} if exists $opt{Body}; my $head = $self->head; $head->fold_length(delete $opt{FoldLength} || 79); $head->mail_from($opt{MailFrom}) if exists $opt{MailFrom}; $head->modify(exists $opt{Modify} ? $opt{Modify} : 1); if(!defined $arg) { } elsif(ref($arg) eq 'ARRAY') { $self->header($arg) unless exists $opt{Header}; $self->body($arg) unless exists $opt{Body}; } elsif(defined fileno($arg)) { $self->read_header($arg) unless exists $opt{Header}; $self->read_body($arg) unless exists $opt{Body}; } else { croak "couldn't understand $arg to Mail::Internet constructor"; } $self; } sub read(@) { my $self = shift; $self->read_header(@_); $self->read_body(@_); } sub read_body($) { my ($self, $fd) = @_; $self->body( [ <$fd> ] ); } sub read_header(@) { my $head = shift->head; $head->read(@_); $head->header; } sub extract($) { my ($self, $lines) = @_; $self->head->extract($lines); $self->body($lines); } sub dup() { my $self = shift; my $dup = ref($self)->new; my $body = $self->{mail_inet_body} || []; my $head = $self->{mail_inet_head};; $dup->{mail_inet_body} = [ @$body ]; $dup->{mail_inet_head} = $head->dup if $head; $dup; } #--------------- sub body(;$@) { my $self = shift; return $self->{mail_inet_body} ||= [] unless @_; $self->{mail_inet_body} = ref $_[0] eq 'ARRAY' ? $_[0] : [ @_ ]; } sub head { shift->{mail_inet_head} ||= Mail::Header->new } #--------------- sub print($) { my $self = shift; my $fd = shift || \*STDOUT; $self->print_header($fd) and print $fd "\n" and $self->print_body($fd); } sub print_header($) { shift->head->print(@_) } sub print_body($) { my $self = shift; my $fd = shift || \*STDOUT; foreach my $ln (@{$self->body}) { print $fd $ln or return 0; } 1; } sub as_string() { my $self = shift; $self->head->as_string . "\n" . join '', @{$self->body}; } sub as_mbox_string($) { my $self = shift->dup; my $escaped = shift; $self->head->delete('Content-Length'); $self->escape_from unless $escaped; $self->as_string . "\n"; } #--------------- sub header { shift->head->header(@_) } sub fold { shift->head->fold(@_) } sub fold_length { shift->head->fold_length(@_) } sub combine { shift->head->combine(@_) } sub add(@) { my $head = shift->head; my $ret; while(@_) { my ($tag, $line) = splice @_, 0, 2; $ret = $head->add($tag, $line, -1) or return undef; } $ret; } sub replace(@) { my $head = shift->head; my $ret; while(@_) { my ($tag, $line) = splice @_, 0, 2; $ret = $head->replace($tag, $line, 0) or return undef; } $ret; } sub get(@) { my $head = shift->head; return map { $head->get($_) } @_ if wantarray; foreach my $tag (@_) { my $r = $head->get($tag); return $r if defined $r; } undef; } sub delete(@) { my $head = shift->head; map { $head->delete($_) } @_; } # Undocumented; unused??? sub empty() { my $self = shift; %$self = (); 1; } #--------------- sub remove_sig($) { my $body = shift->body; my $nlines = shift || 10; my $start = @$body; my $i = 0; while($i++ < $nlines && $start--) { next if $body->[$start] !~ /^--[ ]?[\r\n]/; splice @$body, $start, $i; last; } } sub sign(@) { my ($self, %arg) = @_; my ($sig, @sig); if($sig = delete $arg{File}) { local *SIG; if(open(SIG, $sig)) { local $_; while() { last unless /^(--)?\s*$/ } @sig = ($_, , "\n"); close SIG; } } elsif($sig = delete $arg{Signature}) { @sig = ref($sig) ? @$sig : split(/\n/, $sig); } if(@sig) { $self->remove_sig; s/[\r\n]*$/\n/ for @sig; push @{$self->body}, "-- \n", @sig; } $self; } sub tidy_body() { my $body = shift->body; shift @$body while @$body && $body->[0] =~ /^\s*$/; pop @$body while @$body && $body->[-1] =~ /^\s*$/; $body; } #--------------- sub reply(@) { my ($self, %arg) = @_; my $class = ref $self; my @reply; local *MAILHDR; if(open(MAILHDR, "$ENV{HOME}/.mailhdr")) { # User has defined a mail header template @reply = ; close MAILHDR; } my $reply = $class->new(\@reply); # The Subject line my $subject = $self->get('Subject') || ""; $subject = "Re: " . $subject if $subject =~ /\S+/ && $subject !~ /Re:/i; $reply->replace(Subject => $subject); # Locate who we are sending to my $to = $self->get('Reply-To') || $self->get('From') || $self->get('Return-Path') || ""; my $sender = (Mail::Address->parse($to))[0]; my $name = $sender->name; unless(defined $name) { my $fr = $self->get('From'); $fr = (Mail::Address->parse($fr))[0] if defined $fr; $name = $fr->name if defined $fr; } my $indent = $arg{Indent} || ">"; if($indent =~ /\%/) { my %hash = ( '%' => '%'); my @name = $name ? grep( {length $_} split /[\n\s]+/, $name) : ''; $hash{f} = $name[0]; $hash{F} = $#name ? substr($hash{f},0,1) : $hash{f}; $hash{l} = $#name ? $name[$#name] : ""; $hash{L} = substr($hash{l},0,1) || ""; $hash{n} = $name || ""; $hash{I} = join "", map {substr($_,0,1)} @name; $indent =~ s/\%(.)/defined $hash{$1} ? $hash{$1} : $1/eg; } my $id = $sender->address; $reply->replace(To => $id); # Find addresses not to include my $mailaddresses = $ENV{MAILADDRESSES} || ""; my %nocc = (lc($id) => 1); $nocc{lc $_->address} = 1 for Mail::Address->parse($reply->get('Bcc'), $mailaddresses); if($arg{ReplyAll}) # Who shall we copy this to { my %cc; foreach my $addr (Mail::Address->parse($self->get('To'), $self->get('Cc'))) { my $lc = lc $addr->address; $cc{$lc} = $addr->format unless $nocc{$lc}; } my $cc = join ', ', values %cc; $reply->replace(Cc => $cc); } # References my $refs = $self->get('References') || ""; my $mid = $self->get('Message-Id'); $refs .= " " . $mid if defined $mid; $reply->replace(References => $refs); # In-Reply-To my $date = $self->get('Date'); my $inreply = ""; if(defined $mid) { $inreply = $mid; my @comment; push @comment, "from $name" if defined $name; push @comment, "on $date" if defined $date; local $" = ' '; $inreply .= " (@comment)" if @comment; } elsif(defined $name) { $inreply = $name . "'s message"; $inreply .= "of " . $date if defined $date; } $reply->replace('In-Reply-To' => $inreply); # Quote the body my $body = $reply->body; @$body = @{$self->body}; # copy body $reply->remove_sig; $reply->tidy_body; s/\A/$indent/ for @$body; # Add references unshift @{$body}, (defined $name ? $name . " " : "") . "<$id> writes:\n"; if(defined $arg{Keep} && ref $arg{Keep} eq 'ARRAY') # Include lines { foreach my $keep (@{$arg{Keep}}) { my $ln = $self->get($keep); $reply->replace($keep => $ln) if defined $ln; } } if(defined $arg{Exclude} && ref $arg{Exclude} eq 'ARRAY') # Exclude lines { $reply->delete(@{$arg{Exclude}}); } $reply->head->cleanup; # remove empty header lines $reply; } sub smtpsend($@) { my ($self, %opt) = @_; require Net::SMTP; require Net::Domain; my $host = $opt{Host}; my $envelope = $opt{MailFrom} || mailaddress(); my $quit = 1; my ($smtp, @hello); push @hello, Hello => $opt{Hello} if defined $opt{Hello}; push @hello, Port => $opt{Port} if exists $opt{Port}; push @hello, Debug => $opt{Debug} if exists $opt{Debug}; if(!defined $host) { local $SIG{__DIE__}; my @hosts = qw(mailhost localhost); unshift @hosts, split /\:/, $ENV{SMTPHOSTS} if defined $ENV{SMTPHOSTS}; foreach $host (@hosts) { $smtp = eval { Net::SMTP->new($host, @hello) }; last if defined $smtp; } } elsif(UNIVERSAL::isa($host,'Net::SMTP') || UNIVERSAL::isa($host,'Net::SMTP::SSL')) { $smtp = $host; $quit = 0; } else { local $SIG{__DIE__}; $smtp = eval { Net::SMTP->new($host, @hello) }; } defined $smtp or return (); my $head = $self->cleaned_header_dup; # Who is it to my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'}; @rcpt = map { $head->get($_) } qw(To Cc Bcc) unless @rcpt; my @addr = map {$_->address} Mail::Address->parse(@rcpt); @addr or return (); $head->delete('Bcc'); # Send it my $ok = $smtp->mail($envelope) && $smtp->to(@addr) && $smtp->data(join("", @{$head->header}, "\n", @{$self->body})); $quit && $smtp->quit; $ok ? @addr : (); } sub send($@) { my ($self, $type, @args) = @_; require Mail::Mailer; my $head = $self->cleaned_header_dup; my $mailer = Mail::Mailer->new($type, @args); $mailer->open($head->header_hashref); $self->print_body($mailer); $mailer->close; } sub nntppost { my ($self, %opt) = @_; require Net::NNTP; my $groups = $self->get('Newsgroups') || ""; my @groups = split /[\s,]+/, $groups; @groups or return (); my $head = $self->cleaned_header_dup; # Remove these incase the NNTP host decides to mail as well as me $head->delete(qw(To Cc Bcc)); my $news; my $quit = 1; my $host = $opt{Host}; if(ref($host) && UNIVERSAL::isa($host,'Net::NNTP')) { $news = $host; $quit = 0; } else { my @opt = $opt{Host}; push @opt, Port => $opt{Port} if exists $opt{Port}; push @opt, Debug => $opt{Debug} if exists $opt{Debug}; $news = Net::NNTP->new(@opt) or return (); } $news->post(@{$head->header}, "\n", @{$self->body}); my $rc = $news->code; $news->quit if $quit; $rc == 240 ? @groups : (); } sub escape_from { my $body = shift->body; scalar grep { s/\A(>*From) />$1 /o } @$body; } sub unescape_from { my $body = shift->body; scalar grep { s/\A>(>*From) /$1 /o } @$body; } # Don't tell people it exists sub cleaned_header_dup() { my $head = shift->head->dup; $head->delete('From '); # Just in case :-) # An original message should not have any Received lines $head->delete('Received'); $head->replace('X-Mailer', "Perl5 Mail::Internet v".$Mail::Internet::VERSION) unless $head->count('X-Mailer'); my $name = eval {local $SIG{__DIE__}; (getpwuid($>))[6]} || $ENV{NAME} ||""; while($name =~ s/\([^\(\)]*\)//) { 1; } if($name =~ /[^\w\s]/) { $name =~ s/"/\"/g; $name = '"' . $name . '"'; } my $from = sprintf "%s <%s>", $name, mailaddress(); $from =~ s/\s{2,}/ /g; foreach my $tag (qw(From Sender)) { $head->get($tag) or $head->add($tag, $from); } $head; } 1; MailTools-2.22/lib/Mail/Internet.pod0000644000175000001440000002436314716611316020022 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Internet - manipulate email messages =head1 SYNOPSIS use Mail::Internet; my $msg = Mail::Internet->new(\*STDIN); =head1 DESCRIPTION This package implements reading, creating, manipulating, and writing email messages. Sometimes, the implementation tries to be too smart, but in the general case it works as expected. If you start writing a B, you should use the L distribution, which has more features and handles messages much better according to the RFCs. See L. You may also chose L, to get at least some multipart support in your application. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB() Duplicate the message as a whole. Both header and body will be deep-copied: a new L object is returned. =item $obj-EB(\@lines) Extract header and body from an ARRAY of message lines. Requires an object already created with L, which contents will get overwritten. =item $obj-EB( [$arg], [%options] ) =item Mail::Internet-EB( [$arg], [%options] ) $arg is optional and may be either a file descriptor (reference to a GLOB) or a reference to an array. If given the new object will be initialized with headers and body either from the array of read from the file descriptor. The L %options C, C and C may also be given. -Option--Default Body [] Header undef =over 2 =item Body => ARRAY-of-LINES The value of this option should be a reference to an array which contains the lines for the body of the message. Each line should be terminated with C<\n> (LF). If Body is given then C will not attempt to read the body from C<$arg> (even if it is specified). =item Header => Mail::Header The value of this option should be a L object. If given then C will not attempt to read a mail header from C<$arg>, if it was specified. =back =item $obj-EB($fh) Read a message from the $fh into an already existing message object. Better use L with the $fh as first argument. =back =head2 Accessors =over 4 =item $obj-EB( [$body] ) Returns the body of the message. This is a reference to an array. Each entry in the array represents a single line in the message. If I<$body> is given, it can be a reference to an array or an array, then the body will be replaced. If a reference is passed, it is used directly and not copied, so any subsequent changes to the array will change the contents of the body. =item $obj-EB() Returns the C object which holds the headers for the current message =back =head2 Processing the message as a whole =over 4 =item $obj-EB( [$already_escaped] ) Returns the message as a string in mbox format. C<$already_escaped>, if given and true, indicates that L has already been called on this object. =item $obj-EB() Returns the message as a single string. =item $obj-EB( [$fh] ) Print the header, body or whole message to file descriptor I<$fh>. I<$fd> should be a reference to a GLOB. If I<$fh> is not given the output will be sent to STDOUT. example: $mail->print( \*STDOUT ); # Print message to STDOUT =item $obj-EB( [$fh] ) Print only the body to the $fh (default STDOUT). =item $obj-EB( [$fh] ) Print only the header to the $fh (default STDOUT). =back =head2 Processing the header Most of these methods are simply wrappers around methods provided by L. =over 4 =item $obj-EB(PAIRS) The PAIRS are field-name and field-content. For each PAIR, L is called. All fields are added after existing fields. The last addition is returned. =item $obj-EB( $tag, [$with] ) See L. =item $obj-EB( $tag, [$tags] ) Delete all fields with the name $tag. L is doing the work. =item $obj-EB( [$length] ) See L. =item $obj-EB( [$tag], [$length] ) See L. =item $obj-EB( $tag, [$tags] ) In LIST context, all fields with the name $tag are returned. In SCALAR context, only the first field which matches the earliest $tag is returned. L is called to collect the data. =item $obj-EB
(\@lines) See L. =item $obj-EB(PAIRS) The PAIRS are field-name and field-content. For each PAIR, L is called with index 0. If a $field is already in the header, it will be removed first. Do not specified the same field-name twice. =back =head2 Processing the body =over 4 =item $obj-EB( [$nlines] ) Attempts to remove a user's signature from the body of a message. It does this by looking for a line equal to C<'-- '> within the last C<$nlines> of the message. If found then that line and all lines after it will be removed. If C<$nlines> is not given a default value of 10 will be used. This would be of most use in auto-reply scripts. =item $obj-EB(%options) Add your signature to the body. L will strip existing signatures first. -Option --Default File undef Signature [] =over 2 =item File => FILEHANDLE Take from the FILEHANDLE all lines starting from the first C<< -- >>. =item Signature => STRING|ARRAY-of-LINES =back =item $obj-EB() Removes all leading and trailing lines from the body that only contain white spaces. =back =head2 High-level functionality =over 4 =item $obj-EB() It can cause problems with some applications if a message contains a line starting with C<`From '>, in particular when attempting to split a folder. This method inserts a leading C<`>'> on any line that matches the regular expression C*From/> =item $obj-EB( [%options] ) Post an article via NNTP. Requires Net::NNTP to be installed. -Option--Default Debug Host Port 119 =over 2 =item Debug => BOOLEAN Debug value to pass to Net::NNTP, see L =item Host => HOSTNAME|Net::NNTP object Name of NNTP server to connect to, or a Net::NNTP object to use. =item Port => INTEGER Port number to connect to on remote host =back =item $obj-EB(%options) Create a new object with header initialised for a reply to the current object. And the body will be a copy of the current message indented. The C<.mailhdr> file in your home directory (if exists) will be read first, to provide defaults. -Option --Default Exclude [] Indent '>' Keep [] ReplyAll false =over 2 =item Exclude => ARRAY-of-FIELDS Remove the listed FIELDS from the produced message. =item Indent => STRING Use as indentation string. The string may contain C<%%> to get a single C<%>, C<%f> to get the first from name, C<%F> is the first character of C<%f>, C<%l> is the last name, C<%L> its first character, C<%n> the whole from string, and C<%I> the first character of each of the names in the from string. =item Keep => ARRAY-of-FIELDS Copy the listed FIELDS from the original message. =item ReplyAll => BOOLEAN Automatically include all To and Cc addresses of the original mail, excluding those mentioned in the Bcc list. =back =item $obj-EB( [$type, [$args...]] ) Send a Mail::Internet message using L. $type and $args are passed on to L. =item $obj-EB( [%options] ) Send a Mail::Internet message using direct SMTP to the given ADDRESSES, each can be either a string or a reference to a list of email addresses. If none of C, or C are given then the addresses are extracted from the message being sent. The return value will be a list of email addresses that the message was sent to. If the message was not sent the list will be empty. Requires Net::SMTP and Net::Domain to be installed. -Option --Default Bcc undef Cc undef Debug Hello localhost.localdomain Host $ENV{SMTPHOSTS} MailFrom Mail::Util::mailaddress() Port 25 To undef =over 2 =item Bcc => ADDRESSES =item Cc => ADDRESSES =item Debug => BOOLEAN Debug value to pass to Net::SMTP, see =item Hello => STRING Send a HELO (or EHLO) command to the server with the given name. =item Host => HOSTNAME Name of the SMTP server to connect to, or a Net::SMTP object to use If C is not given then the SMTP host is found by attempting connections first to hosts specified in C<$ENV{SMTPHOSTS}>, a colon separated list, then C and C. =item MailFrom => ADDRESS The e-mail address which is used as sender. By default, L provides the address of the sender. =item Port => INTEGER Port number to connect to on remote host =item To => ADDRESSES =back =item $obj-EB(()) Remove the escaping added by L. =back =head1 SEE ALSO This module is part of the MailTools distribution, F. =head1 AUTHORS The MailTools bundle was developed by Graham Barr. Later, Mark Overmeer took over maintenance without commitment to further development. Mail::Cap by Gisle Aas Eaas@oslonett.noE. Mail::Field::AddrList by Peter Orbaek Epoe@cit.dkE. Mail::Mailer and Mail::Send by Tim Bunce ETim.Bunce@ig.co.ukE. For other contributors see ChangeLog. =head1 LICENSE Copyrights 1995-2000 Graham Barr Egbarr@pobox.comE and 2001-2024 Mark Overmeer Eperl@overmeer.netE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F MailTools-2.22/lib/Mail/Field/0000755000175000001440000000000014716611317016542 5ustar00markovusers00000000000000MailTools-2.22/lib/Mail/Field/Date.pod0000644000175000001440000000574114716611316020131 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Field::Date - a date header field =head1 INHERITANCE Mail::Field::Date is a Mail::Field =head1 SYNOPSIS use HTTP::Date 'time2iso'; my $field = Mail::Field->new(Date => time2iso()); =head1 DESCRIPTION Represents one "Date" header field. Extends L<"DESCRIPTION" in Mail::Field|Mail::Field/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Field|Mail::Field/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Field|Mail::Field/"Constructors">. =over 4 =item Mail::Field::Date-EB($fields) Inherited, see L =item Mail::Field::Date-EB( $tag, $head [, $index ] ) Inherited, see L =item Mail::Field::Date-EB( $tag [, STRING | %options] ) Inherited, see L =back =head2 "Fake" constructors Extends L<""Fake" constructors" in Mail::Field|Mail::Field/""Fake" constructors">. =over 4 =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Accessors Extends L<"Accessors" in Mail::Field|Mail::Field/"Accessors">. =over 4 =item $obj-EB(%options) -Option --Default Time undef TimeStr undef =over 2 =item Time => SECONDS =item TimeStr => STRING A string acceptable to Date::Parse. =back =item $obj-EB() Inherited, see L =item $obj-EB() =item Mail::Field::Date-EB() Inherited, see L =back =head2 Smart accessors Extends L<"Smart accessors" in Mail::Field|Mail::Field/"Smart accessors">. =over 4 =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB