Fixed processing of link rel="forum-user-list"

[oss/stilllife.git] / forum / forum

diff --git a/forum/forum b/forum/forum
index d6304459f3f485a8a6f90d52e43caaf6bfece69b..ba95dcd7afe29553812e56a91b4b2f4f3abca860 100755 (executable)
--- a/forum/forum
+++ b/forum/forum
@@ -19,6 +19,8 @@ use HTML::TreeBuilder;
 use Storable qw(freeze thaw);
 use Date::Parse;
 use Email::Valid;
+use LWP::UserAgent;
+use Net::OpenID::Consumer;
 #
 # Набор поддерживаемых действий. Хэш вида 
 # "имя поля в запросе" =>  "функция обработчик"
@@ -66,7 +68,7 @@ if ($cgi->request_method ne "POST") {
 # Запрос к скрипту методом GET. Надо показать форму, если только это не
 # редирект от OpenId-сервера 
        if ($cgi->param('openidvfy')) { 
-               openid_verify($cgi);
+               openid_verify($cgi,$forum);
        } elsif ($cgi->param("logout")) {
                logout('logout',$cgi,$forum);
        } else {
@@ -82,7 +84,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;
 
@@ -252,6 +254,7 @@ sub gettemplate {
        }
        my $tree = HTML::TreeBuilder->new_from_file($filename);
        fix_forum_links($forum,$tree,$url);
+       return $tree;
 }      
 #
 # Вывод шаблона формы. В шаблоне должна присутстовать форма с  
@@ -261,7 +264,8 @@ sub gettemplate {
 #
 sub show_template {
        my ($form,$cgi,$forum) = @_;
-       my $tree = get_template($forum,$form,$ENV{'PATH_INFO'});
+       my $tree = gettemplate($forum,$form,$ENV{'PATH_INFO'});
+
        # Находим форму с классом $form
        my $f = $tree->look_down("_tag","form",
                "name",$form);
@@ -373,6 +377,18 @@ sub fix_forum_links {
                } else {
                        $attr ="src";
                }
+               
+               # Обрабатываем наши специальные link rel=""
+               if ($element->tag eq "link") {
+                       if ($element->attr("rel") eq "forum-user-list") {
+                               $element->attr("href" => $cgi->url(-absolute=>1,
+                                       -path_info=>0,-query_string=>0).$forum->{userurl});
+                               next ELEMENT;   
+                       } elsif ($element->attr("rel") eq "forum-script")  {
+                               $element->attr("href" => $script_with_path);
+                               next ELEMENT;
+                       }       
+               }
                my $link = $element->attr($attr);
                # Абсолютная ссылка - оставляем как есть. 
                next ELEMENT if (! defined $link || $link=~/^\w+:/); 
@@ -520,8 +536,8 @@ sub newsession {
 sub authenticate {
        my ($cgi,$forum) = @_;  
        if ($cgi->param("openidsite")) {
-               my $openid_url = sprintf($cgi->param("openidsite",$cgi->param("user")));
-               openidstart($cgi,$openid_url);
+               my $openid_url = sprintf($cgi->param("openidsite"),$cgi->param("user"));
+               openidstart($cgi,$forum,$openid_url);
        }       
        my %userbase;
        dbmopen %userbase,datafile($forum,"passwd"),0644;
@@ -577,7 +593,8 @@ sub forum_redirect {
        my ($cgi,$forum,$url) = @_;
        if (!defined $url) {
                $url = $cgi->param("returnto");
-               $url = $cgi->url(-base=>1).$cgi->path_info() if (!$url);
+               $url =
+               $cgi->url(-base=>1).($cgi->path_info()||$forum->{forumtop}) if !$url ;
        }
        print $cgi->redirect(-url=>$url,
                ($forum->{cookies}?(-cookie=>$forum->{cookies}):()));
@@ -860,4 +877,87 @@ sub get_uid {
        close $f;
        return sprintf ("%08s",$id);
 }
+#
+# ----------------- OpenID registration -----------------------------
+# 
+sub create_openid_consumer {
+       my ($cgi,$forum) = @_;
+       return Net::OpenID::Consumer ->new(
+               ua => LWP::UserAgent->new(),
+               args => $cgi,
+               consumer_secret=>"X9RWPo0rBE7yLja6VB3d",
+               required_root => $cgi->url(-base=>1));
+}              
 
+# openidstart - вызывается когда обнаружено что текущее имя
+# пользователя, пытающегося аутентифицироваться, содержит http://
+#  
+#
+
+sub openidstart {
+       my ($cgi,$forum,$openidurl) = @_;
+       #
+       # Fix duplicated http:// which can be produced by our sprintf based
+       # login system
+       #
+       $openidurl=~s!^http://http://!http://!;
+       my $csr = create_openid_consumer($cgi,$forum);
+       my $claimed_identity=$csr->claimed_identity($openidurl);
+       if (!defined $claimed_identity) {
+               show_error($forum,"Указанная URL $openidurl не является OpenId");            
+               exit;
+       }
+       $cgi->param("openidvfy",1);
+       $cgi->delete("user");
+       $cgi->delete("openidsite");
+       $cgi->delete("password");
+       my $check_url = $claimed_identity->check_url(
+               return_to=> $cgi->url(-full=>1,-path_info=>1,-query=>1),
+               trust_root=> $cgi->url(-base=>1));
+       print $cgi->redirect(-location=>$check_url);
+       exit;
+}      
+#
+# Вызывается при редиректе от openid producer-а. Проверяет, что
+# удаленный сервер подтвердил openid и вызывает операцию для которой
+# (либо возврат на исходную страницу при операции login, либо постинг
+# реплики) 
+#
+sub openid_verify {
+       my ($cgi,$forum) = @_;
+       my $csr  = create_openid_consumer($cgi,$forum);
+       if (my $setup_url = $csr->user_setup_url) {
+               print $cgi->redirect(-location=>$setup_url);
+               exit;
+       } elsif ($csr->user_cancel) {
+               show_error($forum,"Ваш openid-сервер отказался подтвержать вашу
+               идентичность");
+               exit;
+       } elsif (my $vident = $csr->verified_identity) {
+               #Успешная аутентификация.         
+               #Создаем сессию
+               my $user = $vident->url; 
+               # Remove trailing slash from URL if any
+               $user=~s/\/$//;
+               my %userbase;
+               dbmopen %userbase,datafile($forum,"passwd"),0664;
+               if (!$userbase{$user}) {
+                       $userbase{$user} = $forum->{authenticated}={};
+               } else {
+                       $forum->{authenticated} = thaw ($userbase{$user});
+               }
+               dbmclose %userbase;
+               $forum->{"authenticated"}{"user"} = $user;
+               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;
+       }       
+}