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