#!/usr/bin/perl -w
#******************************************************#
# Perlscript for login and register form #
# #
# GNU General Public License Version 2 or later #
# http://www.gnu.org/licenses/gpl.html #
# #
# Thomas Lauener, Zuerich Switzerland #
# www.ipsource.ch #
# info@ipsource.ch #
#******************************************************#
use English;
#use strict;
# HTTP-header
print "content-type: text/html\n\n";
print "check user\n";
print "\n";
print "server
\n";
$arg =$ENV{'QUERY_STRING'};
$check = 0;
$input="";
# readln
$ENV{'REQUEST_METHOD'}=~ "POST" && read(STDIN, $input,$ENV{'content_LENGTH'});
$register=($arg=~ /register/) || 0;
# temp
#print "ARG",($arg=~ /register/) || 0;
#print "R:",$register;
#print "PID: ",$<;# PROCESS_ID;
print "IN",$input,"\n";
#print $arg{'action'};
# /temp
# Check the form
unless($check!~ 0 || length($input)==0
&& &msg("H2","Please enter userID, password and retype password.")) # entries done
{
%daten=&extract($input);
@skeys = sort criteria01 (keys %daten);
#print $daten{'user'};
# check all fields
SWITCH: for(@skeys)
{
/user/ && do
{
$check =
&msg("H3","Check user...")
&& (&isval($_) || &msg("H2","failed.") && &msg("H2","Please enter userID.") && 0)
# print "CHECK1A:",$check, "REGISTER", $register
&& (!$register
|| (&exist($daten{'user'})
|| &msg("H2","failed.") && &msg("H1","UserID is allready in use.") && 0)
&& &msg("H3","ok"));
# print "CHECK1B:",$check, "REGISTER", $register;
};
/pwd1/ && do
{
$pwd1= &msg("H3","Check password...") && (&isval($_) || 0);
$check &&= $pwd1;
$pwd1 ||= &msg("H2","failed.") && &msg("H2","Please enter password.") && 0;
};
/pwd2/ && $register && do
{
$pwd2= &isval($_) || 0;
$pwd2 ||= $pwd1 && &msg("H2","failed.") && 0;
$pwd2 ||= &msg("H2","Please retype password.") && 0;
$check = $pwd1 && $pwd2 && ($daten{'pwd1'} eq $daten{$_}
|| &msg("H2","failed.") && &msg("H2","Password-entries are different.") && 0)
&& &msg("H3","ok") && $check;
};
#/mail/ && $register && do {next SWITCH;};
}# /SWITCH
$check = ($register && &msg("H3","Add user ...") || &msg("H3","user login...")) && $check;
$check &&= ($register && &putdata() && &msg("H3","ok") && &msg("H3","user has been registered.")
|| &userchk() && &msg("H3","user is entering in members aera.") && &lnk());
$check ||= &msg("H2","failed.") && &msg("H2","Please correct entries.") && 0;
print "\n";
exit(0);
}
# read all lines and put them into a array
sub getdata
{
my @Zeilen = ("");
open(USERDAT, ")
{ #_________ line 100
push(@Zeilen,$_);
}
close(USERDAT);
return @Zeilen;
}
sub putdata
# add user to the datfile
{
open(USERDAT, ">>users.dat"); # open for write
print USERDAT $input,"\n"; # add record
close(USERDAT);
return 1;
}
sub crlf
{
print "
\n";
return 0;
}
sub extract
# alter separator to ',' abd write line in a hash
# parameter: line_to_extract
{
my $zeile=$_[0];
$zeile=~ s/\=|&/\,/gi;
#$zeile=~ s/&/','/gi;
#$zeile="'".$zeile."'";
print "ZEILE",$zeile;
my @list=split(/,/,$zeile);
%hash=@list;
return @hash;
}
sub exist
# check if the user is all allready existing
# parameter: new_user
{
my $ok=1;
my $i=1;
@users=&getdata(); # file to array
while($i < @users && $ok==1)
{
%user=&extract($users[$i]); # element to hash
$ok=!($_[0] eq $user{'user'});
#print "DO",$_[0],"EndDO USR", $user{'user'},"EndUSER";
$i++;
}
return $ok;
}
sub criteria01
# order by form input
{
if($input=~ /$a(?=\=)/ && $'=~ /$b(?=\=)/)
{return -1;}
else
{return 1;}
}
sub msg
# print HTML-message
# parameter: style, text, crlf
{
print "<", $_[0]," ALIGN=\"LEFT\">$_[1]\n";
return 1;
}
sub lnk
# print HTML- link
{
#print "the script\n";
return 1;
}
sub isval
# is the field filled & create msg
# parameter fieldname
{
return $input!~ /$_[0](?=\=\&)/ || 0;
}
sub userchk
# check if userID and password fit to a existing user
# parameter: login_string
{
my $ok=0;
my $i=0;
@users=&getdata(); # file to array
while($i < @users && $ok==0)
{
$input=~ /last=/;
$ok=($users[$i]=~ /$`/) || 0;
$i++;
} #____________________________________________________________ line 200
return $ok;
}