X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=9da5a6671db42081823300be6e864b24d99f916b;hp=6ac2b9d753d897cb0580d8a8fa67c7078ffd753a;hb=20bb426a02c0ea54d8feaea7c5da51735ab70293;hpb=5a30e3a89e4e313a526a7f03afbe94282c715bdd

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 6ac2b9d75..9da5a6671 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,9 +10,8 @@ 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);
+             @saltset @pw_set
+             $rsync $ssh $exportdir $vpopdir);
 use Carp;
 use File::Path;
 use Fcntl qw(:flock);
@@ -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') ) {
@@ -246,6 +236,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 {
@@ -273,6 +265,16 @@ sub insert {
                                'domsvc'   => $self->domsvc,
                              } );
 
+  if ( $self->svcnum ) {
+    my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
+    unless ( $cust_svc ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "no cust_svc record found for svcnum ". $self->svcnum;
+    }
+    $self->pkgnum($cust_svc->pkgnum);
+    $self->svcpart($cust_svc->svcpart);
+  }
+
   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
   return "Unknown svcpart" unless $part_svc;
   return "uid in use"
@@ -287,6 +289,20 @@ sub insert {
     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,
@@ -330,37 +346,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 =
@@ -380,6 +365,7 @@ sub insert {
 
   }
 
+  #end of old-style exports
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   ''; #no error
@@ -441,61 +427,11 @@ 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 ) = @_;
   
   (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd")
-    and flock(VPASSWD,LOCK_EX|LOCK_NB)
+    and flock(VPASSWD,LOCK_EX)
   ) or die "can't open vpasswd file for $username\@$domain: $exportdir/domains/$domain/vpasswd";
   print VPASSWD join(":",
     $username,
@@ -517,7 +453,8 @@ sub vpopmail_insert {
   mkdir "$exportdir/domains/$domain/$username/Maildir/tmp", 0700 or die "can't create Maildir";
  
   my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' };
-  $error = $queue->insert;
+  my $error = $queue->insert;
+  die $error if $error;
 
   1;
 }
@@ -528,7 +465,7 @@ sub vpopmail_sync {
   my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]);
   
   chdir $exportdir;
-  my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$pdir/domains/")
+  my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/");
   system {$args[0]} @args;
 
 }
@@ -560,6 +497,8 @@ $username and $dir.
 
 (TODOC: cyrus config file)
 
+(TODOC: new exports! $noexport_hack)
+
 =cut
 
 sub delete {
@@ -579,7 +518,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';
@@ -628,6 +567,20 @@ sub delete {
     return $error;
   }
 
+  #new-style exports!
+  unless ( $noexport_hack ) {
+    foreach my $part_export ( $self->cust_svc->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,
@@ -660,24 +613,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 );
@@ -688,6 +623,8 @@ sub delete {
 
   }
 
+  #end of old-style exports
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }
@@ -731,35 +668,11 @@ 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 ) = @_;
   
   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
-    and flock(VPASSWD,LOCK_EX|LOCK_NB)
+    and flock(VPASSWD,LOCK_EX)
   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
 
   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
@@ -847,6 +760,20 @@ sub replace {
     return $error if $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'),
@@ -889,19 +816,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))]
@@ -927,23 +841,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 ) = @_;
 
@@ -1007,7 +910,7 @@ sub vpopmail_replace_password {
   my( $username, $password, $domain ) = @_;
   
   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
-    and flock(VPASSWD,LOCK_EX|LOCK_NB)
+    and flock(VPASSWD,LOCK_EX)
   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
 
   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
@@ -1029,7 +932,8 @@ sub vpopmail_replace_password {
   close(VPASSWD);
 
   my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' };
-  $error = $queue->insert;
+  my $error = $queue->insert;
+  die $error if $error;
 
   1;
 }
@@ -1293,19 +1197,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
@@ -1376,8 +1283,64 @@ 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
+
+=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;
+    }
+    </SCRIPT>
+    <SELECT MULTIPLE NAME="$selectname">
+END
+
+  foreach my $group ( @all_groups ) {
+    $html .= '<OPTION';
+    $html .= ' SELECTED' if $sel_groups{$group};
+    $html .= ">$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.
@@ -1386,6 +1349,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,