| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# |
|
2
|
|
|
|
|
|
|
# (c) Jan Gehring |
|
3
|
|
|
|
|
|
|
# |
|
4
|
|
|
|
|
|
|
# vim: set ts=3 sw=3 tw=0: |
|
5
|
|
|
|
|
|
|
# vim: set expandtab: |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Rex::IO::Client::Protocol::V1; |
|
8
|
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
5
|
use strict; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
31
|
|
|
10
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
42
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.6'; # VERSION |
|
13
|
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
993
|
use attributes; |
|
|
1
|
|
|
|
|
1265
|
|
|
|
1
|
|
|
|
|
6
|
|
|
15
|
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
1315
|
use JSON::XS; |
|
|
1
|
|
|
|
|
3768
|
|
|
|
1
|
|
|
|
|
59
|
|
|
17
|
1
|
|
|
1
|
|
902
|
use Mojo::UserAgent; |
|
|
1
|
|
|
|
|
539484
|
|
|
|
1
|
|
|
|
|
19
|
|
|
18
|
1
|
|
|
1
|
|
99
|
use Data::Dumper; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
98
|
|
|
19
|
1
|
|
|
1
|
|
10
|
use Mojo::JSON; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
2055
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
|
22
|
1
|
|
|
1
|
0
|
4
|
my $that = shift; |
|
23
|
1
|
|
33
|
|
|
17
|
my $proto = ref($that) || $that; |
|
24
|
1
|
|
|
|
|
5
|
my $self = {@_}; |
|
25
|
|
|
|
|
|
|
|
|
26
|
1
|
|
|
|
|
3
|
bless( $self, $proto ); |
|
27
|
|
|
|
|
|
|
|
|
28
|
1
|
|
50
|
|
|
16
|
$self->{endpoint} ||= "http://127.0.0.1:3000"; |
|
29
|
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
9
|
return $self; |
|
31
|
|
|
|
|
|
|
} |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub endpoint : lvalue { |
|
34
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
|
35
|
0
|
|
|
|
|
|
$self->{endpoint}; |
|
36
|
|
|
|
|
|
|
} |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub get_plugins { |
|
39
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
|
40
|
0
|
|
|
|
|
|
$self->_get("/plugins")->res->json; |
|
41
|
|
|
|
|
|
|
} |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub auth { |
|
44
|
0
|
|
|
0
|
0
|
|
my ( $self, $user, $pass ) = @_; |
|
45
|
|
|
|
|
|
|
my ( $proto, $endpoint ) = |
|
46
|
0
|
|
|
|
|
|
( $self->{endpoint} =~ m/^(https?:\/\/).*\@(.*)$/ ); |
|
47
|
|
|
|
|
|
|
|
|
48
|
0
|
|
|
|
|
|
my $ref = $self->_ua->post( "$proto$user:$pass\@$endpoint/1.0/user/login", |
|
49
|
|
|
|
|
|
|
json => {} )->res->json; |
|
50
|
|
|
|
|
|
|
|
|
51
|
0
|
0
|
|
|
|
|
if ( $ref->{ok} == Mojo::JSON->true ) { |
|
52
|
0
|
|
|
|
|
|
return $ref->{data}; |
|
53
|
|
|
|
|
|
|
} |
|
54
|
|
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
|
return 0; |
|
56
|
|
|
|
|
|
|
} |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub _ua { |
|
59
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
|
60
|
0
|
0
|
|
|
|
|
if ( $self->{ua} ) { |
|
61
|
0
|
|
|
|
|
|
return $self->{ua}; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
my $ua = Mojo::UserAgent->new; |
|
65
|
|
|
|
|
|
|
|
|
66
|
0
|
0
|
|
|
|
|
if ( $self->{ssl} ) { |
|
67
|
0
|
|
|
|
|
|
$ua->ca( $self->{ssl}->{ca} ); |
|
68
|
0
|
|
|
|
|
|
$ua->cert( $self->{ssl}->{cert} ); |
|
69
|
0
|
|
|
|
|
|
$ua->key( $self->{ssl}->{key} ); |
|
70
|
|
|
|
|
|
|
} |
|
71
|
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
$self->{ua} = $ua; |
|
73
|
0
|
|
|
|
|
|
return $self->{ua}; |
|
74
|
|
|
|
|
|
|
} |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub _get { |
|
77
|
0
|
|
|
0
|
|
|
my ( $self, $url, $qry_string_ref ) = @_; |
|
78
|
|
|
|
|
|
|
|
|
79
|
0
|
0
|
|
|
|
|
if ( ref $qry_string_ref ) { |
|
|
|
0
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
$url .= "?"; |
|
81
|
0
|
|
|
|
|
|
for my $key ( keys %{$qry_string_ref} ) { |
|
|
0
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
$url .= "\&$key=$qry_string_ref->{$key}"; |
|
83
|
|
|
|
|
|
|
} |
|
84
|
|
|
|
|
|
|
} |
|
85
|
|
|
|
|
|
|
elsif ($qry_string_ref) { |
|
86
|
0
|
|
|
|
|
|
$url .= "?$qry_string_ref"; |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
$self->_ua->get( $self->endpoint . $url ); |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub _post { |
|
93
|
0
|
|
|
0
|
|
|
my ( $self, $url, $post ) = @_; |
|
94
|
0
|
|
|
|
|
|
$self->_ua->post( $self->endpoint . $url, json => $post ); |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub _put { |
|
98
|
0
|
|
|
0
|
|
|
my ( $self, $url, $put ) = @_; |
|
99
|
0
|
|
|
|
|
|
$self->_ua->put( $self->endpoint . $url, $self->_json->encode($put) ); |
|
100
|
|
|
|
|
|
|
} |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub _list { |
|
103
|
0
|
|
|
0
|
|
|
my ( $self, $url ) = @_; |
|
104
|
0
|
|
|
|
|
|
my $tx = $self->_ua->build_tx( LIST => $self->endpoint . $url ); |
|
105
|
0
|
|
|
|
|
|
$self->_ua->start($tx); |
|
106
|
|
|
|
|
|
|
} |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub _info { |
|
109
|
0
|
|
|
0
|
|
|
my ( $self, $url ) = @_; |
|
110
|
0
|
|
|
|
|
|
my $tx = $self->_ua->build_tx( INFO => $self->endpoint . $url ); |
|
111
|
0
|
|
|
|
|
|
$self->_ua->start($tx); |
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub _run { |
|
115
|
0
|
|
|
0
|
|
|
my ( $self, $url, $obj ) = @_; |
|
116
|
0
|
|
0
|
|
|
|
$obj ||= {}; |
|
117
|
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
my $tx = |
|
119
|
|
|
|
|
|
|
$self->_ua->build_tx( RUN => $self->endpoint . $url, json => $obj ); |
|
120
|
0
|
|
|
|
|
|
$self->_ua->start($tx); |
|
121
|
|
|
|
|
|
|
} |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub _delete { |
|
124
|
0
|
|
|
0
|
|
|
my ( $self, $url ) = @_; |
|
125
|
0
|
|
|
|
|
|
my $tx = $self->_ua->build_tx( DELETE => $self->endpoint . $url ); |
|
126
|
0
|
|
|
|
|
|
$self->_ua->start($tx); |
|
127
|
|
|
|
|
|
|
} |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub _count { |
|
130
|
0
|
|
|
0
|
|
|
my ( $self, $url ) = @_; |
|
131
|
0
|
|
|
|
|
|
my $tx = $self->_ua->build_tx( COUNT => $self->endpoint . $url ); |
|
132
|
0
|
|
|
|
|
|
$self->_ua->start($tx); |
|
133
|
|
|
|
|
|
|
} |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub _json { |
|
136
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
|
137
|
0
|
|
|
|
|
|
return Mojo::JSON->new; |
|
138
|
|
|
|
|
|
|
} |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
## new urls |
|
141
|
|
|
|
|
|
|
# $VERB /1.0/plugin/resource/subres/id |
|
142
|
|
|
|
|
|
|
# GET /1.0/hardware/server/5 -> get hardware id 5 |
|
143
|
|
|
|
|
|
|
# GET /1.0/hardware/server -> get hardware list |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub call { |
|
146
|
0
|
|
|
0
|
0
|
|
my ( $self, $verb, $version, $plugin, @param ) = @_; |
|
147
|
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
|
my $url = "/$version/$plugin"; |
|
149
|
0
|
|
|
|
|
|
my $ref; |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
#for my $key (@param) { |
|
152
|
0
|
|
|
|
|
|
while ( my $key = shift @param ) { |
|
153
|
0
|
|
|
|
|
|
my $value = shift @param; |
|
154
|
0
|
0
|
|
|
|
|
if ( $key eq "ref" ) { |
|
155
|
0
|
|
|
|
|
|
$ref = $value; |
|
156
|
0
|
|
|
|
|
|
next; |
|
157
|
|
|
|
|
|
|
} |
|
158
|
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
$url .= "/$key"; |
|
160
|
|
|
|
|
|
|
|
|
161
|
0
|
0
|
|
|
|
|
if ( defined $value ) { |
|
162
|
0
|
|
|
|
|
|
$url .= "/$value"; |
|
163
|
|
|
|
|
|
|
} |
|
164
|
|
|
|
|
|
|
} |
|
165
|
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
my $meth = "_\L$verb"; |
|
167
|
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
|
my $ret; |
|
169
|
|
|
|
|
|
|
|
|
170
|
0
|
0
|
|
|
|
|
if ( ref $ref ) { |
|
|
|
0
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
|
$ret = $self->$meth( $url, $ref ); |
|
172
|
|
|
|
|
|
|
} |
|
173
|
|
|
|
|
|
|
elsif ($ref) { |
|
174
|
0
|
|
|
|
|
|
$ret = $self->$meth( $url, $ref ); |
|
175
|
|
|
|
|
|
|
} |
|
176
|
|
|
|
|
|
|
else { |
|
177
|
0
|
|
|
|
|
|
$ret = $self->$meth($url); |
|
178
|
|
|
|
|
|
|
} |
|
179
|
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
|
return decode_json( $ret->res->body ); |
|
181
|
|
|
|
|
|
|
} |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
1; |