#!/usr/bin/perl -T $versions{'agora.cgi'} = "5.5.005 Gold Member Version"; # . $ENV{"AGORAWRAP"}; # Version history is available at... # http://www.agoracart.com/ # # AgoraCart Pro and all associated files, except where noted, are # Copyright 2001 to Present by K-Factor Technologies, Inc. # at AgoraCart.com / AgoraCartPro.com / K-Factor.net with additional # Copyrights 1999-2001 by Steven P. Kneizys and # Copyrights 2000 - 2007 by C. Edward Mayo # # 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. # # Each copy of Agoracart Pro and it's related files are cost items and # are not free software. Each copy, use, install, copy and/or module must be # licensed by K-Factor Technologies, Inc. Licenses (aka pro version membership) # may be purchased at AgoraCart.com or AgoraCartPro.com. # # This copyright notice may not be # removed or altered in any way. # BEGIN { use lib "library/additions"; push(@INC,"library/additions"); } $| = 1; $ENV{"PATH"} = "/bin:/usr/bin"; $test=`whoami`; $versions{'whoami'} = $test if $test; $versions{'id'} = `id`; if ((-f "./wrap_agc.o") && (!($ARGV[0] =~ /nowrap/i))) { # use wrapper $ENV{"AGORAWRAP"}="*"; print `./wrap_agc.o`; &call_exit; } $time = time; $main_program_running = "yes"; $sc_global_bot_tracker = ''; &require_supporting_libraries (__FILE__, __LINE__, "./admin_files/agora_user_lib.pl", # md5 "./library/MD5.pl", "./library/cgi-lib.pl", "./library/agora_html_lib.pl"); # added by Mister Ed for mySQL testing. fixes other thingies too. $sc_special_checkout_variable2 = "";# reserved, do not use if using PayPal &read_and_parse_form_data; &xss_killer; &require_supporting_libraries (__FILE__, __LINE__, "./library/agora.setup.db"); &codehook("after_loading_setup_db"); &require_supporting_libraries (__FILE__, __LINE__, "./admin_files/$sc_gateway_name-user_lib.pl", "$sc_html_setup_file_path", "$sc_cookie_lib"); $sc_loading_primary_gateway = "yes"; &require_supporting_libraries(__FILE__,__LINE__,"$sc_process_order_lib_path"); $sc_loading_primary_gateway = "no"; # added by Mister Ed July 11, 2006 $sc_special_checkout_variable1 = ''; # reserved, do not use if using random key generation $sc_special_checkout_variable3 = ''; $sc_special_misc_variable1 = ''; $sc_special_misc_variable2 = ''; $sc_special_misc_variable3 = ''; &codehook("before_loading_custom_libs"); opendir (USER_LIBS, "./add_ons") || &codehook("cannot-open-custom-dir"); @mylibs = sort(readdir(USER_LIBS)); closedir (USER_LIBS); foreach $zlib (@mylibs) { $lib = $zlib; $lib =~ /([\w\-\=\+]+)(\.pl)/i; $zfile = "$1$2"; $zlib =~ /([^\n|;]+)/; $lib = $1; if ((-f "./add_ons/$lib") && ($lib eq $zfile)) { &require_supporting_libraries(__FILE__, __LINE__,"./add_ons/$lib"); } } &codehook("after_loading_custom_libs"); &agora_starter_section; &codehook("open_for_business"); foreach $query_field (@sc_db_query_criteria) { @criteria = split(/\|/, $query_field); if ($form_data{$criteria[0]} ne "") { $are_any_query_fields_filled_in = "yes"; } } if (($search_request ne "") && ($are_any_query_fields_filled_in eq "no")) { $page = "searchpage.html"; $search_request = ""; if (!(-f "$sc_html_product_directory_path/$page")){ $page = ""; $form_data{'product'} = "."; # show everything $are_any_query_fields_filled_in = "yes"; } else { $form_data{'page'} = $page; } } &codehook("special_navigation"); if (&form_check('display_cart')) { &load_order_lib; &display_cart_contents; &call_exit; } if (&form_check('add_to_cart_button')) { &load_order_lib; &add_to_the_cart; &call_exit; } elsif (&form_check('modify_cart_button')) { &load_order_lib; &display_cart_contents; &call_exit; } elsif (&form_check('change_quantity_button')) { &load_order_lib; &output_modify_quantity_form; &call_exit; } elsif (&form_check('submit_change_quantity_button')) { &load_order_lib; &modify_quantity_of_items_in_cart; &call_exit; } elsif (&form_check('delete_item_button')) { &load_order_lib; &output_delete_item_form; &call_exit; } elsif (&form_check('submit_deletion_button')) { &load_order_lib; &delete_from_cart; &call_exit; } elsif (&form_check('order_form_button')) { &load_order_lib; &display_order_form; &call_exit; } elsif (&form_check('clear_order_form_button')) { &load_order_lib; &clear_verify_file; &codehook("display_cleared_order_form"); &display_order_form; &call_exit; } elsif (&form_check('submit_order_form_button')) { &load_order_lib; if ($sc_test_repeat) { &display_order_form; } else { &process_order_form; } &call_exit; } elsif (($page ne "" || $search_request ne "" || &form_check('continue_shopping_button') || $are_any_query_fields_filled_in =~ /yes/i) && ($form_data{'return_to_frontpage_button'} eq "")) { &display_products_for_sale; &call_exit; } $sc_processing_order="yes"; # assume unless we fall through &codehook("gateway_response"); $sc_processing_order="no"; # If we got here, then just output the front page &output_frontpage; &call_exit; ######################################################################### # load the order library # ######################################################################### sub load_order_lib{ &codehook("load_order_lib_before"); &require_supporting_libraries(__FILE__,__LINE__,"$sc_order_lib_path"); &codehook("load_order_lib_after"); } ######################################################################### # check if a form_data button has been selected # ######################################################################### sub form_check { local ($name) = @_; local ($name2) = $name . ".x"; if (($form_data{$name} ne "") || ($form_data{$name2} ne "")) { return 1; } else { return ""; } } ####################################################################### # Require Supporting Libraries. # ####################################################################### # require_supporting_libraries is used to read in some of # the supporting files that this script will take # advantage of. # # require_supporting_libraries takes a list of arguments # beginning with the current filename, the current line # number and continuing with the list of files which must # be required using the following syntax: # # &require_supporting_libraries (__FILE__, __LINE__, # "file1", "file2", # "file3"...); # # Note: __FILE__ and __LINE__ are special Perl variables # which contain the current filename and line number # respectively. We'll continually use these two variables # throughout the rest of this script in order to generate # useful error messages. sub require_supporting_libraries { # The libraries are required by us,so exit if loading error local ($file, $line, @require_files) = @_; local ($require_file); &request_supporting_libraries("warn exit",$file, $line, @require_files); } sub request_supporting_libraries { # The incoming file and line arguments are split into # the local variables $file and $line while the file list # is assigned to the local list array @require_files. # # $require_file which will just be a temporary holder # variable for our foreach processing is also defined as a # local variable. local ($what_to_do_on_error, $file, $line, @require_files) = @_; local ($require_file); # Next, the script checks to see if every file in the # @require_files list array exists (-e) and is readable by # it (-r). If so, the script goes ahead and requires it. foreach $require_file (@require_files) { if (-e "$require_file" && -r "$require_file") { # file is there, now try to require it $result = eval('require "$require_file"'); # require it in a not-fatal way if ($@ ne "") { if($what_to_do_on_error =~ /warn/i) { if ($error_header_done ne "yes") { $error_header_done = "yes"; print "Content-type: text/html\n\n"; } print "
\n"; print "Error loading library $require_file:

\n $@\n"; print "

