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
   7 );
   8 use subs qw(
   9   getsecrets cgisetotaker
  10 );
  11 use Exporter;
  12 use Carp;
  13 use DBI;
  14 use FS::Conf;
  15
  16 @ISA = qw(Exporter);
  17 @EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup
  18                 adminsuidsetup getotaker dbh datasrc getsecrets );
  19
  20 $freeside_uid = scalar(getpwnam('freeside'));
  21
  22 $conf_dir = "/usr/local/etc/freeside/";
  23
  24 =head1 NAME
  25
  26 FS::UID - Subroutines for database login and assorted other stuff
  27
  28 =head1 SYNOPSIS
  29
  30   use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
  31   checkeuid checkruid swapuid);
  32
  33   adminsuidsetup $user;
  34
  35   $cgi = new CGI;
  36   $dbh = cgisuidsetup($cgi);
  37
  38   $dbh = dbh;
  39
  40   $datasrc = datasrc;
  41
  42 =head1 DESCRIPTION
  43
  44 Provides a hodgepodge of subroutines.
  45
  46 =head1 SUBROUTINES
  47
  48 =over 4
  49
  50 =item adminsuidsetup USER
  51
  52 Sets the user to USER (see config.html from the base documentation).
  53 Cleans the environment.
  54 Make sure the script is running as freeside, or setuid freeside.
  55 Opens a connection to the database.
  56 Swaps real and effective UIDs.
  57 Runs any defined callbacks (see below).
  58 Returns the DBI database handle (usually you don't need this).
  59
  60 =cut
  61
  62 sub adminsuidsetup {
  63
  64   $user = shift;
  65   croak "fatal: adminsuidsetup called without arguements" unless $user;
  66
  67   $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
  68   $ENV{'SHELL'} = '/bin/sh';
  69   $ENV{'IFS'} = " \t\n";
  70   $ENV{'CDPATH'} = '';
  71   $ENV{'ENV'} = '';
  72   $ENV{'BASH_ENV'} = '';
  73
  74   croak "Not running uid freeside!" unless checkeuid();
  75   getsecrets;
  76   $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
  77                           'AutoCommit' => 'true',
  78                           'ChopBlanks' => 'true',
  79   } ) or die "DBI->connect error: $DBI::errstr\n";
  80
  81   swapuid(); #go to non-privledged user if running setuid freeside
  82
  83   foreach ( keys %callback ) {
  84     &{$callback{$_}};
  85   }
  86
  87   $dbh;
  88 }
  89
  90 =item cgisuidsetup CGI_object
  91
  92 Stores the CGI (see L<CGI>) object for later use. (CGI::Base is depriciated)
  93 Runs adminsuidsetup.
  94
  95 =cut
  96
  97 sub cgisuidsetup {
  98   $cgi=shift;
  99   if ( $cgi->isa('CGI::Base') ) {
 100     carp "Use of CGI::Base is depriciated";
 101   } elsif ( $cgi->isa('Apache') ) {
 102
 103   } elsif ( ! $cgi->isa('CGI') ) {
 104     croak "fatal: unrecognized object $cgi";
 105   }
 106   cgisetotaker;
 107   adminsuidsetup($user);
 108 }
 109
 110 =item cgi
 111
 112 Returns the CGI (see L<CGI>) object.
 113
 114 =cut
 115
 116 sub cgi {
 117   carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
 118   $cgi;
 119 }
 120
 121 =item dbh
 122
 123 Returns the DBI database handle.
 124
 125 =cut
 126
 127 sub dbh {
 128   $dbh;
 129 }
 130
 131 =item datasrc
 132
 133 Returns the DBI data source.
 134
 135 =cut
 136
 137 sub datasrc {
 138   $datasrc;
 139 }
 140
 141 #hack for web demo
 142 #sub setdbh {
 143 #  $dbh=$_[0];
 144 #}
 145
 146 sub suidsetup {
 147   croak "suidsetup depriciated";
 148 }
 149
 150 =item getotaker
 151
 152 Returns the current Freeside user.
 153
 154 =cut
 155
 156 sub getotaker {
 157   $user;
 158 }
 159
 160 =item cgisetotaker
 161
 162 Sets and returns the CGI REMOTE_USER.  $cgi should be defined as a CGI.pm
 163 object.  Support for CGI::Base and derived classes is depriciated.
 164
 165 =cut
 166
 167 sub cgisetotaker {
 168   if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
 169     carp "Use of CGI::Base is depriciated";
 170     $user = lc ( $cgi->var('REMOTE_USER') );
 171   } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
 172     $user = lc ( $cgi->remote_user );
 173   } elsif ( $cgi && $cgi->isa('Apache') ) {
 174     $user = lc ( $cgi->connection->user );
 175   } else {
 176     die "fatal: Can't get REMOTE_USER! for cgi $cgi";
 177   }
 178   $user;
 179 }
 180
 181 =item checkeuid
 182
 183 Returns true if effective UID is that of the freeside user.
 184
 185 =cut
 186
 187 sub checkeuid {
 188   ( $> == $freeside_uid );
 189 }
 190
 191 =item checkruid
 192
 193 Returns true if the real UID is that of the freeside user.
 194
 195 =cut
 196
 197 sub checkruid {
 198   ( $< == $freeside_uid );
 199 }
 200
 201 =item swapuid
 202
 203 Swaps real and effective UIDs.
 204
 205 =cut
 206
 207 sub swapuid {
 208   ($<,$>) = ($>,$<) if $< != $>;
 209 }
 210
 211 =item getsecrets [ USER ]
 212
 213 Sets the user to USER, if supplied.
 214 Sets and returns the DBI datasource, username and password for this user from
 215 the `/usr/local/etc/freeside/mapsecrets' file.
 216
 217 =cut
 218
 219 sub getsecrets {
 220   my($setuser) = shift;
 221   $user = $setuser if $setuser;
 222   die "No user!" unless $user;
 223   my($conf) = new FS::Conf $conf_dir;
 224   my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
 225   die "User not found in mapsecrets!" unless $line;
 226   $line =~ /^\s*$user\s+(.*)$/;
 227   $secrets = $1;
 228   die "Illegal mapsecrets line for user?!" unless $secrets;
 229   ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
 230     or die "Can't get secrets: $!";
 231   $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
 232   ($datasrc, $db_user, $db_pass);
 233 }
 234
 235 =back
 236
 237 =head1 CALLBACKS
 238
 239 Warning: this interface is likely to change in future releases.
 240
 241 A package can install a callback to be run in adminsuidsetup by putting a
 242 coderef into the hash %FS::UID::callback :
 243
 244     $coderef = sub { warn "Hi, I'm returning your call!" };
 245     $FS::UID::callback{'Package::Name'};
 246
 247 =head1 VERSION
 248
 249 $Id: UID.pm,v 1.2 2000-05-13 21:50:12 ivan Exp $
 250
 251 =head1 BUGS
 252
 253 Too many package-global variables.
 254
 255 Not OO.
 256
 257 No capabilities yet.  When mod_perl and Authen::DBI are implemented,
 258 cgisuidsetup will go away as well.
 259
 260 Goes through contortions to support non-OO syntax with multiple datasrc's.
 261
 262 Callbacks are inelegant.
 263
 264 =head1 SEE ALSO
 265
 266 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
 267
 268 =cut
 269
 270 1;
 271