How can I enter a password using Perl and replace the characters with '*'? - perl

I have a Perl script that requires the user to enter a password. How can I echo only '*' in place of the character that the user types, as they type it?
I'm using Windows XP/Vista.

In the past I have used IO::Prompt for this.
use IO::Prompt;
my $password = prompt('Password:', -e => '*');
print "$password\n";

If you don't want use any packages... Only for UNIX
system('stty','-echo');
chop($password=<STDIN>);
system('stty','echo');

You can play with Term::ReadKey. Here is a very simple example, with some detection for backspace and delete key. I've tested it on Mac OS X 10.5 but according to the ReadKey manual it should work under Windows. The manual indicates that under Windows using non-blocking reads (ReadKey(-1)) will fail. That's why I'm using ReadKey(0) who's basically getc (more on getc in the libc manual).
#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadKey;
my $key = 0;
my $password = "";
print "\nPlease input your password: ";
# Start reading the keys
ReadMode(4); #Disable the control keys
while(ord($key = ReadKey(0)) != 10)
# This will continue until the Enter key is pressed (decimal value of 10)
{
# For all value of ord($key) see http://www.asciitable.com/
if(ord($key) == 127 || ord($key) == 8) {
# DEL/Backspace was pressed
#1. Remove the last char from the password
chop($password);
#2 move the cursor back by one, print a blank character, move the cursor back by one
print "\b \b";
} elsif(ord($key) < 32) {
# Do nothing with these control characters
} else {
$password = $password.$key;
print "*(".ord($key).")";
}
}
ReadMode(0); #Reset the terminal once we are done
print "\n\nYour super secret password is: $password\n";

You should take a look at either Term::ReadKey or Win32::Console. You can use those modules to read the single key strokes and emit '*' or whathever.

Building on Pierr-Luc's program, just added some control on the backslashes. With this, you can't keep pressing backslash forever:
sub passwordDisplay() {
my $password = "";
# Start reading the keys
ReadMode(4); #Disable the control keys
my $count = 0;
while(ord($key = ReadKey(0)) != 10) {
# This will continue until the Enter key is pressed (decimal value of 10)
# For all value of ord($key) see http://www.asciitable.com/
if(ord($key) == 127 || ord($key) == 8) {
# DEL/Backspace was pressed
if ($count > 0) {
$count--;
#1. Remove the last char from the password
chop($password);
#2 move the cursor back by one, print a blank character, move the cursor back by one
print "\b \b";
}
}
elsif(ord($key) >= 32) {
$count++;
$password = $password.$key;
print "*";
}
}
ReadMode(0); #Reset the terminal once we are done
return $password;
}

using Pierr-Luc's program
# Start reading the keys
ReadMode(4); #Disable the control keys
while(ord($key = ReadKey(0)) != '13' )
# This will continue until the Enter key is pressed (decimal value of 10)
{
# For all value of ord($key) see http://www.asciitable.com/
if(ord($key) == 127 || ord($key) == 8 && (length($password) > 0)) {
# DEL/Backspace was pressed
#1. Remove the last char from the password
chop($password);
#2 move the cursor back by one, print a blank character, move the cursor back by one
print "\b \b";
} elsif(ord($key) > 32) {
$password = $password.$key;
print "*";
}
}
ReadMode(0); #Reset the terminal once we are done

Have you tried storing the string (so that your program can still read it) and find out its length then create a string of the same length, but only use '*'?

Related

How do I close the CMD when I enter a certain value in perl?

