FS/FS/UID.pm

   1 package FS::UID;
   2
   3 use strict;
   4 use vars qw(
   5   @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
   6   $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback
   7   $driver_name $AutoCommit
   8 );
   9 use subs qw(
  10   getsecrets cgisetotaker
  11 );
  12 use Exporter;
  13 use Carp qw(carp croak cluck);
  14 use DBI;
  15 use FS::Conf;
  16
  17 @ISA = qw(Exporter);
  18 @EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
  19                 getotaker dbh datasrc getsecrets driver_name myconnect );
  20
  21 $freeside_uid = scalar(getpwnam('freeside'));
  22
  23 $conf_dir = "/usr/local/etc/freeside/";
  24
  25 $AutoCommit = 1; #ours, not DBI
  26
  27 =head1 NAME
  28
  29 FS::UID - Subroutines for database login and assorted other stuff
  30
  31 =head1 SYNOPSIS
  32
  33   use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
  34   checkeuid checkruid);
  35
  36   adminsuidsetup $user;
  37
  38   $cgi = new CGI;
  39   $dbh = cgisuidsetup($cgi);
  40
  41   $dbh = dbh;
  42
  43   $datasrc = datasrc;
  44
  45   $driver_name = driver_name;
  46
  47 =head1 DESCRIPTION
  48
  49 Provides a hodgepodge of subroutines.
  50
  51 =head1 SUBROUTINES
  52
  53 =over 4
  54
  55 =item adminsuidsetup USER
  56
  57 Sets the user to USER (see config.html from the base documentation).
  58 Cleans the environment.
  59 Make sure the script is running as freeside, or setuid freeside.
  60 Opens a connection to the database.
  61 Swaps real and effective UIDs.
  62 Runs any defined callbacks (see below).
  63 Returns the DBI database handle (usually you don't need this).
  64
  65 =cut
  66
  67 sub adminsuidsetup {
  68   $dbh->disconnect if $dbh;
  69   &forksuidsetup(@_);
  70 }
  71
  72 sub forksuidsetup {
  73   $user = shift;
  74   croak "fatal: adminsuidsetup called without arguements" unless $user;
  75
  76   $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
  77   $user = $1;
  78
  79   $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
  80   $ENV{'SHELL'} = '/bin/sh';
  81   $ENV{'IFS'} = " \t\n";
  82   $ENV{'CDPATH'} = '';
  83   $ENV{'ENV'} = '';
  84   $ENV{'BASH_ENV'} = '';
  85
  86   croak "Not running uid freeside!" unless checkeuid();
  87
  88   $dbh = &myconnect;
  89
  90   foreach ( keys %callback ) {
  91     &{$callback{$_}};
  92     # breaks multi-database installs # delete $callback{$_}; #run once
  93   }
  94
  95   &{$_} foreach @callback;
  96
  97   $dbh;
  98 }
  99
 100 sub myconnect {
 101   $dbh = DBI->connect( getsecrets, {'AutoCommit' => 0, 'ChopBlanks' => 1, } )
 102     or die "DBI->connect error: $DBI::errstr\n";
 103 }
 104
 105 =item install_callback
 106
 107 A package can install a callback to be run in adminsuidsetup by passing
 108 a coderef to the FS::UID->install_callback class method.  If adminsuidsetup has
 109 run already, the callback will also be run immediately.
 110
 111     $coderef = sub { warn "Hi, I'm returning your call!" };
 112     FS::UID->install_callback($coderef);
 113
 114     install_callback FS::UID sub {
 115       warn "Hi, I'm returning your call!"
 116     };
 117
 118 =cut
 119
 120 sub install_callback {
 121   my $class = shift;
 122   my $callback = shift;
 123   push @callback, $callback;
 124   &{$callback} if $dbh;
 125 }
 126
 127 =item cgisuidsetup CGI_object
 128
 129 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
 130 object (CGI::Base is depriciated).  Runs cgisetotaker and then adminsuidsetup.
 131
 132 =cut
 133
 134 sub cgisuidsetup {
 135   $cgi=shift;
 136   if ( $cgi->isa('CGI::Base') ) {
 137     carp "Use of CGI::Base is depriciated";
 138   } elsif ( $cgi->isa('Apache') ) {
 139
 140   } elsif ( ! $cgi->isa('CGI') ) {
 141     croak "fatal: unrecognized object $cgi";
 142   }
 143   cgisetotaker;
 144   adminsuidsetup($user);
 145 }
 146
 147 =item cgi
 148
 149 Returns the CGI (see L<CGI>) object.
 150
 151 =cut
 152
 153 sub cgi {
 154   carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
 155   $cgi;
 156 }
 157
 158 =item dbh
 159
 160 Returns the DBI database handle.
 161
 162 =cut
 163
 164 sub dbh {
 165   $dbh;
 166 }
 167
 168 =item datasrc
 169
 170 Returns the DBI data source.
 171
 172 =cut
 173
 174 sub datasrc {
 175   $datasrc;
 176 }
 177
 178 =item driver_name
 179
 180 Returns just the driver name portion of the DBI data source.
 181
 182 =cut
 183
 184 sub driver_name {
 185   return $driver_name if defined $driver_name;
 186   $driver_name = ( split(':', $datasrc) )[1];
 187 }
 188
 189 sub suidsetup {
 190   croak "suidsetup depriciated";
 191 }
 192
 193 =item getotaker
 194
 195 Returns the current Freeside user.
 196
 197 =cut
 198
 199 sub getotaker {
 200   #$user;
 201   #stupid kludge until schema otaker fields are not 8 chars
 202   substr($user,0,8);
 203 }
 204
 205 =item cgisetotaker
 206
 207 Sets and returns the CGI REMOTE_USER.  $cgi should be defined as a CGI.pm
 208 object (see L<CGI>) or an Apache object (see L<Apache>).  Support for CGI::Base
 209 and derived classes is depriciated.
 210
 211 =cut
 212
 213 sub cgisetotaker {
 214   if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
 215     carp "Use of CGI::Base is depriciated";
 216     $user = lc ( $cgi->var('REMOTE_USER') );
 217   } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
 218     $user = lc ( $cgi->remote_user );
 219   } elsif ( $cgi && $cgi->isa('Apache') ) {
 220     $user = lc ( $cgi->connection->user );
 221   } else {
 222     die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
 223         "Apache user authentication as documented in httemplate/docs/install.html";
 224   }
 225   $user;
 226 }
 227
 228 =item checkeuid
 229
 230 Returns true if effective UID is that of the freeside user.
 231
 232 =cut
 233
 234 sub checkeuid {
 235   ( $> == $freeside_uid );
 236 }
 237
 238 =item checkruid
 239
 240 Returns true if the real UID is that of the freeside user.
 241
 242 =cut
 243
 244 sub checkruid {
 245   ( $< == $freeside_uid );
 246 }
 247
 248 =item getsecrets [ USER ]
 249
 250 Sets the user to USER, if supplied.
 251 Sets and returns the DBI datasource, username and password for this user from
 252 the `/usr/local/etc/freeside/mapsecrets' file.
 253
 254 =cut
 255
 256 sub getsecrets {
 257   my($setuser) = shift;
 258   $user = $setuser if $setuser;
 259   die "No user!" unless $user;
 260   my($conf) = new FS::Conf $conf_dir;
 261   my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
 262   die "User $user not found in mapsecrets!" unless $line;
 263   $line =~ /^\s*$user\s+(.*)$/;
 264   $secrets = $1;
 265   die "Illegal mapsecrets line for user?!" unless $secrets;
 266   ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
 267     or die "Can't get secrets: $!";
 268   $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
 269   undef $driver_name;
 270   ($datasrc, $db_user, $db_pass);
 271 }
 272
 273 =back
 274
 275 =head1 CALLBACKS
 276
 277 Warning: this interface is (still) likely to change in future releases.
 278
 279 New (experimental) callback interface:
 280
 281 A package can install a callback to be run in adminsuidsetup by passing
 282 a coderef to the FS::UID->install_callback class method.  If adminsuidsetup has
 283 run already, the callback will also be run immediately.
 284
 285     $coderef = sub { warn "Hi, I'm returning your call!" };
 286     FS::UID->install_callback($coderef);
 287
 288     install_callback FS::UID sub {
 289       warn "Hi, I'm returning your call!"
 290     };
 291
 292 Old (deprecated) callback interface:
 293
 294 A package can install a callback to be run in adminsuidsetup by putting a
 295 coderef into the hash %FS::UID::callback :
 296
 297     $coderef = sub { warn "Hi, I'm returning your call!" };
 298     $FS::UID::callback{'Package::Name'} = $coderef;
 299
 300 =head1 BUGS
 301
 302 Too many package-global variables.
 303
 304 Not OO.
 305
 306 No capabilities yet.  When mod_perl and Authen::DBI are implemented,
 307 cgisuidsetup will go away as well.
 308
 309 Goes through contortions to support non-OO syntax with multiple datasrc's.
 310
 311 Callbacks are (still) inelegant.
 312
 313 =head1 SEE ALSO
 314
 315 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
 316
 317 =cut
 318
 319 1;
 320