KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
database/perl/vendor/lib/Email/Sender/Transport/DevNull.pm vendored Normal file
View File

@@ -0,0 +1,49 @@
package Email::Sender::Transport::DevNull;
# ABSTRACT: happily throw away your mail
$Email::Sender::Transport::DevNull::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
#pod =head1 DESCRIPTION
#pod
#pod This class implements L<Email::Sender::Transport>. Any mail sent through a
#pod DevNull transport will be silently discarded.
#pod
#pod =cut
sub send_email { return $_[0]->success }
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::DevNull - happily throw away your mail
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This class implements L<Email::Sender::Transport>. Any mail sent through a
DevNull transport will be silently discarded.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

92
database/perl/vendor/lib/Email/Sender/Transport/Failable.pm vendored Normal file
View File

@@ -0,0 +1,92 @@
package Email::Sender::Transport::Failable;
# ABSTRACT: a wrapper to makes things fail predictably
$Email::Sender::Transport::Failable::VERSION = '1.300035';
use Moo;
extends 'Email::Sender::Transport::Wrapper';
use MooX::Types::MooseLike::Base qw(ArrayRef);
#pod =head1 DESCRIPTION
#pod
#pod This transport extends L<Email::Sender::Transport::Wrapper>, meaning that it
#pod must be created with a C<transport> attribute of another
#pod Email::Sender::Transport. It will proxy all email sending to that transport,
#pod but only after first deciding if it should fail.
#pod
#pod It does this by calling each coderef in its C<failure_conditions> attribute,
#pod which must be an arrayref of code references. Each coderef will be called and
#pod will be passed the Failable transport, the Email::Abstract object, the
#pod envelope, and a reference to an array containing the rest of the arguments to
#pod C<send>.
#pod
#pod If any coderef returns a true value, the value will be used to signal failure.
#pod
#pod =cut
has 'failure_conditions' => (
isa => ArrayRef,
default => sub { [] },
is => 'ro',
reader => '_failure_conditions',
);
sub failure_conditions { @{$_[0]->_failure_conditions} }
sub fail_if { push @{shift->_failure_conditions}, @_ }
sub clear_failure_conditions { @{$_[0]->{failure_conditions}} = () }
around send_email => sub {
my ($orig, $self, $email, $env, @rest) = @_;
for my $cond ($self->failure_conditions) {
my $reason = $cond->($self, $email, $env, \@rest);
next unless $reason;
die (ref $reason ? $reason : Email::Sender::Failure->new($reason));
}
return $self->$orig($email, $env, @rest);
};
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Failable - a wrapper to makes things fail predictably
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport extends L<Email::Sender::Transport::Wrapper>, meaning that it
must be created with a C<transport> attribute of another
Email::Sender::Transport. It will proxy all email sending to that transport,
but only after first deciding if it should fail.
It does this by calling each coderef in its C<failure_conditions> attribute,
which must be an arrayref of code references. Each coderef will be called and
will be passed the Failable transport, the Email::Abstract object, the
envelope, and a reference to an array containing the rest of the arguments to
C<send>.
If any coderef returns a true value, the value will be used to signal failure.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

222
database/perl/vendor/lib/Email/Sender/Transport/Maildir.pm vendored Normal file
View File

