From: Victor Wagner Date: Tue, 18 Mar 2008 21:43:19 +0000 (+0000) Subject: Registration form seems to work X-Git-Url: http://www.wagner.pp.ru/gitweb/?p=oss%2Fstilllife.git;a=commitdiff_plain;h=4a6fbbacea03ccd8fad6564542d9316efffd7b17 Registration form seems to work --- diff --git a/forum/forum b/forum/forum new file mode 100755 index 0000000..cecacc3 --- /dev/null +++ b/forum/forum @@ -0,0 +1,526 @@ +#!/usr/bin/perl -T + +use strict; +use warnings; +use CGI; +use HTML::TreeBuilder; +use Storable qw(freeze thaw); +use Date::Parse; +use Email::Valid; +# +# Набор поддерживаемых действий. Хэш вида +# "имя поля в запросе" => "функция обработчик" +# +my %actions = ( + reply => \&reply, + edit => \&edit_comment, + delete => \&delete_comment, + move => \&move_comment, + newtopic=> \&new_topic, + newforum=> \&new_forum, + login => \&login, + register=>\®ister, + profile=>\&profile, + setrights=>\&set_rights, + openidlogin=>\&openid_login, + openidvfy =>\&openid_verify +); + + + +my $cgi = new CGI; + +my $forum=get_forum_config(); + +print STDERR "Config = $forum\nkeys= ".join(" ",keys %$forum)."\n" ; + +authorize_user($cgi,$forum); +print STDERR "Request method = ".$cgi->request_method()."\n"; +if ($cgi->request_method ne "POST") { +# Запрос к скрипту методом GET. Надо показать форму, если только это не +# редирект от OpenId-сервера + if ($cgi->param('openidvfy')) { + openid_verify($cgi); + } else { + for my $param ($cgi->param) { +# Среди параметров, указанных в URL ищем тот, который задает +# действие + if (exists $actions{$param}) { +# Мы, конечно уже проверили, что в названии параметра +# нехороших символов нет, но чтобы perl в taint mode не +# ругался... + if (allow_operation($param,$cgi,$forum)) { + show_template($1,$cgi,$forum) if $param=~/^(\w+)$/; + exit; + } else { + if (!$forum->{"authenticated"}) { + $cgi->param("returnto",$cgi->uri(-full=>1)); + show_template("login",$cgi,$forum); + exit; + + } else { + show_error($forum,"У Вас нет прав на выполнение этой + операции") + } + } + } + } + show_error($forum,"Некорректный вызов скрипта. Отсутствует параметр + действия"); + } +} else { + # Запрос методом POST. Вызываем обработчик + for my $param ($cgi->param) { + if (exists $actions{$param}) { + print STDERR "Calling $param handler\n"; + $actions{$param}->($param,$cgi,$forum); + exit; + } + } + show_error($forum,"Некорректный вызов скрипта. Отсутствует параметр действия"); +} +# +# Поиск файла .forum вверх по дереву от $ENV{PATH_TRANSLATED} +# Значение PATH_TRANSLATED считаем безопасным - наш web-сервер нам не +# враг. +# Возвращает список имя,значение, имя, значение который прививается в +# хэш + +sub get_forum_config { + my @path=split("/",$1) if $ENV{PATH_TRANSLATED}=~/^(\S+)$/; + while (@path>1) { + pop @path; + if (-r (my $config=join("/",@path,".forum")) ) { + open F,"<",$config; + my %config; + while () { + s/#.*$//; #Drop comments; + $config{$1}=$2 if /(\w+)\s*=\s*(\S.*)$/; + } + close F; + # + # Если в конфиге отсутствует переменная templates, но + # рядом с конфигом присутствует директория templates, + # то шаблоны там. + # + if (! exists $config{"templates"} + && -d (my $filename = join("/",@path,"templates"))) { + print STDERR "get_forum_config: set templates to $filename\n"; + $config{"templates"} = $filename; + } + # + # То же самое - параметр userdir и директория users + # + if (! exists $config{"userdir"} + && -d (my $filename = join("/",@path,"users"))) { + $config{"userdir"} = $filename; + } + # + # Если нет ссылки в конфиге на файл паролей или он не + # существует, выдаем ошибку. С офоромлением, так как шаблоны + # у нас уже есть + if (! exists $config{"passwd"}) { + show_error(\%config,"В конфигурации форума не указан файл пользователей"); + exit; + } + if (!exists $config{"session"}) { + show_error(\%config,"В конфигурации форума не указан файл сессий"); + exit; + } + $config{"authperiod"}="+1m" if (! exists $config{"authperiod"}); + $config{"renewtime"} = "86000" if (!exists $config{"renewtime"}); + return \%config; + } + } + # + # Выводим ошибку 404 без осмысленного оформления, так как данных форума + # мы не нашли + print "Status: 404\nContent-Type: text/html; charset=utf-8\n\n", + "Форум не обнаружен", + "Форум не найден", + "

