From 84f3d2ff0f9e887c82ce68e44a469bb4ea12a987 Mon Sep 17 00:00:00 2001 From: safir Date: Sun, 7 Dec 2008 12:14:28 +0000 Subject: [PATCH] =?utf8?q?=D0=98=D1=81=D0=BF=D1=80=D0=B0=D0=B2=D0=B8=D0=BB?= =?utf8?q?=20=D0=BF=D1=80=D0=BE=D0=B1=D0=BB=D0=B5=D0=BC=D1=83=20=D1=81=20?= =?utf8?q?=D0=B0=D0=B2=D1=82=D0=BE=D0=BC=D0=B0=D1=82=D0=B8=D1=87=D0=B5?= =?utf8?q?=D1=81=D0=BA=D0=B8=D0=BC=20=D1=81=D0=BE=D0=B7=D0=B4=D0=B0=D0=BD?= =?utf8?q?=D0=B8=D0=B5=D0=BC=20=D0=BF=D1=80=D0=B8=20=D0=B5=D0=B3=D0=BE=20?= =?utf8?q?=D0=BE=D1=82=D0=BA=D1=80=D1=8B=D1=82=D0=B8=D0=B8,=20=D0=B5=D1=81?= =?utf8?q?=D0=BB=D0=B8=20=D1=84=D0=B0=D0=B9=D0=BB=20=D0=B4=D0=BE=20=D1=8D?= =?utf8?q?=D1=82=D0=BE=D0=B3=D0=BE=20=D0=BD=D0=B5=20=D1=81=D1=83=D1=89?= =?utf8?q?=D0=B5=D1=81=D1=82=D0=B2=D0=BE=D0=B2=D0=B0=D0=BB.=20=D0=A0=D0=B5?= =?utf8?q?=D0=B0=D0=BB=D0=B8=D0=B7=D0=BE=D0=B2=D0=B0=D0=BD=D0=BE=20=D0=B7?= =?utf8?q?=D0=B0=D0=BC=D0=B5=D0=BD=D0=BE=D0=B9=20"open"=20=D0=BD=D0=B0=20"?= =?utf8?q?sysopen"=20=D1=81=20=D1=84=D0=BB=D0=B0=D0=B3=D0=BE=D0=BC=20O=5FC?= =?utf8?q?REATE.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- forum/forum | 698 ++++++++++++++++++++++++++-------------------------- 1 file changed, 349 insertions(+), 349 deletions(-) diff --git a/forum/forum b/forum/forum index a1d6137..8e43e56 100755 --- a/forum/forum +++ b/forum/forum @@ -1,16 +1,16 @@ #!/usr/bin/perl -T # -# Stil Life forum. Copyright (c) by Victor B. Wagner, 2008 +# Stil Life forum. Copyright (c) by Victor B. Wagner, 2008 # This program distributed under GNU Affero General Public License v3 or # above # http://www.gnu.org/licenses/agpl.html # # Вкратце: Если вы используете этот скрипт на своем сайте, Вы обязаны # сделать доступным его исходный текст. В частности, если Вы внесли -# какие-либо изменения, вы должны эти изменения опубликовать. -# +# какие-либо изменения, вы должны эти изменения опубликовать. +# # Home site of this program http://vitus.wagner.pp.ru/stilllife -# +# use strict; use warnings; use Carp; @@ -26,7 +26,7 @@ use POSIX; use LWP::UserAgent; use Net::OpenID::Consumer; # -# Набор поддерживаемых действий. Хэш вида +# Набор поддерживаемых действий. Хэш вида # "имя поля в запросе" => "функция обработчик" # my @actions = ( @@ -43,7 +43,7 @@ my @actions = ( {name=>"profile",POST=>\&profile,GET=>\&show_profile,rights=>"normal"}, {name=>"setrights",POST=>\&set_rights,GET=>\&show_rights,rights=>"admin"}, {name=>"reapply",POST=>\&apply_templates,GET=>\&apply_templates,rights=>"admin"} -); +); # our $path_translated; # Untainted value of PATH_TRANSLATED env var my $cgi = new CGI; @@ -57,28 +57,28 @@ for my $action (@actions) { if ($cgi->param($action->{name})) { if (allow_operation($action,$cgi,$forum)) { $action->{$method}->($action->{name},$cgi,$forum); - } elsif (!$forum->{"authenticated"}) { + } elsif (!$forum->{"authenticated"}) { $cgi->param("returnto",$cgi->url(-full=>1)); show_template("login",$cgi,$forum); } else { show_error($forum,"У Вас нет прав на выполнение этой операции") } } -} +} if (index($path_translated,$forum->{userdir})==0) { show_user_page($cgi,$forum); -} +} show_error($forum,"Некорректный вызов скрипта. Отсутствует параметр действия"); - -#-------------------------------------------------------------- + +#-------------------------------------------------------------- #-------- Чтение конфигурационного файла и связанные с этим действия -#------------------------------------------------------------------ +#------------------------------------------------------------------ # # Преобразование пути в файловой системе сервера в путь в URL -# +# sub dir2url { my ($cgi,$dir) = @_; my $prefix=""; @@ -93,7 +93,7 @@ sub dir2url { алгоритм преобразования директори в URL\n". "PATH_INFO=$ENV{PATH_INFO}\n". "PATH_TRANSLATER=$ENV{'PATH_TRANSLATED'}"); - } + } my $root = substr($ENV{'PATH_TRANSLATED'},0,$pos); if (substr($dir,0,length($root)) ne $root) { show_error({},"Ошибка конфигурации форума. Не удается преобразовать @@ -104,7 +104,7 @@ sub dir2url { return $prefix.substr($dir,length($root)); } # -# Поиск файла .forum вверх по дереву от $path_translated +# Поиск файла .forum вверх по дереву от $path_translated # Значение PATH_TRANSLATED считаем безопасным - наш web-сервер нам не # враг. # Возвращает список имя,значение, имя, значение который прививается в @@ -121,51 +121,51 @@ sub get_forum_config { while () { s/#.*$//; #Drop comments; $config{$1}=$2 if /(\w+)\s*=\s*(\S.*)$/; - } + } close F; # # Переменная forumtop - это URL того места, где находится # файл .forum - + $config{"forumtop"} = dir2url($cgi,join("/",@path)); $config{"forumroot"} = join("/",@path); # Если в конфиге отсутствует переменная templates, но # рядом с конфигом присутствует директория templates, # то шаблоны там. # - if (! exists $config{"templates"} + if (! exists $config{"templates"} && -d (my $filename = join("/",@path,"templates"))) { $config{"templates"} = $filename; - } + } $config{"templatesurl"} = dir2url($cgi,$config{"templates"}) unless exists $config{"templatesurl"}; - # + # # То же самое - параметр userdir и директория users # - if (! exists $config{"userdir"} + if (! exists $config{"userdir"} && -d (my $filename = join("/",@path,"users"))) { $config{"userdir"} = $filename; - } + } $config{"userurl"} = dir2url($cgi,$config{"userdir"}); # - # Если нет ссылки в конфиге на файл паролей или он не + # Если нет ссылки в конфиге на файл паролей или он не # существует, выдаем ошибку. С офоромлением, так как шаблоны # у нас уже есть if (!exists $config{"datadir"}) { show_error(\%config,"В конфигурации форума не указана - директория данных "); + директория данных "); exit; } if (!-d $config{"datadir"}) { - show_error(\%config,"В конфигурации форума указана несуществующая директория данных "); + show_error(\%config,"В конфигурации форума указана несуществующая директория данных "); exit; } # # Некоторые умолчания # - $config{"authperiod"}="+1M" if (! exists $config{"authperiod"}); + $config{"authperiod"}="+1M" if (! exists $config{"authperiod"}); $config{"renewtime"} = "86000" if (!exists $config{"renewtime"}); $config{"replies_per_page"} = 50 if (!exists $config{"replies_per_page"}); $config{"indexfile"} = "index.html" if (!exists $config{"indexfile"}); @@ -182,7 +182,7 @@ sub get_forum_config { "

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

", # To make IE think this page is user friendly - "\n"; + "\n"; exit; } # @@ -209,19 +209,19 @@ sub show_error { print "Ошибка конфигурации форума", "

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

", escapeHTML($msg),"

", - "

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

"; + "

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

