File Coverage

blib/lib/cPanel/APIClient/Transport/HTTPSync.pm
Criterion Covered Total %
statement 42 57 73.6
branch 6 12 50.0
condition 0 3 0.0
subroutine 10 12 83.3
pod 0 2 0.0
total 58 86 67.4


line stmt bran cond sub pod time code
1             package cPanel::APIClient::Transport::HTTPSync;
2              
3 2     2   14 use strict;
  2         4  
  2         58  
4 2     2   10 use warnings;
  2         4  
  2         71  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             cPanel::APIClient::Transport::HTTPSync - Synchronous HTTP transport
11              
12             =head1 SYNOPSIS
13              
14             my $remote_cp = cPanel::APIClient->create(
15             service => 'cpanel',
16              
17             transport => [
18             'HTTPSync',
19             hostname => 'somewhere.out.there',
20              
21             # Not for production:
22             # tls_verification => 'off',
23             ],
24              
25             credentials => {
26             username => 'johnny',
27             password => '$3kr1t',
28             },
29             );
30              
31             my $resp = $remote_cp->call_uapi( 'Email', 'list_forwarders' );
32              
33             =head1 DESCRIPTION
34              
35             This transport mechanism implements access to cPanel & WHM’s APIs
36             via synchronous (i.e., blocking) HTTP.
37              
38             =head1 SEE ALSO
39              
40             L and
41             L facilitate sending
42             multiple concurrent API requests.
43              
44             =cut
45              
46             #----------------------------------------------------------------------
47              
48 2         17 use parent qw(
49             cPanel::APIClient::TransportBase::HTTPBase
50             cPanel::APIClient::TransportBase::TLSVerificationBase
51 2     2   23 );
  2         4  
52              
53 2     2   91 use HTTP::Tiny ();
  2         17  
  2         54  
54              
55 2     2   835 use cPanel::APIClient::Utils::HTTPResponse ();
  2         5  
  2         1443  
56              
57             #----------------------------------------------------------------------
58              
59             sub new {
60 7     7 0 47 my ( $class, $authn, %opts ) = @_;
61              
62 7         52 my $self = $class->SUPER::new( $authn, %opts );
63              
64 7         17 my @ht_args;
65              
66 7         49 my $verify_SSL = ('off' ne $self->_parse_tls_verification( \%opts ) );
67              
68 7         25 push @ht_args, ( verify_SSL => $verify_SSL );
69              
70 7 50       38 if ( $self->_needs_session() ) {
71 0         0 require HTTP::CookieJar;
72 0         0 push @ht_args, ( cookie_jar => HTTP::CookieJar->new() );
73             }
74              
75 7         99 $self->{'ua'} = HTTP::Tiny->new(@ht_args);
76              
77 7         983 return $self;
78             }
79              
80             sub _get_session {
81 0     0   0 my ( $self, $service_obj ) = @_;
82              
83 0         0 my ( $method, $url, $payload ) = $self->{'authn'}->get_login_request_pieces();
84 0         0 substr( $url, 0, 0, $self->_get_url_base($service_obj) );
85              
86 0 0       0 die "Bad method: $method" if 'POST' ne $method;
87              
88 0         0 my $resp = $self->{'ua'}->post(
89             $url,
90             { content => $payload },
91             );
92              
93 0         0 my $resp_obj = cPanel::APIClient::Transport::HTTPSync::Response->new($resp);
94              
95 0         0 $self->{'authn'}->consume_session_response($resp_obj);
96              
97 0         0 return;
98             }
99              
100             sub request {
101 7     7 0 22 my ( $self, $service_obj, $request_obj ) = @_;
102              
103 7 50       23 if ( $self->_needs_session() ) {
104 0   0     0 $self->{'_got_session'} ||= do {
105 0         0 $self->_get_session($service_obj);
106 0         0 1;
107             };
108             }
109              
110 7         36 my ( $method, $url, $headers_ar, $payload ) = $self->_assemble_request_pieces( $service_obj, $request_obj );
111              
112 7 50       28 die "Bad method: $method" if 'POST' ne $method;
113              
114             my $resp = $self->{'ua'}->post(
115             $url,
116             {
117 7         22 headers => { map { @$_ } @$headers_ar },
  14         231  
118             content => $payload,
119             },
120             );
121              
122 7 100       184242 if ( $resp->{'status'} == 599 ) {
123 2         35 die $request_obj->create_transport_error( $resp->{'content'} );
124             }
125              
126 5         65 my $resp_obj = cPanel::APIClient::Transport::HTTPSync::Response->new($resp);
127              
128 5         78 return $request_obj->parse_http_response( $resp_obj, $resp->{'content'} );
129             }
130              
131             #----------------------------------------------------------------------
132              
133             package cPanel::APIClient::Transport::HTTPSync::Response;
134              
135             sub new {
136 5     5   19 my ( $class, $struct ) = @_;
137              
138 5         19 return bless $struct, $class;
139             }
140              
141             sub code {
142 5     5   50 return $_[0]{'status'};
143             }
144              
145             sub header {
146 0     0   0 my ( $self, $name ) = @_;
147              
148 0         0 return $self->{'headers'}{$name};
149             }
150              
151             sub as_string {
152 1     1   4 my ($self) = @_;
153              
154 1         2 my $hdrs = $self->{'headers'};
155              
156             return join(
157             "\x0d\x0a",
158 3         11 join( q< >, grep { defined } @{$self}{ 'protocol', 'status', 'reason' } ),
  1         3  
159 1 50       4 ( map { "$_: " . ( defined $hdrs->{$_} ? $hdrs->{$_} : q<> ) } keys %$hdrs ),
  2         28  
160             );
161             }
162              
163             =head1 LICENSE
164              
165             Copyright 2020 cPanel, L. L. C. All rights reserved. L
166              
167             This is free software; you can redistribute it and/or modify it under the
168             same terms as Perl itself. See L.
169              
170             =cut
171              
172             1;