PERL Beginners - SMTP TRACE

Author

SMTP TRACE

Chesneydevine@Gmail.Com

2007-08-07, 10:01 pm

If i were to copy and paste some code, would any of you know how to
turn on smtp trace?

I've never taken any perl classes before and my attempt at learning
isn't going well. I have a project I have to do for work and am to
take any measures at figuring out how to get our trouble ticket system
working again!

Thanks!

Chesney

Jeff Pang

2007-08-07, 10:01 pm

-----Original Message-----
>From: "chesneydevine@gmail.com" <chesneydevine@gmail.com>
>Sent: Aug 8, 2007 5:06 AM
>To: beginners@perl.org
>Subject: SMTP TRACE
>
>If i were to copy and paste some code, would any of you know how to
>turn on smtp trace?

Sure you can.Just open the Debug mode when using Net::SMTP,
$smtp = Net::SMTP->new('mailhost',
Hello => 'my.mail.domain',
Timeout => 30,
Debug => 1,
);

But you need to know the SMTP talking session,which is referered to RFC821/2821.

>I've never taken any perl classes before and my attempt at learning
>isn't going well.

Just post your troubles here,the list can help you.

--
Jeff Pang <pangj@earthlink.net>
http://home.arcor.de/jeffpang/

Chesneydevine@Gmail.Com

2007-08-23, 7:00 pm

Here's my code
sorry its long!
its for trouble ticket express

package TTXMail;

use strict;
use TTXData;
use TTXMarkup;
my $hasb64 = 1;
$hasb64 = 0 unless eval "require MIME::Base64";

my $mailer;
my $smtphost;
my $usesmtp;

my $CRLF = "\015\012";
my $doemailfix = 0;

#
========================================
===============================
encode

sub encode {
return $_[0] if $_[0] !~ /[^a-zA-Z0-9 ()[\]_!\/\\{}"';:?<>@#\$%&*\n
\r.,-]/;
return "=?ISO-8859-1?B?".base64($_[0], "")."?=" if !$_[1];
my $adr = $_[0];
$adr =~ s/"[^"]*"//;
$adr =~ s/^[^<]*<//g;
$adr =~ s/>[^>]*$//g;
$adr =~ s/^\s+//;
$adr =~ s/\s+$//;
my $name = $_[0];
$name =~ s/<[^>]*>//g;
$name =~ s/"//g;
$name =~ s/[a-zA-Z0-9._-]+@[a-zA-Z0-9._-]+//g;
$name =~ s/^\s+//;
$name =~ s/\s+$//;
$name =~ s/\s\s+/ /;
$name = "=?ISO-8859-1?B?".base64($name, "")."?=" if $name ne undef;
$name =~ s/\r?\n\r?\s+/ /g;
my $str;
if ($name ne undef) {
$str = "\"$name\" ";
}
$str .= "<$adr>";
return $str;
}
#
========================================
=================================
smtp

sub smtp {
if ($usesmtp eq undef) {
if ($mailer ne undef && -x $mailer) {
$usesmtp = 0;
} else {
$usesmtp = 1;
unless (eval "require Net::SMTP") { $usesmtp = 0; }
}
}
return $usesmtp;
}
#
========================================
=============================
sendmail