Хвост URL, указанный при вызове скрипта показывает не на + форум

", + # To make IE think this page is user friendly + "\n"; + exit; +} +# +# Вывод сообщения об ошибке по шаблону форума +# Шаблон должен содержать элемент с классом error. +# +sub show_error { + my ($cfg,$msg) = @_; + if ( -r $cfg->{"templates"}."/error.html") { + my $tree = HTML::TreeBuilder->new_from_file($cfg->{"templates"}."/error.html"); + my $node= $tree->find_by_attribute('class','error'); + my $body; + if (!$node) { + $body = $tree->find_by_tagname('body'); + $body->push_content($node = new + HTML::Element('div','class'=>'error')); + } + $node->delete_content; + $node->push_content($msg); + print $cgi->header(-type=>'text/html',-charset=>'utf-8'); + print $tree->as_HTML("<>&"); + } else { + print STDERR "templates= $cfg->{templates}\n" ; + print $cgi->header(-type=>'text/html',-charset=>'utf-8'); + print "Ошибка конфигурации форума", + "

Ошибка конфигурации форума

", + $cgi->escapeHTML($msg),"

", + "

При обработке этой ошибки не обнаружен шаблон сообщения об ошибке

"; + } +} +# +# Вывод шаблона формы. В шаблоне должна присутстовать форма с +# именем, совпадающим с именем form. Если в $cgi есть параметры, имена +# которых совпадают с именами полей этой формы, их значения +# подставляются +# +sub show_template { + my ($form,$cgi,$forum) = @_; + print STDERR "show_template: form=$form forum=$forum\n"; + my $filename=$forum->{"templates"}."/$form.html"; + if (! -r $filename) { + show_error($forum,"Нет шаблона для операции $form"); + exit; + } + my $tree = HTML::TreeBuilder->new_from_file($filename); + # Находим форму с классом $form + my $f = $tree->look_down("_tag","form", + "name",$form); + if (! defined $f) { + # Если не нашли - ругаемся + show_error($forum,"Шаблон для операции $form не содержит формы с + именем $form"); + exit; + } + if (!$cgi->param("returnto")) { + $cgi->param("returnto", $cgi->referer||$cgi->url(-absolute=>1,-path_info=>1)); + + } + if (!$cgi->param($form)) { + $cgi->param($form,1); + } + # + # Если ранее была выставлена ошибка с помощью set_error, подставляем + # сообщение в элемент с классом error + # + if ($forum->{error_message}) { + my $errormsg = $tree->look_down("class"=>"error"); + if ($errormsg) { + $errormsg->delete_content(); + $errormsg->push_content($forum->{error_message}); + } + } + if ($forum->{"authenticated"}) { + # Подставляем информацию о текущем пользователе если в шаблоне + # это предусмотрено + substitute_user_info($tree,$forum); + } + my %substituted; + for my $element($f->find_by_tag_name("textarea","input","select")) { + my $name = $f->attr("name"); + $substituted{$name} = 1; + if (defined $cgi->param($name)) { + if ($f->tag eq "input") { + if ($f->attr("type") eq "check") { + if (grep($f->attr("value") eq $_,$cgi->param($name))) { + $f->attr("checked",""); + } else { + $f->attr("checked",undef); + } + + } elsif ($f->attr("type") eq + "radio") { + if ($f->attr("value") eq $cgi->param($name)) { + $f->attr("checked",""); + } else { + $f->attr("checked",undef); + } + } else { + $f->attr("value",$cgi->param($name)); + } + } elsif ($f->tag eq "textarea") { + $f->delete_content; + $f->push_content($cgi->param("name")); + } elsif ($f->tag eq "select") { + for my $option ($f->find_by_tag_name("option")) { + if (grep($option->attr("value") eq $_, $cgi-param("name"))) { + $option->attr("selected",""); + } else { + $option->attr("selected",undef); + } + } + + } + } + + } + $f->attr("type","POST"); + $f->attr("action",$cgi->url(-full=>1,-path_info=>1,-query=>0)); + for my $required ($form,"returnto") { + if (!$substituted{$required}) { + my $element = new HTML::Element('input', + 'type' => 'hidden', 'name' => $required, + 'value'=> $cgi->param($required)); + $f->push_content($element); + } + } + + + print + $cgi->header(type=>"text/html",charset=>"utf-8",($forum->{cookies}?(-cookie=>$forum->{cookies}):())), + $tree->as_HTML("<>&"); +} + +# +# Подставляет в заданное поддерево информацию о пользователе +# + +sub substitute_user_info { + +my ($tree,$forum) = @_; +my %userinfo = %{$forum->{"authenticated"}}; + +# +# Специально обрабатываем поля user (должна быть ссылка) и avatar +# (должен быть img). + +my $userlink = $tree->look_down("_tag"=>"a","class"=>"author"); +if ($userlink) { + $userlink->attr(href=>$userinfo{"userpage"}); + $userlink->delete_content(); + $userlink->push_content($userinfo{"user"}); +} +delete $userinfo{"userpage"}; +delete $userinfo{"user"}; +my $avatar = $tree->look_down("_tag"=>"img","class"=>"avatar"); +if ($avatar) { + $avatar->attr(src=>$userinfo{"avatar"}); +} +delete $userinfo{"avatar"}; + +while (my ($field,$value)=each %userinfo) { + my $element = $tree->look_down("class","a".$field); + if ($element) { + $element->delete_content(); + # + # FixME - allow HTML in author attributes + $element->push_content($value); + } + +} + +} +# +# Авторизует зарегистрированного пользователя. +# 1. Проверяет куку если есть +# + +sub authorize_user { + ($cgi,$forum) = @_; + if (my $session=$cgi->cookie("slsession")) { + # Пользователь имеет куку + my %sessbase; + dbmopen %sessbase,$forum->{"session"},0644; + if (exists($sessbase{$session})) { + my ($user,$expires,$ip)=split(";", $sessbase{$session}); + if (!defined $ip|| $ip eq $ENV{'REMOTE_ADDR'}) { + my %userbase; + dbmopen %userbase,$forum->{"passwd"},0644; + if ( exists($userbase{$user})) { + my $userinfo = thaw($userbase{$user}); + delete $userinfo->{"passwd"}; + $userinfo->{"user"} = $user; + if ($expires-time()< $forum->{"renewtime" }) { + delete $sessbase{$session}; + newsession(\%sessbase,$forum,$user,$ip); + } + $forum->{"authenticated"}=$userinfo; + } + dbmclose %userbase; + } + } + dbmclose %sessbase; + } +} + +# +# Создает новую сессию для пользователя и подготавливает куку которую +# сохраняет в хэше конфигурации форума +# +sub newsession { + my ($base,$forum,$user,$bindip) = @_; + if (!defined $base) { + $base = {}; + dbmopen %$base,$forum->{"session"},0644; + } + my $sessname; + my $t = time(); + my ($u,$expires,$ip); + do { + $sessname = sprintf("%08x",rand(0xffffffff)); + if ($base->{"sessname"}) { + ($u,$expires,$ip) = split ";", $base->{$sessname}; + delete $base->{$sessname} if $expires < $t; + } + } while ($base->{$sessname}); + my $cookie = $cgi->cookie(-name=>"slsession", + -expires => $forum->{"authperiod"},-value=> $sessname); + $base->{$sessname}=$user.";".str2time($cookie->expires()). + ($ip?";$ENV{'REMOTE_ADDR'}":""); + + $forum->{'cookie'}=[ $cookie, + $cgi->cookie(-name=>"sluser",-value=>$user,-expires => + $forum->{authperiod})]; +} +# +# Выполняет аутентикацию пользователя по логину и паролю и +# создает для него сессию. +# +sub authenticate { + my ($cgi,$forum) = @_; + if ($cgi->param("openidsite")) { + my $openid_url = sprintf($cgi->param("openidsite",$cgi->param("user"))); + openidstart($cgi,$openid_url); + } + my %userbase; + dbmopen %userbase,$forum->{"passwd"},0644; + my $user = $cgi->param("user"); + if (! $userbase{$user}) { + set_error($forum,"Неверное имя пользователя или пароль"); + return undef; + } + my $userinfo = thaw($userbase{$user}) ; + dbmclose %userbase; + if (crypt($user,$userinfo->{passwd}) eq $userinfo->{passwd}) { + delete $userinfo->{"passwd"}; + $userinfo->{"user"} = $user; + newsession(undef,$forum,$user); + $forum->{"authenticated"} = $userinfo; + } else { + set_error($forum,"Неверное имя пользователя или пароль"); + } +} +# +# Запоминает сообщение об ошибке для последующего вывода show_template +# +sub set_error { + my ($forum,$message) = @_; + $forum->{error_message} = $message; +} +# +# Выводит текущий шаблно с сообщением об ошибке +# +sub form_error { + my ($form_name,$cgi,$forum,$msg) = @_; + set_error($forum,$msg); + show_template($form_name,$cgi,$forum); + exit; +} +# +# Обработка результатов заполнения формы регистрации. +# +# +sub register { + my ($formname,$cgi,$forum) = @_; + # + # Возможные ошибки: + # 1 Такой юзер уже есть + # + # не заполнено поле user + if (!$cgi->param("user")) { + form_error($formname,$cgi,$forum, "Не заполнено имя пользователя"); + } + # или поле password + if (!$cgi->param("pass1")) { + form_error($formname,$cgi,$forum,"Не указан пароль"); + } + # Копии пароля не совпали + if ($cgi->param("pass2") ne $cgi->param("pass1")) { + form_error($formname,$cgi,$forum,"Ошибка при вводе пароля"); + } + my $user = $cgi->param("user"); + # Не указаны поля, перечисленные в скрытом поле required + if ($cgi->param("required")) { + foreach my $field (split(/\s*,\s*/,$cgi->param('required'))) { + if (!$cgi->param($field)) { + form_error($formname,$cgi,$forum,"Не заполнено обязательное поле $field"); + } + } + } + my %userbase; + dbmopen %userbase,$forum->{"passwd"},0644 + or form_error($formname,$cgi,$forum,"Ошибка открытия файла паролей $!"); + if ($userbase{$cgi->param("user")}) { + dbmclose %userbase; + form_error($formname,$cgi,$forum,"Имя пользователя '".$cgi->param("user"). "' уже занято"); + } + if ($cgi->param("email") && ! Email::Valid->address($cgi->param("email"))) { + form_error($formname,$cgi,$forum,"Некорректный E-Mail адрес"); + } + my $saltstring = 'ABCDEFGHIJKLMNOPQRSTUVWXUZabcdefghijklmnopqrstuvwxuz0123456789./'; + my $salt = substr($saltstring,int(rand(64)),1). + substr($altstring,int(rand(64)),1); + my $password=crypt($cgi->param("pass1",$salt)); + my $userinfo = {passwd=>$password}; + # Удаляем лишние поля + $cgi->delete("required"); + $cgi->delete("register"); + $cgi->delete("user"); + $cgi->delete("pass1"); + $cgi->delete("pass2"); + foreach my $field (split(/\s*,\s*/,$cgi->param('ignore'))) { + if (!$cgi->param($field)) { + $cgi->delete($field); + } + } + my $returnto = $cgi->param("returnto"); + $cgi->delete("returnto"); + # Если есть аватар в файле, то сохраняем этот файл и формируем URL + # на него. + if ($cgi->param("avatarfile" )) { + my $f = $cgi->upload("avatarfile"); + binmode $f,":bytes"; + my $out; + my $filename = $1 if $cgi->param("avatarfile")=~/([^\/\\]+)$/; + open $out,">",$forum->{"userdir"}."/".$filename; + binmode $out,":bytes"; + my $buffer; + while (my $bytes = read($f,$buffer,4096)) { + print $out $buffer; + } + close $f; + close $out; + $userinfo->{'avatar'}= $forum->{"userurl"}."/".$filename; + $cgi->delete("avatar"); + $cgi->delete("avatarfile"); + } + + foreach my $param ($cgi->param) { + $userinfo->{$param} = $cgi->param($param); + } + $userinfo->{registered} = time; + if (exists $forum->{default_status}) { + $userinfo->{status} = $forum->{default_status}; + } + print STDERR "registering user $user\n"; + $userbase{$user} = freeze($userinfo); + dbmclose %userbase; + newsession(undef,$forum,$user); + if (defined $returnto) { + forum_redirect($returnto) + } else { + forum_redirect($cgi->url(-base=>1).$ENV{PATH_INFO}); + } + +} + +sub allow_operation { + my ($operation,$cgi,$forum) = @_; + return 1 if (grep $operation eq $_,"register","login","reply"); + + return 1; +}