1 |
240 |
ahitrov |
package session::AUTH::VKontakte; |
2 |
|
|
|
3 |
|
|
use strict; |
4 |
|
|
use warnings; |
5 |
|
|
use LWP::UserAgent; |
6 |
676 |
ahitrov |
use IO::Socket::SSL; |
7 |
240 |
ahitrov |
use JSON::XS; |
8 |
|
|
use Data::Dumper; |
9 |
|
|
use URI; |
10 |
|
|
use URI::QueryParam; |
11 |
|
|
use Encode; |
12 |
|
|
use Contenido::Globals; |
13 |
|
|
|
14 |
|
|
use vars qw($VERSION); |
15 |
|
|
$VERSION = '4.1'; |
16 |
|
|
|
17 |
|
|
=for rem |
18 |
|
|
vkontakte: |
19 |
|
|
auto_create_user: 1 |
20 |
242 |
ahitrov |
app_id: decimal digits |
21 |
|
|
app_secret: 32 hex digits |
22 |
676 |
ahitrov |
authorize_url: http://oauth.vk.com/authorize |
23 |
|
|
access_token_url: https://oauth.vk.com/access_token |
24 |
|
|
user_info_url: https://api.vk.com/method/account.getProfileInfo |
25 |
240 |
ahitrov |
user_post_url: ~ |
26 |
|
|
=cut |
27 |
|
|
|
28 |
|
|
our $JSON = JSON::XS->new->utf8; |
29 |
|
|
|
30 |
|
|
=for rem SCHEMA |
31 |
|
|
|
32 |
242 |
ahitrov |
$m->redirect ( $vk_connect->authorize_url( vk_redirect_uri => ... )->as_string ); |
33 |
240 |
ahitrov |
|
34 |
|
|
|
35 |
|
|
=cut |
36 |
|
|
|
37 |
512 |
ahitrov |
our %SCOPE = ( |
38 |
|
|
'notify' => 1, |
39 |
|
|
'friends' => 2, |
40 |
|
|
'photos' => 4, |
41 |
|
|
'audio' => 8, |
42 |
|
|
'video' => 16, |
43 |
|
|
'docs' => 131072, |
44 |
|
|
'notes' => 2048, |
45 |
|
|
'pages' => 128, |
46 |
|
|
'menu_link' => 256, |
47 |
|
|
'status' => 1024, |
48 |
|
|
'groups' => 262144, |
49 |
|
|
'email' => 4194304, |
50 |
|
|
'notifications' => 524288, |
51 |
|
|
'stats' => 1048576, |
52 |
|
|
'ads' => 32768, |
53 |
|
|
'offline' => 65536, |
54 |
|
|
); |
55 |
|
|
|
56 |
240 |
ahitrov |
sub new { |
57 |
|
|
my ($class, %config) = @_; |
58 |
|
|
my $self = bless {}, $class; |
59 |
|
|
|
60 |
557 |
ahitrov |
$self->{vk_authorize_url} = 'https://oauth.vk.com/authorize'; |
61 |
240 |
ahitrov |
$self->{vk_access_token_url} = 'https://oauth.vk.com/access_token'; |
62 |
|
|
$self->{vk_user_info_url} = 'https://api.vk.com/method/getProfiles'; |
63 |
|
|
|
64 |
660 |
ahitrov |
for (qw( vk_app_id vk_app_secret )) { |
65 |
240 |
ahitrov |
$self->{$_} = $config{$_} || $state->{session}->{$_} || return undef; |
66 |
|
|
} |
67 |
676 |
ahitrov |
if ( $config{vk_scope} || $state->{session}->{vk_scope} ) { |
68 |
|
|
$self->{vk_scope} = $config{vk_scope} || $state->{session}->{vk_scope}; |
69 |
|
|
} |
70 |
240 |
ahitrov |
$self->{timeout} = $state->{session}->{connection_timeout} || 3; |
71 |
|
|
for (qw(vk_user_post_url vk_redirect_uri)) { |
72 |
|
|
$self->{$_} = $config{$_} || $state->{session}->{$_}; |
73 |
|
|
} |
74 |
676 |
ahitrov |
$self->{vk_api_version} = '5.52'; |
75 |
240 |
ahitrov |
return $self; |
76 |
|
|
} |
77 |
|
|
|
78 |
|
|
sub authorize_url { |
79 |
|
|
my $self = shift; |
80 |
|
|
my (%args) = @_; |
81 |
|
|
my $go = URI->new( $self->{vk_authorize_url} ); |
82 |
|
|
$go->query_param( client_id => $self->{vk_app_id} ); |
83 |
512 |
ahitrov |
$go->query_param( scope => $self->{vk_scope} || '' ); |
84 |
557 |
ahitrov |
$go->query_param( display => 'page' ); |
85 |
240 |
ahitrov |
$go->query_param( response_type => 'code' ); |
86 |
676 |
ahitrov |
$go->query_param( v => $self->{vk_api_version} ); |
87 |
240 |
ahitrov |
$args{redirect_uri} ||= $self->{vk_redirect_uri}; |
88 |
|
|
for ( keys %args ) { |
89 |
|
|
$go->query_param( $_ => $args{$_} ); |
90 |
|
|
} |
91 |
557 |
ahitrov |
warn "VK AUTH URL: $go\n" if $DEBUG; |
92 |
272 |
ahitrov |
my $local_session = $session || $keeper->{session}->get_session; |
93 |
|
|
$local_session->set( vk_redirect_url => $self->{vk_redirect_uri} ); |
94 |
240 |
ahitrov |
return $go; |
95 |
|
|
} |
96 |
|
|
|
97 |
|
|
sub authenticate { |
98 |
|
|
my ( $self, %authinfo ) = @_; |
99 |
|
|
warn "VK.authenticate" if $DEBUG; |
100 |
|
|
|
101 |
|
|
my $local_session = $session || $keeper->{session}->get_session; |
102 |
|
|
my $redirect_uri = $self->{vk_redirect_uri}; |
103 |
|
|
|
104 |
|
|
my $access_token = $local_session->{vk_access_token}; |
105 |
|
|
my $vk_user_id = $local_session->{vk_user_id}; |
106 |
|
|
my $expires = $local_session->{vk_expires}; |
107 |
|
|
if ($access_token and $expires > time) { |
108 |
|
|
warn "Already have access_token" if $DEBUG; |
109 |
|
|
} else { |
110 |
|
|
undef $access_token; |
111 |
|
|
} |
112 |
|
|
my $code = $authinfo{'code'}; |
113 |
|
|
unless ( $code ) { |
114 |
|
|
warn "Call to authenticate without code\n"; |
115 |
|
|
return undef; |
116 |
|
|
} |
117 |
|
|
my $ua = LWP::UserAgent->new; |
118 |
|
|
$ua->timeout($self->{timeout}); |
119 |
|
|
|
120 |
|
|
unless ($access_token) { |
121 |
|
|
my $req = URI->new( $self->{vk_access_token_url}); |
122 |
|
|
$req->query_param( client_id => $self->{vk_app_id} ); |
123 |
|
|
$req->query_param( client_secret => $self->{vk_app_secret} ); |
124 |
|
|
$req->query_param( code => $code ); |
125 |
|
|
$req->query_param( redirect_uri => $redirect_uri ); |
126 |
676 |
ahitrov |
$req->query_param( v => $self->{vk_api_version} ); |
127 |
242 |
ahitrov |
warn "Token request: [$req]\n" if $DEBUG; |
128 |
240 |
ahitrov |
my $res = $ua->get($req); |
129 |
|
|
unless ($res->code == 200) { |
130 |
|
|
warn "VK: Access_token request failed: ".$res->status_line."\n"; |
131 |
|
|
return undef; |
132 |
|
|
} |
133 |
|
|
my $info = $JSON->decode($res->content); |
134 |
513 |
ahitrov |
warn Dumper $info if $DEBUG; |
135 |
240 |
ahitrov |
unless ( ref $info eq 'HASH' && ($access_token = $info->{access_token}) ) { |
136 |
|
|
warn "No access token in response: ".$res->content."\n"; |
137 |
|
|
return undef; |
138 |
|
|
} |
139 |
272 |
ahitrov |
$local_session->set( vk_access_token => $access_token ); |
140 |
|
|
$local_session->set( vk_user_id => $info->{user_id} ); |
141 |
513 |
ahitrov |
if ( exists $info->{email} ) { |
142 |
|
|
$local_session->set( vk_email => $info->{email} ); |
143 |
|
|
$local_session->set( email => $info->{email} ) unless exists $local_session->{email}; |
144 |
|
|
} |
145 |
240 |
ahitrov |
if ( my $expires = $info->{expires_in} ) { |
146 |
272 |
ahitrov |
$local_session->set( vk_expires => time + $expires ); |
147 |
240 |
ahitrov |
} else { |
148 |
272 |
ahitrov |
#$local_session->set( vk_expires => time + 3600*24 ); |
149 |
240 |
ahitrov |
} |
150 |
272 |
ahitrov |
warn "VK: requested access token" if $DEBUG; |
151 |
240 |
ahitrov |
} else { |
152 |
272 |
ahitrov |
warn "VK: have access token" if $DEBUG; |
153 |
240 |
ahitrov |
} |
154 |
|
|
|
155 |
513 |
ahitrov |
my @fields = qw( uid first_name last_name nickname domain sex bdate city country timezone photo photo_medium photo_big ); |
156 |
240 |
ahitrov |
my $req = URI->new( $self->{vk_user_info_url} ); |
157 |
|
|
$req->query_param( uid => $local_session->{vk_user_id} ); |
158 |
513 |
ahitrov |
$req->query_param( fields => join ',', @fields ); |
159 |
240 |
ahitrov |
$req->query_param( access_token => $access_token ); |
160 |
676 |
ahitrov |
$req->query_param( v => $self->{vk_api_version} ); |
161 |
240 |
ahitrov |
|
162 |
|
|
warn "VK: Fetching user $req\n" if $DEBUG; |
163 |
|
|
my $res = $ua->get($req); |
164 |
|
|
unless ($res->code == 200) { |
165 |
|
|
warn "VK: user request failed: ".$res->status_line."\n"; |
166 |
|
|
return undef; |
167 |
|
|
} |
168 |
|
|
|
169 |
|
|
my $info; |
170 |
|
|
unless ( $info = eval { $JSON->decode($res->content) } ) { |
171 |
|
|
warn "user '".$res->content."' decode failed: $@\n"; |
172 |
|
|
return undef; |
173 |
|
|
} |
174 |
|
|
warn Dumper($info) if $DEBUG; |
175 |
|
|
return undef unless exists $info->{response} && ref $info->{response} eq 'ARRAY' && @{$info->{response}}; |
176 |
|
|
my $user_info = $info->{response}[0]; |
177 |
|
|
foreach my $key ( qw(nickname last_name first_name) ) { |
178 |
|
|
$user_info->{$key} = Encode::encode('utf-8', $user_info->{$key}); |
179 |
|
|
} |
180 |
|
|
|
181 |
|
|
my @plugins = split (/[\ |\t]+/, $state->{plugins}); |
182 |
|
|
my $name = $user_info->{first_name}.' '.$user_info->{last_name}; |
183 |
512 |
ahitrov |
my $email = exists $user_info->{email} && $user_info->{email} ? $user_info->{email} : undef; |
184 |
240 |
ahitrov |
if ( grep { $_ eq 'users' } @plugins ) { |
185 |
308 |
ahitrov |
my $user; |
186 |
|
|
if ( $state->{users}->use_credentials ) { |
187 |
320 |
ahitrov |
if ( $local_session->id ) { |
188 |
|
|
$user = $keeper->{users}->get_profile( id => $local_session->{id} ); |
189 |
|
|
} else { |
190 |
|
|
$user = $keeper->{users}->get_profile( vkontakte => $user_info->{uid} ); |
191 |
|
|
} |
192 |
312 |
ahitrov |
} |
193 |
513 |
ahitrov |
if ( !ref $user && (exists $local_session->{vk_email} || exists $local_session->{email}) ) { |
194 |
|
|
$user = $keeper->{users}->get_profile( email => exists $local_session->{vk_email} ? $local_session->{vk_email} : $local_session->{email} ); |
195 |
|
|
} |
196 |
312 |
ahitrov |
unless ( ref $user ) { |
197 |
308 |
ahitrov |
$user = $keeper->{users}->get_profile( login => 'vkontakte:'.$user_info->{uid} ); |
198 |
|
|
} |
199 |
240 |
ahitrov |
unless ( ref $user ) { |
200 |
|
|
my $user_class = $state->{users}->profile_document_class; |
201 |
|
|
$user = $user_class->new( $keeper ); |
202 |
370 |
ahitrov |
my %props = map { $_->{attr} => $_ } $user->structure; |
203 |
513 |
ahitrov |
$user->login( exists $local_session->{vk_email} ? $local_session->{vk_email} : 'vkontakte:'.$user_info->{uid} ); |
204 |
240 |
ahitrov |
$user->name( $user_info->{last_name}.', '.$user_info->{first_name} ); |
205 |
|
|
$user->nickname( $user_info->{nickname} ); |
206 |
|
|
$user->status( 1 ); |
207 |
|
|
$user->type( 0 ); |
208 |
|
|
$user->login_method('vkontakte'); |
209 |
370 |
ahitrov |
if ( exists $props{country} ) { |
210 |
|
|
$user->country( $user_info->{country} ); |
211 |
|
|
} |
212 |
513 |
ahitrov |
$user->email( $local_session->{vk_email} ? $local_session->{vk_email} : undef ); |
213 |
240 |
ahitrov |
|
214 |
|
|
my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure; |
215 |
|
|
if ( ref $prop_ava ) { |
216 |
|
|
my $avatar = $user->_store_image( $user_info->{photo_big}, attr => 'avatar' ); |
217 |
410 |
ahitrov |
$user->avatar( $user->_serialize($avatar) ); |
218 |
240 |
ahitrov |
} |
219 |
|
|
|
220 |
|
|
$user->store; |
221 |
|
|
} else { |
222 |
|
|
my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure; |
223 |
|
|
if ( ref $prop_ava ) { |
224 |
|
|
my $avatar = $user->get_image( 'avatar' ); |
225 |
|
|
unless ( ref $avatar && exists $avatar->{filename} ) { |
226 |
|
|
my $avatar = $user->_store_image( $user_info->{photo_big}, attr => 'avatar' ); |
227 |
410 |
ahitrov |
$user->avatar( $user->_serialize($avatar) ); |
228 |
240 |
ahitrov |
$user->store; |
229 |
|
|
} |
230 |
|
|
} |
231 |
|
|
} |
232 |
312 |
ahitrov |
if ( $state->{users}->use_credentials ) { |
233 |
|
|
$user->create_credential( |
234 |
514 |
ahitrov |
name => $user_info->{last_name}.', '.$user_info->{first_name}, |
235 |
312 |
ahitrov |
vkontakte => $user_info->{uid}, |
236 |
|
|
avatar => $user_info->{photo_big}, |
237 |
|
|
); |
238 |
|
|
} |
239 |
410 |
ahitrov |
my %data = session::Keeper::_get_hash_from_profile( $user ); |
240 |
|
|
$data{auth_by} = 'vkontakte'; |
241 |
240 |
ahitrov |
if ( $user_info->{photo} ) { |
242 |
410 |
ahitrov |
$data{avatar} ||= $user_info->{photo}; |
243 |
240 |
ahitrov |
} |
244 |
272 |
ahitrov |
$local_session->set( %data ); |
245 |
240 |
ahitrov |
|
246 |
|
|
} else { |
247 |
|
|
my %data = ( |
248 |
|
|
id => $user_info->{uid}, |
249 |
|
|
name => $name, |
250 |
|
|
nick => $user_info->{nickname} || $name, |
251 |
514 |
ahitrov |
login => exists $local_session->{vk_email} ? $local_session->{vk_email} : 'vkontakte:'.$user_info->{uid}, |
252 |
240 |
ahitrov |
status => 1, |
253 |
|
|
type => 0, |
254 |
|
|
auth_by => 'vkontakte', |
255 |
|
|
ltime => time, |
256 |
|
|
); |
257 |
|
|
if ( $user_info->{photo} ) { |
258 |
|
|
$data{avatar} = $user_info->{photo}; |
259 |
|
|
} |
260 |
272 |
ahitrov |
$local_session->set( %data ); |
261 |
240 |
ahitrov |
} |
262 |
|
|
return $local_session; |
263 |
|
|
} |
264 |
|
|
|
265 |
|
|
1; |