2009-10-02 13:01:53 +00:00
|
|
|
#! /usr/bin/perl
|
|
|
|
|
# Copyright (C) 2009 Alex Schroeder <alex@gnu.org>
|
|
|
|
|
|
|
|
|
|
# This program is free software: you can redistribute it and/or modify it under
|
|
|
|
|
# the terms of the GNU General Public License as published by the Free Software
|
|
|
|
|
# Foundation, either version 3 of the License, or (at your option) any later
|
|
|
|
|
# version.
|
|
|
|
|
#
|
|
|
|
|
# This program is distributed in the hope that it will be useful, but WITHOUT
|
|
|
|
|
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
|
|
|
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
|
|
|
|
#
|
|
|
|
|
# You should have received a copy of the GNU General Public License along with
|
|
|
|
|
# this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
|
|
package OddMuse;
|
|
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
|
use Getopt::Std;
|
|
|
|
|
use File::Temp;
|
|
|
|
|
use MIME::Entity;
|
|
|
|
|
|
|
|
|
|
# This script can be invoked as follows:
|
|
|
|
|
# perl smtp_test.pl -m "alex:*secret*@mail.epfarms.org" \
|
|
|
|
|
# -f "kensanata@gmail.com"
|
|
|
|
|
|
|
|
|
|
# -m user:password@mailhost for sending email using SMTP Auth. Without this
|
|
|
|
|
# information, the script will send mail to localhost.
|
|
|
|
|
# -f email address to use as the sender and recipient.
|
|
|
|
|
|
|
|
|
|
my %opts;
|
|
|
|
|
getopt('mf', \%opts);
|
2009-10-02 15:36:38 +00:00
|
|
|
die "Must provide an SMTP host using -m\n" unless $opts{m};
|
2009-10-02 13:01:53 +00:00
|
|
|
$opts{m} =~ /(.*?):(.*)\@(.*)/;
|
|
|
|
|
my ($user, $password, $host) = ($1, $2, $3);
|
2009-10-02 15:36:38 +00:00
|
|
|
die "Cannot parse -m " . $opts{m} . "\n" unless $host;
|
2009-10-02 13:01:53 +00:00
|
|
|
my $from = $opts{f};
|
|
|
|
|
die "Must provide sender using -f\n" if $host && !$from;
|
|
|
|
|
|
|
|
|
|
my ($fh, $filename) = File::Temp->new(SUFFIX => '.html', UNLINK => 1);
|
|
|
|
|
print $fh qq(<body>This is a <b>test</b>!);
|
|
|
|
|
$fh->close;
|
|
|
|
|
|
2009-10-02 15:46:11 +00:00
|
|
|
eval {
|
|
|
|
|
require Net::SMTP::TLS;
|
|
|
|
|
my $mail = new MIME::Entity->build(To => $from, # test!
|
|
|
|
|
From => $from,
|
|
|
|
|
Subject => 'Test Net::SMTP::TLS',
|
|
|
|
|
Path => $fh,
|
|
|
|
|
Type => "text/html");
|
|
|
|
|
my $smtp = Net::SMTP::TLS->new($host,
|
|
|
|
|
User => $user,
|
|
|
|
|
Password => $password,
|
|
|
|
|
Debug => 1);
|
|
|
|
|
$smtp->mail($from);
|
|
|
|
|
$smtp->to($from); # test!
|
|
|
|
|
$smtp->data;
|
|
|
|
|
$smtp->datasend($mail->stringify);
|
|
|
|
|
$smtp->dataend;
|
|
|
|
|
$smtp->quit;
|
|
|
|
|
};
|
2009-10-02 15:36:38 +00:00
|
|
|
|
2009-10-02 15:48:43 +00:00
|
|
|
warn "Net::SMTP::TLS problem: $@" if $@;
|
|
|
|
|
|
|
|
|
|
eval {
|
2009-10-02 15:46:11 +00:00
|
|
|
require Net::SMTP::SSL;
|
|
|
|
|
my $mail = new MIME::Entity->build(To => $from, # test!
|
|
|
|
|
From => $from,
|
|
|
|
|
Subject => 'Test Net::SMTP::SSL',
|
|
|
|
|
Path => $fh,
|
|
|
|
|
Type => "text/html");
|
|
|
|
|
my $smtp = Net::SMTP::SSL->new($host, Port => 465,
|
|
|
|
|
Debug => 1);
|
|
|
|
|
$smtp->auth($user, $password);
|
|
|
|
|
$smtp->mail($from);
|
|
|
|
|
$smtp->to($from); # test!
|
|
|
|
|
$smtp->data;
|
|
|
|
|
$smtp->datasend($mail->stringify);
|
|
|
|
|
$smtp->dataend;
|
|
|
|
|
$smtp->quit;
|
2009-10-02 15:48:43 +00:00
|
|
|
};
|
|
|
|
|
|
|
|
|
|
warn "Net::SMTP::SSL problem: $@" if $@;
|
