X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=8d22c21e00f8330f54ae1f50711343c9e12a05ba;hp=bb9fe67b3a41a7283c0e9ec5d8c131b12598aa95;hb=87af741da0dd5f6a76bbb566b4d6c54cd5b15315;hpb=dd12d8bcbb33acb0ffa087a70c566e8328fbe9c3

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index bb9fe67b3..8d22c21e0 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -1,7 +1,8 @@
 package FS::svc_acct;
 
 use strict;
-use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin
+use vars qw( @ISA $nossh_hack $noexport_hack $conf
+             $dir_prefix @shells $usernamemin
              $usernamemax $passwordmin $passwordmax
              $username_ampersand $username_letter $username_letterfirst
              $username_noperiod $username_uppercase
@@ -9,7 +10,6 @@ use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin
              $cyrus_server $cyrus_admin_user $cyrus_admin_pass
              $cp_server $cp_user $cp_pass $cp_workgroup
              $dirhash
-             $icradius_dbh
              @saltset @pw_set
              $rsync $ssh $exportdir $vpopdir);
 use Carp;
@@ -27,6 +27,7 @@ use FS::cust_main_invoice;
 use FS::svc_domain;
 use FS::raddb;
 use FS::queue;
+use FS::radius_usergroup;
 
 @ISA = qw( FS::svc_Common );
 
@@ -88,18 +89,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
     $cp_pass = '';
     $cp_workgroup = '';
   }
-  if ( $conf->exists('icradiusmachines') ) {
-    if ( $conf->exists('icradius_secrets') ) {
-      #need some sort of late binding so it's only connected to when
-      # actually used, hmm
-      $icradius_dbh = DBI->connect($conf->config('icradius_secrets'))
-        or die $DBI::errstr;
-    } else {
-      $icradius_dbh = dbh;
-    }
-  } else {
-    $icradius_dbh = '';
-  }
+
   $dirhash = $conf->config('dirhash') || 0;
   $exportdir = "/usr/local/etc/freeside/export." . datasrc;
   if ( $conf->exists('vpopmailmachines') ) {
@@ -202,8 +192,6 @@ FS::svc_Common.  The following fields are currently supported:
 
 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
 
-=item domsvc - service number of svc_domain with which to associate
-
 =back
 
 =head1 METHODS
@@ -226,6 +214,10 @@ otherwise returns false.
 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be 
 defined.  An FS::cust_svc record will be created and inserted.
 
+The additional field I<usergroup> can optionally be defined; if so it should
+contain an arrayref of group names.  See L<FS::radius_usergroup>.  (used in
+sqlradius export only)
+
 If the configuration value (see L<FS::Conf>) shellmachine exists, and the 
 username, uid, and dir fields are defined, the command(s) specified in
 the shellmachine-useradd configuration are added to the job queue (see
@@ -246,6 +238,8 @@ $username, $uid, $gid, $dir, and $shell.
 
 (TODOC: cyrus config file, L<FS::queue> and L<freeside-queued>)
 
+(TODOC: new exports! $noexport_hack)
+
 =cut
 
 sub insert {
@@ -263,8 +257,6 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $amount = 0;
-
   $error = $self->check;
   return $error if $error;
 
@@ -297,6 +289,34 @@ 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;
+      }
+    }
+  }
+
+  #new-style exports!
+  unless ( $noexport_hack ) {
+    foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
+      my $error = $part_export->export_insert($self);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "exporting to ". $part_export->exporttype.
+               " (transaction rolled back): $error";
+      }
+    }
+  }
+
+  #old-style exports
+
   my( $username, $uid, $gid, $dir, $shell ) = (
     $self->username,
     $self->uid,
@@ -340,37 +360,6 @@ sub insert {
     }
   }
   
