|
|
cool hack
|
|
|
|
 |
WebStore on NT Setup help
|
 |
|
|
|
|
sent
in the following hack...
I don't know if these qualify as cool hacks or not, but they seem helpful to me.
I'm in the process of getting started with Web Store. I'm running on an NT machine
(which, the more I learn about perl, the more I regret: its a UNIX world.) I'm also
running on my isp's machine, so there is only limited control over how things work.
(For example, I can't run blat)
I had some snags with 1) the setup and then 2) with using smtp mail. Here's what I did.
First Problem
Since my ISP is apparently using some kind of virtual directories, web store was having
problems installing. Lots of files were not being found. Lines like
&require_supporting_libraries (__VIRTUAL__, __LINE__,
"./Library/web_store.setup.db");
were not working.
To help with installation, I added a line to the web_store.cgi script right at the top.
$mypath = "D:/Inetpub/www/www.hfhmn.org/cgi-bin/web_store";
which is simply my pathname.
I then went through webstore and the setup file and replaced the relative pathnames with
$mypath. E.g.:
&require_supporting_libraries (__VIRTUAL__, __LINE__,
"./Library/web_store.setup.db");
becomes
&require_supporting_libraries (__VIRTUAL__, __LINE__,
"$mypath/Library/web_store.setup.db");
Now all the files are being found, and if I ever switch servers or directory structures
I only have to change the one line in the web_store.cgi script, and everything else should
be found.
Second problem
I couldn't get the smtp mail routines to work. (I put a post up on the BBS about this,
and then solved my own problem, so I posted that too.) The problem was that the escape
characters were not being removed from the e-mail addresses. It would try to mail me at
brill\@hfhmn.org, instead of brill@hfhmn.org.
Putting in a line like
$sc_order_email=~ s/\\//g;
will strip the escape character out of the variable so that it can e-mail properly.
I took a somewhat longer solution. If anything about this message of mine constitutes a
cool hack, then I guess this is it.
I cobbled together some code from a smtp routine that I knew would work. Its shorter than
the one that you are distributing with web store, and easier to follow, I think. Since many
people are having trouble with smtp mailing (as judged by the large number of posts on the
BBS) they may have better luck with this, since it returns an error code that tells you what
the problem is. All credit goes to Christian Mallwitz, who wrote the guts of the program,
with the minor exception of the lines I added to strip the escape characters.
Oh yeah, one other thing, which has probably been mentioned before.
In web_store_order_lib.pl, the line that actually calls the send_mail routine sends it
the e-mail "from" address twice, so that when you get an order from web_store it looks
like you sent it to yourself. Changing the first argument from $sc_order_email to
$form_data{"14-e-mail"} will fix it, making the from address be that of the person who
is putting in the order.
if ($sc_send_order_to_email =~ /yes/i) {
&send_mail($form_data{"14-e-mail"},$sc_order_email,
"Web Store Order", $text_of_cart);
Code for smtp mail on an NT system:
#------------------------------------------------------------
# Dan Brill's smtp Mailer for Web Store
#
# Driven by:
# sub sendmail() by Christian Mallwitz
# Version : 1.21
# Environment: Hip Perl Build 105 NT 3.51 Server SP4
# Environment: Hip Perl Build 110 NT 4.00
#
# Leave references and creduts to Christian Mallwitz in this script.
#
# return codes:
#
# 1 success
# -1 $smtphost unknown
# -2 socket() failed
# -3 connect() failed
# -4 service not available
# -5 unspecified communication error
# -6 local user $to unknown on host $smtp
# -7 transmission of message failed
# -8 argument $to empty
#
# (sub changes $_)
#
#------------------------------------------------------------
# set up name of smtp
$smtp = "mail.yourmailserver.com";
# access mail socket
use Socket;
sub send_mail {
$from = $form_data{"14-e-mail"};
$to = $sc_order_email;
$subject = "Web Store Order";
$message = $text_of_cart;
# Sends arguments to Christian Mallwitz's sendmail subroutine
&sendmail($from, $to, $smtp, $subject, $message);
if ($errorcode==1) {
print "<h2>Thank you.</h2><br><br>";
}else{
print "<h2><FONT COLOR='red'>ERROR! Your information could not be
processed: Errorcode = $errorcode </font></h2><br>";
}
}
sub sendmail {
my ($from, $to, $smtp, $subject, $message) = @_;
my ($fromaddr) = $from;
# Code added to strip \ from e-mail addresses, which Web Store seems to neglect
$fromaddr =~ s/\\//g;
$to =~ s/\\//g;
$message =~ s/^\./\.\./gm; # handle . as first character
$message =~ s/\r\n/\n/g; # handle line ending
$message =~ s/\n/\r\n/g;
$smtp =~ s/^\s+//g; # remove any spaces around $smtp
$smtp =~ s/\s+$//g;
if (!$to) { return $errorcode = -8; }
my($proto) = (getprotobyname('tcp'))[2];
my($port) = (getservbyname('smtp', 'tcp'))[2];
my($smtpaddr) = ($smtp =~
/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
? pack('C4',$1,$2,$3,$4)
: (gethostbyname($smtp))[4];
if (!defined($smtpaddr)) { return $errorcode = -1; }
if (!socket(S, AF_INET, SOCK_STREAM, $proto)) { return $errorcode = -2; }
if (!connect(S, pack('Sna4x8', AF_INET, $port, $smtpaddr))) { return $errorcode = -3; }
my($oldfh) = select(S); $| = 1; select($oldfh);
$_ = <S>; if (/^[45]/) { close S; return $errorcode = -4; }
print S "helo localhost\r\n";
$_ = <S>; if (/^[45]/) { close S; return $errorcode = -5; }
print S "mail from: <$fromaddr>\r\n";
$_ = <S>; if (/^[45]/) { close S; return $errorcode = -5; }
foreach (split(/, /, $to)) {
print S "rcpt to: <$_>\r\n";
$_ = <S>; if (/^[45]/) { close S; return $errorcode = -6; }
}
print S "data\r\n";
$_ = <S>; if (/^[45]/) { close S; return $errorcode = -5; }
print S "To: $to\r\n";
print S "From: $fromaddr\r\n";
print S "X-Mailer: Perl Sendmail Version 1.21 Christian Mallwitz Germany\r\n";
print S "Subject: $subject\r\n\r\n";
print S "________________________________________________________________\n";
print S "From: $from\r\n\r\n";
print S "Affiliate: $affiliate\r\n\r\n";
print S "Message: \n\n $message";
print S "\r\n.\r\n";
$_ = <S>; if (/^[45]/) { close S; return $errorcode = -7; }
print S "quit\r\n";
$_ = <S>;
close S;
return $errorcode=1;
}
|
|