Line # Revision Author
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;