X-Git-Url: http://wagner.pp.ru/gitweb/?a=blobdiff_plain;f=forum%2Fforum;h=e7cbc9218f6e23ae34691ed508adc207a72147c9;hb=89667c75001818612ff7456840d369954560e76a;hp=3407034639663e447322f90789f5b6d5792a5b3d;hpb=f5b8e195f7fea3b8a3b1886a1e96f912b3198460;p=oss%2Fstilllife.git diff --git a/forum/forum b/forum/forum index 3407034..e7cbc92 100755 --- a/forum/forum +++ b/forum/forum @@ -1,12 +1,29 @@ #!/usr/bin/perl -T - +# +# 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 Fcntl qw(:DEFAULT :flock); use CGI; use HTML::TreeBuilder; use Storable qw(freeze thaw); use Date::Parse; use Email::Valid; +use Image::Size; +use HTML::BBReverse; +use POSIX; +use LWP::UserAgent; +use Net::OpenID::Consumer; # # Набор поддерживаемых действий. Хэш вида # "имя поля в запросе" => "функция обработчик" @@ -25,22 +42,38 @@ my %actions = ( openidlogin=>\&openid_login, openidvfy =>\&openid_verify ); +# +# Уровень прав, которые необходимо иметь пользователю для совершения +# определенного действия +# иерархия вида undef < banned < normal < author < moderator "login", + edit => "author", + delete => "author", + newtopic => "normal", + move => "moderator", + newforum => "moderator", + profile => "normal", + setrights => "admin", +); - - my $cgi = new CGI; - +print STDERR "--------------------\n"; 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); + openid_verify($cgi,$forum); + } elsif ($cgi->param("logout")) { + logout('logout',$cgi,$forum); } else { for my $param ($cgi->param) { # Среди параметров, указанных в URL ищем тот, который задает @@ -54,7 +87,7 @@ if ($cgi->request_method ne "POST") { exit; } else { if (!$forum->{"authenticated"}) { - $cgi->param("returnto",$cgi->uri(-full=>1)); + $cgi->param("returnto",$cgi->url(-full=>1)); show_template("login",$cgi,$forum); exit; @@ -72,13 +105,44 @@ if ($cgi->request_method ne "POST") { # Запрос методом POST. Вызываем обработчик for my $param ($cgi->param) { if (exists $actions{$param}) { - print STDERR "Calling $param handler\n"; - $actions{$param}->($param,$cgi,$forum); - exit; + if (allow_operation($param,$cgi,$forum)) { + $actions{$param}->($param,$cgi,$forum); + exit; + } else { + show_error($forum,"У Вас нет прав на выполнение этой + операции") + } + } - } + } + print STDERR "Получены параметры ",join(" ",$cgi->param),"\n"; show_error($forum,"Некорректный вызов скрипта. Отсутствует параметр действия"); } + +sub dir2url { + my ($cgi,$dir) = @_; + my $prefix=""; + my $pos=rindex $ENV{'PATH_TRANSLATED'},$ENV{'PATH_INFO'}; + if ($pos <0 && $ENV{'PATH_INFO'}=~m!(/\~\w+)/!) { + $prefix .=$1; + $pos = + rindex($ENV{'PATH_TRANSLATED'},substr($ENV{'PATH_INFO'},length($1))); + } + if ($pos <0) { + show_error({},"Ошибка конфигурации форума. Не удается определить + алгоритм преобразования директори в 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({},"Ошибка конфигурации форума. Не удается преобразовать + имя директории $dir в url\n". + "PATH_INFO=$ENV{PATH_INFO}\n". + "PATH_TRANSLATER=$ENV{'PATH_TRANSLATED'}"); + } + return $prefix.substr($dir,length($root)); +} # # Поиск файла .forum вверх по дереву от $ENV{PATH_TRANSLATED} # Значение PATH_TRANSLATED считаем безопасным - наш web-сервер нам не @@ -89,7 +153,6 @@ if ($cgi->request_method ne "POST") { 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; @@ -99,38 +162,50 @@ sub get_forum_config { } close F; # + # Переменная forumtop - это URL того места, где находится + # файл .forum + + $config{"forumtop"} = dir2url($cgi,join("/",@path)); # Если в конфиге отсутствует переменная 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; } + $config{"templatesurl"} = dir2url($cgi,$config{"templates"}) + unless exists $config{"templatesurl"}; # # То же самое - параметр userdir и директория users # if (! exists $config{"userdir"} && -d (my $filename = join("/",@path,"users"))) { $config{"userdir"} = $filename; - } + + + } + $config{"userurl"} = dir2url($cgi,$config{"userdir"}); + # # Если нет ссылки в конфиге на файл паролей или он не # существует, выдаем ошибку. С офоромлением, так как шаблоны # у нас уже есть - if (! exists $config{"passwd"}) { - show_error(\%config,"В конфигурации форума не указан файл пользователей"); + if (!exists $config{"datadir"}) { + show_error(\%config,"В конфигурации форума не указана + директория данных "); exit; } - if (!exists $config{"session"}) { - show_error(\%config,"В конфигурации форума не указан файл сессий"); + if (!-d $config{"datadir"}) { + 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"}); return \%config; } + pop @path; } # # Выводим ошибку 404 без осмысленного оформления, так как данных форума @@ -164,13 +239,25 @@ sub show_error { 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),"

