Perl Scriptto Emulate Wc Dll

Perl Scriptto Emulate Wc Dll (Updated: 2003.02.12 02:28:53 PM)

Edit -Find - New Topic - Recent Changes - Alphabetic Topic List - Random Topics - List Categories - Home
Making waves on the Web with Visual Foxpro

&OutputSee also Linux Apache Script

Below is a Perl script to emulate Wc.dll in file mode.

After the script are changes to the perlindigo (from www.indigostar.com) httpd.conf file for an NT/Apache/Perl_mod? setup

It works with Get and Post (including multipart) forms

The easiest way to check the functionality on an IIS machine is to temporarily rename the .wc scriptmap to .wco and create a new .wc scriptmap as described in the script.

I have not been able to check it out on a Linux machine yet.

Hopefully it will be useful the someone who would like to use Web Connect behind a Linux server with Samba.

****start script wcfile.pl
#!perl -w
## may need to change above line depending on path

# runs under apache 1.3/perl_mod
# need to add to httpd.conf

# Perl script to handle request from web server
# create West-Wind? Web connection request file
# wait for WC to create ".ret" file to signal response file is ready
# read response file and sent back to web server
# works with both perl in the NT resource kit and perl from
# www.activestate.com/ActivePerl/

# IIS setup to emulate wc.dll scritmaps using perl.exe (does not work with perlis.dll)
# No need to create multiple perl files since all requests ending in ".wcp" run the wcfile.pl script
# use quotes around the %s and filename to allow long filenames (s must be lowercase)
# Executable: D:\PERL\BIN\PERL.EXE "c:\myperl\wcfile.pl" "%s"
# Extension: .wcp (or whatever else you want)
# Method exclusions: PUT,DELETE
# Check that file exists: unchecked

# user defined variables - corresponds to variables in wc.ini
#--------------------------------------------------------
#$Path= 'c:/temp/wc/';
my $Path= 'c:/webtemp/gator/';

my $Timeout = 30 ; ## Time in seconds to allow request to finish

my $PollTime = 200 ; ## polling loop delay in milliseconds

my $Template = 'wc_' ;
#------------------------------------------------------

my $filetest ;
my $lcReq="" ;
my $uniqueid = 0 ;
my $WCReqFile= "" ;
my $WCRespFile= "";
my $WCAckFile= "";
my $lcReqMethod = "";
my ($hroffset, $dayoffset );
my $lnLoopCount ;
my $lnMaxLoops ;
my $temp ;
my $gmtoffset ;
my ($plsep1, $wcsep1, $plsep2, $wcsep2, $buffer) ;

# Get unique filename for $WCReqFile and $WCRespFile and $WCAckFile

# get unique filenames by making random number
# and checking $Path directory for existing files for any of the 3 filenames
$filetest = '1';
while ($filetest) {
srand;
$uniqueid = rand ;
$uniqueid = int($uniqueid * 100000);
$WCReqFile=($Path . $Template . $uniqueid . '.tmp' );
$WCRespFile=($Path . "wwc" . $uniqueid . '.out' );
$WCAckFile=($Path . $Template . $uniqueid . '.ret' );
if ( !(-e $WCReqFile) and !(-e $WCRespFile) and !(-e$ WCAckFile?) ) {
$filetest = '0';
}
}

# Write Web Connection formatted request file ($WCReqFile)

$lcReqMethod = $ENV{'REQUEST_METHOD'};
open (FILEIN, ">$WCReqFile" ) || die "Can't Open $WCReqFile: $!\n";
$|++; ## Disables output buffering
$lcReq = "+File=" . URLe($WCRespFile);
$lcReq = $lcReq . "&modperl=" . URLe($ENV{'MOD_PERL'}) ;
$lcReq = $lcReq . "&DLLVersion=" . URLe('Web Connection 3.35 (32 servers)');
$lcReq = $lcReq . "&wcConfig=" . URLe("C:/Inetpub/wwwroot/wconnect/wc315A.INI");
$lcReq = $lcReq . "&REQUEST_METHOD=" . URLe($lcReqMethod);
if ($ENV{'QUERY_STRING'}) {
$lcReq = $lcReq . "&QUERY_STRING=" . URLe($ENV{'QUERY_STRING'}) ;
}