Please contact the site administrator to ", "fix the error.  \($ENV{'SERVER_ADMIN'}\)
\n"; print "
\n"; } if($what_to_do_on_error =~ /exit/i) { &call_exit; } } } # If not, the scripts sends back an error message that # will help the admin isolate the problem with the script. else { if($what_to_do_on_error =~ /warn/i) { if ($error_header_done ne "yes") { $error_header_done = "yes"; print "Content-type: text/html\n\n"; } print "I am sorry but I was unable to require $require_file at line $line in $file.
\nWould you please make sure that you have the path correct and that the permissions are set so that I have read access? Thank you.  \($ENV{'SERVER_ADMIN'}\)
\n"; } if($what_to_do_on_error =~ /exit/i) { &call_exit; } } } # End of foreach $require_file (@require_files) } # End of sub require_supporting_libraries ####################################################################### # Read and Parse Form Data. # ####################################################################### # read_and_parse_form_data is a short subroutine # responsible for calling the ReadParse subroutine in # cgi-lib.pl to parse the incoming form data. The script # also tells cgi-lib to prepare that information in the # associative array named %form_data which we will be able # to use for the rest of this script. # # read_and_parse_form_data takes no arguments and is # called with the following syntax: # # &read_and_parse_form_data; sub read_and_parse_form_data { local ($junk); &ReadParse(*form_data); # DELUXE feature ... check here if we are just serving images if ($form_data{'picserve'} ne "") { &serve_picture($form_data{'picserve'},$sc_path_of_images_directory); &call_exit; } if ($form_data{'secpicserve'} ne "") { &serve_picture($form_data{'secpicserve'},"./protected/images/"); &call_exit; } } ######################################################################### # # Writen by Steve K to serve images 04-FEB-2000 # HTML usage examples: # # # # Note: using the http:// format is less efficient # converted to taint-mode sub 2/5/2000 sub serve_picture { local ($qstr,$sc_path_of_images_directory) = @_; local ($test, $test2, $my_path_to_image); $qstr =~ /([\w\-\=\+\/\.\:]+)/; $qstr = "$1"; $my_path_to_image = $sc_path_of_images_directory . $qstr ; $test = substr($my_path_to_image,0,6); $test2 = substr($my_path_to_image,(length($my_path_to_image)-3),3); if ($test2=~ /jpg/i || $test2 =~ /gif/i || $test2 =~ /png/i) { # file is ok to display if ($test2=~ /jpg/i) {# .jpg is jpeg file $test2 = "jpeg"; } if ($test=~ /http:\//i || $test =~ /https:/i) { # need to GET the info .. no implemented here in agora # use LWP::Simple; # print "Content-type: image/$test2\n\n"; # print get($my_path_to_image); } else { # is a filename we can load up directly print "Content-type: image/$test2\n\n"; if (!(-f $my_path_to_image)) {# try adding another slash! $my_path_to_image = $sc_path_of_images_directory ."/" . $qstr ; } open (MYPIC,$my_path_to_image); binmode(MYPIC); $size = 250000; while ($size > 0) { $size = read(MYPIC,$the_picture,$size); print $the_picture; } close(MYPIC); } } } ####################################################################### sub pre_header_navigation { local($temp,$inx,@things_to_delete,@form_keys,$form_name,$count); local(@temp,$request,$actual); if ($cart_id eq $my_cookie_cart_id) { &set_agora("BROWSER_COOKIES_ON","yes"); } # Check if running under SSI ... may need to do something special if ($sc_running_an_SSI_store =~ /yes/i) { $test_for_forced_redirect = &get_agora("SSI_FORCE_REDIRECT"); &set_agora("SSI_FORCE_REDIRECT",''); # What name would we use for the form data? @form_keys = grep(/SSI_FORM_DATA/,&get_agora_names); if ($sc_unique_cart_modifier eq '') { $sc_unique_cart_modifier = &make_random_chars; } @form_keys = grep(/$sc_unique_cart_modifier/,@form_keys); $form_name = $form_keys[0]; # Check for existance of SSI_FORM_DATA $temp = &get_agora("$form_name"); if ($temp ne '') { %form_data = split(/\x01/,$temp); &alias_and_override; &error_check_form_data; } else { # For safety and such, only keep max 90 POSTs cached # automatically delete old ones even if not a POST! $count = &get_agora("SSI_FORM_COUNT"); $count = $count+1; if ($count < 10 || $count > 99) {$count = "10";} &set_agora("SSI_FORM_COUNT",$count); @things_to_delete = grep(/SSI_FORM_DATA_${count}_/,&get_agora_names); foreach $inx (@things_to_delete) {&set_agora($inx,'');} # see if we need to force a redirect ($request,$junk) = split(/\?/,$ENV{'REQUEST_URI'},2); @temp = split(/\//,$request); $request = pop(@temp); ($request,$junk) = split(/\?/,$request,2); @temp = split(/\//,$sc_store_url); $actual = pop(@temp); if ($request ne $actual && (!($sc_allow_forced_SSI_redirect =~ /no/))) { if ($test_for_forced_redirect eq '') { $form_data{'SSI'} = 1; &set_agora("SSI_FORCE_REDIRECT",'1'); } } if (defined($form_data{'SSI'})) { # setup the redirect $temp = ''; delete($form_data{'SSI'}); # Don't re-direct a redirect! $sc_unique_cart_modifier = &make_random_chars; # Need new id!! foreach $inx (keys %form_data) { $temp .= "$inx\x01$form_data{$inx}\x01"; } &set_agora("SSI_FORM_DATA_${count}_$sc_unique_cart_modifier",$temp); $href = "$sc_store_url?cart_id=$cart_id"; $href .= "&crtmod=$sc_unique_cart_modifier"; $temp = $ENV{'SCRIPT_NAME'}; if ($temp =~ /nph-agora.cgi$/i) { $SSI_redirect_message = "HTTP/1.0 302 Found\n"; $SSI_redirect_message .= "$sc_cookie_information"; $SSI_redirect_message .= "Location: $href\n"; } else { $SSI_redirect_message = qq~$sc_doctype  ~; } &set_agora("SSI_REDIRECT_OK",'yes'); &add_codehook("cleanup_before_exit","print_SSI_redirect"); &call_exit; } } } &codehook("pre_header_navigation"); } ####################################################################### sub print_SSI_redirect { print $SSI_redirect_message,"\n"; } ####################################################################### # Alias and Override # # This routine allows the use of aliases for switches, such as # using xm= instead of exact_match= # # Also, override certain setup variables under certain conditions # ####################################################################### sub alias_and_override { local($item,$xx); local ($junk,$raw_text)=""; local (@mylibs,$lib); local ($testval,$testval2,$found_response); &codehook("alias_and_override_top"); &special_security_f3_01172004; if (( ((($form_data{'NiftyPay'} eq '')&&($sc_gateway_name eq "NiftyPay"))||(($form_data{'AgoraPay'} eq '')&&($sc_gateway_name eq "AgoraPay")) ||(($form_data{'iTransact'} eq '')&&($sc_gateway_name eq "iTransact"))) ||(($sc_gateway_name ne "iTransact")&&($sc_gateway_name ne "AgoraPay")&&($sc_gateway_name ne "NiftyPay")) )) { # Debug Thingies # print "Content-type: text/html\n\n"; # print "we did security
"; &special_security_f1_01242002;} if (defined($form_data{'versions'})) { print "Content-type: text/html\n\n"; print "\nVERSIONS\n\n"; print "

Info and Versions of loaded libraries:
\n"; print "\n"; foreach $junk (sort(keys(%versions))) { print "\n"; } print "
$junk $versions{$junk}
\n"; $junk .= `$sc_grep -h "versions{'" ./add_ons/* |$sc_grep "}="`; $junk .= `$sc_grep -h "versions{'" ./add_ons/* |$sc_grep "} ="`; $junk .= `$sc_grep -h "versions{'" ./protected/* |$sc_grep "}="`; $junk .= `$sc_grep -h "versions{'" ./protected/* |$sc_grep "} ="`; $junk .= `$sc_grep -h "versions{'" ./protected/custom/* |$sc_grep "}="`; $junk .= `$sc_grep -h "versions{'" ./protected/custom/* |$sc_grep "} ="`; $junk .= `$sc_grep -h "versions{'" ./library/* |$sc_grep "}="`; $junk .= `$sc_grep -h "versions{'" ./library/* |$sc_grep "} ="`; $junk =~s/\n/ /g; $junk =~ /([\w\-\=\+\/\;\{\}\'\ \.\"\$]+)/; $junk = $1; while ($junk ne "") { $result = $lib; ($junk1,$key,$junk) = split(/\'/,$junk,3); ($junk1,$val,$junk) = split(/\"/,$junk,3); if ($versions{$key} eq "") { $versions{$key} = $val; } ($junk1,$junk) = split(/versions/,$junk,2); } # if ($@ eq "") { print "

