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