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 );
  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   getsecrets;
  88   $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
  89                           'AutoCommit' => 0,
  90                           'ChopBlanks' => 1,
  91   } ) or die "DBI->connect error: $DBI::errstr\n";
  92
  93   foreach ( keys %callback ) {
  94     &{$callback{$_}};
  95     # breaks multi-database installs # delete $callback{$_}; #run once
  96   }
  97
  98   &{$_} foreach @callback;
  99
 100   $dbh;
 101 }
 102
 103 =item install_callback
 104
 105 A package can install a callback to be run in adminsuidsetup by passing
 106 a coderef to the FS::UID->install_callback class method.  If adminsuidsetup has
 107 run already, the callback will also be run immediately.
 108
 109     $coderef = sub { warn "Hi, I'm returning your call!" };
 110     FS::UID->install_callback($coderef);
 111
 112     install_callback FS::UID sub {
 113       warn "Hi, I'm returning your call!"
 114     };
 115
 116 =cut
 117
 118 sub install_callback {
 119   my $class = shift;
 120   my $callback = shift;
 121   push @callback, $callback;
 122   &{$callback} if $dbh;
 123 }
 124
 125 =item cgisuidsetup CGI_object
 126
 127 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
 128 object (CGI::Base is depriciated).  Runs cgisetotaker and then adminsuidsetup.
 129
 130 =cut
 131
 132 sub cgisuidsetup {
 133   $cgi=shift;
 134   if ( $cgi->isa('CGI::Base') ) {
 135     carp "Use of CGI::Base is depriciated";
 136   } elsif ( $cgi->isa('Apache') ) {
 137
 138   } elsif ( ! $cgi->isa('CGI') ) {
 139     croak "fatal: unrecognized object $cgi";
 140   }
 141   cgisetotaker;
 142   adminsuidsetup($user);
 143 }
 144
 145 =item cgi
 146
 147 Returns the CGI (see L<CGI>) object.
 148
 149 =cut
 150
 151 sub cgi {
 152   carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
 153   $cgi;
 154 }
 155
 156 =item dbh
 157
 158 Returns the DBI database handle.
 159
 160 =cut
 161
 162 sub dbh {
 163   $dbh;
 164 }
 165
 166 =item datasrc
 167
 168 Returns the DBI data source.
 169
 170 =cut
 171
 172 sub datasrc {
 173   $datasrc;
 174 }
 175
 176 =item driver_name
 177
 178 Returns just the driver name portion of the DBI data source.
 179
 180 =cut
 181
 182 sub driver_name {
 183   return $driver_name if defined $driver_name;
 184   $driver_name = ( split(':', $datasrc) )[1];
 185 }
 186
 187 sub suidsetup {
 188   croak "suidsetup depriciated";
 189 }
 190
 191 =item getotaker
 192
 193 Returns the current Freeside user.
 194
 195 =cut
 196
 197 sub getotaker {
 198   $user;
 199 }
 200
 201 =item cgisetotaker
 202
 203 Sets and returns the CGI REMOTE_USER.  $cgi should be defined as a CGI.pm
 204 object (see L<CGI>) or an Apache object (see L<Apache>).  Support for CGI::Base
 205 and derived classes is depriciated.
 206
 207 =cut
 208
 209 sub cgisetotaker {
 210   if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
 211     carp "Use of CGI::Base is depriciated";
 212     $user = lc ( $cgi->var('REMOTE_USER') );
 213   } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
 214     $user = lc ( $cgi->remote_user );
 215   } elsif ( $cgi && $cgi->isa('Apache') ) {
 216     $user = lc ( $cgi->connection->user );
 217   } else {
 218     die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
 219         "Apache user authentication as documented in httemplate/docs/install.html";
 220   }
 221   $user;
 222 }
 223
 224 =item checkeuid
 225
 226 Returns true if effective UID is that of the freeside user.
 227
 228 =cut
 229
 230 sub checkeuid {
 231   ( $> == $freeside_uid );
 232 }
 233
 234 =item checkruid
 235
 236 Returns true if the real UID is that of the freeside user.
 237
 238 =cut
 239
 240 sub checkruid {
 241   ( $< == $freeside_uid );
 242 }
 243
 244 =item getsecrets [ USER ]
 245
 246 Sets the user to USER, if supplied.
 247 Sets and returns the DBI datasource, username and password for this user from
 248 the `/usr/local/etc/freeside/mapsecrets' file.
 249
 250 =cut
 251
 252 sub getsecrets {
 253   my($setuser) = shift;
 254   $user = $setuser if $setuser;
 255   die "No user!" unless $user;
 256   my($conf) = new FS::Conf $conf_dir;
 257   my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
 258   die "User $user not found in mapsecrets!" unless $line;
 259   $line =~ /^\s*$user\s+(.*)$/;
 260   $secrets = $1;
 261   die "Illegal mapsecrets line for user?!" unless $secrets;
 262   ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
 263     or die "Can't get secrets: $!";
 264   $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
 265   undef $driver_name;
 266   ($datasrc, $db_user, $db_pass);
 267 }
 268
 269 =back
 270
 271 =head1 CALLBACKS
 272
 273 Warning: this interface is (still) likely to change in future releases.
 274
 275 New (experimental) callback interface:
 276
 277 A package can install a callback to be run in adminsuidsetup by passing
 278 a coderef to the FS::UID->install_callback class method.  If adminsuidsetup has
 279 run already, the callback will also be run immediately.
 280
 281     $coderef = sub { warn "Hi, I'm returning your call!" };
 282     FS::UID->install_callback($coderef);
 283
 284     install_callback FS::UID sub {
 285       warn "Hi, I'm returning your call!"
 286     };
 287
 288 Old (deprecated) callback interface:
 289
 290 A package can install a callback to be run in adminsuidsetup by putting a
 291 coderef into the hash %FS::UID::callback :
 292
 293     $coderef = sub { warn "Hi, I'm returning your call!" };
 294     $FS::UID::callback{'Package::Name'} = $coderef;
 295
 296 =head1 BUGS
 297
 298 Too many package-global variables.
 299
 300 Not OO.
 301
 302 No capabilities yet.  When mod_perl and Authen::DBI are implemented,
 303 cgisuidsetup will go away as well.
 304
 305 Goes through contortions to support non-OO syntax with multiple datasrc's.
 306
 307 Callbacks are (still) inelegant.
 308
 309 =head1 SEE ALSO
 310
 311 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
 312
 313 =cut
 314
 315 1;
 316