1package FusionInventory::Agent::HTTP::Client::Fusion;
2
3use strict;
4use warnings;
5use parent 'FusionInventory::Agent::HTTP::Client';
6
7use English qw(-no_match_vars);
8
9use JSON::PP;
10use HTTP::Request;
11use HTTP::Headers;
12use HTTP::Cookies;
13use URI::Escape;
14
15my $log_prefix = "[http client] ";
16
17sub new {
18    my ($class, %params) = @_;
19
20    my $self = $class->SUPER::new(%params);
21
22# Stack the messages sent in order to be able to check the
23# correctness of the behavior with the test-suite
24    if ($params{debug}) {
25        $self->{debug} = 1;
26        $self->{msgStack} = []
27    }
28
29    $self->{_cookies} = HTTP::Cookies->new ;
30
31    return $self;
32}
33
34sub _prepareVal {
35    my ($self, $val) = @_;
36
37    return '' unless length($val);
38
39# forbid to long argument.
40    while (length(URI::Escape::uri_escape_utf8($val)) > 1500) {
41        $val =~ s/^.{5}/…/;
42    }
43
44    return URI::Escape::uri_escape_utf8($val);
45}
46
47sub send { ## no critic (ProhibitBuiltinHomonyms)
48    my ($self, %params) = @_;
49
50    push @{$self->{msgStack}}, $params{args} if $self->{debug};
51
52    my $url = ref $params{url} eq 'URI' ?
53        $params{url} : URI->new($params{url});
54
55    my $method = (exists($params{method}) && $params{method} =~ /^GET|POST$/) ?
56        $params{method} : 'GET' ;
57
58    my $urlparams = 'action='.uri_escape($params{args}->{action});
59    my $referer = '';
60    if ($method eq 'POST') {
61        $referer = $url;
62        $url .= '?'.$urlparams ;
63        $url .= '&uuid='.uri_escape($params{args}->{uuid}) if (exists($params{args}->{uuid}));
64        $url .= '&method=POST' ;
65    }
66
67    foreach my $k (keys %{$params{args}}) {
68        if (ref($params{args}->{$k}) eq 'ARRAY') {
69            foreach (@{$params{args}->{$k}}) {
70                $urlparams .= '&'.$k.'[]='.$self->_prepareVal($_ || '');
71            }
72        } elsif (ref($params{args}->{$k}) eq 'HASH') {
73            foreach (keys %{$params{args}->{$k}}) {
74                $urlparams .= '&'.$k.'['.$_.']='.$self->_prepareVal($params{args}->{$k}{$_});
75            }
76        } elsif ($k ne 'action' && length($params{args}->{$k})) {
77            $urlparams .= '&'.$k.'='.$self->_prepareVal($params{args}->{$k});
78        }
79    }
80
81    $url .= '?'.$urlparams if ($method eq 'GET');
82
83    $self->{logger}->debug2($url) if $self->{logger};
84
85    my $request ;
86    if ($method eq 'GET') {
87        $request = HTTP::Request->new($method => $url);
88    } else {
89        $self->{logger}->debug2($log_prefix."POST: ".$urlparams) if $self->{logger};
90        my $headers = HTTP::Headers->new(
91            'Content-Type' => 'application/x-www-form-urlencoded',
92            'Referer'      => $referer
93        );
94        $request = HTTP::Request->new(
95            $method => $url,
96            $headers,
97            $urlparams
98        );
99        $self->{_cookies}->add_cookie_header( $request );
100    }
101
102    my $response = $self->request($request);
103
104    return unless $response->is_success();
105
106    $self->{_cookies}->extract_cookies($response);
107
108    my $content = $response->content();
109    unless ($content) {
110        $self->{logger}->error( $log_prefix . "Got empty response" )
111            if $self->{logger};
112        return;
113    }
114
115    my $answer;
116    eval {
117        my $decoder = JSON::PP->new
118            or die "Can't use JSON::PP decoder: $!";
119
120        $answer = $decoder->decode($content);
121    };
122
123    if ($EVAL_ERROR) {
124        my @lines = split(/\n/, $content);
125        $self->{logger}->error(
126            $log_prefix . "Can't decode JSON content, starting with $lines[0]"
127        ) if $self->{logger};
128        return;
129    }
130
131    return $answer;
132}
133
1341;
135__END__
136
137=head1 NAME
138
139FusionInventory::Agent::HTTP::Client::Fusion - An HTTP client using Fusion protocol
140
141=head1 DESCRIPTION
142
143This is the object used by the agent to send messages to GLPI servers,
144using new Fusion protocol (JSON messages sent through GET requests).
145
146=head1 METHODS
147
148=head2 send(%params)
149
150The following parameters are allowed, as keys of the %params
151hash:
152
153=over
154
155=item I<url>
156
157the url to send the message to (mandatory)
158
159=item I<args>
160
161A list of parameters to pass to the server. The action key is mandatory.
162Parameters can be hashref or arrayref.
163
164=back
165
166This method returns a perl data structure.
167