smtp_test.pl

   1 #! /usr/bin/perl
   2 # Copyright (C) 2009  Alex Schroeder <alex@gnu.org>
   3
   4 # This program is free software: you can redistribute it and/or modify it under
   5 # the terms of the GNU General Public License as published by the Free Software
   6 # Foundation, either version 3 of the License, or (at your option) any later
   7 # version.
   8 #
   9 # This program is distributed in the hope that it will be useful, but WITHOUT
  10 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  11 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along with
  14 # this program. If not, see <http://www.gnu.org/licenses/>.
  15
  16 package OddMuse;
  17
  18 use strict;
  19 use Getopt::Std;
  20 use File::Temp;
  21 use MIME::Entity;
  22
  23 # This script can be invoked as follows:
  24 # perl smtp_test.pl -m "alex:*secret*@mail.epfarms.org" \
  25 #                   -f "kensanata@gmail.com"
  26
  27 # -m user:password@mailhost for sending email using SMTP Auth. Without this
  28 #    information, the script will send mail to localhost.
  29 # -f email address to use as the sender and recipient.
  30
  31 my %opts;
  32 getopt('mf', \%opts);
  33 die "Must provide an SMTP host using -m\n" unless $opts{m};
  34 $opts{m} =~ /(.*?):(.*)\@(.*)/;
  35 my ($user, $password, $host) = ($1, $2, $3);
  36 die "Cannot parse -m " . $opts{m} . "\n" unless $host;
  37 my $from = $opts{f};
  38 die "Must provide sender using -f\n" if $host && !$from;
  39
  40 my ($fh, $filename) = File::Temp->new(SUFFIX => '.html', UNLINK => 1);
  41 print $fh qq(<body>This is a <b>test</b>!);
  42 $fh->close;
  43
  44 eval {
  45   require Net::SMTP::TLS;
  46   my $mail = new MIME::Entity->build(To => $from, # test!
  47                                      From => $from,
  48                                      Subject => 'Test Net::SMTP::TLS',
  49                                      Path => $fh,
  50                                      Type => "text/html");
  51   my $smtp = Net::SMTP::TLS->new($host,
  52                                  User => $user,
  53                                  Password => $password,
  54                                  Debug => 1);
  55   $smtp->mail($from);
  56   $smtp->to($from); # test!
  57   $smtp->data;
  58   $smtp->datasend($mail->stringify);
  59   $smtp->dataend;
  60   $smtp->quit;
  61 };
  62
  63 warn "Net::SMTP::TLS problem: $@" if $@;
  64
  65 eval {
  66   require Net::SMTP::SSL;
  67   my $mail = new MIME::Entity->build(To => $from, # test!
  68                                      From => $from,
  69                                      Subject => 'Test Net::SMTP::SSL',
  70                                      Path => $fh,
  71                                      Type => "text/html");
  72   my $smtp = Net::SMTP::SSL->new($host, Port => 465,
  73                                  Debug => 1);
  74   $smtp->auth($user, $password);
  75   $smtp->mail($from);
  76   $smtp->to($from); # test!
  77   $smtp->data;
  78   $smtp->datasend($mail->stringify);
  79   $smtp->dataend;
  80   $smtp->quit;
  81 };
  82
  83 warn "Net::SMTP::SSL problem: $@" if $@;