' . "\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 .= "$ENV{$variable}\|"; } 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") } } `; if ($@ ne '') { print "Content-type: text/html;\n\nBAD update_error_log routine!\n"; } } &SUB_update_error_log; } ################################################################# # 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_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; } ################################################################# # 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); $cookie{'cart_id'} = "$cart_id"; # 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_cookie($expiration,$domain,$path,$secure); } else { &set_cookie($expiration,$secureDomain,$securePath,$secure); } } ############################################################ sub checkReferrer { # BEGIN REFERRING SITE VALIDATION and REPEATED PAGE LOADING local ($referringDomain, $acceptedDomain); local ($test_repeat,$raw_text); $referringDomain = $ENV{'HTTP_REFERER'}; $acceptedDomain = $sc_domain_name_for_cookie; $referringDomain =~ s/\?.*//g; $referringDomain =~ s/http:\/\///g; $referringDomain =~ s/https:\/\///g; $referringDomain =~ s/\/.*//g; $referringDomain =~ s/\/agora.cgi//g; if ($referringDomain =~ "^w*\.") { $referringDomain =~ s/^w*\.//i; } if ($acceptedDomain =~ "^w*\.") { $acceptedDomain =~ s/^w*\.//i; } $test_repeat = 0; if ($sc_test_for_store_cart_change_repeats) { $test_repeat = $sc_test_repeat; } if (($referringDomain ne $acceptedDomain) || ($test_repeat)) { if ($test_repeat) { if ($sc_repeat_fake_it =~ /yes/i) { &repeat_fake_it; } else { $special_message = $messages{'chkref_01'}; &display_cart_contents; } } elsif ($cart_id == $cookie{'cart_id'}) { # okay to show the stuff ... $special_message = $messages{'chkref_02'}; &display_cart_contents; } else { print "$acceptedDomain is the accepted referrer.
"; print "$referringDomain is not a valid referrer
"; print $messages{'chkref_03'}; } &call_exit; } # 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)=""; # 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_verify_order_path = "$base${cart_id}_VERIFY"; $sc_trans_rec_path = "$base${cart_id}_TRANSLOG"; $cart_id_for_html = "$cart_id*" . &make_random_chars; # deprecated! &check_cart_expiry; $sc_test_repeat = 0; if (-f $sc_trans_rec_path) { open(TRANS_FILE, "<$sc_trans_rec_path") || &file_open_error( "$sc_trans_rec_path", "Reading TRANS LOG", __FILE__,__LINE__); local $/=undef; $raw_text = ; close(TRANS_FILE); } else { $raw_text=""; } if (!($raw_text =~ /$sc_unique_cart_modifier/)){ open (TRANS_FILE, ">>$sc_trans_rec_path") || &file_open_error( "$sc_trans_rec_path", "Trans Repeat Write", __FILE__,__LINE__); if ($sc_unique_cart_modifier ne "") { print TRANS_FILE "$sc_unique_cart_modifier\n"; } close(TRANS_FILE); } else { $sc_test_repeat = 1; } &codehook("set_sc_cart_path_bot"); return; } ####################################################################### sub cart_id_for_html{ # nice and simple ... append random chars as tag return "$cart_id*" . &make_random_chars; } ####################################################################### 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 my_die { local ($msg) = @_; if ($sc_in_throes_of_death eq "yes") {die $msg;} $sc_in_throes_of_death="yes"; &call_exit; die $msg; } ####################################################################### # For cleanup purposes such as closing files, removing locks, etc. ####################################################################### sub call_exit { codehook("cleanup_before_exit"); if ($sc_in_throes_of_death ne "yes") { exit; } } # End of agora.cgi