FS/FS/access_user.pm

   1 package FS::access_user;
   2
   3 use strict;
   4 use vars qw( @ISA $htpasswd_file );
   5 use FS::UID;
   6 use FS::Conf;
   7 use FS::Record qw( qsearch qsearchs dbh );
   8 use FS::m2m_Common;
   9 use FS::option_Common;
  10 use FS::access_usergroup;
  11 use FS::agent;
  12
  13 @ISA = qw( FS::m2m_Common FS::option_Common FS::Record );
  14 #@ISA = qw( FS::m2m_Common FS::option_Common );
  15
  16 #kludge htpasswd for now (i hope this bootstraps okay)
  17 FS::UID->install_callback( sub {
  18   my $conf = new FS::Conf;
  19   $htpasswd_file = $conf->base_dir. '/htpasswd';
  20 } );
  21
  22 =head1 NAME
  23
  24 FS::access_user - Object methods for access_user records
  25
  26 =head1 SYNOPSIS
  27
  28   use FS::access_user;
  29
  30   $record = new FS::access_user \%hash;
  31   $record = new FS::access_user { 'column' => 'value' };
  32
  33   $error = $record->insert;
  34
  35   $error = $new_record->replace($old_record);
  36
  37   $error = $record->delete;
  38
  39   $error = $record->check;
  40
  41 =head1 DESCRIPTION
  42
  43 An FS::access_user object represents an internal access user.  FS::access_user inherits from
  44 FS::Record.  The following fields are currently supported:
  45
  46 =over 4
  47
  48 =item usernum - primary key
  49
  50 =item username -
  51
  52 =item _password -
  53
  54 =item last -
  55
  56 =item first -
  57
  58 =item disabled - empty or 'Y'
  59
  60 =back
  61
  62 =head1 METHODS
  63
  64 =over 4
  65
  66 =item new HASHREF
  67
  68 Creates a new internal access user.  To add the user to the database, see L<"insert">.
  69
  70 Note that this stores the hash reference, not a distinct copy of the hash it
  71 points to.  You can ask the object for a copy with the I<hash> method.
  72
  73 =cut
  74
  75 # the new method can be inherited from FS::Record, if a table method is defined
  76
  77 sub table { 'access_user'; }
  78
  79 sub _option_table    { 'access_user_pref'; }
  80 sub _option_namecol  { 'prefname'; }
  81 sub _option_valuecol { 'prefvalue'; }
  82
  83 =item insert
  84
  85 Adds this record to the database.  If there is an error, returns the error,
  86 otherwise returns false.
  87
  88 =cut
  89
  90 sub insert {
  91   my $self = shift;
  92
  93   local $SIG{HUP} = 'IGNORE';
  94   local $SIG{INT} = 'IGNORE';
  95   local $SIG{QUIT} = 'IGNORE';
  96   local $SIG{TERM} = 'IGNORE';
  97   local $SIG{TSTP} = 'IGNORE';
  98   local $SIG{PIPE} = 'IGNORE';
  99
 100   my $oldAutoCommit = $FS::UID::AutoCommit;
 101   local $FS::UID::AutoCommit = 0;
 102   my $dbh = dbh;
 103
 104   my $error = $self->htpasswd_kludge();
 105   if ( $error ) {
 106     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 107     return $error;
 108   }
 109
 110   $error = $self->SUPER::insert(@_);
 111
 112   if ( $error ) {
 113     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 114     return $error;
 115   } else {
 116     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 117     '';
 118   }
 119
 120 }
 121
 122 sub htpasswd_kludge {
 123   my $self = shift;
 124
 125   #awful kludge to skip setting htpasswd for fs_* users
 126   return '' if $self->username =~ /^fs_/;
 127
 128   unshift @_, '-c' unless -e $htpasswd_file;
 129   if (
 130        system('htpasswd', '-b', @_,
 131                           $htpasswd_file,
 132                           $self->username,
 133                           $self->_password,
 134              ) == 0
 135      )
 136   {
 137     return '';
 138   } else {
 139     return 'htpasswd exited unsucessfully';
 140   }
 141 }
 142
 143 =item delete
 144
 145 Delete this record from the database.
 146
 147 =cut
 148
 149 sub delete {
 150   my $self = shift;
 151
 152   local $SIG{HUP} = 'IGNORE';
 153   local $SIG{INT} = 'IGNORE';
 154   local $SIG{QUIT} = 'IGNORE';
 155   local $SIG{TERM} = 'IGNORE';
 156   local $SIG{TSTP} = 'IGNORE';
 157   local $SIG{PIPE} = 'IGNORE';
 158
 159   my $oldAutoCommit = $FS::UID::AutoCommit;
 160   local $FS::UID::AutoCommit = 0;
 161   my $dbh = dbh;
 162
 163   my $error =
 164        $self->SUPER::delete(@_)
 165     || $self->htpasswd_kludge('-D')
 166   ;
 167
 168   if ( $error ) {
 169     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 170     return $error;
 171   } else {
 172     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 173     '';
 174   }
 175
 176 }
 177
 178 =item replace OLD_RECORD
 179
 180 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 181 returns the error, otherwise returns false.
 182
 183 =cut
 184
 185 sub replace {
 186   my $new = shift;
 187
 188   my $old = ( ref($_[0]) eq ref($new) )
 189               ? shift
 190               : $new->replace_old;
 191
 192   local $SIG{HUP} = 'IGNORE';
 193   local $SIG{INT} = 'IGNORE';
 194   local $SIG{QUIT} = 'IGNORE';
 195   local $SIG{TERM} = 'IGNORE';
 196   local $SIG{TSTP} = 'IGNORE';
 197   local $SIG{PIPE} = 'IGNORE';
 198
 199   my $oldAutoCommit = $FS::UID::AutoCommit;
 200   local $FS::UID::AutoCommit = 0;
 201   my $dbh = dbh;
 202
 203   if ( $new->_password ne $old->_password ) {
 204     my $error = $new->htpasswd_kludge();
 205     if ( $error ) {
 206       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 207       return $error;
 208     }
 209   }
 210
 211   my $error = $new->SUPER::replace($old, @_);
 212
 213   if ( $error ) {
 214     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 215     return $error;
 216   } else {
 217     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 218     '';
 219   }
 220
 221 }
 222
 223 =item check
 224
 225 Checks all fields to make sure this is a valid internal access user.  If there is
 226 an error, returns the error, otherwise returns false.  Called by the insert
 227 and replace methods.
 228
 229 =cut
 230
 231 # the check method should currently be supplied - FS::Record contains some
 232 # data checking routines
 233
 234 sub check {
 235   my $self = shift;
 236
 237   my $error =
 238     $self->ut_numbern('usernum')
 239     || $self->ut_alpha('username')
 240     || $self->ut_text('_password')
 241     || $self->ut_text('last')
 242     || $self->ut_text('first')
 243     || $self->ut_enum('disabled', [ '', 'Y' ] )
 244   ;
 245   return $error if $error;
 246
 247   $self->SUPER::check;
 248 }
 249
 250 =item name
 251
 252 Returns a name string for this user: "Last, First".
 253
 254 =cut
 255
 256 sub name {
 257   my $self = shift;
 258   $self->get('last'). ', '. $self->first;
 259 }
 260
 261 =item access_usergroup
 262
 263 =cut
 264
 265 sub access_usergroup {
 266   my $self = shift;
 267   qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
 268 }
 269
 270 #=item access_groups
 271 #
 272 #=cut
 273 #
 274 #sub access_groups {
 275 #
 276 #}
 277 #
 278 #=item access_groupnames
 279 #
 280 #=cut
 281 #
 282 #sub access_groupnames {
 283 #
 284 #}
 285
 286 =item agentnums
 287
 288 Returns a list of agentnums this user can view (via group membership).
 289
 290 =cut
 291
 292 sub agentnums {
 293   my $self = shift;
 294   my $sth = dbh->prepare(
 295     "SELECT DISTINCT agentnum FROM access_usergroup
 296                               JOIN access_groupagent USING ( groupnum )
 297        WHERE usernum = ?"
 298   ) or die dbh->errstr;
 299   $sth->execute($self->usernum) or die $sth->errstr;
 300   map { $_->[0] } @{ $sth->fetchall_arrayref };
 301 }
 302
 303 =item agentnums_href
 304
 305 Returns a hashref of agentnums this user can view.
 306
 307 =cut
 308
 309 sub agentnums_href {
 310   my $self = shift;
 311   scalar( { map { $_ => 1 } $self->agentnums } );
 312 }
 313
 314 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
 315
 316 Returns an sql fragement to select only agentnums this user can view.
 317
 318 Options are passed as a hashref or a list.  Available options are:
 319
 320 =over 4
 321
 322 =item null - The frament will also allow the selection of null agentnums.
 323
 324 =item null_right - The fragment will also allow the selection of null agentnums if the current user has the provided access right
 325
 326 =back
 327
 328 =cut
 329
 330 sub agentnums_sql {
 331   my( $self ) = shift;
 332   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 333
 334   my @agentnums = map { "agentnum = $_" } $self->agentnums;
 335
 336   push @agentnums, 'agentnum IS NULL'
 337     if $opt{'null'}
 338     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 339
 340   return ' 1 = 0 ' unless scalar(@agentnums);
 341   '( '. join( ' OR ', @agentnums ). ' )';
 342 }
 343
 344 =item agentnum
 345
 346 Returns true if the user can view the specified agent.
 347
 348 =cut
 349
 350 sub agentnum {
 351   my( $self, $agentnum ) = @_;
 352   my $sth = dbh->prepare(
 353     "SELECT COUNT(*) FROM access_usergroup
 354                      JOIN access_groupagent USING ( groupnum )
 355        WHERE usernum = ? AND agentnum = ?"
 356   ) or die dbh->errstr;
 357   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 358   $sth->fetchrow_arrayref->[0];
 359 }
 360
 361 =item agents
 362
 363 Returns the list of agents this user can view (via group membership), as
 364 FS::agent objects.
 365
 366 =cut
 367
 368 sub agents {
 369   my $self = shift;
 370   qsearch({
 371     'table'     => 'agent',
 372     'hashref'   => { disabled=>'' },
 373     'extra_sql' => ' AND '. $self->agentnums_sql,
 374   });
 375 }
 376
 377 =item access_right
 378
 379 Given a right name, returns true if this user has this right (currently via
 380 group membership, eventually also via user overrides).
 381
 382 =cut
 383
 384 sub access_right {
 385   my( $self, $rightname ) = @_;
 386   my $sth = dbh->prepare("
 387     SELECT groupnum FROM access_usergroup
 388                     LEFT JOIN access_group USING ( groupnum )
 389                     LEFT JOIN access_right
 390                          ON ( access_group.groupnum = access_right.rightobjnum )
 391       WHERE usernum = ?
 392         AND righttype = 'FS::access_group'
 393         AND rightname = ?
 394   ") or die dbh->errstr;
 395   $sth->execute($self->usernum, $rightname) or die $sth->errstr;
 396   my $row = $sth->fetchrow_arrayref;
 397   $row ? $row->[0] : '';
 398 }
 399
 400 =back
 401
 402 =head1 BUGS
 403
 404 =head1 SEE ALSO
 405
 406 L<FS::Record>, schema.html from the base documentation.
 407
 408 =cut
 409
 410 1;
 411