[pve-apiclient.git] / PVE / APIClient / LWP.pm

package PVE::APIClient::LWP;

use strict;
use warnings;

use Carp;
use HTTP::Request::Common;
use IO::Socket::SSL; # important for SSL_verify_callback
use JSON;
use LWP::UserAgent;
use Net::SSLeay;
use URI::Escape;
use URI;

use PVE::APIClient::Exception qw(raise);

my $extract_data = sub {
    my ($res) = @_;

    croak "undefined result" if !defined($res);
    croak "undefined result data" if !exists($res->{data});

    return $res->{data};
};

sub get_raw {
    my ($self, $path, $param) = @_;

    return $self->call('GET', $path, $param);
}

sub get {
    my ($self, $path, $param) = @_;

    return $extract_data->($self->call('GET', $path, $param));
}

sub post_raw {
    my ($self, $path, $param) = @_;

    return $self->call('POST', $path, $param);
}

sub post {
    my ($self, $path, $param) = @_;

    return $extract_data->($self->call('POST', $path, $param));
}

sub put_raw {
    my ($self, $path, $param) = @_;

    return $self->call('PUT', $path, $param);
}

sub put {
    my ($self, $path, $param) = @_;

    return $extract_data->($self->call('PUT', $path, $param));
}

sub delete_raw {
    my ($self, $path, $param) = @_;

    return $self->call('DELETE', $path, $param);
}

sub delete {
    my ($self, $path, $param) = @_;

    return $extract_data->($self->call('DELETE', $path, $param));
}

sub update_csrftoken {
    my ($self, $csrftoken) = @_;

    $self->{csrftoken} = $csrftoken;

    my $agent = $self->{useragent};

    $agent->default_header('CSRFPreventionToken', $self->{csrftoken});
}

sub update_ticket {
    my ($self, $ticket) = @_;

    my $agent = $self->{useragent};

    $self->{ticket} = $ticket;

    my $encticket = uri_escape($ticket);
    my $cookie = "$self->{cookie_name}=$encticket; path=/; secure;";
    $agent->default_header('Cookie', $cookie);
}

my sub two_factor_auth_login_old : prototype($$$) {
    my ($self, $type, $challenge) = @_;

    if ($type eq 'PVE:tfa') {
	raise("TFA-enabled login currently works only with a TTY.") if !-t STDIN;
	print "\nEnter OTP code for user $self->{username}: ";
	my $tfa_response = <STDIN>;
	chomp $tfa_response;
	return $self->post('/api2/json/access/tfa', {response => $tfa_response});
    } elsif ($type eq 'PVE:u2f') {
	# TODO: implement u2f-enabled join
	raise("U2F-enabled login is currently not implemented.");
    } else {
	raise("Authentication type '$type' not recognized, aborting!");
    }
}

my sub extra_login_params : prototype($) {
    my ($self) = @_;
    return $self->{pve_new_format} ? ('new-format' => 1) : ();
}

my sub two_factor_auth_login : prototype($$$) {
    my ($self, $challenge, $ticket) = @_;

    raise("TFA-enabled login currently works only with a TTY.") if !-t STDIN;

    $challenge = eval { from_json($challenge, { utf8 => 1 }) };
    if (my $err = $@) {
	raise("Bad TFA challenge: $err");
    }
    raise("Bad TFA challenge!") if !$challenge;

    my @available;
    push @available, 'totp' if $challenge->{totp};
    push @available, 'recovery' if $challenge->{recovery};
    push @available, 'yubico' if $challenge->{yubico};

    my $selected;
    if (@available == 1) {
	$selected = $available[0];
    } elsif (@available > 1) {
	while (!defined($selected)) {
	    print "Available TFA methods:\n";
	    print "$_: $available[$_]\n" for (0..(@available - 1));
	    print "Select TFA method: ";
	    STDOUT->flush;
	    my $response = <STDIN>;
	    if ($response =~ /^\s*(\d+)\s*$/) {
		$selected = int($response);
	    }
	}
	$selected = $available[$selected];
    } else {
	raise("TFA required, but available authentication types are not supported, aborting!");
    }

    if ($selected eq 'recovery') {
	my $keys = $challenge->{recovery};
	if (@$keys <= 3) {
	    print("WARNING: Few recovery keys remaining: ");
	} else {
	    print("The following recovery codes are available: ");
	}
	print(join(', ', @$keys), "\n");
    }

    print "Enter $selected code for user $self->{username}: ";
    STDOUT->flush;
    my $tfa_response = <STDIN>;
    chomp $tfa_response;

    return $self->post(
	'/api2/json/access/ticket',
	{
	    username => $self->{username},
	    password => "$selected:$tfa_response",
	    'tfa-challenge' => $ticket,
	    (extra_login_params($self))
	},
    );
}