info and Versions of loaded and unloaded libraries:
\n"; print "\n"; foreach $junk (sort(keys(%versions))) { print "\n"; } print "
$junk $versions{$junk}
\n"; # } print "\n\n"; &call_exit; } # Get rid of extraneous stuff, if present, on the cart id # need to test for a repeated loading of critical pages ... if (defined($form_data{'cart_id'})) { ($form_data{'cart_id'},$junk) = split(/\*/,$form_data{'cart_id'},2); $sc_unique_cart_modifier_orig = $junk; $sc_unique_cart_modifier = substr($sc_unique_cart_modifier_orig,0,6); } # Check for proper URL in use, helps with cookies but not required $found_response = ""; foreach $testval (keys %sc_order_response_vars) { $testval2 = $sc_order_response_vars{$testval}; if ($form_data{$testval2} ne "") { $found_response .= "*"; } } if (("$sc_domain_name_for_cookie" ne $ENV{'HTTP_HOST'}) && ($sc_allow_location_redirect =~ /yes/i ) && ($form_data{'process_order.x'} eq "" ) && ($form_data{'process_order'} eq "" ) && ($form_data{'relay'} eq "" ) && ($found_response eq "" ) && ($form_data{'submit_order_form_button.x'} eq "" ) && ($form_data{'submit_order_form_button'} eq "" ) && ($form_data{'order_form_button.x'} eq "" ) && ($form_data{'order_form_button'} eq "" )){ #redrect them to standard URL if ($cookie{'cart_id'} ne "") { $cart_id = $cookie{'cart_id'}; } if ($form_data{'cart_id'} ne "") { $cart_id = $form_data{'cart_id'}; ($cart_id,$junk) = split(/\*/,$cart_id,2); } $sc_cart_path = "$sc_user_carts_directory_path/${cart_id}_cart"; if (!(-f $sc_cart_path)){ #no cart, forget the number $cart_id = ""; } $href = "$sc_store_url"; if ($cart_id ne "") { $href .= "?cart_id=$cart_id"; } print "Location: $href\n\n"; &call_exit; } $search_request = ($form_data{'search_request_button'} || $form_data{'search_request_button.x'}); if (($form_data{'maxp'} > 0) && ($form_data{'maxp'} < 301)) { $sc_db_max_rows_returned = $form_data{'maxp'}; } if (defined($form_data{'srb'})) { #is an override/shortcut $search_request = $form_data{'srb'}; } if (defined($form_data{'xc'})) { $form_data{'exact_case'} = $form_data{'xc'}; } if (defined($form_data{'xm'})) { $form_data{'exact_match'} = $form_data{'xm'}; } if (defined($form_data{'dc'})) { $form_data{'display_cart'} = $form_data{'dc'}; } if (defined($form_data{'pid'})) { $form_data{'p_id'} = $form_data{'pid'}; } if (defined($form_data{'ofn'})) { $form_data{'order_form'} = $form_data{'ofn'}; } if (defined($form_data{'p'})) { if ($form_data{'product'} ne "") { $form_data{'product'} .= " " . $form_data{'p'}; } else { $form_data{'product'} = $form_data{'p'}; } } if (defined($form_data{'ppovr'})) { $form_data{'ppinc'} = $form_data{'ppovr'}; } if (defined($form_data{'k'})) { if ($form_data{'keywords'} ne "") { $form_data{'keywords'} .= " " . $form_data{'k'}; } else { $form_data{'keywords'} = $form_data{'k'}; } } if (defined($form_data{'kovr'})) { $form_data{'keywords'} = $form_data{'kovr'}; } if (($form_data{'add_to_cart_button'} eq "") && ($form_data{'add_to_cart_button.x'} ne "")) { $form_data{'add_to_cart_button'} = "1"; } if ($form_data{'viewOrder'} eq "yes") { $sc_should_i_display_cart_after_purchase = "yes"; } else { $sc_should_i_display_cart_after_purchase = "no"; } if (($sc_debug_mode =~ /yes/i) && ($sc_debug_track_cartid =~ /yes/i)) { if (($cookie{'cart_id'} ne "") && ($form_data{'cart_id'} ne "")) { $cart_id = $form_data{'cart_id'}; ($cart_id,$junk) = split(/\*/,$cart_id,2); if ($cart_id ne $cookie{'cart_id'}) { local($mytext) = "Cart ID changed: cookie=$cookie{'cart_id'} "; $mytext .= "form=$form_data{'cart_id'}|"; $mytext .= "form values:|"; local($inx); foreach $inx (sort(keys %form_data)) { $mytext .= " \$form_data{'$inx'} = $form_data{$inx}|"; } &update_error_log($mytext, __FILE__, __LINE__); } } } &special_security_f2_01242002; &codehook("alias_and_override_end"); } ####################################################################### # Error Check Form Data. # ####################################################################### # error_check_form_data is responsible for checking to # make sure that only authorized pages are viewable using # this application. It takes no arguments and is called # with the following syntax: # # &error_check_form_data; # # The routine simply checks to make sure that if # the page variable extension is not one that is defined # in the setup file as an appropriate extension like .html # or .htm, or there is no page being requestd (ie: the # store front is being displayed) it will send a warning # to the user, append the error log, and exit. # # @acceptable_file_extensions_to_display is an array of # acceptable file extensions defined in the setup file. # To be more or less restrictive, just modify this list. # # Specifically, for each extension defined in the setup # file, if the value of the page variable coming in from # the form ($page) is like the extension (/$file_extension/) # or there is no value for page (eq ""), we will set # $valid_extension equal to yes. sub error_check_form_data { # # error check this, paranoia I know ... just in case regular expr. get # broken somehow, this is our safety net if ($form_data{'page'} =~ /\.\.\/|http:|https:|ftp:/) { print "Content-type: text/html\n\n"; print "


ERROR:
You may not use the store to navigate"; print " to outside pages/sites, that is Forbidden. Sorry!\n "; $form_data{'page'} =''; &call_exit; } # These expressions will strip of any path information so # files are only loaded from the appropriate directory. # We will also only load pages of the proper extension, # which is checked in sub error_check_form_data. $page = $form_data{'page'}; $page =~ /([\w\-\=\+\/]+)\.(\w+)/; $page = "$1.$2"; $page_extension = ".$2"; $page = "" if ($page eq "."); $page =~ s/^\/+//; # Get rid of any residual / prefix $form_data{'page'} = $page; # set it back, in case somebody uses it foreach $file_extension (@acceptable_file_extensions_to_display) { if ($page_extension eq $file_extension || $page eq "") { $valid_extension = "yes"; } } # Next, the script checks to see if $valid_extension has # been set to "yes". # # If the value for page satisfied any of the extensions # in @acceptable_file_extensions_to_display, the script # will set $valid_extension equal to yes. If the value # is set to yes, the subroutine will go on with it's work. # Otherwise it will exit with a warning and write to the # eror log if appropriate # # Notice that we pass three parameters to the # update_error_log subroutine which will be discussed # later. The subroutine gets a warning, the # name of the file, and the line number of the error. # # $sc_page_load_security_warning is a variable set in # agora.setup.db If you want to give a more or less # informative error message, you are welcome to change the # text there. if ($valid_extension ne "yes") { print "Content-type: text/html\n\n$sc_page_load_security_warning\n"; &update_error_log("PAGE LOAD WARNING", __FILE__, __LINE__); &call_exit; } $form_data{'page'} = $page; # set it to the untainted & filtered one # # This is section added by Mister Ed 09/2002 and operates # exactly like the routines above for the pages parsed by # agoracart, but for the cartlinks instead. # if ($form_data{'cartlink'} ne "") { # # error check this, paranoia I know ... just in case regular expr. get # broken somehow, this is our safety net if ($form_data{'cartlink'} =~ /\.\.\/|http:|https:|ftp:/) { print "Content-type: text/html\n\n"; print "


ERROR:
You may not use the store to navigate"; print " to outside pages/sites, that is Forbidden. Sorry!\n "; $form_data{'cartlink'} = ''; &call_exit; } $cartlink = $form_data{'cartlink'}; $cartlink =~ /([\w\-\=\+\/]+)\.(\w+)/; $cartlink = "$1.$2"; $page_extension = ".$2"; $cartlink = "" if ($cartlink eq "."); $cartlink =~ s/^\/+//; $form_data{'cartlink'} = $cartlink; foreach $file_extension (@acceptable_file_extensions_to_display) { if ($page_extension eq $file_extension || $cartlink eq "") { $valid_extension = "yes"; } } if ($valid_extension ne "yes") { print "Content-type: text/html\n\n$sc_page_load_security_warning\n"; &update_error_log("PAGE LOAD WARNING", __FILE__, __LINE__); &call_exit; } $form_data{'cartlink'} = $cartlink; # set it to the untainted & filtered one } # now un-taint the value of $form_data{'cart_id'} # also pattern match it, in case the form has 2+ cart_id fields if ($form_data{'cart_id'} ne "") { if ($form_data{'cart_id'} =~ /^([\w\-\=\+\/]+)\.(\w+)/) { $temp = "$1.$2"; if ($form_data{'cart_id'} ne $temp) { $temp = '';} $form_data{'cart_id'} = $temp; if ($form_data{'cart_id'} eq ".") { $form_data{'cart_id'} = ""; } } else { $form_data{'cart_id'} = ""; } } if ($cookie{'cart_id'} ne "") { if ($cookie{'cart_id'} =~ /(^[\w\-\=\+\/]+)\.(\w+)/) { $cookie{'cart_id'} = "$1.$2"; if ($cookie{'cart_id'} eq ".") { $cookie{'cart_id'} = ""; } } else { $cookie{'cart_id'} = ""; } } } ####################################################################### sub special_security_f1_01242002 { # international latin enabled by Mister Ed June 27, 2006 # ÀÁÂÃÄÅÆÇŒÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØŠÙÚÛÜÝŸßàáâãäåæçèëìíîïðñòóôœõöøšùúûüýþÿž # À Á Â Ã Ä Å Æ Ç Œ È É Ê Ë Ì Í Î Ï Ð Ñ Ò Ó Ô Õ Ö Ø Š Ù Ú Û Ü Ý Ÿ ß à á â ã ä å æ ç è ë ì í î ï ð ñ ò ó ô œ õ ö ø š ù ú û ü ý þ ÿ ž # defaults for English: USA, Canada, Australia, Canada my $patternString = '[^ \$\w\-=\+\.\/,@#!_\\[\]\^\{\}\:&;|~\*\x00\(\)]+'; my $patternString2 = '[ \$\w\-=\+\.\/,@#!_\\[\]\^\{\}\:&;|~\*\x00\(\)]+'; if ($sc_use_international_latin_characters =~ /yes/i) { $patternString = '[^ \$\w\-=\+\.\/,ÀÁÂÃÄÅÆÇŒÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØŠÙÚÛÜÝŸßàáâãäåæçèëìíîïðñòóôœõöøšùúûüýþÿž@#!_\\[\]\^\{\}\:&;|~\*\x00\(\)]+'; $patternString2 = '[ \$\w\-=\+\.\/,ÀÁÂÃÄÅÆÇŒÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØŠÙÚÛÜÝŸßàáâãäåæçèëìíîïðñòóôœõöøšùúûüýþÿž@#!_\\[\]\^\{\}\:&;|~\*\x00\(\)]+'; # corrected December 22, 2006 # $patternString = '[^ \$\w\-=\+\.\/,ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝŸàáâãäåæçèëìíîïðñòóôœõöøùúûüýþÿ@#!_\\[\]\^\{\}\:&;|~\*\x00\(\)]+'; # $patternString2 = '[ \$\w\-=\+\.\/,ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝŸàáâãäåæçèëìíîïðñòóôœõöøùúûüýþÿ@#!_\\[\]\^\{\}\:&;|~\*\x00\(\)]+'; } # prefilter everything for meta characters if (!($sc_debug_mode =~ /yes/i)) { delete($form_data{'versions'});} $form_data{'cart_id'} =~ s//>/g; for $xx (keys %form_data) { $form_data{$xx}=~s/($patternString)//g; if ($form_data{$xx}=~/($patternString2)/){ $form_data{$xx} = $1; } else { $form_data{$xx} = ''; } } } sub special_security_f2_01242002 { if (!($form_data{'cart_id'} =~ /^([\w\-\=\+\/]+)\.(\w+)/)) { $form_data{'cart_id'} = ''; $sc_unique_cart_modifier_orig = ''; $sc_unique_cart_modifier = ''; } } # disallows submitting items in browser address bar sub special_security_f3_01172004 { if ($form_data{'option'} ne '') { $form_data{'add_to_cart_button'} = ''; $form_data{'add_to_cart_button.x'} = ''; $sc_unique_cart_modifier_orig = ''; $sc_unique_cart_modifier = ''; } } ####################################################################### sub option_prep { local ($field,$option_location,$product_id)= @_; local ($very_first_part,$junk); local ($arg,$arg1,$arg2); $field = &agorascript($field,"optpre","$option_location",__FILE__,__LINE__); $field =~ s/%%PRODUCT_ID%%/$product_id/ig; $field =~ s/%%PRODUCTID%%/$product_id/ig; $field =~ s/%%prodID%%/$product_id/ig; $field = &agorascript($field,"optpost","$option_location",__FILE__,__LINE__); # DELUXE feature ... take only the part between

