diff --git a/cgi/procdonate.cgi b/cgi/procdonate.cgi
index 13b9bf4..55726c0 100755
--- a/cgi/procdonate.cgi
+++ b/cgi/procdonate.cgi
@@ -1,1172 +1,1173 @@
#!/usr/bin/perl -T
# procdonate.cgi - Donation payment processor for gnupg.org
# Copyright (C) 2014 g10 Code GmbH
#
# This file is free software; as a special exception the author gives
# unlimited permission to copy and/or distribute it, with or without
# modifications, as long as this notice is preserved.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
use strict;
#use CGI qw/:standard -debug/;
use CGI;
use Cwd qw(realpath);
use IO::Socket::UNIX;
realpath($0) =~ /^(.*)\/.*$/;
my %config = do $1 . '/config.rc';
$ENV{PATH} = "/bin:/usr/bin";
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
my $baseurl = $config{baseurl};
my $htdocs = $config{htdocs};
my $stripepubkey = $config{stripepubkey};
my $socket_name = $config{payprocd_socket};
my $error_marker = '* error';
# The form variables are accessed via Q.
my $q = new CGI;
# This is a multi-purpose CGI. The mode decides what to do.
my $mode = $q->param("mode");
my $sessid = $q->param("sessid");
my $lang = $q->param("lang");
# Variables used in the template pages.
my $amount = "";
my $paytype = "";
my $stripeamount = "";
my $euroamount = "";
my $currency = "";
my $recur = "";
my $name = "";
my $mail = "";
my $message = "";
my $separef = "";
my $sepaqr = "";
my $errorstr = "";
my $notepanel = "";
# We use a dictionary to track error. Those errors will then be
# inserted into the output by write_template.
my %errdict = ();
# Prototypes
sub fail ($);
sub get_paypal_approval ();
sub complete_sepa ();
# Write a template file. A template is a proper HTML file with
# variables enclosed in HTML comments. To allow inserting data into
# a value attribute of an input field, such a tag needs to be written as
#
# the result after processing will be
#
# assuming that the value of FOO is foo. Note that this substitution
# rules work for all tags and thus you better take care to add an
# extra space if you do not want this to happen.
sub write_template ($) {
my $fname = shift;
my $tname;
my $errorpanel = $errorstr;
my $err_amount = '';
my $err_name = '';
my $err_mail = '';
my $err_paytype = '';
my $check_checked = ' checked="checked"';
my $sel_eur = '';
my $sel_usd = '';
my $sel_gbp = '';
my $sel_jpy = '';
my $chk_amt500 = '';
my $chk_amt200 = '';
my $chk_amt100 = '';
my $chk_amt50 = '';
my $chk_amt20 = '';
my $chk_amt10 = '';
my $chk_amt5 = '';
my $chk_amtx = '';
my $amt_other = '';
my $recur_none = '';
my $recur_month = '';
my $recur_quarter = '';
my $recur_year = '';
my $recur_text = '';
my $message_fmt;
my $publishname;
my $check_paytype = 'none';
my $stripe_data_email = '';
my $stripe_data_label_value;
my $xamount;
my $stripelocale;
# Avoid broken HTML attributes.
$amount =~ s/\x22/\x27/g;
$stripeamount =~ s/\x22/\x27/g;
$currency =~ s/\x22/\x27/g;
$recur =~ s/\x22/\x27/g;
$name =~ s/\x22/\x27/g;
$mail =~ s/\x22/\x27/g;
$message =~ s/\x22/\x27/g;
$separef =~ s/\x22/\x27/g;
$lang =~ s/\x22/\x27/g;
# Clean possible user provided data
$sessid =~ s/\x26lt;/g;
$lang =~ s/\x26lt;/g;
$amount =~ s/\x26lt;/g;
$stripeamount =~ s/\x26lt;/g;
$currency =~ s/\x26lt;/g;
$recur =~ s/\x26lt;/g;
$name =~ s/\x26lt;/g;
$mail =~ s/\x26lt;/g;
$message =~ s/\x26lt;/g;
$separef =~ s/\x26lt;/g;
# No need to clean $euroamount.
# Check whether a translated template is available.
$tname = $htdocs . $fname;
$tname =~ s/\.html$/.$lang.html/;
if ( not -f $tname ) { $tname = $htdocs . $fname; }
# Create a formatted message.
$message_fmt = $message;
$message_fmt =~ s/\n/
/g;
# Check the currency and predefined amount.
if ( $currency =~ /EUR/i ) {
$sel_eur = ' selected="selected"';
$chk_amtx = $check_checked;
$amt_other = $amount;
} elsif ( $currency =~ /USD/i ) {
$sel_usd = ' selected="selected"';
$chk_amtx = $check_checked;
$amt_other = $amount;
} elsif ( $currency =~ /GBP/i ) {
$sel_gbp = ' selected="selected"';
$chk_amtx = $check_checked;
$amt_other = $amount;
} elsif ( $currency =~ /JPY/i ) {
$sel_jpy = ' selected="selected"';
$chk_amtx = $check_checked;
$amt_other = $amount;
} else {
$chk_amtx = $check_checked;
$amt_other = $amount;
}
# For non-recurring Stripe donations we do not want to send a
# data-email="$mail"
# line to Stripe so to enable the user to use a a different mail
# address for use with them. This is implemented using a
# STRIPE_DATA_EMAIL template variable.
$stripe_data_email = 'data-email="' . $mail . '"';
if ( $recur =~ /0/ ) {
$stripe_data_email = '';
$recur_none = ' selected="selected"';
$recur_text = '';
if ($lang eq 'de') {
$stripe_data_label_value = 'Einmalig spenden';
} elsif ($lang eq 'fr') {
$stripe_data_label_value = 'Faire un don unique';
} elsif ($lang eq 'ja') {
$stripe_data_label_value = '一回の寄付する';
} else {
$stripe_data_label_value = 'Make one-time donation';
}
} elsif ( $recur =~ /12/ ) {
$recur_month = ' selected="selected"';
if ($lang eq 'de') {
$recur_text = 'monatlich';
$stripe_data_label_value = 'Monatlich spenden';
} elsif ($lang eq 'fr') {
$recur_text = 'mensuels';
$stripe_data_label_value = 'Faire un don mensuel';
} elsif ($lang eq 'ja') {
$recur_text = '毎月';
$stripe_data_label_value = '毎月寄付する';
} else {
$recur_text = 'monthly';
$stripe_data_label_value = 'Donate monthly';
}
} elsif ( $recur =~ /4/ ) {
$recur_quarter = ' selected="selected"';
if ($lang eq 'de') {
$recur_text = 'vierteljährlich';
$stripe_data_label_value = 'Vierteljährlich spenden';
} elsif ($lang eq 'fr') {
$recur_text = 'trimestriels';
$stripe_data_label_value = 'Faire un don trimestriel';
} elsif ($lang eq 'ja') {
$recur_text = '3ヶ月毎';
$stripe_data_label_value = '3ヶ月毎に寄付する';
} else {
$recur_text = 'quarterly';
$stripe_data_label_value = 'Donate quarterly';
}
} elsif ( $recur =~ /1/ ) {
$recur_year = ' selected="selected"';
if ($lang eq 'de') {
$recur_text = 'jährlich';
$stripe_data_label_value = 'Jährlich spenden';
} elsif ($lang eq 'fr') {
$recur_text = 'annuels';
$stripe_data_label_value = 'Faire un don annuel';
} elsif ($lang eq 'ja') {
$recur_text = '毎年';
$stripe_data_label_value = '毎年寄付する';
} else {
$recur_text = 'yearly';
$stripe_data_label_value = 'Donate yearly';
}
} else { # invalid
$stripe_data_label_value = '';
}
if ( $paytype eq "cc" ) {
$check_paytype = "CC";
} elsif ( $paytype eq "pp" ) {
$check_paytype = "PP";
} elsif ( $paytype eq "se" ) {
$check_paytype = "SE";
} elsif ( $paytype eq "bc" ) {
$check_paytype = "BC";
}
# Set var for the paypal button
if ( $name eq 'Anonymous' or $name eq '') {
$publishname = 'No';
} else {
$publishname = 'Yes';
}
# Set a specific locale.
if ($lang eq 'de') { $stripelocale = "de"; }
elsif ($lang eq 'fr') { $stripelocale = "fr"; }
elsif ($lang eq 'ja') { $stripelocale = "ja"; }
elsif ($lang eq 'en') { $stripelocale = "en"; }
else { $stripelocale = "auto"; }
# Build error strings.
foreach (keys %errdict)
{
my $fieldname;
if ($lang eq 'de') { $fieldname = "Feld $_: "; }
elsif ($lang eq 'fr') { $fieldname = "Champ $_: "; }
elsif ($lang eq 'ja') { $fieldname = "欄 $_: "; }
else { $fieldname = "Field $_: "; }
if (/amount/) { $err_amount = $error_marker; }
elsif (/name/) { $err_name = $error_marker; }
elsif (/mail/) { $err_mail = $error_marker; }
elsif (/paytype/){ $err_paytype = $error_marker; }
$errorpanel = $errorpanel . $fieldname . $errdict{$_} . "
\n"
}
if ( $errorpanel ne '' ) {
$errorpanel =
"
\n" . $errorpanel . "
\n" . $notepanel . "
The system is currently processing too many requests.
' . 'Please retry later.
'; &write_template("donate/error.html"); } sub write_cancel_page () { print $q->header(-type=>'text/html', -charset=>'utf-8'); print "\n"; &write_template("donate/paypal-can.html"); } # Write an internal error page sub fail ($) { my $desc = shift; # FIXME: write the detailed error only to the log. print $q->header(-type=>'text/html', -charset=>'utf-8'); print "\n"; $errorstr = 'An internal error occured:
' . "$desc
"; write_template("donate/error.html"); exit 0; } # Write a the initial donation page. This is usallay done to show # errors. The page is intially shown as static page. sub write_main_page () { print $q->header(-type=>'text/html', -charset=>'utf-8'); print "\n"; write_template("donate/donate.html"); } # Write a page with all the data inserted. sub write_checkout_page () { print $q->header(-type=>'text/html', -charset=>'utf-8'); print "\n"; if ( $paytype eq "cc" ) { write_template("donate/checkout-cc.html"); } elsif ( $paytype eq "pp" ) { write_template("donate/checkout-pp.html"); } elsif ( $paytype eq "bc" ) { # For Bitcoins this is the final page write_template("donate/checkout-bc.html"); } else { # For SEPA this is the final page write_template("donate/checkout-se.html"); } } # Write the final thank you page. sub write_thanks_page () { print $q->header(-type=>'text/html', -charset=>'utf-8'); print "\n"; write_template("donate/donate-thanks.html"); } # Check the values entered at the donation page. Return true if # everything is alright. On error the donation page is send again. sub check_donation () { my %data; my %sepa; my $anyerr = 0; my $msg; $amount = $q->param("amount"); if ($amount eq 'other') { # backward compatibility $amount = $q->param("amountother"); } $currency = $q->param("currency"); $recur = $q->param("recur"); $name = $q->param("name"); $name = 'Anonymous' if $name eq ''; $mail = $q->param("mail"); $message = $q->param("message"); $stripeamount = "0"; $paytype = $q->param("paytype"); # Check the amount and the recurring value unless Bitcoins are # selected. if ( $paytype ne "bc" ) { # Note that we only use full Euro/USD/etc from the amount to avoid # problems with ',' and '.' decimal separators. $data{"Amount"} = int $amount; $data{"Currency"} = $currency; $data{"Recur"} = $recur; if (not payproc ('CHECKAMOUNT', \%data )) { $errdict{"amount"} = $data{"ERR_Description"}; $anyerr = 1; } $stripeamount = $data{"_amount"}; $amount = $data{"Amount"}; $recur = $data{"Recur"}; $currency = $data{"Currency"}; $euroamount = $data{"Euro"}; # Check that at least some Euros are given. Due to Stripe # processing fees and our own costs for bookkeeping we need to ask # for a minimum amount. if ( (not $anyerr) and ($euroamount < 4.00) ) { if ($lang eq 'de') { $msg= 'Um unsere Verwaltungskosten niedrig zu halten,' . 'können wir leider keine Spenden unter 4 Euro annehmen.'; } elsif ($lang eq 'fr') { $msg = 'Désolé, en raison des frais généraux nous ne pouvons' . ' pas accepter les donations de moins de 4 euros.'; } elsif ($lang eq 'ja') { $msg = '申し訳ありません。間接経費のため、4ユーロ未満の寄付' . 'は受け付けることができません。'; } else { $msg = 'Sorry, due to overhead costs we do' . ' not accept donations of less than 4 Euro.'; } $errdict{"amount"} = $msg; $anyerr = 1; } } # Check the payment type if ( $paytype eq "bc" ) { # No further checks - this is kind of a hack. } elsif ( $paytype ne "cc" and $paytype ne "pp" and $paytype ne "se" ) { if ($lang eq 'de') { $msg= 'Keine Zahlungsart angegeben.' . ' Bitte "Kreditkarte", "PayPal" oder "SEPA" auswählen.'; } elsif ($lang eq 'fr') { $msg= 'Aucun type de paiement sélectionné.' . ' Les options sont "Carte de crédit", "PayPal", ou bien "SEPA".'; } elsif ($lang eq 'ja') { $msg= '支払い方式が選択されていません。' . '"クレジットカード", "PayPal", または "SEPA" が選択できます。'; } else { $msg= 'No payment type selected.' . ' Use "Credit Card", "PayPal", or "SEPA".'; } $errdict{"paytype"} = $msg; $anyerr = 1; } # SEPA credit transfers are only possible in Euro. # (yes, this may overwrite an earlier error message). if ( $paytype eq "se" and $currency ne "EUR" ) { $errdict{"amount"} = 'SEPA transfers are only possible in EUR.'; $anyerr = 1; } # Check the mail address if ($mail ne '' and $mail !~ /\S+@\S+\.\S+/ ) { $errdict{"mail"} = 'invalid mail address'; $anyerr = 1; } # If needed present errors and ask again. */ if ($anyerr) { write_main_page(); return; } # Now create a session. $data{"Lang"} = $lang; $data{"Stripeamount"} = $stripeamount; $data{"Euroamount"} = $euroamount; $data{"Recur"} = $recur; $data{"Name"} = $name; $data{"Mail"} = $mail; $data{"Message"} = $message; $data{"Paytype"} = $paytype; payproc ('SESSION create', \%data ) or fail $data{"ERR_Description"}; $sessid = $data{"_SESSID"}; # Send the checkout page or redirect to paypal if ( $paytype eq "pp" ) { get_paypal_approval (); } elsif ( $paytype eq "se" ) { complete_sepa (); } else { write_checkout_page(); } } # This simply resends the main page again. sub resend_main_page () { my %data; payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"}; # If the session has a lang value use that. if ($data{"Lang"} ne '') { $lang = $data{"Lang"}; } $amount = $data{"Amount"}; $currency = $data{"Currency"}; $recur = $data{"Recur"}; $paytype = $data{"Paytype"}; $stripeamount = $data{"Stripeamount"}; $euroamount = $data{"Euroamount"}; $name = $data{"Name"}; $mail = $data{"Mail"}; $message = $data{"Message"}; write_main_page(); } # Write a THANKS page. sub write_thanks ($) { my $data = shift; my $recur; my $recur_text = ''; my $processor; my $cardno; my $accountid = '-'; if ( $paytype eq 'cc' ) { $processor = 'Stripe'; $cardno = '*' . $$data{"Last4"}; } elsif ( $paytype eq 'pp' ) { $processor = 'Paypal'; $cardno = '-'; } else { $processor = '-'; $cardno = '-'; } if ($$data{"account-id"} ne '') { $accountid = $$data{"account-id"}; } $recur = $$data{"Recur"}; if ( $recur =~ /12/ ) { if ($lang eq 'de') { $recur_text = 'monatlich'; } elsif ($lang eq 'fr') { $recur_text = 'Mensuelle'; } elsif ($lang eq 'ja') { $recur_text = '毎月'; } else { $recur_text = 'Monthly'; } } elsif ( $recur =~ /4/ ) { if ($lang eq 'de') { $recur_text = 'vierteljährlich'; } elsif ($lang eq 'fr') { $recur_text = 'Trimestrielle'; } elsif ($lang eq 'ja') { $recur_text = '3ヶ月毎'; } else { $recur_text = 'Quarterly'; } } elsif ( $recur =~ /1/ ) { if ($lang eq 'de') { $recur_text = 'jährlich'; } elsif ($lang eq 'fr') { $recur_text = 'Annuelle'; } elsif ($lang eq 'ja') { $recur_text = '毎年'; } else { $recur_text = 'Yearly'; } } else { if ($lang eq 'de') { $recur_text = 'nein'; } elsif ($lang eq 'fr') { $recur_text = 'Unique'; } elsif ($lang eq 'ja') { $recur_text = '一回だけ'; } else { $recur_text = 'Just once'; } } if ($lang eq 'de') { $message = <Error: ' . $stripe{"failure"} . '
' . $stripe{"failure-mesg"} . '
'; # Again. write_checkout_page (); return; } # Print thanks write_thanks (\%stripe); payproc ('SESSION destroy ' . $sessid, ()); } # Initiate a payment with paypal and redirect to the Paypal site. sub get_paypal_approval () { my %data; my %request; my $redirurl; payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"}; # If the session has a lang value use that. if ($data{"Lang"} ne '') { $lang = $data{"Lang"}; } $request{"Currency"} = $data{"Currency"}; $request{"Amount"} = $data{"Amount"}; $request{"Recur"} = $data{"Recur"}; $request{"Desc"} = "Donation of " . $data{"Amount"} . " " . $data{"Currency"} . " to the GnuPG project"; $request{"Email"} = $data{"Mail"}; $request{"Meta[name]"} = $data{"Name"} unless $data{"Name"} eq 'Anonymous'; $request{"Meta[mail]"} = $data{"Mail"}; if ($data{"Message"} ne '') { $request{"Meta[message]"} = $data{"Message"}; } $request{"Return-Url"} = $baseurl . "/cgi-bin/procdonate.cgi?mode=confirm-paypal"; $request{"Cancel-Url"} = $baseurl . "/cgi-bin/procdonate.cgi?mode=cancel-paypal"; $request{"Session-Id"} = $sessid; if (payproc ('GETINFO live', ())) { $request{"Paypal-Xp"} = "XP-HD8G-XZRE-W7MH-EYNF"; } else { $request{"Paypal-Xp"} = "XP-NBWZ-QR6Z-8CXV-Q8XS"; } if (not payproc ('PPCHECKOUT prepare', \%request)) { $errorstr = $request{"ERR_Description"}; # Back to the main page. write_main_page(); return; } $redirurl = $request{"Redirect-Url"}; #print STDERR "Redirecting to: $redirurl\n"; print $q->redirect($redirurl) unless $redirurl eq ""; } # The is called by paypal after the user hit cancel. We need to # extract the alias to get back the session data. sub cancel_paypal_checkout () { my $aliasid; my $payerid; my %data; $aliasid = $q->param("aliasid"); # Get the session from the alias. payproc ('SESSION sessid ' . $aliasid, \%data) or fail $data{"ERR_Description"}; $sessid = $data{"_SESSID"}; payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"}; # If the session has a lang value use that. if ($data{"Lang"} ne '') { $lang = $data{"Lang"}; } if ( $data{"Paytype"} ne "pp" ) { fail "Invalid paytype for Paypal transaction"; } # Set vars for the checkout page. $amount = $data{"Amount"}; $currency = $data{"Currency"}; $paytype = $data{"Paytype"}; $stripeamount = $data{"Stripeamount"}; $euroamount = $data{"Euroamount"}; $recur = $data{"Recur"}; $name = $data{"Name"}; $mail = $data{"Mail"}; $message = $data{"Message"}; write_cancel_page (); } # The is called by paypal after approval. We need to extract the alias # and the payerid and store it in the session. Then we ask to confirm # the payment. sub confirm_paypal_checkout () { my $aliasid; my $payerid; my %data; $aliasid = $q->param("aliasid"); $payerid = $q->param("PayerID"); # Get the session from the alias and store the aliasid and the # payerid in the session. payproc ('SESSION sessid ' . $aliasid, \%data) or fail $data{"ERR_Description"}; $sessid = $data{"_SESSID"}; payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"}; # If the session has a lang value use that. if ($data{"Lang"} ne '') { $lang = $data{"Lang"}; } if ( $data{"Paytype"} ne "pp" ) { fail "Invalid paytype for Paypal transaction"; } # Put a description for the thanks page into the session data. # We do this only now because we send a reduced Desc field to paypal. $data{"Desc"} = "GnuPG donation by " . $data{"Name"} . " <" . $data{"Mail"} . ">"; # Note that the capitalization of session data names must match # the rules of payprocd. $data{"Paypal_aliasid"} = $aliasid; $data{"Paypal_payerid"} = $payerid; # Set vars for the checkout page. $amount = $data{"Amount"}; $currency = $data{"Currency"}; $paytype = $data{"Paytype"}; $stripeamount = $data{"Stripeamount"}; $euroamount = $data{"Euroamount"}; $recur = $data{"Recur"}; $name = $data{"Name"}; $mail = $data{"Mail"}; $message = $data{"Message"}; # Store the session after setting the above vars because that call # clears DATA. payproc ('SESSION put ' . $sessid, \%data) or fail $data{"ERR_Description"}; # Write the checkout (i.e. confirm payment) page write_checkout_page (); } # The approved Paypal payment has been approved. Now execute the # payment. sub complete_paypal_checkout () { my %data; my %request; payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"}; $request{"Alias-Id"} = $data{"Paypal_aliasid"}; $request{"Paypal-Payer"} = $data{"Paypal_payerid"}; if (not payproc ('PPCHECKOUT execute', \%request)) { $errorstr = 'Error: ' . $request{"failure"} . '
' . $request{"failure-mesg"} . '
'; print $q->header(-type=>'text/html', -charset=>'utf-8'); print "\n"; write_template("donate/error.html"); return; } # Copy some values for use by the thanks page. $request{"Desc"} = $data{"Desc"}; $request{"Recur"} = $data{"Recur"}; $request{"Paytype"} = $data{"Paytype"}; $paytype = $data{"Paytype"}; write_thanks (\%request); payproc ('SESSION destroy ' . $sessid, ()); } # Complete the SEPA payment: Check values and show final page. sub complete_sepa () { my %data; my %request; payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"}; # If the session has a lang value use that. if ($data{"Lang"} ne '') { $lang = $data{"Lang"}; } $request{"Currency"} = $data{"Currency"}; $request{"Amount"} = $data{"Amount"}; $request{"Desc"} = "GnuPG SEPA donation"; $request{"Email"} = $data{"Mail"} unless $data{"Mail"} eq ''; $request{"Meta[name]"} = $data{"Name"} unless $data{"Name"} eq 'Anonymous'; if ($data{"Message"} ne '') { $request{"Meta[message]"} = $data{"Message"}; } + $request{"Recur"} = $data{"Recur"}; if (not payproc ('SEPAPREORDER', \%request )) { $errorstr = "Error: " . $request{"ERR_Description"}; # Back to the main page. write_main_page (); return; } $separef = $request{"Sepa-Ref"}; $amount = $request{"Amount"}; # Set remaining vars for the checkout page. $currency = $data{"Currency"}; $paytype = $data{"Paytype"}; $stripeamount = $data{"Stripeamount"}; $euroamount = $data{"Euroamount"}; $recur = $data{"Recur"}; $name = $data{"Name"}; $mail = $data{"Mail"}; $message = $data{"Message"}; my @cmd = (qw (/usr/local/bin/ppsepaqr), 'DE76301502000002108603', 'g10 Code GmbH', $amount, 'GnuPG donation '.$separef ); if (open PPSEPAQR, '-|', @cmd) { while (defined (my $line =OK
\n"; } } # # Main # #print STDERR "CGI called with mode=$mode\n"; #print STDERR "CGI called with sessid=$sessid\n"; if ($q->param('url') ne '') { # If the URL field has been filled out, the client did not follow # the instructions and thus failed the Turing test. Provide an # innocent error page. write_overload_page () } elsif ($mode eq '') { # No mode: Show empty template. write_main_page(); } elsif ($mode eq 'preset') { # Show a a template with certain preset values. $currency = 'EUR'; $paytype = 'cc'; # First dedicated payment plans. if ($q->param('plan') eq '12-5-eur' ) { $recur = '4'; $amount = '15'; $notepanel = 'Note: To avoid overhead costs we adjusted your donation ' . 'from monthly to the equal quarterly amount'; } elsif ($q->param('plan') eq '12-10-eur' ) { $recur = '12'; $amount = '10'; } elsif ($q->param('plan') eq '12-20-eur' ) { $recur = '12'; $amount = '20'; } elsif ($q->param('plan') eq '12-50-eur' ) { $recur = '12'; $amount = '50'; } else { # Then look at arbitrary values # No checking needed. $recur = '0'; if ($q->param('s_amt') ne '') { $amount = int $q->param('s_amt'); } if ($q->param('s_cur') ne '') { $currency = $q->param('s_cur'); } if ($q->param('s_pt') ne '') { $paytype = $q->param('s_pt'); } } write_main_page(); } elsif ($mode eq 'ping') { # Check aliveness ping_pong(); } elsif ($mode eq 'main') { # Returning from the donation start page check_donation(); } elsif ($mode eq 're-main') { # Returning from the donation start page resend_main_page(); } elsif ($mode eq 'checkout-stripe') { # we have the stripe token - charge the card. complete_stripe_checkout(); } elsif ($mode eq 'cancel-paypal') { # Paypal transaction has been canceled by Paypal or the user. # Show the cancel page which has a button to return to the # main donation page. cancel_paypal_checkout(); } elsif ($mode eq 'confirm-paypal') { # We have approval from Paypal - show the confirm checkout page. confirm_paypal_checkout(); } elsif ($mode eq 'checkout-paypal') { # The approved Paypal payment has been approved - charge. complete_paypal_checkout(); } elsif ($mode eq 'pong') { # Helper to test a script checking PING. fail "Error connecting to payprocd: Forced to fail"; } else { fail('Internal error: Unknown mode'); }