bulk provisioning via ftp and SOAP #5202
[freeside.git] / FS / FS / svc_acct.pm
index a4876c5..1a42e65 100644 (file)
@@ -6,7 +6,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
              $usernamemax $passwordmin $passwordmax
              $username_ampersand $username_letter $username_letterfirst
              $username_noperiod $username_nounderscore $username_nodash
-             $username_uppercase $username_percent
+             $username_uppercase $username_percent $username_colon
              $password_noampersand $password_noexclamation
              $warning_template $warning_from $warning_subject $warning_mimetype
              $warning_cc
@@ -20,12 +20,14 @@ use Fcntl qw(:flock);
 use Date::Format;
 use Crypt::PasswdMD5 1.2;
 use Data::Dumper;
+use Text::Template;
 use Authen::Passphrase;
 use FS::UID qw( datasrc driver_name );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs fields dbh dbdef );
 use FS::Msgcat qw(gettext);
 use FS::UI::bytecount;
+use FS::part_pkg;
 use FS::svc_Common;
 use FS::cust_svc;
 use FS::part_svc;
@@ -47,7 +49,7 @@ $DEBUG = 0;
 $me = '[FS::svc_acct]';
 
 #ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::svc_acct'} = sub { 
+FS::UID->install_callback( sub { 
   $conf = new FS::Conf;
   $dir_prefix = $conf->config('home');
   @shells = $conf->config('shells');
@@ -63,6 +65,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $username_uppercase = $conf->exists('username-uppercase');
   $username_ampersand = $conf->exists('username-ampersand');
   $username_percent = $conf->exists('username-percent');
+  $username_colon = $conf->exists('username-colon');
   $password_noampersand = $conf->exists('password-noexclamation');
   $password_noexclamation = $conf->exists('password-noexclamation');
   $dirhash = $conf->config('dirhash') || 0;
@@ -86,7 +89,8 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $radius_password = $conf->config('radius-password') || 'Password';
   $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
   @pw_set = ( 'A'..'Z' ) if $conf->exists('password-generated-allcaps');
-};
+}
+);
 
 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