"; } exit; -} +} # -# Вывод шаблона формы. В шаблоне должна присутстовать форма с +# Вывод шаблона формы. В шаблоне должна присутстовать форма с # именем, совпадающим с именем form. Если в $cgi есть параметры, имена # которых совпадают с именами полей этой формы, их значения # подставляются # sub show_template { - my $tree = prepare_template(@_); + my $tree = prepare_template(@_); send_to_user($tree,@_); exit; } @@ -231,8 +231,8 @@ sub send_to_user { $cgi->header(-type=>"text/html",-charset=>"utf-8",($forum->{cookies}?(-cookie=>$forum->{cookies}):())), output_html($tree); exit; -} -sub prepare_template { +} +sub prepare_template { my ($form,$cgi,$forum) = @_; my $tree = gettemplate($forum,$form,$ENV{'PATH_INFO'}); @@ -249,11 +249,11 @@ sub prepare_template { 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 # @@ -263,11 +263,11 @@ sub prepare_template { $errormsg->delete_content(); $errormsg->push_content($forum->{error_message}); } - } + } if ($forum->{"authenticated"}) { - + # Подставляем информацию о текущем пользователе если в шаблоне - # это предусмотрено + # это предусмотрено substitute_user_info($tree,$forum); $cgi->param("user",$forum->{"authenticated"}{"user"}) if (!defined $cgi->param("user")) } @@ -280,14 +280,14 @@ sub prepare_template { if ($element->tag eq "input") { my $type=$element->attr('type') || "text"; next ELEMENT if grep($type eq $_, - "button","submit","reset"); + "button","submit","reset"); if ($type eq "check") { if (grep($element->attr("value") eq $_,$cgi->param($name))) { $element->attr("checked",""); } else { $element->attr("checked",undef); } - + } elsif ($type eq "radio") { if ($element->attr("value") eq $cgi->param($name)) { @@ -295,7 +295,7 @@ sub prepare_template { } else { $element->attr("checked",undef); } - } else { + } else { $element->attr("value",$cgi->param($name)); } } elsif ($element->tag eq "textarea") { @@ -305,10 +305,10 @@ sub prepare_template { $cgi->param($name."_format","bbcode"); my $parser = HTML::BBReverse->new(); $data = $parser->reverse($1); - # FIXME elsif ($data=~/

) + # FIXME elsif ($data=~/

) } else { $cgi->param($name."_format","html"); - } + } } $element->delete_content; @@ -319,9 +319,9 @@ sub prepare_template { $option->as_text(); if (grep($value eq $_, $cgi->param($name))) { $option->attr("selected","selected"); - } else { + } else { $option->attr("selected",undef); - } + } } } @@ -336,9 +336,9 @@ sub prepare_template { 'value'=> $cgi->param($required)); $f->push_content($element); } - } + } return $tree; -} +} # # Поправляет ссылки на служебные файлы и скрипты форума # @@ -347,7 +347,7 @@ sub fix_forum_links { if (!defined $path_info) { $path_info = $ENV{PATH_INFO}; $path_info =~ s/\/+/\//g; - } + } my $script_with_path = $ENV{SCRIPT_NAME}.$path_info; ELEMENT: for my $element ($tree->find_by_tag_name("form","img","link","script","a")) { @@ -359,30 +359,30 @@ sub fix_forum_links { } else { $attr ="src"; } - + # Обрабатываем наши специальные link rel="" my $userlist = $cgi->url(-absolute=>1, -path_info=>0,-query_string=>0).$forum->{userurl}; if ($element->tag eq "link") { if ($element->attr("rel") eq "forum-user-list") { $element->attr("href" => $userlist); - next ELEMENT; + next ELEMENT; } elsif ($element->attr("rel") eq "forum-script") { $element->attr("href" => $script_with_path); next ELEMENT; - } + } } my $link = $element->attr($attr); - # Абсолютная ссылка - оставляем как есть. + # Абсолютная ссылка - оставляем как есть. next ELEMENT if (! defined $link || $link=~/^\w+:/ || $link - eq"."||$link eq ".."); - # Ссылка от корня сайта. + eq"."||$link eq ".."); + # Ссылка от корня сайта. if (substr($link,0,1) eq "/") { # Если там два слэша, заменяем их на forumtop if (substr($link,0,2) eq '//') { $element->attr($attr, $forum->{forumtop}.substr($link,1)); next ELEMENT; - } + } # Если она не ведет на наш скрипт, не обрабатываем next ELEMENT if substr($link,0,length($ENV{SCRIPT_NAME}) ne $ENV{SCRIPT_NAME}) ; @@ -393,11 +393,11 @@ sub fix_forum_links { if (!($link =~ s!^templates/!$forum->{templatesurl}/!) && !($link =~ s!^users/!$userlist/!) && !($link =~ s!^forum\b!$script_with_path!)) { - $link = $forum->{"forumtop"}."/".$link - } + $link = $forum->{"forumtop"}."/".$link + } $element->attr($attr,$link); } -} +} sub makeuserlink { my ($forum,$tree,$linkclass,$userinfo) = @_; @@ -407,10 +407,10 @@ sub makeuserlink { } else { $userpage = $cgi->url(-absolute=>1).$forum->{"userurl"}."/".$cgi->escape($userinfo->{"user"}); - } + } substinfo($tree,["_tag"=>"a","class"=>$linkclass], href=>$userpage,_content=>$userinfo->{"user"}); -} +} # # Подставляет в заданное поддерево информацию о пользователе # @@ -423,34 +423,34 @@ if (defined $user) { %userinfo=%$user; } else { # Если не сказано, какой юзер, то текущий. - %userinfo = %{$forum->{"authenticated"}} + %userinfo = %{$forum->{"authenticated"}} } # -# Специально обрабатываем поля user (должна быть ссылка) и avatar +# Специально обрабатываем поля user (должна быть ссылка) и avatar # (должен быть img). makeuserlink($forum,$tree,"author",\%userinfo); delete $userinfo{"user"}; if (ref $userinfo{"avatar"} eq "HASH") { substinfo($tree,["_tag"=>"img","class"=>"avatar"], %{$userinfo{'avatar'}}); - } elsif ($userinfo{'avatar'}) { + } elsif ($userinfo{'avatar'}) { substinfo($tree,["_tag"=>"img","class"=>"avatar"], src=>$userinfo{"avatar"}); } else { substinfo($tree,["_tag"=>"img","class"=>"avatar"], src=>$forum->{templatesurl}."/1x1.gif", width=>1,height=>1); - } + } for my $element ( $tree->look_down("class",qr/^ap-/)) { - my $field=$1 if $element->attr("class")=~/^ap-(.*)$/; + my $field=$1 if $element->attr("class")=~/^ap-(.*)$/; $element->delete_content(); $field =~ tr/-/_/; $userinfo{$field} = 0 if (!exists $userinfo{$field} && grep ($field eq $_,"forums","messages","topics")); if (exists $userinfo{$field}) { - + my $data; if ($field eq "registered" || substr($field,0,5) eq "last_") { $data = strftime("%d.%m.%Y %H:%M",localtime($userinfo{$field})) @@ -460,10 +460,10 @@ if (defined $user) { $data = $userinfo{$field} } $element->push_content($data); - $element->attr(href=>"mailto:$userinfo{$field}") + $element->attr(href=>"mailto:$userinfo{$field}") if ($element->tag eq "a" && $field eq "email"); - } - } + } + } } @@ -476,7 +476,7 @@ sub authorize_user { my ($cgi,$forum) = @_; if (my $session=$cgi->cookie("slsession")) { # Пользователь имеет куку - my %sessbase; + my %sessbase; dbmopen %sessbase,datafile($forum,"session"),0644; if ($sessbase{$session}) { my ($user,$expires,$ip)=split(";", $sessbase{$session}); @@ -486,7 +486,7 @@ sub authorize_user { clear_user_cookies($cgi,$forum); show_error($forum,"Некорректная пользовательская сессия"); exit; - } + } if (!defined $ip|| $ip eq $ENV{'REMOTE_ADDR'}) { my %userbase; dbmopen %userbase,datafile($forum,"passwd"),0644; @@ -502,9 +502,9 @@ sub authorize_user { $forum->{"authenticated"}=$userinfo; print STDERR "authorize_user: ",$forum->{authenticated}{user}, $forum->{authenticated},"\n"; - } - dbmclose %userbase; - } + } + dbmclose %userbase; + } } else { clear_user_cookies($cgi,$forum); show_error($forum,"Некорректная пользовательская сессия"); @@ -514,23 +514,23 @@ sub authorize_user { } } # -# Возвращает путь к файлу в директории +# Возвращает путь к файлу в директории # sub datafile { my ($forum,$filename) = @_; return $forum->{"datadir"}."/".$filename; -} +} # # Создает новую сессию для пользователя и подготавливает куку которую # сохраняет в хэше конфигурации форума -# +# sub newsession { my ($base,$forum,$user,$bindip) = @_; if (!defined $base) { $base = {}; dbmopen %$base,datafile($forum,"session"),0644; - } + } my $sessname; my $t = time(); my ($u,$expires,$ip); @@ -544,24 +544,24 @@ sub newsession { my $cookie = $cgi->cookie(-name=>"slsession", -expires => $forum->{"authperiod"},-value=> $sessname); my $username = $user; - $username =~ s/^http:\/\///; #Remoove http:// from OpenID user names + $username =~ s/^http:\/\///; #Remoove http:// from OpenID user names $base->{$sessname}=$username.";".str2time($cookie->expires()). ($ip?";$ENV{'REMOTE_ADDR'}":""); - + $forum->{'cookies'}=[ $cookie, $cgi->cookie(-name=>"sluser",-value=>$user,-expires => - $forum->{authperiod})]; + $forum->{authperiod})]; } # -# Выполняет аутентикацию пользователя по логину и паролю и +# Выполняет аутентикацию пользователя по логину и паролю и # создает для него сессию. # sub authenticate { - my ($cgi,$forum) = @_; + my ($cgi,$forum) = @_; if ($cgi->param("openidsite")) { my $openid_url = sprintf($cgi->param("openidsite"),$cgi->param("user")); openidstart($cgi,$forum,$openid_url); - } + } my %userbase; dbmopen %userbase,datafile($forum,"passwd"),0644; my $user = $cgi->param("user"); @@ -570,27 +570,27 @@ sub authenticate { if (! $userbase{$user}) { set_error($forum,"Неверное имя пользователя или пароль"); return undef; - } + } my $userinfo = thaw($userbase{$user}) ; dbmclose %userbase; #while (my ($key,$val)=each %$userinfo) { print STDERR "$key => '$val'\n";} - if (defined $forum->{denied_status} && $userinfo->{status} eq + if (defined $forum->{denied_status} && $userinfo->{status} eq $forum->{denied_status}) { set_error($forum,"Вход пользователя $user в систему заблокирован"); return undef; - } + } if (crypt($password,$userinfo->{passwd}) eq $userinfo->{passwd}) { delete $userinfo->{"passwd"}; $cgi->delete("password"); $userinfo->{"user"} = $user; newsession(undef,$forum,$user); - $forum->{"authenticated"} = $userinfo; + $forum->{"authenticated"} = $userinfo; print STDERR "User $user authenticated successfully\n"; return 1; } else { set_error($forum,"Неверное имя пользователя или пароль"); return undef; - } + } } # # Запоминает сообщение об ошибке для последующего вывода show_template @@ -599,7 +599,7 @@ sub set_error { my ($forum,$message) = @_; print STDERR "set_error: $message\n"; $forum->{error_message} = $message; -} +} # # Выводит текущий шаблон с сообщением об ошибке # @@ -608,7 +608,7 @@ sub form_error { set_error($forum,$msg); show_template($form_name,$cgi,$forum); exit; -} +} # # Выполняет редирект (возможно, с установкой куков) на страницу, # указанную # третьем параметре функции или в параметре CGI-запроса @@ -627,13 +627,13 @@ sub forum_redirect { $url = $cgi->url(-base=>1).$url if substr($url,0,1) eq "/"; print $cgi->redirect(-url=>$url, ($forum->{cookies}?(-cookie=>$forum->{cookies}):())); - exit; + exit; } # # Заполнение формы редактирования профиля данными пользователя sub show_profile { - my ($formname,$cgi,$forum) = @_; + my ($formname,$cgi,$forum) = @_; my $rights = getrights($cgi,$forum); my $user = $cgi->param("user"); if (!$user && substr($path_translated,length($forum->{userdir}) eq @@ -641,26 +641,26 @@ sub show_profile { $user = substr($path_translated,length($forum->{userdir})+1); } $user = $forum->{authenticated}{user} unless $user; - show_error($forum,"Чей профиль вы хотите редактировать?") - unless $user; + show_error($forum,"Чей профиль вы хотите редактировать?") + unless $user; my %base; dbmopen %base,datafile($forum,"passwd"),0664; - show_error($forum,"Нет такого пользователя $user") + show_error($forum,"Нет такого пользователя $user") unless $base{$user}; my $userinfo = thaw($base{$user}); - dbmclose(%base); + dbmclose(%base); delete $userinfo->{passwd}; $userinfo->{user}=$user; - while(my ($field,$value) = each %$userinfo) { + while(my ($field,$value) = each %$userinfo) { $value = $value->{src} if ($field eq 'avatar' && ref($value)); if ($value =~/^<(div|p)\b/) { my $tree = str2tree($value); tree2input($cgi,$field,$tree); $tree->delete; - } else { + } else { $cgi->param($field,$value); } - } + } my $tree = prepare_template(@_); # Запрещаем редактирование полей, входящих в restricted_user_info my $form = $tree->look_down(_tag=>"form",name=>"profile"); @@ -672,7 +672,7 @@ sub show_profile { if ($tag eq 'input') { my $newel=new HTML::Element("span", "class"=>"restricted-field"); - + $newel->push_content($element->attr("value")); $element->replace_with($newel)->delete(); } elsif ($tag eq 'textarea') { @@ -683,7 +683,7 @@ sub show_profile { class=>"restricted-field"); OPTION: for my $option ($element->content_list) { - if (ref $option eq "HTML::Element" && + if (ref $option eq "HTML::Element" && $option->attr("selected")) { $newel->push_content($option->detach_content()); last OPTION; @@ -691,11 +691,11 @@ sub show_profile { } if (!$newel->content_list) { $newel->push_content(($element->content_list)[0]); - } + } $element->replace_with($newel)->delete; - } + } } - } + } } # Подставляем аватарку substinfo($tree,[_tag=>'img',class=>'avatar'],(ref($userinfo->{avatar})?(%{$userinfo->{avatar}}):(src=>$userinfo->{avatar}))); @@ -708,13 +708,13 @@ sub show_profile { $userlink->attr('href'=>undef); $userlink->tag('span'); } - } + } send_to_user($tree,@_); } # Обработка результатов редактирования профиля пользвателя # sub profile { - my ($formname,$cgi,$forum) = @_; + my ($formname,$cgi,$forum) = @_; if (!$cgi->param("user")) { show_error($forum,"В форме нет имени пользователя"); } @@ -740,8 +740,8 @@ sub profile { $userinfo->{passwd}=crypt_password($cgi->param('pass1')); } else { form_error($formname,$cgi,$forum,"Ошибка при вводе пароля"); - } - } + } + } make_profile($formname,$cgi,$forum,$userinfo,$rights eq "admin"); delete $userinfo->{user}; $base{$user} = freeze $userinfo; @@ -753,35 +753,35 @@ sub profile { # # sub register { - my ($formname,$cgi,$forum) = @_; + my ($formname,$cgi,$forum) = @_; # - # Возможные ошибки: + # Возможные ошибки: # 1 Такой юзер уже есть # - # не заполнено поле user + # не заполнено поле user if (!$cgi->param("user")) { form_error($formname,$cgi,$forum, "Не заполнено имя пользователя"); - } - # или поле password + } + # или поле 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")) { + # Не указаны поля, перечисленные в скрытом поле required + if ($cgi->param("required")) { foreach my $field (split(/\s*,\s*/,$cgi->param('required'))) { if (!$cgi->param($field)) { form_error($formname,$cgi,$forum,"Не заполнено обязательное поле $field"); } - } + } } $cgi->delete("required"); my %userbase; - dbmopen %userbase,datafile($forum,"passwd"),0644 + dbmopen %userbase,datafile($forum,"passwd"),0644 or form_error($formname,$cgi,$forum,"Ошибка открытия файла паролей $!"); if ($userbase{$cgi->param("user")}) { dbmclose %userbase; @@ -795,15 +795,15 @@ sub register { $userbase{$user} = freeze($userinfo); dbmclose %userbase; if (!defined $forum->{denied_status} || $userinfo->{status} ne - $forum->{denied_status}) { + $forum->{denied_status}) { newsession(undef,$forum,$user); - forum_redirect($cgi,$forum,$cgi->param("returnto")); + forum_redirect($cgi,$forum,$cgi->param("returnto")); } else { # FIXME Email validation # Email to admin show_template("newuser",$cgi,$forum); } -} +} sub make_profile { my ($formname,$cgi,$forum,$userinfo,$isadmin) =@_; # Удаляем лишние поля @@ -811,7 +811,7 @@ sub make_profile { if (!$cgi->param($field)) { $cgi->delete($field); } - } + } if ($cgi->param("email") && ! Email::Valid->address($cgi->param("email"))) { form_error($formname,$cgi,$forum,"Некорректный E-Mail адрес"); } @@ -825,7 +825,7 @@ sub make_profile { $cgi->delete("pass1"); $cgi->delete("pass2"); if ($cgi->param("avatarfile" )) { - my $filename = + my $filename = (save_attached_images($cgi,$forum,$forum->{userdir},"${userprefix}_%f", "avatarfile"))[1]; my $path = $forum->{"userdir"}."/".$filename; @@ -833,10 +833,10 @@ sub make_profile { $userinfo->{'avatar'}= {src=>$forum->{"userurl"}."/".$userprefix."_".$filename, width=>$w,height=>$h}; } elsif ($cgi->param('avatar')) { - if (!ref($userinfo->{'avatar'}) || + if (!ref($userinfo->{'avatar'}) || $userinfo->{avatar}{'src'} ne $cgi->param('avatar')) { $userinfo->{avatar}=get_avatar_info($cgi->param('avatar')); - } + } } my @restrict=(); @restrict = split /\s*,\s*/, $forum->{restricted_user_info} @@ -855,7 +855,7 @@ sub make_profile { $tree->delete(); } else { delete $userinfo->{$param}; - } + } } else { $userinfo->{$param} = $cgi->param($param); } @@ -866,22 +866,22 @@ sub crypt_password { my $saltstring = 'ABCDEFGHIJKLMNOPQRSTUVWXUZabcdefghijklmnopqrstuvwxuz0123456789./'; my $salt = substr($saltstring,int(rand(64)),1). substr($saltstring,int(rand(64)),1); - my $password=crypt($open_password,$salt); + my $password=crypt($open_password,$salt); return $password; -} +} sub set_default_user_attrs { my ($forum,$userinfo) = @_; while (my($key,$val) = each %$forum) { next unless $key =~ /^default_(.*)$/; $userinfo->{$1} = $val; - } + } } sub show_user_page { my ($cgi,$forum) = @_; my $rights; - $rights=getrights($cgi,$forum) if ($forum->{authenticated}); + $rights=getrights($cgi,$forum) if ($forum->{authenticated}); my %base; my $tree; dbmopen %base,datafile($forum,"passwd"),0664; @@ -898,8 +898,8 @@ sub show_user_page { $userinfo->{"user"} = $user; substitute_user_info($block,$forum,$userinfo); profile_links($block,$user,$rights,$cgi,$forum); - } - $usertpl->delete; + } + $usertpl->delete; } else { my $user = substr($path_translated,length($forum->{userdir})+1); if (!$base{$user}) { @@ -916,9 +916,9 @@ sub show_user_page { for my $userlink ($tree->look_down(_tag => "a",class=>"author")) { $userlink->attr("href",undef); $userlink->tag("span"); - } + } } - } + } my $page = output_html($tree); my $length = do {use bytes; length($page);}; print $cgi->header(-type=>"text/html",-content_length=>$length, @@ -929,27 +929,27 @@ sub profile_links { my ($tree,$user,$rights,$cgi,$forum)=@_; foreach my $profile_link ($tree->look_down(_tag=>"a", href=>qr/profile=/)) { - if ((defined $rights && $rights eq "admin")|| + if ((defined $rights && $rights eq "admin")|| (defined $forum->{authenticated}{user} && $forum->{authenticated}{user} eq $user)) { $profile_link->attr("href", $ENV{'SCRIPT_NAME'}.$forum->{userurl}. "/".$user."?profile=1"); - } else { + } else { $profile_link->delete(); - } - } + } + } } sub clear_user_cookies { my ($cgi,$forum) = @_; $forum->{cookies}=[ $cgi->cookie(-name=>"sluser", -value=>"0", -expires=>"-1m"),$cgi->cookie(-name=>"slsession", -value=>"0", -expires => "-1m")]; -} +} # # Обработчик формы логина. Сводится к вызову функции authenticate, -# поскольку мы поддерживаем логин одновременный с отправкой реплики. +# поскольку мы поддерживаем логин одновременный с отправкой реплики. # sub login { my ($form,$cgi,$forum)=@_; @@ -957,8 +957,8 @@ sub login { forum_redirect($cgi,$forum); } else { show_template(@_); - } -} + } +} # # Обработчик формы logout. В отличие от большинства обработчиков форм, # поддерживает обработку методом GET @@ -973,40 +973,40 @@ sub logout { dbmclose %sessiondb; } forum_redirect($cgi,$forum); -} +} sub allow_operation { my ($operation,$cgi,$forum) = @_; - return 1 if (!exists($operation->{rights})); + return 1 if (!exists($operation->{rights})); if (!$forum->{authenticated}) { return 1 if ($operation->{rights} eq "login"); return 0; - } + } my $user = $forum->{authenticated}{user} ; my $accesslevel=getrights($cgi,$forum); - + return 1 if ($accesslevel eq "admin"); - return 0 if ($operation->{rights} eq "admin"); + return 0 if ($operation->{rights} eq "admin"); return 1 if ($accesslevel eq "moderator"); - return 0 if $accesslevel eq "banned"; + return 0 if $accesslevel eq "banned"; return 1; } sub reply { my ($form,$cgi,$forum) = @_; if (! exists $forum->{authenticated} ) { - form_error($form,$cgi,$forum,"Вы не зарегистрировались") if (!authenticate($cgi,$forum)); + form_error($form,$cgi,$forum,"Вы не зарегистрировались") if (!authenticate($cgi,$forum)); } # # Находим файл дискуссии, в который надо поместить реплику # - my ($tree,$lockfd)=gettree($path_translated); + my ($tree,$lockfd)=gettree($path_translated); my $newmsg = newlistelement($tree,"message","messagelist"); if (!$newmsg) { show_error($forum,"Шаблон темы не содержит элемента с классом message"); - } - - # + } + + # # Генерируем идентификатор записи. # my $id = "m".get_uid($forum); @@ -1030,14 +1030,14 @@ sub reply { # fix_image_links($cgi,$txtree,\%attached,$dir); # - # Подставляем данные сообщения + # Подставляем данные сообщения # $newmsg->attr("id"=>$id); substinfo($newmsg,[class=>"subject"],_content=>$cgi->param("subject")); my $textnode=$newmsg->look_down("class"=>"mtext"); if (!$textnode) { - show_error($forum,"В шаблоне реплики нет места для текста"); - } + show_error($forum,"В шаблоне реплики нет места для текста"); + } $textnode->delete_content(); $textnode->push_content($txtree); if ($forum->{authenticated}{signature}) { @@ -1073,19 +1073,19 @@ sub reply { # подставляем mparent my $parent_id=$cgi->param("id"); if ($parent_id) { - substinfo($newmsg,[_tag => "a",class=>"mparent"], + substinfo($newmsg,[_tag => "a",class=>"mparent"], "href"=>$cgi->path_info."#$parent_id",style=>undef); } else { - substinfo($newmsg,[_tag => "a",class=>"mparent"], + substinfo($newmsg,[_tag => "a",class=>"mparent"], style=>"display: none;"); - } + } my $msgcount=0; for my $msg ($newmsg->parent->look_down("class"=>"message")) { $msgcount ++; - } - + } + # - # Делаем Уфф и сохраняем то, что получилось + # Делаем Уфф и сохраняем то, что получилось # $newmsg = $newmsg->clone; savetree($path_translated,$tree,$lockfd); @@ -1093,19 +1093,19 @@ sub reply { record_statistics($forum,"message"), update_topic_list($forum,$path_translated,$msgcount,$posted); forum_redirect($cgi,$forum,$cgi->path_info."#$id"); -} +} sub fix_image_links { my ($cgi,$txtree,$attached,$dir) =@_; for my $image ($txtree->find_by_tag_name("img")) { my $file=lc($image->attr("src")); if ( exists $attached->{$file}) { $image->attr("src" => dir2url($cgi,$dir)."/".$attached->{$file}); - my ($width,$height) = imgsize($dir ."/".$attached->{$file}); + my ($width,$height) = imgsize($dir ."/".$attached->{$file}); $image->attr("width" =>$width); $image->attr("height" => $height); - } - } -} + } + } +} sub save_attached_images { my ($cgi,$forum,$dir,$nametemplate,@params) = @_; my %attached; @@ -1121,7 +1121,7 @@ sub save_attached_images { if (!$in) { show_error($forum,"Ошибка при загрузке картинки $filename"); exit; - } + } my $out; open $out,">$dir/$attached{$filename}"; binmode $out,":bytes"; @@ -1171,18 +1171,18 @@ sub record_as_recent { for (my $i=$#msgs;$i>=$forum->{replies_per_page}-1;$i--) { $msgs[$i]->delete; } - } - $msgs[0]->preinsert($msg); + } + $msgs[0]->preinsert($msg); } } else { my $old_copy = $msglist->look_down(id=>$msg->attr("id")); if ($old_copy) { $old_copy->replace_with($msg)->delete; - } + } } } savetree($forum->{forumroot}."/recent.html",$tree,$lockfd); -} +} sub getperms { my $dir = shift; local $_; @@ -1197,7 +1197,7 @@ sub getperms { } else { $users{$key} .= $_ if ($key); } - } + } close F; } return %users; @@ -1208,7 +1208,7 @@ sub getperms { sub gettitle { our $gettitle_flag=0; our $gettitle_text=""; - + open F,"<",shift or return undef; my $parser = HTML::Parser->new(api_version=>3, text_h=>[sub { $gettitle_text .= @@ -1219,13 +1219,13 @@ our $gettitle_text=""; my $data; read F,$data,4096; $parser->parse($data) or last; - } + } return $gettitle_text; } # # Показ формы реактирования прав -# +# sub show_rights { my ($form,$cgi,$forum) = @_; @@ -1239,15 +1239,15 @@ sub show_rights { # Пробегаемся вверх по дереву hide_list($tree,"dirlist"); - if ($path_translated ne $forum->{forumroot}) { + if ($path_translated ne $forum->{forumroot}) { my $d = $path_translated; my @dirs; while ($d) { - # и получаем список файлов perms.txt + # и получаем список файлов perms.txt $d=~s/\/[^\/]+$//; unshift @dirs,$d if -f "$d/perms.txt"; last if $d eq $forum->{forumroot}; - + } # Подставляем их куда надо for $d (@dirs) { @@ -1256,21 +1256,21 @@ sub show_rights { my $item = newlistelement($tree,"dir","dirlist"); substinfo($item,[_tag => 'a',class=>'dirlink'], href=>$d,_content=>$title); - + substinfo($item,[_tag=>'a',class=>'rights'], href=>$cgi->url(-absolute=>1,-path_info=>0).dir2url($cgi,$d)."?setrights=1"); while (my ($key,$val) = each %users) { my @data = map {$_=>new HTML::Element("br")} split /\r?\n/, $val; substinfo($item,[class=>$key],_content=>\@data); - } - } + } + } } my $f = $tree->look_down(_tag=>'form',name=>'setrights'); substinfo($f,[_tag=>'a',class=>'dirlink'], href=>$cgi->path_info, _content=>gettitle($path_translated."/".$forum->{indexfile})); # Отдаем юзеру. - send_to_user($tree,@_); + send_to_user($tree,@_); } sub set_rights { @@ -1285,11 +1285,11 @@ sub set_rights { if (replacefile($path_translated."/perms.txt",$newperm)) { set_error($forum,"Списки модераторов раздела обновлены"); } - show_rights(@_); + show_rights(@_); } # -# Обработка операции создания новой темы. +# Обработка операции создания новой темы. # sub new_topic { @@ -1300,32 +1300,32 @@ sub new_topic { my $urlname; if (!$cgi->param("urlname")) { $urlname = get_uid($forum); - } else { + } else { $urlname=$1 if $cgi->param("urlname") =~ /^([-\w]+)$/; form_error($form,$cgi,$forum,"Некорректные символы в urlname. - Допустимы только латинские буквы, цифры и минус") unless $urlname; + Допустимы только латинские буквы, цифры и минус") unless $urlname; } if (!-d $path_translated && $path_translated=~s/^(.+)\/+[^\/]+$/$1/ && !-d $path_translated) { show_error($forum,"Операция $form может быть вызвана только со страницы форума"); - } + } my $filename = "$path_translated/$urlname.html"; if (-f $filename) { form_error($form,$cgi,$forum,"Тема с urlname $urlname уже существует"); - } + } my $url = $cgi->path_info."/$urlname.html"; $url =~ s/\/+/\//g; if (!$cgi->param("title")) { form_error($form,$cgi,$forum,"Тема должна иметь непустое название"); - } + } # # Создаем собственно тему # my $tree = gettemplate($forum,"topic",$url); - # Заполнить название и аннотацию + # Заполнить название и аннотацию my $abstract = input2tree($cgi,$forum,"abstract"); substinfo($tree,[_tag=>"meta","name"=>"description"],content=>$abstract->as_trimmed_text) if $abstract; substinfo($tree,[_tag=>"title"],_content=>$cgi->param("title")); @@ -1339,11 +1339,11 @@ sub new_topic { # Вставляем в страницу КОПИЮ аннотации, поскольку аннотация # нам еще понадобится в списке тем. substinfo($subtree,["class"=>"abstract"],_content=>$abstract->clone) if $abstract; - substitute_user_info($subtree,$forum); + substitute_user_info($subtree,$forum); } else { substinfo($tree,["class"=>"title"], _content=>$cgi->param("title")); - } + } # Скрыть список сообщений. hide_list($tree,"messagelist"); savetree($filename,$tree,undef); @@ -1358,8 +1358,8 @@ sub new_topic { substinfo($newtopic,[_tag=>"a","class"=>"title"], _content=>$cgi->param("title"), href=>"$urlname.html"); substinfo($newtopic,["class"=>"date"], _content=>$creation_time); - substinfo($newtopic,["class"=>"abstract"],_content=>$abstract); - substitute_user_info($newtopic,$forum); + substinfo($newtopic,["class"=>"abstract"],_content=>$abstract); + substitute_user_info($newtopic,$forum); $newtopic->attr("id",$urlname); my $controlform = $newtopic->look_down(_tag=>"form",class=>"topicinfo"); if ($controlform) { @@ -1367,7 +1367,7 @@ sub new_topic { -query_string=>0).$url); substinfo($controlform,[_tag=>"input",name=>"author"],value=> $forum->{authenticated}{user}); - } + } update_topic_list($forum,$newtopic,0,$creation_time); savetree($path_translated."/".$forum->{"indexfile"},$tree,$lockfd); record_statistics($forum,"topic"); @@ -1382,26 +1382,26 @@ sub new_forum { my $urlname; if (!$cgi->param("urlname")) { form_error($form,$cgi,$forum,"Форуму необходимо задать непустое urlname"); - } + } if ($cgi->param("urlname") eq ".") { $urlname = "." - } else { + } else { $urlname=$1 if $cgi->param("urlname") =~ /^([-\w]+)$/ ; form_error($form,$cgi,$forum,"Некорректные символы в urlname. - Допустимы только латинские буквы, цифры и минус") unless $urlname; + Допустимы только латинские буквы, цифры и минус") unless $urlname; } if (!-d $path_translated && $path_translated=~s/^(.+)\/+[^\/]+$/$1/ && !-d $path_translated) { show_error($forum,"Операция $form может быть вызвана только со страницы форума"); - } + } my $newname = "$path_translated/$urlname"; - $newname=$path_translated if ($urlname eq "."); + $newname=$path_translated if ($urlname eq "."); my $filename = "$newname/$forum->{indexfile}"; if (-f $filename) { form_error($form,$cgi,$forum,"Форум $urlname уже существует"); - } + } if (!$cgi->param("title")) { form_error($form,$cgi,$forum,"Форум должен иметь непустое название"); } @@ -1417,13 +1417,13 @@ sub new_forum { $logo_name = $forum->{"templatesurl"}."/1x1.gif"; $logo_width = 1; $logo_height=1; - } + } # # Создаем собственно оглавление форума # - + my $url = $cgi->path_info."/$urlname"; $url= $cgi->path_info if $urlname eq "."; $url =~ s/\/+/\//g; @@ -1432,9 +1432,9 @@ sub new_forum { if ($urlname ne ".") { for my $element ($tree->look_down("class"=>"top-page")) { $element->delete; - } + } } - # Заполнить название и аннотацию + # Заполнить название и аннотацию my $abstract = input2tree($cgi,$forum,"abstract"); substinfo($tree,[_tag=>"meta","name"=>"description"],content=>$abstract->as_trimmed_text) if $abstract; substinfo($tree,[_tag=>"title"],_content=>$cgi->param("title")); @@ -1448,7 +1448,7 @@ sub new_forum { # Вставляем в страницу КОПИЮ аннотации, поскольку аннотация # нам еще понадобится в списке тем. substinfo($subtree,["class"=>"abstract"],_content=>$abstract->clone) if $abstract; - substitute_user_info($subtree,$forum); + substitute_user_info($subtree,$forum); substinfo($subtree,[_tag=>"img","class"=>"logo"], src=> $logo_name, width=>$logo_width, height=>$logo_height); # Скрыть списки подфорумов и тем . @@ -1458,7 +1458,7 @@ sub new_forum { for my $link_up ($tree->look_down(_tag=>"a",href=>"..")) { $link_up->delete; } - } + } savetree($filename,$tree,undef); $tree->destroy; # @@ -1471,10 +1471,10 @@ sub new_forum { substinfo($newforum,[_tag=>"a","class"=>"title"], _content=>$cgi->param("title"), href=>"$urlname/"); substinfo($newforum,["class"=>"date"], _content=>$creation_time); - substinfo($newforum,["class"=>"abstract"],_content=>$abstract); + substinfo($newforum,["class"=>"abstract"],_content=>$abstract); substinfo($newforum,[_tag=>"img","class"=>"logo"],src=>"$urlname/$logo_name", width=>$logo_width,height=>$logo_height); - substitute_user_info($newforum,$forum); + substitute_user_info($newforum,$forum); $newforum->attr("id",$urlname); my $controlform = $newforum->look_down(_tag=>"form",class=>"foruminfo"); if ($controlform) { @@ -1482,16 +1482,16 @@ sub new_forum { $url); substinfo($controlform,[_tag=>"input",name=>"author"],value=> $forum->{authenticated}{user}); - } + } savetree($path_translated."/".$forum->{"indexfile"},$tree,$lockfd); record_statistics($forum,"forum"); } else { # Создаем тему для "свежих реплик" - my $recent = gettemplate($forum,"topic",$url."/recent.html"); + my $recent = gettemplate($forum,"topic",$url."/recent.html"); # remove reply link from page itself for my $link ($recent->look_down(_tag =>"a", href=>qr/reply=/)) { $link->delete; - } + } substinfo($recent,["_tag"=>"title"],$cgi->param("title").": Свежие сообщения"); substinfo($recent,["class"=>"title"], _content=>$cgi->param("title"). ": Свежие сообщения"); @@ -1508,8 +1508,8 @@ sub new_forum { # # Параметры $cgi,$forum, тип => ссылка на функцию ... # где тип - message, topic или forum. Определяет обрабатываемый объект -# и вызывает соответствующую фунцкию. Ожидает что функция завершится -#вызовом exit. +# и вызывает соответствующую фунцкию. Ожидает что функция завершится +#вызовом exit. sub dispatch_objtype { my $cgi=shift; my $forum = shift; @@ -1519,11 +1519,11 @@ sub dispatch_objtype { $actions{"message"}->($cgi,$forum,$path_translated,$cgi->param("id")) if exists($actions{'message'}); } else { - $actions{topic}->($cgi,$forum,$path_translated) + $actions{topic}->($cgi,$forum,$path_translated) if exists($actions{'topic'}); - } + } } elsif (-d $path_translated && -f $path_translated ."/". $forum->{indexfile}) { - $actions{'forum'}->($cgi,$forum,$path_translated) + $actions{'forum'}->($cgi,$forum,$path_translated) if exists($actions{'forum'}); } @@ -1533,16 +1533,16 @@ sub dispatch_objtype { sub delete_item { my ($formname,$cgi,$forum) = @_; # - # Сначала разберемся, что мы собственно удаляем + # Сначала разберемся, что мы собственно удаляем # if ($cgi->param("user")) { delete_user($cgi,$forum,$cgi->param("user")); - } + } dispatch_objtype($cgi,$forum,topic=>\&delete_topic, message=>\&delete_comment, forum=>\&delete_forum); show_error($forum,"Невозможно удалить неопознанный объект"); -} +} # Показ формы редактирования sub show_editable { my ($formname,$cgi,$forum) = @_; @@ -1550,7 +1550,7 @@ sub show_editable { topic=>\&show_topicedit, forum=>\&show_forumedit); show_error($forum,"Невозможно редактировать неопознанный объект"); -} +} # Применение результатов редактирования sub edit_item { my ($formname,$cgi,$forum) = @_; @@ -1558,7 +1558,7 @@ sub edit_item { topic=>\&topicedit, forum=>\&forumedit); show_error($forum,"Невозможно редактировать неопознанный объект"); -} +} sub move_item { my ($formname,$cgi,$forum) = @_; dispatch_objtype($cgi,$forum,"message"=>\&move_message, @@ -1573,7 +1573,7 @@ sub show_move_dest { forum=>\&show_move_forum); show_error($forum,"Невозможно переместить неопознанный объект"); } -# +# # Удаление пользователя # sub delete_user { @@ -1581,18 +1581,18 @@ sub delete_user { if ($forum->{authenticated}{user} ne $user && getrights($cgi,$forum) ne "admin") { show_error($forum,"У вас недостаточно прав для удаления - пользователя $user"); - } + пользователя $user"); + } my %base; dbmopen %base,datafile($forum,"passwd"),0644; delete $base{$user}; dbmclose %base; forum_redirect($cgi,$forum,$forum->{forumtop}); -} +} # Проверка прав на изменение реплики sub moderator_or_author { my ($cgi,$forum,$msg)=@_; - return 1 if getrights($cgi,$forum) eq "moderator" + return 1 if getrights($cgi,$forum) eq "moderator" || getrights($cgi,$forum) eq "admin"; my $author= $msg->look_down(_tag=>"input",name=>"author"); if ($author) { @@ -1602,7 +1602,7 @@ sub moderator_or_author { } else { return undef; } -} +} # # Удаление реплики # @@ -1612,14 +1612,14 @@ sub delete_comment { my ($msg) = $tree->look_down(id => $id); show_error($forum,"В данной теме нет реплики с id=$id") if (!$msg); show_error($forum,"У вас нет прав на удаление этого сообщения") - unless moderator_or_author($cgi,$forum,$msg); + unless moderator_or_author($cgi,$forum,$msg); delete_from_list($tree,"messagelist","message",$msg); savetree($topic,$tree,$lockfd); $tree->delete; ($tree,$lockfd) = gettree($forum->{forumroot}."/recent.html"); ($msg) = $tree->look_down(id => $id); if ($msg) { - delete_from_list($tree,"messagelist","message",$msg); + delete_from_list($tree,"messagelist","message",$msg); savetree($forum->{forumroot}."/recent.html",$tree,$lockfd); } else { discardtree($tree,$lockfd); @@ -1627,16 +1627,16 @@ sub delete_comment { # Если у реплики были картинки, то их тоже надо грохнуть for my $pic (<$id."_*.*">) { unlink $pic; - } + } forum_redirect($cgi,$forum,$cgi->path_info); -} +} # # Удаление темы # sub delete_topic { my ($cgi,$forum,$topic) = @_; # Если модератор, то в тему и не заглядываем - my ($dir,$id) = ($1,$2) if $topic=~/^(.*)\/([^\/]+).html$/; + my ($dir,$id) = ($1,$2) if $topic=~/^(.*)\/([^\/]+).html$/; show_error($forum,"Неверное имя темы $topic") unless ($dir && $id); if (getrights($cgi,$forum) ne "moderator" && getrights($cgi,$forum) ne "admin") { @@ -1650,9 +1650,9 @@ sub delete_topic { $info = $tree->look_down(class=>"messagelist"); if ($info->attr("style") !~ /display: none;/) { show_error($forum,"Невозможно удалить тему, содержащую сообщения"); - } + } discardtree($tree,$lockfd); - } # FIXME при удалении непустой темы модератором почистить recent.html + } # FIXME при удалении непустой темы модератором почистить recent.html my ($tree,$lockfd) = gettree($dir . "/".$forum->{indexfile}); delete_from_list($tree,"topiclist","topic",$id); savetree($dir ."/".$forum->{indexfile},$tree); @@ -1669,7 +1669,7 @@ sub delete_forum { if (getrights($cgi,$forum) ne "moderator" && getrights($cgi,$forum) ne "admin") { show_error($forum,"У вас нет права удалять форумы"); - } + } opendir DIR,$dir; my $count = 0; while ( my $entry=readdir DIR) { @@ -1678,8 +1678,8 @@ sub delete_forum { next if $entry =~ /^logo.[^.]+/; show_error($forum,"Нельзя удалять корень форума" ) if $entry eq ".forum"; - $count ++; - } + $count ++; + } closedir DIR; show_error($forum,"Нельзя удалять непустой форум") if $count; # Находим родительский форум @@ -1694,13 +1694,13 @@ sub delete_forum { opendir DIR,$dir; for my $entry ( readdir DIR) { unlink "$dir/$entry"; - } + } rmdir $dir; my $redirect_url = $cgi->path_info; $redirect_url =~s/\/$//; $redirect_url =~ s/\/[^\/]*$//; - forum_redirect($cgi,$forum,$redirect_url); -} + forum_redirect($cgi,$forum,$redirect_url); +} # Показ сообщения для редактирования sub show_messageedit { my ($cgi,$forum,$path,$id)=@_; @@ -1709,8 +1709,8 @@ sub show_messageedit { $dirname =~ s/\/[^\/]+$//; my ($msg) = $tree->look_down(id => $id); show_error($forum,"В данной теме нет реплики с id=$id") if (!$msg); - show_error($forum,"У вас нет прав на редактированиее этого сообщения") - unless moderator_or_author($cgi,$forum,$msg); + show_error($forum,"У вас нет прав на редактированиее этого сообщения") + unless moderator_or_author($cgi,$forum,$msg); # Выбираем данные сообщения my ($text) = $msg->look_down(class=>"mtext")->content_list; my ($subject) = $msg->look_down(class=>"subject"); @@ -1722,7 +1722,7 @@ sub show_messageedit { # Подставляем информацию о картинках. opendir D,$dirname; while ( my $filename=readdir D) { - next unless $filename =~/^${id}_/; + next unless $filename =~/^${id}_/; my $pic = "$dirname/$filename"; my $picitem = newlistelement($form,"picture","picturelist"); my ($w,$h) = imgsize($pic); @@ -1733,7 +1733,7 @@ sub show_messageedit { substinfo($picitem,[class=>"filename"],_content =>$filename); } closedir D; - send_to_user($form,"edit_message",$cgi,$forum); + send_to_user($form,"edit_message",$cgi,$forum); } # Показ темы для редактирования sub show_topicedit { @@ -1743,8 +1743,8 @@ sub show_topicedit { $dirname =~ s/\/([^\/]+).html$//; my $urlname=$1; my $topic = $tree->look_down("class"=>"topic"); - show_error($forum,"У вас нет прав на редактированиее этой темы") - unless moderator_or_author($cgi,$forum,$topic); + show_error($forum,"У вас нет прав на редактированиее этой темы") + unless moderator_or_author($cgi,$forum,$topic); # Выбираем данные сообщения my ($text) = $topic->look_down(class=>"abstract")->content_list; my ($subject) = $topic->look_down(class=>"title"); @@ -1760,9 +1760,9 @@ sub show_topicedit { # Показ форума для редактирования sub show_forumedit { my ($cgi,$forum,$path) = @_; - show_error($forum,"У вас нет прав на редактированиее этого форума") + show_error($forum,"У вас нет прав на редактированиее этого форума") unless (getrights($cgi,$forum) eq 'moderator' || getrights($cgi,$forum) eq - 'admin'); + 'admin'); my ($tree,$lockfd) = gettree($path."/".$forum->{indexfile}); my $dirname = $path; @@ -1798,26 +1798,26 @@ sub show_forumedit { unless ($logo) { substinfo($form,[class=>"picture"], style=>"display: none;"); - } + } send_to_user($form,"edit_forum",$cgi,$form); -} +} sub messageedit { my ($cgi,$forum,$topic,$id) = @_; my ($tree,$lockfd) = gettree($path_translated); my ($msg) = $tree->look_down(id=>$id); show_error($forum,"В данной теме нет реплики с id=$id") if (!$msg); - show_error($forum,"У вас нет прав на редактированиее этого сообщения") - unless moderator_or_author($cgi,$forum,$msg); + show_error($forum,"У вас нет прав на редактированиее этого сообщения") + unless moderator_or_author($cgi,$forum,$msg); # Обработка картинок my ($dirname,$topic_id)=($1,$2) if $path_translated=~/(.+)\/([^\/]+).html/; # 1. Удаляем помеченные как таковые for my $file ($cgi->param("delpictire")) { unlink $dirname."/".$file; - } + } # 2. Сохраняем свежеприаттаченные my %attached=save_attached_images($cgi,$forum,$dirname,"${id}_%f",grep(/^image\d+/,$cgi->param)); - + # Преобразуем текст в html my $txtree = input2tree($cgi,$forum,"text"); fix_image_links($cgi,$txtree,\%attached,$dirname); @@ -1825,7 +1825,7 @@ sub messageedit { substinfo($msg,[class=>"subject"],_content=>$cgi->param("subject")); substinfo($msg,[class=>"editdate"],_content=>$edited); makeuserlink($forum,$msg,"editor",$forum->{authenticated}); - unhide_list($msg,"edited"); + unhide_list($msg,"edited"); my $textnode = $msg->look_down(class=>"mtext"); my ($old_text)=$textnode->splice_content(0,1,$txtree); $old_text->delete; @@ -1843,10 +1843,10 @@ sub topicedit { my ($cgi,$forum,$topic) = @_; show_error($forum,"Нет такой темы ".$cgi->path_info) if (!-f $path_translated); - show_error($forum,"У вас нет прав на редактированиее этой темы") - unless moderator_or_author($cgi,$forum,$topic); + show_error($forum,"У вас нет прав на редактированиее этой темы") + unless moderator_or_author($cgi,$forum,$topic); form_error("edit_topic",$cgi,$forum,"Тема должна иметь непустое название") - if (!$cgi->param("title")); + if (!$cgi->param("title")); my $abstract = input2tree($cgi,$forum,"abstract"); my ($tree,$lockfd) = gettree($path_translated); my $subtree = $tree->look_down("class"=>"topic"); @@ -1859,7 +1859,7 @@ sub topicedit { } else { substinfo($tree,["class"=>"title"], _content=>$cgi->param("title")); - } + } savetree($path_translated,$tree,$lockfd); $tree->destroy; my ($dir,$id) = ($1,$2) if $path_translated=~/^(.*)\/([^\/]+).html$/; @@ -1867,21 +1867,21 @@ sub topicedit { my $item = $tree->look_down(id=>$id); substinfo($item,[_tag=>"a","class"=>"title"], _content=>$cgi->param("title")); - substinfo($item,["class"=>"abstract"],_content=>$abstract); + substinfo($item,["class"=>"abstract"],_content=>$abstract); savetree($dir."/".$forum->{"indexfile"},$tree,$lockfd); forum_redirect($cgi,$forum); } sub forumedit { my ($cgi,$forum,$dir) = @_; - show_error($forum,"У вас нет прав на редактированиее этого форума") + show_error($forum,"У вас нет прав на редактированиее этого форума") unless (getrights($cgi,$forum) eq 'moderator' || getrights($cgi,$forum) eq - 'admin'); + 'admin'); if (!-d $path_translated) { show_error($forum,"Операция редактирования форумаможет быть вызвана только со страницы форума"); - } + } if (!$cgi->param("title")) { form_error("edit_forum",$cgi,$forum,"Форум должен иметь непустое название"); } @@ -1892,7 +1892,7 @@ sub forumedit { $logo_name = $forum->{"templatesurl"}."/1x1.gif"; $logo_width = 1; $logo_height=1; - } + } if ($cgi->param("logo")) { # Удаляем все, что похоже на логотип opendir D, $path_translated; @@ -1904,7 +1904,7 @@ sub forumedit { $logo_name=(save_attached_images($cgi,$forum,$path_translated,"logo.%e","logo"))[1]; ($logo_width,$logo_height) = imgsize("$path_translated/$logo_name"); } - my ($tree,$lockfd) = gettree($path_translated . "/".$forum->{indexfile}); + my ($tree,$lockfd) = gettree($path_translated . "/".$forum->{indexfile}); my $abstract = input2tree($cgi,$forum,"abstract"); substinfo($tree,[_tag=>"meta","name"=>"description"],content=>$abstract->as_trimmed_text) if $abstract; substinfo($tree,[_tag=>"title"],_content=>$cgi->param("title")); @@ -1915,17 +1915,17 @@ sub forumedit { # нам еще понадобится в списке тем. substinfo($subtree,["class"=>"abstract"],_content=>$abstract->clone) if $abstract; substinfo($subtree,[_tag=>"img","class"=>"logo"], - src=> $logo_name, width=>$logo_width, height=>$logo_height) + src=> $logo_name, width=>$logo_width, height=>$logo_height) if defined($logo_name); savetree($path_translated ."/".$forum->{indexfile},$tree,$lockfd); $tree->destroy; if ($path_translated ne $forum->{forumroot}) { my ($updir,$id) = ($1,$2) if $path_translated=~/^(.*)\/([^\/]+)$/; - ($tree,$lockfd) = gettree($updir . "/".$forum->{indexfile}); + ($tree,$lockfd) = gettree($updir . "/".$forum->{indexfile}); my $item = $tree->look_down(id=>$id); - substinfo($item,[_tag=>"a","class"=>"title"], + substinfo($item,[_tag=>"a","class"=>"title"], _content=>$cgi->param("title")); - substinfo($item,["class"=>"abstract"],_content=>$abstract); + substinfo($item,["class"=>"abstract"],_content=>$abstract); substinfo($item,[_tag=>"img","class"=>"logo"],src=>"$id/$logo_name", width=>$logo_width,height=>$logo_height) if $logo_name; savetree($updir."/".$forum->{"indexfile"},$tree,$lockfd); @@ -1933,11 +1933,11 @@ sub forumedit { forum_redirect($cgi,$forum); } -#---------------------------------------------------------- +#---------------------------------------------------------- # База пользователей и права доступа #---------------------------------------------------------- # -# Записывает в базу данных пользователей, сколько каких объектов +# Записывает в базу данных пользователей, сколько каких объектов # создал текущий пользователь # sub record_statistics { @@ -1960,8 +1960,8 @@ sub getrights { my ($cgi,$forum) = @_; if (!$forum->{authenticated}) { return undef; - } - return $forum->{authenticated}{rights} if + } + return $forum->{authenticated}{rights} if exists $forum->{authenticated}{rights}; my $user = $forum->{authenticated}{user}; my $dir = $path_translated; @@ -1970,7 +1970,7 @@ sub getrights { my $f; my $user_status = "normal"; LEVEL: - while (length($dir)) { + while (length($dir)) { if (-f "$dir/perms.txt") { open $f,"<","$dir/perms.txt"; my $status = undef; @@ -1982,23 +1982,23 @@ sub getrights { if ($user eq $_ && defined $status) { if ($status eq "banned") { return $forum->{authenticated}{rights}=$status; - } + } if ($status eq "admins" ) { return $forum->{authenticated}{rights}="admin"; } $user_status = "moderator"; } - } + } } close $f; last LEVEL if -f "$dir/.forum"; - } + } # Strip last path component. - $dir =~s/\/[^\/]+$// - } + $dir =~s/\/[^\/]+$// + } return $forum->{authenticated}{rights}=$user_status; -} +} @@ -2017,7 +2017,7 @@ sub gettree { flock $f, LOCK_EX; my $tree = treefromfile($f); return ($tree,$f); -} +} # # Сохранить дерево и закрыть lockfd. # @@ -2025,26 +2025,26 @@ sub gettree { sub replacefile { my $filename = shift; my $content = shift; - my $f; + my $f; open $f,">",$filename . ".new" or return undef; print $f $content; close $f; # FIXME - только для POSIX. unlink $filename; rename $filename.".new",$filename; -} +} sub savetree { my ($filename,$tree,$lockfd) = @_; replacefile($filename,output_html($tree)); close $lockfd if defined($lockfd); -} +} sub discardtree { my ($tree,$lockfd) = @_; flock $lockfd,LOCK_UN; close $lockfd; $tree->delete; -} +} # # Cериализовать HTML-документ с DOCTYPE (workaround вокруг баги в # HTML::TreeBuilder) @@ -2055,7 +2055,7 @@ sub output_html { confess "Tree is not HTML::TreeBuilder" unless ref($tree) eq "HTML::TreeBuilder"; return ''. $tree->as_HTML("<>&"); -} +} # # Читает шаблон и подготавливает его к размещению по указанной URL. # Если url не указана, считается что шаблон будет показан как результат @@ -2072,7 +2072,7 @@ sub gettemplate { my $tree = treefromfile($filename); fix_forum_links($forum,$tree,$url); return $tree; -} +} # # Создает объект HTML::TreeBuilder и выставляет ряд опций. @@ -2081,29 +2081,29 @@ sub gettemplate { sub make_tree { my $tree = HTML::TreeBuilder->new; # Set some options for treebuilder - # Comments are neccessary to convert HTML back to BBCode + # Comments are neccessary to convert HTML back to BBCode $tree->store_comments(1); # Avoid converting html into one long-long string $tree->ignore_ignorable_whitespace(0); $tree->no_space_compacting(1); $tree->p_strict(1); return $tree; -} +} sub treefromfile { my ($f) = shift; my $tree = make_tree(); $tree->parse_file($f); return $tree; -} +} # # Получает уникальный числовой идентификатор. -# +# sub get_uid { my $forum = shift; my $f; - open $f,"+<",datafile($forum,"sequence") or - flock $f,LOCK_EX; + (sysopen $f, datafile($forum,"sequence"), O_RDWR | O_CREAT, 0644) or + flock $f,LOCK_EX; my $id=<$f> || "0"; $id++; seek $f,0,0; @@ -2122,12 +2122,12 @@ sub create_openid_consumer { args => $cgi, consumer_secret=>"X9RWPo0rBE7yLja6VB3d", required_root => $cgi->url(-base=>1)); -} +} # openidstart - вызывается когда обнаружено что текущее имя # пользователя, пытающегося аутентифицироваться, содержит http:// -# +# # sub openidstart { @@ -2140,7 +2140,7 @@ sub openidstart { my $csr = create_openid_consumer($cgi,$forum); my $claimed_identity=$csr->claimed_identity($openidurl); if (!defined $claimed_identity) { - show_error($forum,"Указанная URL $openidurl не является OpenId"); + show_error($forum,"Указанная URL $openidurl не является OpenId"); exit; } $cgi->param("openidvfy",1); @@ -2152,12 +2152,12 @@ sub openidstart { trust_root=> $cgi->url(-base=>1)); print $cgi->redirect(-location=>$check_url); exit; -} +} # # Вызывается при редиректе от openid producer-а. Проверяет, что # удаленный сервер подтвердил openid и вызывает операцию для которой # (либо возврат на исходную страницу при операции login, либо постинг -# реплики) +# реплики) # sub openid_verify { my ($action,$cgi,$forum) = @_; @@ -2170,23 +2170,23 @@ sub openid_verify { идентичность"); exit; } elsif (my $vident = $csr->verified_identity) { - #Успешная аутентификация. + #Успешная аутентификация. #Создаем сессию - my $user = $vident->url; + my $user = $vident->url; # Remove trailing slash from URL if any $user=~s/\/$//; my %userbase; dbmopen %userbase,datafile($forum,"passwd"),0664; - my $username = $user; + my $username = $user; $username =~ s/^http:\/\///; if (!$userbase{$username}) { # Тащим foaf, если получится my %info=get_foaf($csr->ua,$vident->declared_foaf); if (ref($info{'avatar'}) eq "HASH" ) { delete $info{'avatar'}{'type'}; - } + } $info{"openiduser"}=1; - $info{"registered"}=time; + $info{"registered"}=time; set_default_user_attrs($forum,\%info); $info{'status'} = $forum->{openid_status} if $forum->{openid_status}; $forum->{authenticated}=\%info; @@ -2195,27 +2195,27 @@ sub openid_verify { $forum->{authenticated} = thaw ($userbase{$username}); } dbmclose %userbase; - if (defined $forum->{denied_status} && + if (defined $forum->{denied_status} && ($forum->{authenticated}{status} eq $forum->{denied_status})) { - show_error($forum,"Вход пользователя $username в систему заблокирован"); - } + show_error($forum,"Вход пользователя $username в систему заблокирован"); + } $forum->{"authenticated"}{"user"} = $username; newsession(undef,$forum,$user); # Если указан параметр reply, вызываем обработку реплики - if ($cgi->param("reply")) { + if ($cgi->param("reply")) { reply("reply",$cgi,$forum); exit; - } + } #Иначе, возвращаемся на исходную страницу forum_redirect($cgi,$forum,undef); } else { show_error($forum,"Ошибка OpenId аутентификации"); exit; - } + } } sub get_avatar_info { - my ($url,$ua) = @_; + my ($url,$ua) = @_; $ua = LWP::UserAgent->new( agent => "Stilllife/1.0") unless $ua; my $response = $ua->get($url); if ($response->is_success) { @@ -2225,21 +2225,21 @@ sub get_avatar_info { } else { print STDERR "Error getting $url: ".$response->status_line,"\n"; return undef; - } + } } sub get_foaf { - my ($ua,$foaf_url) = @_; + my ($ua,$foaf_url) = @_; my $response = $ua->get($foaf_url); unless ($response->is_success) { print STDERR "Error geting foaf from $foaf_url\n"; return (); - } + } my $foaf = $response->content; my %info = foaf_parse($foaf); if ($info{avatar}) { $info{avatar} = get_avatar_info($info{avatar},$ua); - } + } return %info; } @@ -2268,25 +2268,25 @@ sub input2tree { my $text = $cgi->param($field_name); return "" if (!$text); if ($format eq "bbcode") { - my $parser = HTML::BBReverse->new(); + my $parser = HTML::BBReverse->new(); $text="

