line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Azure::AD::DeviceLogin; |
2
|
1
|
|
|
1
|
|
1349
|
use Moo; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
5
|
|
3
|
1
|
|
|
1
|
|
363
|
use Azure::AD::Errors; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
4
|
1
|
|
|
1
|
|
7
|
use Types::Standard qw/Str Int InstanceOf CodeRef/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
11
|
|
5
|
1
|
|
|
1
|
|
1026
|
use JSON::MaybeXS; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
63
|
|
6
|
1
|
|
|
1
|
|
6
|
use HTTP::Tiny; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
934
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
has ua_agent => (is => 'ro', isa => Str, default => sub { |
11
|
|
|
|
|
|
|
'Azure::AD::DeviceLogin ' . $Azure::AD::DeviceLogin::VERSION |
12
|
|
|
|
|
|
|
}); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
has ua => (is => 'rw', required => 1, lazy => 1, |
15
|
|
|
|
|
|
|
default => sub { |
16
|
|
|
|
|
|
|
my $self = shift; |
17
|
|
|
|
|
|
|
HTTP::Tiny->new( |
18
|
|
|
|
|
|
|
agent => $self->ua_agent, |
19
|
|
|
|
|
|
|
timeout => 60, |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
has resource_id => ( |
25
|
|
|
|
|
|
|
is => 'ro', |
26
|
|
|
|
|
|
|
isa => Str, |
27
|
|
|
|
|
|
|
required => 1, |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has message_handler => ( |
31
|
|
|
|
|
|
|
is => 'ro', |
32
|
|
|
|
|
|
|
isa => CodeRef, |
33
|
|
|
|
|
|
|
required => 1, |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
has tenant_id => ( |
37
|
|
|
|
|
|
|
is => 'ro', |
38
|
|
|
|
|
|
|
isa => Str, |
39
|
|
|
|
|
|
|
required => 1, |
40
|
|
|
|
|
|
|
default => sub { |
41
|
|
|
|
|
|
|
$ENV{AZURE_TENANT_ID} |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
has client_id => ( |
46
|
|
|
|
|
|
|
is => 'ro', |
47
|
|
|
|
|
|
|
isa => Str, |
48
|
|
|
|
|
|
|
required => 1, |
49
|
|
|
|
|
|
|
default => sub { |
50
|
|
|
|
|
|
|
$ENV{AZURE_CLIENT_ID} |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
has ad_url => ( |
55
|
|
|
|
|
|
|
is => 'ro', |
56
|
|
|
|
|
|
|
isa => Str, |
57
|
|
|
|
|
|
|
default => sub { |
58
|
|
|
|
|
|
|
'https://login.microsoftonline.com' |
59
|
|
|
|
|
|
|
}, |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
has device_endpoint => ( |
63
|
|
|
|
|
|
|
is => 'ro', |
64
|
|
|
|
|
|
|
isa => Str, |
65
|
|
|
|
|
|
|
lazy => 1, |
66
|
|
|
|
|
|
|
default => sub { |
67
|
|
|
|
|
|
|
my $self = shift; |
68
|
|
|
|
|
|
|
sprintf '%s/%s/oauth2/devicecode', $self->ad_url, $self->tenant_id; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
has token_endpoint => ( |
73
|
|
|
|
|
|
|
is => 'ro', |
74
|
|
|
|
|
|
|
isa => Str, |
75
|
|
|
|
|
|
|
lazy => 1, |
76
|
|
|
|
|
|
|
default => sub { |
77
|
|
|
|
|
|
|
my $self = shift; |
78
|
|
|
|
|
|
|
sprintf "%s/%s/oauth2/token", $self->ad_url, $self->tenant_id; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub access_token { |
83
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
84
|
0
|
|
|
|
|
|
$self->_refresh; |
85
|
0
|
|
|
|
|
|
$self->current_creds->{ access_token }; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
has current_creds => (is => 'rw'); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
has expiration => ( |
91
|
|
|
|
|
|
|
is => 'rw', |
92
|
|
|
|
|
|
|
isa => Int, |
93
|
|
|
|
|
|
|
lazy => 1, |
94
|
|
|
|
|
|
|
default => sub { 0 } |
95
|
|
|
|
|
|
|
); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub _refresh_from_cache { |
98
|
0
|
|
|
0
|
|
|
my $self = shift; |
99
|
|
|
|
|
|
|
#TODO: implement caching strategy |
100
|
0
|
|
|
|
|
|
return undef; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub _save_to_cache { |
104
|
0
|
|
|
0
|
|
|
my $self = shift; |
105
|
|
|
|
|
|
|
#TODO: implement caching strategy |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub get_device_payload { |
109
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
110
|
0
|
|
|
|
|
|
my $device_response = $self->ua->post_form( |
111
|
|
|
|
|
|
|
$self->device_endpoint, |
112
|
|
|
|
|
|
|
{ |
113
|
|
|
|
|
|
|
client_id => $self->client_id, |
114
|
|
|
|
|
|
|
resource => $self->resource_id, |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
); |
117
|
|
|
|
|
|
|
|
118
|
0
|
0
|
|
|
|
|
if (not $device_response->{ success }) { |
119
|
|
|
|
|
|
|
Azure::AD::RemoteError->throw( |
120
|
|
|
|
|
|
|
message => $device_response->{ content }, |
121
|
|
|
|
|
|
|
code => 'GetDeviceCodeFailed', |
122
|
|
|
|
|
|
|
status => $device_response->{ status } |
123
|
0
|
|
|
|
|
|
); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
return decode_json($device_response->{ content }); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub get_auth_payload_for { |
130
|
0
|
|
|
0
|
0
|
|
my ($self, $device_payload) = @_; |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
|
my $code_expiration = time + $device_payload->{ expires_in }; |
133
|
0
|
|
|
|
|
|
my $auth_response; |
134
|
0
|
|
0
|
|
|
|
while ($code_expiration > time and not $auth_response->{ success }) { |
135
|
0
|
|
|
|
|
|
sleep($device_payload->{ interval }); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
$auth_response = $self->ua->post_form( |
138
|
|
|
|
|
|
|
$self->token_endpoint, |
139
|
|
|
|
|
|
|
{ |
140
|
|
|
|
|
|
|
grant_type => 'device_code', |
141
|
|
|
|
|
|
|
code => $device_payload->{ device_code }, |
142
|
0
|
|
|
|
|
|
client_id => $self->client_id, |
143
|
|
|
|
|
|
|
resource => $self->resource_id, |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
0
|
0
|
|
|
|
|
if (not $auth_response->{ success }) { |
149
|
|
|
|
|
|
|
Azure::AD::RemoteError->throw( |
150
|
|
|
|
|
|
|
message => $auth_response->{ content }, |
151
|
|
|
|
|
|
|
code => 'GetAuthTokenFailed', |
152
|
|
|
|
|
|
|
status => $auth_response->{ status } |
153
|
0
|
|
|
|
|
|
); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
|
return decode_json($auth_response->{content}); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub _refresh { |
160
|
0
|
|
|
0
|
|
|
my $self = shift; |
161
|
|
|
|
|
|
|
|
162
|
0
|
0
|
|
|
|
|
if (not defined $self->current_creds) { |
163
|
0
|
|
|
|
|
|
$self->_refresh_from_cache; |
164
|
0
|
0
|
|
|
|
|
return $self->current_creds if (defined $self->current_creds); |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
0
|
0
|
|
|
|
|
return if $self->expiration >= time; |
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
|
my $device_payload = $self->get_device_payload; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
|
$self->message_handler->($device_payload->{ message }); |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
|
|
|
my $auth = $self->get_auth_payload_for($device_payload); |
174
|
|
|
|
|
|
|
|
175
|
0
|
|
|
|
|
|
$self->current_creds($auth); |
176
|
0
|
|
|
|
|
|
$self->expiration($auth->{ expires_on }); |
177
|
0
|
|
|
|
|
|
$self->_save_to_cache; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
1; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=encoding UTF-8 |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head1 NAME |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Azure::AD::DeviceLogin - Azure AD Device Login authentication flow |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 SYNOPSIS |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
use Azure::AD::DeviceLogin; |
191
|
|
|
|
|
|
|
my $creds = Azure::AD::ClientCredentials->new( |
192
|
|
|
|
|
|
|
resource_id => 'https://management.core.windows.net/', |
193
|
|
|
|
|
|
|
message_handler => sub { say $_[0] }, |
194
|
|
|
|
|
|
|
client_id => '', |
195
|
|
|
|
|
|
|
tenant_id => '', |
196
|
|
|
|
|
|
|
); |
197
|
|
|
|
|
|
|
say $creds->access_token; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head1 DESCRIPTION |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
Implements the Azure AD Device Login flow. See L for more |
202
|
|
|
|
|
|
|
information and alternative flows. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head2 resource_id |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
The URL for which you want a token extended (the URL of the service which you want |
209
|
|
|
|
|
|
|
to obtain a token for). |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
C for using the MS Graph API |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
C for using the Azure Management APIs |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=head2 message_handler |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Callback that receives the message for the user as it's first argument. This callback |
218
|
|
|
|
|
|
|
should transmit the message to the end user, who has to follow the instructions embedded |
219
|
|
|
|
|
|
|
in it. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head2 tenant_id |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
The ID of the Azure Active Directory Tenant |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head2 client_id |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
The Client ID (also referred to as the Application ID) of an application |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head2 ad_url |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
This defaults to C, and generally doesn't need to |
232
|
|
|
|
|
|
|
be specified. Azure AD has more endpoints for some clouds: |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
C China Cloud |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
C US Gov Cloud |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
C German Cloud |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head1 METHODS |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head2 access_token |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Returns the access token that has to be sent to the APIs you want to access. This |
245
|
|
|
|
|
|
|
is normally sent in the Authentication header of HTTPS requests as a Bearer token. |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
The call to access_token will start the Device Login flow, which involves transmitting |
248
|
|
|
|
|
|
|
a message to the user (see message_handler attribute). The user will have to visit a |
249
|
|
|
|
|
|
|
URL with a browser, insert the code in the message, authorize the application, and then |
250
|
|
|
|
|
|
|
the authentication will proceed. Meanwhile the call to access_code will be blocked, |
251
|
|
|
|
|
|
|
awaiting the user to complete the flow. Once the user completes the instructions the access_code |
252
|
|
|
|
|
|
|
will be returned. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
The access_token is cached in the object as long as it's valid, so subsequent calls |
255
|
|
|
|
|
|
|
to access_token will return the appropiate token without reauthenticating to Azure AD. |
256
|
|
|
|
|
|
|
If the token has expired, access_token will call Azure AD to obtain a new token. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Example usage: |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
my $auth = Azure::AD::DeviceLogin->new(...); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
use HTTP::Tiny; |
263
|
|
|
|
|
|
|
my $ua = HTTP::Tiny->new; |
264
|
|
|
|
|
|
|
my $response = $ua->get( |
265
|
|
|
|
|
|
|
'http://aservice.com/orders/list', |
266
|
|
|
|
|
|
|
{ |
267
|
|
|
|
|
|
|
headers => { Authorization => 'Bearer ' . $auth->access_token } |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
); |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head1 SEE ALSO |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
L |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=head1 COPYRIGHT and LICENSE |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Copyright (c) 2018 by CAPSiDE |
278
|
|
|
|
|
|
|
This code is distributed under the Apache 2 License. The full text of the |
279
|
|
|
|
|
|
|
license can be found in the LICENSE file included with this module. |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=cut |