diff options
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm | 184 |
1 files changed, 0 insertions, 184 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm deleted file mode 100644 index 29f934bb26..0000000000 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm +++ /dev/null @@ -1,184 +0,0 @@ -package LWP::Protocol::mailto; - -# This module implements the mailto protocol. It is just a simple -# frontend to the Unix sendmail program except on MacOS, where it uses -# Mail::Internet. - -require HTTP::Request; -require HTTP::Response; -require HTTP::Status; - -use Carp; -use strict; - -our $VERSION = '6.61'; - -use parent qw(LWP::Protocol); -our $SENDMAIL; - -unless ($SENDMAIL = $ENV{SENDMAIL}) { - for my $sm (qw(/usr/sbin/sendmail - /usr/lib/sendmail - /usr/ucblib/sendmail - )) - { - if (-x $sm) { - $SENDMAIL = $sm; - last; - } - } - die "Can't find the 'sendmail' program" unless $SENDMAIL; -} - -sub request -{ - my($self, $request, $proxy, $arg, $size) = @_; - - my ($mail, $addr) if $^O eq "MacOS"; - my @text = () if $^O eq "MacOS"; - - # check proxy - if (defined $proxy) - { - return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST, - 'You can not proxy with mail'); - } - - # check method - my $method = $request->method; - - if ($method ne 'POST') { - return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST, - 'Library does not allow method ' . - "$method for 'mailto:' URLs"); - } - - # check url - my $url = $request->uri; - - my $scheme = $url->scheme; - if ($scheme ne 'mailto') { - return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR, - "LWP::Protocol::mailto::request called for '$scheme'"); - } - if ($^O eq "MacOS") { - eval { - require Mail::Internet; - }; - if($@) { - return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR, - "You don't have MailTools installed"); - } - unless ($ENV{SMTPHOSTS}) { - return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR, - "You don't have SMTPHOSTS defined"); - } - } - else { - unless (-x $SENDMAIL) { - return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR, - "You don't have $SENDMAIL"); - } - } - if ($^O eq "MacOS") { - $mail = Mail::Internet->new or - return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR, - "Can't get a Mail::Internet object"); - } - else { - open(SENDMAIL, "| $SENDMAIL -oi -t") or - return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR, - "Can't run $SENDMAIL: $!"); - } - if ($^O eq "MacOS") { - $addr = $url->encoded822addr; - } - else { - $request = $request->clone; # we modify a copy - my @h = $url->headers; # URL headers override those in the request - while (@h) { - my $k = shift @h; - my $v = shift @h; - next unless defined $v; - if (lc($k) eq "body") { - $request->content($v); - } - else { - $request->push_header($k => $v); - } - } - } - if ($^O eq "MacOS") { - $mail->add(To => $addr); - $mail->add(split(/[:\n]/,$request->headers_as_string)); - } - else { - print SENDMAIL $request->headers_as_string; - print SENDMAIL "\n"; - } - my $content = $request->content; - if (defined $content) { - my $contRef = ref($content) ? $content : \$content; - if (ref($contRef) eq 'SCALAR') { - if ($^O eq "MacOS") { - @text = split("\n",$$contRef); - foreach (@text) { - $_ .= "\n"; - } - } - else { - print SENDMAIL $$contRef; - } - - } - elsif (ref($contRef) eq 'CODE') { - # Callback provides data - my $d; - if ($^O eq "MacOS") { - my $stuff = ""; - while (length($d = &$contRef)) { - $stuff .= $d; - } - @text = split("\n",$stuff); - foreach (@text) { - $_ .= "\n"; - } - } - else { - print SENDMAIL $d; - } - } - } - if ($^O eq "MacOS") { - $mail->body(\@text); - unless ($mail->smtpsend) { - return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR, - "Mail::Internet->smtpsend unable to send message to <$addr>"); - } - } - else { - unless (close(SENDMAIL)) { - my $err = $! ? "$!" : "Exit status $?"; - return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR, - "$SENDMAIL: $err"); - } - } - - - my $response = HTTP::Response->new(HTTP::Status::RC_ACCEPTED, - "Mail accepted"); - $response->header('Content-Type', 'text/plain'); - if ($^O eq "MacOS") { - $response->header('Server' => "Mail::Internet $Mail::Internet::VERSION"); - $response->content("Message sent to <$addr>\n"); - } - else { - $response->header('Server' => $SENDMAIL); - my $to = $request->header("To"); - $response->content("Message sent to <$to>\n"); - } - - return $response; -} - -1; |