--cut here--

# tokens # if ($chop =~ /yes/i) { ($very_first_part,$field,$junk) = split(/

--cut here--<\/h3>/i,$field,3); if ($field eq "") { $field = $very_first_part; } if ($field eq "") { $field = "(file $option_location not found)"; } # } return $field; } ####################################################################### # Assign a Shopping Cart. # ####################################################################### # assign_a_unique_shopping_cart_id is a subroutine used to # assign a unique cart id to every new clinet. It takes # no argumnets and is called with the following syntax: # # &assign_a_unique_shopping_cart_id; sub assign_a_unique_shopping_cart_id { # Since no cart_id cookie exists, the script assigns # the user their own unique shopping cart. To do so, # it generates a random (rand) 8 digit (100000000) # integer (int) and then appends to that string the current # process id ($$). However, the srand function is seeded # with the time and the current process id in order to # produce a more random random number. $sc_cart_path is # also defined now that we have a unique cart id number. srand (time|$$); if ($sc_need_short_cart_id =~ /yes/i) { $cart_id = int(rand(1000)); } else { $cart_id = int(rand(10000000)); } $cart_id .= ".$$"; $cart_id =~ s/-//g; &codehook("assign-cart_id-modifier"); $sc_cart_path = "$sc_user_carts_directory_path/${cart_id}_cart"; # However, before we can be absolutely sure that we have # created a unique cart, the script must check the existing # list of carts to make sure that there is not one with # the same value. # # It does this by checking to see if a cart with the # randomly generated ID number already exists in the Carts # directory. If one does exit (-e), the script grabs # another random number using the same routine as # above and checks again. # # Using the $cart_count variable, the script executes this # algorithm three times. If it does not succeede in finding # a unique cart id number, the script assumes that there is # something seriously wrong with the randomizing routine # and exits, warning the user on the web and the admin # using the update_error_log subroutine discussed later. $cart_count = 0; while (-e "$sc_cart_path") { if ($cart_count == 4) { print "$sc_randomizer_error_message"; &update_error_log("COULD NOT CREATE UNIQUE CART ID", __FILE__, __LINE__); &call_exit; } $cart_id = int(rand(10000000)); $cart_id .= "_$$"; $cart_id =~ s/-//g; &codehook("assign-cart_id-modifier"); $sc_cart_path = "$sc_user_carts_directory_path/${cart_id}_cart"; $cart_count++; } # End of while (-e $sc_cart_path) # Now that we have generated a truly unique id # number for the new client's cart, the script may go # ahead and create it in the shopping_carts sub-directory. # # If there is a problem opening the new cart, we'll output # an error message with the file_open_error subroutine # discussed later. &set_sc_cart_path; # there are other paths that must be set as well &codehook("assign-cart_id"); &SetCookies; } ####################################################################### # Log Access to Store # ####################################################################### sub log_access_to_store { $date = &get_date; &get_file_lock("$sc_access_log_path.lockfile"); open (ACCESS_LOG, ">>$sc_access_log_path"); $remote_addr = $ENV{'REMOTE_ADDR'}; $request_uri = $ENV{'REQUEST_URI'}; $http_user_agent = $ENV{'HTTP_USER_AGENT'}; if ($ENV{'HTTP_REFERER'} ne "") { $http_referer = $ENV{'HTTP_REFERER'}; } else { $http_referer = "possible bookmarks"; } $remote_host = $ENV{'REMOTE_HOST'}; #$shortdate = `date +"%T"`; # time #$shortdate = `date +"%D %T"`; # date and time $shortdate = &get_date_short; chomp ($shortdate); $unixdate = time; $new_access = "$form_data{'url'}\|$shortdate\|$request_uri" . "\|$cookie{'visit'}\|$remote_addr\|$http_user_agent" . "\|$http_referer\|$unixdate\|"; # The script then takes off the final pipe, adds the new # access to the log file, closes the log file and removes # the lock file. chop $new_access; print ACCESS_LOG "$new_access\n"; close (ACCESS_LOG); &release_file_lock("$sc_access_log_path.lockfile"); } ####################################################################### # Output Frontpage. # ####################################################################### # output_frontpage is used to display the frontpage of the # store. It takes no argumnets and is accessed with the # following syntax: # # &output_frontpage; # # The subroutine simply utilizes the display_page # subroutine which is discussed later to output the # frontpage file, the location of which, is defined # in agora.setup.db. display_page takes four arguments: # the cart path, the routine calling it, the current # filename and the current line number. sub output_frontpage { &codehook("output_frontpage"); &display_page("$sc_store_front_path", "Output Frontpage", __FILE__,__LINE__); } ############################################################ sub finish_add_to_the_cart { &codehook("finish_add_to_the_cart"); if ($sc_should_i_display_cart_after_purchase_real =~ /yes/i) { $sc_should_i_display_cart_after_purchase = "yes"; } if (($sc_use_html_product_pages =~ /yes/i) || (($sc_use_html_product_pages =~ /maybe/i) && ($page ne ""))) { if ($sc_should_i_display_cart_after_purchase =~ /yes/i) { &display_cart_contents; } else { &display_page("$sc_html_product_directory_path/$page", "Display Products for Sale"); } #end of else } else { if ($sc_should_i_display_cart_after_purchase =~ /yes/i) { &display_cart_contents; } elsif ($are_any_query_fields_filled_in =~ /yes/i) { $page = ""; &display_products_for_sale; } else { &create_html_page_from_db; } # end of else } # end of top/first if conditional } ####################################################################### # Display Products for Sale # ####################################################################### # display_products_for_sale is used to generate # dynamically the "product pages" that the client will # want to browse through. There are two cases within it # however. # # Firstly, if the store is an HTML-based store, this # routine will either display the requested page # or, in the case of a search, perform a search on all the # pages in the store for the submitted keyowrd. # # Secondly, if this is a database-based store, the script # will use the create_html_page_from_db to output the # product page requested or to perform the search on the # database. # # The subroutine takes no arguments and is called with the # following syntax: # # &display_products_for_sale; sub display_products_for_sale { # The script first determines which type of store this is. # If it turns out to be an HTML-based store, the script # will check to see if the current request is a keyword # search or simply a request to display a page. If it is # a keyword search, the script will require the html # search library and use the html_search subroutine with # in it to perform the search. if (($sc_use_html_product_pages eq "yes") || (($sc_use_html_product_pages eq "maybe") && ($page ne ""))) { if (($search_request ne "") && ($sc_use_html_product_pages eq "yes")){ &standard_page_header("Search Results"); require "$sc_html_search_routines_library_path"; &html_search; &html_search_page_footer; &call_exit; } # If the store is HTML-based and there is no current # keyword however, the script simply displays the page as # requested with display_page which will be discussed # shortly. &display_page("$sc_html_product_directory_path/$page", "Display Products for Sale", __FILE__, __LINE__); } # On the other hand, if $sc_use_html_product_pages was set to # no, it means that the admin wants the script to generate # HTML product pages on the fly using the format string # and the raw database rows. The script will do so # using the create_html_page_from_db subroutine which will # be discussed next. else { &create_html_page_from_db; } } ####################################################################### # create_html_page_from_db Subroutine # ####################################################################### # create_html_page_from_db is used to genererate the # navigational interface for database-base stores. It is # used to create both product pages and "list of products" # pages. The subroutine takes no arguments and is called # with the following syntax: # # &create_html_page_from_db; sub create_html_page_from_db { local ($body_html,$prod_message,$prod_message2,$status,$total_row_count); # First thing, need to check to see if there is actually # a page which must be displayed. If there is a value for # the page variable incoming as form data, (ie: list of # product page) the script will simply display that page # with the display_page subroutine and exit. # If there is no page value, then the script knows that it # must generate a dynamic product page using the value of # the product form variable to query the database. # #if ($page ne "" && $search_request eq "" && # $form_data{'continue_shopping_button'} eq "") if (($page ne "" ) && (!($sc_use_html_product_pages eq "no"))) { &display_page("$sc_html_product_directory_path/$form_data{'page'}", "Display Products for Sale", __FILE__, __LINE__); &call_exit; } # First, the script uses the product_page_header # subroutine in order to dynamically generate the product # page header. We'll pass to the subroutine the value of # the page we have been asked to display so that it can # display something useful in the area. # # The product_page_header subroutine is located in # agora_html_lib.pl and $sc_product_display_title is # defined in the setup file. ($body_html,$prod_message,$status,$total_row_count) = &create_html_page_from_db_body; # new code hook added by Mister Ed October 19, 2006 # allows changes to page titles or other info just before page display &codehook("create_html_page_from_db_hook"); # allow for next/prev text to be overridden for tokenization placement. #added by Mister Ed Sept 1, 2008. inspired from Dan @ Cartsolutions.net $prod_message2 = "$prod_message"; if ($sc_use_alt_next_display =~ /Yes/) { $prod_message2 = ""; } &product_page_header($sc_product_display_title,$prod_message2); print $body_html; &product_page_footer($prod_message2); &call_exit; } ####################################################################### sub create_html_page_from_db_body { # First, the script defines a few working variables which # will remain local to this subroutine. local ($my_output,$prod_message); local (@database_rows, @database_fields, @item_ids, @display_fields); local ($total_row_count, $id_index, $display_index, $found, $product_id); local ($row, $field, $empty, $option_tag, $option_location, $output); # Next the database is querried for rows containing the # value of the incoming product variable in the correct # category as defined in agora.setup.db The script uses # the submit_query subroutine in agora_db_lib.pl # passing to it a reference to the list array # database_rows. # # submit_query returns a descriptive status message # if there was a problem and a total row count # for diagnosing if the maximum rows returned # variable was exceeded. if (!($sc_db_lib_was_loaded =~ /yes/i)) { &require_supporting_libraries (__FILE__, __LINE__, "$sc_db_lib_path"); } ($status,$total_row_count) = &submit_query(*database_rows); # Now that the script has the database rows to be # displayed, it will display them. # # Firstly, the script goes through each database row # contained in @database_rows splitting it into it's # fields. # # For the most part, in order to display the database # rows, the script will simply need to take each field # from the database row and substitute it for a %s in the # format string defined in agora.setup.db # # However, in the case of options which will modify a # product, the script must grab the code from an options # file. # # The special way that options are denoted in the database # are by using the format %%OPTION%%option.html in the # data file. This string includes two important bits of # information. # # Firstly, it begins with %%OPTION%%. This is a flag # which will let the script know that it needs to deal # with this database field as if it were an option. When # it sees the flag, it will then look to the bit after the # flag to see which file it should load. Thus, in this # example, the script would load the file option.html for # display. # # Why go through all the trouble? Well basically, we need # to create a system which will handle large chunks of # HTML code within the database that are very likely to be # similar. If there are options on product pages, it is # likely that they are going to be repeated fairly # often. For example, every item in a database might have # an option like tape, cd or lp. By creating one # options.html file, we could easily put all the code into # one shared location and not need to worry about typing # it in for every single database entry. # DELUXE version sanity check if (($form_data{'next'}+$sc_db_max_rows_returned) < 1) { $form_data{'next'} = 0; } $nextCount = $form_data{'next'}+$sc_db_max_rows_returned; $prevCount = $form_data{'next'}-$sc_db_max_rows_returned; $minCount = $form_data{'next'}; $maxCount = $form_data{'next'}+$sc_db_max_rows_returned; if ($maxCount < @database_rows) { $my_max_count = $maxCount; } else { $my_max_count = @database_rows; } $num_returned = @database_rows; $nextHits = $sc_db_max_rows_returned; $prod_message = &product_message($status,$num_returned,$nextHits); if ($form_data{'add_to_cart_button.x'} ne "" && $sc_shall_i_let_client_know_item_added eq "yes") { $my_output .= "$sc_item_ordered_message"; } $last_product_displayed = "no"; # Agora version 3.2b -- now it is a list of keys, not full rows foreach $row (@database_rows) { $rowCount++; $prevHits = $sc_db_max_rows_returned; $nextHits = $sc_db_max_rows_returned; if ($rowCount > $minCount && $rowCount <= $maxCount) { #@database_fields = split (/\|/, $row); $product_id = $row; $found = &check_db_with_product_id($product_id,*database_fields); &codehook("create_html_page_read_db_item"); foreach $field (@database_fields) { # DELUXE feature ... if field starts with %%IMG%% then it is an image, # and we will generate an HTML IMG tag for it if ($field =~ /^%%IMG%%/i) { ($empty, $image_tag, $image_location) = split (/%%/, $field); $field = '' . '; } # For every field in every database row, the script simply # checks to see if it begins (^) with %%OPTION%%. If so, # it splits out the string into three strings, one # empty, one equal to OPTION and one equal to the location # of the option to be used. Then the script resets the # field to null because it is about to overwrite it. if ($field =~ /^%%OPTION%%/i) { ($empty, $option_tag, $option_location, $junk) = split (/%%/, $field, 4); $field = ""; # The option file is then opened and read. Next, every # line of the option file is appended to the $field # variable and the file is closed again. Then the # current product id number is substituted for the # %%PRODUCT_ID%% flag in the option_prep subroutine and # and any optpre and optpost agorascript is run $field = &load_opt_file($option_location); $field = &option_prep($field,$option_location,$product_id); # End of if ($field =~ /^%%OPTION%%/) } # Now see if we need to load a generic file of some type if ($field =~ /^%%FILE%%/i) { ($empty, $option_tag, $option_location) = split (/%%/, $field); $field = ""; { open (OPTION_FILE, "<$sc_generic_directory_path/$option_location"); local $/=undef; $field=; close (OPTION_FILE); } $field = &agorascript($field,"pre","$option_location",__FILE__,__LINE__); $field =~ s/%%PRODUCT_ID%%/$database_fields[$sc_db_index_of_product_id]/g; $field =~ s/%%PRODUCTID%%/$database_fields[$sc_db_index_of_product_id]/g; $field =~ s/%%URLofImages%%/$URL_of_images_directory/g; $field =~ s/%%cart_id%%/$cart_id/g; $field = &agorascript($field,"post","$option_location",__FILE__,__LINE__); ($very_first_part,$field,$junk) = split(/

