eXtropia: the open web technology company
Technology | Support | Tutorials | Development | About Us | Users | Contact Us
Development resources
 ::   WebWare 2.1 (Perl)
 ::   WebWare 2.0 (Java)
 ::   Cool hacks
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__, 

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__, 


&require_supporting_libraries (__VIRTUAL__, __LINE__, 

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) { 
               "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>"; 

  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 =~ 
? 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;