my $new_tfa_ticket_re = qr/^[^\s:]+:!tfa!([^:]+):/;
my $old_tfa_ticket_re = qr/^([^\s!]+)![^!]*(!([0-9a-zA-Z\/.=_\-+]+))?$/;
sub login {
    my ($self) = @_;

    my $uri = URI->new();
    $uri->scheme($self->{protocol});
    $uri->host($self->{host});
    $uri->port($self->{port});
    $uri->path('/api2/json/access/ticket');

    my $ua = $self->{useragent};
    my $username = $self->{username} // 'unknown',

    delete $self->{fingerprint}->{last_unknown};

    my $exec_login = sub {
	return $ua->post($uri, {
	    username => $username,
	    password => $self->{password} || '',
	    (extra_login_params($self))
	});
    };

    my $response = $exec_login->();

    if (!$response->is_success) {
	if (my $fp = delete($self->{fingerprint}->{last_unknown})) {
	    if ($self->manual_verify_fingerprint($fp)) {
		$response = $exec_login->(); # try again
	    }
	}
    }

    if (!$response->is_success) {
	raise($response->status_line ."\n", code => $response->code)
    }

    my $res = from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});

    my $data = $extract_data->($res);
    $self->update_ticket($data->{ticket});
    $self->update_csrftoken($data->{CSRFPreventionToken});

    # handle two-factor login
    my $ticket = $data->{ticket};
    if ($ticket =~ $new_tfa_ticket_re) {
	my $challenge = uri_unescape($1);
	$data = two_factor_auth_login($self, $challenge, $ticket);
	$self->update_ticket($data->{ticket});
    } elsif ($ticket =~ $old_tfa_ticket_re) {
	# handle old-style two-factor login for PVE:
	my ($type, $challenge) = ($1, $2);
	$data = two_factor_auth_login_old($self, $type, $challenge);
	$self->update_ticket($data->{ticket});
    }

    return $data;
}

sub manual_verify_fingerprint {
    my ($self, $fingerprint) = @_;

    if (!$self->{manual_verification}) {
	raise("fingerprint '$fingerprint' not verified, abort!\n");
    }

    print "The authenticity of host '$self->{host}' can't be established.\n" .
	"X509 SHA256 key fingerprint is $fingerprint.\n" .
	"Are you sure you want to continue connecting (yes/no)? ";

    my $answer = <STDIN>;

    my $valid = ($answer =~ m/^\s*yes\s*$/i) ? 1 : 0;

    $self->{fingerprint}->{cache}->{$fingerprint} = $valid;

    raise("Fingerprint not verified, abort!\n") if !$valid;

    if (my $cb = $self->{register_fingerprint_cb}) {
	$cb->($fingerprint) if $valid;
    }

    return $valid;
}

