line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::OpenStack::Compute::AuthRole; |
2
|
2
|
|
|
2
|
|
2174
|
use Moose::Role; |
|
2
|
|
|
|
|
7547
|
|
|
2
|
|
|
|
|
10
|
|
3
|
|
|
|
|
|
|
|
4
|
2
|
|
|
2
|
|
8942
|
use JSON qw(from_json to_json); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
17
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
requires qw( |
7
|
|
|
|
|
|
|
auth_url |
8
|
|
|
|
|
|
|
user |
9
|
|
|
|
|
|
|
password |
10
|
|
|
|
|
|
|
project_id |
11
|
|
|
|
|
|
|
region |
12
|
|
|
|
|
|
|
service_name |
13
|
|
|
|
|
|
|
is_rax_auth |
14
|
|
|
|
|
|
|
verify_ssl |
15
|
|
|
|
|
|
|
_agent |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub get_auth_info { |
19
|
2
|
|
|
2
|
0
|
3
|
my ($self) = @_; |
20
|
2
|
|
|
|
|
72
|
my $auth_url = $self->auth_url; |
21
|
2
|
|
|
|
|
7
|
my ($version) = $auth_url =~ /(v\d+\.\d+)$/; |
22
|
2
|
100
|
|
|
|
17
|
die "Could not determine version from url [$auth_url]" unless $version; |
23
|
1
|
50
|
|
|
|
31
|
return $self->auth_rax() if $self->is_rax_auth; |
24
|
1
|
50
|
|
|
|
3
|
return $self->auth_basic() if $version lt 'v2'; |
25
|
1
|
|
|
|
|
5
|
return $self->auth_keystone(); |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub auth_basic { |
29
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
30
|
0
|
|
|
|
|
0
|
my $res = $self->_agent->get($self->auth_url, |
31
|
|
|
|
|
|
|
x_auth_user => $self->user, |
32
|
|
|
|
|
|
|
x_auth_key => $self->password, |
33
|
|
|
|
|
|
|
x_auth_project_id => $self->project_id, |
34
|
|
|
|
|
|
|
); |
35
|
0
|
0
|
|
|
|
0
|
die $res->status_line . "\n" . $res->content unless $res->is_success; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
return { |
38
|
0
|
|
|
|
|
0
|
base_url => $res->header('x-server-management-url'), |
39
|
|
|
|
|
|
|
token => $res->header('x-auth-token'), |
40
|
|
|
|
|
|
|
}; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub auth_keystone { |
44
|
1
|
|
|
1
|
0
|
1
|
my ($self) = @_; |
45
|
1
|
|
|
|
|
30
|
return $self->_parse_catalog({ |
46
|
|
|
|
|
|
|
auth => { |
47
|
|
|
|
|
|
|
tenantName => $self->project_id, |
48
|
|
|
|
|
|
|
passwordCredentials => { |
49
|
|
|
|
|
|
|
username => $self->user, |
50
|
|
|
|
|
|
|
password => $self->password, |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
}); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub auth_rax { |
57
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
58
|
0
|
|
|
|
|
0
|
return $self->_parse_catalog({ |
59
|
|
|
|
|
|
|
auth => { |
60
|
|
|
|
|
|
|
'RAX-KSKEY:apiKeyCredentials' => { |
61
|
|
|
|
|
|
|
apiKey => $self->password, |
62
|
|
|
|
|
|
|
username => $self->user, |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
}); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub _parse_catalog { |
69
|
1
|
|
|
1
|
|
2
|
my ($self, $auth_data) = @_; |
70
|
1
|
|
|
|
|
27
|
my $res = $self->_agent->post($self->auth_url . "/tokens", |
71
|
|
|
|
|
|
|
content_type => 'application/json', content => to_json($auth_data)); |
72
|
1
|
50
|
|
|
|
423312
|
die $res->status_line . "\n" . $res->content unless $res->is_success; |
73
|
0
|
|
|
|
|
|
my $data = from_json($res->content); |
74
|
0
|
|
|
|
|
|
my $token = $data->{access}{token}{id}; |
75
|
|
|
|
|
|
|
|
76
|
0
|
|
|
|
|
|
my @catalog = @{ $data->{access}{serviceCatalog} }; |
|
0
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
@catalog = grep { $_->{type} eq 'compute' } @catalog; |
|
0
|
|
|
|
|
|
|
78
|
0
|
0
|
|
|
|
|
die "No compute catalog found" unless @catalog; |
79
|
0
|
0
|
|
|
|
|
if ($self->service_name) { |
80
|
0
|
|
|
|
|
|
@catalog = grep { $_->{name} eq $self->service_name } @catalog; |
|
0
|
|
|
|
|
|
|
81
|
0
|
0
|
|
|
|
|
die "No catalog found named " . $self->service_name unless @catalog; |
82
|
|
|
|
|
|
|
} |
83
|
0
|
|
|
|
|
|
my $catalog = $catalog[0]; |
84
|
0
|
|
|
|
|
|
my $base_url = $catalog->{endpoints}[0]{publicURL}; |
85
|
0
|
0
|
|
|
|
|
if ($self->region) { |
86
|
0
|
|
|
|
|
|
for my $endpoint (@{ $catalog->{endpoints} }) { |
|
0
|
|
|
|
|
|
|
87
|
0
|
0
|
|
|
|
|
my $region = $endpoint->{region} or next; |
88
|
0
|
0
|
|
|
|
|
if ($region eq $self->region) { |
89
|
0
|
|
|
|
|
|
$base_url = $endpoint->{publicURL}; |
90
|
0
|
|
|
|
|
|
last; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
return { base_url => $base_url, token => $token }; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
1; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
__END__ |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=pod |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=encoding UTF-8 |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 NAME |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Net::OpenStack::Compute::AuthRole |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head1 VERSION |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
version 1.1200 |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head1 DESCRIPTION |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
This role is used by L<Net::OpenStack::Compute> for OpenStack authentication. |
118
|
|
|
|
|
|
|
It supports the old 1.0 style auth, |
119
|
|
|
|
|
|
|
L<Keystone|https://github.com/openstack/keystone> auth, |
120
|
|
|
|
|
|
|
and Rackspace's RAX auth. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head1 AUTHOR |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Naveed Massjouni <naveedm9@gmail.com> |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
This software is copyright (c) 2011 by Naveed Massjouni. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
131
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |