1 package PVE
::APIClient
::LWP
;
6 use IO
::Socket
::SSL
; # important for SSL_verify_callback
11 use Data
::Dumper
; # fixme: remove
12 use HTTP
::Request
::Common
;
15 my $extract_data = sub {
18 croak
"undefined result" if !defined($res);
19 croak
"undefined result data" if !exists($res->{data
});
25 my ($self, $path, $param) = @_;
27 return $self->call('GET', $path, $param);
31 my ($self, $path, $param) = @_;
33 return $extract_data->($self->call('GET', $path, $param));
37 my ($self, $path, $param) = @_;
39 return $self->call('POST', $path, $param);
43 my ($self, $path, $param) = @_;
45 return $extract_data->($self->call('POST', $path, $param));
49 my ($self, $path, $param) = @_;
51 return $self->call('PUT', $path, $param);
55 my ($self, $path, $param) = @_;
57 return $extract_data->($self->call('PUT', $path, $param));
61 my ($self, $path, $param) = @_;
63 return $self->call('DELETE', $path, $param);
67 my ($self, $path, $param) = @_;
69 return $extract_data->($self->call('DELETE', $path, $param));
72 sub update_csrftoken
{
73 my ($self, $csrftoken) = @_;
75 $self->{csrftoken
} = $csrftoken;
77 my $agent = $self->{useragent
};
79 $agent->default_header('CSRFPreventionToken', $self->{csrftoken
});
83 my ($self, $ticket) = @_;
85 my $agent = $self->{useragent
};
87 $self->{ticket
} = $ticket;
89 my $encticket = uri_escape
($ticket);
90 my $cookie = "$self->{cookie_name}=$encticket; path=/; secure;";
91 $agent->default_header('Cookie', $cookie);
98 $uri->scheme($self->{protocol
});
99 $uri->host($self->{host
});
100 $uri->port($self->{port
});
101 $uri->path('/api2/json/access/ticket');
103 my $ua = $self->{useragent
};
105 delete $self->{last_unknown_fingerprint
};
107 my $exec_login = sub {
108 return $ua->post($uri, {
109 username
=> $self->{username
} || 'unknown',
110 password
=> $self->{password
} || ''});
113 my $response = $exec_login->();
115 if (!$response->is_success) {
116 if (my $fp = delete($self->{last_unknown_fingerprint
})) {
117 if ($self->manual_verify_fingerprint($fp)) {
118 $response = $exec_login->(); # try again
123 if (!$response->is_success) {
124 die $response->status_line . "\n";
127 my $res = from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
129 my $data = $extract_data->($res);
131 $self->update_ticket($data->{ticket
});
132 $self->update_csrftoken($data->{CSRFPreventionToken
});
137 sub manual_verify_fingerprint
{
138 my ($self, $fingerprint) = @_;
140 if (!$self->{manual_verification
}) {
141 warn "fingerprint: $fingerprint\n";
145 print "The authenticity of host '$self->{host}' can't be established.\n" .
146 "X509 SHA256 key fingerprint is $fingerprint.\n" .
147 "Are you sure you want to continue connecting (yes/no)? ";
151 my $valid = ($answer =~ m/^\s*yes\s*$/i) ?
1 : 0;
153 $self->{cached_fingerprints
}->{$fingerprint} = $valid;
155 if (my $cb = $self->{register_fingerprint_cb
}) {
156 $cb->($fingerprint) if $valid;
163 my ($self, $method, $path, $param) = @_;
165 delete $self->{last_unknown_fingerprint
};
167 my $ticket = $self->{ticket
};
169 my $ua = $self->{useragent
};
171 # fixme: check ticket lifetime?
173 if (!$ticket && $self->{username
} && $self->{password
}) {
177 my $uri = URI-
>new();
178 $uri->scheme($self->{protocol
});
179 $uri->host($self->{host
});
180 $uri->port($self->{port
});
184 if ($path !~ m!^api2/!) {
185 $uri->path("api2/json/$path");
190 #print "CALL $method : " . $uri->as_string() . "\n";
192 my $exec_method = sub {
195 if ($method eq 'GET') {
196 $uri->query_form($param);
197 $response = $ua->request(HTTP
::Request
::Common
::GET
($uri));
198 } elsif ($method eq 'POST') {
199 $response = $ua->request(HTTP
::Request
::Common
::POST
($uri, Content
=> $param));
200 } elsif ($method eq 'PUT') {
201 # We use another temporary URI object to format
202 # the application/x-www-form-urlencoded content.
204 my $tmpurl = URI-
>new('http:');
205 $tmpurl->query_form(%$param);
206 my $content = $tmpurl->query;
208 $response = $ua->request(HTTP
::Request
::Common
::PUT
($uri, 'Content-Type' => 'application/x-www-form-urlencoded', Content
=> $content));
210 } elsif ($method eq 'DELETE') {
211 $response = $ua->request(HTTP
::Request
::Common
::DELETE
($uri));
213 die "method $method not implemented\n";
218 my $response = $exec_method->();
220 if (my $fp = delete($self->{last_unknown_fingerprint
})) {
221 if ($self->manual_verify_fingerprint($fp)) {
222 $response = $exec_method->(); # try again
226 #print "RESP: " . Dumper($response) . "\n";
228 my $ct = $response->header('Content-Type') || '';
230 if ($response->is_success) {
232 die "got unexpected content type" if $ct !~ m
|application
/json
|;
234 return from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
238 my $msg = $response->status_line . "\n";
240 return if $ct !~ m
|application
/json
|;
241 my $res = from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
242 if (my $errors = $res->{errors
}) {
243 foreach my $key (keys %$errors) {
244 my $m = $errors->{$key};
247 $msg .= " $key: $m\n";
256 my $verify_cert_callback = sub {
257 my ($self, $cert) = @_;
259 # check server certificate against cache of pinned FPs
260 # get fingerprint of server certificate
261 my $fp = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
262 return 0 if !defined($fp) || $fp eq ''; # error
264 my $valid = $self->{cached_fingerprints
}->{$fp};
265 return $valid if defined($valid); # return cached result
267 if (my $cb = $self->{verify_fingerprint_cb
}) {
268 $valid = $cb->($cert);
269 $self->{cached_fingerprints
}->{$fp} = $valid;
273 $self->{last_unknown_fingerprint
} = $fp;
279 my ($class, %param) = @_;
281 my $ssl_default_opts = { verify_hostname
=> 0 };
282 my $ssl_opts = $param{ssl_opts
} || $ssl_default_opts;
285 username
=> $param{username
},
286 password
=> $param{password
},
287 host
=> $param{host
} || 'localhost',
288 port
=> $param{port
},
289 protocol
=> $param{protocol
},
290 cookie_name
=> $param{cookie_name
} // 'PVEAuthCookie',
291 manual_verification
=> $param{manual_verification
},
292 cached_fingerprints
=> $param{cached_fingerprints
} || {},
293 verify_fingerprint_cb
=> $param{verify_fingerprint_cb
},
294 register_fingerprint_cb
=> $param{register_fingerprint_cb
},
295 ssl_opts
=> $ssl_opts,
296 timeout
=> $param{timeout
} || 60,
300 if (!$ssl_opts->{SSL_verify_callback
}) {
301 $ssl_opts->{'SSL_verify_mode'} = SSL_VERIFY_PEER
;
302 $ssl_opts->{'SSL_verify_callback'} = sub {
303 my (undef, undef, undef, undef, $cert, $depth) = @_;
305 # we don't care about intermediate or root certificates
306 return 1 if $depth != 0;
308 return $verify_cert_callback->($self, $cert);
312 if (!$self->{port
}) {
313 $self->{port
} = $self->{host
} eq 'localhost' ?
85 : 8006;
315 if (!$self->{protocol
}) {
316 $self->{protocol
} = $self->{host
} eq 'localhost' ?
'http' : 'https';
319 $self->{useragent
} = LWP
::UserAgent-
>new(
320 protocols_allowed
=> [ 'http', 'https'],
321 ssl_opts
=> $ssl_opts,
322 timeout
=> $self->{timeout
},
323 keep_alive
=> $param{keep_alive
} // 50,
326 $self->{useragent
}->default_header('Accept-Encoding' => 'gzip'); # allow gzip
328 $self->update_ticket($param{ticket
}) if $param{ticket
};
329 $self->update_csrftoken($param{csrftoken
}) if $param{csrftoken
};