]>
Commit | Line | Data |
---|---|---|
aff192e6 DM |
1 | package PVE::API2Client; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | use URI; | |
6 | use HTTP::Cookies; | |
7 | use LWP::UserAgent; | |
8 | use JSON; | |
9 | use PVE::API2; | |
10 | use Data::Dumper; # fixme: remove | |
11 | use HTTP::Request::Common; | |
12 | ||
13 | sub get { | |
14 | my ($self, $path, $param) = @_; | |
15 | ||
16 | return $self->call('GET', $path, $param); | |
17 | } | |
18 | ||
19 | sub post { | |
20 | my ($self, $path, $param) = @_; | |
21 | ||
22 | return $self->call('POST', $path, $param); | |
23 | } | |
24 | ||
25 | sub put { | |
26 | my ($self, $path, $param) = @_; | |
27 | ||
28 | return $self->call('PUT', $path, $param); | |
29 | } | |
30 | ||
31 | sub delete { | |
32 | my ($self, $path, $param) = @_; | |
33 | ||
34 | return $self->call('DELETE', $path, $param); | |
35 | } | |
36 | ||
37 | sub call { | |
38 | my ($self, $method, $path, $param) = @_; | |
39 | ||
40 | #print "wrapper called\n"; | |
41 | ||
42 | my $ticket; | |
43 | ||
44 | my $ua = $self->{useragent}; | |
45 | my $cj = $self->{cookie_jar}; | |
46 | ||
47 | $cj->scan(sub { | |
48 | my ($version, $key, $val) = @_; | |
49 | $ticket = $val if $key eq 'PVEAuthCookie'; | |
50 | }); | |
51 | ||
52 | if (!$ticket && $self->{username} && $self->{password}) { | |
53 | my $uri = URI->new(); | |
54 | $uri->scheme($self->{protocol}); | |
55 | $uri->host($self->{host}); | |
56 | $uri->port($self->{port}); | |
57 | $uri->path('/api2/json/ticket'); | |
58 | ||
59 | my $response = $ua->post($uri, { | |
60 | username => $self->{username}, | |
61 | password => $self->{password}}); | |
62 | ||
63 | if (!$response->is_success) { | |
64 | die $response->status_line . "\n"; | |
65 | } | |
66 | # the auth cookie should be set now | |
67 | } | |
68 | ||
69 | my $uri = URI->new(); | |
70 | $uri->scheme($self->{protocol}); | |
71 | $uri->host($self->{host}); | |
72 | $uri->port($self->{port}); | |
73 | $uri->path($path); | |
74 | ||
75 | # print $ua->{cookie_jar}->as_string; | |
76 | ||
77 | #print "CALL $method : " . $uri->as_string() . "\n"; | |
78 | ||
79 | my $response; | |
80 | if ($method eq 'GET') { | |
81 | $uri->query_form($param); | |
82 | $response = $ua->request(HTTP::Request::Common::GET($uri)); | |
83 | } elsif ($method eq 'POST') { | |
84 | $response = $ua->request(HTTP::Request::Common::POST($uri, Content => $param)); | |
85 | } elsif ($method eq 'PUT') { | |
86 | $response = $ua->request(HTTP::Request::Common::PUT($uri, Content => $param)); | |
87 | } elsif ($method eq 'DELETE') { | |
88 | $response = $ua->request(HTTP::Request::Common::DELETE($uri)); | |
89 | } else { | |
90 | die "method $method not implemented\n"; | |
91 | } | |
92 | ||
93 | #print "RESP: " . Dumper($response) . "\n"; | |
94 | ||
95 | if ($response->is_success) { | |
96 | my $ct = $response->header('Content-Type'); | |
97 | ||
98 | die "got unexpected content type" if $ct ne 'application/json'; | |
99 | ||
100 | return from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1}); | |
101 | ||
102 | } else { | |
103 | ||
104 | die $response->status_line . "\n"; | |
105 | ||
106 | } | |
107 | } | |
108 | ||
109 | sub new { | |
110 | my ($class, %param) = @_; | |
111 | ||
112 | my $self = { | |
113 | ticket => $param{ticket}, | |
114 | username => $param{username}, | |
115 | password => $param{password}, | |
116 | host => $param{host} || 'localhost', | |
117 | port => $param{port}, | |
118 | timeout => $param{timeout} || 60, | |
119 | }; | |
120 | bless $self; | |
121 | ||
122 | if (!$self->{port}) { | |
123 | $self->{port} = $self->{host} eq 'localhost' ? 85 : 8006; | |
124 | } | |
125 | if (!$self->{protocol}) { | |
126 | $self->{protocol} = $self->{host} eq 'localhost' ? 'http' : 'https'; | |
127 | } | |
128 | ||
129 | $self->{cookie_jar} = HTTP::Cookies->new (ignore_discard => 1); | |
130 | ||
131 | if ($self->{ticket}) { | |
132 | my $domain = "$self->{host}.local" unless $self->{host} =~ /\./; | |
133 | $self->{cookie_jar}->set_cookie(0, 'PVEAuthCookie', $self->{ticket}, | |
134 | '/', $domain); | |
135 | } | |
136 | ||
137 | $self->{useragent} = LWP::UserAgent->new( | |
138 | cookie_jar => $self->{cookie_jar}, | |
139 | protocols_allowed => [ 'http', 'https'], | |
140 | timeout => $self->{timeout}, | |
141 | ); | |
142 | ||
143 | $self->{useragent}->default_header('Accept-Encoding' => 'gzip'); # allow gzip | |
144 | ||
145 | return $self; | |
146 | } | |
147 | ||
148 | 1; |