From: Victor Wagner <vitus@wagner.pp.ru>
Date: Tue, 18 Mar 2008 21:43:19 +0000 (+0000)
Subject: Registration form seems to work
X-Git-Url: http://wagner.pp.ru/gitweb/?a=commitdiff_plain;h=4a6fbbacea03ccd8fad6564542d9316efffd7b17;p=oss%2Fstilllife.git

Registration form seems to work
---

diff --git a/forum/forum b/forum/forum
new file mode 100755
index 0000000..cecacc3
--- /dev/null
+++ b/forum/forum
@@ -0,0 +1,526 @@
+#!/usr/bin/perl -T
+
+use strict;
+use warnings;
+use CGI;
+use HTML::TreeBuilder;
+use Storable qw(freeze thaw);
+use Date::Parse;
+use Email::Valid;
+#
+# Набор поддерживаемых действий. Хэш вида 
+# "имя поля в запросе" =>  "функция обработчик"
+#
+my %actions = (
+	reply => \&reply,
+	edit => \&edit_comment,
+	delete => \&delete_comment,
+	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 $cgi = new CGI;
+
+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;
+		}
+	}	
+	show_error($forum,"Некорректный вызов скрипта. Отсутствует параметр действия");
+}	
+#
+# Поиск файла .forum вверх по дереву от $ENV{PATH_TRANSLATED}  
+# Значение PATH_TRANSLATED считаем безопасным - наш web-сервер нам не
+# враг.
+# Возвращает список имя,значение, имя, значение который прививается в
+# хэш
+
+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;
+			while (<F>) {
+				s/#.*$//; #Drop comments;
+				$config{$1}=$2 if /(\w+)\s*=\s*(\S.*)$/;
+			}	
+			close F;
+			#
+			# Если в конфиге отсутствует переменная 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;
+			}		
+			# 
+			# То же самое - параметр userdir и директория users
+			#
+			if (! exists $config{"userdir"} 
+				&& -d (my $filename = join("/",@path,"users"))) {
+					$config{"userdir"} = $filename;
+			}		
+			#
+			# Если нет ссылки в конфиге на файл паролей или он не 
+			# существует, выдаем ошибку. С офоромлением, так как шаблоны
+			#  у нас уже есть
+			if (! exists $config{"passwd"}) {
+				show_error(\%config,"В конфигурации форума не указан файл пользователей");
+				exit;
+			}
+			if (!exists $config{"session"}) {
+				show_error(\%config,"В конфигурации форума не указан файл сессий"); 
+				exit;
+			}
+			$config{"authperiod"}="+1m" if (! exists $config{"authperiod"}); 
+			$config{"renewtime"} = "86000" if (!exists $config{"renewtime"});
+			return \%config;
+		}
+	}
+	#
+	# Выводим ошибку 404 без осмысленного оформления, так как данных форума
+	# мы не нашли
+	print "Status: 404\nContent-Type: text/html; charset=utf-8\n\n",
+	"<HTML><HEAD><TITLE>Форум не обнаружен</TITLE></HEAD><BODY>",
+	"<H!>Форум не найден</H!>",
+	"<p>Хвост URL, указанный при вызове скрипта  показывает не на
+	форум</p>",
+	# To make IE think this page is user friendly
+	"<!--",("X" x 512),"--></body></html>\n"; 
+	exit;
+}
+#
+# Вывод сообщения об ошибке по шаблону форума
+# Шаблон должен содержать элемент с классом error.
+#
+sub show_error {
+	my ($cfg,$msg) = @_;
+	if ( -r $cfg->{"templates"}."/error.html") {
+		my $tree = HTML::TreeBuilder->new_from_file($cfg->{"templates"}."/error.html");
+		my $node= $tree->find_by_attribute('class','error');
+		my $body;
+		if (!$node) {
+			$body = $tree->find_by_tagname('body');
+			$body->push_content($node = new
+			HTML::Element('div','class'=>'error'));
+		}
+		$node->delete_content;
+		$node->push_content($msg);
+		print $cgi->header(-type=>'text/html',-charset=>'utf-8');
+		print $tree->as_HTML("<>&");
+	} else {
+		print STDERR "templates= $cfg->{templates}\n" ;
+		print $cgi->header(-type=>'text/html',-charset=>'utf-8');
+		print "<html><head><title>Ошибка конфигурации форума</title></head>",
+		"<body><h1>Ошибка конфигурации форума</h1><p>",
+		$cgi->escapeHTML($msg),"</p>",
+		"<p>При обработке этой ошибки не обнаружен шаблон сообщения об ошибке</p></body></html>";  
+	}
+}	
+#
+# Вывод шаблона формы. В шаблоне должна присутстовать форма с  
+# именем, совпадающим с именем form. Если в $cgi есть параметры, имена
+# которых совпадают с именами полей этой формы, их значения
+# подставляются
+#
+sub show_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);
+	# Находим форму с классом $form
+	my $f = $tree->look_down("_tag","form",
+		"name",$form);
+	if (! defined $f) {
+		# Если не нашли - ругаемся
+		show_error($forum,"Шаблон для операции $form не содержит формы с
+		именем $form");
+		exit;
+	}
+	if (!$cgi->param("returnto")) {
+		$cgi->param("returnto", $cgi->referer||$cgi->url(-absolute=>1,-path_info=>1));
+
+	}	
+	if (!$cgi->param($form)) {
+		$cgi->param($form,1);
+	}	
+	# 
+	# Если ранее была выставлена ошибка с помощью set_error, подставляем
+	# сообщение в элемент с классом error
+	#
+	if ($forum->{error_message}) {
+		my $errormsg = $tree->look_down("class"=>"error");
+		if ($errormsg) {
+			$errormsg->delete_content();
+			$errormsg->push_content($forum->{error_message});
+		}
+	}	
+	if ($forum->{"authenticated"}) {
+		# Подставляем информацию о текущем пользователе если в шаблоне
+		# это предусмотрено 
+		substitute_user_info($tree,$forum);
+	}
+	my %substituted;
+	for my $element($f->find_by_tag_name("textarea","input","select")) {
+		my $name = $f->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","");
+ 					} else {
+						$f->attr("checked",undef);
+					}
+				
+				} elsif ($f->attr("type") eq
+				"radio") {
+					if ($f->attr("value") eq $cgi->param($name)) {
+						$f->attr("checked","");
+ 					} else {
+						$f->attr("checked",undef);
+					}
+				} else {	
+				$f->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","");
+					} else {	
+						$option->attr("selected",undef);
+					}	
+				}
+
+			}
+		}
+
+	}
+	$f->attr("type","POST");
+	$f->attr("action",$cgi->url(-full=>1,-path_info=>1,-query=>0));
+	for my $required ($form,"returnto") {
+		if (!$substituted{$required}) {
+			my $element = new HTML::Element('input',
+				'type' => 'hidden', 'name' => $required,
+				'value'=> $cgi->param($required));
+			$f->push_content($element);
+		}
+	}	
+				
+		
+	print
+	$cgi->header(type=>"text/html",charset=>"utf-8",($forum->{cookies}?(-cookie=>$forum->{cookies}):())),
+	$tree->as_HTML("<>&");
+}
+
+#
+# Подставляет в заданное поддерево информацию о пользователе
+#
+
+sub substitute_user_info {
+
+my ($tree,$forum) = @_;
+my %userinfo = %{$forum->{"authenticated"}};
+
+#
+# Специально обрабатываем поля user (должна быть ссылка) и avatar  
+# (должен быть img).
+
+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);
+	}
+
+}
+
+}
+#
+# Авторизует зарегистрированного пользователя.
+# 1. Проверяет куку если есть
+#
+
+sub authorize_user	{
+	($cgi,$forum) = @_;
+	if (my $session=$cgi->cookie("slsession")) {
+	# Пользователь имеет куку
+		my %sessbase; 	
+		dbmopen %sessbase,$forum->{"session"},0644;
+			if (exists($sessbase{$session}))  {
+				my ($user,$expires,$ip)=split(";", $sessbase{$session});
+				if (!defined $ip|| $ip eq $ENV{'REMOTE_ADDR'}) {
+					my %userbase;
+					dbmopen %userbase,$forum->{"passwd"},0644;
+					if ( exists($userbase{$user})) {
+						my $userinfo = thaw($userbase{$user});
+						delete $userinfo->{"passwd"};
+						$userinfo->{"user"} = $user;
+						if ($expires-time()< $forum->{"renewtime" }) {
+							delete $sessbase{$session};
+							newsession(\%sessbase,$forum,$user,$ip);
+						}
+						$forum->{"authenticated"}=$userinfo;
+					}	
+					dbmclose %userbase; 
+				}	
+			}	
+		dbmclose %sessbase;
+	}
+}
+
+#
+# Создает новую сессию для пользователя и подготавливает куку которую
+# сохраняет в хэше конфигурации форума
+# 
+sub newsession {
+	my ($base,$forum,$user,$bindip) = @_;
+	if (!defined $base) {
+		$base = {};
+		dbmopen %$base,$forum->{"session"},0644;
+	}	
+	my $sessname;
+	my $t = time();
+	my ($u,$expires,$ip);
+	do {
+		$sessname = sprintf("%08x",rand(0xffffffff));
+		if ($base->{"sessname"}) {
+			($u,$expires,$ip) = split ";", $base->{$sessname};
+			delete $base->{$sessname} if $expires < $t;
+		}
+	} while ($base->{$sessname});
+	my $cookie = $cgi->cookie(-name=>"slsession",
+		-expires => $forum->{"authperiod"},-value=> $sessname);
+	$base->{$sessname}=$user.";".str2time($cookie->expires()).
+		($ip?";$ENV{'REMOTE_ADDR'}":"");
+		
+	$forum->{'cookie'}=[ $cookie,
+	$cgi->cookie(-name=>"sluser",-value=>$user,-expires =>
+	$forum->{authperiod})];			  	
+}
+#
+# Выполняет аутентикацию пользователя по логину и паролю и 
+# создает для него сессию.
+#
+sub authenticate {
+	my ($cgi,$forum) = @_; 	
+	if ($cgi->param("openidsite")) {
+		my $openid_url = sprintf($cgi->param("openidsite",$cgi->param("user")));
+		openidstart($cgi,$openid_url);
+	}	
+	my %userbase;
+	dbmopen %userbase,$forum->{"passwd"},0644;
+	my $user = $cgi->param("user");
+	if (! $userbase{$user}) {
+	  set_error($forum,"Неверное имя пользователя или пароль");
+	  return undef;
+	}   
+	my $userinfo = thaw($userbase{$user}) ;
+	dbmclose %userbase;
+	if (crypt($user,$userinfo->{passwd}) eq $userinfo->{passwd}) {
+		delete $userinfo->{"passwd"};
+		$userinfo->{"user"} = $user;
+		newsession(undef,$forum,$user);
+		$forum->{"authenticated"} = $userinfo;		
+	} else {
+		set_error($forum,"Неверное имя пользователя или пароль");
+	}	
+}
+#
+# Запоминает сообщение об ошибке для последующего вывода show_template
+#
+sub set_error {
+	my  ($forum,$message) = @_;
+	$forum->{error_message} = $message;
+}	
+#
+# Выводит текущий шаблно с сообщением об ошибке
+#
+sub form_error {
+	my ($form_name,$cgi,$forum,$msg) = @_;
+	set_error($forum,$msg);
+	show_template($form_name,$cgi,$forum);
+	exit;
+}	
+#
+# Обработка результатов заполнения формы регистрации.
+#
+#
+sub register {
+	my ($formname,$cgi,$forum) = @_; 
+	#
+	# Возможные ошибки: 
+	# 1 Такой юзер уже есть
+	#
+	#  не заполнено поле user 
+	if (!$cgi->param("user")) {
+		form_error($formname,$cgi,$forum, "Не заполнено имя пользователя");
+	}	
+	#  или поле password 
+	if (!$cgi->param("pass1"))  {
+		form_error($formname,$cgi,$forum,"Не указан пароль");
+	}	
+	#  Копии пароля не совпали
+	if ($cgi->param("pass2") ne $cgi->param("pass1")) {
+		form_error($formname,$cgi,$forum,"Ошибка при вводе пароля");
+	}		
+	my $user = $cgi->param("user");
+	# Не указаны поля, перечисленные в скрытом поле required 
+	if ($cgi->param("required")) { 
+		foreach my $field (split(/\s*,\s*/,$cgi->param('required'))) {
+			if (!$cgi->param($field)) {
+				form_error($formname,$cgi,$forum,"Не заполнено обязательное поле $field");
+			}
+		}	
+	}
+	my %userbase;
+	dbmopen %userbase,$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 $saltstring = 'ABCDEFGHIJKLMNOPQRSTUVWXUZabcdefghijklmnopqrstuvwxuz0123456789./';
+	my $salt = substr($saltstring,int(rand(64)),1).
+				substr($altstring,int(rand(64)),1);
+	my $password=crypt($cgi->param("pass1",$salt));			
+	my $userinfo = {passwd=>$password};
+	# Удаляем лишние поля
+	$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");
+	# Если есть аватар в файле, то сохраняем этот файл и формируем URL
+	# на него.
+	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;
+		binmode $out,":bytes";
+		my $buffer;
+		while (my $bytes = read($f,$buffer,4096)) {
+			print $out $buffer;
+		}	
+		close $f;
+		close $out;
+		$userinfo->{'avatar'}= $forum->{"userurl"}."/".$filename;
+		$cgi->delete("avatar");
+		$cgi->delete("avatarfile");
+	}
+	
+	foreach my $param 	($cgi->param) {
+		$userinfo->{$param} = $cgi->param($param);
+	}
+	$userinfo->{registered} = time;
+	if (exists $forum->{default_status}) {
+		$userinfo->{status} = $forum->{default_status};
+	}
+	print STDERR "registering user $user\n";
+	$userbase{$user} = freeze($userinfo);
+	dbmclose %userbase;
+	newsession(undef,$forum,$user);
+	if (defined $returnto) {
+		forum_redirect($returnto) 
+	} else {
+		forum_redirect($cgi->url(-base=>1).$ENV{PATH_INFO});
+	}	
+
+}	
+
+sub allow_operation {
+	my ($operation,$cgi,$forum) = @_;
+	return 1 if (grep $operation eq $_,"register","login","reply");
+
+	return 1;
+}