FS/FS/access_user.pm

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