Restructured method dispatching. Fixed html escaping in text formatting

mode, added show_messageedit

diff --git a/forum/forum b/forum/forum
index bc685450577ae4cfd35d1e81175f1304172b3af6..1cff61efef608c52549773f51fda09e4ab2b3bc8 100755 (executable)
--- a/forum/forum
+++ b/forum/forum
@@ -28,103 +28,47 @@ use Net::OpenID::Consumer;
 # Набор поддерживаемых действий. Хэш вида 
 # "имя поля в запросе" =>  "функция обработчик"
 #
-my %actions = (
-       reply => \&reply,
-       edit => \&edit_comment,
-       delete => \&delete_item,
-       move => \&move_comment,
-       newtopic=> \&new_topic,
-       newforum=> \&new_forum,
-       login => \&login,
-       register=>\&register,
-       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=>\&register,GET=>\&show_template},
+       {name=>"profile",POST=>\&profile,GET=>\&show_profile,rights=>"normal"},
+       {name=>"setrights",POST=>\&set_rights,GET=>\&show_rights,rights=>"admin"},
 );     
 #
-#  Уровень прав, которые необходимо иметь пользователю для совершения
-#  определенного действия
-#  иерархия вида undef < banned < normal < author < moderator <admin
-#  Если операция не упомянута в данном массив, то значит можно всем, в
-#  том числе  и анониму.
-# Слово login означает, что вообще-то это normal, но пользователь может
-# логиниться непосредственно в процессе выполнения операции.
-my %permissions = (
-       reply => "login",
-       edit => "author",
-       delete => "author",
-       newtopic => "normal",
-       move => "moderator",
-       newforum => "moderator",
-       profile => "normal",
-       setrights => "admin",
-);     
 our $path_translated; # Untainted value of PATH_TRANSLATED env var
 my $cgi = new CGI;
 print STDERR "--------------------\n";
 my $forum=get_forum_config();
 
 authorize_user($cgi,$forum);
