File Coverage

lib/Rex/Interface/Connection/HTTP.pm
Criterion Covered Total %
statement 16 80 20.0
branch 0 16 0.0
condition 0 12 0.0
subroutine 6 22 27.2
pod 0 14 0.0
total 22 144 15.2


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             package Rex::Interface::Connection::HTTP;
6              
7 1     1   15 use v5.12.5;
  1         3  
8 1     1   6 use warnings;
  1         3  
  1         40  
9              
10             our $VERSION = '1.14.2.2'; # TRIAL VERSION
11              
12 1     1   5 use Rex::Interface::Connection::Base;
  1         2  
  1         10  
13              
14             BEGIN {
15 1     1   56 LWP::UserAgent->use;
16 1         8 JSON::MaybeXS->use;
17             }
18              
19 1     1   6 use Data::Dumper;
  1         2  
  1         41  
20              
21 1     1   6 use base qw(Rex::Interface::Connection::Base);
  1         2  
  1         1093  
22              
23             sub new {
24 0     0 0   my $that = shift;
25 0   0       my $proto = ref($that) || $that;
26 0           my $self = $that->SUPER::new(@_);
27              
28 0           bless( $self, $proto );
29              
30             # activate caching
31 0           Rex::Config->set_use_cache(1);
32              
33 0           return $self;
34             }
35              
36       0 0   sub error { }
37              
38             sub connect {
39 0     0 0   my ( $self, %option ) = @_;
40 0           my ( $user, $pass, $server, $port, $timeout );
41              
42 0           $user = $option{user};
43 0           $pass = $option{password};
44 0           $server = $option{server};
45 0           $port = $self->_get_port( $option{port} );
46 0           $timeout = $option{timeout};
47              
48 0           $self->{server} = $server;
49 0           $self->{port} = $port;
50              
51 0 0         if ( $server =~ m/([^:]+):(\d+)/ ) {
52 0           $server = $self->{server} = $1;
53 0           $port = $self->{port} = $2;
54             }
55              
56 0           $self->{__user} = $user;
57 0           $self->{__pass} = $pass;
58              
59 0 0 0       if (!Rex::Config->has_user
60             && Rex::Config->get_ssh_config_username( server => $server ) )
61             {
62 0           $user = Rex::Config->get_ssh_config_username( server => $server );
63             }
64              
65 0           $self->ua->credentials( "$server:$port", "Rex::Endpoint::HTTP",
66             $user => $pass, );
67              
68 0           my $resp = $self->post("/login");
69 0 0         if ( $resp->{ok} ) {
70 0           Rex::Logger::info("Connected to $server, trying to authenticate.");
71             }
72             else {
73 0           Rex::Logger::info( "Can't connect to $server", "warn" );
74 0           $self->{connected} = 0;
75 0           return;
76             }
77              
78 0           Rex::Logger::info( "Connecting to $server:$port (" . $user . ")" );
79              
80             }
81              
82       0 0   sub disconnect { }
83 0     0 0   sub get_connection_object { my ($self) = @_; return $self; }
  0            
84 0     0 0   sub get_fs_connection_object { my ($self) = @_; return $self; }
  0            
85 0     0 0   sub is_connected { return 1; }
86 0     0 0   sub is_authenticated { return 1; }
87              
88             sub exec {
89 0     0 0   my ( $self, $cmd ) = @_;
90             }
91              
92             sub ua {
93 0     0 0   my ($self) = @_;
94 0 0         return $self->{ua} if $self->{ua};
95              
96 0           $self->{ua} = LWP::UserAgent->new;
97             }
98              
99             sub upload {
100 0     0 0   my ( $self, $data ) = @_;
101              
102             my $res = $self->ua->post(
103             $self->_get_proto . "://"
104             . $self->{server} . ":"
105             . $self->{port}
106 0           . "/fs/upload",
107             Content_Type => "multipart/form-data",
108             Content => $data
109             );
110              
111 0 0         if ( $res->is_success ) {
112 0           return decode_json( $res->decoded_content );
113             }
114             else {
115 0           die("Error requesting /fs/upload.");
116             }
117             }
118              
119             sub post {
120 0     0 0   my ( $self, $service, $data, $header ) = @_;
121              
122 0   0       $header ||= {};
123 0   0       $data ||= {};
124              
125 0 0         if ( !ref($data) ) {
126 0           die(
127             "Invalid 2nd argument. must be arrayRef or hashRef!\npost(\$service, \$ref)"
128             );
129             }
130              
131             my $res = $self->ua->post(
132             $self->_get_proto . "://"
133             . $self->{server} . ":"
134             . $self->{port}
135             . "$service",
136 0           %{$header},
  0            
137             Content => encode_json($data)
138             );
139              
140 0 0         if ( $res->is_success ) {
141 0           return decode_json( $res->decoded_content );
142             }
143             else {
144 0           die( "Error requesting $service.\n\nError: " . $res->{_content} );
145             }
146              
147             }
148              
149             sub get {
150 0     0 0   my ( $self, $service ) = @_;
151              
152             my $res =
153             $self->ua->get( $self->_get_proto . "://"
154             . $self->{server} . ":"
155             . $self->{port}
156 0           . "$service" );
157              
158 0 0         if ( $res->is_success ) {
159 0           return decode_json( $res->decoded_content );
160             }
161             else {
162 0           die("Error requesting $service.");
163             }
164              
165             }
166              
167 0     0 0   sub get_connection_type { return "HTTP"; }
168              
169             sub _get_proto {
170 0     0     return "http";
171             }
172              
173             sub _get_port {
174 0     0     my ( $self, $port ) = @_;
175 0   0       return $port || 8080;
176             }
177              
178             1;