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