banned card hashing rewrite, RT#32290, RT#23741
[freeside.git] / FS / FS / Upgrade.pm
1 package FS::Upgrade;
2
3 use strict;
4 use vars qw( @ISA @EXPORT_OK $DEBUG );
5 use Exporter;
6 use Tie::IxHash;
7 use File::Slurp;
8 use FS::UID qw( dbh driver_name );
9 use FS::Conf;
10 use FS::Record qw(qsearchs qsearch str2time_sql);
11 use FS::queue;
12 use FS::upgrade_journal;
13 use FS::Setup qw( enable_banned_pay_pad );
14
15 use FS::svc_domain;
16 $FS::svc_domain::whois_hack = 1;
17
18 @ISA = qw( Exporter );
19 @EXPORT_OK = qw( upgrade_schema upgrade_config upgrade upgrade_sqlradius );
20
21 $DEBUG = 1;
22
23 =head1 NAME
24
25 FS::Upgrade - Database upgrade routines
26
27 =head1 SYNOPSIS
28
29   use FS::Upgrade;
30
31 =head1 DESCRIPTION
32
33 Currently this module simply provides a place to store common subroutines for
34 database upgrades.
35
36 =head1 SUBROUTINES
37
38 =over 4
39
40 =item upgrade_config
41
42 =cut
43
44 #config upgrades
45 sub upgrade_config {
46   my %opt = @_;
47
48   my $conf = new FS::Conf;
49
50   $conf->touch('payment_receipt')
51     if $conf->exists('payment_receipt_email')
52     || $conf->config('payment_receipt_msgnum');
53
54   $conf->touch('geocode-require_nw_coordinates')
55     if $conf->exists('svc_broadband-require-nw-coordinates');
56
57   unless ( $conf->config('echeck-country') ) {
58     if ( $conf->exists('cust_main-require-bank-branch') ) {
59       $conf->set('echeck-country', 'CA');
60     } elsif ( $conf->exists('echeck-nonus') ) {
61       $conf->set('echeck-country', 'XX');
62     } else {
63       $conf->set('echeck-country', 'US');
64     }
65   }
66
67   my @agents = qsearch('agent', {});
68
69   upgrade_overlimit_groups($conf);
70   map { upgrade_overlimit_groups($conf,$_->agentnum) } @agents;
71
72   upgrade_invoice_from($conf);
73   foreach my $agent (@agents) {
74     upgrade_invoice_from($conf,$agent->agentnum,1);
75   }
76
77   my $DIST_CONF = '/usr/local/etc/freeside/default_conf/';#DIST_CONF in Makefile
78   $conf->set($_, scalar(read_file( "$DIST_CONF/$_" )) )
79     foreach grep { ! $conf->exists($_) && -s "$DIST_CONF/$_" }
80       qw( quotation_html quotation_latex quotation_latexnotes );
81
82   # change 'fslongtable' to 'longtable'
83   # in invoice and quotation main templates, and also in all secondary 
84   # invoice templates
85   my @latex_confs =
86     qsearch('conf', { 'name' => {op=>'LIKE', value=>'%latex%'} });
87
88   foreach my $c (@latex_confs) {
89     my $value = $c->value;
90     if (length($value) and $value =~ /fslongtable/) {
91       $value =~ s/fslongtable/longtable/g;
92       $conf->set($c->name, $value, $c->agentnum);
93     }
94   }
95
96   # if there's a USPS tools login, assume that's the standardization method
97   # you want to use
98   $conf->set('address_standardize_method', 'usps')
99     if $conf->exists('usps_webtools-userid')
100     && length($conf->config('usps_webtools-userid')) > 0
101     && ! $conf->exists('address_standardize_method');
102
103   # this option has been renamed/expanded
104   if ( $conf->exists('cust_main-enable_spouse_birthdate') ) {
105     $conf->touch('cust_main-enable_spouse');
106     $conf->delete('cust_main-enable_spouse_birthdate');
107   }
108
109   # renamed/repurposed
110   if ( $conf->exists('cust_pkg-show_fcc_voice_grade_equivalent') ) {
111     $conf->touch('part_pkg-show_fcc_options');
112     $conf->delete('cust_pkg-show_fcc_voice_grade_equivalent');
113     warn "
114 You have FCC Form 477 package options enabled.
115
116 Starting with the October 2014 filing date, the FCC has redesigned 
117 Form 477 and introduced new service categories.  See bin/convert-477-options
118 to update your package configuration for the new report.
119
120 If you need to continue using the old Form 477 report, turn on the
121 'old_fcc_report' configuration option.
122 ";
123   }
124
125   # boolean invoice_sections_by_location option is now
126   # invoice_sections_method = 'location'
127   my @invoice_sections_confs =
128     qsearch('conf', { 'name' => { op=>'LIKE', value=>'%sections_by_location' } });
129   foreach my $c (@invoice_sections_confs) {
130     $c->name =~ /^(\w+)sections_by_location$/;
131     $conf->delete($c->name);
132     my $newname = $1.'sections_method';
133     $conf->set($newname, 'location');
134   }
135
136   # boolean enable_taxproducts is now enable_taxproducts = 'cch'
137   if ( $conf->exists('enable_taxproducts') and
138        $conf->config('enable_taxproducts') eq '' ) {
139
140     $conf->set('enable_taxproducts', 'cch');
141
142   }
143
144   # boolean tax-cust_exempt-groups-require_individual_nums is now -num_req all
145   if ( $conf->exists('tax-cust_exempt-groups-require_individual_nums') ) {
146     $conf->set('tax-cust_exempt-groups-num_req', 'all');
147     $conf->delete('tax-cust_exempt-groups-require_individual_nums');
148   }
149
150   enable_banned_pay_pad() unless length($conf->config('banned_pay-pad'));
151
152 }
153
154 sub upgrade_overlimit_groups {
155     my $conf = shift;
156     my $agentnum = shift;
157     my @groups = $conf->config('overlimit_groups',$agentnum); 
158     if(scalar(@groups)) {
159         my $groups = join(',',@groups);
160         my @groupnums;
161         my $error = '';
162         if ( $groups !~ /^[\d,]+$/ ) {
163             foreach my $groupname ( @groups ) {
164                 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
165                 unless ( $g ) {
166                     $g = new FS::radius_group {
167                                     'groupname' => $groupname,
168                                     'description' => $groupname,
169                                     };
170                     $error = $g->insert;
171                     die $error if $error;
172                 }
173                 push @groupnums, $g->groupnum;
174             }
175             $conf->set('overlimit_groups',join("\n",@groupnums),$agentnum);
176         }
177     }
178 }
179
180 sub upgrade_invoice_from {
181   my ($conf, $agentnum, $agentonly) = @_;
182   if (
183       (!$conf->exists('invoice_from_name',$agentnum,$agentonly)) && 
184       ($conf->config('invoice_from',$agentnum,$agentonly) =~ /\<(.*)\>/)
185   ) {
186     my $realemail = $1;
187     $realemail =~ s/^\s*//; # remove leading spaces
188     $realemail =~ s/\s*$//; # remove trailing spaces
189     my $realname = $conf->config('invoice_from',$agentnum);
190     $realname =~ s/\<.*\>//; # remove email address
191     $realname =~ s/^\s*//; # remove leading spaces
192     $realname =~ s/\s*$//; # remove trailing spaces
193     # properly quote names that contain punctuation
194     if (($realname =~ /[^[:alnum:][:space:]]/) && ($realname !~ /^\".*\"$/)) {
195       $realname = '"' . $realname . '"';
196     }
197     $conf->set('invoice_from_name', $realname, $agentnum);
198     $conf->set('invoice_from', $realemail, $agentnum);
199   }
200 }
201
202 =item upgrade
203
204 =cut
205
206 sub upgrade {
207   my %opt = @_;
208
209   my $data = upgrade_data(%opt);
210
211   my $oldAutoCommit = $FS::UID::AutoCommit;
212   local $FS::UID::AutoCommit = 0;
213   local $FS::UID::AutoCommit = 0;
214
215   local $FS::cust_pkg::upgrade = 1; #go away after setup+start dates cleaned up for old customers
216
217
218   foreach my $table ( keys %$data ) {
219
220     my $class = "FS::$table";
221     eval "use $class;";
222     die $@ if $@;
223
224     if ( $class->can('_upgrade_data') ) {
225       warn "Upgrading $table...\n";
226
227       my $start = time;
228
229       $class->_upgrade_data(%opt);
230
231       # New interface for async upgrades: a class can declare a 
232       # "queueable_upgrade" method, which will run as part of the normal 
233       # upgrade, but if the -j option is passed, will instead be run from 
234       # the job queue.
235       if ( $class->can('queueable_upgrade') ) {
236         my $jobname = $class . '::queueable_upgrade';
237         my $num_jobs = FS::queue->count("job = '$jobname' and status != 'failed'");
238         if ($num_jobs > 0) {
239           warn "$class upgrade already scheduled.\n";
240         } else {
241           if ( $opt{'queue'} ) {
242             warn "Scheduling $class upgrade.\n";
243             my $job = FS::queue->new({ job => $jobname });
244             $job->insert($class, %opt);
245           } else {
246             $class->queueable_upgrade(%opt);
247           }
248         } #$num_jobs == 0
249       }
250
251       if ( $oldAutoCommit ) {
252         warn "  committing\n";
253         dbh->commit or die dbh->errstr;
254       }
255       
256       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
257       warn "  done in ". (time-$start). " seconds\n";
258
259     } else {
260       warn "WARNING: asked for upgrade of $table,".
261            " but FS::$table has no _upgrade_data method\n";
262     }
263
264 #    my @records = @{ $data->{$table} };
265 #
266 #    foreach my $record ( @records ) {
267 #      my $args = delete($record->{'_upgrade_args'}) || [];
268 #      my $object = $class->new( $record );
269 #      my $error = $object->insert( @$args );
270 #      die "error inserting record into $table: $error\n"
271 #        if $error;
272 #    }
273
274   }
275
276   local($FS::cust_main::ignore_expired_card) = 1;
277   #this is long-gone... would need to set an equivalent in cust_location #local($FS::cust_main::ignore_illegal_zip) = 1;
278   local($FS::cust_main::ignore_banned_card) = 1;
279   local($FS::cust_main::skip_fuzzyfiles) = 1;
280
281   local($FS::cust_payby::ignore_expired_card) = 1;
282   local($FS::cust_payby::ignore_banned_card) = 1;
283
284   # decrypt inadvertantly-encrypted payinfo where payby != CARD,DCRD,CHEK,DCHK
285   # kind of a weird spot for this, but it's better than duplicating
286   # all this code in each class...
287   my @decrypt_tables = qw( cust_main cust_pay_void cust_pay cust_refund cust_pay_pending );
288   foreach my $table ( @decrypt_tables ) {
289       my @objects = qsearch({
290         'table'     => $table,
291         'hashref'   => {},
292         'extra_sql' => "WHERE payby NOT IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
293                        " AND LENGTH(payinfo) > 100",
294       });
295       foreach my $object ( @objects ) {
296           my $payinfo = $object->decrypt($object->payinfo);
297           die "error decrypting payinfo" if $payinfo eq $object->payinfo;
298           $object->payinfo($payinfo);
299           my $error = $object->replace;
300           die $error if $error;
301       }
302   }
303
304 }
305
306 =item upgrade_data
307
308 =cut
309
310 sub upgrade_data {
311   my %opt = @_;
312
313   tie my %hash, 'Tie::IxHash', 
314
315     #payby conditions to new ones
316     'part_event_condition' => [],
317
318     #payby actions to new ones
319     'part_event' => [],
320
321     #cust_main (remove paycvv from history, locations, cust_payby, etc)
322     'cust_main' => [],
323
324     #contact -> cust_contact / prospect_contact
325     'contact' => [],
326
327     #msgcat
328     'msgcat' => [],
329
330     #reason type and reasons
331     'reason_type'     => [],
332     'cust_pkg_reason' => [],
333
334     #need part_pkg before cust_credit...
335     'part_pkg' => [],
336
337     #customer credits
338     'cust_credit' => [],
339
340     #duplicate history records
341     'h_cust_svc'  => [],
342
343     #populate cust_pay.otaker
344     'cust_pay'    => [],
345
346     #populate part_pkg_taxclass for starters
347     'part_pkg_taxclass' => [],
348
349     #remove bad pending records
350     'cust_pay_pending' => [],
351
352     #replace invnum and pkgnum with billpkgnum
353     'cust_bill_pkg_detail' => [],
354
355     #usage_classes if we have none
356     'usage_class' => [],
357
358     #phone_type if we have none
359     'phone_type' => [],
360
361     #fixup access rights
362     'access_right' => [],
363
364     #change recur_flat and enable_prorate
365     'part_pkg_option' => [],
366
367     #add weights to pkg_category
368     'pkg_category' => [],
369
370     #cdrbatch fixes
371     'cdr' => [],
372
373     #otaker->usernum
374     'cust_attachment' => [],
375     #'cust_credit' => [],
376     #'cust_main' => [],
377     'cust_main_note' => [],
378     #'cust_pay' => [],
379     'cust_pay_void' => [],
380     'cust_pkg' => [],
381     #'cust_pkg_reason' => [],
382     'cust_pkg_discount' => [],
383     'cust_refund' => [],
384     'banned_pay' => [],
385
386     #default namespace
387     'payment_gateway' => [],
388
389     #migrate to templates
390     'msg_template' => [],
391
392     #return unprovisioned numbers to availability
393     'phone_avail' => [],
394
395     #insert scripcondition
396     'TicketSystem' => [],
397     
398     #insert LATA data if not already present
399     'lata' => [],
400     
401     #insert MSA data if not already present
402     'msa' => [],
403
404     # migrate to radius_group and groupnum instead of groupname
405     'radius_usergroup' => [],
406     'part_svc'         => [],
407     'part_export'      => [],
408
409     #insert default tower_sector if not present
410     'tower' => [],
411
412     #repair improperly deleted services
413     'cust_svc' => [],
414
415     #routernum/blocknum
416     'svc_broadband' => [],
417
418     #set up payment gateways if needed
419     'pay_batch' => [],
420
421     #flag monthly tax exemptions
422     'cust_tax_exempt_pkg' => [],
423
424     #kick off tax location history upgrade
425     'cust_bill_pkg' => [],
426
427     #fix taxable line item links
428     'cust_bill_pkg_tax_location' => [],
429
430     #populate state FIPS codes if not already done
431     'state' => [],
432
433     #populate tax statuses
434     'tax_status' => [],
435   ;
436
437   \%hash;
438
439 }
440
441 =item upgrade_schema
442
443 =cut
444
445 sub upgrade_schema {
446   my %opt = @_;
447
448   my $data = upgrade_schema_data(%opt);
449
450   my $oldAutoCommit = $FS::UID::AutoCommit;
451   local $FS::UID::AutoCommit = 0;
452   local $FS::UID::AutoCommit = 0;
453
454   foreach my $table ( keys %$data ) {
455
456     my $class = "FS::$table";
457     eval "use $class;";
458     die $@ if $@;
459
460     if ( $class->can('_upgrade_schema') ) {
461       warn "Upgrading $table schema...\n";
462
463       my $start = time;
464
465       $class->_upgrade_schema(%opt);
466
467       if ( $oldAutoCommit ) {
468         warn "  committing\n";
469         dbh->commit or die dbh->errstr;
470       }
471       
472       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
473       warn "  done in ". (time-$start). " seconds\n";
474
475     } else {
476       warn "WARNING: asked for schema upgrade of $table,".
477            " but FS::$table has no _upgrade_schema method\n";
478     }
479
480   }
481
482 }
483
484 =item upgrade_schema_data
485
486 =cut
487
488 sub upgrade_schema_data {
489   my %opt = @_;
490
491   tie my %hash, 'Tie::IxHash', 
492
493     #fix classnum character(1)
494     'cust_bill_pkg_detail' => [],
495     #add necessary columns to RT schema
496     'TicketSystem' => [],
497
498   ;
499
500   \%hash;
501
502 }
503
504 sub upgrade_sqlradius {
505   #my %opt = @_;
506
507   my $conf = new FS::Conf;
508
509   my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
510
511   foreach my $part_export ( @part_export ) {
512
513     my $errmsg = 'Error adding FreesideStatus to '.
514                  $part_export->option('datasrc'). ': ';
515
516     my $dbh = DBI->connect(
517       ( map $part_export->option($_), qw ( datasrc username password ) ),
518       { PrintError => 0, PrintWarn => 0 }
519     ) or do {
520       warn $errmsg.$DBI::errstr;
521       next;
522     };
523
524     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
525     my $group = "UserName";
526     $group .= ",Realm"
527       if ref($part_export) =~ /withdomain/
528       || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
529
530     my $sth_alter = $dbh->prepare(
531       "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
532     );
533     if ( $sth_alter ) {
534       if ( $sth_alter->execute ) {
535         my $sth_update = $dbh->prepare(
536          "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
537         ) or die $errmsg.$dbh->errstr;
538         $sth_update->execute or die $errmsg.$sth_update->errstr;
539       } else {
540         my $error = $sth_alter->errstr;
541         warn $errmsg.$error
542           unless $error =~ /Duplicate column name/i  #mysql
543               || $error =~ /already exists/i;        #Pg
544 ;
545       }
546     } else {
547       my $error = $dbh->errstr;
548       warn $errmsg.$error; #unless $error =~ /exists/i;
549     }
550
551     my $sth_index = $dbh->prepare(
552       "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
553     );
554     if ( $sth_index ) {
555       unless ( $sth_index->execute ) {
556         my $error = $sth_index->errstr;
557         warn $errmsg.$error
558           unless $error =~ /Duplicate key name/i #mysql
559               || $error =~ /already exists/i;    #Pg
560       }
561     } else {
562       my $error = $dbh->errstr;
563       warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
564     }
565
566     my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
567       ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
568       : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
569
570     my $sth = $dbh->prepare("SELECT UserName,
571                                     Realm,
572                                     $str2time max(AcctStartTime)),
573                                     $str2time max(AcctStopTime))
574                               FROM radacct
575                               WHERE FreesideStatus = 'done'
576                                 AND $times
577                               GROUP BY $group
578                             ")
579       or die $errmsg.$dbh->errstr;
580     $sth->execute() or die $errmsg.$sth->errstr;
581   
582     while (my $row = $sth->fetchrow_arrayref ) {
583       my ($username, $realm, $start, $stop) = @$row;
584   
585       $username = lc($username) unless $conf->exists('username-uppercase');
586
587       my $exportnum = $part_export->exportnum;
588       my $extra_sql = " AND exportnum = $exportnum ".
589                       " AND exportsvcnum IS NOT NULL ";
590
591       if ( ref($part_export) =~ /withdomain/ ) {
592         $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
593                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
594       }
595   
596       my $svc_acct = qsearchs({
597         'select'    => 'svc_acct.*',
598         'table'     => 'svc_acct',
599         'addl_from' => 'LEFT JOIN cust_svc   USING ( svcnum )'.
600                        'LEFT JOIN export_svc USING ( svcpart )',
601         'hashref'   => { 'username' => $username },
602         'extra_sql' => $extra_sql,
603       });
604
605       if ($svc_acct) {
606         $svc_acct->last_login($start)
607           if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
608         $svc_acct->last_logout($stop)
609           if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
610       }
611     }
612   }
613
614 }
615
616 =back
617
618 =head1 BUGS
619
620 Sure.
621
622 =head1 SEE ALSO
623
624 =cut
625
626 1;
627