[interchange-cvs] interchange - heins modified lib/Vend/Dispatch.pm
interchange-core@icdevgroup.org
interchange-core@icdevgroup.org
Mon Sep 16 22:01:01 2002
User: heins
Date: 2002-09-17 02:00:02 GMT
Added: lib/Vend Dispatch.pm
Log:
* Forgot to add this file. 8-}
Revision Changes Path
1.1 interchange/lib/Vend/Dispatch.pm
rev 1.1, prev_rev 1.0
Index: Dispatch.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
# Vend::Dispatch - Handle Interchange page requests
#
# $Id: Dispatch.pm,v 1.1 2002/09/17 02:00:02 mheins Exp $
#
# Copyright (C) 2002 ICDEVGROUP <interchange@icdevgroup.org>
# Copyright (C) 2002 Mike Heins <mike@perusion.net>
#
# This program was originally based on Vend 0.2 and 0.3
# Copyright 1995 by Andrew M. Wilcox <amw@wilcoxsolutions.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA.
package Vend::Dispatch;
use vars qw($VERSION);
$VERSION =3D substr(q$Revision: 1.1 $, 10);
use POSIX qw(strftime);
use Vend::Util;
use Vend::Interpolate;
use Vend::Data;
use Vend::Config;
use autouse 'Vend::Error' =3D> qw/get_locale_message interaction_error do_l=
ockout full_dump/;
use Vend::Order;
use Vend::Session;
use Vend::Page;
use Vend::UserDB;
use Vend::CounterFile;
# TRACK
use Vend::Track;
# END TRACK
require Exporter;
@ISA =3D qw(Exporter);
@EXPORT =3D qw(=20
config_named_catalog
dispatch
do_process
http
response
run_macro
tie_static_dbm
update_user
update_values
);
my $H;
sub http {
return $H;
}
sub response {
my ($output) =3D @_;
my $out =3D ref $output ? $output : \$output;
if (defined $Vend::CheckHTML) {
require Vend::External;
Vend::External::check_html($out);
}
$H->respond($out);
}
# Parse the mv_click and mv_check special variables
sub parse_click {
my ($ref, $click, $extra) =3D @_;
my($codere) =3D '[-\w_#/.]+';
my $params;
#::logDebug("Looking for click $click");
if($params =3D $::Scratch->{$click}) {
# Do nothing, we found the click
#::logDebug("Found scratch click $click =3D |$params|");
}
elsif(defined ($params =3D $Vend::Cfg->{OrderProfileName}{$click}) ) {
# Do nothing, we found the click
$params =3D $Vend::Cfg->{OrderProfile}[$params];
#::logDebug("Found profile click $click =3D |$params|");
}
elsif(defined ($params =3D $Global::ProfilesName->{$click}) ) {
# Do nothing, we found the click
$params =3D $Global::Profiles->[$params];
#::logDebug("Found profile click $click =3D |$params|");
}
elsif($params =3D $::Scratch->{"mv_click $click"}) {
$::Scratch->{mv_click_arg} =3D $click;
}
elsif($params =3D $::Scratch->{mv_click}) {
$::Scratch->{mv_click_arg} =3D $click;
}
else {
#::logDebug("Found NO click $click");
return 1;
} # No click processor
my($var,$val,$parameter);
$params =3D interpolate_html($params);
my(@param) =3D split /\n+/, $params;
for(@param) {
next unless /\S/;
next if /^\s*#/;
s/^[\r\s]+//;
s/[\r\s]+$//;
$parameter =3D $_;
($var,$val) =3D split /[\s=3D]+/, $parameter, 2;
$val =3D~ s/&#(\d+);/chr($1)/ge;
$ref->{$var} =3D $val;
$extra->{$var} =3D $val
if defined $extra;
}
}
# This is the set of CGI-passed variables to ignore, in other words
# never set in the user session. If set in the mv_check pass, though,
# they will stick.
%Global::Ignore =3D qw(
mv_todo 1
mv_todo.submit.x 1
mv_todo.submit.y 1
mv_todo.return.x 1
mv_todo.return.y 1
mv_todo.checkout.x 1
mv_todo.checkout.y 1
mv_todo.todo.x 1
mv_todo.todo.y 1
mv_todo.map 1
mv_doit 1
mv_check 1
mv_click 1
mv_nextpage 1
mv_failpage 1
mv_successpage 1
mv_more_ip 1
mv_credit_card_number 1
mv_credit_card_cvv2 1
);
## FILE PERMISSIONS
sub set_file_permissions {
my($r, $w, $p, $u);
$r =3D $Vend::Cfg->{'ReadPermission'};
if ($r eq 'user') { $p =3D 0400; $u =3D 0277; }
elsif ($r eq 'group') { $p =3D 0440; $u =3D 0227; }
elsif ($r eq 'world') { $p =3D 0444; $u =3D 0222; }
else { die "Invalid value for ReadPermission\n"; }
$w =3D $Vend::Cfg->{'WritePermission'};
if ($w eq 'user') { $p +=3D 0200; $u &=3D 0577; }
elsif ($w eq 'group') { $p +=3D 0220; $u &=3D 0557; }
elsif ($w eq 'world') { $p +=3D 0222; $u &=3D 0555; }
else { die "Invalid value for WritePermission\n"; }
$Vend::Cfg->{'FileCreationMask'} =3D $p;
$Vend::Cfg->{'Umask'} =3D $u;
}
sub update_values {
my (@keys) =3D @_;
my $set;
if(@keys) {
$set =3D {};
@{$set}{@keys} =3D @CGI::values{@keys};
}
else {
$set =3D \%CGI::values;
if( $Vend::Cfg->{CreditCardAuto} and $CGI::values{mv_credit_card_number} =
) {
(
@{$::Values}{
qw/
mv_credit_card_valid
mv_credit_card_info
mv_credit_card_exp_month
mv_credit_card_exp_year
mv_credit_card_exp_all
mv_credit_card_type
mv_credit_card_reference
mv_credit_card_error
/ }
) =3D encrypt_standard_cc(\%CGI::values);
}=09
}
my $restrict;
if($restrict =3D $Vend::Session->{restrict_html} and ! ref $restrict) {
$restrict =3D [ map { lc $_ } split /\s+/, $restrict ];
$Vend::Session->{restrict_html} =3D $restrict;
}
while (my ($key, $value) =3D each %$set) {
# values explicly ignored in configuration
next if defined $Global::Ignore{$key};
next if defined $Vend::Cfg->{FormIgnore}{$key};
#LEGACY
# We add any checkbox ordered items, but don't update --=20
# we don't want to order them twice
next if ($key =3D~ m/^quantity\d+$/);
#END LEGACY
# Admins should know what they are doing
if($Vend::admin) {
$::Values->{$key} =3D $value;
next;
}
elsif ($restrict and $value =3D~ /</) {
# Allow designer to allow only certain HTML tags from trusted users
# Will go away when current session ends...
# [ script start character handled in [value ...] ITL tag
$value =3D Vend::Interpolate::filter_value(
'restrict_html',
$value,
undef,
@$restrict,
);
$::Values->{$key} =3D $value;
next;
}
$value =3D~ tr/<[//d;
$value =3D~ s/<//ig;
$value =3D~ s/[//g;
$::Values->{$key} =3D $value;
}
}
sub update_user {
my($key,$value);
# Update the user-entered fields.
add_items() if defined $CGI::values{mv_order_item};
update_values();
if($CGI::values{mv_check}) {
my(@checks) =3D split /\s*[,\0]+\s*/, delete $CGI::values{mv_check};
my($check);
foreach $check (@checks) {
parse_click $::Values, $check, \%CGI::values;=09
}
}
check_save if defined $CGI::values{mv_save_session};
}
## DO PROCESS
sub do_click {
my($click, @clicks);
do {
if($CGI::values{mv_click}) {
@clicks =3D split /\s*[\0]+\s*/, delete $CGI::values{mv_click};
}
if(defined $CGI::values{mv_click_map}) {
my(@map) =3D split /\s*[\0]+\s*/, delete $CGI::values{mv_click_map};
foreach $click (@map) {
push (@clicks, $click)
if defined $CGI::values{"mv_click.$click.x"}
or defined $CGI::values{"$click.x"}
or $click =3D $CGI::values{"mv_click_$click"};
}
}
foreach $click (@clicks) {
parse_click \%CGI::values, $click;
}
} while $CGI::values{mv_click};
return 1;
}
sub do_deliver {
my $file =3D $CGI::values{mv_data_file};
my $mode =3D $CGI::values{mv_acl_mode} || '';
if($::Scratch->{mv_deliver} !~ m{(^|\s)$file(\s|$)}
and=20
! Vend::UserDB::userdb(
'check_file_acl',
location =3D> $file,
mode =3D> $mode,
)
)
{
$Vend::StatusLine =3D "Status: 403\nContent-Type: text/html";
my $msg =3D get_locale_message(403, <<EOF);
<B>Authorization Required<B>
<P>
This server could not verify that you are authorized to access the document
requested.=20
EOF
response($msg);
return 0;
}
if (! -f $file) {
$Vend::StatusLine =3D "Status: 404\nContent-Type: text/html";
my $msg =3D get_locale_message(404, <<EOF, $file);
<B>Not Found<B>
<P>
The requested file %s was not found on this server.
EOF
response($msg);
return 0;
}
$Vend::StatusLine =3D "Content-Type: " .
($CGI::values{mv_content_type} || 'application/octet-stream');
::response( Vend::Util::readfile (
$CGI::values{mv_data_file},
$Global::NoAbsolute,
)
);
return 0;
}
my %form_action =3D (
search =3D> \&do_search,
deliver =3D> \&do_deliver,
submit =3D>
sub {
update_user();
update_quantity()
or return interaction_error("quantities");
my $ok;
my($missing,$next,$status,$final,$result_hash);
# Set shopping cart if necessary
# Vend::Items is tied, remember!
$Vend::Items =3D $CGI::values{mv_cartname}
if $CGI::values{mv_cartname};
#::logDebug("Default order route=3D$::Values->{mv_order_route}");
## Determine the master order route, if routes
## are not set in CGI values (4.7.x default)
if(
$Vend::Cfg->{Route}
and ! defined $::Values->{mv_order_route}
)
{
my $curr =3D $Vend::Cfg->{Route};
my $repos =3D $Vend::Cfg->{Route_repository};
if($curr->{master}) {
# Default route is master
for(keys %$repos) {
next unless $curr eq $repos->{$_};
$::Values->{mv_order_route} =3D $_;
last;
}
}
else {
for(keys %$repos) {
next unless $repos->{$_}->{master};
$::Values->{mv_order_route} =3D $_;
last;
}
}
}
#::logDebug("Default order route=3D$::Values->{mv_order_route}");
CHECK_ORDER: {
# If the user sets this later, will be used
delete $Vend::Session->{mv_order_number};
if (defined $CGI::values{mv_order_profile}) {
($status,$final,$missing) =3D
check_order($CGI::values{mv_order_profile});
}
else {
$status =3D $final =3D 1;
}
#::logDebug("Profile status status=3D$status final=3D$final errors=3D$missi=
ng");
my $provisional;
if ($status and defined $::Values->{mv_order_route}) {
# This checks only route order profiles
#::logDebug("Routing order, pre-check");
($status, $provisional, $missing)
=3D route_order(
$::Values->{mv_order_route},
$Vend::Items,
'check',
);
}=20
$final =3D $provisional if ! $final;
#::logDebug("Routing status status=3D$status final=3D$final errors=3D$missi=
ng");
if($status) {
$CGI::values{mv_nextpage} =3D $CGI::values{mv_successpage}=20
if $CGI::values{mv_successpage};
$CGI::values{mv_nextpage} =3D $::Values->{mv_orderpage}=20
if ! $CGI::values{mv_nextpage};
}
else {
$CGI::values{mv_nextpage} =3D $CGI::values{mv_failpage}
if $CGI::values{mv_failpage};
$CGI::values{mv_nextpage} =3D find_special_page('needfield')
if ! $CGI::values{mv_nextpage};
undef $final;
}
return 1 unless $final;
my $order_no;
if (defined $::Values->{mv_order_route}) {
# $ok will not be defined unless Route "supplant" was set
# $order_no will come back so we don't issue two of them
#::logDebug("Routing order $::Values->{mv_order_route}");
($ok, $order_no, $result_hash) =3D route_order(
$::Values->{mv_order_route},
$Vend::Items
);
return 1 unless $ok;
}
$result_hash =3D {} unless $result_hash;
# TRACK
$Vend::Track->finish_order ();
# END TRACK
# This function (followed down) now does the rudimentary
# backend ordering with AsciiTrack and the order report.
# If the "supplant" option was set in order routing it will
# not be used ($ok would have been defined)
#::logDebug("Order number=3D$order_no\n");
$ok =3D mail_order(undef, $order_no || undef) unless defined $ok;
#::logDebug("Order number=3D$order_no, result_hash=3D" . ::uneval($result_h=
ash));
# Display a receipt if configured
my $not_displayed =3D 1;
if(! $ok) {
display_special_page(
find_special_page('failed'),
errmsg('Error transmitting order(%s): %s', $!, $@),
);
}
elsif (! $result_hash->{no_receipt} ) {
eval {
my $receipt =3D $result_hash->{receipt}
|| $::Values->{mv_order_receipt}
|| find_special_page('receipt');
#::logDebug("selected receipt=3D$receipt");
display_special_page($receipt);
};
$not_displayed =3D 0;
#::logDebug("not_displayed=3D$not_displayed");
if($@) {
my $msg =3D $@;
logError(=20
'Display of receipt on order number %s failed: %s',
$::Values->{mv_order_number},
$msg,
);
}
}
# Remove the items
@$Vend::Items =3D ();
#::logDebug("returning order_number=3D$order_no, not_displayed=3D$not_displ=
ayed");
return $not_displayed;
}
},
refresh =3D> sub {
update_quantity()
or return interaction_error("quantities");
# LEGACY
$CGI::values{mv_nextpage} =3D $CGI::values{mv_orderpage}
if $CGI::values{mv_orderpage};
# END LEGACY
$CGI::values{mv_nextpage} =3D $CGI::values{mv_orderpage}
|| find_special_page('order')
if ! $CGI::values{mv_nextpage};
update_user();
return 1;
},
set =3D> sub {
update_user() unless $CGI::values{mv_data_auto_number};
update_data();
update_user() if $CGI::values{mv_data_auto_number};
return 1;
},
autoset =3D> sub {
update_data();
update_user();
return 1;
},
back =3D> sub { return 1 },
return =3D> sub {
update_user();
update_quantity()
or return interaction_error("quantities");
return 1;
},
cancel =3D> sub {
put_session();
get_session();
init_session();
$CGI::values{mv_nextpage} =3D find_special_page('canceled')
if ! $CGI::values{mv_nextpage};
return 1;
},
);
$form_action{go} =3D $form_action{return};
# Process the completed order or search page.
sub do_process {
if($CGI::values{mv_form_profile}) {
#::logDebug("checking form profile $CGI::values{mv_form_profile} =3D $::Scr=
atch->{$CGI::values{mv_form_profile}}");
my ($status) =3D check_order($CGI::values{mv_form_profile}, \%CGI::values=
);
#::logDebug("checked form profile=3D" . (defined $status ? $status : 'undef=
') );
return 1 if defined $status and ! $status;
}
#::logDebug("todo=3D$CGI::values{mv_todo} prior to mv_click=3D" . join ",",=
split /\0/, $CGI::values{mv_click});
my $orig_todo =3D $CGI::values{mv_todo};
do_click();
my $todo =3D $CGI::values{mv_todo};
#::logDebug("todo=3D$todo after mv_click");
# Maybe we have an imagemap input, if not, use $doit
if($orig_todo ne $todo) {
# Don't mess with it, changed in click
}
elsif (defined $CGI::values{'mv_todo.x'}) {
my $x =3D $CGI::values{'mv_todo.x'};
my $y =3D $CGI::values{'mv_todo.y'};
my $map =3D $CGI::values{'mv_todo.map'};
# Called with action_map and not package id
# since "autouse" is possibly in force...found
# by Jeff Carnahan
$todo =3D action_map($x,$y,$map);
}
elsif( my @todo =3D grep /^mv_todo\.\w+(?:\.x)?$/, keys %CGI::values ) {
# Only one todo!
for(@todo) {
delete $CGI::values{$_};
s/^mv_todo\.(\w+)(?:\.[xy])?$/$1/;
}
$todo =3D shift @todo;
}
$todo =3D $CGI::values{mv_doit} || 'back' if ! $todo;
#::logDebug("todo=3D$todo after mv_click");
my ($sub, $status);
#Now determine the action on the todo
if (defined $Vend::Cfg->{FormAction}{$todo}) {
$sub =3D $Vend::Cfg->{FormAction}{$todo};
}
elsif (not $sub =3D $form_action{$todo} ) {
interaction_error("No action passed for processing\n");
return;
}
eval {
$status =3D $sub->($todo);
};
if($@) {
undef $status;
my $err =3D $@;
my $template =3D <<EOF;
Sorry, there was an error in processing this form action. Please=20
report the error or try again later.
EOF
$template .=3D "\n\nError: %s\n"
if $Global::DisplayErrors && $Vend::Cfg->{DisplayErrors}
;
$template =3D get_locale_message(500, $template, $err);
$template .=3D "($err)";
logError($err);
response($template);
}
return $status;
}
sub run_in_catalog {
my ($cat, $job, $itl) =3D @_;
my ($g,$c);
#::logGlobal("running job in cat=3D$cat");
$g =3D $Global::Catalog{$cat};
unless (defined $g) {
logGlobal( "Can't find catalog '%s'" , $cat );
return undef;
}
#$Vend::Log_suppress =3D 1;
unless ($Vend::Quiet) {
logGlobal("Run catalog '%s' cron group=3D%s", $cat, $job || 'INTERNAL');
}
#undef $Vend::Log_suppress;
open_cat($cat);
logError("Run cron group=3D%s", $job || 'INTERNAL');
my $croncfg =3D $Vend::Cfg->{Cron};
my $dir;
my @itl;
if($job) {
my $ct =3D $croncfg->{base_directory} || 'etc/cron';
my $gt =3D '';
$gt =3D "$Global::ConfDir/$ct" if $croncfg->{use_global};
for my $d ($ct, $gt) {
#::logGlobal("check directory=3D$d for $job");
next unless $d;
next unless -d "$d/$job";
$dir =3D "$d/$job";
last;
}
if($dir) {
my @f =3D glob("$dir/*");
@f =3D grep ! -d $_, @f;
@f =3D grep $_ !~ /$Vend::Cfg->{HTMLsuffix}$/, @f;
for(@f) {
#::logGlobal("found cron piece file=3D$_");
push @itl, [$_, readfile($_)];
}
}
}
if ($itl) {
push @itl, ["Passed ITL", $itl];
}
my @out;
if(@itl) {
# Run once at beginning
run_macro($croncfg->{initialize});
# initialize or autoload can create session
# but must handle all aspects
init_session() unless $Vend::Session;
$CGI::remote_addr ||=3D 'none';
$CGI::useragent ||=3D 'commandline';
for(@itl) {
# Run once at beginning of each job
run_macro($croncfg->{autoload});
push @out, interpolate_html($_->[1]);
}
}
else {
logGlobal("Empty cron job=3D%s", $job);
}
my $out =3D join "", @out;
$out =3D~ s/^\s+//;
$out =3D~ s/\s+$/\n/;
$out .=3D full_dump() if $croncfg->{add_session};
=09
close_cat();
# don't send email and/or write log entry if cron job returns
# no output (in spirit of the real cron)
return unless $out;
=09
if(my $addr =3D $Vend::CronEmail || $croncfg->{email}) {
my $subject =3D $croncfg->{subject} || 'Interchange cron results for job:=
%s';
$subject =3D errmsg($subject, $job);
my $from =3D $croncfg->{from} || $Vend::Cfg->{MailOrderTo};
Vend::Interpolate::tag_mail($addr,
{
from =3D> $from,
to =3D> $addr,
subject =3D> $subject,
reply_to =3D> $croncfg->{reply_to},
mailer =3D> "Interchange $::VERSION",
extra =3D> $croncfg->{extra_headers},
log_error =3D> 1,
},
$out,
);
}
if($croncfg->{log}) {
logData($croncfg->{log}, $out);
}
return $out;
}
sub adjust_cgi {
my($host);
die "REQUEST_METHOD is not defined" unless defined $CGI::request_method
or @Global::argv;
# The great and really final AOL fix
#
$host =3D $CGI::remote_host;
$CGI::ip =3D $CGI::remote_addr;
if($Global::DomainTail and $host) {
$host =3D~ s/.*?([-A-Za-z0-9]+\.[A-Za-z]+)$/$1/;
}
elsif($Global::IpHead) {
$host =3D $Global::IpQuad =3D=3D 0 ? 'nobody' : '';
my @ip;
@ip =3D split /\./, $CGI::ip;
$CGI::ip =3D '';
$CGI::ip =3D join ".", @ip[0 .. ($Global::IpQuad - 1)] if $Global::IpQuad;
}
#
# end AOL fix
# Fix Cobalt/CGIwrap problem
if($Global::Variable->{CGIWRAP_WORKAROUND}) {
$CGI::path_info =3D~ s!^$CGI::script_name!!;
}
$CGI::host =3D $host || $CGI::ip;
$CGI::user =3D $CGI::remote_user if $CGI::remote_user;
undef $CGI::authorization if $CGI::remote_user;
unless ($Global::FullUrl) {
$CGI::script_name =3D $CGI::script_path;
}
else {
if($CGI::server_port eq '80') { $CGI::server_port =3D ''; }
else { $CGI::server_port =3D ":$CGI::server_port"; }
$CGI::script_name =3D $CGI::server_name .
$CGI::server_port .
$CGI::script_path;
}
}
sub url_history {
$Vend::Session->{History} =3D []
unless defined $Vend::Session->{History};
shift @{$Vend::Session->{History}}
if $#{$Vend::Session->{History}} >=3D $Vend::Cfg->{History};
if(
($CGI::pragma =3D~ /\bno-cache\b/ and ! $CGI::values{mv_force_cache})
or $CGI::values{mv_no_cache}
)
{
push (@{$Vend::Session->{History}}, [ 'expired', {} ]);
}
else {
my $save_number =3D delete $CGI::values{mv_credit_card_number};
my $save_cvv2 =3D delete $CGI::values{mv_credit_card_cvv2};
push (@{$Vend::Session->{History}}, [ $CGI::path_info, \%CGI::values ]);
$CGI::values{mv_credit_card_number} =3D $save_number if length($save_numb=
er);
$CGI::values{mv_credit_card_cvv2} =3D $save_cvv2 if length($save_cvv2=
);
}
return;
}
## DISPATCH
# Parse the invoking URL and dispatch to the handling subroutine.
my %action =3D (
process =3D> \&do_process,
ui =3D> sub {=20
&UI::Primitive::ui_acl_global();
&do_process(@_);
},
scan =3D> \&do_scan,
search =3D> \&do_search,
order =3D> \&do_order,
obtain =3D> \&do_order,
silent =3D> sub {
$Vend::StatusLine =3D "Status: 204 No content";
my $extra_click =3D $Vend::FinalPath;
$extra_click =3D~ s:/:\0:g;
$CGI::values{mv_click} =3D $CGI::values{mv_click}
? "$CGI::values{mv_click}\0$extra_click"
: $extra_click;
do_process(@_);
response('');
return 0;
},
);
sub update_global_actions {
@action{keys %{$Global::ActionMap}} =3D (values %{$Global::ActionMap})
if $Global::ActionMap;
@form_action{keys %{$Global::FormAction}} =3D (values %{$Global::FormActio=
n})
if $Global::FormAction;
}
sub open_cat {
my $cat =3D shift;
if($cat) {
%CGI::values =3D ();
if($Global::Catalog{$cat}) {
$CGI::script_path =3D $Global::Catalog{$cat}->{script};
$CGI::script_name =3D $CGI::script_path;
}
}
unless (defined $Global::Selector{$CGI::script_name}) {
my $msg =3D get_locale_message(
404,
"Undefined catalog: %s",
$CGI::script_name || $cat,
);
$Vend::StatusLine =3D <<EOF;
Status: 404 Not Found
Content-Type: text/plain
EOF
if($H) {
response($msg);
}
logGlobal($msg);
# No close_cat() necessary
return;
}
if($Global::Foreground) {
my %hash;
tie %hash, 'Tie::ShadowHash', $Global::Selector{$CGI::script_name} ;
$Vend::Cfg =3D \%hash;
}
else {
$Vend::Cfg =3D $Global::Selector{$CGI::script_name};
}
$Vend::Cat =3D $Vend::Cfg->{CatalogName};
my $catref =3D $Global::Catalog{$Vend::Cat};
if(! $Global::Foreground and defined $catref->{directive}) {
no strict 'refs';
my ($key, $val);
while ( ($key, $val) =3D each %{$catref->{directive}}) {
#::logDebug("directive key=3D$key val=3D" . ::uneval($val));
${"Global::$key"} =3D $val;
}
}
# See if it is a subcatalog
if (defined $Vend::Cfg->{BaseCatalog}) {
my $name =3D $Vend::Cfg->{BaseCatalog};
my $ref =3D $Global::Catalog{$name};
my $c =3D $Vend::Cfg;
$Vend::Cfg =3D $Global::Selector{$ref->{'script'}};
for(keys %{$c->{Replace}}) {
undef $Vend::Cfg->{$_};
}
copyref $c, $Vend::Cfg;
if($Vend::Cfg->{Variable}{MV_LANG}) {
my $loc =3D $Vend::Cfg->{Variable}{MV_LANG};
$Vend::Cfg->{Locale} =3D $Vend::Cfg->{Locale_repository}{$loc}
if defined $Vend::Cfg->{Locale_repository}{$loc};
}
$Vend::Cfg->{StaticPage} =3D {}
unless $Vend::Cfg->{Static};
}
$::Variable =3D $Vend::Cfg->{Variable};
$::Pragma =3D { %{ $Vend::Cfg->{Pragma} } };
if (defined $Global::SelectorAlias{$CGI::script_name}
and ! defined $Vend::InternalHTTP )
{
my $real =3D $Global::SelectorAlias{$CGI::script_name};
unless ( $CGI::secure or
$Vend::Cfg->{SecureURL} =3D~ m{$CGI::script_name$} and
$Vend::Cfg->{VendURL} !~ m{/nph-[^/]+$} and
$Vend::Cfg->{VendURL} !~ m{$CGI::script_name$} )
{
$Vend::Cfg->{VendURL} =3D~ s!$real!$CGI::script_name!;
$Vend::Cfg->{SecureURL} =3D~ s!$real!$CGI::script_name!;
}
}
elsif ($Vend::InternalHTTP) {
$Vend::Cfg->{VendURL} =3D "http://" .
$CGI::http_host .
$CGI::script_path;
$Vend::Cfg->{ImageDir} =3D $Vend::Cfg->{ImageDirInternal}
if $Vend::Cfg->{ImageDirInternal};
}
if($Global::HitCount and ! $cat) {
my $ctr =3D new Vend::CounterFile
"$Global::ConfDir/hits.$Vend::Cat";
$ctr->inc();
}
if ($Vend::Cfg->{SetGroup}) {
eval {
$) =3D "$Vend::Cfg->{SetGroup} $Vend::Cfg->{SetGroup}";
};
if ($@) {
my $msg =3D $@;
logGlobal( "Can't set group to GID %s: %s",
$Vend::Cfg->{SetGroup}, $msg
);
logError("Can't set group to GID %s: %s",
$Vend::Cfg->{SetGroup}, $msg
);
}
}
chdir $Vend::Cfg->{VendRoot}=20
or die "Couldn't change to $Vend::Cfg->{VendRoot}: $!\n";
set_file_permissions();
# STATICPAGE
tie_static_dbm() if $Vend::Cfg->{StaticDBM};
# END STATICPAGE
umask $Vend::Cfg->{Umask};
#show_times("end cgi and config mapping") if $Global::ShowTimes;
open_database();
#show_times("end open_database") if $Global::ShowTimes;
}
sub close_cat {
put_session() if $Vend::HaveSession;
close_session() if $Vend::SessionOpen;
close_database();
}
sub run_macro {
my $macro =3D shift
or return;
my $content_ref =3D shift;
my @mac;
if(ref $macro eq 'ARRAY') {
@mac =3D @$macro;
}
elsif ($macro =3D~ /^[-\s\w,]+$/) {
@mac =3D grep /\S/, split /[\s,]+/, $macro;
}
else {
push @mac, $macro;
}
for my $m (@mac) {
if ($m =3D~ /^\w+$/) {
my $sub =3D $Vend::Cfg->{Sub}{$m} || $Global::GlobalSub->{$m}
or do {
logError("Unknown Autoload macro '%s'.", $macro);
next;
};
$sub->($content_ref);
}
elsif($m =3D~ /^\w+-\w+$/) {
Vend::Interpolate::tag_profile($m);
}
else {
interpolate_html($m);
}
}
}
sub dispatch {
my($http) =3D @_;
$H =3D $http;
adjust_cgi();
open_cat();
$CGI::user =3D Vend::Util::check_authorization($CGI::authorization)
if defined $CGI::authorization;
my($sessionid, $seed);
$sessionid =3D $CGI::values{mv_session_id} || undef;
$sessionid =3D~ s/\0.*//s;
$::Instance->{CookieName} =3D $Vend::Cfg->{CookieName};
if($CGI::values{mv_tmp_session}) {
#::logDebug("setting tmp_session");
$Vend::tmp_session =3D $Vend::new_session =3D 1;
$sessionid =3D 'nsession';
$Vend::Cookie =3D 1;
$Vend::Cfg->{ScratchDefault}{mv_no_count} =3D 1;
$Vend::Cfg->{ScratchDefault}{mv_no_session_id} =3D 1;
}
elsif ($::Instance->{CookieName} and defined $CGI::cookie) {
$CGI::cookie =3D~ m{$::Instance->{CookieName}=3D($Vend::Cfg->{CookiePatte=
rn})};
$seed =3D $sessionid =3D $1;
$::Instance->{ExternalCookie} =3D $sessionid || 1;
$Vend::CookieID =3D $Vend::Cookie =3D 1;
}
elsif (defined $CGI::cookie and
$CGI::cookie =3D~ /\bMV_SESSION_ID=3D(\w{8,32})
[:_] (
( \d{1,3}\. # An IP ADDRESS
\d{1,3}\.
\d{1,3}\.
\d{1,3})
# A user name or domain
| ([A-Za-z0-9][-\@A-Za-z.0-9]+) )?
\b/x)
{
$sessionid =3D $1
unless defined $CGI::values{mv_pc} and $CGI::values{mv_pc} eq 'RESET';
$CGI::cookiehost =3D $3;
$CGI::cookieuser =3D $4;
$Vend::CookieID =3D $Vend::Cookie =3D 1;
}
$::Instance->{CookieName} =3D 'MV_SESSION_ID' if ! $::Instance->{CookieNam=
e};
$CGI::host =3D 'nobody' if $Vend::Cfg->{WideOpen};
if(! $sessionid) {
my $id =3D $::Variable->{MV_SESSION_ID};
$sessionid =3D $CGI::values{$id} if $CGI::values{$id};
if (! $sessionid and $Vend::Cfg->{FallbackIP}) {
$sessionid =3D generate_key($CGI::remote_addr . $CGI::useragent);
}
}
elsif (! $::Instance->{ExternalCookie} and $sessionid !~ /^\w+$/) {
my $msg =3D get_locale_message(
403,
"Unauthorized for that session %s. Logged.",
$sessionid,
);
$Vend::StatusLine =3D <<EOF;
Status: 403 Unauthorized
Content-Type: text/plain
EOF
response($msg);
logGlobal($msg);
close_cat();
return;
}
# DEBUG
#::logDebug ("session=3D'$sessionid' cookie=3D'$CGI::cookie' chost=3D'$CGI:=
:cookiehost'");
# END DEBUG
RESOLVEID: {
if ($sessionid) {
$Vend::SessionID =3D $sessionid;
$Vend::SessionName =3D session_name();
if($Vend::tmp_session) {
$Vend::Session =3D {};
init_session;
last RESOLVEID;
}
# get_session will return a value if a session is read,
# if not it will return false and a new session has been created.
# The IP address will be counted for robot_resolution
if(! get_session($seed) and ! $::Instance->{ExternalCookie}) {
retire_id($sessionid);
last RESOLVEID;
}
my $now =3D time;
if(! $Vend::CookieID) {
if( is_retired($sessionid) ) {
new_session();
last RESOLVEID;
}
my $compare_host =3D $CGI::secure
? ($Vend::Session->{shost})
: ($Vend::Session->{ohost});
if($Vend::Cfg->{WideOpen}) {
# do nothing, no host checking
}
elsif(! $compare_host) {
new_session($seed) unless $CGI::secure;
init_session();
$Vend::Session->{shost} =3D $CGI::remote_addr;
}
elsif ($compare_host ne $CGI::remote_addr) {
new_session($seed);
init_session();
}
}
if ($now - $Vend::Session->{'time'} > $Vend::Cfg->{SessionExpire}) {
if($::Instance->{ExternalCookie}) {
init_session();
}
else {
retire_id($sessionid);
new_session();
}
last RESOLVEID;
}
elsif($Vend::Cfg->{RobotLimit}) {
if ($now - $Vend::Session->{'time'} > 30) {
$Vend::Session->{accesses} =3D 0;
}
else {
$Vend::Session->{accesses}++;
#::logDebug("accesses=3D$Vend::Session->{accesses} admin=3D$Vend::admin");
if($Vend::Session->{accesses} > $Vend::Cfg->{RobotLimit}
and ! $Vend::admin
)
{
my $msg =3D errmsg(
"WARNING: POSSIBLE BAD ROBOT. %s accesses with no 30 second pause.",
$Vend::Session->{accesses},
);
do_lockout($msg);
}
}
}
}
else {
if($Vend::Cfg->{RobotLimit}) {
if (Vend::Session::count_ip() > $Vend::Cfg->{RobotLimit}) {
my $msg;
# Here they can get it back if they pass expiration time
my $wait =3D $Global::Variable->{MV_ROBOT_EXPIRE} || 86400;
$wait /=3D 3600;
$msg =3D errmsg(<<EOF, $wait);=20
Too many new ID assignments for this IP address. Please wait at least %d ho=
urs
before trying again. Only waiting that period will allow access. Terminatin=
g.
EOF
$msg =3D Vend::Page::get_locale_message(403, $msg);
do_lockout($msg);
$Vend::StatusLine =3D <<EOF;
Status: 403 Forbidden
Content-Type: text/plain
EOF
response($msg);
close_cat();
return;
}
}
new_session();
}
}
#::logDebug("session name=3D'$Vend::SessionName'\n");
$Vend::Calc_initialized =3D 0;
$CGI::values{mv_session_id} =3D $Vend::Session->{id} =3D $Vend::SessionID;
if($Vend::Cfg->{CookieLogin}) {
COOKIELOGIN: {
last COOKIELOGIN if $Vend::Session->{logged_in};
last COOKIELOGIN if defined $CGI::values{mv_username};
last COOKIELOGIN unless
$CGI::values{mv_username} =3D Vend::Util::read_cookie('MV_USERNAME');
my $password;
last COOKIELOGIN unless
$password =3D Vend::Util::read_cookie('MV_PASSWORD');
$CGI::values{mv_password} =3D $password;
my $profile =3D Vend::Util::read_cookie('MV_USERPROFILE');
local(%SIG);
undef $SIG{__DIE__};
eval {
Vend::UserDB::userdb('login', profile =3D> $profile );
};
if($@) {
$Vend::Session->{failure} .=3D $@;
}
}
}
$Vend::Session->{'arg'} =3D $Vend::Argument =3D ($CGI::values{mv_arg} || u=
ndef);
if ($CGI::values{mv_pc} =3D~ /\D/) {
$Vend::Session->{source} =3D $CGI::values{mv_pc} eq 'RESET'
? ''
: $CGI::values{mv_pc};
}
elsif($CGI::values{mv_source}) {
$Vend::Session->{source} =3D $CGI::values{mv_source};
}
$Vend::Session->{'user'} =3D $CGI::user;
undef $Vend::Cookie if=20
$Vend::Session->{logged_in} && ! $Vend::Cfg->{StaticLogged};
$CGI::pragma =3D 'no-cache'
if delete $::Scratch->{mv_no_cache};
#show_times("end session get") if $Global::ShowTimes;
$Vend::FinalPath =3D $Vend::Session->{last_url} =3D $CGI::path_info;
if( defined $Vend::Session->{path_alias}{$Vend::FinalPath} ) {
$CGI::path_info
=3D $Vend::FinalPath
=3D $Vend::Session->{path_alias}{$Vend::FinalPath};
delete $Vend::Session->{path_alias}{$Vend::FinalPath}
if delete $Vend::Session->{one_time_path_alias}{$Vend::FinalPath};
}
url_history($Vend::FinalPath) if $Vend::Cfg->{History};
# TRACK
$Vend::Track =3D new Vend::Track;
# END TRACK
if($Vend::Cfg->{DisplayErrors} and $Global::DisplayErrors) {
$SIG{"__DIE__"} =3D sub {
my $msg =3D shift;
put_session() if $Vend::HaveSession;
my $content =3D get_locale_message(500, <<EOF, $msg);
<HTML><HEAD><TITLE>Fatal Interchange Error</TITLE></HEAD><BODY>
<H1>FATAL error</H1>
<PRE>%s</PRE>
</BODY></HTML>
EOF
response(\$content);
exit 0;
};
}
# Do it here so we can use autoloads and such
Vend::Interpolate::reset_calc() if $Global::Foreground;
Vend::Interpolate::init_calc();
new Vend::Tags;
# LEGACY
ROUTINES: {
last ROUTINES unless index($Vend::FinalPath, '/process/') =3D=3D 0;
while ($Vend::FinalPath =3D~ s:/process/(locale|language|currency)/([^/]*=
)/:/process/:) {
$::Scratch->{"mv_$1"} =3D $2;
}
$Vend::FinalPath =3D~ s:/process/page/:/:;
}
my $locale;
if($locale =3D $::Scratch->{mv_language}) {
$Global::Variable->{LANG}
=3D $::Variable->{LANG} =3D $locale;
}
if ($Vend::Cfg->{Locale} and
$locale =3D $::Scratch->{mv_locale} and
defined $Vend::Cfg->{Locale_repository}->{$locale}
)
{=20
$Global::Variable->{LANG}
=3D $::Variable->{LANG}
=3D $::Scratch->{mv_language}
=3D $locale
if ! $::Scratch->{mv_language};
Vend::Util::setlocale( $locale,
($::Scratch->{mv_currency} || undef),
{ persist =3D> 1 }
);
}
# END LEGACY
run_macro($Vend::Cfg->{Autoload});
#show_times("end global Autoload macro") if $Global::ShowTimes;
for my $macro ( $Vend::Cfg->{Filter}, $Vend::Session->{Filter}) {
next unless $macro;
if (ref($macro) ne 'HASH') {
logError("Bad CGI filter '%s'", $macro);
}
for(keys %$macro) {
Vend::Interpolate::input_filter_do($_, { op =3D> $macro->{$_} } );
}
}
run_macro($Vend::Session->{Autoload});
#show_times("end session Autoload macro") if $Global::ShowTimes;
# If the cgi-bin program was invoked with no extra path info,
# just display the catalog page.
if (! $Vend::FinalPath || $Vend::FinalPath =3D~ m:^/+$:) {
$Vend::FinalPath =3D find_special_page('catalog');
}
$Vend::FinalPath =3D~ s:^/+::;
$Vend::FinalPath =3D~ s/(\.html?)$//;
my $record;
my $adb;
if(ref $Vend::Session->{alias_table}) {
$record =3D $Vend::Session->{alias_table}{$Vend::FinalPath};
$Vend::Cfg->{AliasTable} ||=3D 'alias';
}
if(
$Vend::Cfg->{AliasTable}
and
$record=20
or=20
(
$adb =3D database_exists_ref($Vend::Cfg->{AliasTable})
and=20
$record =3D $adb->row_hash($Vend::FinalPath)
)
)
{
$Vend::FinalPath =3D $record->{real_page};
# This prevents filesystem access when we never want it
# If base page is not passed we allow normal resolution
$record->{base_page}
and $Vend::ForceFlypage =3D $record->{base_page};
my $ref;
## Here we populate CGI variables if desired
## Explicitly passed variables override this
if(
$record->{base_control}
and
$ref =3D get_option_hash($record->{base_control})
)
{
for(keys %$ref) {
next if defined $CGI::values{$_};
$CGI::values{$_} =3D $ref->{$_};
}
}
}
$Vend::Session->{extension} =3D $1 || '';
#::logDebug("path=3D$Vend::FinalPath mv_action=3D$CGI::values{mv_action}");
DOACTION: {
my @path =3D split('/', $Vend::FinalPath, 2);
if (defined $CGI::values{mv_action}) {
$CGI::values{mv_todo} =3D $CGI::values{mv_action}
if ! defined $CGI::values{mv_todo}
and ! defined $CGI::values{mv_doit};
$Vend::Action =3D 'process';
$CGI::values{mv_nextpage} =3D $Vend::FinalPath
if ! defined $CGI::values{mv_nextpage};
}
else {
$Vend::Action =3D shift @path;
}
#::logGlobal("action=3D$Vend::Action path=3D$Vend::FinalPath");
my ($sub, $status, $action);
if(defined $Vend::Cfg->{ActionMap}{$Vend::Action}) {
$sub =3D $Vend::Cfg->{ActionMap}{$Vend::Action};
$CGI::values{mv_nextpage} =3D $Vend::FinalPath
if ! defined $CGI::values{mv_nextpage};
new Vend::Parse;
}
elsif ( defined ($sub =3D $action{$Vend::Action}) ) {
$Vend::FinalPath =3D join "", @path;
}
#show_times("end path/action resolve") if $Global::ShowTimes;
eval {
if(defined $sub) {
$status =3D $sub->($Vend::FinalPath);
#show_times("end action") if $Global::ShowTimes;
}
else {
$status =3D 1;
}
};
(undef $Vend::RedoAction, redo DOACTION) if $Vend::RedoAction;
if($@) {
undef $status;
my $err =3D $@;
my $template =3D <<EOF;
Sorry, there was an error in processing this form action. Please=20
report the error or try again later.
EOF
$template .=3D "\n\nError: %s\n"
if $Global::DisplayErrors && $Vend::Cfg->{DisplayErrors}
;
$template =3D get_locale_message(500, $template, $err);
$template .=3D "($err)";
response($template);
}
$CGI::values{mv_nextpage} =3D $Vend::FinalPath
if ! defined $CGI::values{mv_nextpage};
do_page() if $status;
#show_times("end page display") if $Global::ShowTimes;
if(my $macro =3D $Vend::Cfg->{AutoEnd}) {
if($macro =3D~ /\[\w+/) {
interpolate_html($macro);
}
elsif ($macro =3D~ /^\w+$/) {
$sub =3D $Vend::Cfg->{Sub}{$macro} || $Global::GlobalSub->{$macro};
$sub->();
}
#show_times("end AutoEnd macro") if $Global::ShowTimes;
}
}
# TRACK
$Vend::Track->filetrack();
# END TRACK
close_cat();
undef $H;
#show_times("end dispatch cleanup") if $Global::ShowTimes;
return 1;
}
1;
__END__