summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm
diff options
context:
space:
mode:
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.pm184
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;