X-Git-Url: http://www.wagner.pp.ru/gitweb/?a=blobdiff_plain;f=forum%2Fforum;h=1cff61efef608c52549773f51fda09e4ab2b3bc8;hb=bf0ab021fe24215225d4f8c682223327abd14ea8;hp=3407034639663e447322f90789f5b6d5792a5b3d;hpb=f5b8e195f7fea3b8a3b1886a1e96f912b3198460;p=oss%2Fstilllife.git diff --git a/forum/forum b/forum/forum index 3407034..1cff61e 100755 --- a/forum/forum +++ b/forum/forum @@ -1,95 +1,118 @@ #!/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; # # ÐÐ°Ð±Ð¾Ñ Ð¿Ð¾Ð´Ð´ÐµÑживаемÑÑ Ð´ÐµÐ¹ÑÑвий. Ð¥ÑÑ Ð²Ð¸Ð´Ð° # "Ð¸Ð¼Ñ Ð¿Ð¾Ð»Ñ Ð² запÑоÑе" => "ÑÑнкÑÐ¸Ñ Ð¾Ð±ÑабоÑÑик" # -my %actions = ( - reply => \&reply, - edit => \&edit_comment, - delete => \&delete_comment, - move => \&move_comment, - newtopic=> \&new_topic, - newforum=> \&new_forum, - login => \&login, - register=>\®ister, - profile=>\&profile, - setrights=>\&set_rights, - openidlogin=>\&openid_login, - openidvfy =>\&openid_verify +my @actions = ( + {name=>"openidvfy",GET=>\&openid_verify,POST=>\&openid_verify}, + {name=>"logout",GET=>\&logout,POST=>\&logout}, + {name=>"reply", POST => \&reply, GET=>\&show_template,rights=>"login"}, + {name=>"edit", POST => \&edit_item, GET=>\&show_editable,rights=>"author"}, + {name=>"delete",POST => \&delete_item, GET=>\&delete_item,rights=>"author"}, + {name=>"move",POST => \&move_item, GET=>\&show_move_dest,rights=>"moderator"}, + {name=>"newtopic",POST=> \&new_topic,GET=>\&show_template,rights=>"normal"}, + {name=>"newforum",POST=> \&new_forum,GET=>\&show_template,rights=>"moderator"}, + {name=>"login",POST => \&login,GET=>\&show_template}, + {name=>"register",POST=>\®ister,GET=>\&show_template}, + {name=>"profile",POST=>\&profile,GET=>\&show_profile,rights=>"normal"}, + {name=>"setrights",POST=>\&set_rights,GET=>\&show_rights,rights=>"admin"}, ); - - - +# +our $path_translated; # Untainted value of PATH_TRANSLATED env var 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); - } else { - for my $param ($cgi->param) { -# СÑеди паÑамеÑÑов, ÑказаннÑÑ Ð² URL иÑем ÑоÑ, коÑоÑÑй Ð·Ð°Ð´Ð°ÐµÑ -# дейÑÑвие - if (exists $actions{$param}) { -# ÐÑ, конеÑно Ñже пÑовеÑили, ÑÑо в названии паÑамеÑÑа -# Ð½ÐµÑ Ð¾ÑоÑÐ¸Ñ Ñимволов неÑ, но ÑÑÐ¾Ð±Ñ perl в taint mode не -# ÑÑгалÑÑ... - if (allow_operation($param,$cgi,$forum)) { - show_template($1,$cgi,$forum) if $param=~/^(\w+)$/; - exit; - } else { - if (!$forum->{"authenticated"}) { - $cgi->param("returnto",$cgi->uri(-full=>1)); - show_template("login",$cgi,$forum); - exit; - - } else { - show_error($forum,"У ÐÐ°Ñ Ð½ÐµÑ Ð¿Ñав на вÑполнение ÑÑой - опеÑаÑии") - } - } - } - } - show_error($forum,"ÐекоÑÑекÑнÑй вÑзов ÑкÑипÑа. ÐÑÑÑÑÑÑвÑÐµÑ Ð¿Ð°ÑамеÑÑ - дейÑÑвиÑ"); - } -} else { - # ÐапÑÐ¾Ñ Ð¼ÐµÑодом POST. ÐÑзÑваем обÑабоÑÑик - for my $param ($cgi->param) { - if (exists $actions{$param}) { - print STDERR "Calling $param handler\n"; - $actions{$param}->($param,$cgi,$forum); - exit; +my $method = $cgi->request_method; +$method = "GET" if ($method eq "HEAD"); +for my $action (@actions) { + if ($cgi->param($action->{name})) { + if (allow_operation($action,$cgi,$forum)) { + $action->{$method}->($action->{name},$cgi,$forum); + } elsif (!$forum->{"authenticated"}) { + $cgi->param("returnto",$cgi->url(-full=>1)); + show_template("login",$cgi,$forum); + } else { + show_error($forum,"У ÐÐ°Ñ Ð½ÐµÑ Ð¿Ñав на вÑполнение ÑÑой опеÑаÑии") } - } - show_error($forum,"ÐекоÑÑекÑнÑй вÑзов ÑкÑипÑа. ÐÑÑÑÑÑÑвÑÐµÑ Ð¿Ð°ÑамеÑÑ Ð´ÐµÐ¹ÑÑвиÑ"); + } } +if (index($path_translated,$forum->{userdir})==0) { + show_user_page($cgi,$forum); +} +show_error($forum,"ÐекоÑÑекÑнÑй вÑзов ÑкÑипÑа. ÐÑÑÑÑÑÑвÑÐµÑ Ð¿Ð°ÑамеÑÑ + дейÑÑвиÑ"); + + +#-------------------------------------------------------------- +#-------- ЧÑение конÑигÑÑаÑионного Ñайла и ÑвÑзаннÑе Ñ ÑÑим дейÑÑÐ²Ð¸Ñ +#------------------------------------------------------------------ + # -# ÐоиÑк Ñайла .forum ввеÑÑ Ð¿Ð¾ деÑÐµÐ²Ñ Ð¾Ñ $ENV{PATH_TRANSLATED} +# ÐÑеобÑазование пÑÑи в Ñайловой ÑиÑÑеме ÑеÑвеÑа в пÑÑÑ Ð² URL +# +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 ввеÑÑ Ð¿Ð¾ деÑÐµÐ²Ñ Ð¾Ñ $path_translated # ÐнаÑение PATH_TRANSLATED ÑÑиÑаем безопаÑнÑм - Ð½Ð°Ñ web-ÑеÑÐ²ÐµÑ Ð½Ð°Ð¼ не # вÑаг. # ÐозвÑаÑÐ°ÐµÑ ÑпиÑок имÑ,знаÑение, имÑ, знаÑение коÑоÑÑй пÑививаеÑÑÑ Ð² # Ñ ÑÑ - +# sub get_forum_config { - my @path=split("/",$1) if $ENV{PATH_TRANSLATED}=~/^(\S+)$/; + $path_translated = $1 if $ENV{PATH_TRANSLATED}=~/^(.+)$/; + $path_translated=~s/\/+$//; + my @path=split("/",$path_translated); while (@path>1) { - pop @path; if (-r (my $config=join("/",@path,".forum")) ) { open F,"<",$config; my %config; @@ -99,38 +122,54 @@ sub get_forum_config { } close F; # + # ÐеÑÐµÐ¼ÐµÐ½Ð½Ð°Ñ forumtop - ÑÑо URL Ñого меÑÑа, где Ð½Ð°Ñ Ð¾Ð´Ð¸ÑÑÑ + # Ñайл .forum + + $config{"forumtop"} = dir2url($cgi,join("/",@path)); + $config{"forumroot"} = 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"}); + $config{"indexfile"} = "index.html" if (!exists $config{"indexfile"}); return \%config; } + pop @path; } # # ÐÑводим оÑÐ¸Ð±ÐºÑ 404 без оÑмÑÑленного оÑоÑмлениÑ, Ñак как даннÑÑ ÑоÑÑма @@ -151,7 +190,7 @@ sub get_forum_config { sub show_error { my ($cfg,$msg) = @_; if ( -r $cfg->{"templates"}."/error.html") { - my $tree = HTML::TreeBuilder->new_from_file($cfg->{"templates"}."/error.html"); + my $tree = treefromfile($cfg->{"templates"}."/error.html"); my $node= $tree->find_by_attribute('class','error'); my $body; if (!$node) { @@ -162,16 +201,17 @@ sub show_error { $node->delete_content; $node->push_content($msg); print $cgi->header(-type=>'text/html',-charset=>'utf-8'); - print $tree->as_HTML("<>&"); + print output_html($tree); } else { - print STDERR "templates= $cfg->{templates}\n" ; print $cgi->header(-type=>'text/html',-charset=>'utf-8'); print "
", - $cgi->escapeHTML($msg),"
", + escapeHTML($msg),"", "ÐÑи обÑабоÑке ÑÑой оÑибки не обнаÑÑжен Ñаблон ÑообÑÐµÐ½Ð¸Ñ Ð¾Ð± оÑибке
"; } + exit; } + # # ÐÑвод Ñаблона ÑоÑмÑ. Ð Ñаблоне должна пÑиÑÑÑÑÑоваÑÑ ÑоÑма Ñ # именем, ÑовпадаÑÑим Ñ Ð¸Ð¼ÐµÐ½ÐµÐ¼ form. ÐÑли в $cgi еÑÑÑ Ð¿Ð°ÑамеÑÑÑ, имена @@ -179,14 +219,21 @@ sub show_error { # подÑÑавлÑÑÑÑÑ # sub show_template { + my $tree = prepare_template(@_); + send_to_user($tree,@_); + exit; +} +sub send_to_user { + my ($tree,$form,$cgi,$forum) = @_; + print + $cgi->header(-type=>"text/html",-charset=>"utf-8",($forum->{cookies}?(-cookie=>$forum->{cookies}):())), + output_html($tree); + exit; +} +sub prepare_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 +243,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,40 +263,60 @@ 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; 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") { + my $type=$element->attr('type') || "text"; + next ELEMENT if grep($type eq $_, + "button","submit","reset"); + if ($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 ($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 ($element->tag eq "textarea") { + my $data=$cgi->param($name); + if ($data=~/^<(div|p)\b/ && !defined($cgi->param($name."_format"))) { + if ($data=~/^) + } else { + $cgi->param($name."_format","html"); + } + } - } elsif ($f->tag eq "textarea") { - $f->delete_content; - $f->push_content($cgi->param("name")); - } elsif ($f->tag eq "select") { - for my $option ($f->find_by_tag_name("option")) { - if (grep($option->attr("value") eq $_, $cgi-param("name"))) { - $option->attr("selected",""); + $element->delete_content; + $element->push_content($cgi->param($name)); + } elsif ($element->tag eq "select") { + for my $option ($element->find_by_tag_name("option")) { + my $value = $option->attr("value") || + $option->as_text(); + if (grep($value eq $_, $cgi->param($name))) { + $option->attr("selected","selected"); } else { $option->attr("selected",undef); } @@ -258,8 +326,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', @@ -268,50 +335,129 @@ sub show_template { $f->push_content($element); } } - + return $tree; +} +# +# ÐопÑавлÑÐµÑ ÑÑÑлки на ÑлÑжебнÑе ÑÐ°Ð¹Ð»Ñ Ð¸ ÑкÑипÑÑ ÑоÑÑма +# +sub fix_forum_links { + my ($forum,$tree,$path_info) = @_; + 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")) { + my $attr; + if ($element->tag eq "form") { + $attr = "action"; + } elsif ($element->tag eq "a"|| $element->tag eq "link") { + $attr = "href"; + } else { + $attr ="src"; + } - print - $cgi->header(type=>"text/html",charset=>"utf-8",($forum->{cookies}?(-cookie=>$forum->{cookies}):())), - $tree->as_HTML("<>&"); -} - + # ÐбÑабаÑÑваем наÑи ÑпеÑиалÑнÑе 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; + } 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 ".."); + # СÑÑлка Ð¾Ñ ÐºÐ¾ÑÐ½Ñ ÑайÑа. + 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}) ; + # ÐнаÑе пиÑем ÑÑда Ñлово forum вмеÑÑо ÑеалÑного имени + # ÑкÑипÑа ÑÑÐ¾Ð±Ñ Ð¿Ð¾Ñом единообÑазно обÑабоÑаÑÑ + $link =~ s/^[^\?]+/forum/; + } + if (!($link =~ s!^templates/!$forum->{templatesurl}/!) && + !($link =~ s!^users/!$userlist/!) && + !($link =~ s!^forum\b!$script_with_path!)) { + $link = $forum->{"forumtop"}."/".$link + } + $element->attr($attr,$link); + } +} # # ÐодÑÑавлÑÐµÑ Ð² заданное поддеÑево инÑоÑмаÑÐ¸Ñ Ð¾ полÑзоваÑеле # sub substitute_user_info { -my ($tree,$forum) = @_; -my %userinfo = %{$forum->{"authenticated"}}; +my ($tree,$forum,$user) = @_; +my %userinfo; +if (defined $user) { + %userinfo=%$user; +} else { + # ÐÑли не Ñказано, какой ÑзеÑ, Ñо ÑекÑÑий. + %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"}; + if (ref $userinfo{"avatar"} eq "HASH") { + substinfo($tree,["_tag"=>"img","class"=>"avatar"], + %{$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); + } -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(); + $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})) + } elsif ($userinfo{$field}=~/^<\w+/) { + $data = str2tree($userinfo{$field}); + } else { + $data = $userinfo{$field} + } + $element->push_content($data); + $element->attr(href=>"mailto:$userinfo{$field}") + if ($element->tag eq "a" && $field eq "email"); + } + } -} } # @@ -320,17 +466,24 @@ while (my ($field,$value)=each %userinfo) { # sub authorize_user { - ($cgi,$forum) = @_; + my ($cgi,$forum) = @_; 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}) { my $userinfo = thaw($userbase{$user}); delete $userinfo->{"passwd"}; $userinfo->{"user"} = $user; @@ -338,14 +491,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 +522,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 +536,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 +552,37 @@ 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 (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; + print STDERR "User $user authenticated successfully\n"; + return 1; } else { set_error($forum,"ÐевеÑное Ð¸Ð¼Ñ Ð¿Ð¾Ð»ÑзоваÑÐµÐ»Ñ Ð¸Ð»Ð¸ паÑолÑ"); + return undef; } } # @@ -409,10 +590,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 +603,139 @@ 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 ; + } + $url = $cgi->url(-base=>1).$url if substr($url,0,1) eq "/"; + print $cgi->redirect(-url=>$url, + ($forum->{cookies}?(-cookie=>$forum->{cookies}):())); + exit; +} +# +# Ðаполнение ÑоÑÐ¼Ñ ÑедакÑиÑÐ¾Ð²Ð°Ð½Ð¸Ñ Ð¿ÑоÑÐ¸Ð»Ñ Ð´Ð°Ð½Ð½Ñми полÑзоваÑÐµÐ»Ñ + +sub show_profile { + my ($formname,$cgi,$forum) = @_; + my $rights = getrights($cgi,$forum); + my $user = $cgi->param("user"); + if (!$user && substr($path_translated,length($forum->{userdir}) eq + $forum->{userdir})) { + $user = substr($path_translated,length($forum->{userdir})+1); + } + $user = $forum->{authenticated}{user} unless $user; + show_error($forum,"Чей пÑоÑÐ¸Ð»Ñ Ð²Ñ Ñ Ð¾ÑиÑе ÑедакÑиÑоваÑÑ?") + unless $user; + my %base; + dbmopen %base,datafile($forum,"passwd"),0664; + show_error($forum,"ÐÐµÑ Ñакого полÑзоваÑÐµÐ»Ñ $user") + unless $base{$user}; + my $userinfo = thaw($base{$user}); + dbmclose(%base); + delete $userinfo->{passwd}; + $userinfo->{user}=$user; + while(my ($field,$value) = each %$userinfo) { + $value = $value->{src} if ($field eq 'avatar' && ref($value)); + $cgi->param($field,$value); + } + my $tree = prepare_template(@_); + # ÐапÑеÑаем ÑедакÑиÑование полей, Ð²Ñ Ð¾Ð´ÑÑÐ¸Ñ Ð² restricted_user_info + my $form = $tree->look_down(_tag=>"form",name=>"profile"); + if ($rights ne "admin" && $forum->{restricted_user_info}) { + for my $field (split /\s*,\s*/,$forum->{restricted_user_info}) { + ELEMENT: + for my $element ($form->look_down(name=>$field)) { + my $tag= $element->tag; + 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') { + $element->replace_with_content(new HTML::Element("div", + class=>"restricted-field"))->delete(); + } elsif ($tag eq 'select') { + my $newel = new HTML::Element("span", + class=>"restricted-field"); + OPTION: + for my $option ($element->content_list) { + if (ref $option eq "HTML::Element" && + $option->attr("selected")) { + $newel->push_content($option->detach_content()); + last OPTION; + } + } + 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}))); + for my $userlink ($tree->look_down(_tag => "a",class=>"author")) { + $userlink->delete_content; + $userlink->push_content($user); + if ($forum->{authenticated}{openiduser}) { + $userlink->attr('href'=>"http://$user"); + } else { + $userlink->attr('href'=>undef); + $userlink->tag('span'); + } + } + send_to_user($tree,@_); +} +# ÐбÑабоÑка ÑезÑлÑÑаÑов ÑедакÑиÑÐ¾Ð²Ð°Ð½Ð¸Ñ Ð¿ÑоÑÐ¸Ð»Ñ Ð¿Ð¾Ð»ÑзваÑÐµÐ»Ñ +# +sub profile { + my ($formname,$cgi,$forum) = @_; + if (!$cgi->param("user")) { + show_error($forum,"Ð ÑоÑме Ð½ÐµÑ Ð¸Ð¼ÐµÐ½Ð¸ полÑзоваÑелÑ"); + } + my $user = $cgi->param('user'); + my $rights = getrights($cgi,$forum); + if ($user ne $forum->{authenticated}{user} && + $rights ne "admin") { + show_error($forum,"У Ð²Ð°Ñ Ð½ÐµÑ Ð¿Ñав на изменение пÑоÑÐ¸Ð»Ñ ÑÑого + полÑзоваÑелÑ"); + } + my %base; + dbmopen %base,datafile($forum,"passwd"),0644; + if (!$base{$user}) { + show_error($forum,"ÐеÑÑÑеÑÑвÑÑÑий полÑзоваÑÐµÐ»Ñ $user"); + } + my $userinfo = thaw $base{$user}; + $userinfo->{user}=$user; + # + # If password fields are filled, change password + # + if ($cgi->param('pass1')) { + if ($cgi->param('pass1') eq $cgi->param('pass2')) { + $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; + dbmclose %base; + show_profile($formname,$cgi,$forum); +} +# # ÐбÑабоÑка ÑезÑлÑÑаÑов Ð·Ð°Ð¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ ÑоÑÐ¼Ñ ÑегиÑÑÑаÑии. # # @@ -451,42 +766,58 @@ sub register { } } } + $cgi->delete("required"); 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; form_error($formname,$cgi,$forum,"ÐÐ¼Ñ Ð¿Ð¾Ð»ÑзоваÑÐµÐ»Ñ '".$cgi->param("user"). "' Ñже занÑÑо"); } - if ($cgi->param("email") && ! Email::Valid->address($cgi->param("email"))) { - form_error($formname,$cgi,$forum,"ÐекоÑÑекÑнÑй E-Mail адÑеÑ"); + my $userinfo = {passwd=>crypt_password($cgi->param('pass1'))}; + make_profile($formname,$cgi,$forum,$userinfo,0); + $userinfo->{registered} = time; + set_default_user_attrs($forum,$userinfo); + print STDERR "stilllife forum: registering user $user\n"; + $userbase{$user} = freeze($userinfo); + dbmclose %userbase; + if (!defined $forum->{denied_status} || $userinfo->{status} ne + $forum->{denied_status}) { + newsession(undef,$forum,$user); + forum_redirect($cgi,$forum,$cgi->param("returnto")); + } else { + # FIXME Email validation + # Email to admin + show_template("newuser",$cgi,$forum); } - my $saltstring = 'ABCDEFGHIJKLMNOPQRSTUVWXUZabcdefghijklmnopqrstuvwxuz0123456789./'; - my $salt = substr($saltstring,int(rand(64)),1). - substr($saltstring,int(rand(64)),1); - my $password=crypt($cgi->param("pass1"),$salt); - my $userinfo = {passwd=>$password}; +} +sub make_profile { + my ($formname,$cgi,$forum,$userinfo,$isadmin) =@_; # УдалÑем лиÑние Ð¿Ð¾Ð»Ñ - $cgi->delete("required"); - $cgi->delete("register"); - $cgi->delete("user"); - $cgi->delete("pass1"); - $cgi->delete("pass2"); foreach my $field (split(/\s*,\s*/,$cgi->param('ignore'))) { if (!$cgi->param($field)) { $cgi->delete($field); } } - my $returnto = $cgi->param("returnto"); - $cgi->delete("returnto"); + if ($cgi->param("email") && ! Email::Valid->address($cgi->param("email"))) { + form_error($formname,$cgi,$forum,"ÐекоÑÑекÑнÑй E-Mail адÑеÑ"); + } + my $user = $userinfo->{user}; + my $userprefix=$user; + $userprefix=~tr!\\/: !_!; # ÐÑли еÑÑÑ Ð°Ð²Ð°ÑÐ°Ñ Ð² Ñайле, Ñо ÑÐ¾Ñ ÑанÑем ÑÑÐ¾Ñ Ñайл и ÑоÑмиÑÑем URL # на него. + $cgi->delete($formname); + $cgi->delete("user"); + $cgi->delete("pass1"); + $cgi->delete("pass2"); if ($cgi->param("avatarfile" )) { my $f = $cgi->upload("avatarfile"); binmode $f,":bytes"; my $out; my $filename = $1 if $cgi->param("avatarfile")=~/([^\/\\]+)$/; - open $out,">",$forum->{"userdir"}."/".$filename; + my $path = $forum->{"userdir"}."/".$userprefix."_".$filename; + open $out,">",$path; binmode $out,":bytes"; my $buffer; while (my $bytes = read($f,$buffer,4096)) { @@ -494,33 +825,1295 @@ sub register { } close $f; close $out; - $userinfo->{'avatar'}= $forum->{"userurl"}."/".$filename; - $cgi->delete("avatar"); - $cgi->delete("avatarfile"); + my ($w,$h) = imgsize($path); + $userinfo->{'avatar'}= {src=>$forum->{"userurl"}."/".$userprefix."_".$filename, + width=>$w,height=>$h}; + } elsif ($cgi->param('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} + unless $isadmin; + foreach my $param ($cgi->param) { - $userinfo->{$param} = $cgi->param($param); - } - $userinfo->{registered} = time; - if (exists $forum->{default_status}) { - $userinfo->{status} = $forum->{default_status}; + next if (grep $_ eq $param,@restrict); + next if $param eq 'avatar'; + next if $param eq 'avatarfile'; + next if $param eq 'returnto'; + next if $param =~ /_format$/; + if (defined $cgi->param("${param}_format")) { + my $tree = input2tree($cgi,$forum,$param); + $userinfo->{$param} = tree2str($tree); + $tree->delete(); + } else { + $userinfo->{$param} = $cgi->param($param); + } } - print STDERR "registering user $user\n"; - $userbase{$user} = freeze($userinfo); - dbmclose %userbase; - newsession(undef,$forum,$user); - if (defined $returnto) { - forum_redirect($returnto) +} +sub crypt_password { + my $open_password=shift; + my $saltstring = 'ABCDEFGHIJKLMNOPQRSTUVWXUZabcdefghijklmnopqrstuvwxuz0123456789./'; + my $salt = substr($saltstring,int(rand(64)),1). + substr($saltstring,int(rand(64)),1); + 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}); + my %base; + my $tree; + dbmopen %base,datafile($forum,"passwd"),0664; + if ($path_translated eq $forum->{userdir}) { + # показаÑÑ ÑпиÑок полÑзоваÑелей + $tree = gettemplate($forum,"userlist"); + my $usertpl = $tree->look_down(class=>"userinfo"); + my $userlist = $usertpl->parent; + $usertpl->detach; + for my $user (sort keys %base) { + my $block = $usertpl->clone; + $userlist->push_content($block); + my $userinfo =thaw($base{$user}); + $userinfo->{"user"} = $user; + substitute_user_info($block,$forum,$userinfo); + profile_links($block,$user,$rights,$cgi,$forum); + } + $usertpl->delete; } else { - forum_redirect($cgi->url(-base=>1).$ENV{PATH_INFO}); + my $user = substr($path_translated,length($forum->{userdir})+1); + if (!$base{$user}) { + print $cgi->header(-status=>"404 NOT FOUND"); + exit; + } + my $userinfo = thaw($base{$user}); + $userinfo->{"user"} = $user; + $tree = gettemplate($forum,"user"); + substinfo($tree,[_tag=>"title"],_content=>"Stilllife user: $user"); + substitute_user_info($tree,$forum,$userinfo); + profile_links($tree,$user,$rights,$cgi,$forum); + unless ($userinfo->{openiduser}) { + 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, + -charset=>"utf-8",($forum->{cookies}?(-cookie=>$forum->{cookies}):())), + $page; +} +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")|| + (defined $forum->{authenticated}{user} && + $forum->{authenticated}{user} eq $user)) { + $profile_link->attr("href", + $ENV{'SCRIPT_NAME'}.$forum->{userurl}. + "/".$user."?profile=1"); + } 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)=@_; + if (authenticate($cgi,$forum)) { + forum_redirect($cgi,$forum); + } else { + show_template(@_); + } +} +# +# ÐбÑабоÑÑик ÑоÑÐ¼Ñ 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($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 1 if ($accesslevel eq "moderator"); + 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)); + } + # + # ÐÐ°Ñ Ð¾Ð´Ð¸Ð¼ Ñайл диÑкÑÑÑии, в коÑоÑÑй надо помеÑÑиÑÑ ÑÐµÐ¿Ð»Ð¸ÐºÑ + # + my ($tree,$lockfd)=gettree($path_translated); + my $newmsg = newlistelement($tree,"message","messagelist"); + if (!$newmsg) { + show_error($forum,"Шаблон ÑÐµÐ¼Ñ Ð½Ðµ ÑодеÑÐ¶Ð¸Ñ ÑлеменÑа Ñ ÐºÐ»Ð°ÑÑом + message"); + exit; + } + + # + # ÐенеÑиÑÑем иденÑиÑикаÑÐ¾Ñ Ð·Ð°Ð¿Ð¸Ñи. + # + my $id = "m".get_uid($forum); + + # + # Ð¡Ð¾Ñ ÑанÑем пÑиаÑÑаÑеннÑе каÑÑинки, еÑли еÑÑÑ. + # + my $dir = $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); + } + } + # + # ÐодÑÑавлÑем даннÑе ÑообÑÐµÐ½Ð¸Ñ + # + $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 + my $posted = strftime("%d.%m.%Y %H:%M",localtime()); + substinfo($newmsg,["class"=>"mdate"], + _content =>$posted); + # ÐодÑÑавлÑем 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",style=>undef); + } else { + 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); + record_as_recent($forum,$newmsg); + record_statistics($forum,"message"), + update_topic_list($forum,$path_translated,$msgcount,$posted); + forum_redirect($cgi,$forum,$cgi->path_info."#$id"); +} +sub update_topic_list { + my ($forum,$topic,$count,$date) = @_; + my ($tree,$lockfd,$block,$index); + if (!ref ($topic)) { + # ÐÑли $topic - Ð¸Ð¼Ñ Ñайла, найдем ÑооÑвеÑÑÑвÑÑÑий Ð¸Ð½Ð´ÐµÐºÑ Ð¸ в нем + # ÑÐ»ÐµÐ¼ÐµÐ½Ñ Ñ ÑооÑвеÑÑÑвÑÑÑим id; + my ($dir,$id)=($1,$2) if $topic =~/(.+)\/([^\/]+).html/; + $index = $dir."/".$forum->{indexfile}; + ($tree,$lockfd) = gettree($index); + $block = $tree->look_down("id"=>$id); + return unless $block; + } else { + # ÐнаÑе нам пеÑедали кÑÑок гоÑового ÑаÑпаÑÑенного деÑева + $block = $topic; + } + substinfo($block,[class=>"msgcount"],_content=>$count); + substinfo($block,[class=>"last-updated"],_content=>$date); + # и еÑли Ð¼Ñ Ð¿Ð°ÑÑили деÑево, Ñо Ð¼Ñ ÐµÐ³Ð¾ и ÑÐ¾Ñ ÑанÑем + savetree($index,$tree,$lockfd); +} + +sub record_as_recent { + my ($forum,$msg) = @_; + my ($tree,$lockfd) = gettree($forum->{forumroot}."/recent.html"); + my $msglist = $tree->look_down("class"=>"messagelist"); + if ($msglist) { + my $style = $msglist->attr("style"); + if ($style && $style =~ s/display: none;//) { + $msglist->attr("style",$style); + $msglist->look_down(class=>"message")->replace_with($msg); + } else { + my @msgs = $msglist->look_down("class"=>"message"); + if (@msgs >= $forum->{replies_per_page}) { + for (my $i=$#msgs;$i>=$forum->{replies_per_page}-1;$i--) { + $msgs[$i]->delete; + } + } + $msgs[0]->preinsert($msg); + } + } + savetree($forum->{forumroot}."/recent.html",$tree,$lockfd); +} +# +# ÐбÑабоÑка опеÑаÑии ÑÐ¾Ð·Ð´Ð°Ð½Ð¸Ñ Ð½Ð¾Ð²Ð¾Ð¹ ÑемÑ. +# + +sub new_topic { + my ($form,$cgi,$forum) = @_; + # + # ÐÑовеÑÑем коÑÑекÑноÑÑÑ urlname и пÑоÑÐ¸Ñ Ð¿Ð¾Ð»ÐµÐ¹ + # + my $urlname; + if (!$cgi->param("urlname")) { + $urlname = get_uid($forum); + } else { + $urlname=$1 if $cgi->param("urlname") =~ /^([-\w]+)$/; + form_error($form,$cgi,$forum,"ÐекоÑÑекÑнÑе ÑÐ¸Ð¼Ð²Ð¾Ð»Ñ Ð² urlname. + ÐопÑÑÑÐ¸Ð¼Ñ ÑолÑко лаÑинÑкие бÑквÑ, ÑиÑÑÑ Ð¸ минÑÑ") unless $urlname; + } + if (!-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); + substinfo($tree,[_tag=>"title"],_content=>$cgi->param("title")); + my $subtree = $tree->look_down("class"=>"topic"); + my $creation_time=strftime("%d.%m.%Y %H:%M",localtime()); + if ($subtree) { + substinfo($subtree,["class"=>"title"], + _content=>$cgi->param("title")); + substinfo($subtree,["class"=>"date"], + _content=>$creation_time); + # ÐÑÑавлÑем в ÑÑÑаниÑÑ ÐÐÐÐЮ анноÑаÑии, поÑколÑÐºÑ Ð°Ð½Ð½Ð¾ÑаÑÐ¸Ñ + # нам еÑе понадобиÑÑÑ Ð² ÑпиÑке Ñем. + substinfo($subtree,["class"=>"abstract"],_content=>$abstract->clone); + substitute_user_info($subtree,$forum); + } else { + substinfo($tree,["class"=>"title"], + _content=>$cgi->param("title")); + } + # СкÑÑÑÑ ÑпиÑок ÑообÑений. + hide_list($tree,"messagelist"); + savetree($filename,$tree,undef); + $tree->destroy; + # + # ÐобавлÑем ÑÐ»ÐµÐ¼ÐµÐ½Ñ Ð² ÑпиÑок Ñем ÑекÑÑего ÑоÑÑма + # + + my $lockfd; + ($tree,$lockfd)=gettree($path_translated."/".$forum->{"indexfile"}); + my $newtopic = newlistelement($tree,"topic","topiclist"); + 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); + $newtopic->attr("id",$urlname); + my $controlform = $newtopic->look_down(_tag=>"form",class=>"topicinfo"); + if ($controlform) { + $controlform->attr("action"=>$cgi->url(-absolute=>1,-path_info=>0, + -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"); + forum_redirect($cgi,$forum,$cgi->url(-base=>1).$url); +} + +sub new_forum { + my ($form,$cgi,$forum) = @_; + # + # ÐÑовеÑÑем коÑÑекÑноÑÑÑ urlname и пÑоÑÐ¸Ñ Ð¿Ð¾Ð»ÐµÐ¹ + # + my $urlname; + if (!$cgi->param("urlname")) { + form_error($form,$cgi,$forum,"ФоÑÑÐ¼Ñ Ð½ÐµÐ¾Ð±Ñ Ð¾Ð´Ð¸Ð¼Ð¾ задаÑÑ Ð½ÐµÐ¿ÑÑÑое urlname"); + } + if ($cgi->param("urlname") eq ".") { + $urlname = "." + } else { + $urlname=$1 if $cgi->param("urlname") =~ /^([-\w]+)$/ ; + form_error($form,$cgi,$forum,"ÐекоÑÑекÑнÑе ÑÐ¸Ð¼Ð²Ð¾Ð»Ñ Ð² urlname. + ÐопÑÑÑÐ¸Ð¼Ñ ÑолÑко лаÑинÑкие бÑквÑ, ÑиÑÑÑ Ð¸ минÑÑ") unless $urlname; + } + if (!-d $path_translated) { + show_error($forum,"ÐпеÑаÑÐ¸Ñ $form Ð¼Ð¾Ð¶ÐµÑ Ð±ÑÑÑ Ð²Ñзвана ÑолÑко Ñо + ÑÑÑаниÑÑ ÑоÑÑма"); + } + my $newname = "$path_translated/$urlname"; + $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,"ФоÑÑм должен имеÑÑ Ð½ÐµÐ¿ÑÑÑое название"); + } + mkdir $newname unless -d $newname; + # + # Ð¡Ð¾Ñ ÑанÑем логоÑип + # + my ($logo_name,$logo_width,$logo_height); + if ($cgi->param("logo")) { + my $userpath = $cgi->param("logo"); + $logo_name="logo.".lc($1) if $userpath=~/\.([^.]+)$/; + my $in = $cgi->upload("logo"); + if (!$in) { + show_error($forum,"ÐÑибка пÑи загÑÑзке каÑÑинки $userpath"); + exit; + } + my $out; + open $out,">$newname/$logo_name"; + binmode $out,":bytes"; + local $/=undef; + my $data = <$in>; + print $out $data; + close $in; + close $out; + ($logo_width,$logo_height) = imgsize("$newname/$logo_name"); + } else { + $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; + my $tree = gettemplate($forum,"forum",$url); + # УдалиÑÑ ÑлеменÑÑ, коÑоÑÑй пÑиÑÑÑÑÑвÑÑÑ ÑолÑко на главной ÑÑÑаниÑе + 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); + substinfo($tree,[_tag=>"title"],_content=>$cgi->param("title")); + my $subtree = $tree->look_down("class"=>"annotation") + or show_error($forum,"Ð Ñаблоне ÑоÑÑма оÑÑÑÑÑÑвÑÐµÑ ÐºÐ»Ð°ÑÑ annotation"); + my $creation_time=strftime("%d.%m.%Y %H:%M",localtime()); + substinfo($subtree,["class"=>"title"], + _content=>$cgi->param("title")); + substinfo($subtree,["class"=>"date"], + _content=>$creation_time); + # ÐÑÑавлÑем в ÑÑÑаниÑÑ ÐÐÐÐЮ анноÑаÑии, поÑколÑÐºÑ Ð°Ð½Ð½Ð¾ÑаÑÐ¸Ñ + # нам еÑе понадобиÑÑÑ Ð² ÑпиÑке Ñем. + substinfo($subtree,["class"=>"abstract"],_content=>$abstract->clone); + substitute_user_info($subtree,$forum); + substinfo($subtree,[_tag=>"img","class"=>"logo"], + src=> $logo_name, width=>$logo_width, height=>$logo_height); + # СкÑÑÑÑ ÑпиÑки подÑоÑÑмов и Ñем . + hide_list($tree,"forumlist"); + hide_list($tree,"topiclist"); + if ($urlname eq ".") { + for my $link_up ($tree->look_down(_tag=>"a",href=>"..")) { + $link_up->delete; + } + } + savetree($filename,$tree,undef); + $tree->destroy; + # + # ÐобавлÑем ÑÐ»ÐµÐ¼ÐµÐ½Ñ Ð² ÑпиÑок Ñем ÑекÑÑего ÑоÑÑма + # + if ($urlname ne ".") { + my $lockfd; + ($tree,$lockfd)=gettree($path_translated."/".$forum->{"indexfile"}); + my $newforum = newlistelement($tree,"forum","forumlist"); + 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,[_tag=>"img","class"=>"logo"],src=>"$urlname/$logo_name", + width=>$logo_width,height=>$logo_height); + substitute_user_info($newforum,$forum); + $newforum->attr("id",$urlname); + my $controlform = $newforum->look_down(_tag=>"form",class=>"foruminfo"); + if ($controlform) { + $controlform->attr("action"=>$cgi->url(-absolute=>1,-path_info=>0). + $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"); + # 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"). ": Свежие ÑообÑениÑ"); + hide_list($recent,"messagelist"); + savetree($path_translated."/recent.html",$recent,undef); + + } + + forum_redirect($cgi,$forum,$cgi->url(-base=>1).$url); +} +# +# ÐбÑабоÑка опеÑаÑий, коÑоÑÑе вÑзÑваÑÑÑÑ Ð¾Ð´Ð¸Ð½Ð°ÐºÐ¾Ð²Ð¾, +# но вÑполнÑÑÑÑÑ Ð¿Ð¾-ÑÐ°Ð·Ð½Ð¾Ð¼Ñ Ð´Ð»Ñ ÑазнÑÑ Ñипов обÑекÑов +# +# ÐаÑамеÑÑÑ $cgi,$forum, Ñип => ÑÑÑлка на ÑÑнкÑÐ¸Ñ ... +# где Ñип - message, topic или forum. ÐпÑеделÑÐµÑ Ð¾Ð±ÑабаÑÑваемÑй обÑÐµÐºÑ +# и вÑзÑÐ²Ð°ÐµÑ ÑооÑвеÑÑÑвÑÑÑÑÑ ÑÑнÑкиÑ. ÐÐ¶Ð¸Ð´Ð°ÐµÑ ÑÑо ÑÑнкÑÐ¸Ñ Ð·Ð°Ð²ÐµÑÑиÑÑÑ +#вÑзовом exit. +sub dispatch_objtype { + my $cgi=shift; + my $forum = shift; + my %actions=@_; + if (-f $path_translated) { + if ($cgi->param("id")) { + $actions{"message"}->($cgi,$forum,$path_translated,$cgi->param("id")) + if exists($actions{'message'}); + } else { + $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) + if exists($actions{'forum'}); + + } + return undef; +} +#Удаление +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) = @_; + dispatch_objtype($cgi,$forum,"message"=>\&show_messageedit, + topic=>\&show_topicedit, + forum=>\&show_forumedit); + show_error($forum,"Ðевозможно ÑедакÑиÑоваÑÑ Ð½ÐµÐ¾Ð¿Ð¾Ð·Ð½Ð°Ð½Ð½Ñй обÑекÑ"); +} +# ÐÑименение ÑезÑлÑÑаÑов ÑедакÑиÑÐ¾Ð²Ð°Ð½Ð¸Ñ +sub edit_item { + my ($formname,$cgi,$forum) = @_; + dispatch_objtype($cgi,$forum,"message"=>\&messageedit, + topic=>\&topicedit, + forum=>\&forumedit); + show_error($forum,"Ðевозможно ÑедакÑиÑоваÑÑ Ð½ÐµÐ¾Ð¿Ð¾Ð·Ð½Ð°Ð½Ð½Ñй обÑекÑ"); +} +sub move_item { + my ($formname,$cgi,$forum) = @_; + dispatch_objtype($cgi,$forum,"message"=>\&move_message, + topic=>\&move_topic, + forum=>\&move_forum); + show_error($forum,"Ðевозможно пеÑемеÑÑиÑÑ Ð½ÐµÐ¾Ð¿Ð¾Ð·Ð½Ð°Ð½Ð½Ñй обÑекÑ"); +} +sub show_move_dest { + my ($formname,$cgi,$forum) = @_; + dispatch_objtype($cgi,$forum,"message"=>\&show_move_message, + topic=>\&show_move_topic, + forum=>\&show_move_forum); + show_error($forum,"Ðевозможно пеÑемеÑÑиÑÑ Ð½ÐµÐ¾Ð¿Ð¾Ð·Ð½Ð°Ð½Ð½Ñй обÑекÑ"); +} +# +# Удаление полÑзоваÑÐµÐ»Ñ +# +sub delete_user { + my ($cgi,$forum,$user) = @_; + if ($forum->{authenticated}{user} ne $user && + getrights($cgi,$forum) ne "admin") { + show_error($forum,"У Ð²Ð°Ñ Ð½ÐµÐ´Ð¾ÑÑаÑоÑно пÑав Ð´Ð»Ñ ÑÐ´Ð°Ð»ÐµÐ½Ð¸Ñ + полÑзоваÑÐµÐ»Ñ $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" + || getrights($cgi,$forum) eq "admin"; + my $author= $msg->look_down(_tag=>"input",name=>"author"); + if ($author) { + return $author->attr("value") eq $forum->{authenticated}{user}; + } elsif ($author = $msg->look_down(class=>"author",_tag=>"a")) { + return $author->as_text eq $forum->{authenticated}{user}; + } else { + return undef; + } +} +# +# Удаление Ñеплики +# +sub delete_comment { + my ($cgi,$forum,$topic,$id) = @_; + my ($tree,$lockfd) = gettree($topic); + my ($msg) = $tree->look_down(id => $id); + show_error($forum,"Рданной Ñеме Ð½ÐµÑ Ñеплики Ñ id=$id") if (!$msg); + show_error($forum,"У Ð²Ð°Ñ Ð½ÐµÑ Ð¿Ñав на Ñдаление ÑÑого ÑообÑениÑ") + 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); + savetree($forum->{forumroot}."/recent.html",$tree,$lockfd); + } else { + discardtree($tree,$lockfd); + } + # ÐÑли Ñ Ñеплики бÑли каÑÑинки, Ñо Ð¸Ñ Ñоже надо гÑÐ¾Ñ Ð½ÑÑÑ + 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$/; + show_error($forum,"ÐевеÑное Ð¸Ð¼Ñ ÑÐµÐ¼Ñ $topic") unless ($dir && $id); + if (getrights($cgi,$forum) ne "moderator" && + getrights($cgi,$forum) ne "admin") { + # ÐÑовеÑÑем авÑоÑÑÑво ÑÐµÐ¼Ñ Ð¸ налиÑие в ней ÑообÑений + my ($tree,$lockfd) = gettree($topic); + my $info = $tree->look_down(class=>"topic"); + my $author = $tree->look_down(class=>"author"); + if ($author->as_text() ne $forum->{authenticated}{user}) { + show_error($forum,"У Ð²Ð°Ñ Ð½ÐµÑ Ð¿Ñава ÑдалÑÑÑ ÑÑÑ ÑемÑ"); + } + $info = $tree->look_down(class=>"messagelist"); + if ($info->attr("style") !~ /display: none;/) { + show_error($forum,"Ðевозможно ÑдалиÑÑ ÑемÑ, ÑодеÑжаÑÑÑ ÑообÑениÑ"); + } + discardtree($tree,$lockfd); + } # FIXME пÑи Ñдалении непÑÑÑой ÑÐµÐ¼Ñ Ð¼Ð¾Ð´ÐµÑаÑоÑом поÑиÑÑиÑÑ recent.html + my ($tree,$lockfd) = gettree($dir . "/".$forum->{indexfile}); + delete_from_list($tree,"topiclist","topic",$id); + savetree($tree,$dir ."/".$forum->{indexfile}); + unlink $topic; + my $redirect_url = $cgi->path_info; + $redirect_url =~ s/\/[^\/]*$//; + forum_redirect($cgi,$forum,$redirect_url); +} +# +# Удаление ÑоÑÑма +# +sub delete_forum { + my ($cgi,$forum,$dir) = @_; + 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) { + next if $entry eq $forum->{indexfile}; + next if $entry eq "perms.txt"; + next if $entry =~ /^logo.[^.]+/; + show_error($forum,"ÐелÑÐ·Ñ ÑдалÑÑÑ ÐºÐ¾ÑÐµÐ½Ñ ÑоÑÑма" ) + if $entry eq ".forum"; + $count ++; + } + closedir DIR; + show_error($forum,"ÐелÑÐ·Ñ ÑдалÑÑÑ Ð½ÐµÐ¿ÑÑÑой ÑоÑÑм") if $count; + # ÐÐ°Ñ Ð¾Ð´Ð¸Ð¼ ÑодиÑелÑÑкий ÑоÑÑм + my $upper = $dir; + $upper=~s/([\/]+)$/$forum->{indexfile}/; + my $id = $1 if $dir =~ /\/([\/]+)$/; + # УдалÑем ÑоÑÑм из ÑпиÑка. + my ($tree,$lockfd) = gettree($upper); + delete_from_list($tree,"forumlist","forum",$id); + savetree($upper,$tree,$lockfd); + # УдалÑем из Ñайловой ÑиÑÑÐµÐ¼Ñ + 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); +} +# Ðоказ ÑообÑÐµÐ½Ð¸Ñ Ð´Ð»Ñ ÑедакÑиÑÐ¾Ð²Ð°Ð½Ð¸Ñ +sub show_messageedit { + my ($cgi,$forum,$path,$id)=@_; + my ($tree,$lockfd) = gettree($path); + my $dirname = $path; + $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); + # ÐÑбиÑаем даннÑе ÑообÑÐµÐ½Ð¸Ñ + my ($text) = $msg->look_down(class=>"mtext")->content_list; + my ($subject) = $msg->look_down(class=>"subject"); + $cgi->param("text"=>$text->as_HTML('<>&"')); + $cgi->param("text_format"=>"html"); + $cgi->param("subject"=> $subject->as_text); + discardtree($tree,$lockfd); + # ÐодгоÑавливаем Ñаблон + my $form = prepare_template("edit_message",$cgi,$forum); + # ÐодÑÑавлÑем инÑоÑмаÑÐ¸Ñ Ð¾ каÑÑÐ¸Ð½ÐºÐ°Ñ . + opendir D,$dirname; + while ( my $filename=readdir D) { + next unless $filename =~/^${id}_/; + my $pic = "$dirname/$filename"; + my $picitem = newlistelement($form,"picture","picturelist"); + my ($w,$h) = imgsize($pic); + substinfo($picitem,[_tag=>"img", class=>"msgpicture"], + src=>dir2url($cgi,$pic),width=>$w,height=>$h); + substinfo($picitem,[_tag=>"input",name=>"delpicture"], + value=>$filename); + substinfo($picitem,[class=>"filename"],_content =>$filename); + } + closedir D; + send_to_user($form,"edit_message",$cgi,$forum); +} +# Ðоказ ÑÐµÐ¼Ñ Ð´Ð»Ñ ÑедакÑиÑÐ¾Ð²Ð°Ð½Ð¸Ñ +sub show_topicedit { + my ($cgi,$forum,$path)=@_; +} +# Ðоказ ÑоÑÑма Ð´Ð»Ñ ÑедакÑиÑÐ¾Ð²Ð°Ð½Ð¸Ñ +sub show_forumedit { + my ($cgi,$forum,$path) = @_; +} +#---------------------------------------------------------- +# Ðаза полÑзоваÑелей и пÑава доÑÑÑпа +#---------------------------------------------------------- +# +# ÐапиÑÑÐ²Ð°ÐµÑ Ð² Ð±Ð°Ð·Ñ Ð´Ð°Ð½Ð½ÑÑ Ð¿Ð¾Ð»ÑзоваÑелей, ÑколÑко ÐºÐ°ÐºÐ¸Ñ Ð¾Ð±ÑекÑов +# Ñоздал ÑекÑÑий полÑзоваÑÐµÐ»Ñ +# +sub record_statistics { + my ($forum,$type) = @_; + my $user = $forum->{authenticated}{user}; + my %base; + dbmopen %base,datafile($forum,"passwd"),0664; + my $userinfo = thaw($base{$user}); + $userinfo->{$type."s"}++; + $userinfo->{"last_$type"}=time; + $base{$user} = freeze($userinfo); + dbmclose %base; +} +# +# ÑиÑÐ°ÐµÑ ÑÐ°Ð¹Ð»Ñ Ð¿Ñав доÑÑÑпа в деÑеве ÑоÑÑма, и возвÑаÑÐ°ÐµÑ +# ÑÑаÑÑÑ ÑекÑÑего полÑзоваÑÐµÐ»Ñ (undef - аноним, banned, normal, +# moderator или admin + +sub getrights { + my ($cgi,$forum) = @_; + if (!$forum->{authenticated}) { + return undef; + } + return $forum->{authenticated}{rights} if + exists $forum->{authenticated}{rights}; + my $user = $forum->{authenticated}{user}; + my $dir = $path_translated; + $dir =~s/\/$//; + $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 $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/\/[^\/]+$// + } + return $forum->{authenticated}{rights}=$user_status; + +} + + + +#------------------------------------------------------------------ +# РабоÑа Ñ Ñайлами и иденÑиÑикÑоÑами +#------------------------------------------------------------------ + +# +# ÐалоÑиÑÑ Ñайл и полÑÑиÑÑ ÐµÐ³Ð¾ ÑаÑпÑаÑенное пÑедÑÑавление. +# ÐозвÑаÑÐ°ÐµÑ Ð¿Ð°ÑÑ ($tree,$lockfd) + +sub gettree { + my $filename = shift; + my $f; + open $f,"<",$filename or return undef; + flock $f, LOCK_EX; + my $tree = treefromfile($f); + return ($tree,$f); +} +# +# Ð¡Ð¾Ñ ÑаниÑÑ Ð´ÐµÑево и закÑÑÑÑ lockfd. +# +# + +sub savetree { + my ($filename,$tree,$lockfd) = @_; + my $f; + open $f,">",$filename . ".new" or return undef; + print $f output_html($tree); + close $f; + # FIXME - ÑолÑко Ð´Ð»Ñ POSIX. + unlink $filename; + rename $filename.".new",$filename; + close $lockfd if defined($lockfd); + +} + +sub discardtree { + my ($tree,$lockfd) = @_; + flock $lockfd,LOCK_UN; + close $lockfd; + $tree->delete; +} +# +# CеÑиализоваÑÑ HTML-докÑÐ¼ÐµÐ½Ñ Ñ DOCTYPE (workaround вокÑÑг баги в +# HTML::TreeBuilder) +# +sub output_html { + my $tree=shift; + return ''. + $tree->as_HTML("<>&"); +} +# +# ЧиÑÐ°ÐµÑ Ñаблон и подгоÑÐ°Ð²Ð»Ð¸Ð²Ð°ÐµÑ ÐµÐ³Ð¾ к ÑазмеÑÐµÐ½Ð¸Ñ Ð¿Ð¾ Ñказанной URL. +# ÐÑли url не Ñказана, ÑÑиÑаеÑÑÑ ÑÑо Ñаблон бÑÐ´ÐµÑ Ð¿Ð¾ÐºÐ°Ð·Ð°Ð½ как ÑезÑлÑÑÐ°Ñ +# ÑекÑÑего http-запÑоÑа. + +sub gettemplate { + my ($forum, $template,$url) = @_; + $url =~ s/\/+/\//g if defined $url; + my $filename=$forum->{"templates"}."/$template.html"; + if (! -r $filename) { + show_error($forum,"ÐÐµÑ Ñаблона $template"); + exit; + } + my $tree = treefromfile($filename); + fix_forum_links($forum,$tree,$url); + return $tree; +} + +# +# Ð¡Ð¾Ð·Ð´Ð°ÐµÑ Ð¾Ð±ÑÐµÐºÑ HTML::TreeBuilder и вÑÑÑавлÑÐµÑ ÑÑд опÑий. +# + +sub make_tree { + my $tree = HTML::TreeBuilder->new; + # Set some options for treebuilder + # 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; + 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( agent => "Stilllife/1.0"), + 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 ($action,$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}) { + # ТаÑим 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; + set_default_user_attrs($forum,\%info); + $info{'status'} = $forum->{openid_status} if $forum->{openid_status}; + $forum->{authenticated}=\%info; + $userbase{$username} = freeze(\%info); + } else { + $forum->{authenticated} = thaw ($userbase{$username}); + } + dbmclose %userbase; + if (defined $forum->{denied_status} && + ($forum->{authenticated}{status} eq $forum->{denied_status})) { + show_error($forum,"ÐÑ Ð¾Ð´ полÑзоваÑÐµÐ»Ñ $username в ÑиÑÑÐµÐ¼Ñ Ð·Ð°Ð±Ð»Ð¾ÐºÐ¸Ñован"); + } + $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 get_avatar_info { + my ($url,$ua) = @_; + $ua = LWP::UserAgent->new( agent => "Stilllife/1.0") unless $ua; + my $response = $ua->get($url); + if ($response->is_success) { + my $image = $response->content; + my ($w,$h,$type) = imgsize(\$image); + return {width=>$w,height=>$h,type=>$type,src=>$url}; + } else { + print STDERR "Error getting $url: ".$response->status_line,"\n"; + return undef; + } +} + +sub get_foaf { + 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; +} + +sub foaf_parse { + my $foaf = shift; + my ($starttag) = $foaf =~ /<(\w+(:\w+)?[^>]+)>/sg; + my %ns = reverse ($starttag =~ /xmlns:(\w+)="([^"]+)"/sg); + my $foaf_prefix = $ns{"http://xmlns.com/foaf/0.1/"}; + my $rdf_prefix = $ns{"http://www.w3.org/1999/02/22-rdf-syntax-ns#"}; + my ($userpic) = $foaf=~/<$foaf_prefix:img[^>]* $rdf_prefix:resource="([^"]+)"/s; + my @info; + push @info, avatar =>$userpic if $userpic; + my ($icq) = $foaf =~/<$foaf_prefix:icqChatID>([^<]*)<\/$foaf_prefix:icqChatID>/s; + push @info, icq => $icq if ($icq); + my ($jabber) = $foaf =~/<$foaf_prefix:jabberID>([^<]*)<\/$foaf_prefix:jabberID>/s; + push @info, jabber => $jabber if ($jabber); + return @info; +} +#----------------------------------------------------------------- +# ÐбÑабоÑка ÑоÑмаÑиÑованнÑÑ ÑекÑÑовÑÑ Ð¿Ð¾Ð»ÐµÐ¹ +#----------------------------------------------------------------- + +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="
/sg;
+ $text=~s/\r?\n/
/sg;
+ $text = "
$text