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