sub sendmail {
my $cfg = TTXData::get('CONFIG');
$doemailfix = $cfg->get('emailfix');
if ($cfg->get('broadcast') ne undef) {
$_[0]->{bcc} = $cfg->get('broadcast');
}
$mailer = $cfg->get('mailer');
$smtphost = $cfg->get('smtp');
my $msg = $_[0]->{msg};
$msg = TTXMarkup::strip($msg);
my $contenttype = "MIME-Version: 1.0\nContent-Type: text/plain;
charset=\"ISO-8859-1\"\nContent-Transfer-Encoding: quoted-printable";
if (!smtp()) {
return 0 if !open(MAIL, "|$mailer -t");
my $bcc = "Bcc: ".$_[0]->{bcc}."\n" if $_[0]->{bcc} ne undef;
print MAIL "To: ".$_[0]->{to}."\nFrom: ".encode($_[0]->{from},
1)."\n".$bcc.
"Subject: ".encode($_[0]->{subject}, 0).
"\n$contenttype\n\n".
quoteit($msg)."\n\n";
close MAIL;
} else {
my $to = $_[0]->{to};
$to =~ s/"[^"]*"//;
$to =~ s/^[^<]*<//g;
$to =~ s/>[^>]*$//g;
$to =~ s/^\s+//;
$to =~ s/\s+$//;
my $from = $_[0]->{from};
$from =~ s/"[^"]*"//;
$from =~ s/^[^<]*<//g;
$from =~ s/>[^>]*$//g;
$from =~ s/^\s+//;
$from =~ s/\s+$//;
if ($cfg->get('smtptrace')) {
# save original STDERR destination
open SAVERR, ">&STDERR";
# redirect STDERR handle to a file
open STDERR, '>>'.$cfg->get('basedir').'/smtptrace.txt';
my $oldfh = select STDERR; $| = 1; select($oldfh); # make
unbuffered
}
my $s = Net::SMTP->new($smtphost, Debug => $cfg-
>get('smtptrace') ? 1:0);
if ($s ne undef) {
if ($cfg->get('smtplogin') ne undef && $s->can('auth')) {
eval "\$s->auth(\$cfg->get('smtplogin'), \$cfg-
>get('smtppwd'));";
if ($@ ne undef) {
if ($cfg->get('smtptrace')) {
warn $@;
warn 'Trying Net::POP3';
}
eval "use Net::POP3;";
if ($@ ne undef) {
if ($cfg->get('smtptrace')) {
warn $@;
}
} else {
my $pop = Net::POP3->new($smtphost);
if (!$pop) { warn "Can't open connection to pop3 server:
$!"; }
elsif (!defined ($pop->login($cfg->get('smtplogin'), $cfg-
>get('smtppwd')))) {
warn "Can't authenticate: $!";
} else {
my $messages = $pop->list();
$pop->quit();
}
}
}
}
$s->mail($from);
if ($_[0]->{bcc} ne undef) {
$s->to($to, $_[0]->{bcc});
} else {
$s->to($to);
}
$s->data();
$s->datasend("To: ".$_[0]->{to}."\n");
$s->datasend("From: ".encode($_[0]->{from}, 1)."\n");
$s->datasend("Subject: ".encode($_[0]->{subject}, 0).
"\n$contenttype\n\n");
$s->datasend(quoteit($msg));
$s->datasend("\n\n");
$s->dataend();
$s->quit();
if ($cfg->get('smtptrace')) {
# restore original STDERR destination
open STDERR, ">&SAVERR";
}
}
}
return 1;
}
#
========================================
==============================
quoteit

sub quoteit {
my $in = shift;
my $out;
local $_;
$in =~ s/\015?\012/\n/g;
while (1) {
$in =~ s/^(.*?(?:(?:\n)|\Z))//m;
$_ = $1;
(defined and length) or last;
s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;
s/([ \t]+)$/join('', map { sprintf("=%02X", ord($_)) } split('',
$1))/egm;
my $brokenlines = "";
$brokenlines .= "$1=\n"
while s/(.*?^[^\n]{73} (?:
[^=\n]{2} (?! [^=\n]{0,1} $)
|[^=\n] (?! [^=\n]{0,2} $)
| (?! [^=\n]{0,3} $)
))//xsm;
$_ = "$brokenlines$_";
if (length($_) < 74) {
s/^\.$/=2E/g;
s/^From /=46rom /g;
}
s/\015?\012/$CRLF/g;
$out .= $_;
(defined($in) and length($in)) or last;
}
$out =~ s/\015//g if $doemailfix;
return $out;
}
#
========================================
===============================
base64