".$parser->parse($text)."
"; } elsif ($format eq "text") { $text = escapeHTML($text); $text=~s/\r?\n\r?\n/<\/p>

/sg; $text=~s/\r?\n/
/sg; $text = "

$text

"; - } + } my $txtree = str2tree($text); for my $badtag ("script","style","head","html","object","embed","iframe","frameset","frame", ($forum->{forbid_tags}?split(/\s*,\s*/,$forum->{forbid_tags}):())) { for my $element ($txtree->find_by_tag_name($badtag)) { $element->delete() if defined $element; - } - } + } + } # FIXME Проверяем на наличие URL-ок не оформленных ссылками. return $txtree; -} +} sub tree2input { @@ -2312,7 +2312,7 @@ sub str2tree { $element->detach; $tree->destroy; return $element; -} +} sub tree2str { my ($tree)=@_; @@ -2322,9 +2322,9 @@ sub tree2str { #------------------------------------------------------------------------ # Подстановка в дереве #------------------------------------------------------------------------ -# Находит +# Находит # элемент указанного класса и удаляет display: none из его атрибута -# style. Возвращает 1, если элемент был раскрыт, и 0, если он и до этого +# style. Возвращает 1, если элемент был раскрыт, и 0, если он и до этого # был видимым. sub unhide_list { my ($tree,$class) = @_; @@ -2336,9 +2336,9 @@ sub unhide_list { return 1; } else { return 0; - } - } -} + } + } +} # # Находит первый элемент указанного класса, и приписывает ему display: # none в style. @@ -2353,42 +2353,42 @@ sub hide_list { my $style = $msglist->attr("style"); unless ($style=~ s/\bdisplay:\s+\w+\s*;/display: none;/) { $style .= "display: none;"; - } + } $msglist->attr("style",$style); - } + } return 1; -} +} # # Удаляет из списка элемент, если он не последий. Если последний - -# скрывает весь список. Элемент можно указывать как ссылкой на объект -# HTML::Element, так и значением атрибута id +# скрывает весь список. Элемент можно указывать как ссылкой на объект +# HTML::Element, так и значением атрибута id # sub delete_from_list { my ($tree,$listclass,$itemclass,$item) = @_; my $list = $tree->look_down(class =>$listclass); ($item) = $list->look_down(id =>$item) unless ref($item); return undef unless $item; - my (@items)=$tree->look_down(class=>$itemclass); + my (@items)=$tree->look_down(class=>$itemclass); if (@items == 1) { hide_list($tree,$listclass); } else { $item->delete; } return 1; -} +} # # Найти все элементы, удоволетворяющие заданному критерию и подставить в # них указанные атрибуты -# +# # Параметры 1. Дерево (класса HTML::Element) -# 2. Запрос - ссылка на список вида атрибут=>значение. +# 2. Запрос - ссылка на список вида атрибут=>значение. # Этот список будет непосредственно передан в # HTML::Element::look_down # 3. Далее пары имя-атрибута, значение. Если вместо имени атрибута # использовать слово _content, заменено будет содержимое элемента. # Значение для _content - ссылка на HTML::Element. Если там строка, # она будет вставлена как одиночный текстовый узел. -# 4. Возвращает число выполненных подстановок (0, если искомых элементов +# 4. Возвращает число выполненных подстановок (0, если искомых элементов # не найдено. # sub substinfo { @@ -2406,18 +2406,18 @@ sub substinfo { } else { $element->push_content($value); } - } else { + } else { $element->attr($attr,$value); - } - } + } + } } - return $count; + return $count; } # -# newlistelement($tree,$elementclass,$listclass) +# newlistelement($tree,$elementclass,$listclass) # -# Если список с указанным классом скрыт, раскрывает его и возвращает -# (единственный) элемент +# Если список с указанным классом скрыт, раскрывает его и возвращает +# (единственный) элемент sub newlistelement { my ($tree,$element,$list) =@_; my $msglist = $tree->look_down("class"=>$list); @@ -2436,7 +2436,7 @@ sub newlistelement { } else { return undef; } -} +} sub escapeHTML { local $_ = shift; @@ -2444,4 +2444,4 @@ sub escapeHTML { s/\/>/g; return $_; -} +} -- 2.39.5