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, $aplinfo, $logfd) = @_;
 144
 145     my $aplsrcurl = "$aplinfo->{url}/$aplinfo->{file}.gz";
 146     my $aplsigurl = "$aplinfo->{url}/$aplinfo->{file}.asc";
 147     my $host = $aplinfo->{host};
 148
 149     my $tmp = "$aplinfodir/pveam-${host}.tmp.$$";
 150     my $tmpgz = "$tmp.gz";
 151     my $sigfn = "$tmp.asc";
 152
 153     eval {
 154
 155         if (url_get($ua, $aplsigurl, $sigfn, $logfd) != 0) {
 156             die "update failed - no signature file '$sigfn'\n";
 157         }
 158
 159         if (url_get($ua, $aplsrcurl, $tmpgz, $logfd) != 0) {
 160             die "update failed - no data file '$aplsrcurl'\n";
 161         }
 162
 163        eval { run_command(["gunzip", "-f", $tmpgz]) };
 164        die "update failed: unable to unpack '$tmpgz'\n" if $@;
 165
 166         # verify signature
 167         my $trustedkeyring = "/usr/share/doc/pve-manager/trustedkeys.gpg";
 168         my $cmd = "/usr/bin/gpgv -q --keyring $trustedkeyring $sigfn $tmp";
 169
 170         my $logfunc = sub { logmsg($logfd, "signature verification: $_[0]"); };
 171         eval {
 172             run_command($cmd, outfunc => $logfunc, errfunc => $logfunc);
 173         };
 174         die "unable to verify signature - $@\n" if $@;
 175
 176         # test syntax
 177         eval { read_aplinfo($tmp, {}, $aplinfo->{url}, 1) };
 178         die "update failed: $@" if $@;
 179
 180         rename($tmp, "$aplinfodir/$host") or
 181             die "update failed: unable to store data: $!\n";
 182
 183         logmsg($logfd, "update successful");
 184     };
 185
 186     my $err = $@;
 187
 188     unlink $tmp;
 189     unlink $tmpgz;
 190     unlink $sigfn;
 191
 192     die $err if $err;
 193 }
 194
 195 sub get_apl_sources {
 196     my $sources = [
 197         {
 198             host => "download.proxmox.com",
 199             url => "http://download.proxmox.com/images",
 200             file => 'aplinfo.dat',
 201         },
 202         {
 203             host => "releases.turnkeylinux.org",
 204             url => "https://releases.turnkeylinux.org/pve",
 205             file => 'aplinfo.dat',
 206         },
 207     ];
 208
 209     return $sources;
 210 }
 211
 212 sub update {
 213     my ($proxy) = @_;
 214
 215     my $size;
 216     if (($size = (-s $logfile) || 0) > (1024*50)) {
 217         rename($logfile, "$logfile.0");
 218     }
 219     my $logfd = IO::File->new (">>$logfile");
 220     logmsg($logfd, "starting update");
 221
 222     my $ua = LWP::UserAgent->new;
 223     my $release = PVE::pvecfg::release();
 224     $ua->agent("PVE/$release");
 225
 226     if ($proxy) {
 227         $ua->proxy(['http', 'https'], $proxy);
 228     } else {
 229         $ua->env_proxy;
 230     }
 231
 232     my $sources = get_apl_sources();
 233
 234     mkdir $aplinfodir;
 235
 236     my @dlerr = ();
 237     foreach my $info (@$sources) {
 238         eval {
 239             download_aplinfo($ua, $info, $logfd);
 240         };
 241         if (my $err = $@) {
 242             logmsg ($logfd, $err);
 243             push @dlerr, $info->{url};
 244         }
 245     }
 246
 247     close($logfd);
 248
 249     return 0 if scalar(@dlerr);
 250
 251     return 1;
 252 }
 253
 254 sub load_data {
 255
 256    my $sources = get_apl_sources();
 257
 258     my $list = {};
 259     foreach my $info (@$sources) {
 260         eval {
 261             my $host = $info->{host};
 262             read_aplinfo("$aplinfodir/$host", $list, $info->{url});
 263         };
 264         warn $@ if $@;
 265     }
 266
 267     return $list;
 268 }
 269
 270 1;
 271