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