1package Term::ReadPassword; 2 3use strict; 4use Term::ReadLine; 5use POSIX qw(:termios_h); 6my %CC_FIELDS = ( 7 VEOF => VEOF, 8 VEOL => VEOL, 9 VERASE => VERASE, 10 VINTR => VINTR, 11 VKILL => VKILL, 12 VQUIT => VQUIT, 13 VSUSP => VSUSP, 14 VSTART => VSTART, 15 VSTOP => VSTOP, 16 VMIN => VMIN, 17 VTIME => VTIME, 18 ); 19 20use vars qw( 21 $VERSION @ISA @EXPORT @EXPORT_OK 22 $ALLOW_STDIN %SPECIAL $SUPPRESS_NEWLINE $INPUT_LIMIT 23 $USE_STARS $STAR_STRING $UNSTAR_STRING 24); 25 26require Exporter; 27 28@ISA = qw(Exporter); 29@EXPORT = qw( 30 read_password 31); 32$VERSION = '0.11'; 33 34# The special characters in the input stream 35%SPECIAL = ( 36 "\x03" => 'INT', # Control-C, Interrupt 37 "\x15" => 'NAK', # Control-U, NAK (clear buffer) 38 "\x08" => 'DEL', # Backspace 39 "\x7f" => 'DEL', # Delete 40 "\x0d" => 'ENT', # CR, Enter 41 "\x0a" => 'ENT', # LF, Enter 42); 43 44# The maximum amount of data for the input buffer to hold 45$INPUT_LIMIT = 1000; 46 47sub read_password { 48 my($prompt, $idle_limit, $interruptable) = @_; 49 $prompt = '' unless defined $prompt; 50 $idle_limit = 0 unless defined $idle_limit; 51 $interruptable = 0 unless defined $interruptable; 52 53 # Let's open the TTY (rather than STDIN) if we can 54 local(*TTY, *TTYOUT); 55 my($in, $out) = Term::ReadLine->findConsole; 56 die "No console available" unless $in; 57 if (open TTY, "+<$in") { 58 # Cool 59 } elsif ($ALLOW_STDIN) { 60 open TTY, "<&STDIN" 61 or die "Can't re-open STDIN: $!"; 62 } else { 63 die "Can't open '$in' read/write: $!"; 64 } 65 66 # And let's send the output to the TTY as well 67 if (open TTYOUT, ">>$out") { 68 # Cool 69 } elsif ($ALLOW_STDIN) { 70 # Well, let's allow STDOUT as well 71 open TTYOUT, ">>&STDOUT" 72 or die "Can't re-open STDOUT: $!"; 73 } else { 74 die "Can't open '$out' for output: $!"; 75 } 76 77 # Don't buffer it! 78 select( (select(TTYOUT), $|=1)[0] ); 79 print TTYOUT $prompt; 80 81 # Okay, now remember where everything was, so we can put it back when 82 # we're done 83 my $fd_tty = fileno(TTY); 84 my $term = POSIX::Termios->new(); 85 $term->getattr($fd_tty); 86 my $original_flags = $term->getlflag(); 87 my %original_cc; 88 for my $field_name (keys %CC_FIELDS) { 89 $original_cc{$field_name} = $term->getcc($CC_FIELDS{$field_name}); 90 } 91 92 # What makes this setup different from the ordinary? 93 # No keyboard-generated signals, no echoing, no canonical input 94 # processing (like backspace handling) 95 my $flags = $original_flags & ~(ISIG | ECHO | ICANON); 96 $term->setlflag($flags); 97 if ($idle_limit) { 98 # $idle_limit is in seconds, so multiply by ten 99 $term->setcc(VTIME, 10 * $idle_limit); 100 # Continue running the program after that time, even if there 101 # weren't any characters typed 102 $term->setcc(VMIN, 0); 103 } else { 104 # No time limit, but... 105 $term->setcc(VTIME, 0); 106 # Continue as soon as one character has been struck 107 $term->setcc(VMIN, 1); 108 } 109 110 # Optionally echo stars in place of password characters. The 111 # $unstar_string uses backspace characters. 112 my $star_string = $USE_STARS ? ($STAR_STRING || '*') : ''; 113 my $unstar_string = $USE_STARS ? ($UNSTAR_STRING || "\b*\b \b") : ''; 114 115 # If there's anything already buffered, we should throw it out. This 116 # is to discourage users from typing their password before they see 117 # the prompt, since their keystrokes may be echoing on the screen. 118 # 119 # So this statement supposedly makes sure the prompt goes out, the 120 # unread input buffer is discarded, and _then_ the changes take 121 # effect. Thus, everything they typed ahead is (probably) echoed. 122 $term->setattr($fd_tty, TCSAFLUSH); 123 124 my $input = ''; 125 my $return_value; 126KEYSTROKE: 127 while (1) { 128 my $new_keys = ''; 129 my $count = sysread(TTY, $new_keys, 99); 130 # We're here, so either the idle_limit expired, or the user typed 131 # something. 132 if ($count) { 133 for my $new_key (split //, $new_keys) { 134 if (my $meaning = $SPECIAL{$new_key}) { 135 if ($meaning eq 'ENT') { 136 # Enter/return key 137 # Return what we have so far 138 $return_value = $input; 139 last KEYSTROKE; 140 } elsif ($meaning eq 'DEL') { 141 # Delete/backspace key 142 # Take back one char, if possible 143 if (length $input) { 144 $input = substr $input, 0, length($input)-1; 145 print TTYOUT $unstar_string; 146 } 147 } elsif ($meaning eq 'NAK') { 148 # Control-U (NAK) 149 # Clear what we have read so far 150 for (1..length $input) { 151 print TTYOUT $unstar_string; 152 } 153 $input = ''; 154 } elsif ($interruptable and $meaning eq 'INT') { 155 # Breaking out of the program 156 # Return early 157 last KEYSTROKE; 158 } else { 159 # Just an ordinary keystroke 160 $input .= $new_key; 161 print TTYOUT $star_string; 162 } 163 } else { 164 # Not special 165 $input .= $new_key; 166 print TTYOUT $star_string; 167 } 168 } 169 # Just in case someone sends a lot of data 170 $input = substr($input, 0, $INPUT_LIMIT) 171 if length($input) > $INPUT_LIMIT; 172 } else { 173 # No count, so something went wrong. Assume timeout. 174 # Return early 175 last KEYSTROKE; 176 } 177 } 178 179 # Done with waiting for input. Let's not leave the cursor sitting 180 # there, after the prompt. 181 print TTYOUT "\n" unless $SUPPRESS_NEWLINE; 182 183 # Let's put everything back where we found it. 184 $term->setlflag($original_flags); 185 while (my($field, $value) = each %original_cc) { 186 $term->setcc($CC_FIELDS{$field}, $value); 187 } 188 $term->setattr($fd_tty, TCSAFLUSH); 189 close(TTY); 190 close(TTYOUT); 191 $return_value; 192} 193 1941; 195__END__ 196 197=head1 NAME 198 199Term::ReadPassword - Asking the user for a password 200 201=head1 SYNOPSIS 202 203 use Term::ReadPassword; 204 while (1) { 205 my $password = read_password('password: '); 206 redo unless defined $password; 207 if ($password eq 'flubber') { 208 print "Access granted.\n"; 209 last; 210 } else { 211 print "Access denied.\n"; 212 redo; 213 } 214 } 215 216=head1 DESCRIPTION 217 218This module lets you ask the user for a password in the traditional way, 219from the keyboard, without echoing. 220 221This is not intended for use over the web; user authentication over the 222web is another matter entirely. Also, this module should generally be used 223in conjunction with Perl's B<crypt()> function, sold separately. 224 225The B<read_password> function prompts for input, reads a line of text from 226the keyboard, then returns that line to the caller. The line of text 227doesn't include the newline character, so there's no need to use B<chomp>. 228 229While the user is entering the text, a few special characters are processed. 230The character delete (or the character backspace) will back up one 231character, removing the last character in the input buffer (if any). The 232character CR (or the character LF) will signal the end of input, causing the 233accumulated input buffer to be returned. Control-U will empty the input 234buffer. And, optionally, the character Control-C may be used to terminate 235the input operation. (See details below.) All other characters, even ones 236which would normally have special purposes, will be added to the input 237buffer. 238 239It is not recommended, though, that you use the as-yet-unspecified control 240characters in your passwords, as those characters may become meaningful in 241a future version of this module. Applications which allow the user to set 242their own passwords may wish to enforce this rule, perhaps with code 243something like this: 244 245 { 246 # Naked block for scoping and redo 247 my $new_pw = read_password("Enter your new password: "); 248 if ($new_pw =~ /([^\x20-\x7E])/) { 249 my $bad = unpack "H*", $1; 250 print "Your password may not contain the "; 251 print "character with hex code $bad.\n"; 252 redo; 253 } elsif (length($new_pw) < 5) { 254 print "Your password must be longer than that!\n"; 255 redo; 256 } elsif ($new_pw ne read_password("Enter it again: ")) { 257 print "Passwords don't match.\n"; 258 redo; 259 } else { 260 &change_password($new_pw); 261 print "Your password is now changed.\n"; 262 } 263 } 264 265The second parameter to B<read_password> is the optional C<idle_timeout> 266value. If it is a non-zero number and there is no keyboard input for that 267many seconds, the input operation will terminate. Notice that this is not 268an overall time limit, as the timer is restarted with each new character. 269 270The third parameter will optionally allow the input operation to be 271terminated by the user with Control-C. If this is not supplied, or is 272false, a typed Control-C will be entered into the input buffer just as any 273other character. In that case, there is no way from the keyboard to 274terminate the program while it is waiting for input. (That is to say, the 275normal ability to generate signals from the keyboard is suspended during 276the call to B<read_password>.) 277 278If the input operation terminates early (either because the idle_timeout 279was exceeded, or because a Control-C was enabled and typed), the return 280value will be C<undef>. In either case, there is no way provided to 281discover what (if anything) was typed before the early termination, or why 282the input operation was terminated. 283 284So as to discourage users from typing their passwords anywhere except at 285the prompt, any input which has been "typed ahead" before the prompt 286appears will be discarded. And whether the input operation terminates 287normally or not, a newline character will be printed, so that the cursor 288will not remain on the line after the prompt. 289 290=head1 BUGS 291 292Windows users will want Term::ReadPassword::Win32. 293 294This module has a poorly-designed interface, and should be thoroughly 295rethought and probably re-united with the Windows version. 296 297Users who wish to see password characters echoed as stars may set 298$Term::ReadPassword::USE_STARS to a true value. The bugs are that some 299terminals may not erase stars when the user corrects an error, and that 300using stars leaks information to shoulder-surfers. 301 302=head1 SECURITY 303 304You would think that a module dealing with passwords would be full of 305security features. You'd think that, but you'd be wrong. For example, perl 306provides no way to erase a piece of data from memory. (It's easy to erase 307it so that it can't be accessed from perl, but that's not the same thing 308as expunging it from the actual memory.) If you've entered a password, 309even if the variable that contained that password has been erased, it may 310be possible for someone to find that password, in plaintext, in a core 311dump. And that's just one potential security hole. 312 313In short, if serious security is an issue, don't use this module. 314 315=head1 LICENSE 316 317This program is free software; you may redistribute it, modify it, or 318both, under the same terms as Perl itself. 319 320=head1 AUTHOR 321 322Tom Phoenix <rootbeer@redcat.com>. Copyright (C) 2007 Tom Phoenix. 323 324=head1 SEE ALSO 325 326Term::ReadLine, L<perlfunc/crypt>, and your system's manpages for the 327low-level I/O operations used here. 328 329=cut 330