sub call {
    my ($self, $method, $path, $param) = @_;

    delete $self->{fingerprint}->{last_unknown};

    my $ticket = $self->{ticket};
    my $apitoken = $self->{apitoken};

    my $ua = $self->{useragent};

    # fixme: check ticket lifetime?

    if (!$ticket && !$apitoken && $self->{username} && $self->{password}) {
	$self->login();
    }

    my $uri = URI->new();
    $uri->scheme($self->{protocol});
    $uri->host($self->{host});
    $uri->port($self->{port});

    $path =~ s!^/+!!;

    if ($path !~ m!^api2/!) {
	$uri->path("api2/json/$path");
    } else {
	$uri->path($path);
    }

    #print "CALL $method : " .  $uri->as_string() . "\n";

    my $exec_method = sub {

	my $response;
	if ($method eq 'GET') {
	    $uri->query_form($param);
	    $response = $ua->request(HTTP::Request::Common::GET($uri));
	} elsif ($method eq 'POST') {
	    $response = $ua->request(HTTP::Request::Common::POST($uri, Content => $param));
	} elsif ($method eq 'PUT') {
	    # We use another temporary URI object to format
	    # the application/x-www-form-urlencoded content.

	    my $tmpurl = URI->new('http:');
	    $tmpurl->query_form(%$param);
	    my $content = $tmpurl->query;

	    $response = $ua->request(HTTP::Request::Common::PUT($uri, 'Content-Type' => 'application/x-www-form-urlencoded', Content => $content));

	} elsif ($method eq 'DELETE') {
	    $response = $ua->request(HTTP::Request::Common::DELETE($uri));
	} else {
	    raise("method $method not implemented\n");
	}
	return $response;
    };

    my $response = $exec_method->();

    if (my $fp = delete($self->{fingerprint}->{last_unknown})) {
	if ($self->manual_verify_fingerprint($fp)) {
	    $response = $exec_method->(); # try again
	}
    }

    my $ct = $response->header('Content-Type') || '';

    if ($response->is_success) {

	raise("got unexpected content type", code => $response->code)
	    if $ct !~ m|application/json|;

	return from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});

    } else {

	my $msg = $response->message;
	my $errors = eval {
	    return if $ct !~ m|application/json|;
	    my $res = from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
	    return $res->{errors};
	};

	raise("$msg\n", code => $response->code, errors => $errors);
    }
}

my sub verify_cert_callback {
    my ($fingerprint, $cert, $verify_cb) = @_;

    # check server certificate against cache of pinned FPs
    # get fingerprint of server certificate
    my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
    return 0 if !defined($fp) || $fp eq ''; # error

    my $valid = $fingerprint->{cache}->{$fp};
    return $valid if defined($valid); # return cached result

    if ($verify_cb) {
	$valid = $verify_cb->($cert);
	$fingerprint->{cache}->{$fp} = $valid;
	return $valid;
    }

    $fingerprint->{last_unknown} = $fp;

    return 0;
};

sub new {
    my ($class, %param) = @_;

    my $ssl_opts = $param{ssl_opts} || {};

    if (!defined($ssl_opts->{verify_hostname})) {
	if (scalar(keys $param{cached_fingerprints}->%*) > 0) {
	    # purely trust the configured fingerprints, by default
	    $ssl_opts->{verify_hostname} = 0;
	} else {
	    # no fingerprints passed, enforce hostname verification, by default
	    $ssl_opts->{verify_hostname} = 1;
	}
    }
    # we can only really trust openssl result if it also verifies the hostname,
    # else it's easy to intercept (MITM using valid Lets Encrypt)
    my $trust_openssl = $ssl_opts->{verify_hostname} ? 1 : 0;

    my $self = {
	username => $param{username},
	password => $param{password},
	host => $param{host} || 'localhost',
	port => $param{port},
	protocol => $param{protocol},
	cookie_name => $param{cookie_name} // 'PVEAuthCookie',
	manual_verification => $param{manual_verification},
	fingerprint => {
	    cache => $param{cached_fingerprints} || {},
	    last_unknown => undef,
	},
	register_fingerprint_cb => $param{register_fingerprint_cb},
	timeout => $param{timeout} || 60,
	pve_new_format => $param{pve_new_format},
    };
    bless $self, $class;

    if (!$ssl_opts->{SSL_verify_callback}) {
	$ssl_opts->{'SSL_verify_mode'} = SSL_VERIFY_PEER;

	my $fingerprints = $self->{fingerprint}; # avoid passing $self, that's a RC cycle!
	my $verify_fingerprint_cb = $param{verify_fingerprint_cb};
	$ssl_opts->{'SSL_verify_callback'} = sub {
	    my ($openssl_valid, undef, undef, undef, $cert, $depth) = @_;

	    # we don't care about intermediate or root certificates
	    return 1 if $depth != 0;

	    return 1 if $trust_openssl && $openssl_valid;

	    return verify_cert_callback($fingerprints, $cert, $verify_fingerprint_cb);
	}
    }

    if (!$self->{port}) {
	$self->{port} = $self->{host} eq 'localhost' ? 85 : 8006;
    }
    if (!$self->{protocol}) {
	# cope that PBS and PVE can be installed on the same host, and one may thus use
	# 'localhost' then - so only default to http for privileged ports, in that case,
	# as the HTTP daemons normally run with those (e.g., 85 or 87)
	$self->{protocol} = $self->{host} eq 'localhost' && $self->{port} < 1024
	    ? 'http'
	    : 'https'
	    ;
    }

    $self->{useragent} = LWP::UserAgent->new(
	protocols_allowed => [ 'http', 'https'],
	ssl_opts => $ssl_opts,
	timeout => $self->{timeout},
	keep_alive => $param{keep_alive} // 50,
	);

    $self->{useragent}->default_header('Accept-Encoding' => 'gzip'); # allow gzip

    if ($param{apitoken} && $param{password}) {
	warn "password will be ignored in favor of API token\n";
	delete $self->{password};
    }
    if ($param{ticket}) {
	if ($param{apitoken}) {
	    warn "ticket will be ignored in favor of API token\n";
	} else {
	    $self->update_ticket($param{ticket});
	}
    }
    $self->update_csrftoken($param{csrftoken}) if $param{csrftoken};

    if ($param{apitoken}) {
	my $agent = $self->{useragent};

	$self->{apitoken} = $param{apitoken};

	$agent->default_header('Authorization', $param{apitoken});
    }

    return $self;
}

