lists: Overhaul the lists.gnupg.org index.html
[gnupg-doc.git] / cgi / procdonate.cgi
1 #!/usr/bin/perl -T
2
3 # procdonate.cgi - Donation payment processor for gnupg.org
4 # Copyright (C) 2014 g10 Code GmbH
5 #
6 # This file is free software; as a special exception the author gives
7 # unlimited permission to copy and/or distribute it, with or without
8 # modifications, as long as this notice is preserved.
9 #
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
12 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14
15 use strict;
16 use CGI;
17 use Cwd qw(realpath);
18 use IO::Socket::UNIX;
19
20 realpath($0) =~ /^(.*)\/.*$/;
21 my %config = do $1 . '/config.rc';
22
23 my $baseurl = $config{baseurl};
24 my $htdocs =  $config{htdocs};
25 my $socket_name = $config{payprocd_socket};
26 my $error_marker = '<span style="color: red;">* error</span>';
27
28 # The form variabales are accessed via Q.
29 my $q  = new CGI;
30
31 # This is a multi-purpose CGI.  The mode decides what to do.
32 my $mode = $q->param("mode");
33 my $sessid = $q->param("sessid");
34
35 # Variables used in the template pages.
36 my $amount = "";
37 my $paytype = "";
38 my $stripeamount = "";
39 my $euroamount = "";
40 my $currency = "";
41 my $name = "";
42 my $mail = "";
43 my $message = "";
44 my $separef = "";
45 my $errorstr = "";
46
47 # We use a dictionary to track error.  Those errors will then be
48 # inserted into the output by write_template.
49 my %errdict = ();
50
51 # Prototypes
52 sub fail ($);
53 sub get_paypal_approval ();
54 sub complete_sepa ();
55
56
57 # Write a template file.  A template is a proper HTML file with
58 # variables enclosed in HTML comments.  To allow inserting data into
59 # a value attribute of an input field, such a tag needs to be written as
60 #   <input value=""/><!--FOO-->
61 # the result after processing will be
62 #   <input value="foo"/>
63 # assuming that the value of FOO is foo. Note that this substitution
64 # rules work for all tags and thus you better take care to add an
65 # extra space if if do not want this to happen.
66 sub write_template ($) {
67     my $fname = shift;
68
69     my $errorpanel = $errorstr;
70     my $err_amount = '';
71     my $err_name = '';
72     my $err_mail = '';
73     my $err_paytype = '';
74     my $check_checked = ' checked="checked"';
75     my $sel_eur = '';
76     my $sel_usd = '';
77     my $sel_gbp = '';
78     my $sel_jpy = '';
79     my $message_fmt;
80     my $publishname;
81     my $check_paytype = 'none';
82
83     # Avoid broken HTML attributes.
84     $amount =~ s/\x22/\x27/g;
85     $stripeamount =~ s/\x22/\x27/g;
86     $currency =~ s/\x22/\x27/g;
87     $name =~ s/\x22/\x27/g;
88     $mail =~ s/\x22/\x27/g;
89     $message =~ s/\x22/\x27/g;
90     $separef =~ s/\x22/\x27/g;
91
92     # Clean possible user provided data
93     $sessid =~ s/</\x26lt;/g;
94     $amount =~ s/</\x26lt;/g;
95     $stripeamount =~ s/</\x26lt;/g;
96     $currency =~ s/</\x26lt;/g;
97     $name =~ s/</\x26lt;/g;
98     $mail =~ s/</\x26lt;/g;
99     $message =~ s/</\x26lt;/g;
100     $separef =~ s/</\x26lt;/g;
101
102     # No need to clean $euroamount.
103
104     # Create a formatted message.
105     $message_fmt = $message;
106     $message_fmt =~ s/\n/<br\x2f>/g;
107
108     if ( $currency =~ /EUR/i ) {
109         $sel_eur = ' selected="selected"';
110     } elsif ( $currency =~ /USD/i ) {
111         $sel_usd = ' selected="selected"';
112     } elsif ( $currency =~ /GBP/i ) {
113         $sel_gbp = ' selected="selected"';
114     } elsif ( $currency =~ /JPY/i ) {
115         $sel_jpy = ' selected="selected"';
116     }
117
118     if ( $paytype eq "cc" ) {
119         $check_paytype = "CC";
120     } elsif ( $paytype eq "pp" ) {
121         $check_paytype = "PP";
122     } elsif ( $paytype eq "se" ) {
123         $check_paytype = "SE";
124     }
125
126     # Set var for the paypal button
127     if ( $name eq 'Anonymous' or $name eq '') {
128         $publishname = 'No';
129     } else {
130         $publishname = 'Yes';
131     }
132
133     # Build error strings.
134     foreach (keys %errdict)
135     {
136         if    (/amount/) { $err_amount = $error_marker; }
137         elsif (/name/)   { $err_name   = $error_marker; }
138         elsif (/mail/)   { $err_mail   = $error_marker; }
139         elsif (/paytype/){ $err_paytype = $error_marker; }
140
141         $errorpanel = $errorpanel . "Field $_: " . $errdict{$_} . "<br/>\n"
142     }
143     if ( $errorpanel ne '' )
144     {
145         $errorpanel =
146             "<div style='color: red;'><p>\n" . $errorpanel . "</p></div>\n";
147     }
148
149
150     open TEMPLATE, $htdocs . $fname;
151     while (<TEMPLATE>) {
152         if ( /<!--/ )
153         {
154             # Only one replacement per line allowed to avoid recursive
155             # replacements. Note that MESSAGE uses a special treatment
156             # for the textarea tag.
157             s/<!--SESSID-->/$sessid/
158             || s/(\x22\x2f>)?<!--AMOUNT-->/$amount\1/
159             || s/(\x22\x2f>)?<!--EUROAMOUNT-->/$euroamount\1/
160             || s/(\x22\x2f>)?<!--STRIPEAMOUNT-->/$stripeamount\1/
161             || s/(\x22\x2f>)?<!--CURRENCY-->/$currency\1/
162             || s/(\x22\x2f>)?<!--NAME-->/$name\1/
163             || s/(\x22\x2f>)?<!--MAIL-->/$mail\1/
164             || s/\x2f><!--CHECKOTHER-->/$check_checked\x2f>/
165             || s/\x2f><!--CHECK_$check_paytype-->/$check_checked\x2f>/
166             || s/(<\x2ftextarea>)?<!--MESSAGE-->/$message\1/
167             || s/<!--MESSAGE_FMT-->/$message_fmt/
168             || s/(<selected=\x22selected\x22)?><!--SEL_EUR-->/$sel_eur>/
169             || s/(<selected=\x22selected\x22)?><!--SEL_USD-->/$sel_usd>/
170             || s/(<selected=\x22selected\x22)?><!--SEL_GBP-->/$sel_gbp>/
171             || s/(<selected=\x22selected\x22)?><!--SEL_JPY-->/$sel_jpy>/
172             || s/<!--PUBLISH_NAME-->/$publishname/
173             || s/<!--SEPA_REF-->/$separef/
174             || s/<!--ERRORSTR-->/$errorstr/
175             || s/<!--ERR_AMOUNT-->/$err_amount/
176             || s/<!--ERR_NAME-->/$err_name/
177             || s/<!--ERR_MAIL-->/$err_mail/
178             || s/<!--ERR_PAYTYPE-->/$err_paytype/
179             || s/<!--ERRORPANEL-->/$errorpanel/;
180         }
181         print;
182     }
183     close TEMPLATE;
184     $errorstr = "";
185 }
186
187
188 # Call the payment processor daemon.  Takes the command and a
189 # reference to a dictionary with the data as input.  On return that
190 # disctionary is replaced by the response data.
191 sub payproc ($$)
192 {
193     my $cmd = shift;
194     my $data = shift;
195     my $sock;
196     my $key;
197     my $value;
198     my $status;
199     my $rest;
200
201     # print STDERR "calling payproc: ", $cmd, "<-\n";
202
203     $sock = IO::Socket::UNIX->new($socket_name)
204         or fail "Error connecting to payprocd: $!";
205     $sock->print ($cmd, "\n");
206
207     while (($key,$value) = each %$data) {
208         next if $key =~ /^_/;
209         $value =~ s/\n/\n /g;
210         $sock->print ("$key: $value\n");
211         # print STDERR "  $key: $value\n";
212     }
213     $sock->print ("\n");
214     $sock->flush or fail "write socket: $!";
215
216     %$data = ();
217     while (defined (my $line = <$sock>))
218     {
219         next if $line =~ /^\#/;
220         chomp $line;
221         last if $line eq '';
222         if (not defined $status)
223         {
224             ($status, $rest) = split(' ', $line, 2);
225             if ( $status eq 'ERR' )
226             {
227                 $rest =~ /\d+\s+\((.*)\).*/;
228                 $$data{"ERR_Description"} = $1;
229             }
230         }
231         elsif ( $line =~ /^\s+/ )
232         {
233             fail "bad dict line received" if not defined $key;
234             $$data{$key} .= "\n" . substr($line, 1);
235         }
236         else
237         {
238             ($key, $value) = split(':', $line, 2);
239             $value =~ s/^\s+//;
240             $$data{$key} = $value;
241         }
242     }
243
244     #print STDERR "payproc status: $status (", $$data{"ERR_Description"}, ")\n";
245     #while (($key,$value) = each %$data) {
246     #     print STDERR "  ", $key, ": ", $value, "\n";
247     #}
248
249     $sock->close;
250     return 1 if $status eq 'OK';
251     return 0 if $status eq 'ERR';
252     fail 'payproc did not return a proper status code';
253 }
254
255
256 # Write a dummy page
257 sub write_overload_page ()
258 {
259     print $q->header(-type=>'text/html', -charset=>'utf-8');
260     print "\n";
261     $errorstr =
262         '<p>The system is currently processing too many requests.</p>'
263         . '<p>Please retry later.</p>';
264
265     &write_template("donate/error.html");
266 }
267
268 sub write_cancel_page ()
269 {
270     print $q->header(-type=>'text/html', -charset=>'utf-8');
271     print "\n";
272     &write_template("donate/paypal-can.html");
273 }
274
275
276 # Write an internal error page
277 sub fail ($)
278 {
279     my $desc = shift;
280
281 # FIXME: write the detailed error only to the log.
282     print $q->header(-type=>'text/html', -charset=>'utf-8');
283     print "\n";
284     $errorstr =
285         '<p>An internal error occured:</p>'
286         . "<p>$desc</p>";
287
288     write_template("donate/error.html");
289     exit 0;
290 }
291
292
293 # Write a the initial donation page.  This is usallay done to show
294 # errors.  The page is intially shown as static page.
295 sub write_main_page ()
296 {
297     print $q->header(-type=>'text/html', -charset=>'utf-8');
298     print "\n";
299     write_template("donate/index.html");
300 }
301
302
303 # Write a page with all the data inserted.
304 sub write_checkout_page ()
305 {
306     print $q->header(-type=>'text/html', -charset=>'utf-8');
307     print "\n";
308     if ( $paytype eq "cc" ) {
309         write_template("donate/checkout-cc.html");
310     }
311     elsif ( $paytype eq "pp" ) {
312         write_template("donate/checkout-pp.html");
313     }
314     else {
315         # For SEPA this is the final page
316         write_template("donate/checkout-se.html");
317     }
318 }
319
320
321 # Write the final thank you page.
322 sub write_thanks_page ()
323 {
324     print $q->header(-type=>'text/html', -charset=>'utf-8');
325     print "\n";
326     write_template("donate/donate-thanks.html");
327 }
328
329
330 # Check the values entered at the donation page.  Return true if
331 # everything is alright.  On error the donation page is send again.
332 sub check_donation ()
333 {
334     my %data;
335     my %sepa;
336     my $anyerr = 0;
337
338     # Note: When re-displaying the page we always use amount other
339     # because that is easier to implement than figuring out which
340     # amount and currency was used and check the appropriate radio
341     # button.
342     $amount = $q->param("amount");
343     if ($amount eq 'other') {
344       $amount = $q->param("amountother");
345       $currency = $q->param("currency");
346     } else {
347       $currency = 'EUR';
348     }
349
350     $name = $q->param("name");
351     $name = 'Anonymous' if $name eq '';
352     $mail = $q->param("mail");
353     $message = $q->param("message");
354     $stripeamount = "0";
355
356     # Check the amount.
357     $data{"Amount"} = $amount;
358     $data{"Currency"} = $currency;
359     if (not payproc ('CHECKAMOUNT', \%data )) {
360         $errdict{"amount"} = $data{"ERR_Description"};
361         $anyerr = 1;
362     }
363     $stripeamount = $data{"_amount"};
364     $amount = $data{"Amount"};
365     $currency = $data{"Currency"};
366     $euroamount = $data{"Euro"};
367
368     # Check that at least some Euros are given.  Due to Stripe
369     # processing fees and our own costs for bookkeeping we need to ask
370     # for a minimum amount.
371     if ( (not $anyerr) and ($euroamount < 4.00) ) {
372         $errdict{"amount"} = 'Sorry, due to overhead costs we do' .
373                              ' not accept donations of less than 4 Euro.';
374         $anyerr = 1;
375     }
376
377     # Check the payment type
378     $paytype = $q->param("paytype");
379     if ( $paytype ne "cc" and $paytype ne "pp" and $paytype ne "se" ) {
380         $errdict{"paytype"} = 'No payment type selected.' .
381                               ' Use "Credit Card", "PayPal", or "SEPA".';
382         $anyerr = 1;
383     }
384
385     # SEPA credit transfers are only possible in Euro.
386     # (yes, this may overwrite an earlier error message).
387     if ( $paytype eq "se" and $currency ne "EUR" ) {
388         $errdict{"amount"} = 'SEPA transfers are only possible in EUR.';
389         $anyerr = 1;
390     }
391
392     # Check the mail address
393     if ($mail ne '' and $mail !~ /\S+@\S+\.\S+/ ) {
394         $errdict{"mail"} = 'invalid mail address';
395         $anyerr = 1;
396     }
397
398     # If needed present errors and ask again.  */
399     if ($anyerr) {
400         write_main_page();
401         return;
402     }
403
404     # Now create a session.
405     $data{"Stripeamount"} = $stripeamount;
406     $data{"Euroamount"} = $euroamount;
407     $data{"Name"} = $name;
408     $data{"Mail"} = $mail;
409     $data{"Message"} = $message;
410     $data{"Paytype"} = $paytype;
411     payproc ('SESSION create', \%data ) or fail $data{"ERR_Description"};
412     $sessid = $data{"_SESSID"};
413
414     # Send the checkout page or redirect to paypal
415     if ( $paytype eq "pp" ) {
416         get_paypal_approval ();
417     }
418     elsif ( $paytype eq "se" ) {
419         complete_sepa ();
420     }
421     else {
422         write_checkout_page();
423     }
424 }
425
426 # This simply resends the main page again.
427 sub resend_main_page ()
428 {
429     my %data;
430
431     payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"};
432     $amount = $data{"Amount"};
433     $currency = $data{"Currency"};
434     $paytype = $data{"Paytype"};
435     $stripeamount = $data{"Stripeamount"};
436     $euroamount = $data{"Euroamount"};
437     $name = $data{"Name"};
438     $mail = $data{"Mail"};
439     $message = $data{"Message"};
440
441     write_main_page();
442 }
443
444
445 # This is called by FIXME
446 sub complete_stripe_checkout ()
447 {
448     my %data;
449     my %stripe;
450
451     # fixme: Change the error message to note that the card has not
452     # been charged.  Somehow delete the token
453     payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"};
454
455     # Do the checkout.
456     $stripe{"Card-Token"} = $q->param("stripeToken");
457     $stripe{"Currency"} = $data{"Currency"};
458     $stripe{"Amount"} = $data{"Amount"};
459     $stripe{"Desc"} =
460         "GnuPG donation by " . $data{"Name"} . " <" . $data{"Mail"} . ">";
461     $stripe{"Stmt-Desc"} = "GnuPG donation";
462     $stripe{"Email"} = $q->param("stripeEmail");
463     $stripe{"Meta[name]"} = $data{"Name"} unless $data{"Name"} eq 'Anonymous';
464     if ($data{"Mail"} ne $q->param("stripeEmail")) {
465         $stripe{"Meta[mail]"} = $data{"Mail"};
466     }
467     if ($data{"Message"} ne '') {
468         $stripe{"Meta[message]"} = $data{"Message"};
469     }
470     if (not payproc ('CHARGECARD', \%stripe)) {
471         $errorstr =
472             '<p>Error: ' . $stripe{"failure"} . '</p><p>'
473             . $stripe{"failure-mesg"} . '</p>';
474         # Again.
475         write_checkout_page ();
476         return;
477     }
478
479     # Print thanks
480
481     $message = <<EOF;
482 Amount ..: $stripe{"Amount"} $stripe{"Currency"}
483 Desc ....: $stripe{"Desc"}
484 Cardno...: *$stripe{"Last4"}
485 Processor: Stripe
486 Email ...: $stripe{"Email"}
487 Charge-Id: $stripe{"Charge-Id"}
488 Timestamp: $stripe{"_timestamp"}
489 EOF
490     if ($stripe{"Live"} eq 'f') {
491         $message = $message . "\n!!! TEST TRANSACTION !!!";
492     }
493
494     write_thanks_page ();
495     payproc ('SESSION destroy ' . $sessid, ());
496 }
497
498
499 # Initiate a payment with paypal and redirect to the Paypal site.
500 sub get_paypal_approval ()
501 {
502     my %data;
503     my %request;
504     my $redirurl;
505
506     payproc ('SESSION get ' . $sessid, \%data)
507         or fail $data{"ERR_Description"};
508
509     $request{"Currency"} = $data{"Currency"};
510     $request{"Amount"} = $data{"Amount"};
511     $request{"Desc"} =
512         "Donation of " . $data{"Amount"} . " " . $data{"Currency"} .
513         " to the GnuPG project";
514     $request{"Meta[name]"} = $data{"Name"} unless
515         $data{"Name"} eq 'Anonymous';
516     $request{"Meta[mail]"} = $data{"Mail"};
517     if ($data{"Message"} ne '') {
518         $request{"Meta[message]"} = $data{"Message"};
519     }
520     $request{"Return-Url"} =
521         $baseurl . "/cgi-bin/procdonate.cgi?mode=confirm-paypal";
522     $request{"Cancel-Url"} =
523         $baseurl . "/cgi-bin/procdonate.cgi?mode=cancel-paypal";
524     $request{"Session-Id"} = $sessid;
525
526     if (payproc ('GETINFO live', ())) {
527       $request{"Paypal-Xp"} = "XP-HD8G-XZRE-W7MH-EYNF";
528     } else {
529       $request{"Paypal-Xp"} = "XP-NBWZ-QR6Z-8CXV-Q8XS";
530     }
531
532     if (not payproc ('PPCHECKOUT prepare', \%request)) {
533         $errorstr = $request{"ERR_Description"};
534         # Back to the main page.
535         write_main_page();
536         return;
537     }
538
539     $redirurl = $request{"Redirect-Url"};
540
541     #print STDERR "Redirecting to: $redirurl\n";
542     print $q->redirect($redirurl) unless $redirurl eq "";
543 }
544
545
546 # The is called by paypal after approval.  We need to extract the alias
547 # and the payerid and store it in the session.  Then we ask to confirm
548 # the payment.
549 sub confirm_paypal_checkout ()
550 {
551     my $aliasid;
552     my $payerid;
553     my %data;
554
555     $aliasid = $q->param("aliasid");
556     $payerid = $q->param("PayerID");
557
558     # Get the session from the alias and store the aliasid and the
559     # payerid in the session.
560     payproc ('SESSION sessid ' . $aliasid, \%data)
561         or fail $data{"ERR_Description"};
562     $sessid = $data{"_SESSID"};
563     payproc ('SESSION get ' . $sessid, \%data)
564         or fail $data{"ERR_Description"};
565
566     if ( $data{"Paytype"} ne "pp" ) {
567         fail "Invalid paytype for Paypal transaction";
568     }
569
570     # Put a description for the thanks page into the session data.
571     # We do this only now because we send a reduced Desc field to paypal.
572     $data{"Desc"} =
573         "GnuPG donation by " . $data{"Name"} . " <" . $data{"Mail"} . ">";
574
575     # Note that the capitalization of session data names must match
576     # the rules of payprocd.
577     $data{"Paypal_aliasid"} = $aliasid;
578     $data{"Paypal_payerid"} = $payerid;
579
580     # Set vars for the checkout page.
581     $amount = $data{"Amount"};
582     $currency = $data{"Currency"};
583     $paytype = $data{"Paytype"};
584     $stripeamount = $data{"Stripeamount"};
585     $euroamount = $data{"Euroamount"};
586     $name = $data{"Name"};
587     $mail = $data{"Mail"};
588     $message = $data{"Message"};
589
590     # Store the session after setting the above vars because that call
591     # clears DATA.
592     payproc ('SESSION put ' . $sessid, \%data)
593         or fail $data{"ERR_Description"};
594
595     # Write the checkout (i.e. confirm payment) page
596     write_checkout_page ();
597 }
598
599
600 # The approved Paypal payment has been approved.  Now execute the
601 # payment.
602 sub complete_paypal_checkout ()
603 {
604     my %data;
605     my %request;
606
607     payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"};
608
609     $request{"Alias-Id"}     = $data{"Paypal_aliasid"};
610     $request{"Paypal-Payer"} = $data{"Paypal_payerid"};
611
612     if (not payproc ('PPCHECKOUT execute', \%request)) {
613         $errorstr =
614             '<p>Error: ' . $request{"failure"} . '</p><p>'
615             . $request{"failure-mesg"} . '</p>';
616
617         print $q->header(-type=>'text/html', -charset=>'utf-8');
618         print "\n";
619         write_template("donate/error.html");
620         return;
621     }
622
623     # Print thanks
624
625     $message = <<EOF;
626 Amount ..: $request{"Amount"} $request{"Currency"}
627 Desc ....: $data{"Desc"}
628 Cardno...: n/a
629 Processor: PayPal
630 Email ...: $request{"Email"}
631 Charge-Id: $request{"Charge-Id"}
632 Timestamp: $request{"_timestamp"}
633 EOF
634     if ($request{"Live"} eq 'f') {
635         $message = $message . "\n!!! TEST TRANSACTION !!!";
636     }
637
638     write_thanks_page ();
639     payproc ('SESSION destroy ' . $sessid, ());
640 }
641
642
643 # Complete the SEPA payment: Check values and show final page.
644 sub complete_sepa ()
645 {
646     my %data;
647     my %request;
648
649     payproc ('SESSION get ' . $sessid, \%data)
650         or fail $data{"ERR_Description"};
651
652     $request{"Currency"} = $data{"Currency"};
653     $request{"Amount"} = $data{"Amount"};
654     $request{"Desc"} = "GnuPG SEPA donation";
655     $request{"Email"} = $data{"Mail"} unless $data{"Mail"} eq '';
656     $request{"Meta[name]"} = $data{"Name"} unless $data{"Name"} eq 'Anonymous';
657     if ($data{"Message"} ne '') {
658         $request{"Meta[message]"} = $data{"Message"};
659     }
660     if (not payproc ('SEPAPREORDER', \%request )) {
661         $errorstr = "Error: " . $request{"ERR_Description"};
662         # Back to the main page.
663         write_main_page ();
664         return;
665     }
666     $separef = $request{"Sepa-Ref"};
667     $amount = $request{"Amount"};
668
669     # Set remaining vars for the checkout page.
670     $currency = $data{"Currency"};
671     $paytype = $data{"Paytype"};
672     $stripeamount = $data{"Stripeamount"};
673     $euroamount = $data{"Euroamount"};
674     $name = $data{"Name"};
675     $mail = $data{"Mail"};
676     $message = $data{"Message"};
677
678     write_checkout_page ();
679 }
680
681
682 # Send a PING command to see whether payprocd is alive.
683 sub ping_pong ()
684 {
685     my %data = ();
686
687     if (payproc ('PING', \%data )) {
688        print $q->header(-type=>'text/HTML', -charset=>'utf-8');
689        print "\n";
690        print "<p>OK</p>\n";
691     }
692 }
693
694
695 #
696 # Main
697 #
698
699 #print STDERR "CGI called with mode=$mode\n";
700 #print STDERR "CGI called with sessid=$sessid\n";
701 if ($q->param('url') ne '') {
702     # If the URL field has been filled out, the client did not follow
703     # the instructions and thus failed the Turing test.  Provide an
704     # innocent error page.
705     write_overload_page ()
706 }
707 elsif ($mode eq '') {
708     # No mode: Show empty template.
709     write_main_page();
710 }
711 elsif ($mode eq 'ping') {
712     # Check aliveness
713     ping_pong();
714 }
715 elsif ($mode eq 'main') {
716     # Returning from the donation start page
717     check_donation();
718 }
719 elsif ($mode eq 're-main') {
720     # Returning from the donation start page
721     resend_main_page();
722 }
723 elsif ($mode eq 'checkout-stripe') {
724     # we have the stripe token - charge the card.
725     complete_stripe_checkout();
726 }
727 elsif ($mode eq 'cancel-paypal') {
728     # Fixme: Destroy the alias of the session.
729     write_cancel_page();
730 }
731 elsif ($mode eq 'confirm-paypal') {
732     # We have approval from Paypal - show the confirm checkout page.
733     confirm_paypal_checkout();
734 }
735 elsif ($mode eq 'checkout-paypal') {
736     # The approved Paypal payment has been approved - charge.
737     complete_paypal_checkout();
738 }
739 elsif ($mode eq 'pong') {
740     # Helper to test a script checking PING.
741     fail "Error connecting to payprocd: Forced to fail";
742 }
743 else {
744     fail('Internal error: Unknown mode');
745 }