Hej,
Nu prøvede jeg at ændre den linie til dit forslag, men nu virker det slet ikke :-(
Scriptet ser således her ud:
**
$| = 1;
$user_datafile = "d:/server/users/bruger_data.txt";
&require_supporting_libraries (__FILE__, __LINE__,
"./library/cgi-lib.pl",
"./library/mail-lib.pl");
&ReadParse(*in);
&require_supporting_libraries (__FILE__, __LINE__,
"./library/routine-lib.pl",
"./setup_files/setup_file.pl");
########### TJEK OM BRUGER FINDES###################
$df = "D:/server/config/web20_mail.dat"; #Data fil
open (FILE, "$df");
@users=<FILE>;
close(FILE);
$found=0;
foreach $line (@users) {
($user,$usermail)=split(/\:/,$line);
if (($user ne $in{'username'})) {
$found=1;
last; }
}
if ($found) {
&password_mail_success;
}
&password_mail_failure;
}
}
#####################################################
#$df = "d:/server/config/web20_mail.dat";
#open (FILE, "$df");
#@users=<FILE>;
#close(FILE);
#$found=0;
#foreach $line (@users) {
#($data,$info)=split(/\:/,$line);
#if (($data ne $in{'input'})) {
#&error;
#exit;
#$found=1;
# last; }
# }
#if ($found) {
####################################################
#&check_referer;
if ($use_new_users_scripts ne "yes") {
print "<html><head><META HTTP-EQUIV=\"REFRESH\" CONTENT=\"2\;URL=$refer\"></head><body $background>";
print "<h2 align=center>Sorry! The Postmaster has not enabled this option</h2></body></html>\n";
exit; }
if ($in{'retrieve_password'} ne "")
{
&retrieve_password;
exit;
}
if ($in{'confpasswd'} ne "")
{
&submit_modification;
exit;
}
if ($in{'change_email'} ne "")
{
&submit_data_email_change;
exit;
}
sub submit_modification
{
&character_check;
if ($in{'newpasswd'} ne $in{'confpasswd'}) {
#&match_password;
exit;
}
$fake_it = "test";
#$fake_it = $in{'password'};
if ($fake_it eq "")
{
&password_change_failure;
exit;
}
if ($in{'confpasswd'} ne "") {
$upassword = $in{'confpasswd'};
$encrypt_pw = &sambar_encrypt($in{'confpasswd'});
} # end if
&get_file_lock("$location_of_lock_file");
open (DATABASE, "<$pwdfile");
while (<DATABASE>)
{
$line = $_;
chop $line;
@fields = split (/\:/, $line);
$old_row = "$line";
if ($fields[$index_of_username] ne $in{'username'})
{
$new_data .= "$line\n";
} else {
$old_row = "$line";
for ($i=0; $i <= (@db_user_definable_field_order-1); $i++)
{
$index = $db_user_definable_field_order[$i];
if ($in{$index} ne "")
{
$fields[$index_of_encrypt_pw] = $encrypt_pw;
$new_row .= "$in{$db_user_definable_field_order[$i]}\:";
}
else
{
$new_row .= "$fields[$i]\:";
}
} # End of for ($i=1; $i <= @db_user_definable_field_order; $i++);
$new_data .= "$new_row \n";
}
}
close (DATABASE);
&release_file_lock("$location_of_lock_file");
&get_file_lock("$location_of_lock_file");
open (DATABASE, ">$pwdfile");
print DATABASE "$new_data";
close (DATABASE);
&release_file_lock("$location_of_lock_file");
################ Clear the values to use again ###############
$line = '';
$new_data = '';
$new_row = '';
$old_row = '';
$index = '';
$fields = '';
@fields = '';
################ Now do the user data file ###################
$confpasswd = $in{'confpasswd'};
use MIME::Base64;
$cgiencrypt_pw = encode_base64($confpasswd);
for ($cgiencrypt_pw) {
s/^\s+//;
s/\s+$//;
}
&get_file_lock("$location_of_lock_file");
open (DATABASE, "<$user_datafile");
while (<DATABASE>)
{
$line = $_;
chop $line;
@fields = split (/\|/, $line);
$old_row = "$line";
if ($fields[$index_of_datausername] ne $in{'username'})
{
$new_data .= "$line\n";
} else {
$old_row = "$line";
for ($i=0; $i <= (@data_user_definable_field_order-1); $i++)
{
$index = $data_user_definable_field_order[$i];
if ($in{$index} ne "")
{
$fields[$index_of_password] = $cgiencrypt_pw;
$fields[$index_of_email] = $new_email;
$new_row .= "$in{$data_user_definable_field_order[$i]}\|";
}
else
{
$new_row .= "$fields[$i]\|";
}
} # End of for ($i=1; $i <= @data_user_definable_field_order; $i++);
$new_data .= "$new_row \n";
}
}
close (DATABASE);
&release_file_lock("$location_of_lock_file");
&get_file_lock("$location_of_lock_file");
open (DATABASE, ">$user_datafile");
print DATABASE "$new_data";
close (DATABASE);
&release_file_lock("$location_of_lock_file");
#end and exit
#&password_change_success;
&retrieve_password
}
sub submit_data_email_change {
if ($in{'new_email'} ne "") {
$new_email = $in{'new_email'};
} # end if
&get_file_lock("$location_of_lock_file");
open (DATABASE, "<$user_datafile");
while (<DATABASE>)
{
$line = $_;
chop $line;
@fields = split (/\|/, $line);
$old_row = "$line";
if ($fields[$index_of_datausername] ne $in{'username'})
{
$new_data .= "$line\n";
} else {
$old_row = "$line";
for ($i=0; $i <= (@data_user_definable_field_order-1); $i++)
{
$index = $data_user_definable_field_order[$i];
if ($in{$index} ne "")
{
$fields[$index_of_data_email] = $new_email;
$new_row .= "$in{$data_user_definable_field_order[$i]}\|";
}
else
{
$new_row .= "$fields[$i]\|";
}
} # End of for ($i=1; $i <= @data_user_definable_field_order; $i++);
$new_data .= "$new_row \n";
}
}
close (DATABASE);
&release_file_lock("$location_of_lock_file");
&get_file_lock("$location_of_lock_file");
open (DATABASE, ">$user_datafile");
print DATABASE "$new_data";
close (DATABASE);
&release_file_lock("$location_of_lock_file");
#end and exit
&email_change_success;
}
#################################################################################
sub retrieve_password {
#open (FILE, "$user_datafile");
# @users=<FILE>;
# close(FILE);
#$found=0;
#foreach $line (@users) {
##($username,$domain,$passwd,$root,$admin,$space,$name,$email)=split(/\:/,$line);
#($username,$domain,$passwd,$root,$admin,$space,$name)=split(/\:/,$line);
#if (($username eq $in{'username'})&&($passwd ne "")) {
##if (($username eq $in{'username'})&&($passwd ne "")&&($email =~ "\@")) {
##if (($name eq $in{'name'})&&($username eq $in{'username'})&&($passwd ne "")&&($email =~ "\@")) {
# $found=1;
#use MIME::Base64;
# $password = decode_base64($passwd);
# last; }
# }
#########################################################3
#$df = "d:/server/config/web20_mail";
#$usern = "abcdefghi.web20.dk";
#open (FILE, "$df");
#@users=<FILE>;
# close(FILE);
#$found=0;
#foreach $line (@users) {
##($username,$domain,$passwd,$root,$admin,$space,$name,$email)=split(/\:/,$line);
#($user,$cont)=split(/\:/,$line);
#if (($user eq $usern)) {
#if (($user eq $in{'username'})) {
##if (($username eq $in{'username'})&&($passwd ne "")&&($email =~ "\@")) {
##if (($name eq $in{'name'})&&($username eq $in{'username'})&&($passwd ne "")&&($email =~ "\@")) {
# $found=1;
# last; }
#
# }
#
#
#if ($found) {
$subj = "Bestilling af kode";
$messagebody .= "Hej $name\n";
$messagebody .= "Du har bedt om at få tilsendt din kode\n";
$messagebody .= "til din hjemmeside hos web20.dk\n\n";
$messagebody .= "Dit bruger navn er : $username\n";
$messagebody .= "Dit bruger navn er : $user\n";
$messagebody .= "Din adgangs kode er: $password $newpass\n\n";
$messagebody .= "Venlig hilsen\n";
$messagebody .= "Web20.dk\n";
&send_mail($from_address, $email, $subj, $messagebody);
&password_mail_success;
}
&password_mail_failure;
#}
#}
sub password_change_success {
#<META HTTP-EQUIV="REFRESH" CONTENT="0;URL=$refer">
print <<__END_MAILRESULTS__;
<HTML><HEAD>
<TITLE>User Found</TITLE>
<META HTTP-EQUIV="REFRESH" CONTENT="20;URL=$refer">
</HEAD>
<$background>
<font COLOR=000040>
<CENTER>
<H2>Password Changed</h2>
<hr>
<h3>Koden er ændret</h3>
<h3>
<hr>
</center>
</body>
</HTML>
__END_MAILRESULTS__
}
sub password_change_failure {
print <<__END_MAILRESULTS__;
<HTML><HEAD>
<TITLE>User Not Found</TITLE>
<META HTTP-EQUIV="REFRESH" CONTENT="22;URL=$refer">
</HEAD>
<$background>
<font COLOR=000040>
<CENTER>
<H2>Password Error</h2>
<hr>
<h3>Your password or username did not match</h3>
<hr>
<b> looking for user : $username
</center>
</body>
</HTML>
__END_MAILRESULTS__
}
sub email_change_success {
print <<__END_MAILRESULTS__;
<HTML><HEAD>
<TITLE>User Found</TITLE>
<META HTTP-EQUIV="REFRESH" CONTENT="1;URL=$refer">
</HEAD>
<$background>
<font COLOR=000040>
<CENTER>
<H2>Email Changed</h2>
<hr>
<h3>Your email has been successfully changed</h3>
<hr>
</center>
</body>
</HTML>
__END_MAILRESULTS__
}
sub password_mail_success {
print <<__END_MAILRESULTS__;
<HTML><HEAD>
<TITLE>User Found</TITLE>
</HEAD>
<$background>
<font COLOR=FF0000>
<CENTER>
<H2>Password Sent</h2>
<hr>
<h3>Your password has been mailed to the address on record</h3>
<h3>password $password </h3>
<h3>mail $mail </h3>
<h3>navn :$name
<h3>
<h3>
<h3>
<h3>email $email
<h3>email2 $mail
<h3>kode $kode
<BR><a href="/">Return to $sitename</a>
<hr>
</center>
</body>
</HTML>
__END_MAILRESULTS__
}
sub password_mail_failure {
print <<__END_NOMAILRESULTS__;
<HTML><HEAD>
<TITLE>No Users Found</TITLE>
</HEAD>
<$background>
<font COLOR=FF0000>
<CENTER>
<H2>Invalid Email</h2>
<hr>
<h2>Error!</h2>
<h3>That did not match or no email address on record to send it to!
<h3>path to pass file :$user_datafile </h3>
<h3>path to pass file :$df </h3>
<b> looking for user : $user </b>
<BR><a href="/">Return to $sitename</a>
<hr>
</center>
</body>
</HTML>
__END_NOMAILRESULTS__
}
sub bad_character {
print <<__END_RESULTS__;
<HTML><HEAD>
<TITLE>Bad Character Used</TITLE>
</HEAD>
<$background>
<font COLOR=FF0000>
<CENTER>
<H2>Invalid Character</h2>
<hr>
<h2>Error!</h2>
<h3>One or more of the characters you used is not allowed</h3>
<BR>Use your back arrow to return to the form.
<hr>
</center>
</body>
</HTML>
__END_RESULTS__
}
sub getmail {
}
sub fejl {
print <<__END_FEJL__;
<HTML><HEAD>
<TITLE>fejl</TITLE>
</HEAD>
<$background>
<font COLOR=FF0000>
<CENTER>
<H2>FEJL</h2>
<hr>
<h2>Error!</h2>
<h3>One or more of the characters you used is not allowed</h3>
<BR>Use your back arrow to return to the form.
<hr>
</center>
</body>
</HTML>
__END_FEJL__
}
###########################################################################
# Library load and File Lock routines are borrowed from Solena Sol
###########################################################################
sub require_supporting_libraries
{
local ($file, $line, @require_files) = @_;
local ($require_file);
foreach $require_file (@require_files)
{
if (-e "$require_file" && -r "$require_file")
{
require "$require_file";
}
else
{
print "Content-type: text/html\n\n";
print "I am sorry but I was unable to require $require_file at line
$line in $file. Would you please make sure that you have the
path correct and that the permissions are set so that I have
read access? Thank you.";
exit;
}
} # End of foreach $require_file (@require_files)
} # End of sub require_supporting_libraries
#######################################################################
# get_file_lock #
#######################################################################
# The subroutine takes one argumnet, the name to use for
# the lock file and is called with the following syntax:
#
# &get_file_lock("file.name");
sub get_file_lock
{
local ($lock_file) = @_;
local ($endtime);
$endtime = 20;
$endtime = time + $endtime;
# We set endtime to wait 20 seconds. If the lockfile has
# not been removed by then, there must be some other
# problem with the file system. Perhaps an instance of
# the script crashed and never could delete the lock file.
while (-e $lock_file && time < $endtime)
{
sleep(1);
}
open(LOCK_FILE, ">$lock_file") || &file_open_error ("$lock_file",
"Lock File Routine",
__FILE__, __LINE__);
# Note: If flock is available on your system, feel free to
# use it. flock is an even safer method of locking your
# file because it locks it at the system level. The above
# routine is "pretty good" and it will server for most
# systems. But if youare lucky enough to have a server
# with flock routines built in, go ahead and uncomment
# the next line and comment the one above.
# flock(LOCK_FILE, 2); # 2 exclusively locks the file
}
#######################################################################
# release_file_lock #
#######################################################################
#
# &release_file_lock("file.name");
sub release_file_lock
{
local ($lock_file) = @_;
# flock(LOCK_FILE, 8); # 8 unlocks the file
# As we mentioned in the discussion of get_file_lock,
# flock is a superior file locking system. If your system
# has it, go ahead and use it instead of the hand rolled
# version here. Uncomment the above line and comment the
# two that follow.
close(LOCK_FILE);
unlink($lock_file);
}
sub character_check {
# screen username and password for invalid characters
if (($in{'username'} =~ s/"/\\"/g)||
#($in{'username'} =~ s/@/\\@/g)||
($in{'username'} =~ s/'/\\'/g)||
#($in{'username'} =~ s/_/\\_/g)||
($in{'username'} =~ s/,/\\,/g)||
($in{'username'} =~ s/~/\\~/g)||
($in{'username'} =~ s/\*/\\\*/g)||
($in{'username'} =~ s/\;/\\\;/g)||
($in{'username'} =~ s/\:/\\\:/g)||
($in{'username'} =~ s/!/\\!/g)||
($in{'username'} =~ s/&/\\&/g)||
($in{'username'} =~ s/\)/\\\)/g)||
($in{'username'} =~ s/\(/\\\(/g)||
($in{'username'} =~ s/\//\\\//g)||
($in{'username'} =~ s/\"/\\\"/g)||
($in{'username'} =~ s/\$/\\\$/g)||
($in{'username'} =~ s/\+/\\\+/g)||
($in{'username'} =~ s/\|/\\\|/g)||
($in{'username'} =~ s/\%/\\\%/g)||
($in{'username'} =~ s/\#/\\\#/g)||
($in{'username'} =~ s/=/\\=/g))
{ &bad_character; exit; }
if (($in{'pw'} =~ s/"/\\"/g)||
($in{'pw'} =~ s/@/\\@/g)||
($in{'pw'} =~ s/'/\\'/g)||
($in{'pw'} =~ s/_/\\_/g)||
($in{'pw'} =~ s/,/\\,/g)||
($in{'pw'} =~ s/~/\\~/g)||
($in{'pw'} =~ s/\*/\\\*/g)||
($in{'pw'} =~ s/\;/\\\;/g)||
($in{'pw'} =~ s/\:/\\\:/g)||
($in{'pw'} =~ s/!/\\!/g)||
($in{'pw'} =~ s/&/\\&/g)||
($in{'pw'} =~ s/\)/\\\)/g)||
($in{'pw'} =~ s/\(/\\\(/g)||
($in{'pw'} =~ s/\//\\\//g)||
($in{'pw'} =~ s/\"/\\\"/g)||
($in{'pw'} =~ s/\$/\\\$/g)||
($in{'pw'} =~ s/\+/\\\+/g)||
($in{'pw'} =~ s/\|/\\\|/g)||
($in{'pw'} =~ s/\%/\\\%/g)||
($in{'pw'} =~ s/\#/\\\#/g)||
($in{'pw'} =~ s/=/\\=/g))
{ &bad_character; exit; }
## This part disallows usernames that begin with a number or have two numbers together
@character_check = ("0","1","2","3","4","5","6","7","8","9");
foreach $disallow (@character_check) {
if ($in{'username'} =~ "$disallow$disallow") {
print "You cant do that";
exit;
} elsif ($in{'username'} =~ /^$disallow/) {
&invalid_sequence;
exit;
}
}
$disallow = "";
} #end character_check
**
en leng smøre på små 600 linier.. sorry..
Men det er starten af scriptet jeg ikke få til at makke ret .-(
Jep, jeg tror mere end gerne at det ikke fungere, men det har nu intet med min foreslåede ændring at gøre. Du har nemlig masser af ubalancerede tuborg-parenteser, og der er et andet sted hvor du endda har udkommenteret den første del af en if-sætning hvorefter at du har glemt at udkommentere resten. Endelig har du masser af død kode - altså kode som aldrig nogensinde ville blive udført.
Jeg har kogt det ned til det essentielle:
$| = 1;
$user_datafile = "d:/server/users/bruger_data.txt";
&require_supporting_libraries(__FILE__, __LINE__, "./library/cgi-lib.pl", "./library/mail-lib.pl");
&ReadParse(*in);
# Hvor bliver ReadParse defineret henne?
&require_supporting_libraries(__FILE__, __LINE__, "./library/routine-lib.pl", "./setup_files/setup_file.pl");
##### TJEK OM BRUGER FINDES #####
$df = "D:/server/config/web20_mail.dat"; #Data fil
open(FILE, "$df");
@users = <FILE>;
close(FILE);
$found = 0;
foreach $line (@users)
{
($user, $usermail) = split(/\:/, $line);
if (($user eq $in{'username'}))
{
$found = 1;
last;
}
}
if ($found)
{
&password_mail_success;
}
else
{
&password_mail_failure;
}
##### Slut på main #####
###########################################################################
# Library load and File Lock routines are borrowed from Solena Sol
###########################################################################
sub require_supporting_libraries
{
local ($file, $line, @require_files) = @_;
local ($require_file);
foreach $require_file (@require_files)
{
if (-e "$require_file" && -r "$require_file")
{
require "$require_file";
}
else
{
print "Content-type: text/html\n\n";
print "I am sorry but I was unable to require $require_file at line $line in $file. Would you please make sure that you have the path correct and that the permissions are set so that I have read access? Thank you.";
exit;
}
} # End of foreach $require_file (@require_files)
} # End of sub require_supporting_libraries
sub password_mail_success
{
print <<__END_MAILRESULTS__;
<HTML><HEAD>
<TITLE>User Found</TITLE>
</HEAD>
<$background>
<font COLOR=FF0000>
<CENTER>
<H2>Password Sent</h2>
<hr>
<h3>Your password has been mailed to the address on record</h3>
<h3>password $password</h3>
<h3>mail $mail</h3>
<h3>navn :$name
<h3>
<h3>
<h3>
<h3>email $email
<h3>email2 $mail
<h3>kode $kode
<BR><a href="/">Return to $sitename</a>
<hr>
</center>
</body>
</HTML>
__END_MAILRESULTS__
}
sub password_mail_failure
{
print <<__END_NOMAILRESULTS__;
<HTML><HEAD>
<TITLE>No Users Found</TITLE>
</HEAD>
<$background>
<font COLOR=FF0000>
<CENTER>
<H2>Invalid Email</h2>
<hr>
<h2>Error!</h2>
<h3>That did not match or no email address on record to send it to!
<h3>path to pass file :$user_datafile </h3>
<h3>path to pass file :$df </h3>
<b> looking for user : $user </b>
<BR><a href="/">Return to $sitename</a>
<hr>
</center>
</body>
</HTML>
__END_NOMAILRESULTS__
}