hopefully the really final fix for the problems using remembered cards in self-servic...
[freeside.git] / fs_selfservice / FS-SelfService / cgi / selfservice.cgi
1 #!/usr/bin/perl -Tw
2
3 use strict;
4 use vars qw($DEBUG $cgi $session_id $form_max $template_dir);
5 use subs qw(do_template);
6 use CGI;
7 use CGI::Carp qw(fatalsToBrowser);
8 use Text::Template;
9 use HTML::Entities;
10 use Date::Format;
11 use Number::Format 1.50;
12 use FS::SelfService qw(
13   access_info login_info login customer_info edit_info invoice
14   payment_info process_payment realtime_collect process_prepay
15   list_pkgs order_pkg signup_info order_recharge
16   part_svc_info provision_acct provision_external
17   unprovision_svc change_pkg domainselector
18   list_svcs list_svc_usage list_cdr_usage list_support_usage
19   myaccount_passwd
20   mason_comp
21 );
22
23 $template_dir = '.';
24
25 $DEBUG = 1;
26
27 $form_max = 255;
28
29 $cgi = new CGI;
30
31 unless ( defined $cgi->param('session') ) {
32   my $login_info = login_info();
33
34   do_template('login', $login_info );
35   exit;
36 }
37
38 if ( $cgi->param('session') eq 'login' ) {
39
40   $cgi->param('username') =~ /^\s*([a-z0-9_\-\.\&]{0,$form_max})\s*$/i
41     or die "illegal username";
42   my $username = $1;
43
44   $cgi->param('domain') =~ /^\s*([\w\-\.]{0,$form_max})\s*$/
45     or die "illegal domain";
46   my $domain = $1;
47
48   $cgi->param('password') =~ /^(.{0,$form_max})$/
49     or die "illegal password";
50   my $password = $1;
51
52   my $rv = login(
53     'username' => $username,
54     'domain'   => $domain,
55     'password' => $password,
56   );
57   if ( $rv->{error} ) {
58     my $login_info = login_info();
59     do_template('login', {
60       'error'    => $rv->{error},
61       'username' => $username,
62       'domain'   => $domain,
63       %$login_info,
64     } );
65     exit;
66   } else {
67     $cgi->param('session' => $rv->{session_id} );
68     $cgi->param('action'  => 'myaccount' );
69   }
70 }
71
72 $session_id = $cgi->param('session');
73
74 #order|pw_list XXX ???
75 $cgi->param('action') =~
76     /^(myaccount|view_invoice|make_payment|make_ach_payment|make_thirdparty_payment|payment_results|ach_payment_results|recharge_prepay|recharge_results|logout|change_bill|change_ship|change_pay|process_change_bill|process_change_ship|process_change_pay|customer_order_pkg|process_order_pkg|customer_change_pkg|process_change_pkg|process_order_recharge|provision|provision_svc|process_svc_acct|process_svc_external|delete_svc|view_usage|view_usage_details|view_cdr_details|view_support_details|change_password|process_change_password)$/
77   or die "unknown action ". $cgi->param('action');
78 my $action = $1;
79
80 warn "calling $action sub\n"
81   if $DEBUG;
82 $FS::SelfService::DEBUG = $DEBUG;
83 my $result = eval "&$action();";
84 die $@ if $@;
85
86 if ( $result->{error} eq "Can't resume session"
87   || $result->{error} eq "Expired session" ) { #ick
88
89   my $login_info = login_info();
90   do_template('login', $login_info);
91   exit;
92 }
93
94 #warn $result->{'open_invoices'};
95 #warn scalar(@{$result->{'open_invoices'}});
96
97 warn "processing template $action\n"
98   if $DEBUG;
99 do_template($action, {
100   'session_id' => $session_id,
101   'action'     => $action, #so the menu knows what tab we're on...
102   #%{ payment_info( 'session_id' => $session_id ) },  # cust_paybys for the menu
103   %{$result}
104 });
105
106 #--
107
108 sub myaccount { customer_info( 'session_id' => $session_id ); }
109
110 sub change_bill { my $payment_info =
111                     payment_info( 'session_id' => $session_id );
112                   return $payment_info if ( $payment_info->{'error'} );
113                   my $customer_info =
114                     customer_info( 'session_id' => $session_id );
115                   return { 
116                     %$payment_info,
117                     %$customer_info,
118                   };
119                 }
120 sub change_ship { change_bill(@_); }
121 sub change_pay { change_bill(@_); }
122
123 sub _process_change_info { 
124   my ($erroraction, @fields) = @_;
125
126   my $results = '';
127
128   $results ||= edit_info (
129     'session_id' => $session_id,
130     map { ($_ => $cgi->param($_)) } grep { defined($cgi->param($_)) } @fields,
131   );
132
133
134   if ( $results->{'error'} ) {
135     no strict 'refs';
136     $action = $erroraction;
137     return {
138       $cgi->Vars,
139       %{&$action()},
140       'error' => '<FONT COLOR="#FF0000">'. $results->{'error'}. '</FONT>',
141     };
142   } else {
143     return $results;
144   }
145 }
146
147 sub process_change_bill {
148         _process_change_info( 'change_bill', 
149           qw( first last company address1 address2 city state
150               county zip country daytime night fax )
151         );
152 }
153
154 sub process_change_ship {
155         my @list = map { "ship_$_" }
156                      qw( first last company address1 address2 city state
157                          county zip country daytime night fax 
158                        );
159         if ($cgi->param('same') eq 'Y') {
160           foreach (@list) { $cgi->param($_, '') }
161         }
162
163         _process_change_info( 'change_ship', @list );
164 }
165
166 sub process_change_pay {
167         my $postal = $cgi->param( 'postal_invoicing' );
168         my $payby  = $cgi->param( 'payby' );
169         my @list =
170           qw( payby payinfo payinfo1 payinfo2 month year payname
171               address1 address2 city county state zip country auto paytype
172               paystate ss stateid stateid_state invoicing_list
173             );
174         push @list, 'postal_invoicing' if $postal;
175         unless (    $payby ne 'BILL'
176                  || $postal
177                  || $cgi->param( 'invoicing_list' )
178                )
179         {
180           $action = 'change_pay';
181           return {
182             %{&change_pay()},
183             $cgi->Vars,
184             'error' => '<FONT COLOR="#FF0000">Postal or email required.</FONT>',
185           };
186         }
187         _process_change_info( 'change_pay', @list );
188 }
189
190 sub view_invoice {
191
192   $cgi->param('invnum') =~ /^(\d+)$/ or die "illegal invnum";
193   my $invnum = $1;
194
195   invoice( 'session_id' => $session_id,
196            'invnum'     => $invnum,
197          );
198
199 }
200
201 sub customer_order_pkg {
202   my $init_data = signup_info( 'customer_session_id' => $session_id );
203   return $init_data if ( $init_data->{'error'} );
204
205   my $customer_info = customer_info( 'session_id' => $session_id );
206   return $customer_info if ( $customer_info->{'error'} );
207
208   my $pkgselect = mason_comp(
209     'session_id' => $session_id,
210     'comp'       => '/edit/cust_main/first_pkg/select-part_pkg.html',
211     'args'       => [ 'password_verify' => 1,
212                       'onchange'        => 'enable_order_pkg()',
213                       'relurls'         => 1,
214                       'empty_label'     => 'Select package',
215                     ],
216   );
217
218   $pkgselect = $pkgselect->{'error'} || $pkgselect->{'output'};
219
220   return {
221     ( map { $_ => $init_data->{$_} }
222           qw( part_pkg security_phrase svc_acct_pop ),
223     ),
224     %$customer_info,
225     'pkg_selector' => $pkgselect,
226   };
227 }
228
229 sub customer_change_pkg {
230   my $init_data = signup_info( 'customer_session_id' => $session_id );
231   return $init_data if ( $init_data->{'error'} );
232
233   my $customer_info = customer_info( 'session_id' => $session_id );
234   return $customer_info if ( $customer_info->{'error'} );
235
236   return {
237     ( map { $_ => $init_data->{$_} }
238           qw( part_pkg security_phrase svc_acct_pop ),
239     ),
240     ( map { $_ => $cgi->param($_) }
241         qw( pkgnum pkg )
242     ),
243     %$customer_info,
244   };
245 }
246
247 sub process_order_pkg {
248
249   my $results = '';
250
251   my @params = (qw( custnum pkgpart ));
252   my $svcdb = '';
253   if ( $cgi->param('pkgpart_svcpart') =~ /^(\d+)_(\d+)$/ ) {
254     $cgi->param('pkgpart', $1);
255     $cgi->param('svcpart', $2);
256     push @params, 'svcpart';
257     $svcdb = $cgi->param('svcdb');
258     push @params, 'domsvc' if $svcdb eq 'svc_acct';
259   } else {
260     $svcdb = 'svc_acct';
261   }
262
263   if ( $svcdb eq 'svc_acct' ) {
264
265     push @params, qw( username _password _password2 sec_phrase popnum );
266
267     unless ( length($cgi->param('_password')) ) {
268       my $init_data = signup_info( 'customer_session_id' => $session_id );
269       $results = { 'error' => $init_data->{msgcat}{empty_password} };
270       $results = { 'error' => $init_data->{error} } if($init_data->{error});
271     }
272     if ( $cgi->param('_password') ne $cgi->param('_password2') ) {
273       my $init_data = signup_info( 'customer_session_id' => $session_id );
274       $results = { 'error' => $init_data->{msgcat}{passwords_dont_match} };
275       $results = { 'error' => $init_data->{error} } if($init_data->{error});
276       $cgi->param('_password', '');
277       $cgi->param('_password2', '');
278     }
279
280   } elsif ( $svcdb eq 'svc_phone' ) {
281
282     push @params, qw( phonenum sip_password pin phone_name );
283
284   } else {
285     die "$svcdb not handled on process_order_pkg yet";
286   }
287
288   $results ||= order_pkg (
289     'session_id' => $session_id,
290     map { $_ => $cgi->param($_) } @params
291   );
292
293
294   if ( $results->{'error'} ) {
295     $action = 'customer_order_pkg';
296     return {
297       $cgi->Vars,
298       %{customer_order_pkg()},
299       'error' => '<FONT COLOR="#FF0000">'. $results->{'error'}. '</FONT>',
300     };
301   } else {
302     return $results;
303   }
304
305 }
306
307 sub process_change_pkg {
308
309   my $results = '';
310
311   $results ||= change_pkg (
312     'session_id' => $session_id,
313     map { $_ => $cgi->param($_) }
314         qw( pkgpart pkgnum )
315   );
316
317
318   if ( $results->{'error'} ) {
319     $action = 'customer_change_pkg';
320     return {
321       $cgi->Vars,
322       %{customer_change_pkg()},
323       'error' => '<FONT COLOR="#FF0000">'. $results->{'error'}. '</FONT>',
324     };
325   } else {
326     return $results;
327   }
328
329 }
330
331 sub process_order_recharge {
332
333   my $results = '';
334
335   $results ||= order_recharge (
336     'session_id' => $session_id,
337     map { $_ => $cgi->param($_) }
338         qw( svcnum )
339   );
340
341
342   if ( $results->{'error'} ) {
343     $action = 'view_usage';
344     if ($results->{'error'} eq '_decline') {
345       $results->{'error'} = "There has been an error processing your account.  Please contact customer support."
346     }
347     return {
348       $cgi->Vars,
349       %{view_usage()},
350       'error' => '<FONT COLOR="#FF0000">'. $results->{'error'}. '</FONT>',
351     };
352   } else {
353     return $results;
354   }
355
356 }
357
358 sub make_payment {
359   payment_info( 'session_id' => $session_id );
360 }
361
362 sub payment_results {
363
364   use Business::CreditCard 0.30;
365
366   #we should only do basic checking here for DoS attacks and things
367   #that couldn't be constructed by the web form...  let process_payment() do
368   #the rest, it gives better error messages
369
370   $cgi->param('amount') =~ /^\s*(\d+(\.\d{2})?)\s*$/
371     or die "Illegal amount: ". $cgi->param('amount'); #!!!
372   my $amount = $1;
373
374   my $payinfo = $cgi->param('payinfo');
375   $payinfo =~ s/[^\dx]//g;
376   $payinfo =~ /^([\dx]{13,16})$/
377     #or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo;
378     or die "illegal card"; #!!!
379   $payinfo = $1;
380   unless ( $payinfo =~ /x/ ) {
381     validate($payinfo)
382       #or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo;
383       or die "invalid card"; #!!!
384   }
385
386   if ( $cgi->param('card_type') ) {
387     cardtype($payinfo) eq $cgi->param('card_type')
388       #or $error ||= $init_data->{msgcat}{not_a}. $cgi->param('CARD_type');
389       or die "not a ". $cgi->param('card_type');
390   }
391
392   $cgi->param('paycvv') =~ /^\s*(.{0,4})\s*$/ or die "illegal CVV2";
393   my $paycvv = $1;
394
395   $cgi->param('month') =~ /^(\d{2})$/ or die "illegal month";
396   my $month = $1;
397   $cgi->param('year') =~ /^(\d{4})$/ or die "illegal year";
398   my $year = $1;
399
400   $cgi->param('payname') =~ /^(.{0,80})$/ or die "illegal payname";
401   my $payname = $1;
402
403   $cgi->param('address1') =~ /^(.{0,80})$/ or die "illegal address1";
404   my $address1 = $1;
405
406   $cgi->param('address2') =~ /^(.{0,80})$/ or die "illegal address2";
407   my $address2 = $1;
408
409   $cgi->param('city') =~ /^(.{0,80})$/ or die "illegal city";
410   my $city = $1;
411
412   $cgi->param('state') =~ /^(.{0,80})$/ or die "illegal state";
413   my $state = $1;
414
415   $cgi->param('zip') =~ /^(.{0,10})$/ or die "illegal zip";
416   my $zip = $1;
417
418   $cgi->param('country') =~ /^(.{0,2})$/ or die "illegal country";
419   my $country = $1;
420
421   my $save = 0;
422   $save = 1 if $cgi->param('save');
423
424   my $auto = 0;
425   $auto = 1 if $cgi->param('auto');
426
427   $cgi->param('paybatch') =~ /^([\w\-\.]+)$/ or die "illegal paybatch";
428   my $paybatch = $1;
429
430   process_payment(
431     'session_id' => $session_id,
432     'payby'      => 'CARD',
433     'amount'     => $amount,
434     'payinfo'    => $payinfo,
435     'paycvv'     => $paycvv,
436     'month'      => $month,
437     'year'       => $year,
438     'payname'    => $payname,
439     'address1'   => $address1,
440     'address2'   => $address2,
441     'city'       => $city,
442     'state'      => $state,
443     'zip'        => $zip,
444     'country'    => $country,
445     'save'       => $save,
446     'auto'       => $auto,
447     'paybatch'   => $paybatch,
448   );
449
450 }
451
452 sub make_ach_payment {
453   payment_info( 'session_id' => $session_id );
454 }
455
456 sub ach_payment_results {
457
458   #we should only do basic checking here for DoS attacks and things
459   #that couldn't be constructed by the web form...  let process_payment() do
460   #the rest, it gives better error messages
461
462   $cgi->param('amount') =~ /^\s*(\d+(\.\d{2})?)\s*$/
463     or die "illegal amount"; #!!!
464   my $amount = $1;
465
466   my $payinfo1 = $cgi->param('payinfo1');
467   $payinfo1=~ /^(\d+)$/
468     or die "illegal account"; #!!!
469   $payinfo1= $1;
470
471   my $payinfo2 = $cgi->param('payinfo2');
472   $payinfo2=~ /^(\d+)$/
473     or die "illegal ABA/routing code"; #!!!
474   $payinfo2= $1;
475
476   $cgi->param('payname') =~ /^(.{0,80})$/ or die "illegal payname";
477   my $payname = $1;
478
479   $cgi->param('paystate') =~ /^(.{0,2})$/ or die "illegal paystate";
480   my $paystate = $1;
481
482   $cgi->param('paytype') =~ /^(.{0,80})$/ or die "illegal paytype";
483   my $paytype = $1;
484
485   $cgi->param('ss') =~ /^(.{0,80})$/ or die "illegal ss";
486   my $ss = $1;
487
488   $cgi->param('stateid') =~ /^(.{0,80})$/ or die "illegal stateid";
489   my $stateid = $1;
490
491   $cgi->param('stateid_state') =~ /^(.{0,2})$/ or die "illegal stateid_state";
492   my $stateid_state = $1;
493
494   my $save = 0;
495   $save = 1 if $cgi->param('save');
496
497   my $auto = 0;
498   $auto = 1 if $cgi->param('auto');
499
500   $cgi->param('paybatch') =~ /^([\w\-\.]+)$/ or die "illegal paybatch";
501   my $paybatch = $1;
502
503   process_payment(
504     'session_id' => $session_id,
505     'payby'      => 'CHEK',
506     'amount'     => $amount,
507     'payinfo1'   => $payinfo1,
508     'payinfo2'   => $payinfo2,
509     'month'      => '12',
510     'year'       => '2037',
511     'payname'    => $payname,
512     'paytype'    => $paytype,
513     'paystate'   => $paystate,
514     'ss'         => $ss,
515     'stateid'    => $stateid,
516     'stateid_state' => $stateid_state,
517     'save'       => $save,
518     'auto'       => $auto,
519     'paybatch'   => $paybatch,
520   );
521
522 }
523
524 sub make_thirdparty_payment {
525   $cgi->param('payby_method') =~ /^(CC|ECHECK)$/
526     or die "illegal payby method";
527   realtime_collect( 'session_id' => $session_id, 'method' => $1 );
528 }
529
530 sub recharge_prepay {
531   customer_info( 'session_id' => $session_id );
532 }
533
534 sub recharge_results {
535
536   my $prepaid_cardnum = $cgi->param('prepaid_cardnum');
537   $prepaid_cardnum =~ s/\W//g;
538   $prepaid_cardnum =~ /^(\w*)$/ or die "illegal prepaid card number";
539   $prepaid_cardnum = $1;
540
541   process_prepay ( 'session_id'     => $session_id,
542                    'prepaid_cardnum' => $prepaid_cardnum,
543                  );
544 }
545
546 sub logout {
547   FS::SelfService::logout( 'session_id' => $session_id );
548 }
549
550 sub provision {
551   my $result = list_pkgs( 'session_id' => $session_id );
552   die $result->{'error'} if exists $result->{'error'} && $result->{'error'};
553   $result;
554 }
555
556 sub provision_svc {
557
558   my $result = part_svc_info(
559     'session_id' => $session_id,
560     map { $_ => $cgi->param($_) } qw( pkgnum svcpart ),
561   );
562   die $result->{'error'} if exists $result->{'error'} && $result->{'error'};
563
564   $result->{'svcdb'} =~ /^svc_(.*)$/
565     #or return { 'error' => 'Unknown svcdb '. $result->{'svcdb'} };
566     or die 'Unknown svcdb '. $result->{'svcdb'};
567   $action .= "_$1";
568
569   $result;
570 }
571
572 sub process_svc_acct {
573
574   my $result = provision_acct (
575     'session_id' => $session_id,
576     map { $_ => $cgi->param($_) } qw(
577       pkgnum svcpart username domsvc _password _password2 sec_phrase popnum )
578   );
579
580   if ( exists $result->{'error'} && $result->{'error'} ) { 
581     #warn "$result $result->{'error'}"; 
582     $action = 'provision_svc_acct';
583     return {
584       $cgi->Vars,
585       %{ part_svc_info( 'session_id' => $session_id,
586                         map { $_ => $cgi->param($_) } qw( pkgnum svcpart )
587                       )
588       },
589       'error' => $result->{'error'},
590     };
591   } else {
592     #warn "$result $result->{'error'}"; 
593     return $result;
594   }
595
596 }
597
598 sub process_svc_external {
599   provision_external (
600     'session_id' => $session_id,
601     map { $_ => $cgi->param($_) } qw( pkgnum svcpart )
602   );
603 }
604
605 sub delete_svc {
606   unprovision_svc(
607     'session_id' => $session_id,
608     'svcnum'     => $cgi->param('svcnum'),
609   );
610 }
611
612 sub view_usage {
613   list_svcs(
614     'session_id'  => $session_id,
615     'svcdb'       => [ 'svc_acct', 'svc_phone' ],
616     'ncancelled'  => 1,
617   );
618 }
619
620 sub view_usage_details {
621   list_svc_usage(
622     'session_id'  => $session_id,
623     'svcnum'      => $cgi->param('svcnum'),
624     'beginning'   => $cgi->param('beginning') || '',
625     'ending'      => $cgi->param('ending') || '',
626   );
627 }
628
629 sub view_cdr_details {
630   list_cdr_usage(
631     'session_id'  => $session_id,
632     'svcnum'      => $cgi->param('svcnum'),
633     'beginning'   => $cgi->param('beginning') || '',
634     'ending'      => $cgi->param('ending') || '',
635   );
636 }
637
638 sub view_support_details {
639   list_support_usage(
640     'session_id'  => $session_id,
641     'svcnum'      => $cgi->param('svcnum'),
642     'beginning'   => $cgi->param('beginning') || '',
643     'ending'      => $cgi->param('ending') || '',
644   );
645 }
646
647 sub change_password {
648   list_svcs(
649     'session_id' => $session_id,
650     'svcdb'      => 'svc_acct',
651   );
652 };
653
654 sub process_change_password {
655
656   my $result = myaccount_passwd(
657     'session_id'    => $session_id,
658     map { $_ => $cgi->param($_) } qw( svcnum new_password new_password2 )
659   );
660
661   if ( exists $result->{'error'} && $result->{'error'} ) { 
662
663     $action = 'change_password';
664     return {
665       $cgi->Vars,
666       %{ list_svcs( 'session_id' => $session_id,
667                     'svcdb'      => 'svc_acct',
668                   )
669        },
670       #'svcnum' => $cgi->param('svcnum'),
671       'error'  => $result->{'error'}
672     };
673
674  } else {
675
676    return $result;
677
678  }
679
680 }
681
682 #--
683
684 sub do_template {
685   my $name = shift;
686   my $fill_in = shift;
687
688   $cgi->delete_all();
689   $fill_in->{'selfurl'} = $cgi->self_url;
690   $fill_in->{'cgi'} = \$cgi;
691
692   my $access_info = $session_id
693                       ? access_info( 'session_id' => $session_id )
694                       : {};
695   $fill_in->{$_} = $access_info->{$_} foreach keys %$access_info;
696
697   my $source = "$template_dir/$name.html";
698   #warn "creating template for $source\n";
699   my $template = new Text::Template( TYPE       => 'FILE',
700                                      SOURCE     => $source,
701                                      DELIMITERS => [ '<%=', '%>' ],
702                                      UNTAINT    => 1,
703                                    )
704     or die $Text::Template::ERROR;
705
706   #warn "filling in $template with $fill_in\n";
707   print $cgi->header( '-expires' => 'now' ),
708         $template->fill_in( PACKAGE => 'FS::SelfService::_selfservicecgi',
709                             HASH    => $fill_in
710                           );
711 }
712
713 #*FS::SelfService::_selfservicecgi::include = \&Text::Template::fill_in_file;
714
715 package FS::SelfService::_selfservicecgi;
716
717 #use FS::SelfService qw(regionselector expselect popselector);
718 use HTML::Entities;
719 use FS::SelfService qw(regionselector popselector domainselector location_form);
720
721 #false laziness w/agent.cgi
722 sub include {
723   my $name = shift;
724   my $template = new Text::Template( TYPE   => 'FILE',
725                                      SOURCE => "$main::template_dir/$name.html",
726                                      DELIMITERS => [ '<%=', '%>' ],
727                                      UNTAINT => 1,                   
728                                    )
729     or die $Text::Template::ERROR;
730
731   $template->fill_in( PACKAGE => 'FS::SelfService::_selfservicecgi',
732                       #HASH    => $fill_in
733                     );
734
735 }
736