sub base64 {
my $in = $_[0];
my $out;
my $eol = $_[1];
$eol = "\n" unless defined $eol;
while (1) {
my ($buf, $b64);
last unless length $in;
$buf = substr($in, 0, 45);
substr($in, 0, 45) = '';
if ($hasb64) {
$b64 = MIME::Base64::encode_base64($buf, $eol);
} else {
$b64 = _b64($buf, $eol);
}
$b64 =~ s/\015?\012/$CRLF/g;
$b64 .= $CRLF if length $eol && $b64 !~ /$CRLF\Z/;
$out .= $b64;
}
return $out;
}
#
========================================
=================================
_b64
sub _b64 {
my $out = "";
my $eol = $_[1];
$eol = "\n" unless defined $eol;
pos($_[0]) = 0;
while ($_[0] =~ /(.{1,45})/gs) {
$out .= substr(pack('u', $1), 1);
chop($out);
}
$out =~ tr|` -_|AA-Za-z0-9+/|;
my $padding = (3 - length($_[0]) % 3) % 3;
$out =~ s/.{$padding}$/'=' x $padding/e if $padding;
if (length $eol) {
$out =~ s/(.{1,76})/$1$eol/g;
}
return $out;
}

1;

Jenda Krynicky

2007-08-27, 7:23 pm

From: "chesneydevine@gmail.com" <chesneydevine@gmail.com>
> Here's my code
> sorry its long!
> its for trouble ticket express
>
> package TTXMail;

Forget this an use a higher level module than Net::SMTP!
MIME::Lite should make your life much easier, and will still give you
the option to use an external mailer or SMTP as requested by the
config.

> use strict;
> use TTXData;
> use TTXMarkup;
> my $hasb64 = 1;
> $hasb64 = 0 unless eval "require MIME::Base64";

MIME::Base64 is included with Perl since 5.007003 and CAN be
installed on any perl all the way back to versions that are so dated
that noone should even think about using them. Why do you think you
need to do this?

> my $mailer;
> my $smtphost;
> my $usesmtp;
>
> my $CRLF = "\015\012";
> my $doemailfix = 0;
>
> #
> ========================================
===============================
> encode
>
> sub encode {
> return $_[0] if $_[0] !~ /[^a-zA-Z0-9 ()[\]_!\/\\{}"';:?<>@#\$%&*\n
> \r.,-]/;
> return "=?ISO-8859-1?B?".base64($_[0], "")."?=" if !$_[1];
> my $adr = $_[0];
> $adr =~ s/"[^"]*"//;
> $adr =~ s/^[^<]*<//g;
> $adr =~ s/>[^>]*$//g;
> $adr =~ s/^\s+//;
> $adr =~ s/\s+$//;

Let me show you a trick:

for ($adr) {
s/"[^"]*"//;
s/^[^<]*<//g;
s/>[^>]*$//g;
s/^\s+//;
s/\s+$//;
}

And if you need to do the same transformations to several variables,
just put them all into the for(list).

Jenda
===== Jenda@Krynicky.cz === http://Jenda.Krynicky.cz =====
When it comes to wine, women and song, wizards are allowed
to get drunk and croon as much as they like.
-- Terry Pratchett in Sourcery

Chas Owens

2007-08-28, 4:39 am

On 8/27/07, Jenda Krynicky <Jenda@krynicky.cz> wrote:
> From: "chesneydevine@gmail.com" <chesneydevine@gmail.com>
>
> Forget this an use a higher level module than Net::SMTP!
> MIME::Lite should make your life much easier, and will still give you
> the option to use an external mailer or SMTP as requested by the
> config.
>
>
> MIME::Base64 is included with Perl since 5.007003 and CAN be
> installed on any perl all the way back to versions that are so dated
> that noone should even think about using them. Why do you think you
> need to do this?
>
>
> Let me show you a trick:
>
> for ($adr) {
> s/"[^"]*"//;
> s/^[^<]*<//g;
> s/>[^>]*$//g;
> s/^\s+//;
> s/\s+$//;
> }
>
> And if you need to do the same transformations to several variables,
> just put them all into the for(list).
snip

The poster did not write this code. You should probably direct any
advice/questions to the author here
http://ttx.helpdeskconnect.com/?cmd=addticket

Sponsored Links