#
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);
}
#
# Обработка результатов заполнения формы регистрации.
}
}
}
+ $cgi->delete("required");
my %userbase;
dbmopen %userbase,datafile($forum,"passwd"),0644
or form_error($formname,$cgi,$forum,"Ошибка открытия файла паролей $!");
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 $out;
my $filename = $1 if $cgi->param("avatarfile")=~/([^\/\\]+)$/;
- open $out,">",$forum->{"userdir"}."/".$filename;
+ my $path = $forum->{"userdir"}."/".$userprefix."_".$filename;
+ open $out,">",$path;
binmode $out,":bytes";
my $buffer;
while (my $bytes = read($f,$buffer,4096)) {
}
close $f;
close $out;
- my ($w,$h) = imgsize($forum->{"userdir"}."/".$filename);
- $userinfo->{'avatar'}= {src=>$forum->{"userurl"}."/".$filename,
+ my ($w,$h) = imgsize($path);
+ $userinfo->{'avatar'}= {src=>$forum->{"userurl"}."/".$userprefix."_".$filename,
width=>$w,height=>$h};
- $cgi->delete("avatar");
- $cgi->delete("avatarfile");
+ } 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 = split /\s*,\s*/, $forum->{restricted_user_info};
- set_default_user_attrs($forum,$userinfo);
+ 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);
$userinfo->{$param} = $cgi->param($param);
}
}
- $userinfo->{registered} = time;
- if (exists $forum->{default_status}) {
- $userinfo->{status} = $forum->{default_status};
- }
- 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,$returnto);
- } else {
- # FIXME Email validation
- # Email to admin
- show_template("newuser",$cgi,$forum);
- }
+}
+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 $userinfo =thaw($base{$user});
$userinfo->{"user"} = $user;
substitute_user_info($block,$forum,$userinfo);
- profile_links($block,$user,$rights,$forum);
+ profile_links($block,$user,$rights,$cgi,$forum);
}
$usertpl->delete;
} else {
$tree = gettemplate($forum,"user");
substinfo($tree,[_tag=>"title"],_content=>"Stilllife user: $user");
substitute_user_info($tree,$forum,$userinfo);
- profile_links($tree,$user,$rights,$forum);
+ profile_links($tree,$user,$rights,$cgi,$forum);
unless ($userinfo->{openiduser}) {
for my $userlink ($tree->look_down(_tag => "a",class=>"author")) {
$userlink->attr("href",undef);
$page;
}
sub profile_links {
- my ($tree,$user,$rights,$forum)=@_;
+ my ($tree,$user,$rights,$cgi,$forum)=@_;
foreach my $profile_link ($tree->look_down(_tag=>"a",
href=>qr/profile=/)) {
if ((defined $rights && $rights eq "admin")||
savetree($path_translated,$tree,$lockfd);
record_statistics($forum,"message"),
update_topic_list($forum,$path_translated,$msgcount,$posted);
- forum_redirect($cgi,$forum);
-
+ forum_redirect($cgi,$forum,$cgi->path_info."#$id");
}
sub update_topic_list {
my ($forum,$topic,$count,$date) = @_;
if (!$forum->{authenticated}) {
return undef;
}
+ return $forum->{authenticated}{rights} if
+ exists $forum->{authenticated}{rights};
my $user = $forum->{authenticated}{user};
my $dir = $path_translated;
$dir =~s/\/$//;
chomp;
if ($user eq $_ && defined $status) {
if ($status eq "banned") {
- return $status;
+ return $forum->{authenticated}{rights}=$status;
}
if ($status eq "admins" ) {
- return "admin";
+ return $forum->{authenticated}{rights}="admin";
}
$user_status = "moderator";
}
# Strip last path component.
$dir =~s/\/[^\/]+$//
}
- return $user_status;
+ return $forum->{authenticated}{rights}=$user_status;
}
required_root => $cgi->url(-base=>1));
}
+
# openidstart - вызывается когда обнаружено что текущее имя
# пользователя, пытающегося аутентифицироваться, содержит http://
#
}
}
+sub get_avatar_info {
+ my ($url,$ua) = @_;
+ $ua = LWP::UserAgent->new( agent => "Stilllife/1.0") unless $ua;
+ my $response = $ua->get($url);
+ if ($response->is_success) {
+ my $image = $response->content;
+ my ($w,$h,$type) = imgsize(\$image);
+ return {width=>$w,height=>$h,type=>$type,src=>$url};
+ } else {
+ print STDERR "Error getting $url: ".$response->status_line,"\n";
+ return undef;
+ }
+}
+
sub get_foaf {
my ($ua,$foaf_url) = @_;
my $response = $ua->get($foaf_url);
my $foaf = $response->content;
my %info = foaf_parse($foaf);
if ($info{avatar}) {
- $response = $ua->get($info{avatar});
- if ($response->is_success) {
- my $image = $response->content;
- my ($w,$h,$type) = imgsize(\$image);
- $info{avatar}={width=>$w,height=>$h,type=>$type,src=>$info{avatar}};
- } else {
- print STDERR "Error getting $info{avatar}: ".$response->status_line,"\n";
- }
+ $info{avatar} = get_avatar_info($info{avatar},$ua);
}
return %info;
}
+
sub foaf_parse {
my $foaf = shift;
my ($starttag) = $foaf =~ /<(\w+(:\w+)?[^>]+)>/sg;