1;
Commit	Line	Data
9ae947dd DM	1	package PVE::APIClient::LWP;
	2
	3	use strict;
	4	use warnings;
44f9aae4 TL	5
	6	use Carp;
	7	use HTTP::Request::Common;
9ae947dd	8	use IO::Socket::SSL; # important for SSL_verify_callback
44f9aae4	9	use JSON;
9ae947dd	10	use LWP::UserAgent;
9ae947dd	11	use Net::SSLeay;
44f9aae4 TL	12	use URI::Escape;
	13	use URI;
	14
097484f4	15	use PVE::APIClient::Exception qw(raise);
9ae947dd DM	16
	17	my $extract_data = sub {
	18	my ($res) = @_;
	19
	20	croak "undefined result" if !defined($res);
	21	croak "undefined result data" if !exists($res->{data});
	22
	23	return $res->{data};
	24	};
	25
	26	sub get_raw {
	27	my ($self, $path, $param) = @_;
	28
	29	return $self->call('GET', $path, $param);
	30	}
	31
	32	sub get {
	33	my ($self, $path, $param) = @_;
	34
	35	return $extract_data->($self->call('GET', $path, $param));
	36	}
	37
	38	sub post_raw {
	39	my ($self, $path, $param) = @_;
	40
	41	return $self->call('POST', $path, $param);
	42	}
	43
	44	sub post {
	45	my ($self, $path, $param) = @_;
	46
	47	return $extract_data->($self->call('POST', $path, $param));
	48	}
	49
	50	sub put_raw {
	51	my ($self, $path, $param) = @_;
	52
	53	return $self->call('PUT', $path, $param);
	54	}
	55
	56	sub put {
	57	my ($self, $path, $param) = @_;
	58
	59	return $extract_data->($self->call('PUT', $path, $param));
	60	}
	61
	62	sub delete_raw {
	63	my ($self, $path, $param) = @_;
	64
	65	return $self->call('DELETE', $path, $param);
	66	}
	67
	68	sub delete {
	69	my ($self, $path, $param) = @_;
	70
	71	return $extract_data->($self->call('DELETE', $path, $param));
	72	}
	73
	74	sub update_csrftoken {
	75	my ($self, $csrftoken) = @_;
	76
	77	$self->{csrftoken} = $csrftoken;
	78
	79	my $agent = $self->{useragent};
80
81	$agent->default_header('CSRFPreventionToken', $self->{csrftoken});
82	}
83
84	sub update_ticket {
85	my ($self, $ticket) = @_;
86
87	my $agent = $self->{useragent};
88
89	$self->{ticket} = $ticket;
90
91	my $encticket = uri_escape($ticket);
444d6419	92	my $cookie = "$self->{cookie_name}=$encticket; path=/; secure;";
9ae947dd DM	93	$agent->default_header('Cookie', $cookie);
	94	}
	95
