smtp_test.pl 2.5 KB

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