bans

[oss/vjournal.git] / lib / VJournal / Session.pm

diff --git a/lib/VJournal/Session.pm b/lib/VJournal/Session.pm
index 99f18e12fc13144a3d177d08063a3a7a8a7a0f38..e8197864dd566298ecebf04aaae4170bf579ff42 100644 (file)
--- a/lib/VJournal/Session.pm
+++ b/lib/VJournal/Session.pm
@@ -68,12 +68,12 @@ sub new {
                dbmopen %userbase,$config{-sessionbase},0644;
 
                return undef if (!exists($userbase{$sess_id}));
                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;
                }
                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;
                if ($avatar) {
                        $me->{-avatar}=$avatar;
                        $me->{-avwidth}=$avwidth;


@@ -89,7 +89,7 @@ sub new {
                        return undef;
                } elsif ($expire < $now - $config{-gracetime}) {
                        $expire+=$config{-sessiontime};
                        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)];
                        $me->{-cookie}=
                        [$cgi->cookie(-name=>COOKIE_NAME,-value=>$sess_id,-expires=>
                                $expire)];


@@ -103,7 +103,8 @@ sub new {
 Creates new session for given user. It is assumet that user have been
 properly authenticated by caller. (i.e. using OpenID).
 
 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
    );
        -avatar=>$uri,
        -bind_to_ip=>1
    );


@@ -124,15 +125,16 @@ sub create {
                croak("Invalid call to ".$pkg."->create");
        }       
        my %params = @_;
                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});
        $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 %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;
                # New user come.
                require VJournal::Avatar;
                my @avatar;


@@ -145,9 +147,11 @@ sub create {
                        @avatar = VJournal::Avatar::by_email($params{-email});
                }
                my %a = @avatar;
                        @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{$user});
+       $session->{-name} = $name;

        $session->{-email} = $email if $email;
        if ($avatarsrc) {
                $session->{-avatar} = $avatarsrc;
        $session->{-email} = $email if $email;
        if ($avatarsrc) {
                $session->{-avatar} = $avatarsrc;


@@ -157,7 +161,7 @@ sub create {
        my $expire = time()+$config{-sessiontime};
        require Digest::MD5;
        my
        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;
                ($params{-bind_to_ip}?$session->{-cgi}->remote_addr():""),$expire);
        $session->{-id} = Digest::MD5::md5_base64($sessioninfo);
        $sessions{$session->{-id}} = $sessioninfo;


@@ -183,6 +187,30 @@ sub set_cookie {
        push @{$self->{-cookie}},@_;
 }
 
        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() 
 =head2 avatar
 
   print $s->avatar() 


@@ -251,9 +279,56 @@ returns true, if current user is owner of the blog
 
 sub isowner {
        my $self=shift;
 
 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) = @_;
+       if (!$self->isowner()) return undef;
+       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;
+       dbmopen %bans,$config{-topdir}."/bans",0644;
+       if (exists $bans{-identity}) {
+               return (-ban=>1);
+       } else {
+               return ();
+       }       
+}      
+

 =head2 _update_user
 
        $s->_update_user
 =head2 _update_user
 
        $s->_update_user