Hora izkam da naprava v saita mi s pomoshta na php script da
naprava Login i password na 50 usera moje li i ako moje pls
kajete kak mnggogo vi se molq eto php scripta koito namerih
v neta kajete kak da go naprava ... 4e da baca . MOLQVI SE
MNGOGOGOG !]
Tova e purvq files access.cgi ima i README
#!/usr/bin/perl
#
#
#######################################################
# Access Denied version 1.2
#
# Created by: Solution Scripts
# Email: solutions@solutionscripts.com
# Web: http://solutionscripts.com
#
#######################################################
#
#
# COPYRIGHT NOTICE:
#
# Copyright 2000 Solution Scripts All Rights Reserved.
#
# This program is being distributed as freeware. It may be
used and
# modified free of charge, so long as this copyright notice,
the header
# above and all the footers in the program that give me
credit remain
# intact. Please also send me an email, and let me know
# where you are using this script.
#
# By using this program you agree to indemnify Solution
Scripts from any liability.
#
# Selling the code for this program without prior written
consent is
# expressly forbidden. Obtain permission before
redistributing this
# program over the Internet or in any other medium. In all
cases
# copyright and header must remain intact.
#
######################################################
#
#
# PLEASE READ THE README INCLUDED IN THIS ZIP OR
# VISIT http://faq.solutionscripts.com/docs/accessdenied
# BEFORE ATTEMPTING TO INSTALL ACCESS-DENIED
$protect{'Test 1'} =
"/home/httpd/cgi-bin/demos/access_denied/.htpasswd";
$protect{'A Test 3'} =
"/home/httpd/cgi-bin/demos/access_denied/.htpasswd3";
$protect{'Test 2'} =
"/home/httpd/cgi-bin/demos/access_denied/.htpasswd1";
# Full path to password file ....... including file name
$password_location = "password.txt";
# THATS ALL FOLKS..................
########################################################
$thisurl = $ENV{'SCRIPT_NAME'};
$use_password = 0;
$VERSION = "1.2";
@char_set = ('a'..'z','0'..'9');
## CREATE SELECT LIST ##
foreach $key (sort_hashs(\%protect)) {
$select .= "<option value=\"$key\">$key";
}
### FORM DATA ###
if ($ENV{'QUERY_STRING'}) {
@pairs=split(/&/,$ENV{'QUERY_STRING'});
$ftype = "GET";
}
if ($ENV{'CONTENT_LENGTH'}) {
read(STDIN, my $buffer, $ENV{'CONTENT_LENGTH'});
push(@pairs,split(/&/, $buffer));
$ftype = "POST";
}
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",
hex($1))/eg;
if ($INPUT{$name}) { $INPUT{$name} =
$INPUT{$name}.",".$value; }
else { $INPUT{$name} = $value; }
}
@passset = ('a'..'z');
for ($i = 0; $i < 2; $i++) {
$randum_num = int(rand($#passset + 1));
$salt .= @passset[$randum_num];
}
print "Content-type: text/html \n\n";
&Top;
open (PASSWORD, "$password_location");
$password = <PASSWORD>;
close (PASSWORD);
chop ($password);
### SET NEW PASSWORD
&newpass if $INPUT{'newpass'};
### SET NEW PASSWORD ###
unless ($password || $use_password) {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC" width=500>
<TR><TD><TABLE cellpadding=5 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
Before you can do anything else, you'll need to set your
administrative password.
This will allow you to use the administrative functions.
<HR noshade size=1 width=85%>
Please enter your desired password below. (Enter it twice.)
<FORM METHOD=POST ACTION="$thisurl">
<INPUT TYPE=HIDDEN NAME="newpass" value="hit return">
<INPUT TYPE=SUBMIT NAME=newpass VALUE="Set Admin Password:">
<INPUT TYPE=PASSWORD NAME=passad SIZE=10>
<INPUT TYPE=PASSWORD NAME=passad2 SIZE=10>
</FORM>
</TD></TR></TABLE>
</TD></TR></TABLE>
<BR><BR>
~;
&Bottom(0);
exit;
}
### PROMPT FOR PASSWORD ###
unless ($INPUT{'password'} || $use_password) {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC" width=500>
<TR><TD><TABLE cellpadding=5 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
Welcome, please enter your password
<HR noshade size=1 width=85%>
<FORM METHOD=POST ACTION="$thisurl">
<INPUT TYPE=HIDDEN NAME="admin" value="hit return">
<INPUT TYPE=PASSWORD NAME=password SIZE=10>
<INPUT TYPE=SUBMIT NAME=admin VALUE=" Proceed ">
</FORM>
</TD></TR></TABLE>
</TD></TR></TABLE>
<BR><BR>
~;
&Bottom(0);
exit;
}
&checkpassword unless $use_password;
if ($INPUT{'add'}) { &add; }
elsif ($INPUT{'remove'}) { &remove; }
elsif ($INPUT{'delete_select'}) { &delete_select; }
elsif ($INPUT{'delete_final'}) { &delete_final; }
else { &admin; }
sub admin {
### PRINT MAIN ADMIN SCREEN ###
print qq~
<form action="$thisurl" method=post>
<INPUT TYPE="HIDDEN" NAME="password"
value="$INPUT{'password'}">
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#000000">
<TR><TD><TABLE cellpadding=4 cellspacing=1 border=0
width="100%">
<TR bgcolor="#CCCCCC"><TD colspan=3 align=center><B>Add or
remove logins</B></TD></TR>
<TR bgcolor="#FFFFFF">
<TD>Login:</TD>
<TD><input type=text name="login" size=25></TD>
</TR>
<TR bgcolor="#FFFFFF">
<TD>Password:</TD>
<TD><input type=text name="pass" size=25></TD>
</TR>
<TR bgcolor="#FFFFFF">
<TD>Retype:</TD>
<TD><input type=text name="pass2" size=25></TD>
</TR>
<TR BGCOLOR="#FFFFFF">
<TD>Select Dir:</TD>
<TD><SELECT NAME="dir">$select</SELECT></TD>
</TR>
<TR BGCOLOR="#FFFFFF">
<TD>Use rules:</TD>
<TD><input type="Checkbox" name="rules" value="on" checked>
Yes</TD>
</TR>
<TR BGCOLOR="#FFFFFF">
<TD colspan=2 align=center><INPUT TYPE="SUBMIT" NAME="add"
VALUE=" Add Login ">
<INPUT TYPE="SUBMIT" NAME="remove" VALUE=" Delete Login
"></TD>
</TR>
</TABLE></TD></TR></TABLE>
<BR><BR>
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#000000">
<TR><TD><TABLE cellpadding=7 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#CCCCCC">
<TD align=center colspan=2><B>Manage Password
Files</B></TD>
</TR>
<TR BGCOLOR="#FFFFFF">
<TD>View passwords in the dir:</TD>
<TD>Begining with the letter: </TD>
</TR>
<TR BGCOLOR="#FFFFFF" align=center>
<TD><SELECT NAME="manage_dir">$select</SELECT></TD>
<TD valign=top rowspan=2><SELECT name=letters multiple
size=6>
<OPTION value="ALL Letters" Selected>All Letters
~;
foreach $ch(@char_set) {
print "<OPTION VALUE=\"$ch\">$ch\n";
}
print qq~
</SELECT></TD>
</TR>
<TR BGCOLOR="#FFFFFF" align=center>
<TD><INPUT TYPE=SUBMIT name="delete_select" value=" Submit
"></TD>
</TR>
</TABLE>
</TD></TR></TABLE>
</FORM>
~;
&Bottom(0);
exit;
}
##### SET NEW ADMIN PASSWORD ####
sub newpass {
unless ($INPUT{'passad'} eq $INPUT{'passad2'}) {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
Your administrative password was
not set, as the two entries were different!
</TD></TR></TABLE>
</TD></TR></TABLE>
~;
&Bottom(0);
exit;
}
if ($INPUT{'passad'}) {
$newpassword = crypt($INPUT{'passad'}, $salt);
}
else {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>You must enter a
password!
</TD></TR></TABLE>
</TD></TR></TABLE>
~;
&Bottom(0);
exit;
}
unless ( -e "$password_location" ) {
open (PASSWORD, ">$password_location")|| &error("Error
setting Password");;
print PASSWORD "$newpassword";
close (PASSWORD);
}
else {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
Error setting your admin password<BR><BR>A
$password_location file was found in this dir.<BR><BR>
Due to security reasons, it will not be overwritten.
</TD></TR></TABLE>
</TD></TR></TABLE>
~;
&Bottom(1);
exit;
}
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
Your administrative password has been set.
</TD></TR></TABLE>
</TD></TR></TABLE>
<BR><BR>
~;
&admin;
exit;
}
#### ADD A NEW PASSWORD ####
sub add {
$err = '';
unless ($INPUT{'login'}) {
$err .= "You have not entered a login, please go back an try
again<BR>\n";
}
unless ($INPUT{'pass'} eq $INPUT{'pass2'}) {
$err .= "The two passwords you entered must be the
same<br>\n";
}
if ($INPUT{'rules'}) {
$pwderr = &check_pwd($INPUT{'pass'},$INPUT{'login'},'');
$err .= "Password Error: ". $pwderr if ($pwderr && ($pwderr
!= 1));
}
if ($err) {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
<B>Error setting login/password</b><BR><BR>
$err
<BR><BR>
To set the password as-is, be sure to uncheck the rules
box.
</TD></TR></TABLE>
</TD></TR></TABLE>
~;
&Bottom(1);
exit;
}
$password = crypt($INPUT{'pass'}, $salt);
open(LIST,"$protect{$INPUT{'dir'}}");
@addresses=<LIST>;
close(LIST);
foreach $line(@addresses) {
@login = split(/\:/,$line);
if ($login[0] eq $INPUT{'login'}) {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>The login you
entered, <b>$INPUT{'login'}</b> already exists in the
$INPUT{'dir'} directory,
therefore was not set.
</td></TR></TABLE>
</td></TR></TABLE>
~;
&Bottom(1);
exit;
}
}
open(LIST,">>$protect{$INPUT{'dir'}}") || &error("Unable to
print to $protect{$INPUT{'dir'}}");
print LIST "$INPUT{'login'}:$password\n";
close(LIST);
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>The login
<b>$INPUT{'login'}</b> was successfully added to the
$INPUT{'dir'} directory
</td></TR></TABLE>
</td></TR></TABLE><BR><BR>
~;
&admin;
exit;
}
#### REMOVE A PASSWORD ####
sub remove{
open(LIST,"$protect{$INPUT{'dir'}}");
@addresses=<LIST>;
close(LIST);
open(LIST,">$protect{$INPUT{'dir'}}") || &error("Unable to
write to $protect{$INPUT{'dir'}}");
$found=0;
foreach $line (@addresses) {
@login = split(/\:/,$line);
if ($login[0] eq $INPUT{'login'}) {
$found=1;
}
else {
print LIST $line;
}
}
close(LIST);
if ($found) {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
The login <b>$INPUT{'login'}</b> has been removed from the
$INPUT{'dir'} directory
</TD></TR></TABLE>
</TD></TR></TABLE>
<BR><BR>
~;
&admin;
exit;
}
else {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
The login <b>$INPUT{'loginn'}</b> has was not found in the
$INPUT{'dir'} directory,
therefore not removed
</TD></TR></TABLE>
</TD></TR></TABLE>
<BR><BR>
~;
&admin;
exit;
}
}
#### DELETE MULTIPLE ####
sub delete_select {
open(LIST,"$protect{$INPUT{'manage_dir'}}") || &error("Can
not open $protect{$INPUT{'manage_dir'}} for reading");
@addresses=<LIST>;
close(LIST);
@addresses = sort {$a cmp $b} @addresses;
print <<EOF;
<FORM METHOD=POST ACTION="$thisurl">
<input type="Hidden" name="password"
value="$INPUT{'password'}">
<input type="Hidden" name="manage_dir"
value="$INPUT{'manage_dir'}">
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#000000">
<TR><TD><TABLE cellpadding=5 cellspacing=1 border=0
width="100%">
<TR bgcolor="#CCCCCC"><TD align=center>
Showing all logins from the <B>$INPUT{'manage_dir'}</B>
directory<BR>
that start with the letter: <B>$INPUT{'letters'}</B>
<BR><BR>
Select logins to delete
</TD></TR></TABLE>
</TD></TR></TABLE>
<br><br>
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#000000">
<TR><TD><TABLE cellpadding=3 cellspacing=1 border=0
width="100%">
<TR align=left bgcolor="#FFFFFF">
EOF
$num_email=0;
$color{'1'} = "#DDDDDD";
$color{'2'} = "#CCCCCC";
$colors=1;
$total =0;
foreach $line(@addresses) {
chomp($line);
@login = split(/\:/,$line);
my @accarray = split(//,$login[0]);
## LETTER SELECT ##
unless ($INPUT{'letters'} =~ /ALL/) {
unless ($INPUT{'letters'} =~ /$accarray[0]/) {
next;
}
}
$total++;
if ($num_email == 3) {
print "</TR><TR align=left bgcolor=\"#FFFFFF\">";
$num_email=0;
}
print "<TD bgcolor=$color{$colors}>";
print "<INPUT TYPE=\"CHECKBOX\" NAME=\"delete\"
VALUE=\"$line\"> -- $login[0]</TD>";
$num_email++;
if ($colors == 2) {
$colors = 0;
}
$colors++;
}
$span = 3 - $num_email;
if ($span) {
print qq~
<TD colspan=$span> </TD>
~;
}
print qq~
</TR>
<TR bgcolor="#DDDDDD" align=center>
<TD colspan=3><B>$total</B> logins found</TD>
</TR>
<TR bgcolor="#CCCCCC" align=center>
<TD colspan=3><INPUT TYPE="SUBMIT" NAME="delete_final"
VALUE="Delete selected logins"></TD>
</TR></TABLE>
</TD></TR></TABLE>
</form>
~;
&Bottom(1);
exit;
}
#### DELETE MULITIPLE LOGIN ####
sub delete_final {
open(LIST,"$protect{$INPUT{'manage_dir'}}")|| &error("Unable
to open $protect{$INPUT{'manage_dir'}}");
@addresses=<LIST>;
close(LIST);
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
The following logins were deleted from the
$INPUT{'manage_dir'} directory<BR><BR>
~;
@deleting = split(/\,/,$INPUT{'delete'});
foreach $line(@deleting) {
@addresses = grep{ !(/^$line/i) } @addresses;
@login = split(/\:/,$line);
print "$login[0] <BR>";
}
print qq~
</TD></TR></TABLE>
</TD></TR></TABLE>
<BR><BR>
~;
open(LIST,">$protect{$INPUT{'manage_dir'}}") ||
&error("Unable to write to
$protect{$INPUT{'manage_dir'}}");
print LIST @addresses;
close(LIST);
&admin;
exit;
}
#### CHECK PASSWORD ####
sub checkpassword {
open (PASSWORD, "$password_location") || &error("Unable to
open $password_location");
$password = <PASSWORD>;
close (PASSWORD);
if ($INPUT{'password'}) {
$newpassword = crypt($INPUT{'password'}, $password);
unless ($newpassword eq $password) {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>Wrong Password
</TD></TR></TABLE></TD></TR></TABLE>
~;
&Bottom(0);
exit;
}
}
else {
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>You must enter your
admin password
</TD></TR></TABLE>
</TD></TR></TABLE>
~;
&Bottom(0);
exit;
}
}
#### PRINT TOP ####
sub Top {
print qq~
<HTML><HEAD><TITLE>Access Denied -- Solution
Scripts</TITLE>
<style type="text/css">
body { font-size: 12px; font-family:
verdana,helvetica,arial; }
td { font-size: 12px; font-family: verdana,helvetica,arial;
}
</STYLE>
</HEAD>
<BODY LEFTMARGIN="0" RIGHTMARGIN="0" TOPMARGIN="0"
BOTTOMMARGIN="0" BGCOLOR="white" TEXT="black" link=blue
vlink=blue alink=blue>
<TABLE WIDTH=100% CELLPADDING=4 CELLSPACING=0 BORDER=0
BGCOLOR="NAVY">
<TR><TD width=100%>
<FONT color="white" size=+2>Access Denied</FONT>
<FONT color="white" size=+1>from</FONT>
<A HREF="http://solutionscripts.com"><FONT color="white"
size=+1>Solution Scripts</FONT></A>
</TD>
<TD NOWRAP align=right>
<FONT color="white">
Version $VERSION<BR>
<A
HREF="http://faq.solutionscripts.com/docs/accessdenied"><FONT
color="white">Manual</FONT></A>
</TD>
</TR></TABLE>
<BR><BR>
<DIV ALIGN=CENTER>
~;
}
#### BOTTOM ####
sub Bottom {
print qq~
</DIV>
<BR>
<BR>
<TABLE bgcolor=white border=0 cellpadding=2 width=100%>
<TR>
<TD NOWRAP align=right><font size=-2>Copyright 2000 <A
HREF="http://solutionscripts.com">Solution Scripts</A>
</FONT></TD>
</TR></TABLE>
</BODY></HTML>
~;
}
#### ERROR ####
sub error{
$errors = $_[0] ;
print qq~
<TABLE cellpadding=0 cellspacing=0 border=0
bgcolor="#CCCCCC">
<TR><TD><TABLE cellpadding=8 cellspacing=1 border=0
width="100%">
<TR BGCOLOR="#FFFFFF"><TD align=center>
<B>An error has occured</B><BR><BR>
The error is: <B>$errors</B><BR>
<B>$!</B>
<BR><BR>
<A HREF="http://faq.solutionscripts.com/docs/accessdenied"
target="_BLANK">Access Denied Documentation</A>
<BR>
<A HREF="http://forum.solutionscripts.com"
target="_BLANK">Solution Scripts help forums</A>
</TD></TR></TABLE>
</TD></TR></TABLE>
~;
&Bottom;
exit;
}
sub sort_hashs {
my $x = shift;
my %array = %$x;
sort { $array{$b} cmp $array{$a}; } keys %array;
}
######### SUB CHECK PASSWORD #########
sub check_pwd {
# portions of code taken from anlpasswd
# ftp://coast.cs.purdue.edu/pub/tools/unix/anlpasswd
# Systems Support Group
# Mathematics & Computer Science Division
# Argonne National Laboratory
# Argonne, Illinois
(my $pass,my $username,my $nickname) = @_;
$nickname = $username unless $nickname;
my $pwderror;
# if ($pass && length($pass) > 8) {
# $pass = substr($pass,0,8);
# };
# Embedded null can spoof crypt routine.
if ($pass =~ /\0/) {
$pwderror = "Please don't use the null character in your
password.\n";
return ($pwderror);
}
if ($pass =~ /:/) {
$pwderror = "Please don't use the colon character in your
password. Some vendors have\n";
$pwderror .= "a problem in changing passwds to something new
when the old has a colon.\n";
return ($pwderror);
}
if (length($pass) < 6) {
$pwderror = "Please use at least 6 characters.\n";
return ($pwderror);
}
if ($pass =~ m!^[A-Z]*\d+$!) {
$pwderror = "Upper case numbering\n";
return ($pwderror); #Upper case with numbers
}
if ($pass =~ m!^\d+\s$!) {
$pwderror = "Watch that whitespace\n";
return ($pwderror); #Numbers with spaces
}
if ($pass =~ m!^\s\d+$!) {
$pwderror = "Watch that whitespace\n";
return ($pwderror); #Spaces with numbers
}
if ($pass =~ m!^[A-Z]*\s$!) {
$pwderror = "Watch that whitespace\n";
return ($pwderror); #Uppercase with spaces
}
if ($pass =~ m!^[a-z]*\s$!) {
$pwderror = "Watch that whitespace\n";
return ($pwderror); #lower case with space
}
if ($pass =~ m!^\s[A-Z]*$!) {
$pwderror = "Watch that whitespace\n";
return ($pwderror); #spaces with Upper case
}
if ($pass =~ m!^\s[a-z]*$!) {
$pwderror = "Watch that whitespace\n";
return ($pwderror); #spaces with lower case
}
if ($pass =~ m!^[a-z]*$!) {
$pwderror = "Mix those cases\n";
return ($pwderror); #all lower case
}
if ($pass =~ m!^\d+$!) {
$pwderror = "It's passWORD not NUMBER\n";
return ($pwderror); #all numbers
}
if ($pass =~ m!^[a-z]*\d+$!) {
$pwderror = "Something a little more complex please\n";
return ($pwderror); #lower case with number
}
if ($pass =~ m!^[A-Z]*$!) {
$pwderror = "no need to SHOUT your choice\n";
return ($pwderror); #all uppercase
}
if ($pass =~ m!^\d+[a-z]*$!) {
$pwderror = "Something a little more complex please\n";
return ($pwderror); #number and lower case
}
if ($pass =~ m!^\d+[A-Z]*$!) {
$pwderror = "Something a little more complex please\n";
return ($pwderror); #number and upper case
}
if ($pass =~ m!^[A-Z]*[a-z]$!) {
$pwderror = "A little backwards today?\n";
return ($pwderror); #all upper followed by lower
}
if ($pass =~ m!^[A-Z][a-z]*$!) {
$pwderror = "Standard capitolization\n";
return ($pwderror); #Standard first letter cap.
}
if ($pass =~ m!^[a-z][A-Z]*$!) {
$pwderror = "Feeling a little shifty today\n";
return ($pwderror); #Backwards of above
}
if ($pass =~ m!^[a-z]*[A-Z]$!) {
$pwderror = "Mix it up a little more\n";
return ($pwderror); #all lower with last cap.
}
if ($pass =~ m!^[-\d/]*$!) {
if ($pass =~ m!^\d{3}-\d{2}-\d{4}$! ||
$pass =~ m!^\d\d\d\d\d\d\d\d\d$!) {
$pwderror = "Please don't use a Social Security Number!\n";
return ($pwderror);
}
if ($pass =~ m!^\d*/\d*/\d*$! ||
$pass =~ m!^\d*-\d*-\d*$!) {
$pwderror = "Please don't use dates.\n";
return ($pwderror);
}
if ($pass =~ m!^\d\d\d-?\d\d\d\d$!) {
$pwderror = "Please don't use a phone number.\n";
return ($pwderror);
}
if ($pass =~ m!^\d{6,7}$!) {
$pwderror = "Please don't use a short number.\n";
return ($pwderror);
}
}
my $mo;
if ($mo = ($pass =~ /^[ \d]*([a-zA-Z]{3,5})[ \d]*$/) &&
($mo =~
/^(jan|feb|mar(ch)?|apr(il)?|may|june?|july?|aug|sept?|oct|nov|dec)$/i)
) {
$pwderror = "Please don't use dates.\n";
return ($pwderror);
}
if ($pass =~ /$username/i) {
$pwderror = "Please don't use your login id.\n";
return ($pwderror);
}
if ($pass =~ /$nickname/i) {
$pwderror = "Please don't use part of your name.\n";
return ($pwderror);
}
# A sequence of keyboard keys?
(my $foo = $pass) =~ y/A-Z/a-z/;
$foo =~ y/qwertyuiop[]asdfghjkl;'zxcvbnm,.\//a-la-ka-j/;
$foo =~ y/!@#\$%^&*()_+|~/abcdefghijklmn/;
$foo =~ y/-1234567890=\\`/kabcdefghijlmn/;
my @ary = unpack('C*',$foo);
my $ok = 0;
for (my $i = 0; $i < $#ary; ++$i) {
my $diff = $ary[$i+1] - $ary[$i];
$ok = 1 if $diff > 1 || $diff < -1;
}
if (!$ok) {
$pwderror = "Please don't use consecutive keys.\n";
return ($pwderror);
}
# Repeated patterns: ababab, abcabc, abcdabcd
if ( $pass =~ /^(..)\1\1/
|| $pass =~ /^(...)\1/
|| $pass =~ /^(....)\1/ ) {
$pwderror = "Please don't use repeated sequences of $1.\n";
return ($pwderror);
}
# Reversed patterns: abccba abcddcba
if ( $pass =~ /^(.)(.)(.)\3\2\1/
|| $pass =~ /^(.)(.)(.)(.)\4\3\2\1/ ) {
$pwderror = "Please don't use palindromic sequences of
$1$2$3$4.\n";
return ($pwderror);
}
my $reverse = reverse $username;
if ($pass =~ /$reverse/i) {
$pwderror = "Please don't use your login id spelled
backwards.\n";
return ($pwderror);
}
return(1); ## GOOD PASSWORD ## whew....!!
}
1;
|
