712147; my $sADF01 = 'shop@wolvertonrail.com'; my $sADF02 = 'lAX3hTSVnY9yhnW7xzrNNZhWqMMHgXjqpS72r7FpAPeCuBJETWCBL0S8pAS'; my $sADF03 = ''; my $sADF04 = ''; my $sADF05 = ''; my $sADFDump = '020102800000008000000000B731D5E9B03594EEF01246C8ABD2EF59A459E303D8BC0273E4C33EEDE0294830C6F921E11BECB580DC5FDDBA76A0658770A003BE2091A32610924CF591B7FD5B60E2BAE084F4C0C24A76E3F299E9E4B8B3FCB1463D90FA13E98BF2D607C681BBDAC26070D45C4FFEE68021281ED87D253051026B58794F3CB96490AA29154A25A06D0247A36DF3F98D1A8798C66F2D590D31C5C67E6882949BEEE81B74321595F4E97ADCAB06F1DC86A847DA3BC3E9A6F5B33C6C1738C927A2E8CF3D589AC8740EB719C32DFF23AFCE47A055719085F7C357A692FB584325948C901B368E47866768C5DD4E3AB35DD466F27BC2BD4F4AAAC55E3C19F4D198723DEEB3D75F6605'; # my $sProcessScriptURL = 'https://www.paypal.com/cgi-bin/webscr'; $::sPlugInScriptError = ""; # used to return error message if any my ($sStatus, $sMessage) = ProcessAuthoriseCallBack(); # do the post authorisation if ($sStatus != $::SUCCESS) { $::sPlugInScriptError = $sMessage; # error will be logged to error.err by calling method } return ($::SUCCESS); sub ProcessAuthoriseCallBack { # # Get the script URL and split it into server and path+script # $sProcessScriptURL =~ /\/\/(.*?)(\/.*$)/; my $sServer = $1; my $sScript = $2; # # PayPal post's it's data so let's read it here if necessary # my ($status, $sError, $pmapInputNameToValue, $sPostedData) = ReadPostData(); if ($status != $::SUCCESS) { # # Send the error message to PSP # ACTINIC::PrintPSPResponse('text/plain', $sError, '500 Internal Server Error'); # tell PSP the request failed and why return ($::FAILURE, $sError); } if (0 == scalar keys %$pmapInputNameToValue) # if the POST data is empty, it was already read { $sError = "No POSTED data received."; ACTINIC::PrintPSPResponse('text/plain', $sError, '500 Internal Server Error'); # tell PSP the request failed and why return ($::FAILURE, $sError); } # # Pass along the callback for confirmation to paypal. # my ($sHttpStatus, $sHttpResponse); $sPostedData .= '&cmd=_notify-validate'; ($status, $sError, $sHttpResponse) = ACTINIC::HTTPS_SendAndReceive($sServer, 443, $sScript, $sPostedData, 'POST'); if ($status != $::SUCCESS) { ACTINIC::PrintPSPResponse('text/plain', $sError, '500 Internal Server Error'); # tell PSP the request failed and why return ($::FAILURE, $sError); } # # Split the HTTP response up # $sHttpResponse =~ m/.*?HTTP.*?\s(\d+)(.*)$/is; $sHttpStatus = $1; $sHttpResponse = $2; if ($sHttpStatus != 200) # not OK { $sError = sprintf("%s:%s", $sHttpStatus, $sHttpResponse); ACTINIC::PrintPSPResponse('text/plain', $sError, '500 Internal Server Error'); return ($::FAILURE, $sError); } # # If the response is bad, abort # if ($sHttpResponse !~ /VERIFIED/) { ACTINIC::PrintPSPResponse('text/plain', "OK-$sHttpResponse"); return ($::FAILURE, "Invalid PayPal verification response \"$sHttpResponse\""); } my $bPreAuthorise = $::FALSE; # # Note if this is a Pending Authorisation callback # if (($pmapInputNameToValue->{payment_status} eq "Pending") && ($pmapInputNameToValue->{pending_reason} eq "authorization")) { $bPreAuthorise = $::TRUE; } # # Otherwise if this callback is not noting the payment status as "complete", we are done for now - only record "completes" # elsif ($pmapInputNameToValue->{payment_status} ne "Completed") { my ($sPPMessage); $sPPMessage = "PayPal payment status: " . $pmapInputNameToValue->{payment_status}; # # if there is pending reason, then print it too. # if (length $pmapInputNameToValue->{pending_reason}) { $sPPMessage .= ", Pending reason: " . $pmapInputNameToValue->{pending_reason}; } ACTINIC::PrintPSPResponse('text/plain', "OK-$sPPMessage"); return ($::SUCCESS); } # # Ok so now we know we have a transaction so we'll cherry-pick the bits we want # my $sActinicFormatOriginalData = 'PATH=' . $::sPath; # # Add the order number # $sActinicFormatOriginalData .= '&ON=' . $pmapInputNameToValue->{invoice}; # # if the payment was not made in USD then the amountis in the mc_gross # my ($nActAmount); if (length $pmapInputNameToValue->{payment_gross}) { $nActAmount = $pmapInputNameToValue->{payment_gross}; } else { $nActAmount = $pmapInputNameToValue->{mc_gross}; } # # Add the amount # $sActinicFormatOriginalData .= '&AM=' . $nActAmount * 100; # bit of a hack $sActinicFormatOriginalData .= '&x_amount=' . $nActAmount; # # Add the transaction_id # $sActinicFormatOriginalData .= '&CD=' . $pmapInputNameToValue->{txn_id}; # # Get the current date/time on the server # my ($sDate) = ACTINIC::GetActinicDate($::TRUE); ($sDate) = ACTINIC::EncodeText2($sDate, $::FALSE); # # Add the transaction date # $sActinicFormatOriginalData .= '&DT=' . $sDate; # # Add the test mode flag if supplied # if(defined $::g_InputHash{TM}) { $sActinicFormatOriginalData .= '&TM=' . $::g_InputHash{TM}; } # # Add the pre-authorisation flag # $sActinicFormatOriginalData .= "&PA=" . ($bPreAuthorise ? "1" : "0"); # # Add the transaction ID # $sActinicFormatOriginalData .= '&TX=' . $pmapInputNameToValue->{txn_id}; $sActinicFormatOriginalData .= '&x_trans_id=' . $pmapInputNameToValue->{txn_id}; # # if the payment was not made in USD then the currency is in the mc_currency # my ($nActCurrency); if (length $pmapInputNameToValue->{currency_code}) { $nActCurrency = $pmapInputNameToValue->{currency_code}; } else { $nActCurrency = $pmapInputNameToValue->{mc_currency}; } # # The currency # $sActinicFormatOriginalData .= '&CU=' . $nActCurrency; # # Create a bogus signature line # $sActinicFormatOriginalData .= '&SN=000'; # # This block of code isolates the plug-in scripts from version specific code that they have historically used # BEGIN undef $sError; if (defined $::EC_MAJOR_VERSION) # EC version 6 or greater { $sError = RecordAuthorization(\$sActinicFormatOriginalData); } else # Pre-version 6 { # # Fool RecordAuthorization by ditching the original input string # $::g_OriginalInputData = $sActinicFormatOriginalData; $sError = RecordAuthorization(); } # END # This block of code isolates the plug-in scripts from version specific code that they have historically used # if (length $sError != 0) # if there were any errors, { ACTINIC::PrintPSPResponse('text/plain', $sError, '500 Internal Server Error'); return ($::FAILURE, $sError); } else { ACTINIC::PrintPSPResponse('text/plain', "OK"); } return ($::SUCCESS, ""); } ####################################################### # # ReadPostData - read the posted data. It is still in # the queue because the Actinic code only expects # GET or POST data, but not both and it handles GET # first. # # Expects: $::ENV{CONTENT_LENGTH} to be defined # STDIN to contain the POST data # # Returns: 0 - status # 1 - error if any # 2 - reference to hash containing PayPal parameters # 3 - the raw posted data string # ####################################################### sub ReadPostData { my ($InputData, $nInputLength, $nStep, $InputBuffer); $nInputLength = 0; $nStep = 0; while ($nInputLength != $::ENV{'CONTENT_LENGTH'}) # read until you have the entire chunk of data { # # read the input # binmode STDIN; $nStep = read(STDIN, $InputBuffer, $ENV{'CONTENT_LENGTH'}); # read POSTed data $nInputLength += $nStep; # keep track of the total data length $InputData .= $InputBuffer; # append the latest chunk to the total data buffer if (0 == $nStep) # EOF { last; # stop read } } if ($nInputLength != $ENV{'CONTENT_LENGTH'}) { return ($::FAILURE, "Bad input. The data length actually read ($nInputLength) does not match the length specified " . $ENV{'CONTENT_LENGTH'} . "\n", undef, undef); } $InputData =~ s/&$//; # loose any bogus trailing &'s # # Parse the input # my (@listNameValues); @listNameValues = split (/[&=]/, $InputData); # break the input into key/values if ($#listNameValues % 2 != 1) # if there is an unmatched value, it is a trailing = which means the value is undef { push @listNameValues, undef; } # # Decode the input # my %EncodedInput = @listNameValues; # map the input key/values to a hash = note that this doesn't work for things like mult-select lists but we don't have to worry about that here my ($key, $value); my %mapNameToValue; while (($key, $value) = each %EncodedInput) { $mapNameToValue{DecodeText($key)} = DecodeText($value); } return ($::SUCCESS, undef, \%mapNameToValue, $InputData); } ####################################################### # # DecodeText - decode the CGI FORM encoding # # Inputs: 0 - string to decode # # Returns: decoded string # ####################################################### sub DecodeText { my ($sString) = @_; $sString =~ s/\+/ /g; # replace + signs with the spaces they represent $sString =~ s/%([A-Fa-f0-9]{2})/pack('c',hex($1))/ge; # Convert %XX from hex numbers to character equivalent return $sString; } return ($::SUCCESS); # # End of File