[pve-devel] [PATCH RFC 18/21] add helpers to access the API via https - needs libwww-perl

[Dietmar Maurer]

Signed-off-by: Dietmar Maurer <dietmar at proxmox.com>
---
 data/PVE/CLI/pvecm.pm | 143 ++++++++++++++++++++++++++++++++++++++++++++++++++
 debian/control        |   2 +-
 2 files changed, 144 insertions(+), 1 deletion(-)

diff --git a/data/PVE/CLI/pvecm.pm b/data/PVE/CLI/pvecm.pm
index 3a44673..5063b4e 100755
--- a/data/PVE/CLI/pvecm.pm
+++ b/data/PVE/CLI/pvecm.pm
@@ -3,6 +3,12 @@ package PVE::CLI::pvecm;
 use strict;
 use warnings;
 use Getopt::Long;
+use Term::ReadLine;
+use IO::Socket::SSL; # important for SSL_verify_callback
+use LWP::UserAgent;
+use URI::Escape;
+use Net::SSLeay;
+use JSON;
 use Socket;
 use IO::File;
 use Net::IP;
@@ -28,6 +34,143 @@ my $backupdir = "/var/lib/pve-cluster/backup";
 my $dbfile = "$libdir/config.db";
 my $authfile = "/etc/corosync/authkey";
 
+sub read_password {
+    my $term = new Term::ReadLine ('pvecm');
+    my $attribs = $term->Attribs;
+    $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
+    my $input = $term->readline('Enter password: ');
+    return $input;
+}
+
+sub api2_post {
+    my ($agent, $host, $path, $param) = @_;
+
+    my $uri = URI->new();
+    $uri->scheme('https');
+    $uri->host($host);
+    $uri->port(8006);
+    $uri->path("/api2/json/$path");
+
+    my $response = $agent->post($uri, $param);
+
+    my $ct = $response->header('Content-Type') || '';
+
+    if ($response->is_success) {
+	die "got unexpected content type" if $ct !~ m|application/json|;
+	my $res = from_json($response->decoded_content, {utf8 => 1});
+	my $data = $res->{data};
+
+	if ($path eq "access/ticket") {
+	    my $csrf = $data->{CSRFPreventionToken};
+	    my $ticket = $data->{ticket};
+	    my $encticket = uri_escape($ticket);
+	    my $cookie = "PVEAuthCookie=$encticket; path=/; secure;";
+	    $agent->default_header('CSRFPreventionToken' => $csrf);
+	    $agent->default_header('Cookie', $cookie);
+	}
+
+	return $data;
+    }
+
+    my $msg = $response->status_line . "\n";
+    eval {
+	return if $ct !~ m|application/json|;
+	my $res = from_json($response->decoded_content, {utf8 => 1});
+	if (my $errors = $res->{errors}) {
+	    foreach my $key (keys %$errors) {
+		my $m = $errors->{$key};
+		chomp($m);
+		$m =~s/\n/ -- /g;
+		$msg .= " $key: $m\n";
+	    }
+	}
+    };
+    die $msg;
+}
+
+sub manual_verify_fingerprint {
+    my ($host, $fingerprint) = @_;
+
+    print "The authenticity of host '$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 = <>;
+
+    return 1 if $answer =~m/^\s*yes\s*$/i;
+
+    return 0;
+}
+
+my $fingerprint;
+my $fingerprint_verified;
+
+sub api2_connect {
+    my ($host, $password) = @_;
+
+    my $ssl_verify_callback = sub {
+	my (undef, undef, undef, undef, $cert, $depth) = @_;
+
+	# we don't care about intermediate or root certificates
+	return 1 if $depth != 0;
+
+	# check server certificate against cache of pinned FPs
+	# get fingerprint of server certificate
+	my $fp;
+	eval {
+	    $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
+	};
+	return 0 if $@ || !defined($fp) || $fp eq ''; # error
+
+	if ($fingerprint_verified && $fingerprint && ($fp eq $fingerprint)) {
+	    return 1;
+	}
+
+	if (PVE::Cluster::check_cert_fingerprint($cert)) {
+	    $fingerprint = $fp;
+	    $fingerprint_verified = 1;
+	    return 1;
+	}
+
+	if (!$fingerprint) {
+	    $fingerprint = $fp;
+	    return 0;
+	}
+	$fingerprint = $fp;
+
+	return 0;
+    };
+
+    my $agent = LWP::UserAgent->new(
+	keep_alive => 10,
+	protocols_allowed => [ 'https'],
+	ssl_opts => {
+	    verify_hostname => 0,
+	    SSL_verify_mode => SSL_VERIFY_PEER,
+	    SSL_verify_callback => $ssl_verify_callback,
+	},
+	timeout => 60);
+
+    $agent->default_header('Accept-Encoding' => 'gzip'); # allow gzip
+
+    eval {
+	api2_post($agent, $host, "access/ticket", {
+	    username => 'root at pam', password => $password });
+    };
+    if (my $err = $@) {
+	die $err if !$fingerprint || $fingerprint_verified;
+	if (manual_verify_fingerprint($host, $fingerprint)) {
+	    $fingerprint_verified = 1;
+	    api2_post($agent, $host, "access/ticket", {
+		username => 'root at pam', password => $password });
+	} else {
+	    die $err;
+	}
+    }
+
+    return $agent;
+}
+
 sub backup_database {
 
     print "backup old database\n";
diff --git a/debian/control b/debian/control
index 73a6146..7339664 100644
--- a/debian/control
+++ b/debian/control
@@ -8,7 +8,7 @@ Standards-Version: 3.7.3
 Package: pve-cluster
 Architecture: any
 Pre-Depends: ${misc:Pre-Depends}
-Depends: ${shlibs:Depends}, ${misc:Depends}, ${perl:Depends}, perlapi-5.20.0, rsync, libsqlite3-0, sqlite3, libfuse2 (>= 2.9.2-4), fuse, corosync-pve (>= 2.3.4-1), libqb0 (>= 0.17.1-1), libpve-common-perl, libglib2.0-0 (>= 2.42.1-1), rsyslog, openssl, librrd4, librrds-perl, rrdcached, libdigest-hmac-perl, libxml-parser-perl, systemd, faketime, libcrypt-ssleay-perl
+Depends: ${shlibs:Depends}, ${misc:Depends}, ${perl:Depends}, perlapi-5.20.0, rsync, libsqlite3-0, sqlite3, libfuse2 (>= 2.9.2-4), fuse, corosync-pve (>= 2.3.4-1), libqb0 (>= 0.17.1-1), libpve-common-perl, libglib2.0-0 (>= 2.42.1-1), rsyslog, openssl, librrd4, librrds-perl, rrdcached, libdigest-hmac-perl, libxml-parser-perl, systemd, faketime, libcrypt-ssleay-perl, libio-socket-ssl-perl, liblwp-protocol-https-perl 
 Description: Cluster Infrastructure for Proxmox Virtual Environment
  This package contains the Cluster Infrastructure for the Proxmox
  Virtual Environment, namely a distributed filesystem to store
-- 
2.1.4