Xpoint
   [напомнить пароль]

Регистрация пользователей

Метки: [без меток]
2008-12-03 12:47:41 [обр] MacGrow[досье]
У меня проблема: не работает скрипт регистрации, точнее почему-то не записывает пользователей. Все время пишет, что пользователя не существует.
спустя 3 минуты [обр] MacGrow[досье]
сообщение промодерировано
вот текст:
#!/usr/bin/perl
require "config.pl";
if($ENV{'REQUEST_METHOD'} eq 'GET'){$query=$ENV{'QUERY_STRING'}}
elsif($ENV{'REQUEST_METHOD'} eq 'POST'){sysread(STDIN,$query,$ENV{'CONTENT_LENGTH'})}
@formfields=split(/&/,$query);
sub urldecode{local($val)=@_;
$val=~s/\+/ /g;
$val=~s/%([0-9a-hA-H]{2})/pack('C',hex($1))/ge;
return $val;
}
foreach (@formfields){chomp($_);
($f_n,$f_v)=split(/=/,$_);
$f_n=&urldecode($f_n);
$f_v=&urldecode($f_v);
$in{$f_n}=$f_v;
}
@month = ("01", "02", "03", "04", "05", "06", "07","08", "09", "10", "11", "12");
($Seconds, $Minutes, $Hours, $DayInMonth, $Month, $ShortYear, $DayOfWeek,
$DayOfYear, $IsDST) = localtime(time);
$Year = $ShortYear + 1900;$Year=~s/^..//;
$Date = "$DayInMonth.$month[$Month].$Year<time>$Hours:$Minutes:$Seconds";
print "Content-Type: text/html; charset=windows-1251\n\n";
# Проверка на наличие IP в базе блокированных пользователей
open (IPusers, "ipusers.txt");
@banlist = <IPusers>;
close(IPusers);
($this1,$this2,$this3,$this4) = split(/\./,$ENV{REMOTE_ADDR});
foreach $banlist (@banlist) {
($ip1,$ip2,$ip3,$ip4,$chop) = split(/\./,$banlist);
if ($this1 == $ip1) {
if ($this2 == $ip2) {
if ($this3 == $ip3) {
if ($this4 == $ip4) {
print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"0;URL=$htmlurl/ban.htm\">\n\n";
}}}
}}
# Конец проверки
if($query ne ''){
if($in{'step'} eq '1'){
}elsif($in{'step'} eq '2'){
open(PWD,"userdat.pl");
if ($flock eq "1"){flock(PWD, 2);}
@users = <PWD>;
close(PWD);chomp(@users);
foreach (@users){
($login,$pwd,$id,$status,$dr,$dc)=split(/\|/,$_);
if($in{'user'} eq $login){$exist = 'da'};
if($in{'refid'} eq $login){$refid = $id}
}
if($in{'user'} eq 'admin'){$exist = 'da'}
if($in{'user'} eq ''){ &reptem("$tabv<p align=center><b><font color=#8E7CCD>Не введен логин!</font></b></b><br><a href=javascript:history.back()><<< Назад</a><br>"); }
if($in{'pwd'} eq ''){ &reptem("$tabv<p align=center><b><font color=#8E7CCD>Не введен пароль!</font></b></b><br><a href=javascript:history.back()><<< Назад</a><br>"); }
if($in{'mail'} eq ''){ &reptem("$tabv<p align=center><b><font color=#8E7CCD>Не введен e-mail!</font></b></b><br><a href=javascript:history.back()><<< Назад</a><br>"); }
if($exist eq 'da'){
$text=<<d00der;
$tabv<h3><font size=-1 color=#8E7CCD>Пользователь $in{'user'} уже зарегистрирован в системе.<br>
Придумайте себе другой логин.</font></h3>
<FORM METHOD="POST" ACTION="reg.cgi"><input type="hidden" name="step" value="2">
<input type="hidden" name="refid" value="$in{'refid'}"><table border="0">
<tr><td><font size="2" face="Verdana"><b>Логин</b></font></td><td><input name="user" maxlength=20></td></tr>
<tr><td><font size="2" face="Verdana"><b>Пароль</b></font></td><td><input type="password" name="pwd" maxlength=20></td></tr>
<tr><td><font size="2" face="Verdana"><b>E-mail</b></font></td><td><input name="mail" maxlength=20 size="20" value="$in{'mail'}"</td></tr>
<tr><td><font size="2" face="Verdana"><b>WM-ID</b></font></td><td><input name="wmid" maxlength=20 size="20" value="$in{'wmid'}"></td></tr>
<tr><td><font size="2" face="Verdana"><b>WM-Z</b></font></td><td><input name="wmz" maxlength=20 size="20" value="$in{'wmz'}"></td></tr>
<tr><td><font size="2" face="Verdana"><b>Друг:</b></font></td><td>$in{'refid'}</td></tr>
</center><tr><td colspan="2">
<p align="center"><b><input type="checkbox" name="C1" value="ON" checked> </b><font size="2">С&nbsp;
правилами&nbsp; работы&nbsp; согласен.</font><br>
<INPUT alt="Регистрация" style="background-color: transparent; cursor: hand; height: 18; width: 151; font-size: 10pt; font-weight: bold; color: #8E7CCD; border-style: none; border-width: 2px" type=submit value="Р е г и с т р а ц и я">
</p></td></tr></table></form>
d00der
reptem($text);
}else{
$id++;
# Архив базы данных пользователей
open(SUBSC,">>arhuser.dat");
if ($flock eq "1"){flock(SUBSC, 2);}
print SUBSC "$in{'user'}|$in{'pwd'}|$id|A|$Date|$in{'mail'}|\n";
close(SUBSC);
# Запись емайл пользователя в базу
open(MAILLIST,">>./mail/mail.txt");
if ($flock eq "1"){flock(MAILLIST, 2);}
print MAILLIST "$in{'mail'}\n";
close(MAILLIST);
# Запись данных в главную базу
open(PWD,">>userdat.pl");
if ($flock eq "1"){flock(PWD, 2);}
print PWD "$in{'user'}|$in{'pwd'}|$id|A|$Date|$in{'mail'}|\n";
close(PWD);
# Запись в статистику
open(TSTAT,">>./system/today.stat");
if ($flock eq "1")
{flock(TSTAT, 2);}
print TSTAT "$in{'user'}|$id|$Date\n";
close(TSTAT);
$make = "./users/$id";
mkdir "$make", 0700;
if($refid eq ''){$refid = 1}
open(ROT,"./system/config.pl");
@rotation = <ROT>;
close(ROT);chomp(@rotation);
open(SYS,"./system/sysstat.pl");
@sys = <SYS>;
close(SYS);chomp(@sys);
$sys[0] = $sys[0] + $rotation[0];
open (LOCK, "./system/sysstat.lock");
@lock = <LOCK>;
close (LOCK);
chomp(@lock);
if ($lock[0]=='1') {
open (LOCK, ">./system/sysstat.lock");
print LOCK "0";
close (LOCK);
$rotation[0]=$rotation[0]+0;
open(SYS,">./system/sysstat.pl");
if ($flock eq "1")
{flock(SYS, 2);}
foreach (@sys){
print SYS "$_\n"}}
close(SYS);
open (LOCK, ">./system/sysstat.lock");
print LOCK "1";
close (LOCK);
open(STAT,">./users/$id/stat.user");
print STAT "$refid\n";
print STAT "$rotation[0]\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
print STAT "0\n";
close(STAT);
open(INFO,">./users/$id/info.user");
print INFO "$in{'pwd'}\n";
print INFO "$in{'mail'}\n";
print INFO "$in{'wmid'}\n";
print INFO "$in{'wmz'}\n";
close(INFO);
open(REF,"./users/$refid/stat.user");
if ($flock eq "1")
{flock(REF, 2);}
@ref1 = <REF>;
close(REF);chomp(@ref1);
$ref1[13]++;
open(REF,">./users/$refid/stat.user");
if ($flock eq "1")
{flock(REF, 2);}
foreach (@ref1){
print REF "$_\n"};
close(REF);
open(REF,"./users/$ref1[0]/stat.user");
if ($flock eq "1")
{flock(REF, 2);}
@ref2 = <REF>;
close(REF);chomp(@ref2);
$ref2[15]++;
open(REF,">./users/$ref1[0]/stat.user");
if ($flock eq "1")
{flock(REF, 2);}
foreach (@ref2){
print REF "$_\n"};
close(REF);
open(REF,"./users/$ref2[0]/stat.user");
if ($flock eq "1")
{flock(REF, 2);}
@ref3 = <REF>;
close(REF);chomp(@ref3);
$ref3[17]++;
open(REF,">./users/$ref2[0]/stat.user");
if ($flock eq "1")
{flock(REF, 2);}
foreach (@ref3){
print REF "$_\n"};
close(REF);
$text=<<d00der;
$tabv
<form action="member.cgi" method="post">
<input type="hidden" name="action" value="stat">
<p align="center"><font color="#000080"><b>Вы успешно зарегистрированы!</b>
</font></p><p align="center"><b><font color="#8E7CCD">Вход в систему</font></b>
</p><div align="center"><center><table border="1" cellpadding="0" cellspacing="0" width="180" bordercolorlight="#C8C0E8">
<tr><td width="70"><b>&nbsp; Логин&nbsp;</b></td><td width="110"><p align="center">
<input size="13" name="user"></p></td></tr><tr><td width="70"><b>&nbsp;
Пароль</b></td><td width="110"><p align="center">
<input type="password" size="13" value name="pwd"></p>
</td></tr><tr><td colspan="2" align="center">
<INPUT alt="Вход" style="background-color: transparent; cursor: hand; height: 18; width: 139; font-size: 10pt; font-weight: bold; color: #8E7CCD; border-style: none; border-width: 2px" type=submit value="В о й т и">
</td></tr></table></center></div><p align="center"><br></p></form>
d00der
reptem($text);
}
}
}else{
}
$text=<<d00der;
$tabv<div align="center"><center>
<table border="0" cellpadding="0" cellspacing="0" width="95%" bgcolor="#FFFFCC" bordercolorlight="#CCCCFF">
<FORM METHOD="POST" ACTION="reg.cgi"><input type="hidden" name="step" value="2">
<input type="hidden" name="refid" value="$in{'refid'}"><table border="0">
<tr><td><font size="2" face="Verdana"><b>Логин</b></font></td><td><input name="user" maxlength=20></td></tr>
<tr><td><font size="2" face="Verdana"><b>Пароль</b></font></td><td><input type="password" name="pwd" maxlength=20></td></tr>
<tr><td><font size="2" face="Verdana"><b>E-mail</b></font></td><td><input name="mail" maxlength=20 size="20" value="$in{'mail'}"</td></tr>
<tr><td><font size="2" face="Verdana"><b>WM-ID</b></font></td><td><input name="wmid" maxlength=20 size="20" value="$in{'wmid'}"></td></tr>
<tr><td><font size="2" face="Verdana"><b>WM-Z</b></font></td><td><input name="wmz" maxlength=20 size="20" value="$in{'wmz'}"></td></tr>
<tr><td><font size="2" face="Verdana"><b>Друг:</b></font></td><td>$in{'refid'}</td></tr>
</center><tr><td colspan="2">
<p align="center"><b><input type="checkbox" name="C1" value="ON" checked> </b><font size="2">С&nbsp;правилами&nbsp; работы&nbsp; согласен.</font><br>
<INPUT alt="Регистрация" style="background-color: transparent; cursor: hand; height: 18; width: 151; font-size: 10pt; font-weight: bold; color: #8E7CCD; border-style: none; border-width: 2px" type=submit value="Р е г и с т р а ц и я">
</p></td></tr></table></form>
d00der
reptem($text);
sub reptem {
my($text) = @_;
open(TEMP, "html.txt");
@TE = <TEMP>;
close TEMP;
$temp = join('',@TE);
$temp =~ s/%PLACE%/$text/;
print "$temp";
exit;
}
спустя 9 минут [обр] Михаил Кюршин aka ya-ya(47/414)[досье]
мне кажется, у вас ошибка на 72 второй строке снизу
спустя 38 минут [обр] Алексей Севрюков(198/1280)[досье]

