line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Perl interface for the Duo Auth API. |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# This Perl module collection provides a Perl interface to the Auth API |
4
|
|
|
|
|
|
|
# integration for the Duo multifactor authentication service |
5
|
|
|
|
|
|
|
# (https://www.duo.com/). It differs from the Perl API sample code in that it |
6
|
|
|
|
|
|
|
# wraps all the returned data structures in objects with method calls, |
7
|
|
|
|
|
|
|
# abstracts some of the API details, and throws rich exceptions rather than |
8
|
|
|
|
|
|
|
# requiring the caller deal with JSON data structures directly. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# SPDX-License-Identifier: MIT |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
package Net::Duo::Auth 1.02; |
13
|
|
|
|
|
|
|
|
14
|
3
|
|
|
3
|
|
3270
|
use 5.014; |
|
3
|
|
|
|
|
12
|
|
15
|
3
|
|
|
3
|
|
18
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
61
|
|
16
|
3
|
|
|
3
|
|
15
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
86
|
|
17
|
|
|
|
|
|
|
|
18
|
3
|
|
|
3
|
|
1295
|
use parent qw(Net::Duo); |
|
3
|
|
|
|
|
896
|
|
|
3
|
|
|
|
|
14
|
|
19
|
|
|
|
|
|
|
|
20
|
3
|
|
|
3
|
|
160
|
use Carp qw(croak); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
134
|
|
21
|
3
|
|
|
3
|
|
1358
|
use Net::Duo::Auth::Async; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
93
|
|
22
|
3
|
|
|
3
|
|
20
|
use URI::Escape qw(uri_escape_utf8); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
2072
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# All dies are of constructed objects, which perlcritic misdiagnoses. |
25
|
|
|
|
|
|
|
## no critic (ErrorHandling::RequireCarping) |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
############################################################################## |
28
|
|
|
|
|
|
|
# Auth API methods |
29
|
|
|
|
|
|
|
############################################################################## |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Helper function to validate and canonicalize arguments to the auth and |
32
|
|
|
|
|
|
|
# auth_async functions. Ensures that the arguments meet the calling contract |
33
|
|
|
|
|
|
|
# for the auth method (see below) and returns a reference to a new hash with |
34
|
|
|
|
|
|
|
# the canonicalized copy of data. |
35
|
|
|
|
|
|
|
# |
36
|
|
|
|
|
|
|
# $self - The Net::Duo::Auth object |
37
|
|
|
|
|
|
|
# $args_ref - Reference to hash of arguments to an auth function |
38
|
|
|
|
|
|
|
# |
39
|
|
|
|
|
|
|
# Returns: Reference to hash of canonicalized arguments |
40
|
|
|
|
|
|
|
# Throws: Text exception on internal call method error |
41
|
|
|
|
|
|
|
sub _canonicalize_auth_args { |
42
|
3
|
|
|
3
|
|
7
|
my ($self, $args_ref) = @_; |
43
|
3
|
|
|
|
|
6
|
my %args = %{$args_ref}; |
|
3
|
|
|
|
|
13
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Ensure we have either username or user_id, but not neither or both. |
46
|
3
|
|
|
|
|
8
|
my $user_count = grep { defined($args{$_}) } qw(username user_id); |
|
6
|
|
|
|
|
18
|
|
47
|
3
|
50
|
|
|
|
14
|
if ($user_count < 1) { |
|
|
50
|
|
|
|
|
|
48
|
0
|
|
|
|
|
0
|
croak('no username or user_id specified'); |
49
|
|
|
|
|
|
|
} elsif ($user_count > 1) { |
50
|
0
|
|
|
|
|
0
|
croak('username and user_id both given'); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Ensure factor is set. |
54
|
3
|
50
|
|
|
|
10
|
if (!defined($args{factor})) { |
55
|
0
|
|
|
|
|
0
|
croak('no factor specified'); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# Set some defaults that we provide in our API guarantee. |
59
|
3
|
|
|
|
|
6
|
my $factor = $args{factor}; |
60
|
3
|
100
|
66
|
|
|
24
|
if ($factor eq 'push' || $factor eq 'phone' || $factor eq 'auto') { |
|
|
|
100
|
|
|
|
|
61
|
2
|
|
100
|
|
|
9
|
$args{device} //= 'auto'; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Convert pushinfo to a URL-encoded string if it is present. We use this |
65
|
|
|
|
|
|
|
# logic rather than _canonicalize_args so that we can preserve order. |
66
|
3
|
100
|
|
|
|
14
|
if ($args{pushinfo}) { |
67
|
1
|
|
|
|
|
2
|
my @pushinfo = @{ $args{pushinfo} }; |
|
1
|
|
|
|
|
4
|
|
68
|
1
|
|
|
|
|
2
|
my @pairs; |
69
|
1
|
|
|
|
|
3
|
while (@pushinfo) { |
70
|
2
|
|
|
|
|
8
|
my $encoded_key = uri_escape_utf8(shift(@pushinfo)); |
71
|
2
|
|
|
|
|
89
|
my $encoded_value = uri_escape_utf8(shift(@pushinfo)); |
72
|
2
|
|
|
|
|
46
|
my $pair = $encoded_key . q{=} . $encoded_value; |
73
|
2
|
|
|
|
|
6
|
push(@pairs, $pair); |
74
|
|
|
|
|
|
|
} |
75
|
1
|
|
|
|
|
5
|
$args{pushinfo} = join(q{&}, @pairs); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# Return the results. Currently, we don't validate any of the other |
79
|
|
|
|
|
|
|
# arguments and just pass them straight to Duo. We could do better about |
80
|
|
|
|
|
|
|
# this. |
81
|
3
|
|
|
|
|
9
|
return \%args; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# Perform a synchronous user authentication. The user will be authenticated |
85
|
|
|
|
|
|
|
# given the factor and additional information provided in the $args argument. |
86
|
|
|
|
|
|
|
# The call will not return until the user has authenticated or the call has |
87
|
|
|
|
|
|
|
# failed for some reason. To do long-polling instead, see the auth_async |
88
|
|
|
|
|
|
|
# method. |
89
|
|
|
|
|
|
|
# |
90
|
|
|
|
|
|
|
# $self - The Net::Duo::Auth object |
91
|
|
|
|
|
|
|
# $args_ref - Reference to hash of arguments, chosen from: |
92
|
|
|
|
|
|
|
# user_id - ID of user (either this or username is required) |
93
|
|
|
|
|
|
|
# username - Username of user (either this or user_id is required) |
94
|
|
|
|
|
|
|
# factor - One of auto, push, passcode, or phone |
95
|
|
|
|
|
|
|
# ipaddr - IP address of user (optional) |
96
|
|
|
|
|
|
|
# For factor == push: |
97
|
|
|
|
|
|
|
# device - ID of the device (optional, default is "auto") |
98
|
|
|
|
|
|
|
# type - String to display before prompt (optional) |
99
|
|
|
|
|
|
|
# display_username - String instead of username (optional) |
100
|
|
|
|
|
|
|
# pushinfo - Reference to array of pairs to show user (optional) |
101
|
|
|
|
|
|
|
# For factor == passcode: |
102
|
|
|
|
|
|
|
# passcode - The passcode to validate |
103
|
|
|
|
|
|
|
# For factor == phone: |
104
|
|
|
|
|
|
|
# device - The ID of the device to call (optional, default is "auto") |
105
|
|
|
|
|
|
|
# |
106
|
|
|
|
|
|
|
# Returns: Scalar context: true if user was authenticated, false otherwise |
107
|
|
|
|
|
|
|
# List context: true/false for success, then hash of additional data |
108
|
|
|
|
|
|
|
# status - Status of authentication |
109
|
|
|
|
|
|
|
# status_msg - Detailed status message |
110
|
|
|
|
|
|
|
# trusted_device_token - Token to use later for /preauth |
111
|
|
|
|
|
|
|
# Throws: Net::Duo::Exception on failure |
112
|
|
|
|
|
|
|
sub auth { |
113
|
2
|
|
|
2
|
1
|
18
|
my ($self, $args_ref) = @_; |
114
|
2
|
|
|
|
|
7
|
my $args = $self->_canonicalize_auth_args($args_ref); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# Make the call to Duo. |
117
|
2
|
|
|
|
|
29
|
my $result = $self->call_json('POST', '/auth/v2/auth', $args); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# Ensure we got a valid result. |
120
|
2
|
50
|
33
|
|
|
15
|
if (!defined($result->{result})) { |
|
|
50
|
|
|
|
|
|
121
|
0
|
|
|
|
|
0
|
my $error = 'no authentication result from Duo'; |
122
|
0
|
|
|
|
|
0
|
die Net::Duo::Exception->protocol($error, $result); |
123
|
|
|
|
|
|
|
} elsif ($result->{result} ne 'allow' && $result->{result} ne 'deny') { |
124
|
0
|
|
|
|
|
0
|
my $error = "invalid authentication result $result->{result}"; |
125
|
0
|
|
|
|
|
0
|
die Net::Duo::Exception->protocol($error, $result); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# Determine whether the authentication succeeded, and return the correct |
129
|
|
|
|
|
|
|
# results. |
130
|
2
|
|
|
|
|
6
|
my $success = $result->{result} eq 'allow'; |
131
|
2
|
|
|
|
|
4
|
delete $result->{result}; |
132
|
2
|
100
|
|
|
|
16
|
return wantarray ? ($success, $result) : $success; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# Perform an asynchronous authentication. |
136
|
|
|
|
|
|
|
# |
137
|
|
|
|
|
|
|
# Takes the same arguments as the auth method, but starts an asynchronous |
138
|
|
|
|
|
|
|
# authentication. Returns a transaction ID, which can be passed to |
139
|
|
|
|
|
|
|
# auth_status() to long-poll the result of the authentication. |
140
|
|
|
|
|
|
|
# |
141
|
|
|
|
|
|
|
# $self - The Net::Duo::Auth object |
142
|
|
|
|
|
|
|
# $args_ref - Reference to hash of arguments, chosen from: |
143
|
|
|
|
|
|
|
# |
144
|
|
|
|
|
|
|
# Returns: The transaction ID to poll with auth_status() |
145
|
|
|
|
|
|
|
# Throws: Net::Duo::Exception on failure |
146
|
|
|
|
|
|
|
sub auth_async { |
147
|
1
|
|
|
1
|
1
|
13
|
my ($self, $args_ref) = @_; |
148
|
1
|
|
|
|
|
6
|
my $args = $self->_canonicalize_auth_args($args_ref); |
149
|
1
|
|
|
|
|
4
|
$args->{async} = 1; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# Make the call to Duo. |
152
|
1
|
|
|
|
|
6
|
my $result = $self->call_json('POST', '/auth/v2/auth', $args); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# Return the transaction ID. |
155
|
1
|
50
|
|
|
|
5
|
if (!defined($result->{txid})) { |
156
|
0
|
|
|
|
|
0
|
my $error = 'no transaction ID in response to async auth call'; |
157
|
0
|
|
|
|
|
0
|
die Net::Duo::Exception->protocol($error, $result); |
158
|
|
|
|
|
|
|
} |
159
|
1
|
|
|
|
|
14
|
return Net::Duo::Auth::Async->new($self, $result->{txid}); |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# Confirm that authentication works properly. |
163
|
|
|
|
|
|
|
# |
164
|
|
|
|
|
|
|
# $self - The Net::Duo::Auth object |
165
|
|
|
|
|
|
|
# |
166
|
|
|
|
|
|
|
# Returns: Server time in seconds since UNIX epoch |
167
|
|
|
|
|
|
|
# Throws: Net::Duo::Exception on failure |
168
|
|
|
|
|
|
|
sub check { |
169
|
1
|
|
|
1
|
1
|
8
|
my ($self) = @_; |
170
|
1
|
|
|
|
|
6
|
my $result = $self->call_json('GET', '/auth/v2/check'); |
171
|
1
|
|
|
|
|
7
|
return $result->{time}; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# Send one or more passcodes (depending on Duo configuration) to a user via |
175
|
|
|
|
|
|
|
# SMS. This should always succeed, so any error results in an exception. |
176
|
|
|
|
|
|
|
# |
177
|
|
|
|
|
|
|
# $self - The Net::Duo::Auth object |
178
|
|
|
|
|
|
|
# $username - The username to send SMS passcodes to |
179
|
|
|
|
|
|
|
# $device - ID of the device to which to send passcodes (optional) |
180
|
|
|
|
|
|
|
# |
181
|
|
|
|
|
|
|
# Returns: undef |
182
|
|
|
|
|
|
|
# Throws: Net::Duo::Exception on failure |
183
|
|
|
|
|
|
|
sub send_sms_passcodes { |
184
|
2
|
|
|
2
|
1
|
11
|
my ($self, $username, $device) = @_; |
185
|
2
|
|
100
|
|
|
12
|
my $data = { |
186
|
|
|
|
|
|
|
username => $username, |
187
|
|
|
|
|
|
|
factor => 'sms', |
188
|
|
|
|
|
|
|
device => $device // 'auto', |
189
|
|
|
|
|
|
|
}; |
190
|
2
|
|
|
|
|
10
|
my $result = $self->call_json('POST', '/auth/v2/auth', $data); |
191
|
2
|
50
|
|
|
|
7
|
if ($result->{status} ne 'sent') { |
192
|
0
|
|
|
|
|
0
|
my $status = $result->{status}; |
193
|
0
|
|
|
|
|
0
|
my $message = $result->{status_msg}; |
194
|
0
|
|
|
|
|
0
|
my $error = "sending SMS passcodes returned $status: $message"; |
195
|
0
|
|
|
|
|
0
|
die Net::Duo::Exception->protocol($error, $result); |
196
|
|
|
|
|
|
|
} |
197
|
2
|
|
|
|
|
13
|
return; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
1; |
201
|
|
|
|
|
|
|
__END__ |