event refactor, landing on HEAD!

[freeside.git] / FS / FS / access_user.pm

diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm
index ca311d3..8e4ad46 100644 (file)
--- a/FS/FS/access_user.pm
+++ b/FS/FS/access_user.pm
@@ -1,12 +1,23 @@
 package FS::access_user;
 
 use strict;
 package FS::access_user;
 
 use strict;

-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
+use vars qw( @ISA $htpasswd_file );
+use FS::UID;
+use FS::Conf;
+use FS::Record qw( qsearch qsearchs dbh );

 use FS::m2m_Common;
 use FS::m2m_Common;

+use FS::option_Common;

 use FS::access_usergroup;
 use FS::access_usergroup;

+use FS::agent;

 
 

-@ISA = qw( FS::m2m_Common FS::Record );
+@ISA = qw( FS::m2m_Common FS::option_Common FS::Record );
+#@ISA = qw( FS::m2m_Common FS::option_Common );
+
+#kludge htpasswd for now (i hope this bootstraps okay)
+FS::UID->install_callback( sub {
+  my $conf = new FS::Conf;
+  $htpasswd_file = $conf->base_dir. '/htpasswd';
+} );

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -29,7 +40,7 @@ FS::access_user - Object methods for access_user records
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 

-An FS::access_user object represents an example.  FS::access_user inherits from
+An FS::access_user object represents an internal access user.  FS::access_user inherits from

 FS::Record.  The following fields are currently supported:
 
 =over 4
 FS::Record.  The following fields are currently supported:
 
 =over 4


@@ -44,6 +55,8 @@ FS::Record.  The following fields are currently supported:
 
 =item first -
 
 
 =item first -
 

+=item disabled - empty or 'Y'
+

 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS


@@ -52,7 +65,7 @@ FS::Record.  The following fields are currently supported:
 
 =item new HASHREF
 
 
 =item new HASHREF
 

-Creates a new example.  To add the example to the database, see L<"insert">.
+Creates a new internal access user.  To add the user to the database, see L<"insert">.

 
 Note that this stores the hash reference, not a distinct copy of the hash it
 points to.  You can ask the object for a copy with the I<hash> method.
 
 Note that this stores the hash reference, not a distinct copy of the hash it
 points to.  You can ask the object for a copy with the I<hash> method.


@@ -63,6 +76,10 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'access_user'; }
 
 
 sub table { 'access_user'; }
 

+sub _option_table    { 'access_user_pref'; }
+sub _option_namecol  { 'prefname'; }
+sub _option_valuecol { 'prefvalue'; }
+

 =item insert
 
 Adds this record to the database.  If there is an error, returns the error,
 =item insert
 
 Adds this record to the database.  If there is an error, returns the error,


@@ -70,7 +87,58 @@ otherwise returns false.
 
 =cut
 
 
 =cut
 

-# the insert method can be inherited from FS::Record
+sub insert {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error = $self->htpasswd_kludge();
+  if ( $error ) {
+    $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+    return $error;
+  }
+
+  $error = $self->SUPER::insert(@_);
+
+  if ( $error ) {
+    $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+    return $error;
+  } else {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    '';
+  }
+
+}
+
+sub htpasswd_kludge {
+  my $self = shift;
+  
+  #awful kludge to skip setting htpasswd for fs_* users
+  return '' if $self->username =~ /^fs_/;
+
+  unshift @_, '-c' unless -e $htpasswd_file;
+  if ( 
+       system('htpasswd', '-b', @_,
+                          $htpasswd_file,
+                          $self->username,
+                          $self->_password,
+             ) == 0
+     )
+  {
+    return '';
+  } else {
+    return 'htpasswd exited unsucessfully';
+  }
+}

 
 =item delete
 
 
 =item delete
 


@@ -78,7 +146,34 @@ Delete this record from the database.
 
 =cut
 
 
 =cut
 

-# the delete method can be inherited from FS::Record
+sub delete {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error =
+       $self->SUPER::delete(@_)
+    || $self->htpasswd_kludge('-D')
+  ;
+
+  if ( $error ) {
+    $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+    return $error;
+  } else {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    '';
+  }
+
+}

 
 =item replace OLD_RECORD
 
 
 =item replace OLD_RECORD
 


@@ -87,11 +182,47 @@ returns the error, otherwise returns false.
 
 =cut
 
 
 =cut
 