-  if ( $icradius_dbh ) {
-
-    my $radcheck_queue =
-      new FS::queue {
-      'svcnum' => $self->svcnum,
-      'job' => 'FS::svc_acct::icradius_rc_insert'
-    };
-    $error = $radcheck_queue->insert( $self->username,
-                                      $self->_password,
-                                      $self->radius_check
-                                    );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "queueing job (transaction rolled back): $error";
-    }
-
-    my $radreply_queue =
-      new FS::queue { 
-      'svcnum' => $self->svcnum,
-      'job' => 'FS::svc_acct::icradius_rr_insert'
-    };
-    $error = $radreply_queue->insert( $self->username,
-                                      $self->_password,
-                                      $self->radius_reply
-                                    );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "queueing job (transaction rolled back): $error";
-    }
-  }
-
   if ( $vpopdir ) {
 
     my $vpopmail_queue =
@@ -390,6 +379,7 @@ sub insert {
 
   }
 
+  #end of old-style exports
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   ''; #no error
@@ -451,56 +441,6 @@ sub cp_insert {
   die $app->message."\n" unless $app->ok;
 }
 
-sub icradius_rc_insert {
-  my( $username, $password, %radcheck ) = @_;
-  
-  my $sth = $icradius_dbh->prepare(
-    "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ".
-    join(", ", map { $icradius_dbh->quote($_) } (
-      '',
-      $username,
-      "Password",
-      $password,
-    ) ). " )"
-  );
-  $sth->execute or die "can't insert into radcheck table: ". $sth->errstr;
-
-  foreach my $attribute ( keys %radcheck ) {
-    my $sth = $icradius_dbh->prepare(
-      "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ".
-      join(", ", map { $icradius_dbh->quote($_) } (
-        '',
-        $username,
-        $attribute,
-        $radcheck{$attribute},
-      ) ). " )"
-    );
-    $sth->execute or die "can't insert into radcheck table: ". $sth->errstr;
-  }
-
-  1;
-}
-
-sub icradius_rr_insert {
-  my( $username, $password, %radreply ) = @_;
-  
-  foreach my $attribute ( keys %radreply ) {
-    my $sth = $icradius_dbh->prepare(
-      "INSERT INTO radreply ( id, UserName, Attribute, Value ) VALUES ( ".
-      join(", ", map { $icradius_dbh->quote($_) } (
-        '',
-        $username,
-        $attribute,
-        $radreply{$attribute},
-      ) ). " )"
-    );
-    $sth->execute or die "can't insert into radreply table: ". $sth->errstr;
-  }
-
-  1;
-}
-
-
 sub vpopmail_insert {
   my( $username, $password, $domain, $vpopdir ) = @_;
   
@@ -571,6 +511,8 @@ $username and $dir.
 
 (TODOC: cyrus config file)
 
+(TODOC: new exports! $noexport_hack)
+
 =cut
 
 sub delete {
@@ -590,7 +532,7 @@ sub delete {
   return "Can't delete an account with (svc_www) web service!"
     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 
-  # what about records in session ?
+  # what about records in session ? (they should refer to history table)
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -633,12 +575,38 @@ sub delete {
     }
   }
 
+  foreach my $radius_usergroup (
+    qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
+  ) {
+    my $error = $radius_usergroup->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  my $part_svc = $self->cust_svc->part_svc;
+
   my $error = $self->SUPER::delete;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
   }
 
+  #new-style exports!
+  unless ( $noexport_hack ) {
+    foreach my $part_export ( $part_svc->part_export ) {
+      my $error = $part_export->export_delete($self);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "exporting to ". $part_export->exporttype.
+               " (transaction rolled back): $error";
+      }
+    }
+  }
+
+  #old-style exports
+
   my( $username, $dir ) = (
     $self->username,
     $self->dir,
@@ -671,24 +639,6 @@ sub delete {
     }
   }
 
-  if ( $icradius_dbh ) {
-
-    my $radcheck_queue =
-      new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' };
-    $error = $radcheck_queue->insert( $self->username );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "queueing job (transaction rolled back): $error";
-    }
-
-    my $radreply_queue =
-      new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' };
-    $error = $radreply_queue->insert( $self->username );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "queueing job (transaction rolled back): $error";
-    }
-  }
   if ( $vpopdir ) {
     my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' };
     $error = $queue->insert( $self->username, $self->domain );
@@ -699,6 +649,8 @@ sub delete {
 
   }
 
+  #end of old-style exports
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }
@@ -742,30 +694,6 @@ sub cp_delete {
   die $app->message."\n" unless $app->ok;
 }
 