if ($ENV{'MOD_PERL'}) {
$lcReq = $lcReq . "&Executable+Path=" . URLe($ENV{'REQUEST_URI'}) ;
} else {
$lcReq = $lcReq . "&Executable+Path=" . URLe($ENV{'SCRIPT_NAME'}) ;
}
if ($lcReqMethod eq 'POST') {
$lcReq = $lcReq . "&CONTENT_TYPE=" . URLe($ENV{'CONTENT_TYPE'}) ;
}
$lcReq = $lcReq . "&PATH_TRANSLATED=" . URLe($ENV{'PATH_TRANSLATED'}) ;
$lcReq = $lcReq . "&PHYSICAL_PATH=" . URLe($ENV{'PATH_TRANSLATED'}) ;
if ($ENV{'MOD_PERL'}) {
$lcReq = $lcReq . "&SCRIPT_NAME=" . URLe($ENV{'REQUEST_URI'}) ;
} else {
$lcReq = $lcReq . "&SCRIPT_NAME=" . URLe($ENV{'SCRIPT_NAME'}) ;
}
$lcReq = $lcReq . "&SERVER_PROTOCOL=" . URLe($ENV{'SERVER_PROTOCOL'}) ;
$lcReq = $lcReq . "&SERVER_SOFTWARE=" . URLe($ENV{'SERVER_SOFTWARE'}) ;
$lcReq = $lcReq . "&SERVER_NAME=" . URLe($ENV{'SERVER_NAME'}) ;
$lcReq = $lcReq . "&SERVER_PORT=" . URLe($ENV{'SERVER_PORT'}) ;
# $lcReq = $lcReq . "&REMOTE_HOST=" . URLe($ENV{"REMOTE_HOST"}) ;
$lcReq = $lcReq . "&REMOTE_HOST=" . URLe($ENV{"REMOTE_ADDR"}) ;
$lcReq = $lcReq . "&REMOTE_ADDR=" . URLe($ENV{'REMOTE_ADDR'}) ;
$lcReq = $lcReq . "&HTTP_REFERER=" . URLe($ENV{'HTTP_REFERER'}) ;
$lcReq = $lcReq . "&HTTP_USER_AGENT=" . URLe($ENV{'HTTP_USER_AGENT'}) ;

# get gmt offset
(my $sec, my $min, my $hour,my $mday,my $mon, my $year, my $wday, my $yday, my $isdst)=localtime();
(my $gmtsec,my $gmtmin, my $gmthour, my $gmtmday, my $gmtmon, my $gmtyear, $wday, my $gmtyday,my $gmtisdst)=gmtime();
$hroffset = $hour - $gmthour ;
$dayoffset = $yday - $gmtyday ;
if ($dayoffset > 360) { ## local day is Dec 31, GMT day is Jan 1
$dayoffset = -1 ;
}elsif($dayoffset < -360) { ## local day is Jan 1, GMT day is Dec 31
$dayoffset = 1 ;
}
$hroffset = $hroffset + ($dayoffset * 24);
$gmtoffset = $hroffset * 3600 ;
$lcReq = $lcReq . "&GMT_OFFSET=" . URLe($gmtoffset) ;

$lcReq = $lcReq . "&ALL_HTTP=HTTP_ACCEPT:=" . $ENV{'HTTP_ACCEPT'} . "\n";
$lcReq = $lcReq . "HTTP_ACCEPT_LANGUAGE:=" . $ENV{'HTTP_ACCEPT_LANGUAGE'} . "\n";
$lcReq = $lcReq . "HTTP_HOST:=" . $ENV{'HTTP_HOST'} . "\n";
$lcReq = $lcReq . "HTTP_REFERER:=" . $ENV{'HTTP_REFERER'} . "\n";
$lcReq = $lcReq . "HTTP_USER_AGENT:=" . $ENV{'HTTP_USER_AGENT'} . "\n";
if ($ENV{'HTTP_PRAGMA'}) {
$lcReq = $lcReq . "HTTP_PRAGMA:=" . $ENV{'HTTP_PRAGMA'} . "\n";
}
if ($ENV{"CONTENT_LENGTH"}) {
$lcReq = $lcReq . "HTTP_CONTENT_LENGTH:=" . $ENV{"CONTENT_LENGTH"} . "\n";
}
if ($ENV{"CONTENT_TYPE"}) {
$lcReq = $lcReq . "HTTP_CONTENT_TYPE:=" . $ENV{"CONTENT_TYPE"} . "\n";
}
print FILEIN $lcReq;