I am currently making a program that will eventually be able to auto start when I sign onto my computer and will allow me to select from a variety of programs to start. I currently have two (just started it). Anyway, I was wondering, because it is being run thru CMD, how can I have the program close CMD when I enter a certain value. My code:
print "What would you like to run? (1 for Chrome and 2 for Calculator \"e\" for exit) \n";
my $prog_run = <STDIN>;
if ($prog_run == 1){
#Chrome Function
system('"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"');
}elsif ($prog_run == 2){
#Calculator Function
system('"C:\Windows\System32\calc.exe"');
}elsif ($prog_run == "e"){
#Exit Fucntion
print "Exiting........";
}
}elsif ($prog_run == "e"){
== is the numeric comparison operator; it only works correctly on numbers. Since "e" is a string, you will need to use the string comparison operator, eq, to compare something with it:
} elsif ($prog_run eq "e") {
However, the line you read from standard input will have a newline on it by default. You can either include this in your string ("e\n"), or chomp $prog_run; beforehand to strip off the newline.
Anyways.
If you're in a loop, you can use last to exit out of it. Alternatively, you can use exit to make the whole Perl process… well, exit.

Perl brute force attack

I am having a lot of trouble trying to create a brute force script. The password I need to crack is 1 to 4 characters long and all lowercase letters. I think I have figured out the code to generate all the possible combinations but I am not sure how to test this on a file. Any guidance or hints would be great.
$password = "aaaa";
while ( length $password < 5 ) {
print "$password\n";
$password++;
I had this similar problem. Either you are in my class or scripting classes around the country do this problem at the same time. My professor encourages forum use but we can't share answers with direct classmates at our university.
If you know me from your class by my username, then I ask that you do not use my code. Otherwise enjoy. I have commented the code since learning from working code is the best way to learn.
As long as you are using only letters you can just increment a scalar instead of nesting loops. If you do need to use other characters I bet you could just use an array of possible characters and increment through that array for each position, though let's ignore that since you seem to only need those letters =)
sub brute2()
{
print "Bruteforce Attack...\n";
print "Enter password length: "; #Prompt user for maximum length for pass
chomp(my $plen = (<>)); #Receive input and remove newline character
print "Password Length is $plen\n";
$plen++;
print "Press any key to continue.\n"; #Execute once they hit any key
if (<>)
{
my $pass = "a"; #This code assumes only letters a..z, so we just set here
while ( length $pass < $plen ) #Run check loop until we exaust all possibilities within the maximum length
{
my $status = system("unzip -pp -o -P $pass secret_file_brute.zip > /dev/null 2>&1"); #System call to compare our password against a zip file, this will set status to the return value
print ("Attempting: $pass Return: $status\n");
if ($status == 0) #Return value of 0 means success
{
print ("Password is: $pass Return is: $status\n"); #Print correct password. I did return value also for debug
last; #Break loop since we got correct password
}
$pass++; #Increment $pass var to next iteration IE "a" to "b", "aa" to "ab", "zzz" to "aaaa" etc...
}
}
}
According to the man page I found, unzip returns exit code 82 when it can't decrypt.
sub try {
my ($password) = #_;
system("unzip -qq -o -P $password secret_file_brute.zip >/dev/null 2>&1");
die("Can't launch unzip: $!\n") if $? == -1;
die("unzip killed by signal ".($? & 0x7F)."\n") if $? & 0x7F;
my $exit_code = $? >> 8;
die("unzip exited with error $exit_code\n") if $exit_code && $exit_code != 82;
return !$exit_code;
}
Your code does not generate all of the possible passwords (e.g. it doesn't generate aaa). The following does:
sub brute_force {
for (my $password = 'a'; length($password)<5; ++$password) {
return $password if try($password);
}
return undef;
}
The final bit is to display the results.
{
my $password = brute_force();
defined($password)
or die("Password not found\n");
print("$password\n");
}

how to check an empty input and regulate the type of input in perl

Guys how do i check an empty input in perl? Including spaces,tabs,newlines etc..
here's my sample code but its not working: what am i doing wrong?
my $number=int (1+rand 100);
while (<>) {
chomp $_;
last if ($_=~/exit|quit/i or $_ eq $number);
print "too high! \n" if (defined $_ && $_ > $number);
print "too low!\n" if (defined $_ && $_ < $number);
print $_;
}
So basically, the user input something, if it's a number it compares to the default random number. It prints low or high depending on the number. But when i just press enter without entering something it still goes to that if statement and gives an error that what i entered isnt numeric (due to this code $_ < $number).
So another question is how to handle input to allow only the word "exit" or "quit" and numbers. Other than that it exits.
The while(<>){...} will loop as long as the return value of the <> is defined, i.e. you aren't at EOF. So $_ is always defined inside the loop.
To assert that some input is numeric, you can use looks_like_number from Scalar::Util or use a simple regex:
unless (/\A[0-9]+\z/) {
print "not numeric!\n";
next;
}
After that, we can treat the value of $_ as a number integer, and can be sure that use warnings won't complain. E.g.
# remove newline from input
chomp;
# Test for abort condition
last if /\b(?:quit|exit)\b/;
# Assert numeric input
unless (/\A[0-9]+\z/) {
print "not numeric!\n";
next;
}
# Check input against secret $number
if ($_ == $number) {
print "Correct!\n";
last;
} elsif ($_ < $number) {
print "too low\n";
} elsif ($_ > $number) {
print "too high\n";
}
Sorry for the silly question, Got the answer to my first question.
you just have to add this code to the first condition
$_=~/^\s*$/
which compares if the input is any whitespace
and for the second one to limit only the "exit" and "quit" as a valid non digit input add this one to the first regex comparison in the first condition
$_=~/(exit|quit|\D)/i
notice the \D which only matches non digit characters. But since its an "OR" it will short circuit once a specific non digit character (exit or quit) is entered, terminating the loop instantly.
Thanks guys

understanding a simple Perl construct

as a not Perl programmer, i would like to be sure i had well understood a construct that i am going to port to Python,
when using :
if (s/^([$PChar])(.)/$2/) {
print $1,"\n";
$finished = 0;
}
$1, $2 etc. are matching regular expression
s/search for/replace with/
what i am really not sure is does the matching/replacement is done before the print $1 ? and is it done "inplace" inside current buffer (which is $F, that is $_ line by line readed, splitted on its space character), that is changing it (so if i understand well, the ([$PChar]) when # beginning of a string is totally striped off/lost in the above statment) ?
EDIT : no maybe it is not lost, first parenthesis part is captured, and then printed as $1 + new line character and then... no, do not understand what become $2... may be buffer change to second parenthesis part ? /END OF EDIT.
also is there any environnement or what is the best environnement that permit to do some step-by-step debugging on Win platform ? i'm aware that having this, i will not have asked this question. And i do not need to learn Perl, just only to be able to read and adapt this script.
here is the englobing part :
#F = split;
for( $j=0; $j<=$#F; $j++) {
my $suffix="";
$_ = $F[$j];
# separate punctuation and parentheses from words
do {
$finished = 1;
# cut off preceding punctuation
if (s/^([$PChar])(.)/$2/) {
print $1,"\n";
$finished = 0;
}
# cut off trailing punctuation
if (s/(.)([$FChar])$/$1/) {
$suffix = "$2\n$suffix";
$finished = 0;
}
whole script tokenize.pl can be seen here while original tar.bz if from here
best regards
# try to delete the first character from the string contained in
# $_ if that character is one of the characters contained in
# the string $PChar. The deletion is done by replace the first and
# second character by only the second character.
if (s/^([$PChar])(.)/$2/) {
# if the replacement was successful, print the deleted character.
print $1,"\n";
$finished = 0;
}

Why is the return value of Perl's system not what I expect?

Let me begin by explaining what I'm trying to accomplish. Essentially there are two Perl scripts. One is what I call the Main script with an UI. The user who runs this script will see a list of other scripts he can call from the menu. This list is loaded through a custom config file. The purpose of the main script is to be able to add other scripts in the future as needed without changing the source and be run either as cron job (Non-Interactive mode) and as the user needs (Interactive Mode). As company policy, I am not entitle to post the entire script, so I will post the Interactive-Mode user selection section:
for($i = 0;$i < #{$conf}+1;$i++)
{
if($i % 2 == 1 || $i == 0)
{
next;
}
print $n++ . ". #{$conf}[$i-1]\n";
}
print "(health_check) ";
#
# User selection
#
my $in = <>;
chomp($in);
if($in =~ /[A-Za-z]/)
{
write_log("[*] Invalid Selection: $in");
print "\n<<<<<<<<<<<<>>>>>>>>>>>>>\n";
print ">>> Invalid Selection <<<\n";
print "<<<<<<<<<<<<>>>>>>>>>>>>>\n";
}
elsif($in == 0)
{
write_log("Exiting interactive mode");
last;
}
elsif(scalar($scripts[$in]))
{
write_log("[*] running: $scripts[$in]");
$rez = system('./' . "$scripts[$in]");
if($rez == 0b00)
{
printf("%s: [OK]\n",$scripts[$in]);
}
elsif($rez == 0b01)
{
printf("%s: [WARNING]\n",$scripts[$in]);
}
elsif($rez == 0b11)
{
printf("%s: [NOT OK]\n",$scripts[$in]);
}
else
{
print "UNKOWN ERROR CODE: $rez\n";
}
}
else
{
write_log("[*] Invalid Selection: $in");
print "\n<<<<<<<<<<<<>>>>>>>>>>>>>\n";
print ">>> Invalid Selection <<<\n";
print "<<<<<<<<<<<<>>>>>>>>>>>>>\n";
}
print "\n\nPress return/enter to continue...";
<>;
}
write_log("Exiting interactive mode");
}
#{$conf} is a reference to the list of available scripts. It has both the name of the scripts and the path to the script.
$i is used for looping.
$n is the script number which is used for the user to select which script to run.
$in is the user input in decimal value to select which script to run.
$scripts is the actual name of the script and not the path to the script.
$rez is the return code from the scripts.
Here is where it gets weird. I have a script that checks for filesystem usage. Once that is checked, it will exit with the appropriate value for the Main script to process.
0 is Ok
1 is Warning
2 is Alert
3 is Warning + Alert
Here is the relevant part of the filesystem check script:
if(check_hdd($warning_lvl, $alert_lvl))
{
$return_val = $return_val | 0b01;
}
if(check_hdd($alert_lvl))
{
$return_val = $return_val | 0b10;
}
exit $return_val;
The check_hdd subroutine will return 1 if anything is in between the range of the two arguments that is put in (e.g., it will return 1 if it detects anything between the range is filesystem usage in percentage with a default of 100% for the second argument).
So this is where it gets weird...
If for example, the hdd script returns 1. The main script will see 256.
So I went in the hdd script and forced it to return 256.
exit 256;
Main script saw: 0. So I did this with various values and built a small table.
HDD_Check Exit Value Main is seeing Exit Value as
1 256
256 0
257 256
258 512
259 768
Ahh. Intriguing. Lets convert that into Binary.
HDD_Check Exit Value (Base 2) Main is seeing Exit Value as (Base 2)
0b0000000001 0b0100000000
0b0100000000 0b0000000000
0b0100000001 0b0100000000
0b0100000010 0b1000000000
0b0100000011 0b1100000000
Weird. Looks like its doing the following while passing the value:
return_value = return_value << 8
So now that the long winded explanation is done, anyone have any idea? I've also tried this with die instead of exitand it does the same. And for some reason I have the impression it's something very obvious which I'm missing...
This is the defined behaviour.
http://perldoc.perl.org/functions/system.html
The return value is the exit status of
the program as returned by the wait
call. To get the actual exit value,
shift right by eight (see below).
Return value of -1 indicates a failure to start the program or an error of the wait(2) system call (inspect $! for the reason).