-sub icradius_rc_delete {
-  my $username = shift;
-  
-  my $sth = $icradius_dbh->prepare(
-    'DELETE FROM radcheck WHERE UserName = ?'
-  );
-  $sth->execute($username)
-    or die "can't delete from radcheck table: ". $sth->errstr;
-
-  1;
-}
-
-sub icradius_rr_delete {
-  my $username = shift;
-  
-  my $sth = $icradius_dbh->prepare(
-    'DELETE FROM radreply WHERE UserName = ?'
-  );
-  $sth->execute($username)
-    or die "can't delete from radreply table: ". $sth->errstr;
-
-  1;
-}
-
 sub vpopmail_delete {
   my( $username, $domain ) = @_;
   
@@ -798,6 +726,10 @@ sub vpopmail_delete {
 Replaces OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
+The additional field I<usergroup> can optionally be defined; if so it should
+contain an arrayref of group names.  See L<FS::radius_usergroup>.  (used in
+sqlradius export only)
+
 If the configuration value (see L<FS::Conf>) shellmachine exists, and the 
 dir field has changed, the command(s) specified in the shellmachine-usermod
 configuraiton file are added to the job queue (see L<FS::queue> and
@@ -858,6 +790,54 @@ sub replace {
     return $error if $error;
   }
 
+  $old->usergroup( [ $old->radius_groups ] );
+  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";
+      }
+    }
+
+  }
+
+  #new-style exports!
+  unless ( $noexport_hack ) {
+    foreach my $part_export ( $new->cust_svc->part_svc->part_export ) {
+      my $error = $part_export->export_replace($new,$old);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "exporting to ". $part_export->exporttype.
+               " (transaction rolled back): $error";
+      }
+    }
+  }
+
+  #old-style exports
+
   my ( $old_dir, $new_dir, $uid, $gid ) = (
     $old->getfield('dir'),
     $new->getfield('dir'),
@@ -900,19 +880,6 @@ sub replace {
     }
   }
 
-  if ( $icradius_dbh ) {
-    my $queue = new FS::queue {  
-      'svcnum' => $new->svcnum,
-      'job' => 'FS::svc_acct::icradius_rc_replace'
-    };
-    $error = $queue->insert( $new->username,
-                             $new->_password,
-                           );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "queueing job (transaction rolled back): $error";
-    }
-  }
   if ( $vpopdir ) {
     my $cpassword = crypt(
       $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]
@@ -938,23 +905,12 @@ sub replace {
     }
   }
 
+  #end of old-style exports
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   ''; #no error
 }
 
-sub icradius_rc_replace {
-  my( $username, $new_password ) = @_;
- 
-   my $sth = $icradius_dbh->prepare(
-     "UPDATE radcheck SET Value = ? WHERE UserName = ? and Attribute = ?"
-   );
-   $sth->execute($new_password, $username, 'Password' )
-     or die "can't update radcheck table: ". $sth->errstr;
-
-  1;
-}
-
 sub cp_rename {
   my ( $old_username, $new_username ) = @_;
 
@@ -1116,8 +1072,14 @@ sub check {
   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_textn('sec_phrase')
   ;
   return $error if $error;
 
@@ -1305,19 +1267,22 @@ sub radius_reply {
 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 check attributes of this record.
 
-Accessing RADIUS attributes directly is not supported and will break in the
-future.
+Note that this is now the preferred method for reading RADIUS attributes - 
+accessing the columns directly is discouraged, as the column names are
+expected to change in the future.
 
 =cut
 
 sub radius_check {
   my $self = shift;
-  map {
-    /^(rc_(.*))$/;
-    my($column, $attrib) = ($1, $2);
-    #$attrib =~ s/_/\-/g;
-    ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
-  } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
+  ( 'Password' => $self->_password,
+    map {
+      /^(rc_(.*))$/;
+      my($column, $attrib) = ($1, $2);
+      #$attrib =~ s/_/\-/g;
+      ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
+    } grep { /^rc_/ && $self->getfield($_) } fields( $self->table )
+  );
 }
 
 =item domain
@@ -1388,8 +1353,71 @@ sub seconds_since {
   $self->cust_svc->seconds_since(@_);
 }
 
+=item radius_groups
+
+Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
+
+=cut
+
+sub radius_groups {
+  my $self = shift;
+  map { $_->groupname }
+    qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
+}
+
 =back
 
+=head1 SUBROUTINES
+
+=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 .= '<OPTION';
+    if ( $sel_groups{$group} ) {
+      $html .= ' SELECTED';
+      $sel_groups{$group} = 0;
+    }
+    $html .= ">$group</OPTION>\n";
+  }
+  foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
+    $html .= "<OPTION 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;
+}
+
 =head1 BUGS
 
 The $recref stuff in sub check should be cleaned up.
@@ -1398,6 +1426,9 @@ 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...
+
 =head1 SEE ALSO
 
 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,