@@ -211,9 +215,9 @@ sub table_info {
     'fields' => {
         'dir'       => 'Home directory',
         'uid'       => {
-                         label     => 'UID',
-                        def_label => 'UID (set to fixed and blank for no UIDs)',
-                        type      => 'text',
+                         label    => 'UID',
+                        def_info => 'set to fixed and blank for no UIDs',
+                        type     => 'text',
                       },
         'slipip'    => 'IP address',
     #    'popnum'    => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!,
@@ -240,23 +244,22 @@ sub table_info {
                        },
         '_password' => 'Password',
         'gid'       => {
-                         label     => 'GID',
-                        def_label => 'GID (when blank, defaults to UID)',
-                        type      => 'text',
+                         label    => 'GID',
+                        def_info => 'when blank, defaults to UID',
+                        type     => 'text',
                       },
         'shell'     => {
-                         #desc =>'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file, set to blank for no shell tracking)',
                         label    => 'Shell',
-                         def_label=> 'Shell (set to blank for no shell tracking)',
-                         type     =>'select',
-                         select_list => [ $conf->config('shells') ],
+                         def_info => 'set to blank for no shell tracking',
+                         type     => 'select',
+                         #select_list => [ $conf->config('shells') ],
+                         select_list => [ $conf ? $conf->config('shells') : () ],
                          disable_inventory => 1,
                          disable_select => 1,
                        },
-        'finger'    => 'Real name (GECOS)',
+        'finger'    => 'Real name', # (GECOS)',
         'domsvc'    => {
                          label     => 'Domain',
-                         #def_label => 'svcnum from svc_domain',
                          type      => 'select',
                          select_table => 'svc_domain',
                          select_key   => 'svcnum',
@@ -275,6 +278,7 @@ sub table_info {
                          type  => 'text',
                          disable_inventory => 1,
                          disable_select => 1,
+                         disable_part_svc_column => 1,
                        },
         'upbytes'   => { label => 'Upload',
                          type  => 'text',
@@ -282,6 +286,7 @@ sub table_info {
                          disable_select => 1,
                          'format' => \&FS::UI::bytecount::display_bytecount,
                          'parse' => \&FS::UI::bytecount::parse_bytecount,
+                         disable_part_svc_column => 1,
                        },
         'downbytes' => { label => 'Download',
                          type  => 'text',
@@ -289,6 +294,7 @@ sub table_info {
                          disable_select => 1,
                          'format' => \&FS::UI::bytecount::display_bytecount,
                          'parse' => \&FS::UI::bytecount::parse_bytecount,
+                         disable_part_svc_column => 1,
                        },
         'totalbytes'=> { label => 'Total up and download',
                          type  => 'text',
@@ -296,11 +302,13 @@ sub table_info {
                          disable_select => 1,
                          'format' => \&FS::UI::bytecount::display_bytecount,
                          'parse' => \&FS::UI::bytecount::parse_bytecount,
+                         disable_part_svc_column => 1,
                        },
         'seconds_threshold'   => { label => 'Seconds threshold',
                                    type  => 'text',
                                    disable_inventory => 1,
                                    disable_select => 1,
+                                   disable_part_svc_column => 1,
                                  },
         'upbytes_threshold'   => { label => 'Upload threshold',
                                    type  => 'text',
@@ -308,6 +316,7 @@ sub table_info {
                                    disable_select => 1,
                                    'format' => \&FS::UI::bytecount::display_bytecount,
                                    'parse' => \&FS::UI::bytecount::parse_bytecount,
+                                   disable_part_svc_column => 1,
                                  },
         'downbytes_threshold' => { label => 'Download threshold',
                                    type  => 'text',
@@ -315,6 +324,7 @@ sub table_info {
                                    disable_select => 1,
                                    'format' => \&FS::UI::bytecount::display_bytecount,
                                    'parse' => \&FS::UI::bytecount::parse_bytecount,
+                                   disable_part_svc_column => 1,
                                  },
         'totalbytes_threshold'=> { label => 'Total up and download threshold',
                                    type  => 'text',
@@ -322,6 +332,7 @@ sub table_info {
                                    disable_select => 1,
                                    'format' => \&FS::UI::bytecount::display_bytecount,
                                    'parse' => \&FS::UI::bytecount::parse_bytecount,
+                                   disable_part_svc_column => 1,
                                  },
         'last_login'=>           {
                                    label     => 'Last login',
@@ -337,6 +348,8 @@ sub table_info {
 
 sub table { 'svc_acct'; }
 
+sub table_dupcheck_fields { ( 'username', 'domsvc' ); }
+
 sub _fieldhandlers {
   {
     #false laziness with edit/svc_acct.cgi
@@ -433,8 +446,26 @@ sub label {
   $self->email(@_);
 }
 
+=item label_long [ END_TIMESTAMP [ START_TIMESTAMP ] ]
+
+Returns a longer string label for this acccount ("Real Name <username@domain>"
+if available, or "username@domain").
+
+END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
+history records.
+
 =cut
 
+sub label_long {
+  my $self = shift;
+  my $label = $self->label(@_);
+  my $finger = $self->finger;
+  return $label unless $finger =~ /\S/;
+  my $maxlen = 40 - length($label) - length($self->cust_svc->part_svc->svc);
+  $finger = substr($finger, 0, $maxlen-3).'...' if length($finger) > $maxlen;
+  "$finger <$label>";
+}
+
 =item insert [ , OPTION => VALUE ... ]
 
 Adds this account to the database.  If there is an error, returns the error,
@@ -499,10 +530,24 @@ sub insert {
     $self->svcpart($cust_svc->svcpart);
   }
 
-  $error = $self->_check_duplicate;
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $error;
+  # set usage fields and thresholds if unset but set in a package def
+  if ( $self->pkgnum ) {
+    my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+    my $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
+    if ( $part_pkg && $part_pkg->can('usage_valuehash') ) {
+
+      my %values = $part_pkg->usage_valuehash;
+      my $multiplier = $conf->exists('svc_acct-usage_threshold') 
+                         ? 1 - $conf->config('svc_acct-usage_threshold')/100
+                         : 0.20;
+
+      foreach ( keys %values ) {
+        next if $self->getfield($_);
+        $self->setfield( $_, $values{$_} );
+        $self->setfield( $_. '_threshold', int( $values{$_} * $multiplier ) );
+      }
+
+    }
   }
 
   my @jobnums;
@@ -817,15 +862,6 @@ sub replace {
 
   }
 
-  if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
-    $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
-    $error = $new->_check_duplicate;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
-
   $error = $new->SUPER::replace($old, @_);
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -987,13 +1023,28 @@ sub check {
   ;
   return $error if $error;
 
+  my $cust_pkg;
+  local $username_letter = $username_letter;
+  if ($self->svcnum) {
+    my $cust_svc = $self->cust_svc
+      or return "no cust_svc record found for svcnum ". $self->svcnum;
+    my $cust_pkg = $cust_svc->cust_pkg;
+  }
+  if ($self->pkgnum) {
+    $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $self->pkgnum } );#complain?
+  }
+  if ($cust_pkg) {
+    $username_letter =
+      $conf->exists('username-letter', $cust_pkg->cust_main->agentnum);
+  }
+
   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
   if ( $username_uppercase ) {
-    $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;
   } else {
-    $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/
+    $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:]{$usernamemin,$ulen})$/
       or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
     $recref->{username} = $1;
   }
@@ -1018,6 +1069,9 @@ sub check {
   unless ( $username_percent ) {
     $recref->{username} =~ /\%/ and return gettext('illegal_username');
   }
+  unless ( $username_colon ) {
+    $recref->{username} =~ /\:/ and return gettext('illegal_username');
+  }
 
   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
   $recref->{popnum} = $1;
@@ -1227,7 +1281,7 @@ sub _check_system {
 
 =item _check_duplicate
 
-Internal function to check for duplicates usernames, username@domain pairs and
+Internal method to check for duplicates usernames, username@domain pairs and
 uids.
 
 If the I<global_unique-username> configuration value is set to B<username> or
@@ -1244,20 +1298,7 @@ sub _check_duplicate {
   my $global_unique = $conf->config('global_unique-username') || 'none';
   return '' if $global_unique eq 'disabled';
 
-  warn "$me locking svc_acct table for duplicate search" if $DEBUG;
-  if ( driver_name =~ /^Pg/i ) {
-    dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
-      or die dbh->errstr;
-  } elsif ( driver_name =~ /^mysql/i ) {
-    dbh->do("SELECT * FROM duplicate_lock
-               WHERE lockname = 'svc_acct'
-              FOR UPDATE"
-          ) or die dbh->errstr;
-  } else {
-    die "unknown database ". driver_name.
-        "; don't know how to lock for duplicate search";
-  }
-  warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;
+  $self->lock_table;
 
   my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
   unless ( $part_svc ) {
@@ -1683,7 +1724,7 @@ my %op2condition = (
                $self->$column - $amount <= 0;
              },
   '+' => sub { my($self, $column, $amount) = @_;
-               $self->$column + $amount > 0;
+               ($self->$column || 0) + $amount > 0;
              },
 );
 my %op2warncondition = (
@@ -1692,7 +1733,7 @@ my %op2warncondition = (
                $self->$column - $amount <= $self->$threshold + 0;
              },
   '+' => sub { my($self, $column, $amount) = @_;
-               $self->$column + $amount > 0;
+               ($self->$column || 0) + $amount > 0;
              },
 );
 
@@ -1801,7 +1842,7 @@ sub _op_usage {
 }
 
 sub set_usage {
-  my( $self, $valueref ) = @_;
+  my( $self, $valueref, %options ) = @_;
 
   warn "$me set_usage called for svcnum ". $self->svcnum.
        ' ('. $self->email. "): ".
@@ -1822,6 +1863,11 @@ sub set_usage {
 
   my $reset = 0;
   my %handyhash = ();
+  if ( $options{null} ) { 
+    %handyhash = ( map { ( $_ => 'NULL', $_."_threshold" => 'NULL' ) }
+                   qw( seconds upbytes downbytes totalbytes )
+                 );
+  }
   foreach my $field (keys %$valueref){
     $reset = 1 if $valueref->{$field};
     $self->setfield($field, $valueref->{$field});
@@ -1840,8 +1886,8 @@ sub set_usage {
   #die $error if $error;         #services not explicity changed via the UI
 
   my $sql = "UPDATE svc_acct SET " .
-    join (',', map { "$_ =  ?" } (keys %handyhash) ).
-    " WHERE svcnum = ?";
+    join (',', map { "$_ =  $handyhash{$_}" } (keys %handyhash) ).
+    " WHERE svcnum = ". $self->svcnum;
 
   warn "$me $sql\n"
     if $DEBUG;
@@ -1849,7 +1895,7 @@ sub set_usage {
   if (scalar(keys %handyhash)) {
     my $sth = $dbh->prepare( $sql )
       or die "Error preparing $sql: ". $dbh->errstr;
-    my $rv = $sth->execute((values %handyhash), $self->svcnum);
+    my $rv = $sth->execute();
     die "Error executing $sql: ". $sth->errstr
       unless defined($rv);
     die "Can't update usage for svcnum ". $self->svcnum