PVE/APLInfo.pm

   1 package PVE::APLInfo;
   2
   3 use strict;
   4 use warnings;
   5
   6 use IO::File;
   7 use LWP::UserAgent;
   8 use POSIX qw(strftime);
   9
  10 use PVE::SafeSyslog;
  11 use PVE::Tools qw(run_command);
  12 use PVE::pvecfg;
  13
  14 my $logfile = "/var/log/pveam.log";
  15 my $aplinfodir = "/var/lib/pve-manager/apl-info";
  16
  17 sub logmsg {
  18     my ($logfd, $msg) = @_;
  19
  20     chomp $msg;
  21
  22     my $tstr = strftime ("%F %H:%M:%S", localtime);
  23
  24     foreach my $line (split (/\n/, $msg)) {
  25         print $logfd "$tstr $line\n";
  26     }
  27 }
  28
  29 sub read_aplinfo_from_fh {
  30     my ($fh, $list, $source, $update) = @_;
  31
  32     local $/ = "";
  33
  34     while (my $rec = <$fh>) {
  35         chomp $rec;
  36
  37         my $res = {};
  38
  39         while ($rec) {
  40
  41             if ($rec =~ s/^Description:\s*([^\n]*)(\n\s+.*)*$//si) {
  42                 $res->{headline} = $1;
  43                 my $long = $2 || '';
  44                 $long =~ s/\n\s+/ /g;
  45                 $long =~ s/^\s+//g;
  46                 $long =~ s/\s+$//g;
  47                 $res->{description} = $long;
  48             } elsif ($rec =~ s/^Version:\s*(.*\S)\s*\n//i) {
  49                 my $version = $1;
  50                 if ($version =~ m/^(\d[a-zA-Z0-9\.\+\-\:\~]*)(-(\d+))?$/) {
  51                     $res->{version} = $version;
  52                 } else {
  53                     my $msg = "unable to parse appliance record: version = '$version'\n";
  54                     $update ? die $msg : warn $msg;
  55                 }
  56             } elsif ($rec =~ s/^Type:\s*(.*\S)\s*\n//i) {
  57                 my $type = $1;
  58                 if ($type =~ m/^(openvz|lxc)$/) {
  59                     $res->{type} = $type;
  60                 } else {
  61                     my $msg = "unable to parse appliance record: unknown type '$type'\n";
  62                     $update ? die $msg : warn $msg;
  63                 }
  64             } elsif ($rec =~ s/^([^:]+):\s*(.*\S)\s*\n//) {
  65                 $res->{lc $1} = $2;
  66             } else {
  67                 my $msg = "unable to parse appliance record: $rec\n";
  68                 $update ? die $msg : warn $msg;
  69                 $res = {};
  70                 last;
  71             }
  72         }
  73
  74         if ($res->{'package'} eq 'pve-web-news' && $res->{description}) {
  75             $list->{'all'}->{$res->{'package'}} = $res;
  76             next;
  77         }
  78
  79         $res->{section} = 'unknown' if !$res->{section};
  80
  81         if ($res->{'package'} && $res->{type} && $res->{os} && $res->{version} &&
  82             $res->{infopage}) {
  83             my $template;
  84             if ($res->{location}) {
  85                 $template = $res->{location};
  86                 $template =~ s|.*/([^/]+.tar.[gx]z)$|$1|;
  87                 if ($res->{location} !~ m|^([a-zA-Z]+)\://|) {
  88                     # relative localtion (no http:// prefix)
  89                     $res->{location} = "$source/$res->{location}";
  90                 }
  91             } else {
  92                 my $arch = $res->{architecture} || 'i386';
  93                 $template = "$res->{os}-$res->{package}_$res->{version}_$arch.tar.gz";
  94                 $template =~ s/$res->{os}-$res->{os}-/$res->{os}-/;
  95                 $res->{location} = "$source/$res->{section}/$template";
  96             }
  97             $res->{source} = $source;
  98             $res->{template} = $template;
  99             $list->{$res->{section}}->{$template} = $res;
 100             $list->{'all'}->{$template} = $res;
 101         } else {
 102             my $msg = "found incomplete appliance records\n";
 103             $update ? die $msg : warn $msg;
 104         }
 105     }
 106 }
 107
 108 sub read_aplinfo {
 109     my ($filename, $list, $source, $update) = @_;
 110
 111     my $fh = IO::File->new("<$filename") ||
 112         die "unable to open file '$filename' - $!\n";
 113
 114     eval { read_aplinfo_from_fh($fh, $list, $source, $update); };
 115     my $err = $@;
 116
 117     close($fh);
 118
 119     die $err if $err;
 120
 121     return $list;
 122 }
 123
 124 sub url_get {
 125     my ($ua, $url, $file, $logfh) = @_;
 126
 127     my $req = HTTP::Request->new(GET => $url);
 128
 129     logmsg ($logfh, "start download $url");
 130     my $res = $ua->request($req, $file);
 131
 132     if ($res->is_success) {
 133         logmsg ($logfh, "download finished: " . $res->status_line);
 134         return 0;
 135     }
 136
 137     logmsg ($logfh, "download failed: " . $res->status_line);
 138
 139     return 1;
 140 }
 141
 142 sub download_aplinfo {
 143     my ($ua, $aplurl, $host, $logfd) = @_;
 144
 145     my $aplsrcurl = "$aplurl/aplinfo.dat.gz";
 146     my $aplsigurl = "$aplurl/aplinfo.dat.asc";
 147
 148     my $tmp = "$aplinfodir/pveam-${host}.tmp.$$";
 149     my $tmpgz = "$tmp.gz";
 150     my $sigfn = "$tmp.asc";
 151
 152     eval {
 153
 154         if (url_get($ua, $aplsigurl, $sigfn, $logfd) != 0) {
 155             die "update failed - no signature file '$sigfn'\n";
 156         }
 157
 158         if (url_get($ua, $aplsrcurl, $tmpgz, $logfd) != 0) {
 159             die "update failed - no data file '$aplsrcurl'\n";
 160         }
 161
 162        eval { run_command(["gunzip", "-f", $tmpgz]) };
 163        die "update failed: unable to unpack '$tmpgz'\n" if $@;
 164
 165         # verify signature
 166         my $trustedkeyring = "/usr/share/doc/pve-manager/trustedkeys.gpg";
 167         my $cmd = "/usr/bin/gpgv -q --keyring $trustedkeyring $sigfn $tmp";
 168
 169         my $logfunc = sub { logmsg($logfd, "signature verification: $_[0]"); };
 170         eval {
 171             run_command($cmd, outfunc => $logfunc, errfunc => $logfunc);
 172         };
 173         die "unable to verify signature - $@\n" if $@;
 174
 175         # test syntax
 176         eval { read_aplinfo($tmp, {}, $aplurl, 1) };
 177         die "update failed: $@" if $@;
 178
 179         rename($tmp, "$aplinfodir/$host") or
 180             die "update failed: unable to store data: $!\n";
 181
 182         logmsg($logfd, "update successful");
 183     };
 184
 185     my $err = $@;
 186
 187     unlink $tmp;
 188     unlink $tmpgz;
 189     unlink $sigfn;
 190
 191     die $err if $err;
 192 }
 193
 194 sub get_apl_sources {
 195
 196     my $urls = [];
 197     push @$urls, "http://download.proxmox.com/images";
 198     push @$urls, "https://releases.turnkeylinux.org/pve";
 199
 200     return $urls;
 201 }
 202
 203 sub update {
 204     my ($proxy) = @_;
 205
 206     my $size;
 207     if (($size = (-s $logfile) || 0) > (1024*50)) {
 208         rename($logfile, "$logfile.0");
 209     }
 210     my $logfd = IO::File->new (">>$logfile");
 211     logmsg($logfd, "starting update");
 212
 213     my $ua = LWP::UserAgent->new;
 214     my $release = PVE::pvecfg::release();
 215     $ua->agent("PVE/$release");
 216
 217     if ($proxy) {
 218         $ua->proxy(['http', 'https'], $proxy);
 219     } else {
 220         $ua->env_proxy;
 221     }
 222
 223     my $urls = get_apl_sources();
 224
 225     mkdir $aplinfodir;
 226
 227     my @dlerr = ();
 228     foreach my $aplurl (@$urls) {
 229         eval {
 230             my $uri = URI->new($aplurl);
 231             my $host = $uri->host();
 232             download_aplinfo($ua, $aplurl, $host, $logfd);
 233         };
 234         if (my $err = $@) {
 235             logmsg ($logfd, $err);
 236             push @dlerr, $aplurl;
 237         }
 238     }
 239
 240     close($logfd);
 241
 242     return 0 if scalar(@dlerr);
 243
 244     return 1;
 245 }
 246
 247 sub load_data {
 248
 249    my $urls = get_apl_sources();
 250
 251     my $list = {};
 252
 253     foreach my $aplurl (@$urls) {
 254
 255         eval {
 256
 257             my $uri = URI->new($aplurl);
 258             my $host = $uri->host();
 259             read_aplinfo("$aplinfodir/$host", $list, $aplurl);
 260         };
 261         warn $@ if $@;
 262     }
 263
 264     return $list;
 265 }
 266
 267 1;
 268