PVE/APIClient/LWP.pm

   1 package PVE::APIClient::LWP;
   2
   3 use strict;
   4 use warnings;
   5 use URI;
   6 use IO::Socket::SSL; # important for SSL_verify_callback
   7 use LWP::UserAgent;
   8 use URI::Escape;
   9 use Net::SSLeay;
  10 use JSON;
  11 use Data::Dumper; # fixme: remove
  12 use HTTP::Request::Common;
  13 use Carp;
  14
  15 my $extract_data = sub {
  16     my ($res) = @_;
  17
  18     croak "undefined result" if !defined($res);
  19     croak "undefined result data" if !exists($res->{data});
  20
  21     return $res->{data};
  22 };
  23
  24 sub get_raw {
  25     my ($self, $path, $param) = @_;
  26
  27     return $self->call('GET', $path, $param);
  28 }
  29
  30 sub get {
  31     my ($self, $path, $param) = @_;
  32
  33     return $extract_data->($self->call('GET', $path, $param));
  34 }
  35
  36 sub post_raw {
  37     my ($self, $path, $param) = @_;
  38
  39     return $self->call('POST', $path, $param);
  40 }
  41
  42 sub post {
  43     my ($self, $path, $param) = @_;
  44
  45     return $extract_data->($self->call('POST', $path, $param));
  46 }
  47
  48 sub put_raw {
  49     my ($self, $path, $param) = @_;
  50
  51     return $self->call('PUT', $path, $param);
  52 }
  53
  54 sub put {
  55     my ($self, $path, $param) = @_;
  56
  57     return $extract_data->($self->call('PUT', $path, $param));
  58 }
  59
  60 sub delete_raw {
  61     my ($self, $path, $param) = @_;
  62
  63     return $self->call('DELETE', $path, $param);
  64 }
  65
  66 sub delete {
  67     my ($self, $path, $param) = @_;
  68
  69     return $extract_data->($self->call('DELETE', $path, $param));
  70 }
  71
  72 sub update_csrftoken {
  73     my ($self, $csrftoken) = @_;
  74
  75     $self->{csrftoken} = $csrftoken;
  76
  77     my $agent = $self->{useragent};
  78
  79     $agent->default_header('CSRFPreventionToken', $self->{csrftoken});
  80 }
  81
  82 sub update_ticket {
  83     my ($self, $ticket) = @_;
  84
  85     my $agent = $self->{useragent};
  86
  87     $self->{ticket} = $ticket;
  88
  89     my $encticket = uri_escape($ticket);
  90     my $cookie = "PVEAuthCookie=$encticket; path=/; secure;";
  91     $agent->default_header('Cookie', $cookie);
  92 }
  93
  94 sub login {
  95     my ($self) = @_;
  96
  97     my $uri = URI->new();
  98     $uri->scheme($self->{protocol});
  99     $uri->host($self->{host});
 100     $uri->port($self->{port});
 101     $uri->path('/api2/json/access/ticket');
 102
 103     my $ua = $self->{useragent};
 104
 105     delete $self->{last_unknown_fingerprint};
 106
 107     my $exec_login = sub {
 108         return $ua->post($uri, {
 109             username => $self->{username} || 'unknown',
 110             password => $self->{password} || ''});
 111     };
 112
 113     my $response = $exec_login->();
 114
 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
 119             }
 120         }
 121     }
 122
 123     if (!$response->is_success) {
 124         die $response->status_line . "\n";
 125     }
 126
 127     my $res = from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
 128
 129     my $data = $extract_data->($res);
 130
 131     $self->update_ticket($data->{ticket});
 132     $self->update_csrftoken($data->{CSRFPreventionToken});
 133
 134     return $data;
 135 }
 136
 137 sub manual_verify_fingerprint {
 138     my ($self, $fingerprint) = @_;
 139
 140     if (!$self->{manual_verification}) {
 141         warn "fingerprint: $fingerprint\n";
 142         return 0;
 143     }
 144
 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)? ";
 148
 149     my $answer = <>;
 150
 151     my $valid = ($answer =~ m/^\s*yes\s*$/i) ? 1 : 0;
 152
 153     $self->{cached_fingerprints}->{$fingerprint} = $valid;
 154
 155     if (my $cb = $self->{register_fingerprint_cb}) {
 156         $cb->($fingerprint) if $valid;
 157     }
 158
 159     return $valid;
 160 }
 161
 162 sub call {
 163     my ($self, $method, $path, $param) = @_;
 164
 165     delete $self->{last_unknown_fingerprint};
 166
 167     my $ticket = $self->{ticket};
 168
 169     my $ua = $self->{useragent};
 170
 171     # fixme: check ticket lifetime?
 172
 173     if (!$ticket && $self->{username} && $self->{password}) {
 174         $self->login();
 175     }
 176
 177     my $uri = URI->new();
 178     $uri->scheme($self->{protocol});
 179     $uri->host($self->{host});
 180     $uri->port($self->{port});
 181
 182     $path =~ s!^/+!!;
 183
 184     if ($path !~ m!^api2/!) {
 185         $uri->path("api2/json/$path");
 186     } else {
 187         $uri->path($path);
 188     }
 189
 190     #print "CALL $method : " .  $uri->as_string() . "\n";
 191
 192     my $exec_method = sub {
 193
 194         my $response;
 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.
 203
 204             my $tmpurl = URI->new('http:');
 205             $tmpurl->query_form(%$param);
 206             my $content = $tmpurl->query;
 207
 208             $response = $ua->request(HTTP::Request::Common::PUT($uri, 'Content-Type' => 'application/x-www-form-urlencoded', Content => $content));
 209
 210         } elsif ($method eq 'DELETE') {
 211             $response = $ua->request(HTTP::Request::Common::DELETE($uri));
 212         } else {
 213             die "method $method not implemented\n";
 214         }
 215         return $response;
 216     };
 217
 218     my $response = $exec_method->();
 219
 220     if (my $fp = delete($self->{last_unknown_fingerprint})) {
 221         if ($self->manual_verify_fingerprint($fp)) {
 222             $response = $exec_method->(); # try again
 223         }
 224     }
 225
 226     #print "RESP: " . Dumper($response) . "\n";
 227
 228     my $ct = $response->header('Content-Type') || '';
 229
 230     if ($response->is_success) {
 231
 232         die "got unexpected content type" if $ct !~ m|application/json|;
 233
 234         return from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
 235
 236     } else {
 237
 238         my $msg = $response->status_line . "\n";
 239         eval {
 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};
 245                     chomp($m);
 246                     $m =~s/\n/ -- /g;
 247                     $msg .= " $key: $m\n";
 248                 }
 249             }
 250         };
 251         die $msg;
 252
 253     }
 254 }
 255
 256 my $verify_cert_callback = sub {
 257     my ($self, $cert) = @_;
 258
 259     # check server certificate against cache of pinned FPs
 260     # get fingerprint of server certificate
 261     my $fp;
 262     eval {
 263         $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
 264     };
 265     return 0 if $@ || !defined($fp) || $fp eq ''; # error
 266
 267     my $valid = $self->{cached_fingerprints}->{$fp};
 268     return $valid if defined($valid); # return cached result
 269
 270     if (my $cb = $self->{verify_fingerprint_cb}) {
 271         $valid = $cb->($cert);
 272         $self->{cached_fingerprints}->{$fp} = $valid;
 273         return $valid;
 274     }
 275
 276     $self->{last_unknown_fingerprint} = $fp;
 277
 278     return 0;
 279 };
 280
 281 sub new {
 282     my ($class, %param) = @_;
 283
 284     my $ssl_default_opts = { verify_hostname => 0 };
 285     my $ssl_opts = $param{ssl_opts} || $ssl_default_opts;
 286
 287     my $self = {
 288         username => $param{username},
 289         password => $param{password},
 290         host => $param{host} || 'localhost',
 291         port => $param{port},
 292         protocol => $param{protocol},
 293         manual_verification => $param{manual_verification},
 294         cached_fingerprints => $param{cached_fingerprints} || {},
 295         verify_fingerprint_cb => $param{verify_fingerprint_cb},
 296         register_fingerprint_cb => $param{register_fingerprint_cb},
 297         ssl_opts => $ssl_opts,
 298         timeout => $param{timeout} || 60,
 299     };
 300     bless $self;
 301
 302     if (!$ssl_opts->{SSL_verify_callback}) {
 303         $ssl_opts->{'SSL_verify_mode'} = SSL_VERIFY_PEER;
 304         $ssl_opts->{'SSL_verify_callback'} = sub {
 305             my (undef, undef, undef, undef, $cert, $depth) = @_;
 306
 307             # we don't care about intermediate or root certificates
 308             return 1 if $depth != 0;
 309
 310             return $verify_cert_callback->($self, $cert);
 311         }
 312     }
 313
 314     if (!$self->{port}) {
 315         $self->{port} = $self->{host} eq 'localhost' ? 85 : 8006;
 316     }
 317     if (!$self->{protocol}) {
 318         $self->{protocol} = $self->{host} eq 'localhost' ? 'http' : 'https';
 319     }
 320
 321     $self->{useragent} = LWP::UserAgent->new(
 322         protocols_allowed => [ 'http', 'https'],
 323         ssl_opts => $ssl_opts,
 324         timeout => $self->{timeout},
 325         keep_alive => $param{keep_alive} // 50,
 326         );
 327
 328     $self->{useragent}->default_header('Accept-Encoding' => 'gzip'); # allow gzip
 329
 330     $self->update_ticket($param{ticket}) if $param{ticket};
 331     $self->update_csrftoken($param{csrftoken}) if $param{csrftoken};
 332
 333
 334     return $self;
 335 }
 336
 337 1;