3bfa976e	96	my sub two_factor_auth_login_old : prototype($$$) {
f1956672 OB	97	my ($self, $type, $challenge) = @_;
	98
	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>;
	103	chomp $tfa_response;
	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.");
	108	} else {
	109	raise("Authentication type '$type' not recognized, aborting!");
	110	}
	111	}
	112
3bfa976e WB	113	my sub extra_login_params : prototype($) {
	114	my ($self) = @_;
	115	return $self->{pve_new_format} ? ('new-format' => 1) : ();
	116	}
	117
	118	my sub two_factor_auth_login : prototype($$$) {
	119	my ($self, $challenge, $ticket) = @_;
	120
	121	raise("TFA-enabled login currently works only with a TTY.") if !-t STDIN;
	122
	123	$challenge = eval { from_json($challenge, { utf8 => 1 }) };
	124	if (my $err = $@) {
	125	raise("Bad TFA challenge: $err");
	126	}
	127	raise("Bad TFA challenge!") if !$challenge;
	128
	129	my @available;
	130	push @available, 'totp' if $challenge->{totp};
	131	push @available, 'recovery' if $challenge->{recovery};
	132	push @available, 'yubico' if $challenge->{yubico};
	133
	134	my $selected;
	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: ";
	142	STDOUT->flush;
	143	my $response = <STDIN>;
	144	if ($response =~ /^\s(\d+)\s$/) {
	145	$selected = int($response);
	146	}
	147	}
	148	$selected = $available[$selected];
	149	} else {
	150	raise("TFA required, but available authentication types are not supported, aborting!");
	151	}
	152
	153	if ($selected eq 'recovery') {
	154	my $keys = $challenge->{recovery};
	155	if (@$keys <= 3) {
	156	print("WARNING: Few recovery keys remaining: ");
	157	} else {
	158	print("The following recovery codes are available: ");
	159	}
	160	print(join(', ', @$keys), "\n");
	161	}
	162
	163	print "Enter $selected code for user $self->{username}: ";
	164	STDOUT->flush;
	165	my $tfa_response = <STDIN>;
	166	chomp $tfa_response;
	167
	168	return $self->post(
	169	'/api2/json/access/ticket',
	170	{
	171	username => $self->{username},
	172	password => "$selected:$tfa_response",
	173	'tfa-challenge' => $ticket,
	174	(extra_login_params($self))
	175	},
	176	);
177	}
178
179	my $new_tfa_ticket_re = qr/^[^\s:]+:!tfa!([^:]+):/;
180	my $old_tfa_ticket_re = qr/^([^\s!]+)![^!]*(!([0-9a-zA-Z\/.=_\-+]+))?$/;
9ae947dd DM	181	sub login {
	182	my ($self) = @_;
	183
	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');
	189
	190	my $ua = $self->{useragent};
8bc98506	191	my $username = $self->{username} // 'unknown',
9ae947dd	192
588a2ba6	193	delete $self->{fingerprint}->{last_unknown};
9ae947dd DM	194
	195	my $exec_login = sub {
	196	return $ua->post($uri, {
8bc98506	197	username => $username,
3bfa976e WB	198	password => $self->{password} \|\| '',
3bfa976e WB	199	(extra_login_params($self))
e02e35fd	200	});
9ae947dd DM	201	};
	202
	203	my $response = $exec_login->();
	204
	205	if (!$response->is_success) {
588a2ba6	206	if (my $fp = delete($self->{fingerprint}->{last_unknown})) {
9ae947dd DM	207	if ($self->manual_verify_fingerprint($fp)) {
	208	$response = $exec_login->(); # try again
	209	}
	210	}
	211	}
	212
	213	if (!$response->is_success) {
097484f4	214	raise($response->status_line ."\n", code => $response->code)
9ae947dd DM	215	}
	216
	217	my $res = from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
	218
	219	my $data = $extract_data->($res);
9ae947dd DM	220	$self->update_ticket($data->{ticket});
	221	$self->update_csrftoken($data->{CSRFPreventionToken});
	222
f1956672	223	# handle two-factor login
3bfa976e WB	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:
f1956672	231	my ($type, $challenge) = ($1, $2);
3bfa976e	232	$data = two_factor_auth_login_old($self, $type, $challenge);
f1956672 OB	233	$self->update_ticket($data->{ticket});
	234	}
	235
