fix quotations vs. currency_fixed price plan, RT#26810, RT#21565
[freeside.git] / FS / FS / svc_acct.pm
index e8c797a..62cb633 100644 (file)
@@ -1,8 +1,13 @@
 package FS::svc_acct;
+use base qw( FS::svc_Domain_Mixin FS::svc_PBX_Mixin
+             FS::svc_CGP_Mixin FS::svc_CGPRule_Mixin
+             FS::svc_Radius_Mixin
+             FS::svc_Tower_Mixin
+             FS::svc_IP_Mixin
+             FS::svc_Common
+           );
 
 use strict;
-use base qw( FS::svc_Domain_Mixin FS::svc_CGP_Mixin FS::svc_CGPRule_Mixin
-             FS::svc_Common );
 use vars qw( $DEBUG $me $conf $skip_fuzzyfiles
              $dir_prefix @shells $usernamemin
              $usernamemax $passwordmin $passwordmax
@@ -10,6 +15,7 @@ use vars qw( $DEBUG $me $conf $skip_fuzzyfiles
              $username_noperiod $username_nounderscore $username_nodash
              $username_uppercase $username_percent $username_colon
              $username_slash $username_equals $username_pound
+             $username_exclamation
              $password_noampersand $password_noexclamation
              $warning_template $warning_from $warning_subject $warning_mimetype
              $warning_cc
@@ -23,7 +29,7 @@ use Carp;
 use Fcntl qw(:flock);
 use Date::Format;
 use Crypt::PasswdMD5 1.2;
-use Digest::SHA1 'sha1_base64';
+use Digest::SHA 'sha1_base64';
 use Digest::MD5 'md5_base64';
 use Data::Dumper;
 use Text::Template;
@@ -49,7 +55,7 @@ use FS::part_export;
 use FS::svc_forward;
 use FS::svc_www;
 use FS::cdr;
-use FS::acct_snarf;
+use FS::tower_sector;
 
 $DEBUG = 0;
 $me = '[FS::svc_acct]';
@@ -79,6 +85,7 @@ FS::UID->install_callback( sub {
   $username_slash = $conf->exists('username-slash');
   $username_equals = $conf->exists('username-equals');
   $username_pound = $conf->exists('username-pound');
+  $username_exclamation = $conf->exists('username-exclamation');
   $password_noampersand = $conf->exists('password-noexclamation');
   $password_noexclamation = $conf->exists('password-noexclamation');
   $dirhash = $conf->config('dirhash') || 0;
@@ -251,6 +258,7 @@ sub table_info {
     'sorts' => [ 'username', 'uid', 'seconds', 'last_login' ],
     'display_weight' => 10,
     'cancel_weight'  => 50, 
+    'ip_field' => 'slipip',
     'fields' => {
         'dir'       => 'Home directory',
         'uid'       => {
@@ -334,11 +342,13 @@ sub table_info {
                          disable_inventory => 1,
                          disable_select => 1, #UI wonky, pry works otherwise
                        },
+        'sectornum' => 'Tower sector',
         'usergroup' => {
                          label => 'RADIUS groups',
                          type  => 'select-radius_group.html',
                          disable_inventory => 1,
                          disable_select => 1,
+                         multiple => 1,
                        },
         'seconds'   => { label => 'Seconds',
                          label_sort => 'with Time Remaining',
@@ -531,22 +541,6 @@ sub table { 'svc_acct'; }
 
 sub table_dupcheck_fields { ( 'username', 'domsvc' ); }
 
-sub _fieldhandlers {
-  {
-    #false laziness with edit/svc_acct.cgi
-    'usergroup' => sub { 
-                         my( $self, $groups ) = @_;
-                         if ( ref($groups) eq 'ARRAY' ) {
-                           $groups;
-                         } elsif ( length($groups) ) {
-                           [ split(/\s*,\s*/, $groups) ];
-                         } else {
-                           [];
-                         }
-                       },
-  };
-}
-
 sub last_login {
   shift->_lastlog('in', @_);
 }
@@ -699,7 +693,7 @@ sub insert {
   my $dbh = dbh;
 
   my @jobnums;
-  my $error = $self->SUPER::insert(
+  my $error = $self->SUPER::insert( # usergroup is here
     'jobnums'       => \@jobnums,
     'child_objects' => $self->child_objects,
     %options,
@@ -709,20 +703,6 @@ sub insert {
     return $error;
   }
 
-  if ( $self->usergroup ) {
-    foreach my $groupnum ( @{$self->usergroup} ) {
-      my $radius_usergroup = new FS::radius_usergroup ( {
-        svcnum    => $self->svcnum,
-        groupnum  => $groupnum,
-      } );
-      my $error = $radius_usergroup->insert;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return $error;
-      }
-    }
-  }
-
   unless ( $skip_fuzzyfiles ) {
     $error = $self->queue_fuzzyfiles_update;
     if ( $error ) {
@@ -935,22 +915,12 @@ sub delete {
     }
   }
 
-  my $error = $self->SUPER::delete;
+  my $error = $self->SUPER::delete; # usergroup here
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
   }
 
-  foreach my $radius_usergroup (
-    qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
-  ) {
-    my $error = $radius_usergroup->delete;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
-
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }
@@ -1011,49 +981,7 @@ sub replace {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  # redundant, but so $new->usergroup gets set
-  $error = $new->check;
-  return $error if $error;
-
-  $old->usergroup( [ $old->radius_groups('NUMBERS') ] );
-  if ( $DEBUG ) {
-    warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
-    warn $new->email. " new groups: ". join(' ',@{$new->usergroup}). "\n";
-  }
-  if ( $new->usergroup ) {
-    #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
-    my @newgroups = @{$new->usergroup};
-    foreach my $oldgroup ( @{$old->usergroup} ) {
-      if ( grep { $oldgroup eq $_ } @newgroups ) {
-        @newgroups = grep { $oldgroup ne $_ } @newgroups;
-        next;
-      }
-      my $radius_usergroup = qsearchs('radius_usergroup', {
-        svcnum    => $old->svcnum,
-        groupnum  => $oldgroup,
-      } );
-      my $error = $radius_usergroup->delete;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "error deleting radius_usergroup $oldgroup: $error";
-      }
-    }
-
-    foreach my $newgroup ( @newgroups ) {
-      my $radius_usergroup = new FS::radius_usergroup ( {
-        svcnum    => $new->svcnum,
-        groupnum => $newgroup,
-      } );
-      my $error = $radius_usergroup->insert;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "error adding radius_usergroup $newgroup: $error";
-      }
-    }
-
-  }
-
-  $error = $new->SUPER::replace($old, @_);
+  $error = $new->SUPER::replace($old, @_); # usergroup here
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error if $error;
@@ -1191,19 +1119,17 @@ sub check {
 
   my($recref) = $self->hashref;
 
-  my $x = $self->setfixed( $self->_fieldhandlers );
+  my $x = $self->setfixed;
   return $x unless ref($x);
   my $part_svc = $x;
 
-  if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
-    $self->usergroup(
-      [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
-  }
-
   my $error = $self->ut_numbern('svcnum')
               #|| $self->ut_number('domsvc')
               || $self->ut_foreign_key( 'domsvc', 'svc_domain', 'svcnum' )
               || $self->ut_foreign_keyn('pbxsvc', 'svc_pbx',    'svcnum' )
+              || $self->ut_foreign_keyn('sectornum','tower_sector','sectornum')
+              || $self->ut_foreign_keyn('routernum','router','routernum')
+              || $self->ut_foreign_keyn('blocknum','addr_block','blocknum')
               || $self->ut_textn('sec_phrase')
               || $self->ut_snumbern('seconds')
               || $self->ut_snumbern('upbytes')
@@ -1239,8 +1165,18 @@ sub check {
   ;
   return $error if $error;
 
+  # assign IP address, etc.
+  if ( $conf->exists('svc_acct-ip_addr') ) {
+    my $error = $self->svc_ip_check;
+    return $error if $error;
+  } else { # I think this is correct
+    $self->routernum('');
+    $self->blocknum('');
+  }
+
   my $cust_pkg;
   local $username_letter = $username_letter;
+  local $username_uppercase = $username_uppercase;
   if ($self->svcnum) {
     my $cust_svc = $self->cust_svc
       or return "no cust_svc record found for svcnum ". $self->svcnum;
@@ -1252,48 +1188,55 @@ sub check {
   if ($cust_pkg) {
     $username_letter =
       $conf->exists('username-letter', $cust_pkg->cust_main->agentnum);
+    $username_uppercase =
+      $conf->exists('username-uppercase', $cust_pkg->cust_main->agentnum);
   }
 
   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
 
-  $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:\/\=\#]{$usernamemin,$ulen})$/i
+  $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:\/\=\#\!]{$usernamemin,$ulen})$/i
     or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
   $recref->{username} = $1;
 
+  my $uerror = gettext('illegal_username'). ': '. $recref->{username};
+
   unless ( $username_uppercase ) {
-    $recref->{username} =~ /[A-Z]/ and return gettext('illegal_username');
+    $recref->{username} =~ /[A-Z]/ and return $uerror;
   }
   if ( $username_letterfirst ) {
-    $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
+    $recref->{username} =~ /^[a-z]/ or return $uerror;
   } elsif ( $username_letter ) {
-    $recref->{username} =~ /[a-z]/ or return gettext('illegal_username');
+    $recref->{username} =~ /[a-z]/ or return $uerror;
   }
   if ( $username_noperiod ) {
-    $recref->{username} =~ /\./ and return gettext('illegal_username');
+    $recref->{username} =~ /\./ and return $uerror;
   }
   if ( $username_nounderscore ) {
-    $recref->{username} =~ /_/ and return gettext('illegal_username');
+    $recref->{username} =~ /_/ and return $uerror;
   }
   if ( $username_nodash ) {
-    $recref->{username} =~ /\-/ and return gettext('illegal_username');
+    $recref->{username} =~ /\-/ and return $uerror;
   }
   unless ( $username_ampersand ) {
-    $recref->{username} =~ /\&/ and return gettext('illegal_username');
+    $recref->{username} =~ /\&/ and return $uerror;
   }
   unless ( $username_percent ) {
-    $recref->{username} =~ /\%/ and return gettext('illegal_username');
+    $recref->{username} =~ /\%/ and return $uerror;
   }
   unless ( $username_colon ) {
-    $recref->{username} =~ /\:/ and return gettext('illegal_username');
+    $recref->{username} =~ /\:/ and return $uerror;
   }
   unless ( $username_slash ) {
-    $recref->{username} =~ /\// and return gettext('illegal_username');
+    $recref->{username} =~ /\// and return $uerror;
   }
   unless ( $username_equals ) {
-    $recref->{username} =~ /\=/ and return gettext('illegal_username');
+    $recref->{username} =~ /\=/ and return $uerror;
   }
   unless ( $username_pound ) {
-    $recref->{username} =~ /\#/ and return gettext('illegal_username');
+    $recref->{username} =~ /\#/ and return $uerror;
+  }
+  unless ( $username_exclamation ) {
+    $recref->{username} =~ /\!/ and return $uerror;
   }
 
 
@@ -1363,8 +1306,6 @@ sub check {
 
   }
 
-  #  $error = $self->ut_textn('finger');
-  #  return $error if $error;
   if ( $self->getfield('finger') eq '' ) {
     my $cust_pkg = $self->svcnum
       ? $self->cust_svc->cust_pkg
@@ -1374,7 +1315,9 @@ sub check {
       $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
     }
   }
-  $self->getfield('finger') =~ /^([\w \,\.\-\'\&\t\!\@\#\$\%\(\)\+\;\"\?\/\*\<\>]+)$/
+  #  $error = $self->ut_textn('finger');
+  #  return $error if $error;
+  $self->getfield('finger') =~ /^([\w \,\.\-\'\&\t\!\@\#\$\%\(\)\+\;\"\?\/\*\<\>]*)$/
       or return "Illegal finger: ". $self->getfield('finger');
   $self->setfield('finger', $1);
 
@@ -1387,7 +1330,7 @@ sub check {
 
   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
     if ( $recref->{slipip} eq '' ) {
-      $recref->{slipip} = '';
+      $recref->{slipip} = ''; # eh?
     } elsif ( $recref->{slipip} eq '0e0' ) {
       $recref->{slipip} = '0e0';
     } else {
@@ -1395,7 +1338,6 @@ sub check {
         or return "Illegal slipip: ". $self->slipip;
       $recref->{slipip} = $1;
     }
-
   }
 
   #arbitrary RADIUS stuff; allow ut_textn for now
@@ -1457,6 +1399,7 @@ sub check {
   else {
     return "invalid password encoding ('".$recref->{_password_encoding}."'";
   }
+
   $self->SUPER::check;
 
 }
@@ -1540,7 +1483,7 @@ sub set_password {
   if ( !$encoding ) {
     # set encoding to system default
     ($encoding, $encryption) =
-      split(/-/, lc($conf->config('default-password-encoding')));
+      split(/-/, lc($conf->config('default-password-encoding') || ''));
     $encoding ||= 'legacy';
     $self->_password_encoding($encoding);
   }
@@ -1951,20 +1894,14 @@ sub email {
   $self->username. '@'. $self->domain(@_);
 }
 
+
 =item acct_snarf
 
 Returns an array of FS::acct_snarf records associated with the account.
 
 =cut
 
-sub acct_snarf {
-  my $self = shift;
-  qsearch({
-    'table'    => 'acct_snarf',
-    'hashref'  => { 'svcnum' => $self->svcnum },
-    #'order_by' => 'ORDER BY priority ASC',
-  });
-}
+# unused as originally intended, but now by Communigate Pro "RPOP"
 
 =item cgp_rpop_hashref
 
@@ -2227,20 +2164,19 @@ sub _op_overlimit {
 
   my $cust_pkg = $self->cust_svc->cust_pkg;
 
-  my $conf_overlimit =
+  my @conf_overlimit =
     $cust_pkg
       ? $conf->config('overlimit_groups', $cust_pkg->cust_main->agentnum )
       : $conf->config('overlimit_groups');
 
   foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 
-    my $groups = $conf_overlimit || $part_export->option('overlimit_groups');
-    next unless $groups;
-
-    my $gref = &{ $self->_fieldhandlers->{'usergroup'} }( $self, $groups );
+    my @groups = scalar(@conf_overlimit) ? @conf_overlimit
+                                         : split(' ',$part_export->option('overlimit_groups'));
+    next unless scalar(@groups);
 
     my $other = new FS::svc_acct $self->hashref;
-    $other->usergroup( $gref );
+    $other->usergroup(\@groups);
 
     my($new,$old);
     if ($action eq 'suspend') {
@@ -2424,60 +2360,6 @@ sub seconds_since {
   $self->cust_svc->seconds_since(@_);
 }
 
-=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
-
-Returns the numbers of seconds this account has been online between
-TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
-external SQL radacct table, specified via sqlradius export.  Sessions which
-started in the specified range but are still open are counted from session
-start to the end of the range (unless they are over 1 day old, in which case
-they are presumed missing their stop record and not counted).  Also, sessions
-which end in the range but started earlier are counted from the start of the
-range to session end.  Finally, sessions which start before the range but end
-after are counted for the entire range.
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-#note: POD here, implementation in FS::cust_svc
-sub seconds_since_sqlradacct {
-  my $self = shift;
-  $self->cust_svc->seconds_since_sqlradacct(@_);
-}
-
-=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
-
-Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
-in this package for sessions ending between TIMESTAMP_START (inclusive) and
-TIMESTAMP_END (exclusive).
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-#note: POD here, implementation in FS::cust_svc
-sub attribute_since_sqlradacct {
-  my $self = shift;
-  $self->cust_svc->attribute_since_sqlradacct(@_);
-}
-
-=item get_session_history TIMESTAMP_START TIMESTAMP_END
-
-Returns an array of hash references of this customers login history for the
-given time range.  (document this better)
-
-=cut
-
-sub get_session_history {
-  my $self = shift;
-  $self->cust_svc->get_session_history(@_);
-}
-
 =item last_login_text 
 
 Returns text describing the time of last login.
@@ -2550,41 +2432,7 @@ sub get_cdrs {
 
 }
 
-=item radius_groups
-
-Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
-
-=cut
-
-sub radius_groups {
-  my $self = shift;
-  if ( $self->usergroup ) {
-    confess "explicitly specified usergroup not an arrayref: ". $self->usergroup
-      unless ref($self->usergroup) eq 'ARRAY';
-    #when provisioning records, export callback runs in svc_Common.pm before
-    #radius_usergroup records can be inserted...
-    my $groups = join(',',@{$self->usergroup});
-    my @groups;
-    return @groups unless length($groups);
-    @groups = qsearch({ 'table'         => 'radius_group',
-                           'extra_sql'     => "where groupnum in ($groups)",
-                        });
-    map { $_->groupname } @groups;
-  } else {
-     my $format = shift || '';
-     my @groups = qsearch({ 'table'         => 'radius_usergroup',
-                            'addl_from'     => 'left join radius_group using (groupnum)',
-                            'select'        => 'radius_group.*',
-                            'hashref'       => { 'svcnum' => $self->svcnum },
-                        });
-
-     # this is to preserve various legacy behaviour / avoid re-writing other code
-     return map { $_->groupnum } @groups if $format eq 'NUMBERS';
-     return map { $_->description . " (" . $_->groupname . ")" } @groups
-        if $format eq 'COMBINED';
-     map { $_->groupname } @groups;
-  }
-}
+# sub radius_groups has moved to svc_Radius_Mixin
 
 =item clone_suspended
 
@@ -2632,7 +2480,8 @@ sub check_password {
 
   if ( $self->_password_encoding eq 'ldap' ) {
 
-    my $auth = from_rfc2307 Authen::Passphrase $self->_password;
+    $password =~ s/^{PLAIN}/{CLEARTEXT}/;
+    my $auth = from_rfc2307 Authen::Passphrase $password;
     return $auth->match($check_password);
 
   } elsif ( $self->_password_encoding eq 'crypt' ) {
@@ -2912,102 +2761,39 @@ Arrayref of additional WHERE clauses, will be ANDed together.
 
 =cut
 
-sub search {
-  my ($class, $params) = @_;
+sub _search_svc {
+  my( $class, $params, $from, $where ) = @_;
 
-  my @where = ();
+  #these two should probably move to svc_Domain_Mixin ?
 
   # domain
   if ( $params->{'domain'} ) { 
     my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
     #preserve previous behavior & bubble up an error if $svc_domain not found?
-    push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
+    push @$where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
   }
 
   # domsvc
   if ( $params->{'domsvc'} =~ /^(\d+)$/ ) { 
-    push @where, "domsvc = $1";
-  }
-
-  #unlinked
-  push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
-
-  #agentnum
-  if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
-    push @where, "agentnum = $1";
+    push @$where, "domsvc = $1";
   }
 
-  #custnum
-  if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
-    push @where, "custnum = $1";
-  }
-
-  #pkgpart
-  if ( $params->{'pkgpart'} && scalar(@{ $params->{'pkgpart'} }) ) {
-    #XXX untaint or sql quote
-    push @where,
-      'cust_pkg.pkgpart IN ('. join(',', @{ $params->{'pkgpart'} } ). ')';
-  }
 
   # popnum
   if ( $params->{'popnum'} =~ /^(\d+)$/ ) { 
-    push @where, "popnum = $1";
+    push @$where, "popnum = $1";
   }
 
-  # svcpart
-  if ( $params->{'svcpart'} =~ /^(\d+)$/ ) { 
-    push @where, "svcpart = $1";
-  }
 
+  #and these in svc_Tower_Mixin, or maybe we never should have done svc_acct
+  # towers (or, as mark thought, never should have done svc_broadband)
 
-  # here is the agent virtualization
-  #if ($params->{CurrentUser}) {
-  #  my $access_user =
-  #    qsearchs('access_user', { username => $params->{CurrentUser} });
-  #
-  #  if ($access_user) {
-  #    push @where, $access_user->agentnums_sql('table'=>'cust_main');
-  #  }else{
-  #    push @where, "1=0";
-  #  }
-  #} else {
-    push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
-                   'table'      => 'cust_main',
-                   'null_right' => 'View/link unlinked services',
-                 );
-  #}
-
-  push @where, @{ $params->{'where'} } if $params->{'where'};
-
-  my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
-  my $addl_from = ' LEFT JOIN cust_svc  USING ( svcnum  ) '.
-                  ' LEFT JOIN part_svc  USING ( svcpart ) '.
-                  ' LEFT JOIN cust_pkg  USING ( pkgnum  ) '.
-                  ' LEFT JOIN cust_main USING ( custnum ) ';
-
-  my $count_query = "SELECT COUNT(*) FROM svc_acct $addl_from $extra_sql";
-  #if ( keys %svc_acct ) {
-  #  $count_query .= ' WHERE '.
-  #                    join(' AND ', map "$_ = ". dbh->quote($svc_acct{$_}),
-  #                                      keys %svc_acct
-  #                        );
-  #}
-
-  my $sql_query = {
-    'table'       => 'svc_acct',
-    'hashref'     => {}, # \%svc_acct,
-    'select'      => join(', ',
-                       'svc_acct.*',
-                       'part_svc.svc',
-                       'cust_main.custnum',
-                       FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
-                     ),
-    'addl_from'   => $addl_from,
-    'extra_sql'   => $extra_sql,
-    'order_by'    => $params->{'order_by'},
-    'count_query' => $count_query,
-  };
+  # sector and tower
+  my @where_sector = $class->tower_sector_sql($params);
+  if ( @where_sector ) {
+    push @$where, @where_sector;
+    push @$from, ' LEFT JOIN tower_sector USING ( sectornum )';
+  }
 
 }