home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / LWP / Protocol / mailto.pm < prev    next >
Text File  |  1996-04-09  |  2KB  |  88 lines
  1. #
  2. # $Id: mailto.pm,v 1.7 1996/04/09 15:44:38 aas Exp $
  3. #
  4. # This module implements the mailto protocol.  It is just a simple
  5. # frontend to the Unix sendmail program.  In the long run this module
  6. # will built using the Mail::Send module.
  7.  
  8. package LWP::Protocol::mailto;
  9.  
  10. require LWP::Protocol;
  11. require HTTP::Request;
  12. require HTTP::Response;
  13. require HTTP::Status;
  14.  
  15. use Carp;
  16.  
  17. @ISA = qw(LWP::Protocol);
  18.  
  19. $SENDMAIL = "/usr/lib/sendmail";
  20.  
  21.  
  22. sub request
  23. {
  24.     my($self, $request, $proxy, $arg, $size) = @_;
  25.  
  26.     # check proxy
  27.     if (defined $proxy)
  28.     {
  29.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  30.                   'You can not proxy with mail';
  31.     }
  32.  
  33.     # check method
  34.     $method = $request->method;
  35.  
  36.     if ($method ne 'POST') {
  37.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  38.                   'Library does not allow method ' .
  39.                   "$method for 'mailto:' URLs";
  40.     }
  41.  
  42.     # check url
  43.     my $url = $request->url;
  44.  
  45.     my $scheme = $url->scheme;
  46.     if ($scheme ne 'mailto') {
  47.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  48.                   "LWP::file::request called for '$scheme'";
  49.     }
  50.     unless (-x $SENDMAIL) {
  51.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  52.                   "You don't have $SENDMAIL";
  53.     }
  54.  
  55.     open(SENDMAIL, "| $SENDMAIL -oi -t") or
  56.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  57.                   "Can't run $SENDMAIL: $!";
  58.  
  59.     my $addr = $url->encoded822addr;
  60.  
  61.     $request->header('To', $addr);
  62.     print SENDMAIL $request->headers_as_string;
  63.     print SENDMAIL "\n";
  64.     my $content = $request->content;
  65.     if (defined $content) {
  66.     my $contRef = ref($content) ? $content : \$content;
  67.     if (ref($contRef) eq 'SCALAR') {
  68.         print SENDMAIL $$contRef;
  69.     } elsif (ref($contRef) eq 'CODE') {
  70.         # Callback provides data
  71.         my $d;
  72.         while (length($d = &$contRef)) {
  73.         print SENDMAIL $d;
  74.         }
  75.     }
  76.     }
  77.     close(SENDMAIL);
  78.  
  79.     my $response = new HTTP::Response &HTTP::Status::RC_ACCEPTED,
  80.                      'Mail accepted by sendmail';
  81.     $response->header('Content-Type', 'text/plain');
  82.     $response->content("Mail sent to <$addr>\n");
  83.  
  84.     return $response;
  85. }
  86.  
  87. 1;
  88.