X-Git-Url: http://wagner.pp.ru/gitweb/?a=blobdiff_plain;f=forum%2Fforum;h=e7cbc9218f6e23ae34691ed508adc207a72147c9;hb=89667c75001818612ff7456840d369954560e76a;hp=33dc75525c1cbf2dcfa67597f2717c9bafebb4ff;hpb=2c5e6e0e562230816a01308a0daee850958a953a;p=oss%2Fstilllife.git
diff --git a/forum/forum b/forum/forum
index 33dc755..e7cbc92 100755
--- a/forum/forum
+++ b/forum/forum
@@ -1,12 +1,29 @@
#!/usr/bin/perl -T
-
+#
+# Stil Life forum. Copyright (c) by Victor B. Wagner, 2008
+# This program distributed under GNU Affero General Public License v3 or
+# above
+# http://www.gnu.org/licenses/agpl.html
+#
+# ÐкÑаÑÑе: ÐÑли Ð²Ñ Ð¸ÑполÑзÑеÑе ÑÑÐ¾Ñ ÑкÑÐ¸Ð¿Ñ Ð½Ð° Ñвоем ÑайÑе, ÐÑ Ð¾Ð±ÑзанÑ
+# ÑделаÑÑ Ð´Ð¾ÑÑÑпнÑм его иÑÑ
однÑй ÑекÑÑ. Ð ÑаÑÑноÑÑи, еÑли ÐÑ Ð²Ð½ÐµÑли
+# какие-либо изменениÑ, Ð²Ñ Ð´Ð¾Ð»Ð¶Ð½Ñ ÑÑи Ð¸Ð·Ð¼ÐµÐ½ÐµÐ½Ð¸Ñ Ð¾Ð¿ÑбликоваÑÑ.
+#
+# Home site of this program http://vitus.wagner.pp.ru/stilllife
+#
use strict;
use warnings;
+use Fcntl qw(:DEFAULT :flock);
use CGI;
use HTML::TreeBuilder;
use Storable qw(freeze thaw);
use Date::Parse;
use Email::Valid;
+use Image::Size;
+use HTML::BBReverse;
+use POSIX;
+use LWP::UserAgent;
+use Net::OpenID::Consumer;
#
# ÐÐ°Ð±Ð¾Ñ Ð¿Ð¾Ð´Ð´ÐµÑживаемÑÑ
дейÑÑвий. Ð¥ÑÑ Ð²Ð¸Ð´Ð°
# "Ð¸Ð¼Ñ Ð¿Ð¾Ð»Ñ Ð² запÑоÑе" => "ÑÑнкÑÐ¸Ñ Ð¾Ð±ÑабоÑÑик"
@@ -25,11 +42,27 @@ my %actions = (
openidlogin=>\&openid_login,
openidvfy =>\&openid_verify
);
+#
+# УÑÐ¾Ð²ÐµÐ½Ñ Ð¿Ñав, коÑоÑÑе необÑ
одимо имеÑÑ Ð¿Ð¾Ð»ÑзоваÑÐµÐ»Ñ Ð´Ð»Ñ ÑовеÑÑениÑ
+# опÑеделенного дейÑÑвиÑ
+# иеÑаÑÑ
Ð¸Ñ Ð²Ð¸Ð´Ð° undef < banned < normal < author < moderator "login",
+ edit => "author",
+ delete => "author",
+ newtopic => "normal",
+ move => "moderator",
+ newforum => "moderator",
+ profile => "normal",
+ setrights => "admin",
+);
-
-
my $cgi = new CGI;
-
+print STDERR "--------------------\n";
my $forum=get_forum_config();
@@ -38,7 +71,9 @@ if ($cgi->request_method ne "POST") {
# ÐапÑÐ¾Ñ Ðº ÑкÑипÑÑ Ð¼ÐµÑодом GET. Ðадо показаÑÑ ÑоÑмÑ, еÑли ÑолÑко ÑÑо не
# ÑедиÑÐµÐºÑ Ð¾Ñ OpenId-ÑеÑвеÑа
if ($cgi->param('openidvfy')) {
- openid_verify($cgi);
+ openid_verify($cgi,$forum);
+ } elsif ($cgi->param("logout")) {
+ logout('logout',$cgi,$forum);
} else {
for my $param ($cgi->param) {
# СÑеди паÑамеÑÑов, ÑказаннÑÑ
в URL иÑем ÑоÑ, коÑоÑÑй задаеÑ
@@ -52,7 +87,7 @@ if ($cgi->request_method ne "POST") {
exit;
} else {
if (!$forum->{"authenticated"}) {
- $cgi->param("returnto",$cgi->uri(-full=>1));
+ $cgi->param("returnto",$cgi->url(-full=>1));
show_template("login",$cgi,$forum);
exit;
@@ -70,12 +105,44 @@ if ($cgi->request_method ne "POST") {
# ÐапÑÐ¾Ñ Ð¼ÐµÑодом POST. ÐÑзÑваем обÑабоÑÑик
for my $param ($cgi->param) {
if (exists $actions{$param}) {
- $actions{$param}->($param,$cgi,$forum);
- exit;
+ if (allow_operation($param,$cgi,$forum)) {
+ $actions{$param}->($param,$cgi,$forum);
+ exit;
+ } else {
+ show_error($forum,"У ÐÐ°Ñ Ð½ÐµÑ Ð¿Ñав на вÑполнение ÑÑой
+ опеÑаÑии")
+ }
+
}
- }
+ }
+ print STDERR "ÐолÑÑÐµÐ½Ñ Ð¿Ð°ÑамеÑÑÑ ",join(" ",$cgi->param),"\n";
show_error($forum,"ÐекоÑÑекÑнÑй вÑзов ÑкÑипÑа. ÐÑÑÑÑÑÑвÑÐµÑ Ð¿Ð°ÑамеÑÑ Ð´ÐµÐ¹ÑÑвиÑ");
}
+
+sub dir2url {
+ my ($cgi,$dir) = @_;
+ my $prefix="";
+ my $pos=rindex $ENV{'PATH_TRANSLATED'},$ENV{'PATH_INFO'};
+ if ($pos <0 && $ENV{'PATH_INFO'}=~m!(/\~\w+)/!) {
+ $prefix .=$1;
+ $pos =
+ rindex($ENV{'PATH_TRANSLATED'},substr($ENV{'PATH_INFO'},length($1)));
+ }
+ if ($pos <0) {
+ show_error({},"ÐÑибка конÑигÑÑаÑии ÑоÑÑма. Ðе ÑдаеÑÑÑ Ð¾Ð¿ÑеделиÑÑ
+ алгоÑиÑм пÑеобÑÐ°Ð·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð´Ð¸ÑекÑоÑи в URL\n".
+ "PATH_INFO=$ENV{PATH_INFO}\n".
+ "PATH_TRANSLATER=$ENV{'PATH_TRANSLATED'}");
+ }
+ my $root = substr($ENV{'PATH_TRANSLATED'},0,$pos);
+ if (substr($dir,0,length($root)) ne $root) {
+ show_error({},"ÐÑибка конÑигÑÑаÑии ÑоÑÑма. Ðе ÑдаеÑÑÑ Ð¿ÑеобÑазоваÑÑ
+ Ð¸Ð¼Ñ Ð´Ð¸ÑекÑоÑии $dir в url\n".
+ "PATH_INFO=$ENV{PATH_INFO}\n".
+ "PATH_TRANSLATER=$ENV{'PATH_TRANSLATED'}");
+ }
+ return $prefix.substr($dir,length($root));
+}
#
# ÐоиÑк Ñайла .forum ввеÑÑ
по деÑÐµÐ²Ñ Ð¾Ñ $ENV{PATH_TRANSLATED}
# ÐнаÑение PATH_TRANSLATED ÑÑиÑаем безопаÑнÑм - Ð½Ð°Ñ web-ÑеÑÐ²ÐµÑ Ð½Ð°Ð¼ не
@@ -86,7 +153,6 @@ if ($cgi->request_method ne "POST") {
sub get_forum_config {
my @path=split("/",$1) if $ENV{PATH_TRANSLATED}=~/^(\S+)$/;
while (@path>1) {
- pop @path;
if (-r (my $config=join("/",@path,".forum")) ) {
open F,"<",$config;
my %config;
@@ -96,6 +162,10 @@ sub get_forum_config {
}
close F;
#
+ # ÐеÑÐµÐ¼ÐµÐ½Ð½Ð°Ñ forumtop - ÑÑо URL Ñого меÑÑа, где наÑ
одиÑÑÑ
+ # Ñайл .forum
+
+ $config{"forumtop"} = dir2url($cgi,join("/",@path));
# ÐÑли в конÑиге оÑÑÑÑÑÑвÑÐµÑ Ð¿ÐµÑÐµÐ¼ÐµÐ½Ð½Ð°Ñ templates, но
# ÑÑдом Ñ ÐºÐ¾Ð½Ñигом пÑиÑÑÑÑÑвÑÐµÑ Ð´Ð¸ÑекÑоÑÐ¸Ñ templates,
# Ñо ÑÐ°Ð±Ð»Ð¾Ð½Ñ Ñам.
@@ -104,36 +174,38 @@ sub get_forum_config {
&& -d (my $filename = join("/",@path,"templates"))) {
$config{"templates"} = $filename;
}
+ $config{"templatesurl"} = dir2url($cgi,$config{"templates"})
+ unless exists $config{"templatesurl"};
#
# То же Ñамое - паÑамеÑÑ userdir и диÑекÑоÑÐ¸Ñ users
#
if (! exists $config{"userdir"}
&& -d (my $filename = join("/",@path,"users"))) {
$config{"userdir"} = $filename;
- my
- $taillen=length($ENV{PATH_TRANSLATED})-length(join("/",@path));
- $config{"userurl"} =
- $cgi->url(-base=>1).substr($ENV{'PATH_INFO'},0,
- length($ENV{'PATH_INFO'})-$taillen)."/users";
- }
+ }
+ $config{"userurl"} = dir2url($cgi,$config{"userdir"});
+
#
# ÐÑли Ð½ÐµÑ ÑÑÑлки в конÑиге на Ñайл паÑолей или он не
# ÑÑÑеÑÑвÑеÑ, вÑдаем оÑибкÑ. С оÑоÑомлением, Ñак как ÑаблонÑ
# Ñ Ð½Ð°Ñ Ñже еÑÑÑ
- if (! exists $config{"passwd"}) {
- show_error(\%config,"РконÑигÑÑаÑии ÑоÑÑма не Ñказан Ñайл полÑзоваÑелей");
+ if (!exists $config{"datadir"}) {
+ show_error(\%config,"РконÑигÑÑаÑии ÑоÑÑма не Ñказана
+ диÑекÑоÑÐ¸Ñ Ð´Ð°Ð½Ð½ÑÑ
");
exit;
}
- if (!exists $config{"session"}) {
- show_error(\%config,"РконÑигÑÑаÑии ÑоÑÑма не Ñказан Ñайл ÑеÑÑий");
+ if (!-d $config{"datadir"}) {
+ show_error(\%config,"РконÑигÑÑаÑии ÑоÑÑма Ñказана неÑÑÑеÑÑвÑÑÑÐ°Ñ Ð´Ð¸ÑекÑоÑÐ¸Ñ Ð´Ð°Ð½Ð½ÑÑ
");
exit;
}
- $config{"authperiod"}="+1m" if (! exists $config{"authperiod"});
+ $config{"authperiod"}="+1M" if (! exists $config{"authperiod"});
$config{"renewtime"} = "86000" if (!exists $config{"renewtime"});
+ $config{"replies_per_page"} = 50 if (!exists $config{"replies_per_page"});
return \%config;
}
+ pop @path;
}
#
# ÐÑводим оÑÐ¸Ð±ÐºÑ 404 без оÑмÑÑленного оÑоÑмлениÑ, Ñак как даннÑÑ
ÑоÑÑма
@@ -173,6 +245,19 @@ sub show_error {
$cgi->escapeHTML($msg),"
",
"ÐÑи обÑабоÑке ÑÑой оÑибки не обнаÑÑжен Ñаблон ÑообÑÐµÐ½Ð¸Ñ Ð¾Ð± оÑибке