Line # Revision Author
1 240 ahitrov 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 242 ahitrov app_id: decimal digits
20 app_secret: 32 hex digits
21 240 ahitrov 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 242 ahitrov $m->redirect ( $vk_connect->authorize_url( vk_redirect_uri => ... )->as_string );
32 240 ahitrov
33
34 =cut
35
36 sub new {
37 my ($class, %config) = @_;
38 my $self = bless {}, $class;
39
40 $self->{vk_authorize_url} = 'http://oauth.vk.com/authorize';
41 $self->{vk_access_token_url} = 'https://oauth.vk.com/access_token';
42 $self->{vk_user_info_url} = 'https://api.vk.com/method/getProfiles';
43
44 for (qw( vk_app_id vk_app_secret )) {
45 $self->{$_} = $config{$_} || $state->{session}->{$_} || return undef;
46 }
47 $self->{timeout} = $state->{session}->{connection_timeout} || 3;
48 for (qw(vk_user_post_url vk_redirect_uri)) {
49 $self->{$_} = $config{$_} || $state->{session}->{$_};
50 }
51 return $self;
52 }
53
54 sub authorize_url {
55 my $self = shift;
56 my (%args) = @_;
57 my $go = URI->new( $self->{vk_authorize_url} );
58 $go->query_param( client_id => $self->{vk_app_id} );
59 $go->query_param( scope => '' );
60 $go->query_param( response_type => 'code' );
61 $args{redirect_uri} ||= $self->{vk_redirect_uri};
62 for ( keys %args ) {
63 $go->query_param( $_ => $args{$_} );
64 }
65 272 ahitrov my $local_session = $session || $keeper->{session}->get_session;
66 $local_session->set( vk_redirect_url => $self->{vk_redirect_uri} );
67 240 ahitrov return $go;
68 }
69
70 sub authenticate {
71 my ( $self, %authinfo ) = @_;
72 warn "VK.authenticate" if $DEBUG;
73
74 my $local_session = $session || $keeper->{session}->get_session;
75 my $redirect_uri = $self->{vk_redirect_uri};
76
77 my $access_token = $local_session->{vk_access_token};
78 my $vk_user_id = $local_session->{vk_user_id};
79 my $expires = $local_session->{vk_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\n";
88 return undef;
89 }
90 my $ua = LWP::UserAgent->new;
91 $ua->timeout($self->{timeout});
92
93 unless ($access_token) {
94 my $req = URI->new( $self->{vk_access_token_url});
95 $req->query_param( client_id => $self->{vk_app_id} );
96 $req->query_param( client_secret => $self->{vk_app_secret} );
97 $req->query_param( code => $code );
98 $req->query_param( redirect_uri => $redirect_uri );
99 242 ahitrov warn "Token request: [$req]\n" if $DEBUG;
100 240 ahitrov my $res = $ua->get($req);
101 unless ($res->code == 200) {
102 warn "VK: Access_token request failed: ".$res->status_line."\n";
103 return undef;
104 }
105 my $info = $JSON->decode($res->content);
106 unless ( ref $info eq 'HASH' && ($access_token = $info->{access_token}) ) {
107 warn "No access token in response: ".$res->content."\n";
108 return undef;
109 }
110 272 ahitrov $local_session->set( vk_access_token => $access_token );
111 $local_session->set( vk_user_id => $info->{user_id} );
112 240 ahitrov if ( my $expires = $info->{expires_in} ) {
113 272 ahitrov $local_session->set( vk_expires => time + $expires );
114 240 ahitrov } else {
115 272 ahitrov #$local_session->set( vk_expires => time + 3600*24 );
116 240 ahitrov }
117 272 ahitrov warn "VK: requested access token" if $DEBUG;
118 240 ahitrov } else {
119 272 ahitrov warn "VK: have access token" if $DEBUG;
120 240 ahitrov }
121
122 my $req = URI->new( $self->{vk_user_info_url} );
123 $req->query_param( uid => $local_session->{vk_user_id} );
124 $req->query_param( fields => 'uid,first_name,last_name,nickname,domain,sex,bdate,city,country,timezone,photo,photo_medium,photo_big' );
125 $req->query_param( access_token => $access_token );
126
127 warn "VK: Fetching user $req\n" if $DEBUG;
128 my $res = $ua->get($req);
129 unless ($res->code == 200) {
130 warn "VK: user request failed: ".$res->status_line."\n";
131 return undef;
132 }
133
134 my $info;
135 unless ( $info = eval { $JSON->decode($res->content) } ) {
136 warn "user '".$res->content."' decode failed: $@\n";
137 return undef;
138 }
139 warn Dumper($info) if $DEBUG;
140 return undef unless exists $info->{response} && ref $info->{response} eq 'ARRAY' && @{$info->{response}};
141 my $user_info = $info->{response}[0];
142 foreach my $key ( qw(nickname last_name first_name) ) {
143 $user_info->{$key} = Encode::encode('utf-8', $user_info->{$key});
144 }
145
146 my @plugins = split (/[\ |\t]+/, $state->{plugins});
147 my $name = $user_info->{first_name}.' '.$user_info->{last_name};
148 if ( grep { $_ eq 'users' } @plugins ) {
149 308 ahitrov my $user;
150 if ( $state->{users}->use_credentials ) {
151 320 ahitrov if ( $local_session->id ) {
152 $user = $keeper->{users}->get_profile( id => $local_session->{id} );
153 } else {
154 $user = $keeper->{users}->get_profile( vkontakte => $user_info->{uid} );
155 }
156 312 ahitrov }
157 unless ( ref $user ) {
158 308 ahitrov $user = $keeper->{users}->get_profile( login => 'vkontakte:'.$user_info->{uid} );
159 }
160 240 ahitrov unless ( ref $user ) {
161 my $user_class = $state->{users}->profile_document_class;
162 $user = $user_class->new( $keeper );
163 370 ahitrov my %props = map { $_->{attr} => $_ } $user->structure;
164 240 ahitrov $user->login( 'vkontakte:'.$user_info->{uid} );
165 $user->name( $user_info->{last_name}.', '.$user_info->{first_name} );
166 $user->nickname( $user_info->{nickname} );
167 $user->status( 1 );
168 $user->type( 0 );
169 $user->login_method('vkontakte');
170 370 ahitrov if ( exists $props{country} ) {
171 $user->country( $user_info->{country} );
172 }
173 240 ahitrov $user->email( undef );
174
175 my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure;
176 if ( ref $prop_ava ) {
177 my $avatar = $user->_store_image( $user_info->{photo_big}, attr => 'avatar' );
178 local $Data::Dumper::Indent = 0;
179 $user->avatar( Data::Dumper::Dumper($avatar) );
180 }
181
182 $user->store;
183 } else {
184 my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure;
185 if ( ref $prop_ava ) {
186 my $avatar = $user->get_image( 'avatar' );
187 unless ( ref $avatar && exists $avatar->{filename} ) {
188 my $avatar = $user->_store_image( $user_info->{photo_big}, attr => 'avatar' );
189 local $Data::Dumper::Indent = 0;
190 $user->avatar( Data::Dumper::Dumper($avatar) );
191 $user->store;
192 }
193 }
194 }
195 312 ahitrov if ( $state->{users}->use_credentials ) {
196 $user->create_credential(
197 vkontakte => $user_info->{uid},
198 avatar => $user_info->{photo_big},
199 );
200 }
201 240 ahitrov my %data = (
202 id => $user->id,
203 name => $name,
204 login => $user->login,
205 status => $user->status,
206 type => $user->type,
207 auth_by => 'vkontakte',
208 ltime => time,
209 );
210 if ( $user_info->{photo} ) {
211 $data{avatar} = $user_info->{photo};
212 }
213 272 ahitrov $local_session->set( %data );
214 240 ahitrov
215 } else {
216 my %data = (
217 id => $user_info->{uid},
218 name => $name,
219 nick => $user_info->{nickname} || $name,
220 login => 'vkontakte:'.$user_info->{uid},
221 status => 1,
222 type => 0,
223 auth_by => 'vkontakte',
224 ltime => time,
225 );
226 if ( $user_info->{photo} ) {
227 $data{avatar} = $user_info->{photo};
228 }
229 272 ahitrov $local_session->set( %data );
230 240 ahitrov }
231 return $local_session;
232 }
233
234 1;