X-Git-Url: http://www.wagner.pp.ru/gitweb/?a=blobdiff_plain;f=forum%2Fforum;h=a1d613710cc5b4141d0b44fa857628f833ef84bc;hb=182c1f107810fa5623b9a998b5ad09e963dc793b;hp=3407034639663e447322f90789f5b6d5792a5b3d;hpb=f5b8e195f7fea3b8a3b1886a1e96f912b3198460;p=oss%2Fstilllife.git diff --git a/forum/forum b/forum/forum index 3407034..a1d6137 100755 --- a/forum/forum +++ b/forum/forum @@ -1,95 +1,120 @@ #!/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 Carp; +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"}, + {name=>"reapply",POST=>\&apply_templates,GET=>\&apply_templates,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 +124,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 +192,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 +203,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 +221,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 +245,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 +265,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 ($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",""); + } 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");
+ }
+
+ }
+ $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 +328,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 +337,134 @@ 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 makeuserlink {
+ my ($forum,$tree,$linkclass,$userinfo) = @_;
+ 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"=>$linkclass],
+ href=>$userpage,_content=>$userinfo->{"user"});
+}
#
# ÐодÑÑавлÑÐµÑ Ð² заданное поддеÑево инÑоÑмаÑÐ¸Ñ Ð¾ полÑзоваÑеле
#
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).
+ makeuserlink($forum,$tree,"author",\%userinfo);
+ delete $userinfo{"user"};
+ if (ref $userinfo{"avatar"} eq "HASH") {
+ substinfo($tree,["_tag"=>"img","class"=>"avatar"],
+ %{$userinfo{'avatar'}});
+ } elsif ($userinfo{'avatar'}) {
+ 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 +473,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 +498,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 +529,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 +543,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 +559,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 +597,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 +610,145 @@ 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));
+ if ($value =~/^<(div|p)\b/) {
+ my $tree = str2tree($value);
+ tree2input($cgi,$field,$tree);
+ $tree->delete;
+ } else {
+ $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,76 +779,1669 @@ 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 $filename =
+ (save_attached_images($cgi,$forum,$forum->{userdir},"${userprefix}_%f",
+ "avatarfile"))[1];
+ my $path = $forum->{"userdir"}."/".$filename;
+ 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) {
+ 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);
+ if ($tree) {
+ $userinfo->{$param} = tree2str($tree);
+ $tree->delete();
+ } else {
+ delete $userinfo->{$param};
+ }
+ } else {
+ $userinfo->{$param} = $cgi->param($param);
+ }
+ }
+}
+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 {
+ 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 (!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");
+ }
+
+ #
+ # ÐенеÑиÑÑем иденÑиÑикаÑÐ¾Ñ Ð·Ð°Ð¿Ð¸Ñи.
+ #
+ my $id = "m".get_uid($forum);
+
+
+ #
+ # СоÑ
ÑанÑем пÑиаÑÑаÑеннÑе каÑÑинки, еÑли еÑÑÑ.
+ #
+ my $dir = $path_translated;
+
+ $dir=~ s/[^\/]+$// if (-f $dir);
+ my %attached=save_attached_images($cgi,$forum,$dir,"${id}_%f",
+ grep(/^image\d+/,$cgi->param));
+ #
+ # ÐÑеобÑазÑем ÑекÑÑ Ð·Ð°Ð¿Ð¸Ñи в html и ÑиÑÑим его
+ #
+ my $txtree = input2tree($cgi,$forum,"text");
+ #
+ # ÐаÑ
одим в ÑекÑÑе URL на пÑиаÑÑаÑеннÑе каÑÑинки и менÑем на Ñе
+ # имена, под коÑоÑÑми Ð¼Ñ Ð¸Ñ
ÑоÑ
Ñанили.
+ #
+ fix_image_links($cgi,$txtree,\%attached,$dir);
+ #
+ # ÐодÑÑавлÑем даннÑе ÑообÑениÑ
+ #
+ $newmsg->attr("id"=>$id);
+ substinfo($newmsg,[class=>"subject"],_content=>$cgi->param("subject"));
+ my $textnode=$newmsg->look_down("class"=>"mtext");
+ if (!$textnode) {
+ show_error($forum,"Ð Ñаблоне Ñеплики Ð½ÐµÑ Ð¼ÐµÑÑа Ð´Ð»Ñ ÑекÑÑа");
+ }
+ $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,1);
+ record_statistics($forum,"message"),
+ update_topic_list($forum,$path_translated,$msgcount,$posted);
+ forum_redirect($cgi,$forum,$cgi->path_info."#$id");
+}
+sub fix_image_links {
+ my ($cgi,$txtree,$attached,$dir) =@_;
+ for my $image ($txtree->find_by_tag_name("img")) {
+ my $file=lc($image->attr("src"));
+ if ( exists $attached->{$file}) {
+ $image->attr("src" => dir2url($cgi,$dir)."/".$attached->{$file});
+ my ($width,$height) = imgsize($dir ."/".$attached->{$file});
+ $image->attr("width" =>$width);
+ $image->attr("height" => $height);
+ }
+ }
+}
+sub save_attached_images {
+ my ($cgi,$forum,$dir,$nametemplate,@params) = @_;
+ my %attached;
+ for my $param (@params) {
+ my $userpath=$cgi->param($param);
+ next unless $userpath;
+ my $filename=lc($1) if $userpath =~ /([^\/\\]+)$/;
+ my $ext = $1 if $filename =~/([^.]+)$/;
+ my %subst=(f=>$filename,e=>$ext);
+ $attached{$filename} = $nametemplate;
+ $attached{$filename}=~s/\%([fe])/$subst{$1}/eg;
+ my $in = $cgi->upload($param);
+ if (!$in) {
+ show_error($forum,"ÐÑибка пÑи загÑÑзке каÑÑинки $filename");
+ exit;
+ }
my $out;
- my $filename = $1 if $cgi->param("avatarfile")=~/([^\/\\]+)$/;
- open $out,">",$forum->{"userdir"}."/".$filename;
+ open $out,">$dir/$attached{$filename}";
binmode $out,":bytes";
- my $buffer;
- while (my $bytes = read($f,$buffer,4096)) {
- print $out $buffer;
- }
- close $f;
+ local $/=undef;
+ my $data = <$in>;
+ print $out $data;
+ close $in;
close $out;
- $userinfo->{'avatar'}= $forum->{"userurl"}."/".$filename;
- $cgi->delete("avatar");
- $cgi->delete("avatarfile");
}
+ return %attached;
+
+}
+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) if defined $tree;
+}
+
+sub record_as_recent {
+ my ($forum,$msg,$new) = @_;
+ my ($tree,$lockfd) = gettree($forum->{forumroot}."/recent.html");
+ my $msglist = $tree->look_down("class"=>"messagelist");
+ if ($msglist) {
+ if ($new) {
+ 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);
+ }
+ } else {
+ my $old_copy = $msglist->look_down(id=>$msg->attr("id"));
+ if ($old_copy) {
+ $old_copy->replace_with($msg)->delete;
+ }
+ }
+ }
+ savetree($forum->{forumroot}."/recent.html",$tree,$lockfd);
+}
+sub getperms {
+ my $dir = shift;
+ local $_;
+ my $key;
+ my %users=(admins=>"",moderators=>"",banned=>"");
+ if (open F,"<",$dir."/perms.txt") {
+ while ( /sg;
+ $text=~s/\r?\n/ $text
/sg;
+ $text = "