@@ -0,0 +1,222 @@
package Email::Sender::Transport::Maildir;
# ABSTRACT: deliver mail to a maildir on disk
$Email::Sender::Transport::Maildir::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
use Errno ();
use Fcntl;
use File::Path 2.06;
use File::Spec;
use Sys::Hostname;
use MooX::Types::MooseLike::Base qw(Bool);
#pod =head1 DESCRIPTION
#pod
#pod This transport delivers into a maildir. The maildir's location may be given as
#pod the F<dir> argument to the constructor, and defaults to F<Maildir> in the
#pod current directory (at the time of transport initialization).
#pod
#pod If the directory does not exist, it will be created.
#pod
#pod By default, three headers will be added:
#pod
#pod * X-Email-Sender-From - the envelope sender
#pod * X-Email-Sender-To - the envelope recipients (one header per rcpt)
#pod * Lines - the number of lines in the body
#pod
#pod These can be controlled with the C<add_lines_header> and
#pod C<add_envelope_headers> constructor arguments.
#pod
#pod The L<Email::Sender::Success> object returned on success has a C<filename>
#pod method that returns the filename to which the message was delivered.
#pod
#pod =cut
{
package
Email::Sender::Success::MaildirSuccess;
use Moo;
use MooX::Types::MooseLike::Base qw(Str);
extends 'Email::Sender::Success';
has filename => (
is => 'ro',
isa => Str,
required => 1,
);
no Moo;
}
my $HOSTNAME;
BEGIN { ($HOSTNAME = hostname) =~ s/\..*//; }
sub _hostname { $HOSTNAME }
my $MAILDIR_TIME = 0;
my $MAILDIR_COUNTER = 0;
has [ qw(add_lines_header add_envelope_headers) ] => (
is => 'ro',
isa => Bool,
default => sub { 1 },
);
has dir => (
is => 'ro',
required => 1,
default => sub { File::Spec->catdir(File::Spec->curdir, 'Maildir') },
);
sub send_email {
my ($self, $email, $env) = @_;
my $dupe = Email::Abstract->new(\do { $email->as_string });
if ($self->add_envelope_headers) {
$dupe->set_header('X-Email-Sender-From' =>
(defined $env->{from} ? $env->{from} : '-'),
);
my @to = grep {; defined } @{ $env->{to} };
$dupe->set_header('X-Email-Sender-To' => (@to ? @to : '-'));
}
$self->_ensure_maildir_exists;
$self->_add_lines_header($dupe) if $self->add_lines_header;
$self->_update_time;
my $fn = $self->_deliver_email($dupe);
return Email::Sender::Success::MaildirSuccess->new({
filename => $fn,
});
}
sub _ensure_maildir_exists {
my ($self) = @_;
for my $dir (qw(cur tmp new)) {
my $subdir = File::Spec->catdir($self->dir, $dir);
next if -d $subdir;
Email::Sender::Failure->throw("couldn't create $subdir: $!")
unless File::Path::make_path($subdir) || -d $subdir;
}
}
sub _add_lines_header {
my ($class, $email) = @_;
return if $email->get_header("Lines");
my $lines = $email->get_body =~ tr/\n/\n/;
$email->set_header("Lines", $lines);
}
sub _update_time {
my $time = time;
if ($MAILDIR_TIME != $time) {
$MAILDIR_TIME = $time;
$MAILDIR_COUNTER = 0;
} else {
$MAILDIR_COUNTER++;
}
}
sub _deliver_email {
my ($self, $email) = @_;
my ($tmp_filename, $tmp_fh) = $self->_delivery_fh;
# if (eval { $email->can('stream_to') }) {
# eval { $mail->stream_to($fh); 1 } or return;
#} else {
my $string = $email->as_string;
$string =~ s/\x0D\x0A/\x0A/g unless $^O eq 'MSWin32';
print $tmp_fh $string
or Email::Sender::Failure->throw("could not write to $tmp_filename: $!");
close $tmp_fh
or Email::Sender::Failure->throw("error closing $tmp_filename: $!");
my $target_name = File::Spec->catfile($self->dir, 'new', $tmp_filename);
my $ok = rename(
File::Spec->catfile($self->dir, 'tmp', $tmp_filename),
$target_name,
);
Email::Sender::Failure->throw("could not move $tmp_filename from tmp to new")
unless $ok;
return $target_name;
}
sub _delivery_fh {
my ($self) = @_;
my $hostname = $self->_hostname;
my ($filename, $fh);
until ($fh) {
$filename = join q{.}, $MAILDIR_TIME, $$, ++$MAILDIR_COUNTER, $hostname;
my $filespec = File::Spec->catfile($self->dir, 'tmp', $filename);
sysopen $fh, $filespec, O_CREAT|O_EXCL|O_WRONLY;
binmode $fh;
Email::Sender::Failure->throw("cannot create $filespec for delivery: $!")
unless $fh or $!{EEXIST};
}
return ($filename, $fh);
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Maildir - deliver mail to a maildir on disk
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport delivers into a maildir. The maildir's location may be given as
the F<dir> argument to the constructor, and defaults to F<Maildir> in the
current directory (at the time of transport initialization).
If the directory does not exist, it will be created.
By default, three headers will be added:
* X-Email-Sender-From - the envelope sender
* X-Email-Sender-To - the envelope recipients (one header per rcpt)
* Lines - the number of lines in the body
These can be controlled with the C<add_lines_header> and
C<add_envelope_headers> constructor arguments.
The L<Email::Sender::Success> object returned on success has a C<filename>
method that returns the filename to which the message was delivered.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

150
database/perl/vendor/lib/Email/Sender/Transport/Mbox.pm vendored Normal file
View File

@@ -0,0 +1,150 @@
package Email::Sender::Transport::Mbox;
# ABSTRACT: deliver mail to an mbox on disk
$Email::Sender::Transport::Mbox::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
use Carp;
use File::Path;
use File::Basename;
use IO::File 1.11; # binmode
use Email::Simple 1.998; # needed for ->header_obj
use Fcntl ':flock';
#pod =head1 DESCRIPTION
#pod
#pod This transport delivers into an mbox. The mbox file may be given by the
#pod F<filename> argument to the constructor, and defaults to F<mbox>.
#pod
#pod The transport I<currently> assumes that the mbox is in F<mboxo> format, but
#pod this may change or be configurable in the future.
#pod
#pod =cut
has 'filename' => (is => 'ro', default => sub { 'mbox' }, required => 1);
sub send_email {
my ($self, $email, $env) = @_;
my $filename = $self->filename;
my $fh = $self->_open_fh($filename);
my $ok = eval {
if ($fh->tell > 0) {
$fh->print("\n") or Carp::confess("couldn't write to $filename: $!");
}
$fh->print($self->_from_line($email, $env))
or Carp::confess("couldn't write to $filename: $!");
$fh->print($self->_escape_from_body($email))
or Carp::confess("couldn't write to $filename: $!");
# This will make streaming a bit more annoying. -- rjbs, 2007-05-25
$fh->print("\n")
or Carp::confess("couldn't write to $filename: $!")
unless $email->as_string =~ /\n$/;
$self->_close_fh($fh)
or Carp::confess "couldn't close file $filename: $!";
1;
};
die unless $ok;
# Email::Sender::Failure->throw($@ || 'unknown error') unless $ok;
return $self->success;
}
sub _open_fh {
my ($class, $file) = @_;
my $dir = dirname($file);
Carp::confess "couldn't make path $dir: $!" if not -d $dir or mkpath($dir);
my $fh = IO::File->new($file, '>>')
or Carp::confess "couldn't open $file for appending: $!";
$fh->binmode(':raw');
$class->_getlock($fh, $file);
$fh->seek(0, 2);
return $fh;
}
sub _close_fh {
my ($class, $fh, $file) = @_;
$class->_unlock($fh);
return $fh->close;
}
sub _escape_from_body {
my ($class, $email) = @_;
my $body = $email->get_body;
$body =~ s/^(From )/>$1/gm;
my $simple = $email->cast('Email::Simple');
return $simple->header_obj->as_string . $simple->crlf . $body;
}
sub _from_line {
my ($class, $email, $envelope) = @_;
my $fromtime = localtime;
$fromtime =~ s/(:\d\d) \S+ (\d{4})$/$1 $2/; # strip timezone.
return "From $envelope->{from} $fromtime\n";
}
sub _getlock {
my ($class, $fh, $fn) = @_;
for (1 .. 10) {
return 1 if flock($fh, LOCK_EX | LOCK_NB);
sleep $_;
}
Carp::confess "couldn't lock file $fn";
}
sub _unlock {
my ($class, $fh) = @_;
flock($fh, LOCK_UN);
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Mbox - deliver mail to an mbox on disk
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport delivers into an mbox. The mbox file may be given by the
F<filename> argument to the constructor, and defaults to F<mbox>.
The transport I<currently> assumes that the mbox is in F<mboxo> format, but
this may change or be configurable in the future.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

75
database/perl/vendor/lib/Email/Sender/Transport/Print.pm vendored Normal file
View File

@@ -0,0 +1,75 @@
package Email::Sender::Transport::Print;
# ABSTRACT: print email to a filehandle (like stdout)
$Email::Sender::Transport::Print::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
#pod =head1 DESCRIPTION
#pod
#pod When this transport is handed mail, it prints it to a filehandle. By default,
#pod it will print to STDOUT, but it can be given any L<IO::Handle> object to print
#pod to as its C<fh> attribute.
#pod
#pod =cut
use IO::Handle;
use MooX::Types::MooseLike::Base qw(InstanceOf);
has 'fh' => (
is => 'ro',
isa => InstanceOf['IO::Handle'],
required => 1,
default => sub { IO::Handle->new_from_fd(fileno(STDOUT), 'w') },
);
sub send_email {
my ($self, $email, $env) = @_;
my $fh = $self->fh;
$fh->printf("ENVELOPE TO : %s\n", join(q{, }, @{ $env->{to} }) || '-');
$fh->printf("ENVELOPE FROM: %s\n", defined $env->{from} ? $env->{from} : '-');
$fh->print(q{-} x 10 . " begin message\n");
$fh->print( $email->as_string );
$fh->print(q{-} x 10 . " end message\n");
return $self->success;
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Print - print email to a filehandle (like stdout)
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
When this transport is handed mail, it prints it to a filehandle. By default,
it will print to STDOUT, but it can be given any L<IO::Handle> object to print
to as its C<fh> attribute.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

413
database/perl/vendor/lib/Email/Sender/Transport/SMTP.pm vendored Normal file
View File

@@ -0,0 +1,413 @@
package Email::Sender::Transport::SMTP;
# ABSTRACT: send email over SMTP
$Email::Sender::Transport::SMTP::VERSION = '1.300035';
use Moo;
use Email::Sender::Failure::Multi;
use Email::Sender::Success::Partial;
use Email::Sender::Role::HasMessage ();
use Email::Sender::Util;
use MooX::Types::MooseLike::Base qw(Bool Int Str HashRef);
use Net::SMTP 3.07; # SSL support, fixed datasend
use utf8 (); # See below. -- rjbs, 2015-05-14
#pod =head1 DESCRIPTION
#pod
#pod This transport is used to send email over SMTP, either with or without secure
#pod sockets (SSL/TLS). It is one of the most complex transports available, capable
#pod of partial success.
#pod
#pod For a potentially more efficient version of this transport, see
#pod L<Email::Sender::Transport::SMTP::Persistent>.
#pod
#pod =head1 ATTRIBUTES
#pod
#pod The following attributes may be passed to the constructor:
#pod
#pod =over 4
#pod
#pod =item C<hosts>: an arrayref of names of the host to try, in order; defaults to a single element array containing C<localhost>
#pod
#pod The attribute C<host> may be given, instead, which contains a single hostname.
#pod
#pod =item C<ssl>: if 'starttls', use STARTTLS; if 'ssl' (or 1), connect securely;
#pod otherwise, no security
#pod
#pod =item C<ssl_options>: passed to Net::SMTP constructor for 'ssl' connections or
#pod to starttls for 'starttls' connections; should contain extra options for
#pod IO::Socket::SSL
#pod
#pod =item C<port>: port to connect to; defaults to 25 for non-SSL, 465 for 'ssl',
#pod 587 for 'starttls'
#pod
#pod =item C<timeout>: maximum time in secs to wait for server; default is 120
#pod
#pod =cut
sub BUILD {
my ($self) = @_;
Carp::croak("do not pass port number to SMTP transport in host, use port parameter")
if grep {; /:/ } $self->hosts;
}
sub BUILDARGS {
my ($self, @rest) = @_;
my $arg = $self->SUPER::BUILDARGS(@rest);
if (exists $arg->{host}) {
Carp::croak("can't pass both host and hosts to constructor")
if exists $arg->{hosts};
$arg->{hosts} = [ delete $arg->{host} ];
}
return $arg;
}
has ssl => (is => 'ro', isa => Str, default => sub { 0 });
has _hosts => (
is => 'ro',
isa => sub {
die "invalid hosts in Email::Sender::Transport::SMTP constructor"
unless defined $_[0]
&& (ref $_[0] eq 'ARRAY')
&& (grep {; length } @{ $_[0] }) > 0;
},
default => sub { [ 'localhost' ] },
init_arg => 'hosts',
);
sub hosts { @{ $_[0]->_hosts } }
sub host { $_[0]->_hosts->[0] }
has _security => (
is => 'ro',
lazy => 1,
init_arg => undef,
default => sub {
my $ssl = $_[0]->ssl;
return '' unless $ssl;
$ssl = lc $ssl;
return 'starttls' if 'starttls' eq $ssl;
return 'ssl' if $ssl eq 1 or $ssl eq 'ssl';
Carp::cluck(qq{true "ssl" argument to Email::Sender::Transport::SMTP should be 'ssl' or 'startls' or '1' but got '$ssl'});
return 1;
},
);
has ssl_options => (is => 'ro', isa => HashRef, default => sub { {} });
has port => (
is => 'ro',
isa => Int,
lazy => 1,
default => sub {
return $_[0]->_security eq 'starttls' ? 587
: $_[0]->_security eq 'ssl' ? 465
: 25
},
);
has timeout => (is => 'ro', isa => Int, default => sub { 120 });
#pod =item C<sasl_username>: the username to use for auth; optional
#pod
#pod =item C<sasl_password>: the password to use for auth; required if C<sasl_username> is provided
#pod
#pod =item C<allow_partial_success>: if true, will send data even if some recipients were rejected; defaults to false
#pod
#pod =cut
has sasl_username => (is => 'ro', isa => Str);
has sasl_password => (is => 'ro', isa => Str);
has allow_partial_success => (is => 'ro', isa => Bool, default => sub { 0 });
#pod =item C<helo>: what to say when saying HELO; no default
#pod
#pod =item C<localaddr>: local address from which to connect
#pod
#pod =item C<localport>: local port from which to connect
#pod
#pod =cut
has helo => (is => 'ro', isa => Str);
has localaddr => (is => 'ro');
has localport => (is => 'ro', isa => Int);
#pod =item C<debug>: if true, put the L<Net::SMTP> object in debug mode
#pod
#pod =back
#pod
#pod =cut
has debug => (is => 'ro', isa => Bool, default => sub { 0 });
# I am basically -sure- that this is wrong, but sending hundreds of millions of
# messages has shown that it is right enough. I will try to make it textbook
# later. -- rjbs, 2008-12-05
sub _quoteaddr {
my $addr = shift;
my @localparts = split /\@/, $addr;
my $domain = pop @localparts;
my $localpart = join q{@}, @localparts;
return $addr # The first regex here is RFC 821 "specials" excepting dot.
unless $localpart =~ /[\x00-\x1F\x7F<>\(\)\[\]\\,;:@"]/
or $localpart =~ /^\./
or $localpart =~ /\.$/;
return join q{@}, qq("$localpart"), $domain;
}
sub _smtp_client {
my ($self) = @_;
my $class = "Net::SMTP";
my $smtp = $class->new( $self->_net_smtp_args );
unless ($smtp) {
$self->_throw(
sprintf "unable to establish SMTP connection to (%s) port %s",
(join q{, }, $self->hosts),
$self->port,
);
}
if ($self->_security eq 'starttls') {
$self->_throw("can't STARTTLS: " . $smtp->message)
unless $smtp->starttls(%{ $self->ssl_options });
}
if ($self->sasl_username) {
$self->_throw("sasl_username but no sasl_password")
unless defined $self->sasl_password;
unless ($smtp->auth($self->sasl_username, $self->sasl_password)) {
if ($smtp->message =~ /MIME::Base64|Authen::SASL/) {
Carp::confess("SMTP auth requires MIME::Base64 and Authen::SASL");
}
$self->_throw('failed AUTH', $smtp);
}
}
return $smtp;
}
sub _net_smtp_args {
my ($self) = @_;
return (
[ $self->hosts ],
Port => $self->port,
Timeout => $self->timeout,
Debug => $self->debug,
(($self->_security eq 'ssl')
? (SSL => 1, %{ $self->ssl_options })
: ()),
defined $self->helo ? (Hello => $self->helo) : (),
defined $self->localaddr ? (LocalAddr => $self->localaddr) : (),
defined $self->localport ? (LocalPort => $self->localport) : (),
);
}
sub _throw {
my ($self, @rest) = @_;
Email::Sender::Util->_failure(@rest)->throw;
}
sub send_email {
my ($self, $email, $env) = @_;
Email::Sender::Failure->throw("no valid addresses in recipient list")
unless my @to = grep { defined and length } @{ $env->{to} };
my $smtp = $self->_smtp_client;
my $FAULT = sub { $self->_throw($_[0], $smtp); };
$smtp->mail(_quoteaddr($env->{from}))
or $FAULT->("$env->{from} failed after MAIL FROM");
my @failures;
my @ok_rcpts;
for my $addr (@to) {
if ($smtp->to(_quoteaddr($addr))) {
push @ok_rcpts, $addr;
} else {
# my ($self, $error, $smtp, $error_class, @rest) = @_;
push @failures, Email::Sender::Util->_failure(
undef,
$smtp,
recipients => [ $addr ],
);
}
}
# This logic used to include: or (@ok_rcpts == 1 and $ok_rcpts[0] eq '0')
# because if called without SkipBad, $smtp->to can return 1 or 0. This
# should not happen because we now always pass SkipBad and do the counting
# ourselves. Still, I've put this comment here (a) in memory of the
# suffering it caused to have to find that problem and (b) in case the
# original problem is more insidious than I thought! -- rjbs, 2008-12-05
if (
@failures
and ((@ok_rcpts == 0) or (! $self->allow_partial_success))
) {
$failures[0]->throw if @failures == 1;
my $message = sprintf '%s recipients were rejected during RCPT',
@ok_rcpts ? 'some' : 'all';
Email::Sender::Failure::Multi->throw(
message => $message,
failures => \@failures,
);
}
# restore Pobox's support for streaming, code-based messages, and arrays here
# -- rjbs, 2008-12-04
$smtp->data or $FAULT->("error at DATA start");
my $msg_string = $email->as_string;
my $hunk_size = $self->_hunk_size;
while (length $msg_string) {
my $next_hunk = substr $msg_string, 0, $hunk_size, '';
$smtp->datasend($next_hunk) or $FAULT->("error at during DATA");
}
$smtp->dataend or $FAULT->("error at after DATA");
my $message = $smtp->message;
$self->_message_complete($smtp);
# We must report partial success (failures) if applicable.
return $self->success({ message => $message }) unless @failures;
return $self->partial_success({
message => $message,
failure => Email::Sender::Failure::Multi->new({
message => 'some recipients were rejected during RCPT',
failures => \@failures
}),
});
}
sub _hunk_size { 2**20 } # send messages to DATA in hunks of 1 mebibyte
sub success {
my $self = shift;
my $success = Moo::Role->create_class_with_roles('Email::Sender::Success', 'Email::Sender::Role::HasMessage')->new(@_);
}
sub partial_success {
my $self = shift;
my $partial_success = Moo::Role->create_class_with_roles('Email::Sender::Success::Partial', 'Email::Sender::Role::HasMessage')->new(@_);
}
sub _message_complete { $_[1]->quit; }
#pod =head1 PARTIAL SUCCESS
#pod
#pod If C<allow_partial_success> was set when creating the transport, the transport
#pod may return L<Email::Sender::Success::Partial> objects. Consult that module's
#pod documentation.
#pod
#pod =cut
with 'Email::Sender::Transport';
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::SMTP - send email over SMTP
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport is used to send email over SMTP, either with or without secure
sockets (SSL/TLS). It is one of the most complex transports available, capable
of partial success.
For a potentially more efficient version of this transport, see
L<Email::Sender::Transport::SMTP::Persistent>.
=head1 ATTRIBUTES
The following attributes may be passed to the constructor:
=over 4
=item C<hosts>: an arrayref of names of the host to try, in order; defaults to a single element array containing C<localhost>
The attribute C<host> may be given, instead, which contains a single hostname.
=item C<ssl>: if 'starttls', use STARTTLS; if 'ssl' (or 1), connect securely;
otherwise, no security
=item C<ssl_options>: passed to Net::SMTP constructor for 'ssl' connections or
to starttls for 'starttls' connections; should contain extra options for
IO::Socket::SSL
=item C<port>: port to connect to; defaults to 25 for non-SSL, 465 for 'ssl',
587 for 'starttls'
=item C<timeout>: maximum time in secs to wait for server; default is 120
=item C<sasl_username>: the username to use for auth; optional
=item C<sasl_password>: the password to use for auth; required if C<sasl_username> is provided
=item C<allow_partial_success>: if true, will send data even if some recipients were rejected; defaults to false
=item C<helo>: what to say when saying HELO; no default
=item C<localaddr>: local address from which to connect
=item C<localport>: local port from which to connect
=item C<debug>: if true, put the L<Net::SMTP> object in debug mode
=back
=head1 PARTIAL SUCCESS
If C<allow_partial_success> was set when creating the transport, the transport
may return L<Email::Sender::Success::Partial> objects. Consult that module's
documentation.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

99
database/perl/vendor/lib/Email/Sender/Transport/SMTP/Persistent.pm vendored Normal file
View File

@@ -0,0 +1,99 @@
package Email::Sender::Transport::SMTP::Persistent;
# ABSTRACT: an SMTP client that stays online
$Email::Sender::Transport::SMTP::Persistent::VERSION = '1.300035';
use Moo;
extends 'Email::Sender::Transport::SMTP';
#pod =head1 DESCRIPTION
#pod
#pod The stock L<Email::Sender::Transport::SMTP> reconnects each time it sends a
#pod message. This transport only reconnects when the existing connection fails.
#pod
#pod =cut
use Net::SMTP;
has _cached_client => (
is => 'rw',
);
sub _smtp_client {
my ($self) = @_;
if (my $client = $self->_cached_client) {
return $client if eval { $client->reset; $client->ok; };
my $error = $@
|| 'error resetting cached SMTP connection: ' . $client->message;
Carp::carp($error);
}
my $client = $self->SUPER::_smtp_client;
$self->_cached_client($client);
return $client;
}
sub _message_complete { }
#pod =method disconnect
#pod
#pod $transport->disconnect;
#pod
#pod This method sends an SMTP QUIT command and destroys the SMTP client, if on
#pod exists and is connected.
#pod
#pod =cut
sub disconnect {
my ($self) = @_;
return unless $self->_cached_client;
$self->_cached_client->quit;
$self->_cached_client(undef);
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::SMTP::Persistent - an SMTP client that stays online
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
The stock L<Email::Sender::Transport::SMTP> reconnects each time it sends a
message. This transport only reconnects when the existing connection fails.
=head1 METHODS
=head2 disconnect
$transport->disconnect;
This method sends an SMTP QUIT command and destroys the SMTP client, if on
exists and is connected.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

139
database/perl/vendor/lib/Email/Sender/Transport/Sendmail.pm vendored Normal file
View File

@@ -0,0 +1,139 @@
package Email::Sender::Transport::Sendmail;
# ABSTRACT: send mail via sendmail(1)
$Email::Sender::Transport::Sendmail::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
use MooX::Types::MooseLike::Base qw(Str);
#pod =head2 DESCRIPTION
#pod
#pod This transport sends mail by piping it to the F<sendmail> command. If the
#pod location of the F<sendmail> command is not provided in the constructor (see
#pod below) then the library will look for an executable file called F<sendmail> in
#pod the path.
#pod
#pod To specify the location of sendmail:
#pod
#pod my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $path });
#pod
#pod =cut
use File::Spec ();
has 'sendmail' => (
is => 'ro',
isa => Str,
required => 1,
lazy => 1,
default => sub {
# This should not have to be lazy, but Moose has a bug(?) that prevents the
# instance or partial-instance from being passed in to the default sub.
# Laziness doesn't hurt much, though, because (ugh) of the BUILD below.
# -- rjbs, 2008-12-04
# return $ENV{PERL_SENDMAIL_PATH} if $ENV{PERL_SENDMAIL_PATH}; # ???
return $_[0]->_find_sendmail('sendmail');
},
);
sub BUILD {
$_[0]->sendmail; # force population -- rjbs, 2009-06-08
}
sub _find_sendmail {
my ($self, $program_name) = @_;
$program_name ||= 'sendmail';
my @path = File::Spec->path;
if ($program_name eq 'sendmail') {
# for 'real' sendmail we will look in common locations -- rjbs, 2009-07-12
push @path, (
File::Spec->catfile('', qw(usr sbin)),
File::Spec->catfile('', qw(usr lib)),
);
}
for my $dir (@path) {
my $sendmail = File::Spec->catfile($dir, $program_name);
return $sendmail if ($^O eq 'MSWin32') ? -f $sendmail : -x $sendmail;
}
Carp::confess("couldn't find a sendmail executable");
}
sub _sendmail_pipe {
my ($self, $envelope) = @_;
my $prog = $self->sendmail;
my ($first, @args) = $^O eq 'MSWin32'
? qq(| "$prog" -i -f $envelope->{from} @{$envelope->{to}})
: (q{|-}, $prog, '-i', '-f', $envelope->{from}, '--', @{$envelope->{to}});
no warnings 'exec'; ## no critic
my $pipe;
Email::Sender::Failure->throw("couldn't open pipe to sendmail ($prog): $!")
unless open($pipe, $first, @args);
return $pipe;
}
sub send_email {
my ($self, $email, $envelope) = @_;
my $pipe = $self->_sendmail_pipe($envelope);
my $string = $email->as_string;
$string =~ s/\x0D\x0A/\x0A/g unless $^O eq 'MSWin32';
print $pipe $string
or Email::Sender::Failure->throw("couldn't send message to sendmail: $!");
close $pipe
or Email::Sender::Failure->throw("error when closing pipe to sendmail: $!");
return $self->success;
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Sendmail - send mail via sendmail(1)
=head1 VERSION
version 1.300035
=head2 DESCRIPTION
This transport sends mail by piping it to the F<sendmail> command. If the
location of the F<sendmail> command is not provided in the constructor (see
below) then the library will look for an executable file called F<sendmail> in
the path.
To specify the location of sendmail:
my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $path });
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

219
database/perl/vendor/lib/Email/Sender/Transport/Test.pm vendored Normal file
View File

@@ -0,0 +1,219 @@
package Email::Sender::Transport::Test;
# ABSTRACT: deliver mail in memory for testing
$Email::Sender::Transport::Test::VERSION = '1.300035';
use Moo;
use Email::Sender::Failure::Multi;
use Email::Sender::Success::Partial;
use MooX::Types::MooseLike::Base qw(ArrayRef Bool);
#pod =head1 DESCRIPTION
#pod
#pod This transport is meant for testing email deliveries in memory. It will store
#pod a record of any delivery made so that they can be inspected afterward.
#pod
#pod =for Pod::Coverage recipient_failure delivery_failure
#pod
#pod By default, the Test transport will not allow partial success and will always
#pod succeed. It can be made to fail predictably, however, if it is extended and
#pod its C<recipient_failure> or C<delivery_failure> methods are overridden. These
#pod methods are called as follows:
#pod
#pod $self->delivery_failure($email, $envelope);
#pod
#pod $self->recipient_failure($to);
#pod
#pod If they return true, the sending will fail. If the transport was created with
#pod a true C<allow_partial_success> attribute, recipient failures can cause partial
#pod success to be returned.
#pod
#pod For more flexible failure modes, you can override more aggressively or can use
#pod L<Email::Sender::Transport::Failable>.
#pod
#pod =attr deliveries
#pod
#pod =for Pod::Coverage clear_deliveries
#pod
#pod This attribute stores an arrayref of all the deliveries made via the transport.
#pod The C<clear_deliveries> method returns a list of them.
#pod
#pod Each delivery is a hashref, in the following format:
#pod
#pod {
#pod email => $email,
#pod envelope => $envelope,
#pod successes => \@ok_rcpts,
#pod failures => \@failures,
#pod }
#pod
#pod Both successful and failed deliveries are stored.
#pod
#pod A number of methods related to this attribute are provided:
#pod
#pod =for :list
#pod * delivery_count
#pod * clear_deliveries
#pod * shift_deliveries
#pod
#pod =cut
has allow_partial_success => (is => 'ro', isa => Bool, default => sub { 0 });
sub recipient_failure { }
sub delivery_failure { }
has deliveries => (
isa => ArrayRef,
init_arg => undef,
default => sub { [] },
is => 'ro',
reader => '_deliveries',
);
sub delivery_count { scalar @{ $_[0]->_deliveries } }
sub record_delivery { push @{ shift->_deliveries }, @_ }
sub deliveries { @{ $_[0]->_deliveries } }
sub shift_deliveries { shift @{ $_[0]->_deliveries } }
sub clear_deliveries { @{ $_[0]->_deliveries } = () }
sub send_email {
my ($self, $email, $envelope) = @_;
my @failures;
my @ok_rcpts;
if (my $failure = $self->delivery_failure($email, $envelope)) {
$failure->throw;
}
for my $to (@{ $envelope->{to} }) {
if (my $failure = $self->recipient_failure($to)) {
push @failures, $failure;
} else {
push @ok_rcpts, $to;
}
}
if (
@failures
and ((@ok_rcpts == 0) or (! $self->allow_partial_success))
) {
$failures[0]->throw if @failures == 1 and @ok_rcpts == 0;
my $message = sprintf '%s recipients were rejected',
@ok_rcpts ? 'some' : 'all';
Email::Sender::Failure::Multi->throw(
message => $message,
failures => \@failures,
);
}
$self->record_delivery({
email => $email,
envelope => $envelope,
successes => \@ok_rcpts,
failures => \@failures,
});
# XXX: We must report partial success (failures) if applicable.
return $self->success unless @failures;
return Email::Sender::Success::Partial->new({
failure => Email::Sender::Failure::Multi->new({
message => 'some recipients were rejected',
failures => \@failures
}),
});
}
with 'Email::Sender::Transport';
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Test - deliver mail in memory for testing
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport is meant for testing email deliveries in memory. It will store
a record of any delivery made so that they can be inspected afterward.
=head1 ATTRIBUTES
=head2 deliveries
=for Pod::Coverage recipient_failure delivery_failure
By default, the Test transport will not allow partial success and will always
succeed. It can be made to fail predictably, however, if it is extended and
its C<recipient_failure> or C<delivery_failure> methods are overridden. These
methods are called as follows:
$self->delivery_failure($email, $envelope);
$self->recipient_failure($to);
If they return true, the sending will fail. If the transport was created with
a true C<allow_partial_success> attribute, recipient failures can cause partial
success to be returned.
For more flexible failure modes, you can override more aggressively or can use
L<Email::Sender::Transport::Failable>.
=for Pod::Coverage clear_deliveries
This attribute stores an arrayref of all the deliveries made via the transport.
The C<clear_deliveries> method returns a list of them.
Each delivery is a hashref, in the following format:
{
email => $email,
envelope => $envelope,
successes => \@ok_rcpts,
failures => \@failures,
}
Both successful and failed deliveries are stored.
A number of methods related to this attribute are provided:
=over 4
=item *
delivery_count
=item *
clear_deliveries
=item *
shift_deliveries
=back
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

90
database/perl/vendor/lib/Email/Sender/Transport/Wrapper.pm vendored Normal file
View File

@@ -0,0 +1,90 @@
package Email::Sender::Transport::Wrapper;
# ABSTRACT: a mailer to wrap a mailer for mailing mail
$Email::Sender::Transport::Wrapper::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
use Email::Sender::Util;
#pod =head1 DESCRIPTION
#pod
#pod Email::Sender::Transport::Wrapper wraps a transport, provided as the
#pod C<transport> argument to the constructor. It is provided as a simple way to
#pod use method modifiers to create wrapping classes.
#pod
#pod =cut
has transport => (
is => 'ro',
does => 'Email::Sender::Transport',
required => 1,
);
sub send_email {
my $self = shift;
$self->transport->send_email(@_);
}
sub is_simple {
return $_[0]->transport->is_simple;
}
sub allow_partial_success {
return $_[0]->transport->allow_partial_success;
}
sub BUILDARGS {
my $self = shift;
my $href = $self->SUPER::BUILDARGS(@_);
if (my $class = delete $href->{transport_class}) {
Carp::confess("given both a transport and transport_class")
if $href->{transport};
my %arg;
for my $key (map {; /^transport_arg_(.+)$/ ? "$1" : () } keys %$href) {
$arg{$key} = delete $href->{"transport_arg_$key"};
}
$href->{transport} = Email::Sender::Util->easy_transport($class, \%arg);
}
return $href;
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Wrapper - a mailer to wrap a mailer for mailing mail
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
Email::Sender::Transport::Wrapper wraps a transport, provided as the
C<transport> argument to the constructor. It is provided as a simple way to
use method modifiers to create wrapping classes.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut