PVE/API2Client.pm

   1 package PVE::API2Client;
   2
   3 use strict;
   4 use warnings;
   5 use URI;
   6 use HTTP::Cookies;
   7 use LWP::UserAgent;
   8 use JSON;
   9 use PVE::API2;
  10 use Data::Dumper; # fixme: remove
  11 use HTTP::Request::Common;
  12
  13 sub get {
  14     my ($self, $path, $param) = @_;
  15
  16     return $self->call('GET', $path, $param);
  17 }
  18
  19 sub post {
  20     my ($self, $path, $param) = @_;
  21
  22     return $self->call('POST', $path, $param);
  23 }
  24
  25 sub put {
  26     my ($self, $path, $param) = @_;
  27
  28     return $self->call('PUT', $path, $param);
  29 }
  30
  31 sub delete {
  32     my ($self, $path, $param) = @_;
  33
  34     return $self->call('DELETE', $path, $param);
  35 }
  36
  37 sub update_ticket {
  38     my ($self, $ticket) = @_;
  39
  40     my $domain = "$self->{host}.local" unless  $self->{host} =~ /\./;
  41     $self->{cookie_jar}->set_cookie(0, 'PVEAuthCookie', $ticket, '/', $domain);
  42 }
  43
  44 sub call {
  45     my ($self, $method, $path, $param) = @_;
  46
  47     #print "wrapper called\n";
  48
  49     my $ticket;
  50
  51     my $ua = $self->{useragent};
  52     my $cj = $self->{cookie_jar};
  53
  54     $cj->scan(sub {
  55         my ($version, $key, $val) = @_;
  56         $ticket = $val if $key eq 'PVEAuthCookie';
  57     });
  58
  59     if (!$ticket && $self->{username} && $self->{password}) {
  60         my $uri = URI->new();
  61         $uri->scheme($self->{protocol});
  62         $uri->host($self->{host});
  63         $uri->port($self->{port});
  64         $uri->path('/api2/json/access/ticket');
  65
  66         my $response = $ua->post($uri, {
  67             username => $self->{username},
  68             password => $self->{password}});
  69
  70         if (!$response->is_success) {
  71             die $response->status_line . "\n";
  72         }
  73
  74         my $data = from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
  75
  76         $self->update_ticket($data->{data}->{ticket});
  77         $self->{csrftoken} = $data->{data}->{CSRFPreventionToken};
  78     }
  79
  80     my $uri = URI->new();
  81     $uri->scheme($self->{protocol});
  82     $uri->host($self->{host});
  83     $uri->port($self->{port});
  84     $uri->path($path);
  85
  86     # print $ua->{cookie_jar}->as_string;
  87
  88     #print "CALL $method : " .  $uri->as_string() . "\n";
  89
  90     if ($self->{csrftoken}) {
  91         $self->{useragent}->default_header('CSRFPreventionToken' => $self->{csrftoken});
  92     }
  93
  94     my $response;
  95     if ($method eq 'GET') {
  96         $uri->query_form($param);
  97         $response = $ua->request(HTTP::Request::Common::GET($uri));
  98     } elsif ($method eq 'POST') {
  99         $response = $ua->request(HTTP::Request::Common::POST($uri, Content => $param));
 100     } elsif ($method eq 'PUT') {
 101         # We use another temporary URI object to format
 102         # the application/x-www-form-urlencoded content.
 103
 104         my $tmpurl = URI->new('http:');
 105         $tmpurl->query_form(%$param);
 106         my $content = $tmpurl->query;
 107
 108         $response = $ua->request(HTTP::Request::Common::PUT($uri, 'Content-Type' => 'application/x-www-form-urlencoded', Content => $content));
 109
 110     } elsif ($method eq 'DELETE') {
 111         $response = $ua->request(HTTP::Request::Common::DELETE($uri));
 112     } else {
 113         die "method $method not implemented\n";
 114     }
 115
 116     #print "RESP: " . Dumper($response) . "\n";
 117
 118     my $ct = $response->header('Content-Type') || '';
 119
 120     if ($response->is_success) {
 121
 122         die "got unexpected content type" if $ct !~ m|application/json|;
 123
 124         return from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
 125
 126     } else {
 127
 128         my $msg = $response->status_line . "\n";
 129         eval {
 130             return if $ct !~ m|application/json|;
 131             my $res = from_json($response->decoded_content, {utf8 => 1, allow_nonref => 1});
 132             if (my $errors = $res->{errors}) {
 133                 foreach my $key (keys $errors) {
 134                     my $m = $errors->{$key};
 135                     chomp($m);
 136                     $m =~s/\n/ -- /g;
 137                     $msg .= " $key: $m\n";
 138                 }
 139             }
 140         };
 141         die $msg;
 142
 143     }
 144 }
 145
 146 sub new {
 147     my ($class, %param) = @_;
 148
 149     my $self = {
 150         ticket => $param{ticket},
 151         csrftoken => $param{csrftoken},
 152         username => $param{username},
 153         password => $param{password},
 154         host => $param{host} || 'localhost',
 155         port => $param{port},
 156         protocol => $param{protocol},
 157         timeout => $param{timeout} || 60,
 158     };
 159     bless $self;
 160
 161     if (!$self->{port}) {
 162         $self->{port} = $self->{host} eq 'localhost' ? 85 : 8006;
 163     }
 164     if (!$self->{protocol}) {
 165         $self->{protocol} = $self->{host} eq 'localhost' ? 'http' : 'https';
 166     }
 167
 168     $self->{cookie_jar} = HTTP::Cookies->new (ignore_discard => 1);
 169
 170     $self->update_ticket($self->{ticket}) if $self->{ticket};
 171
 172     $self->{useragent} = LWP::UserAgent->new(
 173         cookie_jar => $self->{cookie_jar},
 174         protocols_allowed => [ 'http', 'https'],
 175         ssl_opts => { verify_hostname => 0 },
 176         timeout => $self->{timeout},
 177         );
 178
 179     $self->{useragent}->default_header('Accept-Encoding' => 'gzip'); # allow gzip
 180
 181     return $self;
 182 }
 183
 184 1;