PERL Beginners - just got around to posting this.. (long) SMTP TRACE

Author

just got around to posting this.. (long) SMTP TRACE

Chesneydevine@Gmail.Com

2007-08-23, 7:00 pm

Ok..I posted a few w

s ago (ive been so busy at work its not funny)

Im using Trouble Tickets express and they want to charge me for
troubleshooting

but i need to know how to turn on SMTP Trace so I can figure out what
my problem is.

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;

Thanks!

Randal L. Schwartz

2007-08-23, 7:00 pm

>>>>> ""chesneydevine@gmail" == "chesneydevine@gmail com" <chesneydevine@gmail.com> writes:

"chesneydevine@gmail> Im using Trouble Tickets express and they want to charge me for
"chesneydevine@gmail> troubleshooting

.... so instead, I'll post it here, and try to get free consulting advice from
experts, instead of what the purpose of the list is for, which is helping
beginners learn how to code Perl.

Sir, have you no shame?

Go ahead and ask beginner questions here about CODE YOU HAVE WRITTEN.
Don't be posting the code of others.

{Sigh}

--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!

Chesneydevine@Gmail.Com

2007-08-23, 10:01 pm

#1. I am not a SIR I am a Miss

#2 I was told I could post this...im my other post I had said I didn't
have any
experience with Perl, I didn't have any classes in college and my boss
gave me a side project to do. I'm trying to avoid paying 60 dollars an
hour for troubleshooting.

On Aug 23, 11:40 am, mer...@stonehenge.com (Randal L. Schwartz) wrote:
>
> "chesneydevine@gmail> Im using Trouble Tickets express and they want to charge me for
> "chesneydevine@gmail> troubleshooting
>
> ... so instead, I'll post it here, and try to get free consulting advice from
> experts, instead of what the purpose of the list is for, which is helping
> beginners learn how to code Perl.
>
> Sir, have you no shame?
>
> Go ahead and ask beginner questions here about CODE YOU HAVE WRITTEN.
> Don't be posting the code of others.
>
> {Sigh}
>
> --
> Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
> <mer...@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
> Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
> See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!

Uri Guttman

2007-08-23, 10:01 pm

>>>>> "CC" == Chesneydevine@Gmail Com <(Chesneydevine@Gmail.Com)> writes:

CC> #1. I am not a SIR I am a Miss
CC> #2 I was told I could post this...im my other post I had said I didn't
CC> have any
CC> experience with Perl, I didn't have any classes in college and my boss
CC> gave me a side project to do. I'm trying to avoid paying 60 dollars an
CC> hour for troubleshooting.

then you can pay $100 instead!

it is a commercial program you bought so you need commercial
support. this newsgroup is for discussing perl and code you have written
yourself. no one is paid here and we can't save you the cost of your
needed support. if you don't know perl why did your boss give you this
problem and no budget to fix it? and if you bought it and it doesn't
worked then why won't the developers fix the bug?

inquiring minds want to know!

uri

--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org

Chas Owens

2007-08-24, 4:01 am

On 8/23/07, chesneydevine@gmail.com <chesneydevine@gmail.com> wrote:
snip
> my $cfg = TTXData::get('CONFIG');
snip
> if ($cfg->get('smtptrace')) {
snip
> open STDERR, '>>'.$cfg->get('basedir').'/smtptrace.txt';
snip[color=darkred]
> my $s = Net::SMTP->new($smtphost, Debug => $cfg-
snip

It looks like there is a config file somewhere that you can edit to
turn on debugging. That config file also contains an entry for
basedir which is where the debugging information will be written.
Given this information from their website:

How do I change the administration password for the setup.cgi script?

The password is kept in the configuration file - ttxcfg.cgi. You will need
editing the file using plain text editor like Notepad (Windows) or
vi (Unix).
Look for the line, which reads

admpwd=password

Please be advised that the file exists on your web server only.

I am willing to bet that ttxcfg.cgi is the config file. You might
also try looking in TTXData.pm for the get function to see if the name
of the config file is hard coded there.

All of that said, this is not a Perl question. This is a question
about an application that happens to be written in Perl. If there is
no community for this tool then perhaps you would be better off with a
different tool such as RT (http://bestpractical.com/rt/) which not
only has a large community (rt-users@lists.bestpractical.com), but
also a book from O'Reilly
(http://www.oreilly.com/catalog/rtessentials/index.html).

Mr. Shawn H. Corey

2007-08-24, 7:01 pm

chesneydevine@gmail.com wrote:
> #1. I am not a SIR I am a Miss
>
> #2 I was told I could post this...im my other post I had said I didn't
> have any
> experience with Perl, I didn't have any classes in college and my boss
> gave me a side project to do. I'm trying to avoid paying 60 dollars an
> hour for troubleshooting.

It is recommended that you that advance questions to another forum. I suggest the Perl Monks at [url]http://www.perlmonks.org/?node=S

ers%20of%20Perl%20Wisdom[/url]

--
Just my 0.00000002 million dollars worth,
Shawn

"For the things we have to learn before we can do them, we learn by doing them."
Aristotle

"If you Terrans are comprehensible, you don't understand them."
Great Fang Talphon

Sponsored Links