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