9ae947dd DM	236	return $data;
	237	}
	238
	239	sub manual_verify_fingerprint {
	240	my ($self, $fingerprint) = @_;
	241
	242	if (!$self->{manual_verification}) {
8153e671	243	raise("fingerprint '$fingerprint' not verified, abort!\n");
9ae947dd DM	244	}
	245
	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)? ";
	249
ff8ba9c9	250	my $answer = <STDIN>;
9ae947dd DM	251
	252	my $valid = ($answer =~ m/^\syes\s$/i) ? 1 : 0;
	253
588a2ba6	254	$self->{fingerprint}->{cache}->{$fingerprint} = $valid;
9ae947dd	255
8153e671 TL	256	raise("Fingerprint not verified, abort!\n") if !$valid;
8153e671 TL	257
9ae947dd DM	258	if (my $cb = $self->{register_fingerprint_cb}) {
	259	$cb->($fingerprint) if $valid;
	260	}
	261
	262	return $valid;
	263	}
	264
	265	sub call {
	266	my ($self, $method, $path, $param) = @_;
	267
588a2ba6	268	delete $self->{fingerprint}->{last_unknown};
9ae947dd DM	269
9ae947dd DM	270	my $ticket = $self->{ticket};
7b6f8f1d	271	my $apitoken = $self->{apitoken};
9ae947dd DM	272
	273	my $ua = $self->{useragent};
	274
	275	# fixme: check ticket lifetime?
	276
7b6f8f1d	277	if (!$ticket && !$apitoken && $self->{username} && $self->{password}) {
9ae947dd DM	278	$self->login();
	279	}
	280
	281	my $uri = URI->new();
	282	$uri->scheme($self->{protocol});
	283	$uri->host($self->{host});
	284	$uri->port($self->{port});
	285
	286	$path =~ s!^/+!!;
	287
	288	if ($path !~ m!^api2/!) {
	289	$uri->path("api2/json/$path");
	290	} else {
	291	$uri->path($path);
	292	}
	293
	294	#print "CALL $method : " . $uri->as_string() . "\n";
	295
	296	my $exec_method = sub {
	297
	298	my $response;
	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.
	307
	308	my $tmpurl = URI->new('http:');
	309	$tmpurl->query_form(%$param);
	310	my $content = $tmpurl->query;
	311
	312	$response = $ua->request(HTTP::Request::Common::PUT($uri, 'Content-Type' => 'application/x-www-form-urlencoded', Content => $content));
	313
	314	} elsif ($method eq 'DELETE') {
	315	$response = $ua->request(HTTP::Request::Common::DELETE($uri));
	316	} else {
097484f4	317	raise("method $method not implemented\n");
9ae947dd DM	318	}
	319	return $response;
	320	};
	321
	322	my $response = $exec_method->();
	323
588a2ba6	324	if (my $fp = delete($self->{fingerprint}->{last_unknown})) {
9ae947dd DM	325	if ($self->manual_verify_fingerprint($fp)) {
	326	$response = $exec_method->(); # try again
	327	}
	328	}
	329
9ae947dd DM	330	my $ct = $response->header('Content-Type') \|\| '';
	331
	332	if ($response->is_success) {
	333
097484f4 TL	334	raise("got unexpected content type", code => $response->code)
097484f4 TL	335	if $ct !~ m\|application/json\|;
9ae947dd DM	336
	337	return from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
	338
	339	} else {
	340
097484f4 TL	341	my $msg = $response->message;
097484f4 TL	342	my $errors = eval {
9ae947dd DM	343	return if $ct !~ m\|application/json\|;
9ae947dd DM	344	my $res = from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
097484f4	345	return $res->{errors};
9ae947dd	346	};
9ae947dd	347
097484f4	348	raise("$msg\n", code => $response->code, errors => $errors);
9ae947dd DM	349	}
	350	}
	351