Михаил Кюршин aka ya-ya[досье] Да нет же, мне кажется что ошибка на строке 571.
MacGrow[досье]
Вот этот шедевр мне понравился:

print STAT "0\n";
...
print STAT "0\n";

P.S. Читайте Минимальный проблемный код

спустя 1 час 58 минут [обр] MacGrow[досье]
:(
Спасибо, что посмеялись над девушкой, которая запуталась...
спустя 34 минуты [обр] Алексей Севрюков(198/1280)[досье]
MacGrow[досье] Вам дали дельный совет. Поймите правильно, никому не хочется за Вас разбираться в Вашем отвратительном коде. Как минимум 3/4 кода ну никак не относятся к проблеме которую Вы описываете. Прочтите внимательно ссылку, которую я Вам выше.
спустя 5 часов [обр] Nuclon(9/19)[досье]

Алексей Севрюков[досье], мне кажется, давно пора ввести элементы фрилансерства на форуме. так сказать, предлагать решить задачу (вне зависимости от отвратильного когда) за какое-то время и деньги. :)
может это людей хоть чему-то научит...

MacGrow[досье], если уж и даёте такой вот объемный кусок кода - обязательно делайте отступы для блоков разной вложенности - это раз (perltidy за вас это сможет сделать автоматически), а второе - это комментарии к коду - какой кусок что делает. или что должен был делать :) ну а вообще в идеале, как вам уже написали, попробуйте указать минимальный код для повторения проблемы.

спустя 7 часов [обр] Роман Чемисов(56/327)[досье]

MacGrow[досье]
Начните с добавления этих двух строчек:

use strict;
use warnings;

Затем пропустите свой код через Perl Tidy.
После этого можете смело проверять все свои операции открытия файлов и записи в них.

P. S. Мне больше всего понравился вот этот фрагмент:

# Проверка на наличие IP в базе блокированных пользователей

open( IPusers, "ipusers.txt" );

@banlist = <IPusers>;
close(IPusers);
( $this1, $this2, $this3, $this4 ) = split( /\./, $ENV{REMOTE_ADDR} );

foreach $banlist (@banlist) {
    
    ( $ip1, $ip2, $ip3, $ip4, $chop ) = split( /\./, $banlist );
    
    if ( $this1 == $ip1 ) {
        
        if ( $this2 == $ip2 ) {
            
            if ( $this3 == $ip3 ) {
                
                if ( $this4 == $ip4 ) {
                    
                    print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"0;URL=$htmlurl/ban.htm\">\n\n";
                }
            }
        }
    }
}
Powered by POEM™ Engine Copyright © 2002-2005