-if ($cgi->request_method ne "POST") {
-# Запрос к скрипту методом GET. Надо показать форму, если только это не
-# редирект от OpenId-сервера 
-       if ($cgi->param('openidvfy')) { 
-               openid_verify($cgi,$forum);
-       } elsif ($cgi->param("logout")) {
-               logout('logout',$cgi,$forum);
-       } elsif ($cgi->param("profile")) {
-               show_profile("profile",$cgi,$forum);
-       } elsif ($cgi->param('delete')) {
-               delete_item("delete",$cgi,$forum);
-       } else {
-               for my $param ($cgi->param) {
-# Среди параметров, указанных в URL ищем тот, который задает
-# действие 
-                       if (exists $actions{$param}) {
-# Мы, конечно уже проверили, что в названии параметра
-# нехороших символов нет, но чтобы perl в taint mode не
-# ругался... 
-                               if (allow_operation($param,$cgi,$forum)) {
-                                       print STDERR "Allow_operation completed\n";
-                                       show_template($1,$cgi,$forum) if $param=~/^(\w+)$/;     
-                                       exit;
-                               } else {
-                                       if (!$forum->{"authenticated"}) { 
-                                               $cgi->param("returnto",$cgi->url(-full=>1));
-                                               show_template("login",$cgi,$forum);
-                                               exit;
-
-                                       } else {
-                                               show_error($forum,"У Вас нет прав на  выполнение этой
-                                               операции")
-                                       }
-                               }       
-                       }
-               }
-               if (index($path_translated,$forum->{userdir})==0) {
-                       show_user_page($cgi,$forum);
-               }       
-               show_error($forum,"Некорректный вызов скрипта. Отсутствует параметр
-                               действия");
-       }       
-} else {
-       # Запрос методом POST. Вызываем обработчик
-       for my $param ($cgi->param) {
-               if (exists $actions{$param}) {
-                       if (allow_operation($param,$cgi,$forum)) {
-                               $actions{$param}->($param,$cgi,$forum);
-                               exit;
-                       } else {
-                               show_error($forum,"У Вас нет прав на  выполнение этой
-                               операции")
-                       }
-
+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,"У Вас нет прав на  выполнение этой операции")
                }
        }
-       print STDERR "Получены параметры ",join(" ",$cgi->param),"\n";
-       show_error($forum,"Некорректный вызов скрипта. Отсутствует параметр действия");
 }      
+if (index($path_translated,$forum->{userdir})==0) {
+       show_user_page($cgi,$forum);
+}      
+show_error($forum,"Некорректный вызов скрипта. Отсутствует параметр
+               действия");
+       
 
 #-------------------------------------------------------------- 
 #-------- Чтение конфигурационного файла и связанные с этим действия
@@ -284,6 +228,7 @@ sub send_to_user {
        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) = @_;
@@ -521,7 +466,7 @@ if (defined $user) {
 #
 
 sub authorize_user     {
-       ($cgi,$forum) = @_;
+       my ($cgi,$forum) = @_;
        if (my $session=$cgi->cookie("slsession")) {
        # Пользователь имеет куку
                my %sessbase;   
@@ -1023,16 +968,16 @@ sub logout {
 }      
 sub allow_operation {
        my ($operation,$cgi,$forum) = @_;
-       return 1 if (!exists($permissions{$operation})); 
+       return 1 if (!exists($operation->{rights})); 
        if (!$forum->{authenticated}) {
-               return 1 if ($permissions{$operation} eq "login");
+               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 ($permissions{$operation} eq "admin");      
+       return 0 if ($operation->{rights} eq "admin");  
        return 1 if ($accesslevel eq "moderator");
        return 0 if $accesslevel eq "banned";   
        return 1;
@@ -1433,10 +1378,34 @@ sub new_forum {
 
        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) = @_;
        #
@@ -1444,18 +1413,42 @@ sub delete_item {
        #
        if ($cgi->param("user")) {
                delete_user($cgi,$forum,$cgi->param("user"));
-       } elsif (-f $path_translated) {
-               if ($cgi->param("id")) {
-                       delete_comment($cgi,$forum,$path_translated,$cgi->param("id"));
-               } else {
-                       delete_topic($cgi,$forum,$path_translated);
-               }       
-       } elsif (-d $path_translated && -f $path_translated ."/".  $forum->{indexfile}) {
-               delete_forum($cgi,$forum,$path_translated);
-       } else {
-               show_error($forum,"Невозможно удалить неопознанный объект");
-       }
+       }       
+        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,"Невозможно переместить неопознанный объект");
+}
 # 
 # Удаление пользователя
 #
@@ -1472,6 +1465,20 @@ sub delete_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;
+       }
+}      
 #
 # Удаление реплики
 #
@@ -1480,13 +1487,8 @@ sub delete_comment {
        my ($tree,$lockfd) = gettree($topic);
        my ($msg) = $tree->look_down(id => $id);
        show_error($forum,"В данной теме нет реплики с id=$id") if (!$msg);
-       if (getrights($cgi,$forum) ne "moderator" 
-               && getrights($cgi,$forum) ne "admin") {
-               my $author= $msg->look_down(_tag=>"input",name=>"author");
-               if ($author->attr("value") ne $forum->{authenticated}{user}) {
-                       show_error($forum,"У вас нет прав на удаление этого сообщения");
-               }       
-       }
+       show_error($forum,"У вас нет прав на удаление этого сообщения")
+               unless moderator_or_author($cgi,$forum,$msg);           
        delete_from_list($tree,"messagelist","message",$msg);
        savetree($topic,$tree,$lockfd);
        $tree->delete;
@@ -1555,7 +1557,7 @@ sub delete_forum {
                $count ++;      
        }               
        closedir DIR;
-       show_error("Нельзя удалять непустой форум") if $count;
+       show_error($forum,"Нельзя удалять непустой форум") if $count;
        # Находим родительский форум
        my $upper = $dir;
        $upper=~s/([\/]+)$/$forum->{indexfile}/;
@@ -1575,7 +1577,49 @@ sub delete_forum {
        $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) = @_;
+}      
 #---------------------------------------------------------- 
 # База пользователей и права доступа
 #----------------------------------------------------------
@@ -1659,7 +1703,6 @@ sub gettree {
        open $f,"<",$filename or return undef;
        flock $f, LOCK_EX;
        my $tree = treefromfile($f);
-       $tree->parse_file($f);
        return ($tree,$f);
 }      
 #
@@ -1677,6 +1720,7 @@ sub savetree {
        unlink $filename;
        rename $filename.".new",$filename;
        close $lockfd if defined($lockfd);
+
 }      
 
 sub discardtree {
@@ -1798,7 +1842,7 @@ sub openidstart {
 # реплики) 
 #
 sub openid_verify {
-       my ($cgi,$forum) = @_;
+       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);
@@ -1908,9 +1952,10 @@ sub input2tree {
                my $parser = HTML::BBReverse->new(); 
                $text="<div class=\"bbcode\">".$parser->parse($text)."</div>";
        } elsif ($format eq "text") {
-               $text=~s/\r?\n\r?\n/<\/p><p class=\"text\">/;
-               $text=~s/\r?\n/<br>/;
-               $text = "<div><p class=\"text\">".escapeHTML($text)."</p></div>";
+               $text = escapeHTML($text);
+               $text=~s/\r?\n\r?\n/<\/p><p class=\"text\">/sg;
+               $text=~s/\r?\n/<br>/sg;
+               $text = "<div><p class=\"text\">$text</p></div>";
        } 
        my $txtree = str2tree($text);
        for my $badtag