588a2ba6 TL	352	my sub verify_cert_callback {
588a2ba6 TL	353	my ($fingerprint, $cert, $verify_cb) = @_;
9ae947dd DM	354
	355	# check server certificate against cache of pinned FPs
	356	# get fingerprint of server certificate
1d40f3c3	357	my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
38eb3479	358	return 0 if !defined($fp) \|\| $fp eq ''; # error
9ae947dd	359
588a2ba6	360	my $valid = $fingerprint->{cache}->{$fp};
9ae947dd DM	361	return $valid if defined($valid); # return cached result
9ae947dd DM	362
588a2ba6 TL	363	if ($verify_cb) {
	364	$valid = $verify_cb->($cert);
	365	$fingerprint->{cache}->{$fp} = $valid;
9ae947dd DM	366	return $valid;
	367	}
	368
588a2ba6	369	$fingerprint->{last_unknown} = $fp;
9ae947dd DM	370
	371	return 0;
	372	};
	373
	374	sub new {
	375	my ($class, %param) = @_;
	376
c998cdb6	377	my $ssl_opts = $param{ssl_opts} \|\| {};
9ae947dd	378
c998cdb6 TL	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;
	383	} else {
	384	# no fingerprints passed, enforce hostname verification, by default
	385	$ssl_opts->{verify_hostname} = 1;
	386	}
	387	}
a1298cc2 TL	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;
	391
9ae947dd DM	392	my $self = {
	393	username => $param{username},
	394	password => $param{password},
	395	host => $param{host} \|\| 'localhost',
	396	port => $param{port},
	397	protocol => $param{protocol},
444d6419	398	cookie_name => $param{cookie_name} // 'PVEAuthCookie',
9ae947dd	399	manual_verification => $param{manual_verification},
588a2ba6 TL	400	fingerprint => {
	401	cache => $param{cached_fingerprints} \|\| {},
	402	last_unknown => undef,
	403	},
9ae947dd	404	register_fingerprint_cb => $param{register_fingerprint_cb},
9ae947dd	405	timeout => $param{timeout} \|\| 60,
3bfa976e	406	pve_new_format => $param{pve_new_format},
9ae947dd	407	};
38fbee3c	408	bless $self, $class;
9ae947dd DM	409
	410	if (!$ssl_opts->{SSL_verify_callback}) {
	411	$ssl_opts->{'SSL_verify_mode'} = SSL_VERIFY_PEER;
588a2ba6	412
e02e35fd	413	my $fingerprints = $self->{fingerprint}; # avoid passing $self, that's a RC cycle!
588a2ba6	414	my $verify_fingerprint_cb = $param{verify_fingerprint_cb};
9ae947dd	415	$ssl_opts->{'SSL_verify_callback'} = sub {
a1298cc2	416	my ($openssl_valid, undef, undef, undef, $cert, $depth) = @_;
9ae947dd DM	417
	418	# we don't care about intermediate or root certificates
	419	return 1 if $depth != 0;
	420
a1298cc2 TL	421	return 1 if $trust_openssl && $openssl_valid;
a1298cc2 TL	422
e02e35fd	423	return verify_cert_callback($fingerprints, $cert, $verify_fingerprint_cb);
9ae947dd DM	424	}
	425	}
	426
	427	if (!$self->{port}) {
	428	$self->{port} = $self->{host} eq 'localhost' ? 85 : 8006;
	429	}
	430	if (!$self->{protocol}) {
44c53c4b TL	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
	435	? 'http'
	436	: 'https'
	437	;
9ae947dd DM	438	}
	439
	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,
	445	);
	446
	447	$self->{useragent}->default_header('Accept-Encoding' => 'gzip'); # allow gzip
	448
7b6f8f1d FG	449	if ($param{apitoken} && $param{password}) {
	450	warn "password will be ignored in favor of API token\n";
	451	delete $self->{password};
	452	}
	453	if ($param{ticket}) {
	454	if ($param{apitoken}) {
	455	warn "ticket will be ignored in favor of API token\n";
	456	} else {
	457	$self->update_ticket($param{ticket});
	458	}
	459	}
9ae947dd DM	460	$self->update_csrftoken($param{csrftoken}) if $param{csrftoken};
9ae947dd DM	461
7b6f8f1d FG	462	if ($param{apitoken}) {
	463	my $agent = $self->{useragent};
	464
	465	$self->{apitoken} = $param{apitoken};
	466
	467	$agent->default_header('Authorization', $param{apitoken});
	468	}
9ae947dd DM	469
	470	return $self;
	471	}
	472
	473	1;