1 package PVE
::APIClient
::LWP
;
7 use HTTP
::Request
::Common
;
8 use IO
::Socket
::SSL
; # important for SSL_verify_callback
15 use PVE
::APIClient
::Exception
qw(raise);
17 my $extract_data = sub {
20 croak
"undefined result" if !defined($res);
21 croak
"undefined result data" if !exists($res->{data
});
27 my ($self, $path, $param) = @_;
29 return $self->call('GET', $path, $param);
33 my ($self, $path, $param) = @_;
35 return $extract_data->($self->call('GET', $path, $param));
39 my ($self, $path, $param) = @_;
41 return $self->call('POST', $path, $param);
45 my ($self, $path, $param) = @_;
47 return $extract_data->($self->call('POST', $path, $param));
51 my ($self, $path, $param) = @_;
53 return $self->call('PUT', $path, $param);
57 my ($self, $path, $param) = @_;
59 return $extract_data->($self->call('PUT', $path, $param));
63 my ($self, $path, $param) = @_;
65 return $self->call('DELETE', $path, $param);
69 my ($self, $path, $param) = @_;
71 return $extract_data->($self->call('DELETE', $path, $param));
74 sub update_csrftoken
{
75 my ($self, $csrftoken) = @_;
77 $self->{csrftoken
} = $csrftoken;
79 my $agent = $self->{useragent
};
81 $agent->default_header('CSRFPreventionToken', $self->{csrftoken
});
85 my ($self, $ticket) = @_;
87 my $agent = $self->{useragent
};
89 $self->{ticket
} = $ticket;
91 my $encticket = uri_escape
($ticket);
92 my $cookie = "$self->{cookie_name}=$encticket; path=/; secure;";
93 $agent->default_header('Cookie', $cookie);
96 my sub two_factor_auth_login_old
: prototype($$$) {
97 my ($self, $type, $challenge) = @_;
99 if ($type eq 'PVE:tfa') {
100 raise
("TFA-enabled login currently works only with a TTY.") if !-t STDIN
;
101 print "\nEnter OTP code for user $self->{username}: ";
102 my $tfa_response = <STDIN
>;
104 return $self->post('/api2/json/access/tfa', {response
=> $tfa_response});
105 } elsif ($type eq 'PVE:u2f') {
106 # TODO: implement u2f-enabled join
107 raise
("U2F-enabled login is currently not implemented.");
109 raise
("Authentication type '$type' not recognized, aborting!");
113 my sub extra_login_params
: prototype($) {
115 return $self->{pve_new_format
} ?
('new-format' => 1) : ();
118 my sub two_factor_auth_login
: prototype($$$) {
119 my ($self, $challenge, $ticket) = @_;
121 raise
("TFA-enabled login currently works only with a TTY.") if !-t STDIN
;
123 $challenge = eval { from_json
($challenge, { utf8
=> 1 }) };
125 raise
("Bad TFA challenge: $err");
127 raise
("Bad TFA challenge!") if !$challenge;
130 push @available, 'totp' if $challenge->{totp
};
131 push @available, 'recovery' if $challenge->{recovery
};
132 push @available, 'yubico' if $challenge->{yubico
};
135 if (@available == 1) {
136 $selected = $available[0];
137 } elsif (@available > 1) {
138 while (!defined($selected)) {
139 print "Available TFA methods:\n";
140 print "$_: $available[$_]\n" for (0..(@available - 1));
141 print "Select TFA method: ";
143 my $response = <STDIN
>;
144 if ($response =~ /^\s*(\d+)\s*$/) {
145 $selected = int($response);
148 $selected = $available[$selected];
150 raise
("TFA required, but none of the configure factors is supported over TTY, aborting!");
153 if ($selected eq 'recovery') {
154 my $keys = $challenge->{recovery
};
156 print("WARNING: Few recovery keys remaining: ");
158 print("The following recovery codes are available: ");
160 print(join(', ', @$keys), "\n");
163 print "Enter $selected code for user $self->{username}: ";
165 my $tfa_response = <STDIN
>;
169 '/api2/json/access/ticket',
171 username
=> $self->{username
},
172 password
=> "$selected:$tfa_response",
173 'tfa-challenge' => $ticket,
174 (extra_login_params
($self))
179 my $new_tfa_ticket_re = qr/^[^\s:]+:!tfa!([^:]+):/;
180 my $old_tfa_ticket_re = qr/^([^\s!]+)![^!]*(!([0-9a-zA-Z\/.=_\
-+]+))?
$/;
184 my $uri = URI-
>new();
185 $uri->scheme($self->{protocol
});
186 $uri->host($self->{host
});
187 $uri->port($self->{port
});
188 $uri->path('/api2/json/access/ticket');
190 my $ua = $self->{useragent
};
191 my $username = $self->{username
} // 'unknown',
193 delete $self->{fingerprint
}->{last_unknown
};
195 my $exec_login = sub {
196 return $ua->post($uri, {
197 username
=> $username,
198 password
=> $self->{password
} || '',
199 (extra_login_params
($self))
203 my $response = $exec_login->();
205 if (!$response->is_success) {
206 if (my $fp = delete($self->{fingerprint
}->{last_unknown
})) {
207 if ($self->manual_verify_fingerprint($fp)) {
208 $response = $exec_login->(); # try again
213 if (!$response->is_success) {
214 raise
($response->status_line ."\n", code
=> $response->code)
217 my $res = from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
219 my $data = $extract_data->($res);
220 $self->update_ticket($data->{ticket
});
221 $self->update_csrftoken($data->{CSRFPreventionToken
});
223 # handle two-factor login
224 my $ticket = $data->{ticket
};
225 if ($ticket =~ $new_tfa_ticket_re) {
226 my $challenge = uri_unescape
($1);
227 $data = two_factor_auth_login
($self, $challenge, $ticket);
228 $self->update_ticket($data->{ticket
});
229 } elsif ($ticket =~ $old_tfa_ticket_re) {
230 # handle old-style two-factor login for PVE:
231 my ($type, $challenge) = ($1, $2);
232 $data = two_factor_auth_login_old
($self, $type, $challenge);
233 $self->update_ticket($data->{ticket
});
239 sub manual_verify_fingerprint
{
240 my ($self, $fingerprint) = @_;
242 if (!$self->{manual_verification
}) {
243 raise
("fingerprint '$fingerprint' not verified, abort!\n");
246 print "The authenticity of host '$self->{host}' can't be established.\n" .
247 "X509 SHA256 key fingerprint is $fingerprint.\n" .
248 "Are you sure you want to continue connecting (yes/no)? ";
250 my $answer = <STDIN
>;
252 my $valid = ($answer =~ m/^\s*yes\s*$/i) ?
1 : 0;
254 $self->{fingerprint
}->{cache
}->{$fingerprint} = $valid;
256 raise
("Fingerprint not verified, abort!\n") if !$valid;
258 if (my $cb = $self->{register_fingerprint_cb
}) {
259 $cb->($fingerprint) if $valid;
266 my ($self, $method, $path, $param) = @_;
268 delete $self->{fingerprint
}->{last_unknown
};
270 my $ticket = $self->{ticket
};
271 my $apitoken = $self->{apitoken
};
273 my $ua = $self->{useragent
};
275 # fixme: check ticket lifetime?
277 if (!$ticket && !$apitoken && $self->{username
} && $self->{password
}) {
281 my $uri = URI-
>new();
282 $uri->scheme($self->{protocol
});
283 $uri->host($self->{host
});
284 $uri->port($self->{port
});
288 if ($path !~ m!^api2/!) {
289 $uri->path("api2/json/$path");
294 #print "CALL $method : " . $uri->as_string() . "\n";
296 my $exec_method = sub {
299 if ($method eq 'GET') {
300 $uri->query_form($param);
301 $response = $ua->request(HTTP
::Request
::Common
::GET
($uri));
302 } elsif ($method eq 'POST') {
303 $response = $ua->request(HTTP
::Request
::Common
::POST
($uri, Content
=> $param));
304 } elsif ($method eq 'PUT') {
305 # We use another temporary URI object to format
306 # the application/x-www-form-urlencoded content.
308 my $tmpurl = URI-
>new('http:');
309 $tmpurl->query_form(%$param);
310 my $content = $tmpurl->query;
312 $response = $ua->request(HTTP
::Request
::Common
::PUT
($uri, 'Content-Type' => 'application/x-www-form-urlencoded', Content
=> $content));
314 } elsif ($method eq 'DELETE') {
315 $response = $ua->request(HTTP
::Request
::Common
::DELETE
($uri));
317 raise
("method $method not implemented\n");
322 my $response = $exec_method->();
324 if (my $fp = delete($self->{fingerprint
}->{last_unknown
})) {
325 if ($self->manual_verify_fingerprint($fp)) {
326 $response = $exec_method->(); # try again
330 my $ct = $response->header('Content-Type') || '';
332 if ($response->is_success) {
334 raise
("got unexpected content type", code
=> $response->code)
335 if $ct !~ m
|application
/json
|;
337 return from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
341 my $msg = $response->message;
343 return if $ct !~ m
|application
/json
|;
344 my $res = from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
345 return $res->{errors
};
348 raise
("$msg\n", code
=> $response->code, errors
=> $errors);
352 my sub verify_cert_callback
{
353 my ($fingerprint, $cert, $verify_cb) = @_;
355 # check server certificate against cache of pinned FPs
356 # get fingerprint of server certificate
357 my $fp = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
358 return 0 if !defined($fp) || $fp eq ''; # error
360 my $valid = $fingerprint->{cache
}->{$fp};
361 return $valid if defined($valid); # return cached result
364 $valid = $verify_cb->($cert);
365 $fingerprint->{cache
}->{$fp} = $valid;
369 $fingerprint->{last_unknown
} = $fp;
375 my ($class, %param) = @_;
377 my $ssl_opts = $param{ssl_opts
} || {};
379 if (!defined($ssl_opts->{verify_hostname
})) {
380 if (scalar(keys $param{cached_fingerprints
}->%*) > 0) {
381 # purely trust the configured fingerprints, by default
382 $ssl_opts->{verify_hostname
} = 0;
384 # no fingerprints passed, enforce hostname verification, by default
385 $ssl_opts->{verify_hostname
} = 1;
388 # we can only really trust openssl result if it also verifies the hostname,
389 # else it's easy to intercept (MITM using valid Lets Encrypt)
390 my $trust_openssl = $ssl_opts->{verify_hostname
} ?
1 : 0;
393 username
=> $param{username
},
394 password
=> $param{password
},
395 host
=> $param{host
} || 'localhost',
396 port
=> $param{port
},
397 protocol
=> $param{protocol
},
398 cookie_name
=> $param{cookie_name
} // 'PVEAuthCookie',
399 manual_verification
=> $param{manual_verification
},
401 cache
=> $param{cached_fingerprints
} || {},
402 last_unknown
=> undef,
404 register_fingerprint_cb
=> $param{register_fingerprint_cb
},
405 timeout
=> $param{timeout
} || 60,
406 pve_new_format
=> $param{pve_new_format
},
410 if (!$ssl_opts->{SSL_verify_callback
}) {
411 $ssl_opts->{'SSL_verify_mode'} = SSL_VERIFY_PEER
;
413 my $fingerprints = $self->{fingerprint
}; # avoid passing $self, that's a RC cycle!
414 my $verify_fingerprint_cb = $param{verify_fingerprint_cb
};
415 $ssl_opts->{'SSL_verify_callback'} = sub {
416 my ($openssl_valid, undef, undef, undef, $cert, $depth) = @_;
418 # we don't care about intermediate or root certificates
419 return 1 if $depth != 0;
421 return 1 if $trust_openssl && $openssl_valid;
423 return verify_cert_callback
($fingerprints, $cert, $verify_fingerprint_cb);
427 if (!$self->{port
}) {
428 $self->{port
} = $self->{host
} eq 'localhost' ?
85 : 8006;
430 if (!$self->{protocol
}) {
431 # cope that PBS and PVE can be installed on the same host, and one may thus use
432 # 'localhost' then - so only default to http for privileged ports, in that case,
433 # as the HTTP daemons normally run with those (e.g., 85 or 87)
434 $self->{protocol
} = $self->{host
} eq 'localhost' && $self->{port
} < 1024
440 $self->{useragent
} = LWP
::UserAgent-
>new(
441 protocols_allowed
=> [ 'http', 'https'],
442 ssl_opts
=> $ssl_opts,
443 timeout
=> $self->{timeout
},
444 keep_alive
=> $param{keep_alive
} // 50,
447 $self->{useragent
}->default_header('Accept-Encoding' => 'gzip'); # allow gzip
449 if ($param{apitoken
} && $param{password
}) {
450 warn "password will be ignored in favor of API token\n";
451 delete $self->{password
};
453 if ($param{ticket
}) {
454 if ($param{apitoken
}) {
455 warn "ticket will be ignored in favor of API token\n";
457 $self->update_ticket($param{ticket
});
460 $self->update_csrftoken($param{csrftoken
}) if $param{csrftoken
};
462 if ($param{apitoken
}) {
463 my $agent = $self->{useragent
};
465 $self->{apitoken
} = $param{apitoken
};
467 $agent->default_header('Authorization', $param{apitoken
});