if ($lcReqMethod eq 'POST') {
# Get data form STDIN - already url encoded so just add to request string
# problem:
# wwrequest class reads multipart with
# RETURN Extract(@lcMultipart,lcKey + ["]+CHR(13)+CHR(10)+CHR(13)+CHR(10),;
# CHR(13)+CHR(10)+"---------")
# perl return lckey + ["]+chr(13)+chr(13)+chr(10)+chr(13)+chr(13)+chr(10) + value
# + chr(13)+chr(13)+chr(10) + "----------"
# need to convert

binmode STDIN;
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'} );

if ($ENV{'CONTENT_TYPE'} == "multipart/form-data") {
# convert to Wc format
# perl adds a chr(13), this works but
# maybe different substitution flags?
$plsep1 = chr(34) . chr(13) . chr(10) . chr(13) . chr(10) ;
$wcsep1 = chr(34) . chr(10) . chr(10) ;
$buffer =~ s/$plsep1/$wcsep1/gs; # substitute
$plsep2 = chr(13) . chr(10) . chr(13) . chr(10) . "-----";
$wcsep2 = chr(10) . chr(10) . "-----";
$buffer =~ s/$plsep2/$wcsep2/g; # substitute
}
print FILEIN "\n" . "#\@\$ FORM VARIABLES \$\@#" . "\n" . $buffer ;
}
close FILEIN;

# Wait for Web Connection App to create $WCAckFile, then return info in $WCRespFile

#Check if $WCAckFile exist
$lnLoopCount = 0;
$lnMaxLoops = 1000 * $Timeout / $PollTime ;
while (!(-e $WCAckFile)) {
if ($] > 5.001) {
select(undef, undef, undef, ($PollTime/1000));
}
else {
# the perl.exe (version 5.001) in the nt resource kit does not like the select function ,
# so must use sleep - min resolution of 1 second
# 0.5 is truncated to 0
sleep($PollTime/1000 + 1 );
}

$lnLoopCount=$lnLoopCount + 1 ;
if ($lnLoopCount >= $lnMaxLoops) {
die "Content-type: text/html\n\n Timed out waiting for response from wc " ;
}
}

binmode STDOUT;
binmode FILEOUT;
open (FILEOUT, "$WCRespFile" );
# read fileout with <> until eof and print to STDOUT
while ($temp = ) {
print $temp;
}
close FILEOUT;
close STDOUT;
# erase temp files
unlink($WCAckFile);
unlink($WCRespFile);

exit;

sub URLe{my $URLencode=shift;
$URLencode=~s/([^0-9A-Za-z_ ])/'%'.unpack('H2',$1)/ge;
$URLencode=~s/\s/+/g;
return $URLencode;
}

******end script wcfile.pl

*** httpd.conf changes to perlindigo setup

# wcfile - change to existing web directory
DocumentRoot? "d:/inetpub/wwwroot"

#
# wcfile - change to existing web directory

# in section
# wcfile - add scriptmap for webconnect
AddHandler? wcfile .wc .g
Action wcfile /perl-bin/wcfile.pl

# wcfile - change to turn off switch to have Perl send http headers
PerlSendHeader? Off

Edit -Find - New Topic - Recent Changes - Alphabetic Topic List - Random Topics - List Categories - Home
Making waves on the Web with Visual Foxpro
http://www.west-wind.com/ - 2010.09.09 12:10:50 AM EST

Search: