}
if (exists $attrs{-cgi} && $attrs{-cgi}->can("cookie")) {
my $cgi=$attrs{-cgi};
+ load_config($cgi);
my $sess_id = $cgi->cookie(COOKIE_NAME);
return undef unless $sess_id;
- load_config();
if (!exists($config{-sessionbase})) {
croak "No VJournal config read";
}
dbmopen %userbase,$config{-sessionbase},0644;
return undef if (!exists($userbase{$sess_id}));
- my ($name,$avatar,$email,$avwidth,$avheight,$ip,$expire) =
+ my ($name,$identity,$avatar,$email,$avwidth,$avheight,$ip,$expire) =
split(/:/,$userbase{$sess_id});
if ($ip && $ip ne $attrs{-cgi}->remote_addr()) {
return undef;
}
- my $me={-id=>$sess_id,-name=>$name,-cgi=>$cgi};
+ my $me={-id=>$sess_id,-name=>$name,-identity=>$identity,-cgi=>$cgi};
if ($avatar) {
$me->{-avatar}=$avatar;
$me->{-avwidth}=$avwidth;
return undef;
} elsif ($expire < $now - $config{-gracetime}) {
$expire+=$config{-sessiontime};
- $userbase{$sess_id}=join(":",$name,$avatar,$email,$avwidth,$avheight,$ip,$expire);
+ $userbase{$sess_id}=join(":",$name,$identity,$avatar,$email,$avwidth,$avheight,$ip,$expire);
$me->{-cookie}=
[$cgi->cookie(-name=>COOKIE_NAME,-value=>$sess_id,-expires=>
$expire)];
Creates new session for given user. It is assumet that user have been
properly authenticated by caller. (i.e. using OpenID).
- $session=VJournal::Session->create(-user=>'user',-cgi=>$cgi,-email=>$mailaddress,
+ $session=VJournal::Session->create(-identity=>'identity-url',
+ -name=>"user display name",-cgi=>$cgi,-email=>$mailaddress,
-avatar=>$uri,
-bind_to_ip=>1
);
croak("Invalid call to ".$pkg."->create");
}
my %params = @_;
- croack("User name is required by ".$pkg."->create") unless $params{-user};
+ croack("User identity is required by ".$pkg."->create") unless
+ $params{-identity};
$params{-cgi}=CGI->new() if(!$params{-cgi});
load_config($params{-cgi});
- my $user=$params{-user};
+ my $identity=$params{-identity};
my %users;
my %sessions;
dbmopen %users,$config{-userbase},0644;
- my $session={-cgi=>$params{-cgi},-name=>$params{-user}};
- if (!exists($users{$user})) {
+ my $session={-cgi=>$params{-cgi},-identity=>$params{-identity}};
+ if (!exists($users{$identity})) {
# New user come.
require VJournal::Avatar;
my @avatar;
if (exists $params{-avatar}) {
@avatar = VJournal::Avatar::cache($params{-avatar});
} else {
- @avatar = VJournal::Avatar::by_openid($user);
+ @avatar = VJournal::Avatar::by_openid($identity);
}
if (!@avatar && exists $params{-email}) {
@avatar = VJournal::Avatar::by_email($params{-email});
}
my %a = @avatar;
- $users{$user}=join(":",$params{-email},$a{-src},$a{-width},$a{-height});
+ $users{$identity}=join(":",$params{-name}||$identity
+ ,$params{-email},$a{-src},$a{-width},$a{-height});
}
- my ($email,$avatarsrc,$avatarwidth,$avatarheight)=split(":",$users{$user});
+ my ($name,$email,$avatarsrc,$avatarwidth,$avatarheight)=split(":",$users{$identity});
+ $session->{-name} = $name;
$session->{-email} = $email if $email;
if ($avatarsrc) {
$session->{-avatar} = $avatarsrc;
my $expire = time()+$config{-sessiontime};
require Digest::MD5;
my
- $sessioninfo=join(":",$user,$avatarsrc,$email,$avatarwidth,$avatarheight,
+ $sessioninfo=join(":",$name,$identity,$avatarsrc,$email,$avatarwidth,$avatarheight,
($params{-bind_to_ip}?$session->{-cgi}->remote_addr():""),$expire);
$session->{-id} = Digest::MD5::md5_base64($sessioninfo);
$sessions{$session->{-id}} = $sessioninfo;
push @{$self->{-cookie}},@_;
}
+=head2 identity
+
+ $s->identity()
+
+Returns OpenID identity URL for current user
+
+=cut
+
+sub identity {
+ return shift->{-identity};
+}
+
+=head2 name
+
+ $s->name()
+
+Returns display name for current user
+
+=cut
+
+sub name {
+ return shift->{-name};
+}
+
=head2 avatar
print $s->avatar()
sub isowner {
my $self=shift;
- return $self->{-name} eq $config->{-owner};
+ return $self->{-identity} eq $config{-owner};
}
+=head2 banned
+
+ $s->banned()
+
+Return true if current user is banned from leaving comments in the blog.
+
+=cut
+
+sub banned {
+ return exists shift->{-ban}
+}
+
+=head2 ban
+
+ $s->ban($identity_url);
+
+Marks user as banned in the current blog
+
+=cut
+
+sub ban {
+ my ($self,$foe) = @_;
+ return undef if (!$self->isowner()) ;
+ my %bans;
+ dbmopen %bans,$config{-topdir}."/bans",0644;
+ $bans{$foe}=time();
+}
+
+=head2 _readban
+
+ $session=>{-identity=>$identity,...,_readban($identity)}
+
+Returns aray (-ban => 1) if $identity is recorded in tbe bans dbm file
+in the blog top url
+
+=cut
+
+sub _readban {
+ my $identity = shift;
+ my %bans;
+ dbmopen %bans,$config{-topdir}."/bans",0644;
+ if (exists $bans{-identity}) {
+ return (-ban=>1);
+ } else {
+ return ();
+ }
+}
+
=head2 _update_user
$s->_update_user
sub load_config {
my $cgi = $_[0];
- my $path=$cgi->path_translated();
+ my $path;
+ $path=$1 if $cgi->path_translated()=~/^(.*)$/;
my @dirs = File::Spec->splitdir($path);
my @uri = File::Spec->splitdir($cgi->path_info);
my $found =0;
my $d=File::Spec->catdir(@dirs,CONFIG_NAME);
if (-r $d) {
open F,"<",$d;
- local $/=undef;
- my $config = <F>;
+ while (<F>) {
+ $config{"-$1"} = $2 if /^\s*(\w+)\s*=\s*"([^"]*)"\s*$/;
+ }
close F;
- eval "%config = {$d}";
$config{-topdir}=File::Spec->catdir(@dirs);
$config{-topurl}=$cgi->url(-base=>1).File::Spec->catdir(@uri);
die $@ if ($@);
foreach my $key (@reqkeys) {
die "Required key $key missing from config"
unless exists $config{$key};
+
}
# sensible defaults
$config{-sessionbase}||=$config{-statedir}."/sessions.db";
$config{-userbase}||=$config{-statedir}."/user.db";
$config{-sessiontime}||=86400*30;
$config{-gracetime}||=86400;
- $config{-templatedir}||=$config{-topdir}."/templates"
+ $config{-templatedir}||=$config{-topdir}."/templates";
$config{-avatardir}||=$config{-topdir}."/avatars";
if (!$config{-owner}) {
- my $uri=substr($config{-topurl},index($config{-topurl},"://")+2;
+ my $uri=substr($config{-topurl},index($config{-topurl},"://")+3);
$uri =~ s/:\d+(\/.*)?$//;
$config{-owner} = $uri;
}
projects / oss / vjournal.git / blobdiff