1*0Sstevel@tonic-gatepackage User::pwent; 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateuse 5.006; 4*0Sstevel@tonic-gateour $VERSION = '1.00'; 5*0Sstevel@tonic-gate 6*0Sstevel@tonic-gateuse strict; 7*0Sstevel@tonic-gateuse warnings; 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gateuse Config; 10*0Sstevel@tonic-gateuse Carp; 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gateour(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); 13*0Sstevel@tonic-gateBEGIN { 14*0Sstevel@tonic-gate use Exporter (); 15*0Sstevel@tonic-gate @EXPORT = qw(getpwent getpwuid getpwnam getpw); 16*0Sstevel@tonic-gate @EXPORT_OK = qw( 17*0Sstevel@tonic-gate pw_has 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gate $pw_name $pw_passwd $pw_uid $pw_gid 20*0Sstevel@tonic-gate $pw_gecos $pw_dir $pw_shell 21*0Sstevel@tonic-gate $pw_expire $pw_change $pw_class 22*0Sstevel@tonic-gate $pw_age 23*0Sstevel@tonic-gate $pw_quota $pw_comment 24*0Sstevel@tonic-gate $pw_expire 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gate ); 27*0Sstevel@tonic-gate %EXPORT_TAGS = ( 28*0Sstevel@tonic-gate FIELDS => [ grep(/^\$pw_/, @EXPORT_OK), @EXPORT ], 29*0Sstevel@tonic-gate ALL => [ @EXPORT, @EXPORT_OK ], 30*0Sstevel@tonic-gate ); 31*0Sstevel@tonic-gate} 32*0Sstevel@tonic-gateuse vars grep /^\$pw_/, @EXPORT_OK; 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate# 35*0Sstevel@tonic-gate# XXX: these mean somebody hacked this module's source 36*0Sstevel@tonic-gate# without understanding the underlying assumptions. 37*0Sstevel@tonic-gate# 38*0Sstevel@tonic-gatemy $IE = "[INTERNAL ERROR]"; 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gate# Class::Struct forbids use of @ISA 41*0Sstevel@tonic-gatesub import { goto &Exporter::import } 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gateuse Class::Struct qw(struct); 44*0Sstevel@tonic-gatestruct 'User::pwent' => [ 45*0Sstevel@tonic-gate name => '$', # pwent[0] 46*0Sstevel@tonic-gate passwd => '$', # pwent[1] 47*0Sstevel@tonic-gate uid => '$', # pwent[2] 48*0Sstevel@tonic-gate gid => '$', # pwent[3] 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate # you'll only have one/none of these three 51*0Sstevel@tonic-gate change => '$', # pwent[4] 52*0Sstevel@tonic-gate age => '$', # pwent[4] 53*0Sstevel@tonic-gate quota => '$', # pwent[4] 54*0Sstevel@tonic-gate 55*0Sstevel@tonic-gate # you'll only have one/none of these two 56*0Sstevel@tonic-gate comment => '$', # pwent[5] 57*0Sstevel@tonic-gate class => '$', # pwent[5] 58*0Sstevel@tonic-gate 59*0Sstevel@tonic-gate # you might not have this one 60*0Sstevel@tonic-gate gecos => '$', # pwent[6] 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gate dir => '$', # pwent[7] 63*0Sstevel@tonic-gate shell => '$', # pwent[8] 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gate # you might not have this one 66*0Sstevel@tonic-gate expire => '$', # pwent[9] 67*0Sstevel@tonic-gate 68*0Sstevel@tonic-gate]; 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gate# init our groks hash to be true if the built platform knew how 72*0Sstevel@tonic-gate# to do each struct pwd field that perl can ever under any circumstances 73*0Sstevel@tonic-gate# know about. we do not use /^pw_?/, but just the tails. 74*0Sstevel@tonic-gatesub _feature_init { 75*0Sstevel@tonic-gate our %Groks; # whether build system knew how to do this feature 76*0Sstevel@tonic-gate for my $feep ( qw{ 77*0Sstevel@tonic-gate pwage pwchange pwclass pwcomment 78*0Sstevel@tonic-gate pwexpire pwgecos pwpasswd pwquota 79*0Sstevel@tonic-gate } 80*0Sstevel@tonic-gate ) 81*0Sstevel@tonic-gate { 82*0Sstevel@tonic-gate my $short = $feep =~ /^pw(.*)/ 83*0Sstevel@tonic-gate ? $1 84*0Sstevel@tonic-gate : do { 85*0Sstevel@tonic-gate # not cluck, as we know we called ourselves, 86*0Sstevel@tonic-gate # and a confession is probably imminent anyway 87*0Sstevel@tonic-gate warn("$IE $feep is a funny struct pwd field"); 88*0Sstevel@tonic-gate $feep; 89*0Sstevel@tonic-gate }; 90*0Sstevel@tonic-gate 91*0Sstevel@tonic-gate exists $Config{ "d_" . $feep } 92*0Sstevel@tonic-gate || confess("$IE Configure doesn't d_$feep"); 93*0Sstevel@tonic-gate $Groks{$short} = defined $Config{ "d_" . $feep }; 94*0Sstevel@tonic-gate } 95*0Sstevel@tonic-gate # assume that any that are left are always there 96*0Sstevel@tonic-gate for my $feep (grep /^\$pw_/s, @EXPORT_OK) { 97*0Sstevel@tonic-gate $feep =~ /^\$pw_(.*)/; 98*0Sstevel@tonic-gate $Groks{$1} = 1 unless defined $Groks{$1}; 99*0Sstevel@tonic-gate } 100*0Sstevel@tonic-gate} 101*0Sstevel@tonic-gate 102*0Sstevel@tonic-gate# With arguments, reports whether one or more fields are all implemented 103*0Sstevel@tonic-gate# in the build machine's struct pwd pw_*. May be whitespace separated. 104*0Sstevel@tonic-gate# We do not use /^pw_?/, just the tails. 105*0Sstevel@tonic-gate# 106*0Sstevel@tonic-gate# Without arguments, returns the list of fields implemented on build 107*0Sstevel@tonic-gate# machine, space separated in scalar context. 108*0Sstevel@tonic-gate# 109*0Sstevel@tonic-gate# Takes exception to being asked whether this machine's struct pwd has 110*0Sstevel@tonic-gate# a field that Perl never knows how to provide under any circumstances. 111*0Sstevel@tonic-gate# If the module does this idiocy to itself, the explosion is noisier. 112*0Sstevel@tonic-gate# 113*0Sstevel@tonic-gatesub pw_has { 114*0Sstevel@tonic-gate our %Groks; # whether build system knew how to do this feature 115*0Sstevel@tonic-gate my $cando = 1; 116*0Sstevel@tonic-gate my $sploder = caller() ne __PACKAGE__ 117*0Sstevel@tonic-gate ? \&croak 118*0Sstevel@tonic-gate : sub { confess("$IE @_") }; 119*0Sstevel@tonic-gate if (@_ == 0) { 120*0Sstevel@tonic-gate my @valid = sort grep { $Groks{$_} } keys %Groks; 121*0Sstevel@tonic-gate return wantarray ? @valid : "@valid"; 122*0Sstevel@tonic-gate } 123*0Sstevel@tonic-gate for my $feep (map { split } @_) { 124*0Sstevel@tonic-gate defined $Groks{$feep} 125*0Sstevel@tonic-gate || $sploder->("$feep is never a valid struct pwd field"); 126*0Sstevel@tonic-gate $cando &&= $Groks{$feep}; 127*0Sstevel@tonic-gate } 128*0Sstevel@tonic-gate return $cando; 129*0Sstevel@tonic-gate} 130*0Sstevel@tonic-gate 131*0Sstevel@tonic-gatesub _populate (@) { 132*0Sstevel@tonic-gate return unless @_; 133*0Sstevel@tonic-gate my $pwob = new(); 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gate # Any that haven't been pw_had are assumed on "all" platforms of 136*0Sstevel@tonic-gate # course, this may not be so, but you can't get here otherwise, 137*0Sstevel@tonic-gate # since the underlying core call already took exception to your 138*0Sstevel@tonic-gate # impudence. 139*0Sstevel@tonic-gate 140*0Sstevel@tonic-gate $pw_name = $pwob->name ( $_[0] ); 141*0Sstevel@tonic-gate $pw_passwd = $pwob->passwd ( $_[1] ) if pw_has("passwd"); 142*0Sstevel@tonic-gate $pw_uid = $pwob->uid ( $_[2] ); 143*0Sstevel@tonic-gate $pw_gid = $pwob->gid ( $_[3] ); 144*0Sstevel@tonic-gate 145*0Sstevel@tonic-gate if (pw_has("change")) { 146*0Sstevel@tonic-gate $pw_change = $pwob->change ( $_[4] ); 147*0Sstevel@tonic-gate } 148*0Sstevel@tonic-gate elsif (pw_has("age")) { 149*0Sstevel@tonic-gate $pw_age = $pwob->age ( $_[4] ); 150*0Sstevel@tonic-gate } 151*0Sstevel@tonic-gate elsif (pw_has("quota")) { 152*0Sstevel@tonic-gate $pw_quota = $pwob->quota ( $_[4] ); 153*0Sstevel@tonic-gate } 154*0Sstevel@tonic-gate 155*0Sstevel@tonic-gate if (pw_has("class")) { 156*0Sstevel@tonic-gate $pw_class = $pwob->class ( $_[5] ); 157*0Sstevel@tonic-gate } 158*0Sstevel@tonic-gate elsif (pw_has("comment")) { 159*0Sstevel@tonic-gate $pw_comment = $pwob->comment( $_[5] ); 160*0Sstevel@tonic-gate } 161*0Sstevel@tonic-gate 162*0Sstevel@tonic-gate $pw_gecos = $pwob->gecos ( $_[6] ) if pw_has("gecos"); 163*0Sstevel@tonic-gate 164*0Sstevel@tonic-gate $pw_dir = $pwob->dir ( $_[7] ); 165*0Sstevel@tonic-gate $pw_shell = $pwob->shell ( $_[8] ); 166*0Sstevel@tonic-gate 167*0Sstevel@tonic-gate $pw_expire = $pwob->expire ( $_[9] ) if pw_has("expire"); 168*0Sstevel@tonic-gate 169*0Sstevel@tonic-gate return $pwob; 170*0Sstevel@tonic-gate} 171*0Sstevel@tonic-gate 172*0Sstevel@tonic-gatesub getpwent ( ) { _populate(CORE::getpwent()) } 173*0Sstevel@tonic-gatesub getpwnam ($) { _populate(CORE::getpwnam(shift)) } 174*0Sstevel@tonic-gatesub getpwuid ($) { _populate(CORE::getpwuid(shift)) } 175*0Sstevel@tonic-gatesub getpw ($) { ($_[0] =~ /^\d+\z/s) ? &getpwuid : &getpwnam } 176*0Sstevel@tonic-gate 177*0Sstevel@tonic-gate_feature_init(); 178*0Sstevel@tonic-gate 179*0Sstevel@tonic-gate1; 180*0Sstevel@tonic-gate__END__ 181*0Sstevel@tonic-gate 182*0Sstevel@tonic-gate=head1 NAME 183*0Sstevel@tonic-gate 184*0Sstevel@tonic-gateUser::pwent - by-name interface to Perl's built-in getpw*() functions 185*0Sstevel@tonic-gate 186*0Sstevel@tonic-gate=head1 SYNOPSIS 187*0Sstevel@tonic-gate 188*0Sstevel@tonic-gate use User::pwent; 189*0Sstevel@tonic-gate $pw = getpwnam('daemon') || die "No daemon user"; 190*0Sstevel@tonic-gate if ( $pw->uid == 1 && $pw->dir =~ m#^/(bin|tmp)?\z#s ) { 191*0Sstevel@tonic-gate print "gid 1 on root dir"; 192*0Sstevel@tonic-gate } 193*0Sstevel@tonic-gate 194*0Sstevel@tonic-gate $real_shell = $pw->shell || '/bin/sh'; 195*0Sstevel@tonic-gate 196*0Sstevel@tonic-gate for (($fullname, $office, $workphone, $homephone) = 197*0Sstevel@tonic-gate split /\s*,\s*/, $pw->gecos) 198*0Sstevel@tonic-gate { 199*0Sstevel@tonic-gate s/&/ucfirst(lc($pw->name))/ge; 200*0Sstevel@tonic-gate } 201*0Sstevel@tonic-gate 202*0Sstevel@tonic-gate use User::pwent qw(:FIELDS); 203*0Sstevel@tonic-gate getpwnam('daemon') || die "No daemon user"; 204*0Sstevel@tonic-gate if ( $pw_uid == 1 && $pw_dir =~ m#^/(bin|tmp)?\z#s ) { 205*0Sstevel@tonic-gate print "gid 1 on root dir"; 206*0Sstevel@tonic-gate } 207*0Sstevel@tonic-gate 208*0Sstevel@tonic-gate $pw = getpw($whoever); 209*0Sstevel@tonic-gate 210*0Sstevel@tonic-gate use User::pwent qw/:DEFAULT pw_has/; 211*0Sstevel@tonic-gate if (pw_has(qw[gecos expire quota])) { .... } 212*0Sstevel@tonic-gate if (pw_has("name uid gid passwd")) { .... } 213*0Sstevel@tonic-gate print "Your struct pwd has: ", scalar pw_has(), "\n"; 214*0Sstevel@tonic-gate 215*0Sstevel@tonic-gate=head1 DESCRIPTION 216*0Sstevel@tonic-gate 217*0Sstevel@tonic-gateThis module's default exports override the core getpwent(), getpwuid(), 218*0Sstevel@tonic-gateand getpwnam() functions, replacing them with versions that return 219*0Sstevel@tonic-gateC<User::pwent> objects. This object has methods that return the 220*0Sstevel@tonic-gatesimilarly named structure field name from the C's passwd structure 221*0Sstevel@tonic-gatefrom F<pwd.h>, stripped of their leading "pw_" parts, namely C<name>, 222*0Sstevel@tonic-gateC<passwd>, C<uid>, C<gid>, C<change>, C<age>, C<quota>, C<comment>, 223*0Sstevel@tonic-gateC<class>, C<gecos>, C<dir>, C<shell>, and C<expire>. The C<passwd>, 224*0Sstevel@tonic-gateC<gecos>, and C<shell> fields are tainted when running in taint mode. 225*0Sstevel@tonic-gate 226*0Sstevel@tonic-gateYou may also import all the structure fields directly into your 227*0Sstevel@tonic-gatenamespace as regular variables using the :FIELDS import tag. (Note 228*0Sstevel@tonic-gatethat this still overrides your core functions.) Access these fields 229*0Sstevel@tonic-gateas variables named with a preceding C<pw_> in front their method 230*0Sstevel@tonic-gatenames. Thus, C<< $passwd_obj->shell >> corresponds to $pw_shell 231*0Sstevel@tonic-gateif you import the fields. 232*0Sstevel@tonic-gate 233*0Sstevel@tonic-gateThe getpw() function is a simple front-end that forwards 234*0Sstevel@tonic-gatea numeric argument to getpwuid() and the rest to getpwnam(). 235*0Sstevel@tonic-gate 236*0Sstevel@tonic-gateTo access this functionality without the core overrides, pass the 237*0Sstevel@tonic-gateC<use> an empty import list, and then access function functions 238*0Sstevel@tonic-gatewith their full qualified names. The built-ins are always still 239*0Sstevel@tonic-gateavailable via the C<CORE::> pseudo-package. 240*0Sstevel@tonic-gate 241*0Sstevel@tonic-gate=head2 System Specifics 242*0Sstevel@tonic-gate 243*0Sstevel@tonic-gatePerl believes that no machine ever has more than one of C<change>, 244*0Sstevel@tonic-gateC<age>, or C<quota> implemented, nor more than one of either 245*0Sstevel@tonic-gateC<comment> or C<class>. Some machines do not support C<expire>, 246*0Sstevel@tonic-gateC<gecos>, or allegedly, C<passwd>. You may call these methods 247*0Sstevel@tonic-gateno matter what machine you're on, but they return C<undef> if 248*0Sstevel@tonic-gateunimplemented. 249*0Sstevel@tonic-gate 250*0Sstevel@tonic-gateYou may ask whether one of these was implemented on the system Perl 251*0Sstevel@tonic-gatewas built on by asking the importable C<pw_has> function about them. 252*0Sstevel@tonic-gateThis function returns true if all parameters are supported fields 253*0Sstevel@tonic-gateon the build platform, false if one or more were not, and raises 254*0Sstevel@tonic-gatean exception if you asked about a field that Perl never knows how 255*0Sstevel@tonic-gateto provide. Parameters may be in a space-separated string, or as 256*0Sstevel@tonic-gateseparate arguments. If you pass no parameters, the function returns 257*0Sstevel@tonic-gatethe list of C<struct pwd> fields supported by your build platform's 258*0Sstevel@tonic-gateC library, as a list in list context, or a space-separated string 259*0Sstevel@tonic-gatein scalar context. Note that just because your C library had 260*0Sstevel@tonic-gatea field doesn't necessarily mean that it's fully implemented on 261*0Sstevel@tonic-gatethat system. 262*0Sstevel@tonic-gate 263*0Sstevel@tonic-gateInterpretation of the C<gecos> field varies between systems, but 264*0Sstevel@tonic-gatetraditionally holds 4 comma-separated fields containing the user's 265*0Sstevel@tonic-gatefull name, office location, work phone number, and home phone number. 266*0Sstevel@tonic-gateAn C<&> in the gecos field should be replaced by the user's properly 267*0Sstevel@tonic-gatecapitalized login C<name>. The C<shell> field, if blank, must be 268*0Sstevel@tonic-gateassumed to be F</bin/sh>. Perl does not do this for you. The 269*0Sstevel@tonic-gateC<passwd> is one-way hashed garble, not clear text, and may not be 270*0Sstevel@tonic-gateunhashed save by brute-force guessing. Secure systems use more a 271*0Sstevel@tonic-gatemore secure hashing than DES. On systems supporting shadow password 272*0Sstevel@tonic-gatesystems, Perl automatically returns the shadow password entry when 273*0Sstevel@tonic-gatecalled by a suitably empowered user, even if your underlying 274*0Sstevel@tonic-gatevendor-provided C library was too short-sighted to realize it should 275*0Sstevel@tonic-gatedo this. 276*0Sstevel@tonic-gate 277*0Sstevel@tonic-gateSee passwd(5) and getpwent(3) for details. 278*0Sstevel@tonic-gate 279*0Sstevel@tonic-gate=head1 NOTE 280*0Sstevel@tonic-gate 281*0Sstevel@tonic-gateWhile this class is currently implemented using the Class::Struct 282*0Sstevel@tonic-gatemodule to build a struct-like class, you shouldn't rely upon this. 283*0Sstevel@tonic-gate 284*0Sstevel@tonic-gate=head1 AUTHOR 285*0Sstevel@tonic-gate 286*0Sstevel@tonic-gateTom Christiansen 287*0Sstevel@tonic-gate 288*0Sstevel@tonic-gate=head1 HISTORY 289*0Sstevel@tonic-gate 290*0Sstevel@tonic-gate=over 4 291*0Sstevel@tonic-gate 292*0Sstevel@tonic-gate=item March 18th, 2000 293*0Sstevel@tonic-gate 294*0Sstevel@tonic-gateReworked internals to support better interface to dodgey fields 295*0Sstevel@tonic-gatethan normal Perl function provides. Added pw_has() field. Improved 296*0Sstevel@tonic-gatedocumentation. 297*0Sstevel@tonic-gate 298*0Sstevel@tonic-gate=back 299