", "

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

"; } + exit; +} + +sub gettemplate { + my ($forum, $template,$url) = @_; + my $filename=$forum->{"templates"}."/$template.html"; + if (! -r $filename) { + show_error($forum,"Нет шаблона $template"); + exit; + } + my $tree = HTML::TreeBuilder->new_from_file($filename); + fix_forum_links($forum,$tree,$url); + return $tree; } # # Вывод шаблона формы. В шаблоне должна присутстовать форма с @@ -180,13 +267,8 @@ sub show_error { # 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); + my $tree = gettemplate($forum,$form,$ENV{'PATH_INFO'}); + # Находим форму с классом $form my $f = $tree->look_down("_tag","form", "name",$form); @@ -196,6 +278,7 @@ sub show_template { именем $form"); exit; } + $cgi->delete('password'); if (!$cgi->param("returnto")) { $cgi->param("returnto", $cgi->referer||$cgi->url(-absolute=>1,-path_info=>1)); @@ -215,32 +298,39 @@ sub show_template { } } if ($forum->{"authenticated"}) { + # Подставляем информацию о текущем пользователе если в шаблоне # это предусмотрено substitute_user_info($tree,$forum); + $cgi->param("user",$forum->{"authenticated"}{"user"}) if (!defined $cgi->param("user")) } my %substituted; - for my $element($f->find_by_tag_name("textarea","input","select")) { - my $name = $f->attr("name"); + ELEMENT: + for my $element ($f->find_by_tag_name("textarea","input","select")) { + my $name = $element->attr("name"); $substituted{$name} = 1; + #print STDERR "substituting form element name $name tag ",$element->tag, + # "value='",$cgi->param($name),"'\n"; 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",""); + if ($element->tag eq "input") { + next ELEMENT if grep ($element->attr("type") eq + $_,"button","submit","reset"); + if ($element->attr("type") eq "check") { + if (grep($element->attr("value") eq $_,$cgi->param($name))) { + $element->attr("checked",""); } else { - $f->attr("checked",undef); + $element->attr("checked",undef); } - } elsif ($f->attr("type") eq + } elsif ($element->attr("type") eq "radio") { - if ($f->attr("value") eq $cgi->param($name)) { - $f->attr("checked",""); + if ($element->attr("value") eq $cgi->param($name)) { + $element->attr("checked",""); } else { - $f->attr("checked",undef); + $element->attr("checked",undef); } } else { - $f->attr("value",$cgi->param($name)); + $element->attr("value",$cgi->param($name)); } } elsif ($f->tag eq "textarea") { $f->delete_content; @@ -258,8 +348,7 @@ sub show_template { } } - $f->attr("type","POST"); - $f->attr("action",$cgi->url(-full=>1,-path_info=>1,-query=>0)); + $f->attr("method","POST"); for my $required ($form,"returnto") { if (!$substituted{$required}) { my $element = new HTML::Element('input', @@ -271,10 +360,58 @@ sub show_template { print - $cgi->header(type=>"text/html",charset=>"utf-8",($forum->{cookies}?(-cookie=>$forum->{cookies}):())), + $cgi->header(-type=>"text/html",-charset=>"utf-8",($forum->{cookies}?(-cookie=>$forum->{cookies}):())), $tree->as_HTML("<>&"); } - +# +# Поправляет ссылки на служебные файлы и скрипты форума +# +sub fix_forum_links { + my ($forum,$tree,$path_info) = @_; + $path_info=$ENV{'PATH_INFO'} if (!defined $path_info); + my $script_with_path = $ENV{SCRIPT_NAME}.$path_info; + ELEMENT: + for my $element ($tree->find_by_tag_name("form","img","link","script","a")) { + my $attr; + if ($element->tag eq "form") { + $attr = "action"; + } elsif ($element->tag eq "a"|| $element->tag eq "link") { + $attr = "href"; + } else { + $attr ="src"; + } + + # Обрабатываем наши специальные link rel="" + if ($element->tag eq "link") { + if ($element->attr("rel") eq "forum-user-list") { + $element->attr("href" => $cgi->url(-absolute=>1, + -path_info=>0,-query_string=>0).$forum->{userurl}); + 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+:/); + # Ссылка от корня сайта. + if (substr($link,0,1) eq "/") { + # Если она не ведет на наш скрипт, не обрабатываем + next ELEMENT if substr($link,0,length($ENV{SCRIPT_NAME}) ne + $ENV{SCRIPT_NAME}) ; + # Иначе пишем туда слово forum вместо реального имени + # скрипта чтобы потом единообразно обработать + $link =~ s/^[^\?]+/forum/; + } + if (!($link =~ s!^templates/!$forum->{templatesurl}/!) && + !($link =~ s!^users/!$forum->{usersurl}/!) && + !($link =~ s!^forum\b!$script_with_path!)) { + $link = $forum->{"forumtop"}."/".$link + } + $element->attr($attr,$link); + } +} # # Подставляет в заданное поддерево информацию о пользователе # @@ -287,31 +424,27 @@ my %userinfo = %{$forum->{"authenticated"}}; # # Специально обрабатываем поля user (должна быть ссылка) и avatar # (должен быть img). + my $userpage; + if ($userinfo{"openiduser"}) { + $userpage = "http://".$userinfo{"user"}; + } else { + $userpage = + $cgi->url(-absolute=>1).$forum->{"userurl"}."/".$cgi->escape($userinfo{"user"}); + } + substinfo($tree,["_tag"=>"a","class"=>"author"], + href=>$userpage,_content=>$userinfo{"user"}); + delete $userinfo{"user"}; + substinfo($tree,["_tag"=>"img","class"=>"avatar"], + src=>$userinfo{"avatar"}||$forum->{templatesurl}."/1x1.gif"); + delete $userinfo{"avatar"}; -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); + for my $element ( $tree->look_down("class",qr/^ap-/)) { + my $field=$1 if $element->attr("class")=~/^ap-(.*)$/; + $element->delete_content(); + $element->push_content(str2tree($userinfo{$field})) + if $userinfo{$field}; } -} } # @@ -324,13 +457,21 @@ sub authorize_user { if (my $session=$cgi->cookie("slsession")) { # Пользователь имеет куку my %sessbase; - dbmopen %sessbase,$forum->{"session"},0644; - if (exists($sessbase{$session})) { + dbmopen %sessbase,datafile($forum,"session"),0644; + if ($sessbase{$session}) { my ($user,$expires,$ip)=split(";", $sessbase{$session}); + my $user_cookie = $cgi->cookie("sluser"); + if ($user_cookie ne $user && $user_cookie ne + "http://".$user) { + clear_user_cookies($cgi,$forum); + show_error($forum,"Некорректная пользовательская сессия"); + exit; + } if (!defined $ip|| $ip eq $ENV{'REMOTE_ADDR'}) { my %userbase; - dbmopen %userbase,$forum->{"passwd"},0644; - if ( exists($userbase{$user})) { + dbmopen %userbase,datafile($forum,"passwd"),0644; + if ( $userbase{$user}) { + print STDERR "getting user info for $user\n"; my $userinfo = thaw($userbase{$user}); delete $userinfo->{"passwd"}; $userinfo->{"user"} = $user; @@ -338,14 +479,28 @@ sub authorize_user { delete $sessbase{$session}; newsession(\%sessbase,$forum,$user,$ip); } + print STDERR "user $user restored session $session\n"; $forum->{"authenticated"}=$userinfo; + print STDERR "authorize_user: ",$forum->{authenticated}{user}, + $forum->{authenticated},"\n"; } dbmclose %userbase; } - } + } else { + clear_user_cookies($cgi,$forum); + show_error($forum,"Некорректная пользовательская сессия"); + exit; + } dbmclose %sessbase; } } +# +# Возвращает путь к файлу в директории +# +sub datafile { + my ($forum,$filename) = @_; + return $forum->{"datadir"}."/".$filename; +} # # Создает новую сессию для пользователя и подготавливает куку которую @@ -355,7 +510,7 @@ sub newsession { my ($base,$forum,$user,$bindip) = @_; if (!defined $base) { $base = {}; - dbmopen %$base,$forum->{"session"},0644; + dbmopen %$base,datafile($forum,"session"),0644; } my $sessname; my $t = time(); @@ -369,10 +524,12 @@ sub newsession { } while ($base->{$sessname}); my $cookie = $cgi->cookie(-name=>"slsession", -expires => $forum->{"authperiod"},-value=> $sessname); - $base->{$sessname}=$user.";".str2time($cookie->expires()). + my $username = $user; + $username =~ s/^http:\/\///; #Remoove http:// from OpenID user names + $base->{$sessname}=$username.";".str2time($cookie->expires()). ($ip?";$ENV{'REMOTE_ADDR'}":""); - $forum->{'cookie'}=[ $cookie, + $forum->{'cookies'}=[ $cookie, $cgi->cookie(-name=>"sluser",-value=>$user,-expires => $forum->{authperiod})]; } @@ -383,25 +540,32 @@ sub newsession { sub authenticate { my ($cgi,$forum) = @_; if ($cgi->param("openidsite")) { - my $openid_url = sprintf($cgi->param("openidsite",$cgi->param("user"))); - openidstart($cgi,$openid_url); + my $openid_url = sprintf($cgi->param("openidsite"),$cgi->param("user")); + openidstart($cgi,$forum,$openid_url); } my %userbase; - dbmopen %userbase,$forum->{"passwd"},0644; + dbmopen %userbase,datafile($forum,"passwd"),0644; my $user = $cgi->param("user"); + my $password = $cgi->param("password"); + $cgi->delete("password"); if (! $userbase{$user}) { set_error($forum,"Неверное имя пользователя или пароль"); return undef; } my $userinfo = thaw($userbase{$user}) ; dbmclose %userbase; - if (crypt($user,$userinfo->{passwd}) eq $userinfo->{passwd}) { + #while (my ($key,$val)=each %$userinfo) { print STDERR "$key => '$val'\n";} + if (crypt($password,$userinfo->{passwd}) eq $userinfo->{passwd}) { delete $userinfo->{"passwd"}; + $cgi->delete("password"); $userinfo->{"user"} = $user; newsession(undef,$forum,$user); $forum->{"authenticated"} = $userinfo; + print STDERR "User $user authenticated successfully\n"; + return 1; } else { set_error($forum,"Неверное имя пользователя или пароль"); + return undef; } } # @@ -409,10 +573,11 @@ sub authenticate { # sub set_error { my ($forum,$message) = @_; + print STDERR "set_error: $message\n"; $forum->{error_message} = $message; } # -# Выводит текущий шаблно с сообщением об ошибке +# Выводит текущий шаблон с сообщением об ошибке # sub form_error { my ($form_name,$cgi,$forum,$msg) = @_; @@ -421,6 +586,25 @@ sub form_error { exit; } # +# Выполняет редирект (возможно, с установкой куков) на страницу, +# указанную # третьем параметре функции или в параметре CGI-запроса +# returnto +# Если и то, и другое не определено, пытается сконструировать URL для +# возврата из PATH_INFO. +# + +sub forum_redirect { + my ($cgi,$forum,$url) = @_; + if (!defined $url) { + $url = $cgi->param("returnto"); + $url = + $cgi->url(-base=>1).($cgi->path_info()||$forum->{forumtop}) if !$url ; + } + print $cgi->redirect(-url=>$url, + ($forum->{cookies}?(-cookie=>$forum->{cookies}):())); + exit; +} +# # Обработка результатов заполнения формы регистрации. # # @@ -452,7 +636,7 @@ sub register { } } my %userbase; - dbmopen %userbase,$forum->{"passwd"},0644 + dbmopen %userbase,datafile($forum,"passwd"),0644 or form_error($formname,$cgi,$forum,"Ошибка открытия файла паролей $!"); if ($userbase{$cgi->param("user")}) { dbmclose %userbase; @@ -506,21 +690,467 @@ sub register { if (exists $forum->{default_status}) { $userinfo->{status} = $forum->{default_status}; } - print STDERR "registering user $user\n"; + print STDERR "stilllife forum: registering user $user\n"; $userbase{$user} = freeze($userinfo); dbmclose %userbase; newsession(undef,$forum,$user); - if (defined $returnto) { - forum_redirect($returnto) + forum_redirect($cgi,$forum,$returnto) +} +# +# Обработчик формы логина. Сводится к вызову функции authenticate, +# поскольку мы поддерживаем логин одновременный с отправкой реплики. +# +sub login { + my ($form,$cgi,$forum)=@_; + if (authenticate($cgi,$forum)) { + forum_redirect($cgi,$forum); } else { - forum_redirect($cgi->url(-base=>1).$ENV{PATH_INFO}); + show_template(@_); } - } - +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")]; +} +# +# Обработчик формы logout. В отличие от большинства обработчиков форм, +# поддерживает обработку методом GET +# +sub logout { + my ($form,$cgi,$forum) = @_; + clear_user_cookies($cgi,$forum); + if (defined (my $session_id = $cgi->cookie("slsession"))) { + my %sessiondb; + dbmopen %sessiondb,datafile($forum,"session"),0644; + delete $sessiondb{$session_id}; + dbmclose %sessiondb; + } + forum_redirect($cgi,$forum); +} sub allow_operation { my ($operation,$cgi,$forum) = @_; - return 1 if (grep $operation eq $_,"register","login","reply"); - + return 1 if (!exists($permissions{$operation})); + if (!$forum->{authenticated}) { + return 1 if ($permissions{$operation} eq "login"); + return 0; + } + my $user = $forum->{authenticated}{user} ; + my $accesslevel=getrights($cgi,$forum); + # Если permissions{$operation} равны author, нам нужно извлечь + # текст из соответствующего файла и положить его в + # cgi->param("text"); Заодно определим и автора + my ($itemauthor,$itemtext)=get_message_by_id($cgi->param("id")) if + $permissions{$operation} eq "author"; + + return 1 if ($accesslevel eq "admin"); + return 0 if ($permissions{$operation} eq "admin"); + return 1 if ($accesslevel eq "moderator"); + return 0 if $accesslevel eq "banned"; + return 0 if $permissions{$operation} eq "author" && $user ne $itemauthor; return 1; } + +sub reply { + my ($form,$cgi,$forum) = @_; + if (! exists $forum->{authenticated} ) { + form_error($form,$cgi,$forum,"Вы не зарегистрировались") if (!authenticate($cgi,$forum)); + } + # + # Находим файл дискуссии, в который надо поместить реплику + # + my ($tree,$lockfd)=gettree($ENV{'PATH_TRANSLATED'}); + my $messagetpl = $tree->look_down(class=>"message"); + if (!$messagetpl) { + show_error($forum,"Шаблон темы не содержит элемента с классом + message"); + exit; + } + + # + # Генерируем идентификатор записи. + # + my $id = get_uid($forum); + + + # + # Сохраняем приаттаченные картинки, если есть. + # + my $dir = $1 if $ENV{PATH_TRANSLATED}=~/^(.*)$/; + $dir=~ s/[^\/]+$// if (-f $dir); + my %attached; + for (my $i=1;$cgi->param("image$i"); $i++) { + my $userpath=$cgi->param("image$i"); + my $filename=lc($1) if $userpath =~ /([^\/\\]+)$/; + $attached{$filename} = $id."_".$filename; + my $in = $cgi->upload("image$i"); + if (!$in) { + show_error($forum,"Ошибка при загрузке картинки $filename"); + exit; + } + my $out; + open $out,">$dir/$attached{$filename}"; + binmode $out,":bytes"; + local $/=undef; + my $data = <$in>; + print $out $data; + close $in; + close $out; + } + # + # Преобразуем текст записи в html и чистим его + # + my $txtree = input2tree($cgi,$forum,"text"); + # + # Находим в тексте URL на приаттаченные картинки и меняем на те + # имена, под которыми мы их сохранили. + # + for my $image ($txtree->find_by_tag_name("img")) { + my $file=lc($image->attr("src")); + if ( exists $attached{$file}) { + $image->attr("src" => $attached{$file}); + my ($width,$height) = imgsize($dir ."/".$attached{$file}); + $image->attr("width" =>$width); + $image->attr("height" => $height); + } + } + # + # Копируем элемент с классом message + # + my $newmsg = $messagetpl->clone; + my $parent = $messagetpl->parent; + $parent->push_content($newmsg); + # + # Подставляем данные сообщения + # + $newmsg->attr("id"=>$id); + substinfo($newmsg,[class=>"subject"],_content=>$cgi->param("subject")); + my $textnode=$newmsg->look_down("class"=>"mtext"); + if (!$textnode) { + show_error($forum,"В шаблоне реплики нет места для текста"); + } + $textnode->delete_content(); + $textnode->push_content($txtree); + if ($forum->{authenticated}{signature}) { + $textnode->push_content(new HTML::Element("br"),"--", + new HTML::Element("br"),str2tree($forum->{authenticated}{signature})); + } + substitute_user_info($newmsg,$forum); + # + # Подставляем данные в форму msginfo + # + my $editform=$newmsg->look_down(_tag=>"form","class"=>"msginfo"); + if ($editform) { + substinfo($editform,[_tag=>"input",name=>"id"],value=>$id) || + show_error($forum,"В форме управления сообщением нет поля id"); + substinfo($editform,[_tag=>"input",name=>"author"],value=> + $forum->{authenticated}{user}) || + show_error($forum,"В форме управления сообщением нет поля author"); + } + # Подставляем mdate + substinfo($newmsg,["class"=>"mdate"], + _content =>strftime("%d.%m.%Y %H:%M",localtime())); + # Подставляем mreply + substinfo($newmsg,[_tag=>"a","class"=>"mreply"],"href" => + $cgi->url(-absolute=>1,-path_info=>1)."?reply=1&id=$id"); + # Подставляем manchor + substinfo($newmsg,[_tag=>"a","class"=>"manchor"], + "name"=>"#$id","href"=>undef) or + show_error($forum,"В шаблоне сообщения отсутствует якорь для ссылок на него"); + # подставляем mlink + substinfo($newmsg,[_tag=>"a","class"=>"mlink"], + href=>$cgi->path_info."#id"); + # подставляем mparent + my $parent_id=$cgi->param("id"); + if ($parent_id) { + substinfo($newmsg,[_tag => "a",class=>"mparent"], + "href"=>$cgi->path_info."#$parent_id"); + } else { + substinfo($newmsg,[_tag => "a",class=>"mparent"], + "_content"=>""); + } + + # + # Проверяем видимость списка сообщений + # + my $msglist = $tree->look_down("class"=>"messagelist"); + if ($msglist) { + my $style = $msglist->attr("style"); + $msglist->attr("style",$style) if $style && $style =~ s/display: none;//; + } + # + # Делаем Уфф и сохраняем то, что получилось + # + savetree($ENV{PATH_TRANSLATED},$tree,$lockfd); + forum_redirect($cgi,$forum); + +} +# +# читает файлы прав доступа в дереве форума, и возвращает +# статус текущего пользователя (undef - аноним, banned, normal, +# moderator или admin + +sub getrights { + my ($cgi,$forum) = @_; + if (!$forum->{authenticated}) { + return undef; + } + my $user = $forum->{authenticated}{user}; + my $dir = $ENV{'PATH_TRANSLATED'}; + $dir =~s/\/[^\/]+$// if (!-d $dir); + my $f; + my $user_status = "normal"; + LEVEL: + while (length($dir)) { + if (-f "$dir/perms.txt") { + open $f,"<","$dir/perms.txt"; + my $status = undef; + while (<$f>) { + if (/^\[\s*(admins|moderators|banned)\s*\]/) { + $status = $1; + } else { + chomp; + if ($user eq $_ && defined $status) { + if ($status eq "banned") { + return $status; + } + if ($status eq "admins" ) { + return "admin"; + } + $user_status = "moderator"; + } + } + } + close $f; + last LEVEL if -f "$dir/.forum"; + # Strip last path component. + $dir =~s/\/[^\/]+$// + } + } + return $user_status; + +} + + +# +# Залочить файл и получить его распрасенное представление. +# Возвращает пару ($tree,$lockfd) + +sub gettree { + my $filename = shift; + my $f; + open $f,"<",$filename or return undef; + flock $f, LOCK_EX; + my $tree = HTML::TreeBuilder->new_from_file($f); + return ($tree,$f); +} +# +# Сохранить дерево и закрыть lockfd. +# +# + +sub savetree { + my ($filename,$tree,$lockfd) = @_; + my $f; + $filename = $1 if $filename =~ /^(.*)$/; + open $f,">",$filename . ".new" or return undef; + print $f $tree->as_HTML("<>&"); + close $f; + # FIXME - только для POSIX. + unlink $filename; + rename $filename.".new",$filename; + close $lockfd if defined($lockfd); +} + + + +# +# Получает уникальный числовой идентификатор. +# +sub get_uid { + my $forum = shift; + my $f; + open $f,"+<",datafile($forum,"sequence") or + flock $f,LOCK_EX; + my $id=<$f> || "0"; + $id++; + seek $f,0,0; + printf $f "%8s\n",$id; + close $f; + $id=~/(\d+)/; + return sprintf ("%08s",$1); +} +# -------------------------------------------------------------------- +# OpenID registration +# ------------------------------------------------------------------- +sub create_openid_consumer { + my ($cgi,$forum) = @_; + return Net::OpenID::Consumer ->new( + ua => LWP::UserAgent->new(), + args => $cgi, + consumer_secret=>"X9RWPo0rBE7yLja6VB3d", + required_root => $cgi->url(-base=>1)); +} + +# openidstart - вызывается когда обнаружено что текущее имя +# пользователя, пытающегося аутентифицироваться, содержит http:// +# +# + +sub openidstart { + my ($cgi,$forum,$openidurl) = @_; + # + # Fix duplicated http:// which can be produced by our sprintf based + # login system + # + $openidurl=~s!^http://http://!http://!; + my $csr = create_openid_consumer($cgi,$forum); + my $claimed_identity=$csr->claimed_identity($openidurl); + if (!defined $claimed_identity) { + show_error($forum,"Указанная URL $openidurl не является OpenId"); + exit; + } + $cgi->param("openidvfy",1); + $cgi->delete("user"); + $cgi->delete("openidsite"); + $cgi->delete("password"); + my $check_url = $claimed_identity->check_url( + return_to=> $cgi->url(-full=>1,-path_info=>1,-query=>1), + trust_root=> $cgi->url(-base=>1)); + print $cgi->redirect(-location=>$check_url); + exit; +} +# +# Вызывается при редиректе от openid producer-а. Проверяет, что +# удаленный сервер подтвердил openid и вызывает операцию для которой +# (либо возврат на исходную страницу при операции login, либо постинг +# реплики) +# +sub openid_verify { + my ($cgi,$forum) = @_; + my $csr = create_openid_consumer($cgi,$forum); + if (my $setup_url = $csr->user_setup_url) { + print $cgi->redirect(-location=>$setup_url); + exit; + } elsif ($csr->user_cancel) { + show_error($forum,"Ваш openid-сервер отказался подтвержать вашу + идентичность"); + exit; + } elsif (my $vident = $csr->verified_identity) { + #Успешная аутентификация. + #Создаем сессию + my $user = $vident->url; + # Remove trailing slash from URL if any + $user=~s/\/$//; + my %userbase; + dbmopen %userbase,datafile($forum,"passwd"),0664; + my $username = $user; + $username =~ s/^http:\/\///; + if (!$userbase{$username}) { + $userbase{$username} = freeze($forum->{authenticated}={"openiduser"=>1}); + } else { + $forum->{authenticated} = thaw ($userbase{$username}); + } + dbmclose %userbase; + $forum->{"authenticated"}{"user"} = $username; + newsession(undef,$forum,$user); + # Если указан параметр reply, вызываем обработку реплики + if ($cgi->param("reply")) { + reply("reply",$cgi,$forum); + exit; + } + #Иначе, возвращаемся на исходную страницу + forum_redirect($cgi,$forum,undef); + } else { + show_error($forum,"Ошибка OpenId аутентификации"); + exit; + } +} +#----------------------------------------------------------------- +# Обработка форматированных текстовых полей +#----------------------------------------------------------------- + +sub input2tree { + my ($cgi,$forum,$field_name) = @_; + my $format = $cgi->param($field_name."_format"); + my $text = $cgi->param($field_name); + if ($format eq "bbcode") { + my $parser = HTML::BBReverse->new(); + $text="
".$parser->parse($text)."
"; + } elsif ($format eq "text") { + $text=~s/\r?\n\r?\n/<\/p>

/; + $text=~s/\r?\n/
/; + $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; + } + } + # Проверяем на наличие URL-ок не оформленных ссылками. + return $txtree; +} + + + +sub str2tree { + my ($data)=@_; + my $tree = HTML::TreeBuilder->new(); + # Set parser options here + $tree->parse("
$data
"); + $tree->eof; + my $element=$tree->find("body"); + while (($element =($element->content_list)[0])->tag ne "div") { + } + $element->detach; + $tree->destroy; + return $element; +} + +sub tree2str { + my ($tree)=@_; + return $tree->as_HTML("<>&"); +} + +#------------------------------------------------------------------------ +# Подстановка в дереве +#------------------------------------------------------------------------ + +# +# Найти все элементы, удоволетворяющие заданному критерию и подставить в +# них указанные атрибуты +# +# Параметры 1. Дерево (класса HTML::Element) +# 2. Запрос - ссылка на список вида атрибут=>значение. +# Этот список будет непосредственно передан в +# HTML::Element::look_down +# 3. Далее пары имя-атрибута, значение. Если вместо имени атрибута +# использовать слово _content, заменено будет содержимое элемента. +# Значение для _content - ссылка на HTML::Element. Если там строка, +# она будет вставлена как одиночный текстовый узел. +# 4. Возвращает число выполненных подстановок (0, если искомых элементов +# не найдено. +# +sub substinfo { + my ($tree,$query,@attrs) = @_; + my $count; + foreach my $element ($tree->look_down(@$query)) { + $count ++; + while (@attrs) { + my $attr = shift @attrs; + my $value = shift @attrs; + if ($attr eq "_content") { + $element->delete_content; + $element->push_content($value); + } else { + $element->attr($attr,$value); + } + } + } + return $count; +} +