-# the replace method can be inherited from FS::Record
+sub replace {
+  my $new = shift;
+
+  my $old = ( ref($_[0]) eq ref($new) )
+              ? shift
+              : $new->replace_old;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  if ( $new->_password ne $old->_password ) {
+    my $error = $new->htpasswd_kludge();
+    if ( $error ) {
+      $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  my $error = $new->SUPER::replace($old, @_);
+
+  if ( $error ) {
+    $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+    return $error;
+  } else {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    '';
+  }
+
+}

 
 =item check
 
 
 =item check
 

-Checks all fields to make sure this is a valid example.  If there is
+Checks all fields to make sure this is a valid internal access user.  If there is

 an error, returns the error, otherwise returns false.  Called by the insert
 and replace methods.
 
 an error, returns the error, otherwise returns false.  Called by the insert
 and replace methods.
 


@@ -105,10 +236,11 @@ sub check {
 
   my $error = 
     $self->ut_numbern('usernum')
 
   my $error = 
     $self->ut_numbern('usernum')

-    || $self->ut_text('username')
+    || $self->ut_alpha('username')

     || $self->ut_text('_password')
     || $self->ut_text('last')
     || $self->ut_text('first')
     || $self->ut_text('_password')
     || $self->ut_text('last')
     || $self->ut_text('first')

+    || $self->ut_enum('disabled', [ '', 'Y' ] )

   ;
   return $error if $error;
 
   ;
   return $error if $error;
 


@@ -151,11 +283,123 @@ sub access_usergroup {
 #
 #}
 
 #
 #}
 

+=item agentnums 
+
+Returns a list of agentnums this user can view (via group membership).
+
+=cut
+
+sub agentnums {
+  my $self = shift;
+  my $sth = dbh->prepare(
+    "SELECT DISTINCT agentnum FROM access_usergroup
+                              JOIN access_groupagent USING ( groupnum )
+       WHERE usernum = ?"
+  ) or die dbh->errstr;
+  $sth->execute($self->usernum) or die $sth->errstr;
+  map { $_->[0] } @{ $sth->fetchall_arrayref };
+}
+
+=item agentnums_href
+
+Returns a hashref of agentnums this user can view.
+
+=cut
+
+sub agentnums_href {
+  my $self = shift;
+  scalar( { map { $_ => 1 } $self->agentnums } );
+}
+
+=item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
+
+Returns an sql fragement to select only agentnums this user can view.
+
+Options are passed as a hashref or a list.  Available options are:
+
+=over 4
+
+=item null - The frament will also allow the selection of null agentnums.
+
+=item null_right - The fragment will also allow the selection of null agentnums if the current user has the provided access right
+

 =back
 
 =back
 

-=head1 BUGS
+=cut
+
+sub agentnums_sql {
+  my( $self ) = shift;
+  my %opt = ref($_[0]) ? %{$_[0]} : @_;

 
 

-The author forgot to customize this manpage.
+  my @agentnums = map { "agentnum = $_" } $self->agentnums;
+
+  push @agentnums, 'agentnum IS NULL'
+    if $opt{'null'}
+    || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
+
+  return ' 1 = 0 ' unless scalar(@agentnums);
+  '( '. join( ' OR ', @agentnums ). ' )';
+}
+
+=item agentnum
+
+Returns true if the user can view the specified agent.
+
+=cut
+
+sub agentnum {
+  my( $self, $agentnum ) = @_;
+  my $sth = dbh->prepare(
+    "SELECT COUNT(*) FROM access_usergroup
+                     JOIN access_groupagent USING ( groupnum )
+       WHERE usernum = ? AND agentnum = ?"
+  ) or die dbh->errstr;
+  $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
+  $sth->fetchrow_arrayref->[0];
+}
+
+=item agents
+
+Returns the list of agents this user can view (via group membership), as
+FS::agent objects.
+
+=cut
+
+sub agents {
+  my $self = shift;
+  qsearch({
+    'table'     => 'agent',
+    'hashref'   => { disabled=>'' },
+    'extra_sql' => ' AND '. $self->agentnums_sql,
+  });
+}
+
+=item access_right
+
+Given a right name, returns true if this user has this right (currently via
+group membership, eventually also via user overrides).
+
+=cut
+
+sub access_right {
+  my( $self, $rightname ) = @_;
+  my $sth = dbh->prepare("
+    SELECT groupnum FROM access_usergroup
+                    LEFT JOIN access_group USING ( groupnum )
+                    LEFT JOIN access_right
+                         ON ( access_group.groupnum = access_right.rightobjnum )
+      WHERE usernum = ?
+        AND righttype = 'FS::access_group'
+        AND rightname = ?
+  ") or die dbh->errstr;
+  $sth->execute($self->usernum, $rightname) or die $sth->errstr;
+  my $row = $sth->fetchrow_arrayref;
+  $row ? $row->[0] : '';
+}
+
+=back
+
+=head1 BUGS

 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO