fix 'Can't call method "setup" on an undefined value' error when using into rates...
[freeside.git] / FS / FS / svc_acct.pm
index c3e7209..3bb7af4 100644 (file)
@@ -1,7 +1,11 @@
 package FS::svc_acct;
 
 use strict;
-use base qw( FS::svc_Domain_Mixin FS::svc_CGP_Mixin FS::svc_CGPRule_Mixin
+use base qw( FS::svc_Domain_Mixin
+             FS::svc_CGP_Mixin
+             FS::svc_CGPRule_Mixin
+             FS::svc_Radius_Mixin
+             FS::svc_Tower_Mixin
              FS::svc_Common );
 use vars qw( $DEBUG $me $conf $skip_fuzzyfiles
              $dir_prefix @shells $usernamemin
@@ -23,7 +27,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;
@@ -43,12 +47,14 @@ use FS::svc_pbx;
 use FS::raddb;
 use FS::queue;
 use FS::radius_usergroup;
+use FS::radius_group;
 use FS::export_svc;
 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]';
@@ -250,6 +256,7 @@ sub table_info {
     'sorts' => [ 'username', 'uid', 'seconds', 'last_login' ],
     'display_weight' => 10,
     'cancel_weight'  => 50, 
+    'ip_field' => 'slipip',
     'fields' => {
         'dir'       => 'Home directory',
         'uid'       => {
@@ -333,11 +340,13 @@ sub table_info {
                          disable_inventory => 1,
                          disable_select => 1, #UI wonky, pry works otherwise
                        },
+        'sectornum' => 'Tower sector',
         'usergroup' => {
                          label => 'RADIUS groups',
-                         type  => 'radius_usergroup_selector',
+                         type  => 'select-radius_group.html',
                          disable_inventory => 1,
                          disable_select => 1,
+                         multiple => 1,
                        },
         'seconds'   => { label => 'Seconds',
                          label_sort => 'with Time Remaining',
@@ -530,22 +539,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', @_);
 }
@@ -698,7 +691,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,
@@ -708,20 +701,6 @@ sub insert {
     return $error;
   }
 
-  if ( $self->usergroup ) {
-    foreach my $groupname ( @{$self->usergroup} ) {
-      my $radius_usergroup = new FS::radius_usergroup ( {
-        svcnum    => $self->svcnum,
-        groupname => $groupname,
-      } );
-      my $error = $radius_usergroup->insert;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return $error;
-      }
-    }
-  }
-
   unless ( $skip_fuzzyfiles ) {
     $error = $self->queue_fuzzyfiles_update;
     if ( $error ) {
@@ -934,22 +913,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;
   '';
 }
@@ -992,6 +961,10 @@ sub replace {
 
   }
 
+  return "can't change username"
+    if $old->username ne $new->username
+    && $conf->exists('svc_acct-no_edit_username');
+
   #change homdir when we change username
   $new->setfield('dir', '') if $old->username ne $new->username;
 
@@ -1006,49 +979,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 ] );
-  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,
-        groupname => $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,
-        groupname => $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;
@@ -1186,19 +1117,15 @@ 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_textn('sec_phrase')
               || $self->ut_snumbern('seconds')
               || $self->ut_snumbern('upbytes')
@@ -1369,8 +1296,7 @@ sub check {
       $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
     }
   }
-  $self->getfield('finger') =~
-    /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
+  $self->getfield('finger') =~ /^([\w \,\.\-\'\&\t\!\@\#\$\%\(\)\+\;\"\?\/\*\<\>]+)$/
       or return "Illegal finger: ". $self->getfield('finger');
   $self->setfield('finger', $1);
 
@@ -1590,6 +1516,8 @@ sub set_password {
       $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]);
     }
     # else $encryption eq 'plain', do nothing
+    $pass .= '=' x (4 - length($pass) % 4) #properly padded base64
+      if $encryption eq 'md5' || $encryption eq 'sha1';
     $pass = '{'.uc($encryption).'}'.$pass;
   }
   # else encoding eq 'plain'
@@ -2221,20 +2149,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') {
@@ -2544,25 +2471,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...
-    @{$self->usergroup};
-  } else {
-    map { $_->groupname }
-      qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
-  }
-}
+# sub radius_groups has moved to svc_Radius_Mixin
 
 =item clone_suspended
 
