PVE/APLInfo.pm

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