Revision 191

Date:
2012/03/15 18:22:24
Author:
ahitrov
Revision Log:
Session plug-in
Files:

Legend:

 
Added
 
Removed
 
Modified

  • koi8/plugins/comps/contenido/session/dhandler

     
    1 % if (@call)
    2 % {
    3 <& @call &>
    4 % }
    5 <%INIT>
    6
    7 use vars qw( $keeper $request $project );
    8 $r->content_type('text/html');
    9
    10 my @path = split('/', $m->dhandler_arg());
    11 my @call = ();
    12
    13 if (length($path[0]) < 1) { $path[0] = 'index.html' };
    14 @call = (join('/',@path), %ARGS);
    15
    16 if (! $m->comp_exists($call[0]))
    17 {
    18 $m->clear_buffer();
    19 $m->abort(404);
    20 }
    21
    22 </%INIT>

  • koi8/plugins/comps/contenido/session/index.html

     
    1 <& "/contenido/components/header.msn", style => 'index' &>
    2
    3 <div style="text-align:center; padding:180px 20px;">
    4 % if ( $keeper->{session}->state->storage eq 'POSTGRES' ) {
    5 <form action="./index.html" method="POST"
    6 onsubmit="return confirm('�� ������������� ����������� �������� ��� ���������������� ������?\n��� �������� � ��������������� ������ ������������� �� �������!')">
    7 <input type="submit" class="input_btn" name="clear" value="������� ��� ���������������� ������">
    8
    9 </form>
    10 % }
    11 </div>
    12
    13 </body>
    14 </html>
    15 <%args>
    16
    17 $clear => undef
    18
    19 </%args>
    20 <%init>
    21
    22 if ( $clear && $keeper->{session}->state->storage eq 'POSTGRES' ) {
    23 warn "delete from sessions\n";
    24 my $req = $keeper->SQL->do('delete from sessions', {}) || $keeper->t_abort();
    25 $m->redirect ('./');
    26 }
    27
    28 </%init>

  • koi8/plugins/config.proto

     
    1
    2
    3 ### AUTH::FaceBook
    4 ######################################
    5 FACEBOOK_APP_ID =
    6 FACEBOOK_APP_KEY =
    7 FACEBOOK_APP_SECRET =
    8 FACEBOOK_AUTHORIZE_URL = https://graph.facebook.com/oauth/authorize
    9 FACEBOOK_ACCESS_TOKEN_URL = https://graph.facebook.com/oauth/access_token
    10 FACEBOOK_USER_INFO_URL = https://graph.facebook.com/me
    11 FACEBOOK_REDIRECT_URL =
    12 FACEBOOK_USER_POST_URL =
    13
    14 REWRITE += FACEBOOK_AUTHORIZE_URL FACEBOOK_ACCESS_TOKEN_URL FACEBOOK_USER_INFO_URL
    15
    16 ### AUTH::VKontakte
    17 ######################################
    18 VK_APP_ID =
    19 VK_APP_SECRET =
    20 VK_AUTHORIZE_URL = http://vkontakte.ru/login.php
    21 VK_ACCESS_TOKEN_URL = http://vk.com/api.php
    22 VK_USER_INFO_URL = http://vk.com/api.php
    23 VK_REDIRECT_URL =
    24 VK_USER_POST_URL =
    25
    26 REWRITE += VK_APP_ID VK_APP_SECRET
    27 REWRITE += VK_AUTHORIZE_URL VK_ACCESS_TOKEN_URL
    28
    29 CONNECTION_TIMEOUT = 3
    30
    31 PROJECT_REQUIRED += JSON-XS
    32 PROJECT_REQUIRED += Crypt-SSLeay

  • koi8/plugins/lib/session/Apache.pm

     
    1 package session::Apache;
    2
    3 use strict;
    4 use warnings 'all';
    5
    6 use session::State;
    7 use Contenido::Globals;
    8
    9
    10 sub child_init {
    11 # ���������� keeper ������� � keeper �������
    12 $keeper->{session} = session::Keeper->new($state->session);
    13 }
    14
    15 sub request_init {
    16 }
    17
    18 sub child_exit {
    19 }
    20
    21 1;

  • koi8/plugins/lib/session/AUTH/FaceBook.pm

     
    1 package session::AUTH::FaceBook;
    2
    3 use strict;
    4 use warnings;
    5 use LWP::UserAgent;
    6 use JSON::XS;
    7 use Data::Dumper;
    8 use URI;
    9 use URI::QueryParam;
    10 use Encode;
    11 use Contenido::Globals;
    12
    13 use vars qw($VERSION);
    14 $VERSION = '4.1';
    15
    16 =for rem
    17 facebook:
    18 auto_create_user: 1
    19 app_id: 122117614500563
    20 app_key: 3da06301715b0efc5c873535c56c2c33
    21 app_secret: 656bd1369486b902e9bf831a9a08132b
    22 authorize_url: https://graph.facebook.com/oauth/authorize
    23 access_token_url: https://graph.facebook.com/oauth/access_token
    24 user_info_url: https://graph.facebook.com/me
    25 user_post_url: ~
    26 store:
    27 class: "+Comments::Authentication::Store"
    28 type: facebook
    29
    30 =cut
    31
    32 our $JSON = JSON::XS->new->utf8;
    33
    34 =for rem SCHEMA
    35
    36 $m->redirect ( $fb_connect->fb_authorize_url( redirect_uri => ... ) );
    37
    38
    39 =cut
    40
    41
    42 sub new {
    43 my ($class, %config) = @_;
    44 my $self = bless {}, $class;
    45 for (qw(facebook_app_id facebook_app_key facebook_app_secret facebook_authorize_url facebook_access_token_url facebook_user_info_url)) {
    46 $self->{$_} = $config{$_} || $state->{session}->{$_} || return undef;
    47 }
    48 $self->{timeout} = $state->{session}->{connection_timeout} || 3;
    49 for (qw(facebook_user_post_url facebook_redirect_uri)) {
    50 $self->{$_} = $config{$_} || $state->{session}->{$_};
    51 }
    52 return $self;
    53 }
    54
    55 sub fb_authorize_url {
    56 my $self = shift;
    57 my (%args) = @_;
    58 my $go = URI->new( $self->{facebook_authorize_url} );
    59 warn Dumper($go);
    60 $go->query_param( client_id => $self->{facebook_app_key} );
    61 $go->query_param( scope => "publish_stream" );
    62 $args{redirect_uri} ||= $self->{facebook_redirect_uri};
    63 for ( keys %args ) {
    64 $go->query_param( $_ => $args{$_} );
    65 }
    66 $keeper->{session}->store_value( facebook_redirect_url => $self->{facebook_redirect_uri} );
    67 return $go;
    68 }
    69
    70 sub authenticate {
    71 my ( $self, %authinfo ) = @_;
    72 warn "FB.authenticate" if $DEBUG;
    73 # TODO: we need callback url
    74 #warn "user_session=".dumper( $c->user_session )." ";
    75 my $local_session = $session || $keeper->{session}->get_session;
    76 my $redirect_uri = $local_session->{facebook_redirect_url};
    77
    78 my $access_token = $local_session->{facebook_access_token};
    79 my $expires = $local_session->{facebook_expires};
    80 if ($access_token and $expires > time) {
    81 warn "Already have access_token" if $DEBUG;
    82 } else {
    83 undef $access_token;
    84 }
    85 my $code = $authinfo{'code'};
    86 unless ( $code ) {
    87 warn "Call to authenticate without code";
    88 return undef;
    89 }
    90 my $ua = LWP::UserAgent->new;
    91 $ua->timeout($self->{timeout});
    92 unless ($access_token) {
    93 my $req = URI->new( $self->{facebook_access_token_url});
    94 $req->query_param( client_id => $self->{facebook_app_id} );
    95 $req->query_param( redirect_uri => $redirect_uri );
    96 $req->query_param( client_secret=> $self->{facebook_app_secret} );
    97 $req->query_param( code => $code);
    98 warn "Get $req";
    99 my $res = $ua->get($req);
    100 unless ($res->code == 200) {
    101 warn "access_token request failed: ".$res->status_line;
    102 return undef;
    103 }
    104 my %res = eval { URI->new("?".$res->content)->query_form };
    105 warn Dumper(\%res);
    106 unless ($access_token = $res{access_token}) {
    107 warn "No access token in response: ".$res->content;
    108 return undef;
    109 }
    110 $keeper->{session}->store_value( facebook_access_token => $access_token );
    111 $local_session->{facebook_access_token} = $access_token;
    112 if( my $expires = $res{expires} ) {
    113 $local_session->{facebook_expires} = time + $expires;
    114 $keeper->{session}->store_value( facebook_expires => $local_session->{facebook_expires} );
    115 } else {
    116 #$c->user_session->{'expires'} = time + 3600*24;
    117 }
    118 warn "FB: requested access token";
    119 } else {
    120 warn "FB: have access token";
    121 }
    122
    123 my $req = URI->new( $self->{facebook_user_info_url} );
    124 $req->query_param( access_token => $access_token );
    125
    126 warn "Fetching user $req";
    127 my $res = $ua->get($req);
    128 unless ($res->code == 200) {
    129 warn "user request failed: ".$res->status_line;
    130 return undef;
    131 }
    132 my $info;
    133 unless ( $info = eval { JSON::XS->new->utf8->decode($res->content) } ) {
    134 warn "user '".$res->content."' decode failed: $@";
    135 return undef;
    136 }
    137 warn "Userhash = ".Dumper($info);
    138 #warn "facebook: user=$info->{name} / $info->{id} / $info->{gender}";
    139
    140 my @plugins = split (/[\ |\t]+/, $state->{plugins});
    141 if ( grep { $_ eq 'users' } @plugins ) {
    142 my $user = $keeper->{users}->get_profile( login => 'facebook:'.$info->{id} );
    143 unless ( ref $user ) {
    144 my $user_class = $state->{users}->profile_document_class;
    145 $user = $user_class->new( $keeper );
    146 $user->login( 'facebook:'.$info->{id} );
    147 my $name = Encode::encode('utf-8', $info->{name});
    148 Encode::from_to( $name, 'utf-8', 'koi8-r' );
    149 $user->name( $name );
    150 $user->status( 1 );
    151 $user->type( 0 );
    152 $user->login_method('facebook');
    153 $user->country( $info->{locale} );
    154 $user->email( undef );
    155
    156 my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure;
    157 if ( ref $prop_ava ) {
    158 my $avatar = $user->_store_image( 'https://graph.facebook.com/'.$info->{username}.'/picture?type=large', attr => 'avatar' );
    159 local $Data::Dumper::Indent = 0;
    160 $user->avatar( Data::Dumper::Dumper($avatar) );
    161 }
    162
    163 $user->store;
    164 } else {
    165 my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure;
    166 if ( ref $prop_ava ) {
    167 my $avatar = $user->get_image( 'avatar' );
    168 unless ( ref $avatar && exists $avatar->{filename} ) {
    169 my $avatar = $user->_store_image( 'https://graph.facebook.com/'.$info->{username}.'/picture?type=large', attr => 'avatar' );
    170 local $Data::Dumper::Indent = 0;
    171 $user->avatar( Data::Dumper::Dumper($avatar) );
    172 $user->store;
    173 }
    174 }
    175 }
    176 my %data = (
    177 id => $user->id,
    178 name => $user->name,
    179 login => $user->login,
    180 status => $user->status,
    181 type => $user->type,
    182 ltime => time,
    183 avatar => 'https://graph.facebook.com/'.$info->{username}.'/picture',
    184 );
    185 $keeper->{session}->store_value ( %data );
    186 while ( my ( $key, $value ) = each %data ) {
    187 $local_session->{$key} = $value;
    188 }
    189 }
    190 return $local_session;
    191 }
    192
    193 1;

  • koi8/plugins/lib/session/AUTH/VKontakte.pm

     
    1 package session::AUTH::VKontakte;
    2
    3 use strict;
    4 use warnings;
    5 use LWP::UserAgent;
    6 use JSON::XS;
    7 use Data::Dumper;
    8 use URI;
    9 use URI::QueryParam;
    10 use Encode;
    11 use Contenido::Globals;
    12
    13 use vars qw($VERSION);
    14 $VERSION = '4.1';
    15
    16 =for rem
    17 vkontakte:
    18 auto_create_user: 1
    19 app_id: 122117614500563
    20 app_secret: 656bd1369486b902e9bf831a9a08132b
    21 authorize_url: http://api.vkontakte.ru/oauth/authorize
    22 access_token_url: https://api.vkontakte.ru/oauth/access_token
    23 user_info_url: https://api.vkontakte.ru/method/getProfiles
    24 user_post_url: ~
    25 =cut
    26
    27 our $JSON = JSON::XS->new->utf8;
    28
    29 =for rem SCHEMA
    30
    31 $m->redirect ( $fb_connect->fb_authorize_url( redirect_uri => ... ) );
    32
    33
    34 =cut
    35
    36 sub new {
    37 my ($class, %config) = @_;
    38 my $self = bless {}, $class;
    39 for (qw( vk_app_id vk_app_secret vk_authorize_url vk_access_token_url vk_user_info_url)) {
    40 $self->{$_} = $config{$_} || $state->{session}->{$_} || return undef;
    41 }
    42 $self->{timeout} = $state->{session}->{connection_timeout} || 3;
    43 for (qw(vk_user_post_url vk_redirect_uri)) {
    44 $self->{$_} = $config{$_} || $state->{session}->{$_};
    45 }
    46 return $self;
    47 }
    48
    49 sub authorize_url {
    50 my $self = shift;
    51 my (%args) = @_;
    52 my $go = URI->new( $self->{vk_authorize_url} );
    53 $go->query_param( client_id => $self->{vk_app_id} );
    54 $go->query_param( scope => '' );
    55 $go->query_param( response_type => 'code' );
    56 $args{redirect_uri} ||= $self->{vk_redirect_uri};
    57 for ( keys %args ) {
    58 $go->query_param( $_ => $args{$_} );
    59 }
    60 $keeper->{session}->store_value( vk_redirect_url => $self->{vk_redirect_uri} );
    61 return $go;
    62 }
    63
    64 sub authenticate {
    65 my ( $self, %authinfo ) = @_;
    66 warn "VK.authenticate" if $DEBUG;
    67 # TODO: we need callback url
    68 #warn "user_session=".dumper( $c->user_session )." ";
    69
    70 my $local_session = $session || $keeper->{session}->get_session;
    71 my $redirect_uri = $local_session->{vk_redirect_url};
    72
    73 my $access_token = $local_session->{vk_access_token};
    74 my $vk_user_id = $local_session->{vk_user_id};
    75 my $expires = $local_session->{vk_expires};
    76 if ($access_token and $expires > time) {
    77 warn "Already have access_token" if $DEBUG;
    78 } else {
    79 undef $access_token;
    80 }
    81 my $code = $authinfo{'code'};
    82 unless ( $code ) {
    83 warn "Call to authenticate without code\n";
    84 return undef;
    85 }
    86 my $ua = LWP::UserAgent->new;
    87 $ua->timeout($self->{timeout});
    88
    89 unless ($access_token) {
    90 my $req = URI->new( $self->{vk_access_token_url});
    91 $req->query_param( client_id => $self->{vk_app_id} );
    92 $req->query_param( client_secret => $self->{vk_app_secret} );
    93 $req->query_param( code => $code );
    94 my $res = $ua->get($req);
    95 unless ($res->code == 200) {
    96 warn "VK: Access_token request failed: ".$res->status_line."\n";
    97 return undef;
    98 }
    99 my $info = $JSON->decode($res->content);
    100 unless ( ref $info eq 'HASH' && ($access_token = $info->{access_token}) ) {
    101 warn "No access token in response: ".$res->content."\n";
    102 return undef;
    103 }
    104 $keeper->{session}->store_value( vk_access_token => $access_token );
    105 $local_session->{vk_access_token} = $access_token;
    106 $keeper->{session}->store_value( vk_user_id => $info->{user_id} );
    107 $local_session->{vk_user_id} = $info->{user_id};
    108 if ( my $expires = $info->{expires_in} ) {
    109 $local_session->{vk_expires} = time + $expires;
    110 $keeper->{session}->store_value( vk_expires => $local_session->{vk_expires} );
    111 } else {
    112 #$c->user_session->{'expires'} = time + 3600*24;
    113 }
    114 warn "VK: requested access token";
    115 } else {
    116 warn "VK: have access token";
    117 }
    118
    119 my $req = URI->new( $self->{vk_user_info_url} );
    120 $req->query_param( uid => $local_session->{vk_user_id} );
    121 $req->query_param( fields => 'uid,first_name,last_name,nickname,domain,sex,bdate,city,country,timezone,photo,photo_medium,photo_big' );
    122 $req->query_param( access_token => $access_token );
    123
    124 warn "VK: Fetching user $req\n" if $DEBUG;
    125 my $res = $ua->get($req);
    126 unless ($res->code == 200) {
    127 warn "VK: user request failed: ".$res->status_line."\n";
    128 return undef;
    129 }
    130
    131 my $info;
    132 unless ( $info = eval { $JSON->decode($res->content) } ) {
    133 warn "user '".$res->content."' decode failed: $@\n";
    134 return undef;
    135 }
    136 warn Dumper($info) if $DEBUG;
    137 return undef unless exists $info->{response} && ref $info->{response} eq 'ARRAY' && @{$info->{response}};
    138 my $user_info = $info->{response}[0];
    139 foreach my $key ( qw(nickname last_name first_name) ) {
    140 $user_info->{$key} = Encode::encode('utf-8', $user_info->{$key});
    141 Encode::from_to( $user_info->{$key}, 'utf-8', 'koi8-r' );
    142 }
    143
    144 my @plugins = split (/[\ |\t]+/, $state->{plugins});
    145 my $name = $user_info->{first_name}.' '.$user_info->{last_name};
    146 if ( grep { $_ eq 'users' } @plugins ) {
    147 my $user = $keeper->{users}->get_profile( login => 'vkontakte:'.$user_info->{uid} );
    148 unless ( ref $user ) {
    149 my $user_class = $state->{users}->profile_document_class;
    150 $user = $user_class->new( $keeper );
    151 $user->login( 'vkontakte:'.$user_info->{uid} );
    152 $user->name( $user_info->{last_name}.', '.$user_info->{first_name} );
    153 $user->nickname( $user_info->{nickname} );
    154 $user->status( 1 );
    155 $user->type( 0 );
    156 $user->login_method('vkontakte');
    157 $user->country( $user_info->{country} );
    158 $user->email( undef );
    159
    160 my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure;
    161 if ( ref $prop_ava ) {
    162 my $avatar = $user->_store_image( $user_info->{photo_big}, attr => 'avatar' );
    163 local $Data::Dumper::Indent = 0;
    164 $user->avatar( Data::Dumper::Dumper($avatar) );
    165 }
    166
    167 $user->store;
    168 } else {
    169 my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure;
    170 if ( ref $prop_ava ) {
    171 my $avatar = $user->get_image( 'avatar' );
    172 unless ( ref $avatar && exists $avatar->{filename} ) {
    173 my $avatar = $user->_store_image( $user_info->{photo_big}, attr => 'avatar' );
    174 local $Data::Dumper::Indent = 0;
    175 $user->avatar( Data::Dumper::Dumper($avatar) );
    176 $user->store;
    177 }
    178 }
    179 }
    180 my %data = (
    181 id => $user->id,
    182 name => $name,
    183 login => $user->login,
    184 status => $user->status,
    185 type => $user->type,
    186 auth_by => 'vkontakte',
    187 ltime => time,
    188 );
    189 if ( $user_info->{photo} ) {
    190 $data{avatar} = $user_info->{photo};
    191 }
    192 $keeper->{session}->store_value ( %data );
    193 while ( my ( $key, $value ) = each %data ) {
    194 $local_session->{$key} = $value;
    195 }
    196
    197 } else {
    198 my %data = (
    199 id => $user_info->{uid},
    200 name => $name,
    201 nick => $user_info->{nickname} || $name,
    202 login => 'vkontakte:'.$user_info->{uid},
    203 status => 1,
    204 type => 0,
    205 auth_by => 'vkontakte',
    206 ltime => time,
    207 );
    208 if ( $user_info->{photo} ) {
    209 $data{avatar} = $user_info->{photo};
    210 }
    211 $keeper->{session}->store_value ( %data );
    212 while ( my ( $key, $value ) = each %data ) {
    213 $local_session->{$key} = $value;
    214 }
    215 }
    216 return $local_session;
    217 }
    218
    219 1;

  • koi8/plugins/lib/session/Init.pm

     
    1 package session::Init;
    2
    3 use strict;
    4 use warnings 'all';
    5
    6 use session::Apache;
    7 use session::Keeper;
    8 use session::AUTH::FaceBook;
    9 use session::AUTH::VKontakte;
    10
    11 # �������� ���� ����������� ������� �������
    12 # session::SQL::SomeTable
    13 # session::SomeClass
    14 Contenido::Init::load_classes(qw(
    15 ));
    16
    17 sub init {
    18 0;
    19 }
    20
    21 1;

  • koi8/plugins/lib/session/Keeper.pm

     
    1 package session::Keeper;
    2
    3 use strict;
    4 use warnings 'all';
    5 use base qw(Contenido::Keeper);
    6
    7 use Apache::Cookie;
    8 use Apache::Session::File;
    9 use Apache::Session::Postgres;
    10 use Contenido::Globals;
    11 use Data::Dumper;
    12
    13
    14 sub logon {
    15 my $self = shift;
    16 my %opts = @_;
    17
    18 return if !($opts{login} || $opts{email}) && !$opts{passwd};
    19
    20 my $res;
    21 my @plugins = split (/[\ |\t]+/, $state->{plugins});
    22 if ( grep { $_ eq 'users' } @plugins ) {
    23 #### ����������� ����� ������ users
    24 #########################################
    25 $res = $keeper->{users}->login (
    26 $opts{login} ? (login => $opts{login}) : (),
    27 $opts{email} ? (email => lc($opts{email})) : (),
    28 passwd => $opts{passwd},
    29 );
    30 return unless $res;
    31 } else {
    32 #### ����������� ���� ��������
    33
    34
    35
    36 }
    37 if ( ref $res ) {
    38 my %data = (
    39 id => $res->id,
    40 name => $res->name,
    41 email => $res->email,
    42 login => $res->login,
    43 status => $res->status,
    44 ltime => time,
    45 );
    46 $self->store_value ( %data );
    47 }
    48 return $self->get_session();
    49 }
    50
    51
    52 sub logoff {
    53 my $self = shift;
    54 my $sid = _get_session_id ();
    55 my $session = _get_session_object ( $sid );
    56 return unless ref $session;
    57
    58 my $session_id = $session->{_session_id};
    59 if (!$sid || $sid ne $session_id) {
    60 warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
    61 _store_session_id ($session_id)
    62 } else {
    63 foreach my $key ( keys %$session ) {
    64 next if $key eq '_session_id';
    65 next if $key eq '_timestamp';
    66 delete $session->{$key};
    67 }
    68 }
    69 untie %$session;
    70 return 1;
    71 }
    72
    73
    74 sub get_value {
    75
    76 my ($self, $name) = @_;
    77 my $sid = _get_session_id ();
    78 my $session = _get_session_object ( $sid );
    79 return unless ref $session;
    80
    81 my $session_id = $session->{_session_id};
    82 my $value = $session->{$name};
    83 if (!$sid || $sid ne $session_id) {
    84 warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
    85 _store_session_id ($session_id);
    86 }
    87 untie %$session;
    88 return $value;
    89 }
    90
    91
    92 sub store_value {
    93
    94 my ($self, %opts) = @_;
    95 my $sid = _get_session_id ();
    96 my $session = _get_session_object ( $sid );
    97 return unless ref $session;
    98
    99 foreach my $key ( keys %opts ) {
    100 $session->{$key} = $opts{$key};
    101 }
    102
    103 my $session_id = $session->{_session_id};
    104 if (!$sid || $sid ne $session_id) {
    105 warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
    106 _store_session_id ($session_id);
    107 }
    108 untie %$session;
    109 return 1;
    110 }
    111
    112
    113 sub delete_key {
    114
    115 my ($self, $key) = @_;
    116 return unless $key;
    117
    118 my $sid = _get_session_id ();
    119 my $session = _get_session_object ( $sid );
    120 return unless ref $session;
    121
    122 my $session_id = $session->{_session_id};
    123 if (!$sid || $sid ne $session_id) {
    124 warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
    125 _store_session_id ($session_id);
    126 } else {
    127 delete $session->{$key} if exists $session->{$key};
    128 }
    129 untie %$session;
    130 return 1;
    131 }
    132
    133
    134 sub get_session {
    135
    136 my $self = shift;
    137
    138 my $sid = _get_session_id () || '';
    139 my $session = _get_session_object ($sid);
    140 return unless ref $session;
    141
    142 my $session_id = $session->{_session_id};
    143 my %ret = %$session;
    144 if (!$sid || $sid ne $session_id) {
    145 warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG;
    146 _store_session_id ($session_id);
    147 }
    148 untie %$session;
    149
    150 return \%ret;
    151 }
    152
    153
    154 ## ���������� �������
    155 ######################################################################################
    156 sub _store_session_id {
    157
    158 my $sid = shift;
    159 return unless $sid;
    160 my $cookie = Apache::Cookie->new ($request->r(),
    161 -domain => $state->{session}->domain,
    162 -name => $state->{session}->cookie,
    163 -expires=> $state->{session}->expires,
    164 -value => $sid,
    165 -path => '/',
    166 );
    167 $cookie->bake();
    168
    169 }
    170
    171
    172 sub _get_session_id {
    173
    174 my %cookies = Apache::Cookie->fetch;
    175 warn Dumper(\%cookies) if $DEBUG;
    176 my $cookie = $cookies{$state->{session}->cookie};
    177
    178 # ����������� SID �� ����
    179 my $sid = $cookie->value() || '' if $cookie;
    180 warn "\nSession_id = $sid\n" if $DEBUG;
    181
    182 return $sid;
    183 }
    184
    185
    186 sub _get_session_object {
    187
    188 my $sid = shift;
    189
    190 my %session;
    191 my $now = time;
    192 if ( $state->{session}->storage eq 'POSTGRES' ) {
    193 eval {
    194 tie %session, 'Apache::Session::Postgres', $sid, {
    195 Handle => $keeper->SQL,
    196 };
    197 };
    198 } else {
    199 eval {
    200 tie %session, 'Apache::Session::File', $sid, {
    201 Directory => $state->session->session_dir,
    202 };
    203 };
    204 }
    205 if ($@) {
    206 warn "Session data is not accessible: $@";
    207 undef $sid;
    208 } elsif ( $state->{session}->lifetime ) {
    209 unless ( exists $session{_timestamp} ) {
    210 $session{_timestamp} = $now;
    211 } elsif ( ($now - $session{_timestamp}) > $state->{session}->lifetime ) {
    212 undef $sid;
    213 } elsif ( ($now - $session{_timestamp}) > $state->{session}->checkout ) {
    214 $session{_timestamp} = $now;
    215 }
    216 }
    217 unless ( $sid ) {
    218 if ( $state->{session}->storage eq 'POSTGRES' ) {
    219 eval {
    220 tie %session, 'Apache::Session::Postgres', undef, {
    221 Handle => $keeper->SQL,
    222 };
    223 };
    224 } else {
    225 eval {
    226 tie %session, 'Apache::Session::File', undef, {
    227 Directory => $state->session->session_dir,
    228 };
    229 };
    230 }
    231 $session{_timestamp} = $now;
    232 }
    233
    234 return \%session;
    235 }
    236
    237
    238 sub _drop_session_object {
    239
    240 my (%session) = @_;
    241
    242 untie %session;
    243
    244 }
    245
    246 1;

  • koi8/plugins/lib/session/State.pm.proto

     
    1 package session::State;
    2
    3 use strict;
    4 use warnings 'all';
    5 use vars qw($AUTOLOAD);
    6
    7
    8 sub new {
    9 my ($proto) = @_;
    10 my $class = ref($proto) || $proto;
    11 my $self = {};
    12 bless $self, $class;
    13
    14 # ������� ������������ �������
    15 $self->{db_type} = 'none';
    16 $self->{storage} = '@SESSION_STORAGE@' || 'FILE'; ## ��������: FILE POSTGRES MEMCACHED
    17 $self->{session_dir} = '@SESSIONS@';
    18 $self->{session_directory} = '@SESSIONS@';
    19
    20 $self->{domain} = '@SESSION_DOMAIN@';
    21 $self->{cookie} = 'lsid';
    22 $self->{expires} = '@SESSION_EXPIRES@' || '';
    23
    24 $self->{lifetime} = '@SESSION_LIFETIME@';
    25 $self->{lifetime} *= 3600;
    26 $self->{checkout} = $self->{lifetime} - int ($self->{lifetime} / 2);
    27
    28 $self->{db_keepalive} = 0;
    29 $self->{db_host} = '';
    30 $self->{db_name} = '';
    31 $self->{db_user} = '';
    32 $self->{db_password} = '';
    33 $self->{db_port} = '';
    34
    35 $self->{data_directory} = '';
    36 $self->{images_directory} = '';
    37 $self->{binary_directory} = '';
    38 $self->{preview} = '';
    39 $self->{debug} = '';
    40 $self->{store_method} = '';
    41 $self->{cascade} = '';
    42 $self->{memcached_enable} = '';
    43
    44 $self->{facebook_app_id} = '@FACEBOOK_APP_ID@';
    45 $self->{facebook_app_key} = '@FACEBOOK_APP_KEY@';
    46 $self->{facebook_app_secret} = '@FACEBOOK_APP_SECRET@';
    47 $self->{facebook_authorize_url} = '@FACEBOOK_AUTHORIZE_URL@';
    48 $self->{facebook_access_token_url} = '@FACEBOOK_ACCESS_TOKEN_URL@';
    49 $self->{facebook_user_info_url} = '@FACEBOOK_USER_INFO_URL@';
    50 $self->{facebook_redirect_uri} = '@FACEBOOK_REDIRECT_URL@';
    51 $self->{facebook_user_post_url} = '@FACEBOOK_USER_POST_URL@';
    52
    53 $self->{vk_app_id} = '@VK_APP_ID@';
    54 $self->{vk_app_secret} = '@VK_APP_SECRET@';
    55
    56 $self->{vk_authorize_url} = '@VK_AUTHORIZE_URL@' || 'http://api.vkontakte.ru/oauth/authorize';
    57 $self->{vk_access_token_url} = '@VK_ACCESS_TOKEN_URL@' || 'https://api.vkontakte.ru/oauth/access_token';
    58 $self->{vk_user_info_url} = '@VK_USER_INFO_URL@' || 'https://api.vkontakte.ru/method/getProfiles';
    59
    60 $self->{vk_redirect_uri} = '@VK_REDIRECT_URL@';
    61 $self->{vk_user_post_url} = '@VK_USER_POST_URL@';
    62
    63 $self->{connection_timeout} = '@CONNECTION_TIMEOUT@';
    64
    65 $self->_init_();
    66 $self;
    67 }
    68
    69 sub info {
    70 my $self = shift;
    71 return unless ref $self;
    72
    73 for (sort keys %{$self->{attributes}}) {
    74 my $la = length $_;
    75 warn "\t$_".("\t" x (2-int($la/8))).": $self->{$_}\n";
    76 }
    77 }
    78
    79 sub _init_ {
    80 my $self = shift;
    81
    82 # ������� ������������ �������
    83 $self->{attributes}->{$_} = 'SCALAR' for qw(
    84 db_type
    85 session_dir
    86 session_directory
    87 domain
    88 cookie
    89 expires
    90 storage
    91 lifetime
    92 checkout
    93 db_keepalive
    94 db_host
    95 db_port
    96 db_name
    97 db_user
    98 db_password
    99 data_directory images_directory binary_directory preview debug store_method cascade memcached_enable
    100 );
    101 }
    102
    103 sub AUTOLOAD {
    104 my $self = shift;
    105 my $attribute = $AUTOLOAD;
    106
    107 $attribute =~ s/.*:://;
    108 return unless $attribute =~ /[^A-Z]/; # ��������� ������ ���� DESTROY
    109
    110 if (!exists $self->{attributes}->{$attribute}) {
    111 warn "Contenido Error (session::State): ����� ������, ��� �������� �� ���������� ��������������� ��������: ->$attribute()\n";
    112 return;
    113 }
    114
    115 $self->{$attribute} = shift @_ if $#_>=0;
    116 $self->{$attribute};
    117 }
    118
    119 1;

  • koi8/plugins/sql/TOAST/session.sql

     
    1 CREATE TABLE sessions (
    2 id char(32) not null primary key,
    3 dtime timestamp not null default now(),
    4 a_session text
    5 );