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