--cut here--<\/h3>/i,$field,3); if ($field eq "") { $field = $very_first_part; } if ($field eq "") { $field = "(file $option_location not found)"; } # End of if ($field =~ /^%%FILE%%/) } # End of foreach $field (@database_fields) } if ($rowCount == (1 + $minCount)) { $first_product_displayed = "yes"; } else { $first_product_displayed = "no"; if ($rowCount == $maxCount) { $last_product_displayed = "yes"; } } &create_display_fields(@database_fields); $my_output .= &prep_displayProductPage(&get_sc_ppinc_info); # End of foreach $row (@database_rows) } } return ($my_output,$prod_message,$status,$total_row_count); } ####################################################################### # file_open_error Subroutine # ####################################################################### # If there is a problem opening a file or a directory, it # is useful for the script to output some information # pertaining to what problem has occurred. This # subroutine is used to generate those error messages. # # file_open_error takes four arguments: the file or # directory which failed, the section in the code in which # the call was made, the current file name and # line number, and is called with the following syntax: # # &file_open_error("file.name", "ROUTINE", __FILE__, # __LINE__); sub file_open_error { # The subroutine simply uses the update_error_log # subroutine discussed later to modify the error log and # then uses CgiDie in cgi-lib.pl to gracefully exit the # application with a useful debugging error message sent # to the browser window. local ($bad_file,$script_section,$this_file,$line_number) = @_; if ($sc_global_bot_tracker ne "1") { # run only if not a bot &update_error_log("FILE OPEN ERROR-$bad_file", $this_file, $line_number); open(ERROR, $error_page); while () { print $_; } close (ERROR); } # close of run only if not a bot } ####################################################################### # display_page Subroutine # ####################################################################### # display_page is used to filter HTML pages through the # script and display them to the browser window. # # display_page takes four arguments: the file or # directory which failed, the section in the code in which # the erroneous call was made, the current file name and # line number, and is called with the following syntax: # # &file_open_error("file.name", "ROUTINE", __FILE__, # __LINE__); # # (notice the two special Perl variables __FILE__, which # equals the current filename, and __LINE__ which equals # the current line number). sub display_page { local ($page, $routine, $file, $line) = @_; local($the_file)=""; local($meta_tags_thing) = '%x%Meta Tags Go Here%x%'; local($href_fields,$hidden_fields); $href_fields = &make_href_fields; $hidden_fields = &make_hidden_fields; $cart_id_for_html = "%%ZZZ%%"; # the subroutine begins by opening the requested file for # reading, exiting with file_open_error if there is a # problem as usual. if ($form_data{'cartlink'} ne "") { open (PAGE, "<./html/$cartlink") || &file_open_error("$category", "$routine", $file, $line); } else { open (PAGE, "<$page") || &file_open_error("$page", "$routine", $file, $line); } # It then reads in the file one line at a time. while () ###################################################################################### ###### This needs to be verified.... might be easier to put the meta stuff into ###### the css manager as there is already space for meta tags there... ###### then some of this code could be elimineted.... if not it'll have to be ###### updated so that the pages are valid by w3c standards ###################################################################################### { # Check to see if the add_to_cart_button button # has been clicked. if so, it means that we have just # added an item and are returning to the display of the # product page. In this case, we will sneak in an addition # confirmation message right after the
tag line. if (($form_data{'add_to_cart_button'} ne "") && ($sc_allow_sneak_in_message =~ /yes/i) && ($sc_shall_i_let_client_know_item_added =~ /yes/i)) { if ($_ =~ //i) { $the_file .= $meta_tags_thing; $meta_tags_thing = ''; } } close (PAGE); $the_file = &script_and_substitute($the_file,$page); $the_file = $meta_tags_thing . $the_file; # safety net $the_file =~ s/%x%Meta Tags Go Here%x%/$sc_special_page_meta_tags/gi; print $the_file; # End of sub display_page } ################################################################# sub script_and_substitute { local ($the_file,$page)=@_; local($href_fields,$hidden_fields,$item_ordered_message,$my_text)=""; local($arg,$myans); $href_fields = &make_href_fields; $hidden_fields = &make_hidden_fields; $cart_id_for_html = "%%ZZZ%%"; # All forms must include at least two hidden field lines # with "tags" to be substituted for imbedded as follows: # # # # # When the script reads in these lines, it will see the # tags "%%cart_id%%" and"%%page%%" and substitute them for # the actual page and cart_id values which came in as form # data. # # Similarly it might see the following URL reference: # # # # In this case, it will see the cartid= tag and # substitute in the correct and complete # "cartid=some_number". if (($form_data{'add_to_cart_button'} ne "" )&& ($sc_shall_i_let_client_know_item_added =~ /yes/i)) { $item_ordered_message = $sc_item_ordered_msg_token; } $the_file = &agorascript($the_file,"pre","$page",__FILE__,__LINE__); $the_file =~ s/%%item_ordered_msg%%/$item_ordered_message/ig; if ($sc_global_bot_tracker eq "1") { $the_file =~ s/cart_id=%%cart_id%%/cart_id=/g; $the_file =~ s/cart_id=//g; $the_file =~ s/%%cart_id%%//g; } else { $the_file =~ s/cart_id=%%cart_id%%/cart_id=/ig; $the_file =~ s/cart_id=/cart_id=$cart_id_for_html/ig; $the_file =~ s/%%cart_id%%/$cart_id_for_html/ig; } $the_file =~ s/%%page%%/$form_data{'page'}/ig; $the_file =~ s/%%cartlink%%/$form_data{'cartlink'}/ig; $the_file =~ s/%%date%%/$date/ig; $the_file =~ s/%%agoracgi_ver%%/$versions{'agoracart'}/ig; $the_file =~ s/%%URLofImages%%/$URL_of_images_directory/ig; $the_file =~ s/%%scriptURL%%/$sc_main_script_url/ig; $the_file =~ s/%%ScriptPostURL%%/$sc_main_script_post_url/ig; $the_file =~ s/%%sc_order_script_url%%/$sc_order_script_url/ig; $the_file =~ s/%%StepOneURL%%/$sc_stepone_order_script_url/ig; $the_file =~ s/%%href_fields%%/$href_fields/ig; $the_file =~ s/%%make_hidden_fields%%/$hidden_fields/ig; $the_file =~ s/%%ppinc%%/$form_data{'ppinc'}/ig; $the_file =~ s/%%maxp%%/$form_data{'maxp'}/ig; $the_file =~ s/%%product%%/$form_data{'product'}/ig; $the_file =~ s/%%p_id%%/$form_data{'p_id'}/ig; $the_file =~ s/%%keywords%%/$keywords/ig; $the_file =~ s/%%next%%/$form_data{'next'}/ig; $the_file =~ s/%%exact_match%%/$form_data{'exact_match'}/ig; $the_file =~ s/%%member%%/$form_data{'member'}/ig; $the_file =~ s/%%affiliate%%/$form_data{'affiliate'}/ig; $the_file =~ s/%%TemplateName%%/$sc_headerTemplateName/ig; $the_file =~ s/%%ButtonSetURL%%/$sc_buttonSetURL/ig; # Added the following new token to be used in all pages $the_file =~ s/%%head_info%%/$sc_standard_head_info/ig; while ($the_file =~ /(%%eval)([^%]+)(%%)/i) { $arg = $2; $myans = eval($arg); if ($@ ne ""){ $myans = "%% Eval Error on: $arg %%";} $the_file =~ s/(%%eval)([^%]+)(%%)/$myans/i; } while ($the_file =~ /%%ZZZ%%/) { $cart_id_for_html = $cart_id; $the_file =~ s/%%ZZZ%%/$cart_id_for_html/; } $the_file = &agorascript($the_file,"post","$page",__FILE__,__LINE__); $the_file = &agorascript($the_file,"","$page",__FILE__,__LINE__); # Very Last thing, load headers and footers # These routines already have substitutions, agorascript, etc, and # are stand-alones, so do not need to make any additional changes to them while ($the_file =~ /%%StoreHeader%%/i) { $my_text = &GetStoreHeader; $the_file =~ s/%%StoreHeader%%/$my_text/i; } while ($the_file =~ /%%StoreFooter%%/i) { $my_text = &GetStoreFooter; $the_file =~ s/%%StoreFooter%%/$my_text/i; } return $the_file; } ################################################################# # update_error_log Subroutine # ################################################################# # update_error_log is used to append to the error log if # there has been a process executing this script and/or # email the admin. # # The subroutine takes three arguments, the type of error, # the current filename and current line number and is # called with the following syntax: # # &update_error_log("WARNING", __FILE__, __LINE__); sub update_error_log { # The subroutine begins by assigning the incoming # argumnets to local variables and defining some other # local variables to use during its work. # # $type_of_error will be a text string explaining what # kind of error is being logged. # # $file_name is the current filename of this script. # # $line_number is the line number on which the error # occurred. Note that it is essential that the line # number, stored in __LINE__ be passed through all levels # of subroutines so that the line number value will truly # represent the line number of the error and not the # line number of some subroutine for error handling. local ($type_of_error, $file_name, $line_number) = @_; local ($log_entry, $email_body, $variable, @env_vars); # The list of the HTTP environment variables are culled # into the @env_vars list array and get_date is used to # assign the current date to $date @env_vars = sort(keys(%ENV)); $date = &get_date; # Now, if the admin has instructed the script to log # errors by setting $sc_shall_i_log_errors in # agora.setup.db, the script will create an error log # entry. if ($sc_debug_mode eq "yes") { if ($sc_header_printed ne 1) { if ($sc_browser_header eq "") { $sc_browser_header = "Content/type: text/html;\n\n"; } print $sc_browser_header; } local($browser_text) = $type_of_error; $browser_text =~ s/\|/\\n/g; print '
' . "\n
";
print "ERROR:$browser_text
", "FILE: $file_name
", "LINE: $line_number
\n"; print '
' . "\n"; } if ($sc_shall_i_log_errors eq "yes") { # First, the new log entry row is created as a pipe # delimited list beginning with the error type, filename, # line number and current date. $log_entry = "$type_of_error\|FILE=$file_name\|LINE=$line_number\|"; $log_entry .= "DATE=$date\|"; # Then the error log file is opened securely by using the # lock file routines in get_file_lock discussed later. &get_file_lock("$sc_error_log_path.lockfile"); open (ERROR_LOG, ">>$sc_error_log_path") || &CgiDie ("The Error Log could not be opened"); # Now, the script adds to the log entry row, the values # associated with all of the HTTP environment variables # and prints the whole row to the log file which it then # closes and opens for use by other instances of this # script by removing the lock file. foreach $variable (@env_vars) { $log_entry .= "$variable: $ENV{$variable}\|"; } $log_entry =~ s/\n/
/g; # do not want newlines! print ERROR_LOG "$log_entry\n"; close (ERROR_LOG); &release_file_lock("$sc_error_log_path.lockfile"); # End of if ($sc_shall_i_log_errors eq "yes") } # Next, the script checks to see if the admin has # instructed it to also send an email error notification # to the admin by setting the $sc_shall_i_email_if_error # in agora.setup.db # # If so, it prepares an email with the same info contained # in the log file row and mails it to the admin using the # send_mail routine in mail-lib.pl. Note that a common # sourse of email errors lies in the admin not setting the # correct path for sendmail in mail-lib.pl on line 42. # Make sure that you set this variable there if you are # not receiving your mail and you are using the sendmail # version of the mail-lib package. if ($sc_shall_i_email_if_error eq "yes") { $email_body = "$type_of_error\n\n"; $email_body .= "FILE = $file_name\n"; $email_body .= "LINE = $line_number\n"; $email_body .= "DATE=$date\|"; foreach $variable (@env_vars) { $email_body .= "$variable = $ENV{$variable}\n"; } &send_mail("$sc_admin_email", "$sc_admin_email", "Web Store Error", "$email_body"); # End of if ($sc_shall_i_email_if_error eq "yes") } } ################################################################# # get_date Subroutine # ################################################################# # get_date is used to get the current date and time and # format it into a readable form. The subroutine takes no # arguments and is called with the following syntax: # # $date = &get_date; # # It will return the value of the current date, so you # must assign it to a variable in the calling routine if # you are going to use the value. sub get_date { local (@days, @months); local ($connector) = ' at '; @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday', 'Friday', 'Saturday'); @months = ('January','February','March','April','May','June','July', 'August','September','October','November','December'); return &get_date_engine; } sub get_date_short { local (@days, @months); local ($connector) = ' '; @days = ('Sun','Mon','Tue','Wed','Thu', 'Fri', 'Sat'); @months = ('Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep','Oct','Nov','Dec'); return &get_date_engine; } sub get_month_year { local (@days, @months); local ($connector) = ' at '; @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday', 'Friday', 'Saturday'); @months = ('January','February','March','April','May','June','July', 'August','September','October','November','December'); return &get_monthyear_engine; } sub get_date_engine { # The subroutine begins by defining some local working # variables local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,$date); # Next, it uses the localtime command to get the current # time, from the value returned by the time # command, splitting it into variables. ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); # Then the script formats the variables and assign them to # the final $date variable. if ($hour < 10) { $hour = "0$hour"; } if ($min < 10) { $min = "0$min"; } if ($sec < 10) { $sec = "0$sec"; } $year += 1900; $date = "$days[$wday], $months[$mon] $mday, $year" . $connector . "$hour\:$min\:$sec"; return $date; } sub get_monthyear_engine { # The subroutine begins by defining some local working # variables my ($sec,$min,$hour,$mday,$mon,$wday,$yday,$isdst); my ($month,$year); # Next, it uses the localtime command to get the current # time, from the value returned by the time # command, splitting it into variables. ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); # Then the script formats the variables and assign them to # the final $date variable. $year += 1900; $month = "$months[$mon]"; return ($mday,$month,$year); } ################################################################# # display_price Subroutine # ################################################################# # display_price is used to format the price string so that # the store can take into account differing methods for # displaying prices. For example, some countries use # "$xxx.yyy". Others may use "xx.yy UNIT". This # subroutine will use the $sc_money_symbol_placement and # the $sc_money_symbol variables defined in # agora.setup.db to format the entire price string for # display. The subroutine takes one argument, the price # to be formatted, and is called with the following # syntax: # # $price = &display_price(xx.yy); # # Where xx.yy is some number like 23.99. # # Note that the main routine calling this subroutine must # prepare a variable for the returned formatted price to # be assigned to. sub display_price { local ($price) = @_; local ($format_price); # set to 2 decimal places ... SPK 1/26/2000 $price = &format_price($price); if ($sc_money_symbol_placement eq "front") { $format_price = "$sc_money_symbol$sc_money_symbol_spaces$price"; } else { $format_price = "$price$sc_money_symbol_spaces$sc_money_symbol"; } return $format_price; } sub display_price_nospaces { local ($price) = @_; local ($holdme) = $sc_money_symbol_spaces; $sc_money_symbol_spaces=''; $price = &display_price($price); $sc_money_symbol_spaces = $holdme; return $price; } ####################################################################### # get_file_lock # ####################################################################### # get_file_lock is a subroutine used to create a lockfile. # Lockfiles are used to make sure that no more than one # instance of the script can modify a file at one time. A # lock file is vital to the integrity of your data. # Imagine what would happen if two or three people # were using the same script to modify a shared file (like # the error log) and each accessed the file at the same # time. At best, the data entered by some of the users # would be lost. Worse, the conflicting demands could # possibly result in the corruption of the file. # # Thus, it is crucial to provide a way to monitor and # control access to the file. This is the goal of the # lock file routines. When an instance of this script # tries to access a shared file, it must first check for # the existence of a lock file by using the file lock # checks in get_file_lock. # # If get_file_lock determines that there is an existing # lock file, it instructs the instance that called it to # wait until the lock file disappears. The script then # waits and checks back after some time interval. If the # lock file still remains, it continues to wait until some # point at which the admin has given it permissios to just # overwrite the file because some other error must have # occurred. # # If, on the other hand, the lock file has dissappeared, # the script asks get_file_lock to create a new lock file # and then goes ahead and edits the file. # # The subroutine takes one argumnet, the name to use for # the lock file and is called with the following syntax: # # &get_file_lock("file.name"); sub get_file_lock { local ($lock_file) = @_; local ($endtime); local ($exit_get_file_lock)=""; &codehook("get_file_lock"); if ($exit_get_file_lock ne "") {return;} $endtime = 55; # was 20 originally $endtime = time + $endtime; # We set endtime to wait 20 seconds. If the lockfile has # not been removed by then, there must be some other # problem with the file system. Perhaps an instance of # the script crashed and never could delete the lock file. while (-e $lock_file && time < $endtime) { sleep(1); } open(LOCK_FILE, ">$lock_file") || &CgiDie ("I could not open the lockfile - check your permission " . "settings ($lock_file)"); # Note: If flock is available on your system, feel free to # use it. flock is an even safer method of locking your # file because it locks it at the system level. The above # routine is "pretty good" and it will server for most # systems. But if youare lucky enough to have a server # with flock routines built in, go ahead and uncomment # the next line and comment the one above. # flock(LOCK_FILE, 2); # 2 exclusively locks the file } ####################################################################### # release_file_lock # ####################################################################### # release_file_lock is the partner of get_file_lock. When # an instance of this script is done using the file it # needs to manipulate, it calls release_file_lock to # delete the lock file that it put in place so that other # instances of the script can get to the shared file. It # takes one argument, the name of the lock file, and is # called with the following syntax: # # &release_file_lock("file.name"); sub release_file_lock { local ($lock_file) = @_; local ($exit_release_file_lock)=""; &codehook("release_file_lock"); if ($exit_release_file_lock ne "") {return;} # flock(LOCK_FILE, 8); # 8 unlocks the file # As we mentioned in the discussion of get_file_lock, # flock is a superior file locking system. If your system # has it, go ahead and use it instead of the hand rolled # version here. Uncomment the above line and comment the # two that follow. close(LOCK_FILE); unlink($lock_file); } ####################################################################### # format_price # ####################################################################### # format_price is used to format prices to two decimal # places. It takes one argumnet, the price to be formatted # and is called with the following syntax: # # $price =&format_price(xxx.yyyyy); # # Notice that the main calling routine must assign the # returned formatted price to some variable for its own # use. # # Also notice that this routine takes a value even if it # is longer than two decimal places and formats it with # rounding. Thus, you can utilize price calculations such # as 12.99 * 7.985 (where 7.985 might be some tax value. sub format_price { # The incoming price is set to a local variables and a few # wroking local variables are defined. local ($unformatted_price) = @_; local ($formatted_price); # The script then uses the rounding method in EXCEL. If # the 3rd decimal place is > 4, then we round the 2nd # decimal place up 1. Otherwise, we leave the number # alone. Notice that we will use the substr function to # pull off the last value in the three decimal place # number and compare it using the EXCEL logic. # # Basically, the routine uses the rounding rules of # sprintf. # The unformatted_price is rounded to # to two decimal places and returned to the calling # routine. $formatted_price = sprintf ("%.2f", $unformatted_price); return $formatted_price; } ############################################################ # # subroutine: format_text_field # Usage: # $formatted_value = # &format_text_field($value, [$width]); # # Parameters: # $value = text value to format. # $width = optional field width. Defaults to 25. # # This routine takes the value and appends enough # spaces so that the field width is 25 spaces. # in order to justify the fields that are stored # eventually in the $text_of_cart. # # Output: # The formatted value # ############################################################ sub format_text_field { local($value, $width) = @_; $width = 25 if (!$width); # Very simple. We return the value in # $value plus a string of 25 spaces which # has been truncated by the length of # the $value string. # # This results in a left justified # field of width = 25. # return ($value . (" " x ($width - length($value)))); #End of format_text_field } ########################################################################################### sub SetCookies { local(@test,$junk); ($cookie{'cart_id'},$junk) = split(/\*/,$cart_id,2); # Set the domain to be correct for your domain $domain = $sc_domain_name_for_cookie; # now, if there is only a two-parter domain name, add a leading period. @test = split(/\./,$domain); #if ($test[2] eq '') { $domain = '.' . $domain;} $secureDomain = $sc_secure_domain_name_for_cookie; @test = split(/\./,$secureDomain); #if ($test[2] eq '') { $secureDomain = '.' . $secureDomain;} # The path to your 'store' directory $path = $sc_path_for_cookie; $securePath = $sc_secure_path_for_cookie; # Leave this as is. $secure = ""; # Cookie will expire in 24 hours times the number of cookie days $now = time; # Second in twenty four hours $twenty_four_hours = "86400"; $cookie_hours = $sc_cookie_days * $twenty_four_hours; $expiration = $now+$cookie_hours;#number of days until cookie expires &codehook("about_to_set_cookie"); if(!$form_data{'secure'}){ &set_agora_cookies($expiration,$domain,$path,$secure); } else { &set_agora_cookies($expiration,$secureDomain,$securePath,$secure); } } ############################################################ sub checkReferrer { # BEGIN REPEATED PAGE LOADING TEST # referer check taken out in 4.0L local ($test_repeat,$raw_text); $test_repeat = 0; if ($sc_test_for_store_cart_change_repeats) { $test_repeat = $sc_test_repeat; } if (&get_agora("SSI_REDIRECT_OK") ne '') { &set_agora("SSI_REDIRECT_OK",''); $referringDomain = $acceptedDomain; } if ($test_repeat) { if ($sc_repeat_fake_it =~ /yes/i) { &repeat_fake_it; } else { $special_message = $messages{'chkref_01'}; &display_cart_contents; } } # END REFERRING SITE VALIDATION } ############################################################ sub repeat_fake_it { if ($form_data{'add_to_cart_button.x'} ne "") { &finish_add_to_the_cart; &call_exit; } elsif ($form_data{'submit_change_quantity_button.x'} ne "") { &finish_modify_quantity_of_items_in_cart; &call_exit; } elsif ($form_data{'submit_deletion_button.x'} ne "") { &finish_delete_from_cart; &call_exit; } else { $special_message = $messages{'chkref_01'}; &display_cart_contents; } } ############################################################ sub set_sc_cart_path { local($raw_text)=""; local($base)=""; # untaint cart_id ... plus set the original form data variable # just in case somebody mistakenly uses it later $cart_id =~ /([\w\-\=\+\/]+)\.(\w+)/; $cart_id = "$1.$2"; $form_data{'cart_id'} = $cart_id; # have already untainted $cart_id, this should be all we need to do $base = "$sc_user_carts_directory_path/"; $sc_cart_path = "$base${cart_id}_cart"; $sc_capture_path = "$base${cart_id}_CAPTURE"; $sc_server_cookie_path = "$base${cart_id}_COOKIES"; $sc_verify_order_path = "$base${cart_id}_VERIFY"; $cart_id_for_html = "$cart_id"; &load_server_side_cookies; $sc_test_repeat = 0; $raw_text = &get_agora('TRANSACTIONS'); if ($sc_unique_cart_modifier ne '') { if (!($raw_text =~ /$sc_unique_cart_modifier/)){ &set_agora('TRANSACTIONS', $raw_text . "$sc_unique_cart_modifier\n"); } else { $sc_test_repeat = 1; } } &codehook("set_sc_cart_path_bot"); return; } ####################################################################### # added by Mister Ed Aug 2005 to check server side cookies to determine if cart ID in link matches up sub check_server_cookies_first { my($base)=""; # untaint cart_id ... plus set the original form data variable # just in case somebody mistakenly uses it later $cart_id = $form_data{'cart_id'}; $cart_id =~ /([\w\-\=\+\/]+)\.(\w+)/; $cart_id = "$1.$2"; undef(%agora); undef(%agora_original_values); # have already untainted $cart_id, this should be all we need to do $base = "$sc_user_carts_directory_path/"; $sc_server_cookie_path = "$base${cart_id}_COOKIES"; if (-e "$sc_server_cookie_path" && -r "$sc_server_cookie_path"){ # file is there, now try to require it in a not-fatal way eval('require "$sc_server_cookie_path"'); } eval q~ use HTTP::BrowserDetect; my $browser = new HTTP::BrowserDetect($ENV{"HTTP_USER_AGENT"}); ~; if (($agora{'HTTP_USER_AGENT'} ne $ENV{'HTTP_USER_AGENT'}) || ($agora{'BUYSAFE_ORDER_COMPLETED'} eq 'yes')) { &assign_a_unique_shopping_cart_id; } return; } ####################################################################### sub zcode_error { local ($ZCODE,$at,$file,$line)=@_; local ($xx)="-" x 60; $ZCODE =~ s/\n/\|/g; $at =~ s/\n/\|/g; &update_error_log("zcode compilation error: |$at|$ZCODE|$xx", $file,$line); &call_exit; } ####################################################################### # For running codehooks at various places ####################################################################### sub codehook{ local($hookname)=@_; local($codehook,$err_code,@hooklist); if ($codehooks{$hookname} ne "") { @hooklist = split(/\|/,$codehooks{$hookname}); foreach $codehook (@hooklist) { eval("&$codehook;"); $err_code = $@; if ($err_code ne "") { #script died, error of some kind &update_error_log("code-hook $hookname $codehook $err_code","",""); } } } } ####################################################################### # For adding codehooks to the list for later execution ####################################################################### sub add_codehook{ local($hookname,$sub_name)=@_; local($codehook,$err_code,@hooklist); if ($sub_name eq "") { return;} @hooklist = split(/\|/,$codehooks{$hookname}); foreach $codehook (@hooklist) { if ($codehook eq $sub_name) { # already on the list, no need to add return; } } if ($codehooks{$hookname} eq "") { $codehooks{$hookname} = $sub_name; } else { $codehooks{$hookname} .= "|" . $sub_name; } } ####################################################################### sub replace_codehook{# replace ALL hooks with the value provided local($hookname,$sub_name)=@_; $codehooks{$hookname} = $sub_name; } ####################################################################### sub agora_starter_section { &get_cookie; &alias_and_override; &error_check_form_data; $cart_id = $form_data{'cart_id'}; # help with robots hitting site. Beta and may not work. Added by Mister Ed August 16, 2006 eval q~ use HTTP::BrowserDetect; my $browser = new HTTP::BrowserDetect($ENV{"HTTP_USER_AGENT"}); if ($browser->robot()) { $cart_id = ""; #$cart_id = "9999999.99999"; $form_data{'cart_id'} = ""; #$form_data{'cart_id'} = "9999999.99999"; $cookie{'cart_id'} = ""; #$cookie{'cart_id'} = "9999999.99999"; &set_agora("BOT",1); $sc_global_bot_tracker = '1'; &set_agora("BROWSER",$browser->browser_string().'/'.$browser->version()); } ~; #updated by Mister Ed Aug 2005 #reduces inheritances in sharing URLs with Cart IDs #resolves 95% or so of the problems. IF same exact browser and configs, then can be seen/shared possibly if ($sc_global_bot_tracker ne "1") { # run only if not a bot if ($cookie{'cart_id'} eq "" && $form_data{'cart_id'} eq "") { # new visitor &assign_a_unique_shopping_cart_id; $cart_id_history .= "set new cart value "; #for debugging of course &codehook("got_a_new_cart"); } elsif (($form_data{'cart_id'} eq "" && $cookie{'cart_id'} ne "")||($cookie{'cart_id'} eq $form_data{'cart_id'})) { # returning visitor without Cart ID in link or both match $cart_id = $cookie{'cart_id'}; $cart_id_history .= "from cookie "; #for debugging of course &set_sc_cart_path; &codehook("got_a_old_cart_from_cookie"); } else { if (($form_data{'cart_id'} ne "") && ($cookie{'cart_id'} ne $form_data{'cart_id'}) && (!$ENV{'HTTPS'})) { # both are Cart ID in link and Cookie exists. Not SSL, allowance for shared SSL &check_server_cookies_first; } else { # fail safe $cart_id = $form_data{'cart_id'}; $cart_id_history .= "set from form data "; #for debugging of course &set_sc_cart_path; } } } # end of if not a bot if ($sc_buySafe_is_enabled =~ /yes/) { my $temp_buysafe_check = &get_agora('BUYSAFE_ORDER_COMPLETED'); if ($temp_buysafe_check eq 'yes') { &assign_a_unique_shopping_cart_id; } } &pre_header_navigation; print $sc_cookie_information; print $sc_browser_header; $sc_header_printed = 1; #print "cart_id: $cart_id $cart_id_for_html $cart_id_history
\n";# debugging $are_any_query_fields_filled_in = "no"; } ####################################################################### sub my_die { local ($msg) = @_; if ($sc_in_throes_of_death eq "yes") {die $msg;} $sc_in_throes_of_death="yes"; &call_exit; die $msg; } ####################################################################### # Cart Links Sub Routine # # cartlinks added by Mister Ed of AgoraCart.com 09/2002 # edited by Mister Ed of AgoraCart.com 09/2007 # # cart link routine reads all thew .htm and .html files in the store's html sub directory. # Agora Script is then placed on files such as static pages, headers, footers, etc that # will place the links built within the $cartlinks variable. scripting can also be used to change # the layout of the links built below. the cartlinks token %%cartlinks%% can also be used # to place the links into a page in the format they are built below. # # will not build links for pages called: index, frontpage, or error. ####################################################################### # Completely overhauled the html and links formation in this sub. # Added the title attribute to the links for SEO. my (@clinknames); my ($page2_extension, $clinkname); sub cartlinks { if ($cartlinks eq '') { $cartlinks = "
"; close (PAGES); } &codehook("cartlinks_bottom"); } ######################################################################## # For XSS cleanup purposes. XSS doesn't get in anyways, but cleans up any # residual code thingies. PERL taint and special security routines already block # XSS stuff. Added by Mister Ed at K-Factor Technologies, Inc. on Dec 12, 2006 ######################################################################## sub xss_FormData_cleaner { my $temp = ''; codehook("xss_FormData_cleaner_top"); for $xx (keys %form_data) { $temp = $form_data{$xx}; if ($form_data{$xx} ne '') { if (($temp =~ /((<)(script|object|java|vbscript|img|embed|iframe|frameset))/i) || ($temp =~ /script>|src=|\.js|\.cgi|\.pl|document\.|vbscript|\.cookie|\.jsp|\.asp|\.php|javascript|eval\(|\`/i)) { if (($xx eq "cart_id") || ($xx eq "page")) { $form_data{$xx} = ''; } else { delete($form_data{$xx}); } } else { $temp =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($temp))/ge; # debuging purposes # print "Content-type: text/html\n\n
$temp - $xx - $form_data{$xx}
"; # # code below finds tags: or in either hex or alpha - not used currently #if ((($temp =~ /((\%3C)|<)((\%2F)|\/)*[a-z0-9\%]+((\%3E)|>)/ix) { if (($temp =~ /((<)(script|object|java|vbscript|img|embed|iframe|frameset))/i) || ($temp =~ /script|src=|\.js|\.cgi|\.pl|vbscript|document\.|\.cookie|\.jsp|\.asp|\.php|\.css|javascript|java|eval\(|\`/i)) { if (($xx eq "cart_id") || ($xx eq "page")) { $form_data{$xx} = ''; } else { delete($form_data{$xx}); } } } } } } ############ sub xss_killer { my $temp = ''; codehook("xss_killer_top"); for $xx (keys %form_data) { $temp =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($form_data{$xx}))/ge; if ((($temp =~ /((<)(script|object|java|vbscript|img|embed|iframe|frameset))/i) || ($temp =~ /script|src=|\.js|\.cgi|\.pl|document\.|\.cookie|\.jsp|\.asp|\.php|\.css|javascript|java|vbscript/i)) && ($xx ne "cart_id")) { delete($form_data{$xx}); } } } ####################################################################### # For cleanup purposes such as closing files, removing locks, etc. ####################################################################### sub call_exit { &require_supporting_libraries(__FILE__,__LINE__,"./library/agora_html_lib.pl"); &agora_cookie_save; codehook("cleanup_before_exit"); if ($sc_in_throes_of_death ne "yes") { exit; } } # End of agora.cgi