@@ -2674,12 +2583,12 @@ sub crypt_password {
 
       my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
       if ( $encryption eq 'crypt' ) {
-        crypt(
+        return crypt(
           $self->_password,
           $saltset[int(rand(64))].$saltset[int(rand(64))]
         );
       } elsif ( $encryption eq 'md5' ) {
-        unix_md5_crypt( $self->_password );
+        return unix_md5_crypt( $self->_password );
       } elsif ( $encryption eq 'blowfish' ) {
         croak "unknown encryption method $encryption";
       } else {
@@ -2687,7 +2596,7 @@ sub crypt_password {
       }
 
     } elsif ( $self->_password =~ /^\{CRYPT\}(.+)$/ ) {
-      $1;
+      return $1;
     }
 
   } elsif ( $self->_password_encoding eq 'crypt' ) {
@@ -2700,12 +2609,16 @@ sub crypt_password {
 
     my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
     if ( $encryption eq 'crypt' ) {
-      crypt(
+      return crypt(
         $self->_password,
         $saltset[int(rand(64))].$saltset[int(rand(64))]
       );
     } elsif ( $encryption eq 'md5' ) {
-      unix_md5_crypt( $self->_password );
+      return unix_md5_crypt( $self->_password );
+    } elsif ( $encryption eq 'sha1_base64' ) { #for acct_sql
+      my $pass = sha1_base64( $self->_password );
+      $pass .= '=' x (4 - length($pass) % 4); #properly padded base64
+      return $pass;
     } elsif ( $encryption eq 'blowfish' ) {
       croak "unknown encryption method $encryption";
     } else {
@@ -2726,12 +2639,12 @@ sub crypt_password {
 
       my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
       if ( $encryption eq 'crypt' ) {
-        crypt(
+        return crypt(
           $self->_password,
           $saltset[int(rand(64))].$saltset[int(rand(64))]
         );
       } elsif ( $encryption eq 'md5' ) {
-        unix_md5_crypt( $self->_password );
+        return unix_md5_crypt( $self->_password );
       } elsif ( $encryption eq 'blowfish' ) {
         croak "unknown encryption method $encryption";
       } else {
@@ -2908,7 +2821,7 @@ sub search {
 
   #agentnum
   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
-    push @where, "agentnum = $1";
+    push @where, "cust_main.agentnum = $1";
   }
 
   #custnum
@@ -3097,56 +3010,6 @@ sub append_fuzzyfiles {
 }
 
 
-
-=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
-
-=cut
-
-sub radius_usergroup_selector {
-  my $sel_groups = shift;
-  my %sel_groups = map { $_=>1 } @$sel_groups;
-
-  my $selectname = shift || 'radius_usergroup';
-
-  my $dbh = dbh;
-  my $sth = $dbh->prepare(
-    'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
-  ) or die $dbh->errstr;
-  $sth->execute() or die $sth->errstr;
-  my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
-
-  my $html = <<END;
-    <SCRIPT>
-    function ${selectname}_doadd(object) {
-      var myvalue = object.${selectname}_add.value;
-      var optionName = new Option(myvalue,myvalue,false,true);
-      var length = object.$selectname.length;
-      object.$selectname.options[length] = optionName;
-      object.${selectname}_add.value = "";
-    }
-    </SCRIPT>
-    <SELECT MULTIPLE NAME="$selectname">
-END
-
-  foreach my $group ( @all_groups ) {
-    $html .= qq(<OPTION VALUE="$group");
-    if ( $sel_groups{$group} ) {
-      $html .= ' SELECTED';
-      $sel_groups{$group} = 0;
-    }
-    $html .= ">$group</OPTION>\n";
-  }
-  foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
-    $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n);
-  };
-  $html .= '</SELECT>';
-
-  $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
-           qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
-
-  $html;
-}
-
 =item reached_threshold
 
 Performs some activities when svc_acct thresholds (such as number of seconds
@@ -3236,9 +3099,6 @@ The suspend, unsuspend and cancel methods update the database, but not the
 current object.  This is probably a bug as it's unexpected and
 counterintuitive.
 
-radius_usergroup_selector?  putting web ui components in here?  they should
-probably live somewhere else...
-
 insertion of RADIUS group stuff in insert could be done with child_objects now
 (would probably clean up export of them too)