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 sub two_factor_auth_login
{
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!");
116 my $uri = URI-
>new();
117 $uri->scheme($self->{protocol
});
118 $uri->host($self->{host
});
119 $uri->port($self->{port
});
120 $uri->path('/api2/json/access/ticket');
122 my $ua = $self->{useragent
};
123 my $username = $self->{username
} // 'unknown',
125 delete $self->{fingerprint
}->{last_unknown
};
127 my $exec_login = sub {
128 return $ua->post($uri, {
129 username
=> $username,
130 password
=> $self->{password
} || ''
134 my $response = $exec_login->();
136 if (!$response->is_success) {
137 if (my $fp = delete($self->{fingerprint
}->{last_unknown
})) {
138 if ($self->manual_verify_fingerprint($fp)) {
139 $response = $exec_login->(); # try again
144 if (!$response->is_success) {
145 raise
($response->status_line ."\n", code
=> $response->code)
148 my $res = from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
150 my $data = $extract_data->($res);
151 $self->update_ticket($data->{ticket
});
152 $self->update_csrftoken($data->{CSRFPreventionToken
});
154 # handle two-factor login
155 my $tfa_ticket_re = qr/^([^\s!]+)![^!]*(!([0-9a-zA-Z\/.=_\
-+]+))?
$/;
156 if ($data->{ticket
} =~ m/$tfa_ticket_re/) {
157 my ($type, $challenge) = ($1, $2);
158 $data = $self->two_factor_auth_login($type, $challenge);
159 $self->update_ticket($data->{ticket
});
165 sub manual_verify_fingerprint
{
166 my ($self, $fingerprint) = @_;
168 if (!$self->{manual_verification
}) {
169 raise
("fingerprint '$fingerprint' not verified, abort!\n");
172 print "The authenticity of host '$self->{host}' can't be established.\n" .
173 "X509 SHA256 key fingerprint is $fingerprint.\n" .
174 "Are you sure you want to continue connecting (yes/no)? ";
176 my $answer = <STDIN
>;
178 my $valid = ($answer =~ m/^\s*yes\s*$/i) ?
1 : 0;
180 $self->{fingerprint
}->{cache
}->{$fingerprint} = $valid;
182 raise
("Fingerprint not verified, abort!\n") if !$valid;
184 if (my $cb = $self->{register_fingerprint_cb
}) {
185 $cb->($fingerprint) if $valid;
192 my ($self, $method, $path, $param) = @_;
194 delete $self->{fingerprint
}->{last_unknown
};
196 my $ticket = $self->{ticket
};
197 my $apitoken = $self->{apitoken
};
199 my $ua = $self->{useragent
};
201 # fixme: check ticket lifetime?
203 if (!$ticket && !$apitoken && $self->{username
} && $self->{password
}) {
207 my $uri = URI-
>new();
208 $uri->scheme($self->{protocol
});
209 $uri->host($self->{host
});
210 $uri->port($self->{port
});
214 if ($path !~ m!^api2/!) {
215 $uri->path("api2/json/$path");
220 #print "CALL $method : " . $uri->as_string() . "\n";
222 my $exec_method = sub {
225 if ($method eq 'GET') {
226 $uri->query_form($param);
227 $response = $ua->request(HTTP
::Request
::Common
::GET
($uri));
228 } elsif ($method eq 'POST') {
229 $response = $ua->request(HTTP
::Request
::Common
::POST
($uri, Content
=> $param));
230 } elsif ($method eq 'PUT') {
231 # We use another temporary URI object to format
232 # the application/x-www-form-urlencoded content.
234 my $tmpurl = URI-
>new('http:');
235 $tmpurl->query_form(%$param);
236 my $content = $tmpurl->query;
238 $response = $ua->request(HTTP
::Request
::Common
::PUT
($uri, 'Content-Type' => 'application/x-www-form-urlencoded', Content
=> $content));
240 } elsif ($method eq 'DELETE') {
241 $response = $ua->request(HTTP
::Request
::Common
::DELETE
($uri));
243 raise
("method $method not implemented\n");
248 my $response = $exec_method->();
250 if (my $fp = delete($self->{fingerprint
}->{last_unknown
})) {
251 if ($self->manual_verify_fingerprint($fp)) {
252 $response = $exec_method->(); # try again
256 my $ct = $response->header('Content-Type') || '';
258 if ($response->is_success) {
260 raise
("got unexpected content type", code
=> $response->code)
261 if $ct !~ m
|application
/json
|;
263 return from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
267 my $msg = $response->message;
269 return if $ct !~ m
|application
/json
|;
270 my $res = from_json
($response->decoded_content, {utf8
=> 1, allow_nonref
=> 1});
271 return $res->{errors
};
274 raise
("$msg\n", code
=> $response->code, errors
=> $errors);
278 my sub verify_cert_callback
{
279 my ($fingerprint, $cert, $verify_cb) = @_;
281 # check server certificate against cache of pinned FPs
282 # get fingerprint of server certificate
283 my $fp = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
284 return 0 if !defined($fp) || $fp eq ''; # error
286 my $valid = $fingerprint->{cache
}->{$fp};
287 return $valid if defined($valid); # return cached result
290 $valid = $verify_cb->($cert);
291 $fingerprint->{cache
}->{$fp} = $valid;
295 $fingerprint->{last_unknown
} = $fp;
301 my ($class, %param) = @_;
303 my $ssl_default_opts = { verify_hostname
=> 0 };
304 my $ssl_opts = $param{ssl_opts
} || $ssl_default_opts;
307 username
=> $param{username
},
308 password
=> $param{password
},
309 host
=> $param{host
} || 'localhost',
310 port
=> $param{port
},
311 protocol
=> $param{protocol
},
312 cookie_name
=> $param{cookie_name
} // 'PVEAuthCookie',
313 manual_verification
=> $param{manual_verification
},
315 cache
=> $param{cached_fingerprints
} || {},
316 last_unknown
=> undef,
318 register_fingerprint_cb
=> $param{register_fingerprint_cb
},
319 timeout
=> $param{timeout
} || 60,
323 if (!$ssl_opts->{SSL_verify_callback
}) {
324 $ssl_opts->{'SSL_verify_mode'} = SSL_VERIFY_PEER
;
326 my $fingerprints = $self->{fingerprint
}; # avoid passing $self, that's a RC cycle!
327 my $verify_fingerprint_cb = $param{verify_fingerprint_cb
};
328 $ssl_opts->{'SSL_verify_callback'} = sub {
329 my (undef, undef, undef, undef, $cert, $depth) = @_;
331 # we don't care about intermediate or root certificates
332 return 1 if $depth != 0;
334 return verify_cert_callback
($fingerprints, $cert, $verify_fingerprint_cb);
338 if (!$self->{port
}) {
339 $self->{port
} = $self->{host
} eq 'localhost' ?
85 : 8006;
341 if (!$self->{protocol
}) {
342 $self->{protocol
} = $self->{host
} eq 'localhost' ?
'http' : 'https';
345 $self->{useragent
} = LWP
::UserAgent-
>new(
346 protocols_allowed
=> [ 'http', 'https'],
347 ssl_opts
=> $ssl_opts,
348 timeout
=> $self->{timeout
},
349 keep_alive
=> $param{keep_alive
} // 50,
352 $self->{useragent
}->default_header('Accept-Encoding' => 'gzip'); # allow gzip
354 if ($param{apitoken
} && $param{password
}) {
355 warn "password will be ignored in favor of API token\n";
356 delete $self->{password
};
358 if ($param{ticket
}) {
359 if ($param{apitoken
}) {
360 warn "ticket will be ignored in favor of API token\n";
362 $self->update_ticket($param{ticket
});
365 $self->update_csrftoken($param{csrftoken
}) if $param{csrftoken
};
367 if ($param{apitoken
}) {
368 my $agent = $self->{useragent
};
370 $self->{apitoken
} = $param{apitoken
};
372 $agent->default_header('Authorization', $param{apitoken
});