line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
9
|
|
|
9
|
|
62860
|
use utf8; |
|
9
|
|
|
|
|
14
|
|
|
9
|
|
|
|
|
50
|
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Net::Etcd::Role::Actions; |
4
|
|
|
|
|
|
|
|
5
|
9
|
|
|
9
|
|
285
|
use strict; |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
129
|
|
6
|
9
|
|
|
9
|
|
35
|
use warnings; |
|
9
|
|
|
|
|
12
|
|
|
9
|
|
|
|
|
150
|
|
7
|
|
|
|
|
|
|
|
8
|
9
|
|
|
9
|
|
52
|
use Moo::Role; |
|
9
|
|
|
|
|
26
|
|
|
9
|
|
|
|
|
69
|
|
9
|
9
|
|
|
9
|
|
5292
|
use AE; |
|
9
|
|
|
|
|
41465
|
|
|
9
|
|
|
|
|
209
|
|
10
|
9
|
|
|
9
|
|
42
|
use JSON; |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
51
|
|
11
|
9
|
|
|
9
|
|
846
|
use MIME::Base64; |
|
9
|
|
|
|
|
11
|
|
|
9
|
|
|
|
|
442
|
|
12
|
9
|
|
|
9
|
|
46
|
use Types::Standard qw(InstanceOf); |
|
9
|
|
|
|
|
14
|
|
|
9
|
|
|
|
|
71
|
|
13
|
9
|
|
|
9
|
|
7661
|
use AnyEvent::HTTP; |
|
9
|
|
|
|
|
189263
|
|
|
9
|
|
|
|
|
538
|
|
14
|
9
|
|
|
9
|
|
61
|
use Carp; |
|
9
|
|
|
|
|
18
|
|
|
9
|
|
|
|
|
366
|
|
15
|
9
|
|
|
9
|
|
4309
|
use Data::Dumper; |
|
9
|
|
|
|
|
43892
|
|
|
9
|
|
|
|
|
434
|
|
16
|
|
|
|
|
|
|
|
17
|
9
|
|
|
9
|
|
57
|
use namespace::clean; |
|
9
|
|
|
|
|
11
|
|
|
9
|
|
|
|
|
60
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=encoding utf8 |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 NAME |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Net::Etcd::Role::Actions |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=cut |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our $VERSION = '0.022'; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
has etcd => ( |
30
|
|
|
|
|
|
|
is => 'ro', |
31
|
|
|
|
|
|
|
isa => InstanceOf ['Net::Etcd'], |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head2 json_args |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
arguments that will be sent to the api |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=cut |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
has json_args => ( is => 'lazy', ); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub _build_json_args { |
43
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
44
|
0
|
|
|
|
|
|
my $args; |
45
|
0
|
|
|
|
|
|
for my $key ( keys %{$self} ) { |
|
0
|
|
|
|
|
|
|
46
|
0
|
0
|
|
|
|
|
unless ( $key =~ /(?:etcd|cb|cv|hold|json_args|endpoint)$/ ) { |
47
|
0
|
|
|
|
|
|
$args->{$key} = $self->{$key}; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
} |
50
|
0
|
|
|
|
|
|
return to_json($args); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head2 cb |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
AnyEvent callback must be a CodeRef |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=cut |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
has cb => ( |
60
|
|
|
|
|
|
|
is => 'ro', |
61
|
|
|
|
|
|
|
isa => sub { |
62
|
|
|
|
|
|
|
die "$_[0] is not a CodeRef!" if ( $_[0] && ref( $_[0] ) ne 'CODE' ); |
63
|
|
|
|
|
|
|
}, |
64
|
|
|
|
|
|
|
); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head2 cv |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=cut |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
has cv => ( is => 'ro', ); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head2 init |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=cut |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub init { |
77
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
78
|
0
|
|
|
|
|
|
my $init = $self->json_args; |
79
|
0
|
0
|
|
|
|
|
$init or return; |
80
|
0
|
|
|
|
|
|
return $self; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head2 headers |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=cut |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
has headers => ( |
88
|
|
|
|
|
|
|
is => 'lazy', |
89
|
|
|
|
|
|
|
clearer => 1 |
90
|
|
|
|
|
|
|
); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub _build_headers { |
93
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
94
|
0
|
|
|
|
|
|
my $headers; |
95
|
0
|
|
|
|
|
|
my $token = $self->etcd->auth_token; |
96
|
0
|
|
|
|
|
|
$headers->{'Content-Type'} = 'application/json'; |
97
|
0
|
0
|
|
|
|
|
unless ( $self->endpoint =~ m/authenticate/ ) { |
98
|
0
|
0
|
|
|
|
|
$headers->{'Authorization'} = $token if $token; |
99
|
|
|
|
|
|
|
} |
100
|
0
|
|
|
|
|
|
return $headers; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
has tls_ctx => ( is => 'lazy', ); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub _build_tls_ctx { |
106
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
107
|
0
|
|
|
|
|
|
my $ca_file = $self->etcd->ca_file; |
108
|
0
|
|
|
|
|
|
my $key_file = $self->etcd->key_file; |
109
|
0
|
|
|
|
|
|
my $cert_file = $self->etcd->cert_file; |
110
|
0
|
|
|
|
|
|
my $cacert = $self->etcd->cacert; |
111
|
0
|
|
|
|
|
|
my $tls; |
112
|
0
|
0
|
|
|
|
|
$tls->{ca_file} = $ca_file if $ca_file; |
113
|
0
|
0
|
|
|
|
|
$tls->{key_file} = $key_file if $key_file; |
114
|
0
|
0
|
|
|
|
|
$tls->{cert_file} = $cert_file if $cert_file; |
115
|
0
|
0
|
|
|
|
|
$tls->{cacert} = $cacert if $cacert; |
116
|
|
|
|
|
|
|
|
117
|
0
|
0
|
0
|
|
|
|
if ( $ca_file || $key_file || $cert_file ) { |
|
|
|
0
|
|
|
|
|
118
|
0
|
|
|
|
|
|
$tls->{verify} = 1; |
119
|
0
|
|
|
|
|
|
return $tls; |
120
|
|
|
|
|
|
|
} |
121
|
0
|
|
|
|
|
|
return 'low'; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 hold |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
When set will not fire request. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=cut |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
has hold => ( is => 'ro' ); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head2 response |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
has response => ( is => 'ro' ); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head2 retry_auth |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
When set will retry authentication request and update token |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
has retry_auth => ( |
145
|
|
|
|
|
|
|
is => 'ro', |
146
|
|
|
|
|
|
|
default => 0 |
147
|
|
|
|
|
|
|
); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head2 request |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=cut |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
has request => ( is => 'lazy', ); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub _build_request { |
156
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
157
|
0
|
0
|
|
|
|
|
if ( $self->{retry_auth} > 1 ) { |
158
|
0
|
|
|
|
|
|
confess |
159
|
|
|
|
|
|
|
"Error: Unable to authenticate, check your username and password"; |
160
|
0
|
|
|
|
|
|
$self->{retry_auth} = 0; |
161
|
0
|
|
|
|
|
|
return; |
162
|
|
|
|
|
|
|
} |
163
|
0
|
|
|
|
|
|
$self->init; |
164
|
0
|
|
|
|
|
|
my $cb = $self->cb; |
165
|
0
|
0
|
|
|
|
|
my $cv = $self->cv ? $self->cv : AE::cv; |
166
|
0
|
|
|
|
|
|
$cv->begin; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
http_request( |
169
|
|
|
|
|
|
|
'POST', |
170
|
|
|
|
|
|
|
$self->etcd->api_path . $self->{endpoint}, |
171
|
|
|
|
|
|
|
headers => $self->headers, |
172
|
|
|
|
|
|
|
body => $self->json_args, |
173
|
|
|
|
|
|
|
tls_ctx => $self->tls_ctx, |
174
|
|
|
|
|
|
|
on_header => sub { |
175
|
0
|
|
|
0
|
|
|
my ($headers) = @_; |
176
|
0
|
|
|
|
|
|
$self->{response}{headers} = $headers; |
177
|
|
|
|
|
|
|
}, |
178
|
|
|
|
|
|
|
want_body_handle => 1, |
179
|
|
|
|
|
|
|
sub { |
180
|
0
|
|
|
0
|
|
|
my ( $handle, $hdr ) = @_; |
181
|
|
|
|
|
|
|
my $json_reader = sub { |
182
|
0
|
|
|
|
|
|
my ( $handle, $json ) = @_; |
183
|
0
|
0
|
|
|
|
|
return unless $json; |
184
|
0
|
|
|
|
|
|
$self->{response}{content} = JSON::encode_json($json); |
185
|
0
|
0
|
|
|
|
|
$cb->( $json, $hdr ) if $cb; |
186
|
0
|
|
|
|
|
|
my $status = $hdr->{Status}; |
187
|
0
|
|
|
|
|
|
$self->check_hdr($status); |
188
|
0
|
|
|
|
|
|
$cv->send; |
189
|
0
|
|
|
|
|
|
}; |
190
|
|
|
|
|
|
|
my $chunk_reader = sub { |
191
|
0
|
|
|
|
|
|
my ( $handle, $line ) = @_; |
192
|
0
|
0
|
|
|
|
|
return unless $line; |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
#read chunk size |
195
|
0
|
0
|
|
|
|
|
$line =~ /^([0-9a-fA-F]+)/ |
196
|
|
|
|
|
|
|
or die 'bad chunk (incorrect length) -[' . $line . ']-'; |
197
|
0
|
|
|
|
|
|
my $len = hex $1; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
#read chunk |
200
|
|
|
|
|
|
|
$handle->push_read( |
201
|
|
|
|
|
|
|
chunk => $len, |
202
|
|
|
|
|
|
|
sub { |
203
|
0
|
|
|
|
|
|
my ( $handle, $chunk ) = @_; |
204
|
|
|
|
|
|
|
$handle->push_read( |
205
|
|
|
|
|
|
|
line => sub { |
206
|
0
|
0
|
|
|
|
|
length $_[1] |
207
|
|
|
|
|
|
|
and die 'bad chunk (missing last empty line)'; |
208
|
|
|
|
|
|
|
} |
209
|
0
|
|
|
|
|
|
); |
210
|
0
|
|
|
|
|
|
$self->{response}{content} = $chunk; |
211
|
0
|
0
|
|
|
|
|
$cb->( $chunk, $hdr ) if $cb; |
212
|
0
|
|
|
|
|
|
my $status = $hdr->{Status}; |
213
|
0
|
|
|
|
|
|
$self->check_hdr($status); |
214
|
0
|
|
|
|
|
|
$cv->send; |
215
|
|
|
|
|
|
|
} |
216
|
0
|
|
|
|
|
|
); |
217
|
0
|
|
|
|
|
|
}; |
218
|
|
|
|
|
|
|
|
219
|
0
|
0
|
0
|
|
|
|
if ( ( $hdr->{'transfer-encoding'} || '' ) =~ /\bchunked\b/i ) { |
220
|
|
|
|
|
|
|
$handle->on_read( |
221
|
0
|
|
|
|
|
|
sub { $handle->push_read( line => $chunk_reader ) } ); |
|
0
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
else { |
224
|
|
|
|
|
|
|
$handle->on_read( |
225
|
0
|
|
|
|
|
|
sub { $handle->push_read( json => $json_reader ) } ); |
|
0
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
0
|
|
|
|
|
|
$handle->on_eof( sub { $handle->destroy; $cv->end } ); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
229
|
0
|
|
|
|
|
|
$handle->on_error( sub { $handle->destroy; $cv->end } ); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
} |
231
|
0
|
|
|
|
|
|
); |
232
|
0
|
|
|
|
|
|
$cv->recv; |
233
|
0
|
|
|
|
|
|
$self->clear_headers; |
234
|
|
|
|
|
|
|
|
235
|
0
|
0
|
0
|
|
|
|
if ( defined $self->{retry_auth} && $self->{retry_auth} ) { |
236
|
0
|
|
|
|
|
|
my $auth = $self->etcd->auth()->authenticate; |
237
|
0
|
0
|
|
|
|
|
if ( $auth->{response}{success} ) { |
238
|
0
|
|
|
|
|
|
$self->{retry_auth} = 0; |
239
|
0
|
|
|
|
|
|
$self->request; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
} |
242
|
0
|
|
|
|
|
|
return $self; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head2 get_value |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
returns single decoded value or the first. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=cut |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub get_value { |
252
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
253
|
0
|
|
|
|
|
|
local $@; |
254
|
0
|
|
|
|
|
|
my $response = $self->response; |
255
|
0
|
|
|
|
|
|
my $content; |
256
|
0
|
|
|
|
|
|
eval { $content = from_json( $response->{content} ) }; |
|
0
|
|
|
|
|
|
|
257
|
0
|
0
|
|
|
|
|
return if $@; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
#print STDERR Dumper($content); |
260
|
0
|
|
|
|
|
|
my $value = $content->{kvs}->[0]->{value}; |
261
|
0
|
0
|
|
|
|
|
$value or return; |
262
|
0
|
|
|
|
|
|
return decode_base64($value); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head2 all |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
returns list containing for example: |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
{ |
270
|
|
|
|
|
|
|
'mod_revision' => '3', |
271
|
|
|
|
|
|
|
'version' => '1', |
272
|
|
|
|
|
|
|
'value' => 'bar', |
273
|
|
|
|
|
|
|
'create_revision' => '3', |
274
|
|
|
|
|
|
|
'key' => 'foo0' |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
where key and value have been decoded for your pleasure. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=cut |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub all { |
282
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
283
|
0
|
|
|
|
|
|
local $@; |
284
|
0
|
|
|
|
|
|
my $response = $self->response; |
285
|
0
|
|
|
|
|
|
my $content; |
286
|
0
|
|
|
|
|
|
eval { $content = from_json( $response->{content} ) }; |
|
0
|
|
|
|
|
|
|
287
|
0
|
0
|
|
|
|
|
return if $@; |
288
|
0
|
|
|
|
|
|
my $kvs = $content->{kvs}; |
289
|
0
|
|
|
|
|
|
for my $row (@$kvs) { |
290
|
0
|
|
|
|
|
|
$row->{value} = decode_base64( $row->{value} ); |
291
|
0
|
|
|
|
|
|
$row->{key} = decode_base64( $row->{key} ); |
292
|
|
|
|
|
|
|
} |
293
|
0
|
|
|
|
|
|
return $kvs; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=head2 is_success |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
Success is returned if the response is a 200 |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=cut |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub is_success { |
303
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
304
|
0
|
|
|
|
|
|
my $response = $self->response; |
305
|
0
|
0
|
|
|
|
|
if ( defined $response->{success} ) { |
306
|
0
|
|
|
|
|
|
return $response->{success}; |
307
|
|
|
|
|
|
|
} |
308
|
0
|
|
|
|
|
|
return; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=head2 content |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
returns JSON decoded content hash |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=cut |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub content { |
318
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
319
|
0
|
|
|
|
|
|
local $@; |
320
|
0
|
|
|
|
|
|
my $response = $self->response; |
321
|
0
|
|
|
|
|
|
my $content; |
322
|
0
|
|
|
|
|
|
eval { $content = from_json( $response->{content} ) }; |
|
0
|
|
|
|
|
|
|
323
|
0
|
0
|
|
|
|
|
return if $@; |
324
|
0
|
0
|
|
|
|
|
return $content if $content; |
325
|
0
|
|
|
|
|
|
return; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=head2 check_hdr |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
check response header then define success and retry_auth. |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=cut |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub check_hdr { |
335
|
0
|
|
|
0
|
1
|
|
my ( $self, $status ) = @_; |
336
|
0
|
0
|
|
|
|
|
my $success = $status == 200 ? 1 : 0; |
337
|
0
|
|
|
|
|
|
$self->{response}{success} = $success; |
338
|
0
|
0
|
|
|
|
|
$self->{retry_auth}++ if $status == 401; |
339
|
0
|
|
|
|
|
|
return; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
1; |