X-Git-Url: http://wagner.pp.ru/gitweb/?a=blobdiff_plain;f=forum%2Fforum;h=e7cbc9218f6e23ae34691ed508adc207a72147c9;hb=89667c75001818612ff7456840d369954560e76a;hp=c7148594e2a7af9b78902be411f14f866af78a93;hpb=89f2fc99e9e637eb9f383f277e68021828ba5fe2;p=oss%2Fstilllife.git diff --git a/forum/forum b/forum/forum index c714859..e7cbc92 100755 --- a/forum/forum +++ b/forum/forum @@ -13,11 +13,17 @@ # 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; # # Набор поддерживаемых действий. Хэш вида # "имя поля в запросе" => "функция обработчик" @@ -65,7 +71,7 @@ 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 { @@ -81,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; @@ -115,7 +121,7 @@ if ($cgi->request_method ne "POST") { sub dir2url { my ($cgi,$dir) = @_; - my $prefix=$cgi->url(-base=>1); + my $prefix=""; my $pos=rindex $ENV{'PATH_TRANSLATED'},$ENV{'PATH_INFO'}; if ($pos <0 && $ENV{'PATH_INFO'}=~m!(/\~\w+)/!) { $prefix .=$1; @@ -241,6 +247,18 @@ sub show_error { } 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; +} # # Вывод шаблона формы. В шаблоне должна присутстовать форма с # именем, совпадающим с именем form. Если в $cgi есть параметры, имена @@ -249,13 +267,8 @@ sub show_error { # sub show_template { my ($form,$cgi,$forum) = @_; - my $filename=$forum->{"templates"}."/$form.html"; - if (! -r $filename) { - show_error($forum,"Нет шаблона для операции $form"); - exit; - } - my $tree = HTML::TreeBuilder->new_from_file($filename); - fix_forum_links($forum,$tree); + my $tree = gettemplate($forum,$form,$ENV{'PATH_INFO'}); + # Находим форму с классом $form my $f = $tree->look_down("_tag","form", "name",$form); @@ -335,7 +348,7 @@ sub show_template { } } - $f->attr("type","POST"); + $f->attr("method","POST"); for my $required ($form,"returnto") { if (!$substituted{$required}) { my $element = new HTML::Element('input', @@ -367,6 +380,18 @@ sub fix_forum_links { } 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+:/); @@ -399,39 +424,27 @@ my %userinfo = %{$forum->{"authenticated"}}; # # Специально обрабатываем поля user (должна быть ссылка) и avatar # (должен быть img). -my @userlink = $tree->look_down("_tag"=>"a","class"=>"author"); -if (@userlink) { my $userpage; - if ($userinfo{"user"}=~/^http:/) { - $userpage = $userinfo{"user"}; + if ($userinfo{"openiduser"}) { + $userpage = "http://".$userinfo{"user"}; } else { $userpage = - $cgi->url(-absolute=>1,-path_info=>1)."?profile=1&user=".$cgi->escape($userinfo{"user"}); + $cgi->url(-absolute=>1).$forum->{"userurl"}."/".$cgi->escape($userinfo{"user"}); } - for my $element (@userlink) { - $element->attr(href=>$userpage); + 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"}; + + for my $element ( $tree->look_down("class",qr/^ap-/)) { + my $field=$1 if $element->attr("class")=~/^ap-(.*)$/; $element->delete_content(); - $element->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); + $element->push_content(str2tree($userinfo{$field})) + if $userinfo{$field}; } -} } # @@ -447,10 +460,18 @@ sub authorize_user { 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,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; @@ -460,13 +481,16 @@ sub authorize_user { } print STDERR "user $user restored session $session\n"; $forum->{"authenticated"}=$userinfo; - print STDERR "authorize_user: - ",$forum->{authenticated}{user}, + print STDERR "authorize_user: ",$forum->{authenticated}{user}, $forum->{authenticated},"\n"; } dbmclose %userbase; } - } + } else { + clear_user_cookies($cgi,$forum); + show_error($forum,"Некорректная пользовательская сессия"); + exit; + } dbmclose %sessbase; } } @@ -500,7 +524,9 @@ 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->{'cookies'}=[ $cookie, @@ -514,8 +540,8 @@ 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,datafile($forum,"passwd"),0644; @@ -571,7 +597,8 @@ sub forum_redirect { my ($cgi,$forum,$url) = @_; if (!defined $url) { $url = $cgi->param("returnto"); - $url = $cgi->url(-base=>1).$cgi->path_info() if (!$url); + $url = + $cgi->url(-base=>1).($cgi->path_info()||$forum->{forumtop}) if !$url ; } print $cgi->redirect(-url=>$url, ($forum->{cookies}?(-cookie=>$forum->{cookies}):())); @@ -681,15 +708,19 @@ sub login { 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) = @_; - $forum->{cookies}=[ $cgi->cookie(-name=>"sluser", -value=>"0", - -expires=>"-1m"),$cgi->cookie(-name=>"slsession", -value=>"0", - -expires => "-1m")]; + clear_user_cookies($cgi,$forum); if (defined (my $session_id = $cgi->cookie("slsession"))) { my %sessiondb; dbmopen %sessiondb,datafile($forum,"session"),0644; @@ -729,37 +760,131 @@ sub reply { # # Находим файл дискуссии, в который надо поместить реплику # + 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 = undef; - if ($cgi->param("format") eq "bbcode") { - - } elsif ($cgi->param("format") eq "text") { - my $text = $cgi->escapeHTML($cgi->param("text")); - $text=~s/\r?\n\r?\n/

/; - $text=~s/\n/
/; - $txtree = - HTML::TreeBuilder->new_from_content("

$text
"); - } else { # Default - html - $txtree = - HTML::TreeBuilder->new_from_content("
".$cgi->param("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; - } + 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); + } # # читает файлы прав доступа в дереве форума, и возвращает @@ -808,3 +933,224 @@ sub getrights { } +# +# Залочить файл и получить его распрасенное представление. +# Возвращает пару ($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; +} +