campaign,fr: Minor corrections.
[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 qw/:standard -debug/;
17 use CGI;
18 use Cwd qw(realpath);
19 use IO::Socket::UNIX;
20
21 realpath($0) =~ /^(.*)\/.*$/;
22 my %config = do $1 . '/config.rc';
23
24 my $baseurl = $config{baseurl};
25 my $htdocs =  $config{htdocs};
26 my $stripepubkey =  $config{stripepubkey};
27 my $socket_name = $config{payprocd_socket};
28 my $error_marker = '<span style="color: red;">* error</span>';
29
30 # The form variables are accessed via Q.
31 my $q  = new CGI;
32
33 # This is a multi-purpose CGI.  The mode decides what to do.
34 my $mode = $q->param("mode");
35 my $sessid = $q->param("sessid");
36 my $lang = $q->param("lang");
37
38 # Variables used in the template pages.
39 my $amount = "";
40 my $paytype = "";
41 my $stripeamount = "";
42 my $euroamount = "";
43 my $currency = "";
44 my $recur = "";
45 my $name = "";
46 my $mail = "";
47 my $message = "";
48 my $separef = "";
49 my $errorstr = "";
50 my $notepanel = "";
51
52 # We use a dictionary to track error.  Those errors will then be
53 # inserted into the output by write_template.
54 my %errdict = ();
55
56 # Prototypes
57 sub fail ($);
58 sub get_paypal_approval ();
59 sub complete_sepa ();
60
61
62 # Write a template file.  A template is a proper HTML file with
63 # variables enclosed in HTML comments.  To allow inserting data into
64 # a value attribute of an input field, such a tag needs to be written as
65 #   <input value=""/><!--FOO-->
66 # the result after processing will be
67 #   <input value="foo"/>
68 # assuming that the value of FOO is foo. Note that this substitution
69 # rules work for all tags and thus you better take care to add an
70 # extra space if you do not want this to happen.
71 sub write_template ($) {
72     my $fname = shift;
73
74     my $tname;
75     my $errorpanel = $errorstr;
76     my $err_amount = '';
77     my $err_name = '';
78     my $err_mail = '';
79     my $err_paytype = '';
80     my $check_checked = ' checked="checked"';
81     my $sel_eur = '';
82     my $sel_usd = '';
83     my $sel_gbp = '';
84     my $sel_jpy = '';
85     my $chk_amt500 = '';
86     my $chk_amt200 = '';
87     my $chk_amt100 = '';
88     my $chk_amt50 = '';
89     my $chk_amt20 = '';
90     my $chk_amt10 = '';
91     my $chk_amt5 = '';
92     my $chk_amtx = '';
93     my $amt_other = '';
94     my $recur_none = '';
95     my $recur_month = '';
96     my $recur_quarter = '';
97     my $recur_year = '';
98     my $recur_text = '';
99     my $message_fmt;
100     my $publishname;
101     my $check_paytype = 'none';
102     my $stripe_data_email = '';
103     my $stripe_data_label_value;
104     my $xamount;
105     my $stripelocale;
106
107     # Avoid broken HTML attributes.
108     $amount =~ s/\x22/\x27/g;
109     $stripeamount =~ s/\x22/\x27/g;
110     $currency =~ s/\x22/\x27/g;
111     $recur =~ s/\x22/\x27/g;
112     $name =~ s/\x22/\x27/g;
113     $mail =~ s/\x22/\x27/g;
114     $message =~ s/\x22/\x27/g;
115     $separef =~ s/\x22/\x27/g;
116     $lang =~ s/\x22/\x27/g;
117
118     # Clean possible user provided data
119     $sessid =~ s/</\x26lt;/g;
120     $lang =~ s/</\x26lt;/g;
121     $amount =~ s/</\x26lt;/g;
122     $stripeamount =~ s/</\x26lt;/g;
123     $currency =~ s/</\x26lt;/g;
124     $recur =~ s/</\x26lt;/g;
125     $name =~ s/</\x26lt;/g;
126     $mail =~ s/</\x26lt;/g;
127     $message =~ s/</\x26lt;/g;
128     $separef =~ s/</\x26lt;/g;
129
130     # No need to clean $euroamount.
131
132     # Check whether a translated template is available.
133     $tname = $htdocs . $fname;
134     $tname =~ s/\.html$/.$lang.html/;
135     if ( not -f $tname ) { $tname = $htdocs . $fname; }
136
137     # Create a formatted message.
138     $message_fmt = $message;
139     $message_fmt =~ s/\n/<br\x2f>/g;
140
141     # Check the currency and predefined amount.
142     if ( $currency =~ /EUR/i ) {
143         $sel_eur = ' selected="selected"';
144         $chk_amtx = $check_checked;
145         $amt_other = $amount;
146     } elsif ( $currency =~ /USD/i ) {
147         $sel_usd = ' selected="selected"';
148         $chk_amtx = $check_checked;
149         $amt_other = $amount;
150     } elsif ( $currency =~ /GBP/i ) {
151         $sel_gbp = ' selected="selected"';
152         $chk_amtx = $check_checked;
153         $amt_other = $amount;
154     } elsif ( $currency =~ /JPY/i ) {
155         $sel_jpy = ' selected="selected"';
156         $chk_amtx = $check_checked;
157         $amt_other = $amount;
158     } else {
159         $chk_amtx = $check_checked;
160         $amt_other = $amount;
161     }
162
163     # For non-recurring Stripe donations we do not want to send a
164     #     data-email="$mail"
165     # line to Stripe so to enable the user to use a a different mail
166     # address for use with them.  This is implemented using a
167     # STRIPE_DATA_EMAIL template variable.
168     $stripe_data_email = 'data-email="' . $mail . '"';
169     if ( $recur =~ /0/ ) {
170         $stripe_data_email = '';
171         $recur_none    = ' selected="selected"';
172         $recur_text    = '';
173
174         if ($lang eq 'de') {
175             $stripe_data_label_value = 'Einmalig spenden';
176         } elsif ($lang eq 'fr') {
177             $stripe_data_label_value = 'Faire un don unique';
178         } elsif ($lang eq 'ja') {
179             $stripe_data_label_value = '一回の寄付する';
180         } else {
181             $stripe_data_label_value = 'Make one-time donation';
182         }
183
184     } elsif ( $recur =~ /12/ ) {
185         $recur_month   = ' selected="selected"';
186
187         if ($lang eq 'de') {
188             $recur_text    = 'monatlich';
189             $stripe_data_label_value = 'Monatlich spenden';
190         } elsif ($lang eq 'fr') {
191             $recur_text    = 'mensuels';
192             $stripe_data_label_value = 'Faire un don mensuel';
193         } elsif ($lang eq 'ja') {
194             $recur_text    = '毎月';
195             $stripe_data_label_value = '毎月寄付する';
196         } else {
197             $recur_text    = 'monthly';
198             $stripe_data_label_value = 'Donate monthly';
199         }
200
201     } elsif ( $recur =~ /4/ ) {
202         $recur_quarter = ' selected="selected"';
203
204         if ($lang eq 'de') {
205             $recur_text    = 'vierteljährlich';
206             $stripe_data_label_value = 'Vierteljährlich spenden';
207         } elsif ($lang eq 'fr') {
208             $recur_text    = 'trimestriels';
209             $stripe_data_label_value = 'Faire un don trimestriel';
210         } elsif ($lang eq 'ja') {
211             $recur_text    = '3ヶ月毎';
212             $stripe_data_label_value = '3ヶ月毎に寄付する';
213         } else {
214             $recur_text    = 'quarterly';
215             $stripe_data_label_value = 'Donate quarterly';
216         }
217
218     } elsif ( $recur =~ /1/ ) {
219         $recur_year    = ' selected="selected"';
220
221         if ($lang eq 'de') {
222             $recur_text    = 'jährlich';
223             $stripe_data_label_value = 'Jährlich spenden';
224         } elsif ($lang eq 'fr') {
225             $recur_text    = 'annuels';
226             $stripe_data_label_value = 'Faire un don annuel';
227         } elsif ($lang eq 'ja') {
228             $recur_text    = '毎年';
229             $stripe_data_label_value = '毎年寄付する';
230         } else {
231             $recur_text    = 'yearly';
232             $stripe_data_label_value = 'Donate yearly';
233         }
234
235     } else { # invalid
236         $stripe_data_label_value = '';
237     }
238
239     if ( $paytype eq "cc" ) {
240         $check_paytype = "CC";
241     } elsif ( $paytype eq "pp" ) {
242         $check_paytype = "PP";
243     } elsif ( $paytype eq "se" ) {
244         $check_paytype = "SE";
245     } elsif ( $paytype eq "bc" ) {
246         $check_paytype = "BC";
247     }
248
249     # Set var for the paypal button
250     if ( $name eq 'Anonymous' or $name eq '') {
251         $publishname = 'No';
252     } else {
253         $publishname = 'Yes';
254     }
255
256
257
258     # Set a specific locale.
259     if ($lang eq 'de')    { $stripelocale = "de"; }
260     elsif ($lang eq 'fr') { $stripelocale = "fr"; }
261     elsif ($lang eq 'ja') { $stripelocale = "ja"; }
262     elsif ($lang eq 'en') { $stripelocale = "en"; }
263     else                  { $stripelocale = "auto"; }
264
265
266     # Build error strings.
267     foreach (keys %errdict)
268     {
269         my $fieldname;
270
271         if ($lang eq 'de')    { $fieldname = "Feld $_: ";  }
272         elsif ($lang eq 'fr') { $fieldname = "Champ $_: "; }
273         elsif ($lang eq 'ja') { $fieldname = "欄 $_: "; }
274         else                  { $fieldname = "Field $_: "; }
275
276         if    (/amount/) { $err_amount = $error_marker; }
277         elsif (/name/)   { $err_name   = $error_marker; }
278         elsif (/mail/)   { $err_mail   = $error_marker; }
279         elsif (/paytype/){ $err_paytype = $error_marker; }
280
281         $errorpanel = $errorpanel . $fieldname . $errdict{$_} . "<br/>\n"
282     }
283     if ( $errorpanel ne '' ) {
284         $errorpanel =
285             "<div style='color: red;'><p>\n" . $errorpanel . "</p></div>\n";
286     } elsif ( $notepanel ne '' ) {
287         $errorpanel =
288             "<div style='color: grey;'><p>\n" . $notepanel . "</p></div>\n";
289         $notepanel = '';
290     }
291
292
293     open TEMPLATE, $tname;
294     while (<TEMPLATE>) {
295         if ( /<!--/ )
296         {
297         # Only one replacement per line allowed to avoid recursive
298         # replacements. Note that MESSAGE uses a special treatment
299         # for the textarea tag.
300         s/<!--SESSID-->/$sessid/
301         || s/(\x22\x2f>)?<!--AMOUNT-->/$amount\1/
302         || s/(\x22\x2f>)?<!--AMT_OTHER-->/$amt_other\1/
303         || s/(\x22\x2f>)?<!--EUROAMOUNT-->/$euroamount\1/
304         || s/(\x22\x2f>)?<!--STRIPEPUBKEY-->/$stripepubkey\1/
305         || s/(\x22\x2f>)?<!--STRIPELOCALE-->/$stripelocale\1/
306         || s/(\x22\x2f>)?<!--STRIPEAMOUNT-->/$stripeamount\1/
307         || s/(\x22\x2f>)?<!--CURRENCY-->/$currency\1/
308         || s/(\x22\x2f>)?<!--NAME-->/$name\1/
309         || s/(\x22\x2f>)?<!--MAIL-->/$mail\1/
310         || s/\x2f><!--CHECK_$check_paytype-->/$check_checked\x2f>/
311         || s/(<\x2ftextarea>)?<!--MESSAGE-->/$message\1/
312         || s/<!--MESSAGE_FMT-->/$message_fmt/
313         || s/(<selected=\x22selected\x22)?><!--SEL_EUR-->/$sel_eur>/
314         || s/(<selected=\x22selected\x22)?><!--SEL_USD-->/$sel_usd>/
315         || s/(<selected=\x22selected\x22)?><!--SEL_GBP-->/$sel_gbp>/
316         || s/(<selected=\x22selected\x22)?><!--SEL_JPY-->/$sel_jpy>/
317         || s/(<selected=\x22selected\x22)?><!--RECUR_NONE-->/$recur_none>/
318         || s/(<selected=\x22selected\x22)?><!--RECUR_MONTH-->/$recur_month>/
319         || s/(<selected=\x22selected\x22)?><!--RECUR_QUARTER-->/$recur_quarter>/
320         || s/(<selected=\x22selected\x22)?><!--RECUR_YEAR-->/$recur_year>/
321         || s/(<check=\x22checked\x22)?\x2f><!--CHK_AMT500-->/$chk_amt500\x2f>/
322         || s/(<check=\x22checked\x22)?\x2f><!--CHK_AMT200-->/$chk_amt200\x2f>/
323         || s/(<check=\x22checked\x22)?\x2f><!--CHK_AMT100-->/$chk_amt100\x2f>/
324         || s/(<check=\x22checked\x22)?\x2f><!--CHK_AMT50-->/$chk_amt50\x2f>/
325         || s/(<check=\x22checked\x22)?\x2f><!--CHK_AMT20-->/$chk_amt20\x2f>/
326         || s/(<check=\x22checked\x22)?\x2f><!--CHK_AMT10-->/$chk_amt10\x2f>/
327         || s/(<check=\x22checked\x22)?\x2f><!--CHK_AMT5-->/$chk_amt5\x2f>/
328         || s/(<check=\x22checked\x22)?\x2f><!--CHK_AMTX-->/$chk_amtx\x2f>/
329         || s/<!--RECUR_TEXT-->/$recur_text/
330         || s/<!--STRIPE_DATA_EMAIL-->/$stripe_data_email/
331         || s/<!--STRIPE_DATA_LABEL_VALUE-->/$stripe_data_label_value/
332         || s/<!--PUBLISH_NAME-->/$publishname/
333         || s/<!--LANG-->/$lang/
334         || s/<!--SEPA_REF-->/$separef/
335         || s/<!--ERRORSTR-->/$errorstr/
336         || s/<!--ERR_AMOUNT-->/$err_amount/
337         || s/<!--ERR_NAME-->/$err_name/
338         || s/<!--ERR_MAIL-->/$err_mail/
339         || s/<!--ERR_PAYTYPE-->/$err_paytype/
340         || s/<!--ERRORPANEL-->/$errorpanel/;
341         }
342         print;
343     }
344     close TEMPLATE;
345     $errorstr = "";
346 }
347
348
349 # Call the payment processor daemon.  Takes the command and a
350 # reference to a dictionary with the data as input.  On return that
351 # dictionary is replaced by the response data.
352 sub payproc ($$)
353 {
354     my $cmd = shift;
355     my $data = shift;
356     my $sock;
357     my $key;
358     my $value;
359     my $status;
360     my $rest;
361
362     # print STDERR "calling payproc: ", $cmd, "<-\n";
363
364     $sock = IO::Socket::UNIX->new($socket_name)
365         or fail "Error connecting to payprocd: $!";
366     $sock->print ($cmd, "\n");
367
368     while (($key,$value) = each %$data) {
369         next if $key =~ /^_/;
370         $value =~ s/\n/\n /g;
371         $sock->print ("$key: $value\n");
372         # print STDERR "  $key: $value\n";
373     }
374     $sock->print ("\n");
375     $sock->flush or fail "write socket: $!";
376
377     %$data = ();
378     while (defined (my $line = <$sock>))
379     {
380         next if $line =~ /^\#/;
381         chomp $line;
382         last if $line eq '';
383         if (not defined $status)
384         {
385             ($status, $rest) = split(' ', $line, 2);
386             if ( $status eq 'ERR' )
387             {
388                 $rest =~ /\d+\s+\((.*)\).*/;
389                 $$data{"ERR_Description"} = $1;
390             }
391         }
392         elsif ( $line =~ /^\s+/ )
393         {
394             fail "bad dict line received" if not defined $key;
395             $$data{$key} .= "\n" . substr($line, 1);
396         }
397         else
398         {
399             ($key, $value) = split(':', $line, 2);
400             $value =~ s/^\s+//;
401             $$data{$key} = $value;
402         }
403     }
404
405     #print STDERR "payproc status: $status (", $$data{"ERR_Description"}, ")\n";
406     #while (($key,$value) = each %$data) {
407     #     print STDERR "  ", $key, ": ", $value, "\n";
408     #}
409
410     $sock->close;
411     return 1 if $status eq 'OK';
412     return 0 if $status eq 'ERR';
413     fail 'payproc did not return a proper status code';
414 }
415
416
417 # Write a dummy page
418 sub write_overload_page ()
419 {
420     print $q->header(-type=>'text/html', -charset=>'utf-8');
421     print "\n";
422     $errorstr =
423         '<p>The system is currently processing too many requests.</p>'
424         . '<p>Please retry later.</p>';
425
426     &write_template("donate/error.html");
427 }
428
429 sub write_cancel_page ()
430 {
431     print $q->header(-type=>'text/html', -charset=>'utf-8');
432     print "\n";
433     &write_template("donate/paypal-can.html");
434 }
435
436
437 # Write an internal error page
438 sub fail ($)
439 {
440     my $desc = shift;
441
442 # FIXME: write the detailed error only to the log.
443     print $q->header(-type=>'text/html', -charset=>'utf-8');
444     print "\n";
445     $errorstr =
446         '<p>An internal error occured:</p>'
447         . "<p>$desc</p>";
448
449     write_template("donate/error.html");
450     exit 0;
451 }
452
453
454 # Write a the initial donation page.  This is usallay done to show
455 # errors.  The page is intially shown as static page.
456 sub write_main_page ()
457 {
458     print $q->header(-type=>'text/html', -charset=>'utf-8');
459     print "\n";
460     write_template("donate/donate.html");
461 }
462
463
464 # Write a page with all the data inserted.
465 sub write_checkout_page ()
466 {
467     print $q->header(-type=>'text/html', -charset=>'utf-8');
468     print "\n";
469     if ( $paytype eq "cc" ) {
470         write_template("donate/checkout-cc.html");
471     }
472     elsif ( $paytype eq "pp" ) {
473         write_template("donate/checkout-pp.html");
474     }
475     elsif ( $paytype eq "bc" ) {
476         # For Bitcoins this is the final page
477         write_template("donate/checkout-bc.html");
478     }
479     else {
480         # For SEPA this is the final page
481         write_template("donate/checkout-se.html");
482     }
483 }
484
485
486 # Write the final thank you page.
487 sub write_thanks_page ()
488 {
489     print $q->header(-type=>'text/html', -charset=>'utf-8');
490     print "\n";
491     write_template("donate/donate-thanks.html");
492 }
493
494
495 # Check the values entered at the donation page.  Return true if
496 # everything is alright.  On error the donation page is send again.
497 sub check_donation ()
498 {
499     my %data;
500     my %sepa;
501     my $anyerr = 0;
502     my $msg;
503
504     $amount = $q->param("amount");
505     if ($amount eq 'other') {
506       # backward compatibility
507       $amount = $q->param("amountother");
508     }
509     $currency = $q->param("currency");
510
511     $recur = $q->param("recur");
512     $name = $q->param("name");
513     $name = 'Anonymous' if $name eq '';
514     $mail = $q->param("mail");
515     $message = $q->param("message");
516     $stripeamount = "0";
517
518     $paytype = $q->param("paytype");
519
520     # Check the amount and the recurring value unless Bitcoins are
521     # selected.
522     if ( $paytype ne "bc" ) {
523         # Note that we only use full Euro/USD/etc from the amount to avoid
524         # problems with ',' and '.' decimal separators.
525         $data{"Amount"} = int $amount;
526         $data{"Currency"} = $currency;
527         $data{"Recur"} = $recur;
528         if (not payproc ('CHECKAMOUNT', \%data )) {
529             $errdict{"amount"} = $data{"ERR_Description"};
530             $anyerr = 1;
531         }
532         $stripeamount = $data{"_amount"};
533         $amount = $data{"Amount"};
534         $recur = $data{"Recur"};
535         $currency = $data{"Currency"};
536         $euroamount = $data{"Euro"};
537
538         # Check that at least some Euros are given.  Due to Stripe
539         # processing fees and our own costs for bookkeeping we need to ask
540         # for a minimum amount.
541         if ( (not $anyerr) and ($euroamount < 4.00) ) {
542
543             if ($lang eq 'de') {
544                 $msg= 'Um unsere Verwaltungskosten niedrig zu halten,'
545                     . 'können wir leider keine Spenden unter 4 Euro annehmen.';
546             } elsif ($lang eq 'fr') {
547                 $msg = 'Désolé, en raison des frais généraux nous ne pouvons'
548                     . ' pas accepter les donations de moins de 4 euros.';
549             } elsif ($lang eq 'ja') {
550                 $msg = '申し訳ありません。間接経費のため、4ユーロ未満の寄付'
551                     . 'は受け付けることができません。';
552             }
553             else {
554                 $msg = 'Sorry, due to overhead costs we do'
555                     . ' not accept donations of less than 4 Euro.';
556             }
557
558             $errdict{"amount"} = $msg;
559             $anyerr = 1;
560         }
561     }
562
563     # Check the payment type
564     if ( $paytype eq "bc" ) {
565         # No further checks - this is kind of a hack.
566     }
567     elsif ( $paytype ne "cc" and $paytype ne "pp" and $paytype ne "se" ) {
568
569         if ($lang eq 'de') {
570             $msg= 'Keine Zahlungsart angegeben.'
571                 . ' Bitte "Kreditkarte", "PayPal" oder "SEPA" auswählen.';
572         } elsif ($lang eq 'fr') {
573             $msg= 'Aucun type de paiement sélectionné.'
574                 . ' Les options sont "Carte de crédit", "PayPal", ou bien "SEPA".';
575         } elsif ($lang eq 'ja') {
576             $msg= '支払い方式が選択されていません。'
577                 . '"クレジットカード", "PayPal", または "SEPA" が選択できます。';
578         }
579         else {
580             $msg= 'No payment type selected.'
581                 . ' Use "Credit Card", "PayPal", or "SEPA".';
582         }
583
584         $errdict{"paytype"} = $msg;
585         $anyerr = 1;
586     }
587
588     # SEPA credit transfers are only possible in Euro.
589     # (yes, this may overwrite an earlier error message).
590     if ( $paytype eq "se" and $currency ne "EUR" ) {
591         $errdict{"amount"} = 'SEPA transfers are only possible in EUR.';
592         $anyerr = 1;
593     }
594
595     # Check the mail address
596     if ($mail ne '' and $mail !~ /\S+@\S+\.\S+/ ) {
597         $errdict{"mail"} = 'invalid mail address';
598         $anyerr = 1;
599     }
600
601     # If needed present errors and ask again.  */
602     if ($anyerr) {
603         write_main_page();
604         return;
605     }
606
607     # Now create a session.
608     $data{"Lang"} = $lang;
609     $data{"Stripeamount"} = $stripeamount;
610     $data{"Euroamount"} = $euroamount;
611     $data{"Recur"} = $recur;
612     $data{"Name"} = $name;
613     $data{"Mail"} = $mail;
614     $data{"Message"} = $message;
615     $data{"Paytype"} = $paytype;
616     payproc ('SESSION create', \%data ) or fail $data{"ERR_Description"};
617     $sessid = $data{"_SESSID"};
618
619     # Send the checkout page or redirect to paypal
620     if ( $paytype eq "pp" ) {
621         get_paypal_approval ();
622     }
623     elsif ( $paytype eq "se" ) {
624         complete_sepa ();
625     }
626     else {
627         write_checkout_page();
628     }
629 }
630
631 # This simply resends the main page again.
632 sub resend_main_page ()
633 {
634     my %data;
635
636     payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"};
637     # If the session has a lang value use that.
638     if ($data{"Lang"} ne '') {
639         $lang = $data{"Lang"};
640     }
641     $amount = $data{"Amount"};
642     $currency = $data{"Currency"};
643     $recur = $data{"Recur"};
644     $paytype = $data{"Paytype"};
645     $stripeamount = $data{"Stripeamount"};
646     $euroamount = $data{"Euroamount"};
647     $name = $data{"Name"};
648     $mail = $data{"Mail"};
649     $message = $data{"Message"};
650
651     write_main_page();
652 }
653
654
655 # Write a THANKS page.
656 sub write_thanks ($)
657 {
658     my $data = shift;
659     my $recur;
660     my $recur_text = '';
661     my $processor;
662     my $cardno;
663     my $accountid = '-';
664
665     if ( $paytype eq 'cc' ) {
666         $processor = 'Stripe';
667         $cardno = '*' . $$data{"Last4"};
668     } elsif ( $paytype eq 'pp' ) {
669         $processor = 'Paypal';
670         $cardno = '-';
671     } else {
672         $processor = '-';
673         $cardno = '-';
674     }
675
676     if ($$data{"account-id"} ne '') {
677         $accountid = $$data{"account-id"};
678     }
679
680     $recur = $$data{"Recur"};
681     if ( $recur =~ /12/ ) {
682         if ($lang eq 'de')    { $recur_text = 'monatlich'; }
683         elsif ($lang eq 'fr') { $recur_text = 'Mensuelle'; }
684         elsif ($lang eq 'ja') { $recur_text = '毎月'; }
685         else                  { $recur_text = 'Monthly'; }
686     } elsif ( $recur =~ /4/ ) {
687         if ($lang eq 'de')    { $recur_text = 'vierteljährlich'; }
688         elsif ($lang eq 'fr') { $recur_text = 'Trimestrielle'; }
689         elsif ($lang eq 'ja') { $recur_text = '3ヶ月毎'; }
690         else                  { $recur_text = 'Quarterly'; }
691     } elsif ( $recur =~ /1/ ) {
692         if ($lang eq 'de')    { $recur_text = 'jährlich'; }
693         elsif ($lang eq 'fr') { $recur_text = 'Annuelle'; }
694         elsif ($lang eq 'ja') { $recur_text = '毎年'; }
695         else                  { $recur_text = 'Yearly'; }
696     } else {
697         if ($lang eq 'de')    { $recur_text = 'nein'; }
698         elsif ($lang eq 'fr') { $recur_text = 'Unique'; }
699         elsif ($lang eq 'ja') { $recur_text = '一回だけ'; }
700         else                  { $recur_text = 'Just once'; }
701     }
702
703     if ($lang eq 'de') {
704         $message = <<EOF;
705 Betrag ......: $$data{"Amount"} $$data{"Currency"}
706 Dauerauftrag : $recur_text
707 Beschreibung : $$data{"Desc"}
708 Kartennr. ...: $cardno
709 Dienstleister: $processor
710 Charge-Id ...: $$data{"Charge-Id"}
711 Zeitstempel .: $$data{"_timestamp"}
712 Email .......: $$data{"Email"}
713 Spender-ID ..: $accountid
714 EOF
715     } elsif ($lang eq 'fr') {
716          $message = <<EOF;
717 Montant ....: $$data{"Amount"} $$data{"Currency"}
718 Fréquence ..: $recur_text
719 Description : $$data{"Desc"}
720 No. carte ..: $cardno
721 Processeur .: $processor
722 Charge-Id ..: $$data{"Charge-Id"}
723 Date .......: $$data{"_timestamp"}
724 Courriel ...: $$data{"Email"}
725 Account-Id .: $accountid
726 EOF
727     } elsif ($lang eq 'ja') {
728         $message = <<EOF;
729 金額 ......: $$data{"Amount"} $$data{"Currency"}
730 毎回?一回? : $recur_text
731 説明 ......: $$data{"Desc"}
732 カード番号 : $cardno
733 決済業者 ..: $processor
734 Charge-Id .: $$data{"Charge-Id"}
735 時刻 ......: $$data{"_timestamp"}
736 メール ....: $$data{"Email"}
737 Account-Id : $accountid
738 EOF
739     } else {
740          $message = <<EOF;
741 Amount ....: $$data{"Amount"} $$data{"Currency"}
742 Recurring .: $recur_text
743 Desc ......: $$data{"Desc"}
744 Cardno.....: $cardno
745 Processor .: $processor
746 Charge-Id .: $$data{"Charge-Id"}
747 Timestamp .: $$data{"_timestamp"}
748 Email .....: $$data{"Email"}
749 Account-Id : $accountid
750 EOF
751     }
752
753     if ($$data{"Live"} eq 'f') {
754         $message = $message . "\n!!! TEST TRANSACTION !!!";
755     }
756
757     write_thanks_page ();
758 }
759
760
761 # This is called by FIXME
762 sub complete_stripe_checkout ()
763 {
764     my %data;
765     my %stripe;
766     my $recur;
767     my $recur_text = '';
768
769     # fixme: Change the error message to note that the card has not
770     # been charged.  Somehow delete the token
771     payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"};
772
773     if ( $data{"Paytype"} ne "cc" ) {
774         fail "Invalid paytype for Stripe transaction";
775     }
776     $paytype = $data{"Paytype"};
777
778     # If the session has a lang value use that.
779     if ($data{"Lang"} ne '') {
780         $lang = $data{"Lang"};
781     }
782
783     # Do the checkout.
784     $stripe{"Card-Token"} = $q->param("stripeToken");
785     $stripe{"Currency"} = $data{"Currency"};
786     $stripe{"Amount"} = $data{"Amount"};
787     $stripe{"Desc"} =
788         "GnuPG donation by " . $data{"Name"} . " <" . $data{"Mail"} . ">";
789     $stripe{"Stmt-Desc"} = "GnuPG donation";
790     $stripe{"Email"} = $q->param("stripeEmail");
791     $stripe{"Recur"} = $data{"Recur"};
792     $stripe{"Meta[name]"} = $data{"Name"} unless $data{"Name"} eq 'Anonymous';
793     if ($data{"Mail"} ne $q->param("stripeEmail")) {
794         $stripe{"Meta[mail]"} = $data{"Mail"};
795     }
796     if ($data{"Message"} ne '') {
797         $stripe{"Meta[message]"} = $data{"Message"};
798     }
799     if (not payproc ('CHARGECARD', \%stripe)) {
800         $errorstr =
801             '<p>Error: ' . $stripe{"failure"} . '</p><p>'
802             . $stripe{"failure-mesg"} . '</p>';
803         # Again.
804         write_checkout_page ();
805         return;
806     }
807
808     # Print thanks
809     write_thanks (\%stripe);
810     payproc ('SESSION destroy ' . $sessid, ());
811 }
812
813
814 # Initiate a payment with paypal and redirect to the Paypal site.
815 sub get_paypal_approval ()
816 {
817     my %data;
818     my %request;
819     my $redirurl;
820
821     payproc ('SESSION get ' . $sessid, \%data)
822         or fail $data{"ERR_Description"};
823
824     # If the session has a lang value use that.
825     if ($data{"Lang"} ne '') {
826         $lang = $data{"Lang"};
827     }
828
829     $request{"Currency"} = $data{"Currency"};
830     $request{"Amount"} = $data{"Amount"};
831     $request{"Recur"} = $data{"Recur"};
832     $request{"Desc"} =
833         "Donation of " . $data{"Amount"} . " " . $data{"Currency"} .
834         " to the GnuPG project";
835     $request{"Email"} = $data{"Mail"};
836     $request{"Meta[name]"} = $data{"Name"} unless
837         $data{"Name"} eq 'Anonymous';
838     $request{"Meta[mail]"} = $data{"Mail"};
839     if ($data{"Message"} ne '') {
840         $request{"Meta[message]"} = $data{"Message"};
841     }
842     $request{"Return-Url"} =
843         $baseurl . "/cgi-bin/procdonate.cgi?mode=confirm-paypal";
844     $request{"Cancel-Url"} =
845         $baseurl . "/cgi-bin/procdonate.cgi?mode=cancel-paypal";
846     $request{"Session-Id"} = $sessid;
847
848     if (payproc ('GETINFO live', ())) {
849       $request{"Paypal-Xp"} = "XP-HD8G-XZRE-W7MH-EYNF";
850     } else {
851       $request{"Paypal-Xp"} = "XP-NBWZ-QR6Z-8CXV-Q8XS";
852     }
853
854     if (not payproc ('PPCHECKOUT prepare', \%request)) {
855         $errorstr = $request{"ERR_Description"};
856         # Back to the main page.
857         write_main_page();
858         return;
859     }
860
861     $redirurl = $request{"Redirect-Url"};
862
863     #print STDERR "Redirecting to: $redirurl\n";
864     print $q->redirect($redirurl) unless $redirurl eq "";
865 }
866
867
868 # The is called by paypal after the user hit cancel.  We need to
869 # extract the alias to get back the session data.
870 sub cancel_paypal_checkout ()
871 {
872     my $aliasid;
873     my $payerid;
874     my %data;
875
876     $aliasid = $q->param("aliasid");
877
878     # Get the session from the alias.
879     payproc ('SESSION sessid ' . $aliasid, \%data)
880         or fail $data{"ERR_Description"};
881     $sessid = $data{"_SESSID"};
882     payproc ('SESSION get ' . $sessid, \%data)
883         or fail $data{"ERR_Description"};
884
885     # If the session has a lang value use that.
886     if ($data{"Lang"} ne '') {
887         $lang = $data{"Lang"};
888     }
889
890     if ( $data{"Paytype"} ne "pp" ) {
891         fail "Invalid paytype for Paypal transaction";
892     }
893
894     # Set vars for the checkout page.
895     $amount = $data{"Amount"};
896     $currency = $data{"Currency"};
897     $paytype = $data{"Paytype"};
898     $stripeamount = $data{"Stripeamount"};
899     $euroamount = $data{"Euroamount"};
900     $recur = $data{"Recur"};
901     $name = $data{"Name"};
902     $mail = $data{"Mail"};
903     $message = $data{"Message"};
904
905     write_cancel_page ();
906 }
907
908
909 # The is called by paypal after approval.  We need to extract the alias
910 # and the payerid and store it in the session.  Then we ask to confirm
911 # the payment.
912 sub confirm_paypal_checkout ()
913 {
914     my $aliasid;
915     my $payerid;
916     my %data;
917
918     $aliasid = $q->param("aliasid");
919     $payerid = $q->param("PayerID");
920
921     # Get the session from the alias and store the aliasid and the
922     # payerid in the session.
923     payproc ('SESSION sessid ' . $aliasid, \%data)
924         or fail $data{"ERR_Description"};
925     $sessid = $data{"_SESSID"};
926     payproc ('SESSION get ' . $sessid, \%data)
927         or fail $data{"ERR_Description"};
928
929     # If the session has a lang value use that.
930     if ($data{"Lang"} ne '') {
931         $lang = $data{"Lang"};
932     }
933
934     if ( $data{"Paytype"} ne "pp" ) {
935         fail "Invalid paytype for Paypal transaction";
936     }
937
938     # Put a description for the thanks page into the session data.
939     # We do this only now because we send a reduced Desc field to paypal.
940     $data{"Desc"} =
941         "GnuPG donation by " . $data{"Name"} . " <" . $data{"Mail"} . ">";
942
943     # Note that the capitalization of session data names must match
944     # the rules of payprocd.
945     $data{"Paypal_aliasid"} = $aliasid;
946     $data{"Paypal_payerid"} = $payerid;
947
948     # Set vars for the checkout page.
949     $amount = $data{"Amount"};
950     $currency = $data{"Currency"};
951     $paytype = $data{"Paytype"};
952     $stripeamount = $data{"Stripeamount"};
953     $euroamount = $data{"Euroamount"};
954     $recur = $data{"Recur"};
955     $name = $data{"Name"};
956     $mail = $data{"Mail"};
957     $message = $data{"Message"};
958
959     # Store the session after setting the above vars because that call
960     # clears DATA.
961     payproc ('SESSION put ' . $sessid, \%data)
962         or fail $data{"ERR_Description"};
963
964     # Write the checkout (i.e. confirm payment) page
965     write_checkout_page ();
966 }
967
968
969 # The approved Paypal payment has been approved.  Now execute the
970 # payment.
971 sub complete_paypal_checkout ()
972 {
973     my %data;
974     my %request;
975
976     payproc ('SESSION get ' . $sessid, \%data) or fail $data{"ERR_Description"};
977
978     $request{"Alias-Id"}     = $data{"Paypal_aliasid"};
979     $request{"Paypal-Payer"} = $data{"Paypal_payerid"};
980
981     if (not payproc ('PPCHECKOUT execute', \%request)) {
982         $errorstr =
983             '<p>Error: ' . $request{"failure"} . '</p><p>'
984             . $request{"failure-mesg"} . '</p>';
985
986         print $q->header(-type=>'text/html', -charset=>'utf-8');
987         print "\n";
988         write_template("donate/error.html");
989         return;
990     }
991
992     # Copy some values for use by the thanks page.
993     $request{"Desc"} = $data{"Desc"};
994     $request{"Recur"} = $data{"Recur"};
995     $request{"Paytype"} = $data{"Paytype"};
996     $paytype = $data{"Paytype"};
997
998     write_thanks (\%request);
999     payproc ('SESSION destroy ' . $sessid, ());
1000 }
1001
1002
1003 # Complete the SEPA payment: Check values and show final page.
1004 sub complete_sepa ()
1005 {
1006     my %data;
1007     my %request;
1008
1009     payproc ('SESSION get ' . $sessid, \%data)
1010         or fail $data{"ERR_Description"};
1011
1012     # If the session has a lang value use that.
1013     if ($data{"Lang"} ne '') {
1014         $lang = $data{"Lang"};
1015     }
1016
1017     $request{"Currency"} = $data{"Currency"};
1018     $request{"Amount"} = $data{"Amount"};
1019     $request{"Desc"} = "GnuPG SEPA donation";
1020     $request{"Email"} = $data{"Mail"} unless $data{"Mail"} eq '';
1021     $request{"Meta[name]"} = $data{"Name"} unless $data{"Name"} eq 'Anonymous';
1022     if ($data{"Message"} ne '') {
1023         $request{"Meta[message]"} = $data{"Message"};
1024     }
1025     if (not payproc ('SEPAPREORDER', \%request )) {
1026         $errorstr = "Error: " . $request{"ERR_Description"};
1027         # Back to the main page.
1028         write_main_page ();
1029         return;
1030     }
1031     $separef = $request{"Sepa-Ref"};
1032     $amount = $request{"Amount"};
1033
1034     # Set remaining vars for the checkout page.
1035     $currency = $data{"Currency"};
1036     $paytype = $data{"Paytype"};
1037     $stripeamount = $data{"Stripeamount"};
1038     $euroamount = $data{"Euroamount"};
1039     $recur = $data{"Recur"};
1040     $name = $data{"Name"};
1041     $mail = $data{"Mail"};
1042     $message = $data{"Message"};
1043
1044     write_checkout_page ();
1045 }
1046
1047
1048 # Send a PING command to see whether payprocd is alive.
1049 sub ping_pong ()
1050 {
1051     my %data = ();
1052
1053     if (payproc ('PING', \%data )) {
1054        print $q->header(-type=>'text/HTML', -charset=>'utf-8');
1055        print "\n";
1056        print "<p>OK</p>\n";
1057     }
1058 }
1059
1060
1061 #
1062 # Main
1063 #
1064
1065 #print STDERR "CGI called with mode=$mode\n";
1066 #print STDERR "CGI called with sessid=$sessid\n";
1067 if ($q->param('url') ne '') {
1068     # If the URL field has been filled out, the client did not follow
1069     # the instructions and thus failed the Turing test.  Provide an
1070     # innocent error page.
1071     write_overload_page ()
1072 }
1073 elsif ($mode eq '') {
1074     # No mode: Show empty template.
1075     write_main_page();
1076 }
1077 elsif ($mode eq 'preset') {
1078     # Show a a template with certain preset values.
1079     $currency = 'EUR';
1080     $paytype = 'cc';
1081     # First dedicated payment plans.
1082     if ($q->param('plan') eq '12-5-eur' ) {
1083         $recur = '4';
1084         $amount = '15';
1085         $notepanel = 'Note: To avoid overhead costs we adjusted your donation '
1086             . 'from monthly to the equal quarterly amount';
1087     }
1088     elsif ($q->param('plan') eq '12-10-eur' ) {
1089         $recur = '12';
1090         $amount = '10';
1091     }
1092     elsif ($q->param('plan') eq '12-20-eur' ) {
1093         $recur = '12';
1094         $amount = '20';
1095     }
1096     elsif ($q->param('plan') eq '12-50-eur' ) {
1097         $recur = '12';
1098         $amount = '50';
1099     }
1100     else {
1101         # Then look at arbitrary values
1102         # No checking needed.
1103         $recur = '0';
1104         if ($q->param('s_amt') ne '') {
1105             $amount = int $q->param('s_amt');
1106         }
1107         if ($q->param('s_cur') ne '') {
1108             $currency = $q->param('s_cur');
1109         }
1110         if ($q->param('s_pt') ne '') {
1111             $paytype = $q->param('s_pt');
1112         }
1113     }
1114
1115     write_main_page();
1116 }
1117 elsif ($mode eq 'ping') {
1118     # Check aliveness
1119     ping_pong();
1120 }
1121 elsif ($mode eq 'main') {
1122     # Returning from the donation start page
1123     check_donation();
1124 }
1125 elsif ($mode eq 're-main') {
1126     # Returning from the donation start page
1127     resend_main_page();
1128 }
1129 elsif ($mode eq 'checkout-stripe') {
1130     # we have the stripe token - charge the card.
1131     complete_stripe_checkout();
1132 }
1133 elsif ($mode eq 'cancel-paypal') {
1134     # Paypal transaction has been canceled by Paypal or the user.
1135     # Show the cancel page which has a button to return to the
1136     # main donation page.
1137     cancel_paypal_checkout();
1138 }
1139 elsif ($mode eq 'confirm-paypal') {
1140     # We have approval from Paypal - show the confirm checkout page.
1141     confirm_paypal_checkout();
1142 }
1143 elsif ($mode eq 'checkout-paypal') {
1144     # The approved Paypal payment has been approved - charge.
1145     complete_paypal_checkout();
1146 }
1147 elsif ($mode eq 'pong') {
1148     # Helper to test a script checking PING.
1149     fail "Error connecting to payprocd: Forced to fail";
1150 }
1151 else {
1152     fail('Internal error: Unknown mode');
1153 }