site_perl/UID.pm

   1 package FS::UID;
   2
   3 use strict;
   4 use vars qw(
   5   @ISA @EXPORT_OK $cgi $dbh $freeside_uid $conf $datasrc $db_user $db_pass
   6 );
   7 use Exporter;
   8 use Carp;
   9 use DBI;
  10 use FS::Conf;
  11
  12 @ISA = qw(Exporter);
  13 @EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup
  14                 adminsuidsetup getotaker dbh datasrc);
  15
  16 $freeside_uid = scalar(getpwnam('freeside'));
  17
  18 my $conf = new FS::Conf;
  19 ($datasrc, $db_user, $db_pass) = $conf->config('secrets')
  20   or die "Can't get secrets: $!";
  21
  22 =head1 NAME
  23
  24 FS::UID - Subroutines for database login and assorted other stuff
  25
  26 =head1 SYNOPSIS
  27
  28   use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
  29   checkeuid checkruid swapuid);
  30
  31   adminsuidsetup;
  32
  33   $cgi = new CGI;
  34   $dbh = cgisuidsetup($cgi);
  35
  36   $dbh = dbh;
  37
  38   $datasrc = datasrc;
  39
  40 =head1 DESCRIPTION
  41
  42 Provides a hodgepodge of subroutines.
  43
  44 =head1 SUBROUTINES
  45
  46 =over 4
  47
  48 =item adminsuidsetup
  49
  50 Cleans the environment.
  51 Make sure the script is running as freeside, or setuid freeside.
  52 Opens a connection to the database.
  53 Swaps real and effective UIDs.
  54 Returns the DBI database handle (usually you don't need this).
  55
  56 =cut
  57
  58 sub adminsuidsetup {
  59
  60   $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
  61   $ENV{'SHELL'} = '/bin/sh';
  62   $ENV{'IFS'} = " \t\n";
  63   $ENV{'CDPATH'} = '';
  64   $ENV{'ENV'} = '';
  65   $ENV{'BASH_ENV'} = '';
  66
  67   croak "Not running uid freeside!" unless checkeuid();
  68   $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
  69         # hack for web demo
  70         #  my($user)=getotaker();
  71         #  $dbh = DBI->connect("$datasrc:$user",$db_user,$db_pass, {
  72                           'AutoCommit' => 'true',
  73                           'ChopBlanks' => 'true',
  74   } ) or die "DBI->connect error: $DBI::errstr\n";;
  75
  76   swapuid(); #go to non-privledged user if running setuid freeside
  77
  78   $dbh;
  79 }
  80
  81 =item cgisuidsetup CGI_object
  82
  83 Stores the CGI (see L<CGI>) object for later use. (CGI::Base is depriciated)
  84 Runs adminsuidsetup.
  85
  86 =cut
  87
  88 sub cgisuidsetup {
  89   $cgi=$_[0];
  90   if ( $cgi->isa('CGI::Base') ) {
  91     carp "Use of CGI::Base is depriciated";
  92   } elsif ( ! $cgi->isa('CGI') ) {
  93     croak "Pass a CGI object to cgisuidsetup!";
  94   }
  95   adminsuidsetup;
  96 }
  97
  98 =item cgi
  99
 100 Returns the CGI (see L<CGI>) object.
 101
 102 =cut
 103
 104 sub cgi {
 105   $cgi;
 106 }
 107
 108 =item dbh
 109
 110 Returns the DBI database handle.
 111
 112 =cut
 113
 114 sub dbh {
 115   $dbh;
 116 }
 117
 118 =item datasrc
 119
 120 Returns the DBI data source.
 121
 122 =cut
 123
 124 sub datasrc {
 125   $datasrc;
 126 }
 127
 128 #hack for web demo
 129 #sub setdbh {
 130 #  $dbh=$_[0];
 131 #}
 132
 133 sub suidsetup {
 134   croak "suidsetup depriciated";
 135 }
 136
 137 =item getotaker
 138
 139 Returns the current Freeside user.  Currently that means the CGI REMOTE_USER,
 140 or 'freeside'.
 141
 142 =cut
 143
 144 sub getotaker {
 145   if ( $cgi && $cgi->can('var') && defined $cgi->var('REMOTE_USER')) {
 146     carp "Use of CGI::Base is depriciated";
 147     return $cgi->var('REMOTE_USER'); #for now
 148   } elsif ( $cgi && $cgi->can('remote_user') && defined $cgi->remote_user ) {
 149     return $cgi->remote_user;
 150   } else {
 151     return 'freeside';
 152   }
 153 }
 154
 155 =item checkeuid
 156
 157 Returns true if effective UID is that of the freeside user.
 158
 159 =cut
 160
 161 sub checkeuid {
 162   ( $> == $freeside_uid );
 163 }
 164
 165 =item checkruid
 166
 167 Returns true if the real UID is that of the freeside user.
 168
 169 =cut
 170
 171 sub checkruid {
 172   ( $< == $freeside_uid );
 173 }
 174
 175 =item swapuid
 176
 177 Swaps real and effective UIDs.
 178
 179 =cut
 180
 181 sub swapuid {
 182   ($<,$>) = ($>,$<);
 183 }
 184
 185 =back
 186
 187 =head1 BUGS
 188
 189 Not OO.
 190
 191 No capabilities yet.  When mod_perl and Authen::DBI are implemented,
 192 cgisuidsetup will go away as well.
 193
 194 =head1 SEE ALSO
 195
 196 L<FS::Record>, L<CGI>, L<DBI>
 197
 198 =head1 HISTORY
 199
 200 ivan@voicenet.com 97-jun-4 - 9
 201
 202 untaint otaker ivan@voicenet.com 97-jul-7
 203
 204 generalize and auto-get uid (getotaker still needs to be db'ed)
 205 ivan@sisd.com 97-nov-10
 206
 207 &cgisuidsetup logs into database.  other cleaning.
 208 ivan@sisd.com 97-nov-22,23
 209
 210 &adminsuidsetup logs into database with otaker='freeside' (for
 211 automated tasks like billing)
 212 ivan@sisd.com 97-dec-13
 213
 214 added sub datasrc for fs-setup ivan@sisd.com 98-feb-21
 215
 216 datasrc, user and pass now come from conf/secrets ivan@sisd.com 98-jun-28
 217
 218 added ChopBlanks to DBI call (see man DBI) ivan@sisd.com 98-aug-16
 219
 220 pod, use FS::Conf, implemented cgisuidsetup as adminsuidsetup,
 221 inlined suidsetup
 222 ivan@sisd.com 98-sep-12
 223
 224 $Log: UID.pm,v $
 225 Revision 1.3  1998-11-08 10:45:42  ivan
 226 got sub cgi for FS::CGI
 227
 228 Revision 1.2  1998/11/08 09:38:43  ivan
 229 cgisuidsetup complains if you pass it a isa CGI::Base instead of an isa CGI
 230 (first step in migrating from CGI-modules to CGI.pm)
 231
 232
 233 =cut
 234
 235 1;
 236