File Coverage

blib/lib/Unix/Login.pm
Criterion Covered Total %
statement 12 87 13.7
branch 0 42 0.0
condition 0 18 0.0
subroutine 4 8 50.0
pod 2 3 66.6
total 18 158 11.3


line stmt bran cond sub pod time code
1              
2             # $Id: Login.pm,v 1.8 2003/08/29 22:42:59 nwiger Exp $
3             ####################################################################
4             #
5             # Copyright (c) 2000-2003 Nathan Wiger
6             #
7             # This is designed to simulate a command-line login on UNIX machines.
8             # In an array context it returns the std getpwnam array or undef,
9             # and in a scalar context it returns just the username or undef if
10             # the login fails.
11             #
12             ####################################################################
13              
14             # Basic module setup
15             package Unix::Login;
16              
17 1     1   15992 use strict;
  1         2  
  1         39  
18 1     1   4 use vars qw(@ISA @EXPORT $VERSION %CONF);
  1         3  
  1         67  
19              
20 1     1   4 use Exporter;
  1         5  
  1         106  
21             @ISA = qw(Exporter);
22             @EXPORT = qw(login);
23              
24             # Straight from CPAN
25             $VERSION = do { my @r=(q$Revision: 1.8 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
26              
27             # Errors
28 1     1   5 use Carp;
  1         2  
  1         1056  
29              
30             # On interrupt, reset term and exit failure
31 0     0 0   sub sttyexit () { system 'stty echo'; exit 1 }
  0            
32             $SIG{INT} = \&sttyexit;
33             $SIG{TERM} = \&sttyexit;
34             $SIG{QUIT} = \&sttyexit;
35              
36             # Configuration - these are all the default values
37             %CONF = (
38              
39             # Max login attempts
40             attempts => 3,
41            
42             # What todo on failure
43             failmesg => "Login incorrect\n",
44             failsleep => 3,
45             failexit => 1,
46              
47             # Misc default strings
48             banner => "Please Login\n",
49             bannerfile => '',
50             login => "login: ",
51             password => "Password: ",
52              
53             # Take the username from the process?
54             sameuser => 0,
55              
56             # Do we allow them to login with no password??
57             passreq => 1,
58              
59             # If can't find homedir
60             nohomemesg => "No home directory! Setting HOME=/\n",
61              
62             # Where to take input from
63             input => \*STDIN,
64             output => \*STDOUT,
65              
66             # Set ENV variables?
67             setenv => 1,
68             clearenv => 0,
69             path => '/usr/bin:',
70             supath => '/usr/sbin:/usr/bin',
71             maildir => '/var/mail',
72              
73             # Use TomC's User::pwent module?
74             pwent => 0,
75            
76             # Exec the person's shell?
77             cdhome => 0,
78             execshell => 0
79              
80             );
81              
82             #------------------------------------------------
83             # "Constructor" function to handle defaults
84             #------------------------------------------------
85              
86             #######
87             # Usage: $ul = Unix::Login->new(banner => "Welcome to Bob's");
88             #
89             # This constructs a new Unix::Login object (optional, silly)
90             #######
91              
92             sub new {
93             # Easy mostly-std new()
94 0     0 1   my $self = shift;
95 0   0       my $class = ref($self) || $self;
96              
97             # override presets with remaining stuff in @_
98 0           my %conf = (%CONF, @_);
99 0           return bless \%conf, $class;
100             }
101              
102             #------------------------------------------------
103             # Private Functions
104             #------------------------------------------------
105              
106             #######
107             # Usage: my($self, @args) = _self_or_default(@_);
108             #
109             # Modified object checker from CGI.pm, no object for speed
110             #######
111              
112             sub _self_or_default {
113 0     0     local $^W = 0;
114 0 0         return @_ if ref $_[0] eq 'Unix::Login';
115 0           unshift @_, \%CONF; # just need hash anyways
116 0           return @_;
117             }
118              
119             #------------------------------------------------
120             # Public functions - all are exportable
121             #------------------------------------------------
122              
123             #######
124             # Usage: $ul->login or login();
125             #
126             # This is designed to simulate a command-line long on UNIX machines.
127             # In an array context it returns the std getpwnam array or undef,
128             # and in a scalar contact it returns just the username or undef if
129             # the login fails.
130             #
131             # The args are optional; if no args are given, then the default
132             # banner is the basename of the script (`basename $0`), the
133             # default login prompt is "login: ", the default password string
134             # is "Password: ", and the default fail string is "Login incorrect".
135             #######
136              
137             sub login {
138              
139 0     0 1   my($self, @attr) = _self_or_default(@_);
140 0           my %conf = (%{$self}, @attr);
  0            
141              
142 0           my($logintry, $passwdtry, @pwstruct);
143              
144             # Read our input/output
145 0           *INPUT = $conf{input};
146 0           *OUTPUT = $conf{output};
147              
148             # Print out banner once
149 0 0         print OUTPUT "\n", $conf{banner}, "\n" if $conf{banner};
150              
151             # Read our banner file; we print this each iteration
152 0           my $banner = '';
153 0 0         if ($conf{bannerfile}) {
154 0 0         if (open(BFILE, "<" . $conf{bannerfile})) {
155 0           $banner = join '', ;
156 0           close BFILE;
157             }
158             }
159              
160             # While loop
161 0           my $success = 0;
162 0           for (my $i=0; $i < $conf{attempts}; $i++) {
163              
164 0           print OUTPUT $banner; # /etc/issue
165              
166 0 0         if ($conf{sameuser}) {
167 0   0       $logintry = getpwuid($<)
168             || croak "Unidentifiable user running process";
169             } else {
170 0           do {
171 0           print OUTPUT $conf{login};
172 0           $logintry = ;
173 0 0         unless ($logintry) { # catch ^D
174 0 0         sttyexit if $conf{failexit};
175 0           return;
176             }
177 0           $logintry =~ s/\s+//g; # catch " "
178             } while (! $logintry);
179             }
180              
181             # Look it up by name - explicitly say "CORE::"
182             # since we may be using User::pwent...
183 0           @pwstruct = CORE::getpwnam($logintry);
184              
185             # Lose the echo during password entry
186 0           system 'stty -echo';
187 0           print OUTPUT $conf{password};
188 0           chomp($passwdtry = );
189 0           print OUTPUT "\n";
190 0           system 'stty echo';
191              
192             # Require a passwd from the passwd file?
193 0 0 0       if ($pwstruct[0] && ! $pwstruct[1] && $conf{passreq}) {
      0        
194 0 0         sttyexit if $conf{failexit};
195 0           return;
196             }
197            
198             # Check to make sure we have both a valid username and passwd
199 0 0 0       if ($pwstruct[0] && crypt($passwdtry, $pwstruct[1]) eq $pwstruct[1]) {
200 0           $success++;
201 0           last;
202             }
203              
204             # Fake a UNIX login prompt wait
205 0           sleep $conf{failsleep};
206 0           print OUTPUT $conf{failmesg};
207             }
208              
209 0 0         unless ($success) {
210 0 0         sttyexit if $conf{failexit};
211 0           return;
212             }
213            
214             # Do a few basic things
215 0 0         if ($conf{setenv}) {
216 0 0         undef %ENV if $conf{clearenv}; # clean slate
217 0           $ENV{LOGNAME} = $pwstruct[0];
218 0 0         $ENV{PATH} = ($pwstruct[2] == 0) ? $conf{supath} : $conf{path};
219 0           $ENV{HOME} = $pwstruct[7];
220 0           $ENV{SHELL} = $pwstruct[8];
221 0           $ENV{MAIL} = $conf{maildir} . '/' . $pwstruct[0];
222             }
223              
224             # Fork a shell if, for some strange reason, we are asked to.
225             # We use the little-known indirect object form of exec()
226             # to set $0 to -sh so we get a login shell.
227 0 0         if ($conf{execshell}) {
228 0 0         if ($> == 0) {
229 0           $< = $> = $pwstruct[2];
230 0           $( = $) = $pwstruct[3];
231             } else {
232 0           carp "Warning: Cannot setuid/setgid unless running as root";
233             }
234 0           (my $shell = $pwstruct[8]) =~ s!^.*/!!; # basename
235 0           exec { $pwstruct[8] } "-$shell";
  0            
236             }
237              
238 0 0         if ($conf{cdhome}) {
239             # Like real login, try to chdir to homedir
240 0 0 0       unless (-d $pwstruct[7] && chdir $pwstruct[7]) {
241 0           print OUTPUT $conf{nohomemesg};
242 0           $ENV{HOME} = '/';
243             }
244             }
245              
246             # Return appropriate info
247 0 0         if (wantarray) {
    0          
248 0           return @pwstruct;
249             } elsif ($conf{pwent}) {
250 0           require User::pwent;
251 0           return User::pwent::getpwnam($pwstruct[0]);
252             } else {
253 0           return $pwstruct[0];
254             }
255             }
256              
257             1;
258              
259             #
260             # Documentation starts down here
261             #
262             __END__