src/pakfire/lib/functions.pl

   1 #!/usr/bin/perl -w
   2 ###############################################################################
   3 #                                                                             #
   4 # IPFire.org - A linux based firewall                                         #
   5 # Copyright (C) 2007-2022   IPFire Team   <info@ipfire.org>                   #
   6 #                                                                             #
   7 # This program is free software: you can redistribute it and/or modify        #
   8 # it under the terms of the GNU General Public License as published by        #
   9 # the Free Software Foundation, either version 3 of the License, or           #
  10 # (at your option) any later version.                                         #
  11 #                                                                             #
  12 # This program is distributed in the hope that it will be useful,             #
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of              #
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               #
  15 # GNU General Public License for more details.                                #
  16 #                                                                             #
  17 # You should have received a copy of the GNU General Public License           #
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.       #
  19 #                                                                             #
  20 ###############################################################################
  21
  22 require "/opt/pakfire/etc/pakfire.conf";
  23 require "/var/ipfire/general-functions.pl";
  24
  25 use File::Basename;
  26 use File::Copy;
  27 use LWP::UserAgent;
  28 use HTTP::Response;
  29 use HTTP::Headers;
  30 use HTTP::Message;
  31 use HTTP::Request;
  32 use Net::Ping;
  33 use URI;
  34
  35 use Switch;
  36
  37 package Pakfire;
  38
  39 my @VALID_KEY_FINGERPRINTS = (
  40         # 2018
  41         "3ECA8AA4478208B924BB96206FEF7A8ED713594B",
  42         # 2007
  43         "179740DC4D8C47DC63C099C74BDE364C64D96617",
  44 );
  45
  46 # A small color-hash :D
  47 our %color;
  48         $color{'normal'}      = "\033[0m";
  49         $color{'black'}       = "\033[0;30m";
  50         $color{'darkgrey'}    = "\033[1;30m";
  51         $color{'blue'}        = "\033[0;34m";
  52         $color{'lightblue'}   = "\033[1;34m";
  53         $color{'green'}       = "\033[0;32m";
  54         $color{'lightgreen'}  = "\033[1;32m";
  55         $color{'cyan'}        = "\033[0;36m";
  56         $color{'lightcyan'}   = "\033[1;36m";
  57         $color{'red'}         = "\033[0;31m";
  58         $color{'lightred'}    = "\033[1;31m";
  59         $color{'purple'}      = "\033[0;35m";
  60         $color{'lightpurple'} = "\033[1;35m";
  61         $color{'brown'}       = "\033[0;33m";
  62         $color{'lightgrey'}   = "\033[0;37m";
  63         $color{'yellow'}      = "\033[1;33m";
  64         $color{'white'}       = "\033[1;37m";
  65 our $enable_colors = 1;
  66
  67 my $final_data;
  68 my $total_size;
  69 my $bfile;
  70
  71 my %pakfiresettings = ();
  72 &General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
  73
  74 # Make version
  75 $Conf::version = &make_version();
  76
  77 # Pakfire lock file.
  78 our $lockfile = "/tmp/pakfire_lock";
  79
  80 sub message {
  81         my $message = shift;
  82
  83         logger("$message");
  84         if ( $enable_colors == 1 ) {
  85                 if ("$message" =~ /ERROR/) {
  86                         $message = "$color{'red'}$message$color{'normal'}";
  87                 } elsif ("$message" =~ /INFO/) {
  88                         $message = "$color{'cyan'}$message$color{'normal'}";
  89                 } elsif ("$message" =~ /WARN/) {
  90                         $message = "$color{'yellow'}$message$color{'normal'}";
  91                 } elsif ("$message" =~ /RESV/) {
  92                         $message = "$color{'purple'}$message$color{'normal'}";
  93                 } elsif ("$message" =~ /INST/) {
  94                         $message = "$color{'green'}$message$color{'normal'}";
  95                 } elsif ("$message" =~ /REMV/) {
  96                         $message = "$color{'lightred'}$message$color{'normal'}";
  97                 } elsif ("$message" =~ /UPGR/) {
  98                         $message = "$color{'lightblue'}$message$color{'normal'}";
  99                 }
 100         }
 101         print "$message\n";
 102
 103 }
 104
 105 sub logger {
 106         my $log = shift;
 107         if ($log) {
 108                 #system("echo \"`date`: $log\" >> /var/log/pakfire.log");
 109                 system("logger -t pakfire \"$log\"");
 110         }
 111 }
 112
 113 sub usage {
 114   &Pakfire::message("Usage: pakfire <install|remove> [options] <pak(s)>");
 115   &Pakfire::message("               <update> - Contacts the servers for new lists of paks.");
 116   &Pakfire::message("               <upgrade> - Installs the latest version of all paks.");
 117   &Pakfire::message("               <list> [installed/notinstalled/upgrade] - Outputs a list with all, installed, available or upgradeable paks.");
 118   &Pakfire::message("               <info> <pak> [<pak> ...] - Output pak metadata.");
 119   &Pakfire::message("               <status> - Outputs a summary about available core upgrades, updates and a required reboot");
 120   &Pakfire::message("");
 121   &Pakfire::message("       Global options:");
 122   &Pakfire::message("               --non-interactive --> Enables the non-interactive mode.");
 123   &Pakfire::message("                                     You won't see any question here.");
 124   &Pakfire::message("                              -y --> Short for --non-interactive.");
 125   &Pakfire::message("                     --no-colors --> Turns off the wonderful colors.");
 126   &Pakfire::message("");
 127   exit 1;
 128 }
 129
 130 sub fetchfile {
 131         my $getfile = shift;
 132         my $gethost = shift;
 133         my (@server, $host, $proto, $file, $i);
 134         my $allok = 0;
 135
 136         use File::Basename;
 137         $bfile = basename("$getfile");
 138
 139         logger("DOWNLOAD STARTED: $getfile");
 140
 141         $i = 0;
 142         while (($allok == 0) && $i < 5) {
 143                 $i++;
 144
 145                 if ("$gethost" eq "") {
 146                         @server = selectmirror();
 147                         $proto = $server[0];
 148                         $host = $server[1];
 149                         $file = "$server[2]/$getfile";
 150                 } else {
 151                         $host = $gethost;
 152                         $file = $getfile;
 153                 }
 154
 155                 $proto = "HTTPS" unless $proto;
 156
 157                 logger("DOWNLOAD INFO: Host: $host ($proto) - File: $file");
 158
 159                 # Init LWP::UserAgent, request SSL hostname verification
 160                 # and specify CA file.
 161                 my $ua = LWP::UserAgent->new(
 162                         ssl_opts => {
 163                                 SSL_ca_file     => '/etc/ssl/cert.pem',
 164                                 verify_hostname => 1,
 165                         }
 166                 );
 167                 $ua->agent("Pakfire/$Conf::version");
 168                 $ua->timeout(20);
 169
 170                 my %proxysettings=();
 171                 &General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings);
 172
 173                 if ($proxysettings{'UPSTREAM_PROXY'}) {
 174                         logger("DOWNLOAD INFO: Upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\"");
 175                         if ($proxysettings{'UPSTREAM_USER'}) {
 176                                 $ua->proxy(["http", "https"], "http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/");
 177                                 logger("DOWNLOAD INFO: Logging in with \"$proxysettings{'UPSTREAM_USER'}\" against \"$proxysettings{'UPSTREAM_PROXY'}\"");
 178                         } else {
 179                                 $ua->proxy(["http", "https"], "http://$proxysettings{'UPSTREAM_PROXY'}/");
 180                         }
 181                 }
 182
 183                 $final_data = undef;
 184
 185                 my $url;
 186                 switch ($proto) {
 187                         case "HTTP" { $url = "http://$host/$file"; }
 188                         case "HTTPS" { $url = "https://$host/$file"; }
 189                         else {
 190                                 # skip all lines with unknown protocols
 191                                 logger("DOWNLOAD WARNING: Skipping Host: $host due to unknown protocol ($proto) in mirror database");
 192                                 next;
 193                         }
 194                 }
 195
 196                 my $result = $ua->head($url);
 197                 my $remote_headers = $result->headers;
 198                 $total_size = $remote_headers->content_length;
 199                 logger("DOWNLOAD INFO: $file has size of $total_size bytes");
 200
 201                 my $response = $ua->get($url, ':content_cb' => \&callback );
 202                 message("");
 203
 204                 my $code = $response->code();
 205                 my $log = $response->status_line;
 206                 logger("DOWNLOAD INFO: HTTP-Status-Code: $code - $log");
 207
 208                 if ( $code eq "500" ) {
 209                         message("Giving up: There was no chance to get the file \"$getfile\" from any available server.\nThere was an error on the way. Please fix it.");
 210                         return 0;
 211                 }
 212
 213                 if ($response->is_success) {
 214                         if (open(FILE, ">$Conf::tmpdir/$bfile")) {
 215                                 print FILE $final_data;
 216                                 close(FILE);
 217                                 logger("DOWNLOAD INFO: File received. Start checking signature...");
 218                                 if (&valid_signature("$Conf::tmpdir/$bfile")) {
 219                                         logger("DOWNLOAD INFO: Signature of $bfile is fine.");
 220                                         move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile");
 221                                 } else {
 222                                         message("DOWNLOAD ERROR: The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting...");
 223                                         my $ntp = `ntpdate -q -t 10 pool.ntp.org 2>/dev/null | tail -1`;
 224                                         if ( $ntp !~ /time\ server(.*)offset(.*)/ ){message("TIME ERROR: Unable to get the nettime, this may lead to the verification error.");}
 225                                         else { $ntp =~ /time\ server(.*)offset(.*)/; message("TIME INFO: Time Server$1has$2 offset to localtime.");}
 226                                         exit 1;
 227                                 }
 228                                 logger("DOWNLOAD FINISHED: $file");
 229                                 $allok = 1;
 230                                 return 1;
 231                         } else {
 232                                 logger("DOWNLOAD ERROR: Could not open $Conf::tmpdir/$bfile for writing.");
 233                         }
 234                 } else {
 235                         logger("DOWNLOAD ERROR: $log");
 236                 }
 237         }
 238         message("DOWNLOAD ERROR: There was no chance to get the file \"$getfile\" from any available server.\nMay be you should run \"pakfire update\" to get some new servers.");
 239         return 0;
 240 }
 241
 242 sub getmirrors {
 243         my $force = shift;
 244         my $age;
 245
 246         use File::Copy;
 247
 248         if ( -e "$Conf::dbdir/lists/server-list.db" ) {
 249                 my @stat = stat("$Conf::dbdir/lists/server-list.db");
 250                 my $time = time();
 251                 $age = $time - $stat[9];
 252                 $force = "force" if ("$age" >= "3600");
 253                 logger("MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force");
 254         } else {
 255                 # Force an update.
 256                 $force = "force";
 257         }
 258
 259         if ("$force" eq "force") {
 260                 if (fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver")) {
 261                         move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
 262                 } elsif (! -e "$Conf::dbdir/lists/server-list.db" ) {
 263                         # if we end up with no server-list at all, return failure
 264                         return 0;
 265                 }
 266         }
 267         return 1;
 268 }
 269
 270 sub getcoredb {
 271         my $force = shift;
 272         my $age;
 273
 274         use File::Copy;
 275
 276         if ( -e "$Conf::dbdir/lists/core-list.db" ) {
 277                 my @stat = stat("$Conf::dbdir/lists/core-list.db");
 278                 my $time = time();
 279                 $age = $time - $stat[9];
 280                 $force = "force" if ("$age" >= "3600");
 281                 logger("CORE INFO: core-list.db is $age seconds old. - DEBUG: $force");
 282         } else {
 283                 # Force an update.
 284                 $force = "force";
 285         }
 286
 287         if ("$force" eq "force") {
 288                 if (fetchfile("lists/core-list.db", "")) {
 289                         move("$Conf::cachedir/core-list.db", "$Conf::dbdir/lists/core-list.db");
 290                 }
 291         }
 292 }
 293
 294 sub valid_signature($) {
 295         my $filename = shift;
 296
 297         open(my $cmd, "gpg --verify --status-fd 1 \"$filename\" 2>/dev/null |");
 298         while (<$cmd>) {
 299                 # Process valid signature lines
 300                 if (/VALIDSIG ([A-Z0-9]+)/) {
 301                         # Check if we know the key
 302                         foreach my $key (@VALID_KEY_FINGERPRINTS) {
 303                                 # Signature is valid
 304                                 return 1 if ($key eq $1);
 305                         }
 306                 }
 307         }
 308         close($cmd);
 309
 310         # Signature is invalid
 311         return 0;
 312 }
 313
 314 sub selectmirror {
 315         if (defined ${Conf::mirror}) {
 316                 my $uri = URI->new("${Conf::mirror}");
 317
 318                 # Only accept HTTPS mirrors
 319                 if ($uri->scheme eq "https") {
 320                         return ("HTTPS", $uri->host, $uri->path . "/" . ${Conf::version});
 321                 } else {
 322                         message("MIRROR ERROR: Unsupported mirror: " . ${Conf::mirror});
 323                 }
 324         }
 325
 326         ### Check if there is a current server list and read it.
 327         #   If there is no list try to get one.
 328         unless (open(FILE, "<$Conf::dbdir/lists/server-list.db")) {
 329                 unless (getmirrors("noforce")) {
 330                         message("MIRROR ERROR: Could not find or download a server list");
 331                         exit 1;
 332                 }
 333         }
 334
 335         my @lines = <FILE>;
 336         close(FILE);
 337
 338         ### Count the number of the servers in the list
 339         my $scount = 0;
 340         my @newlines;
 341         foreach (@lines) {
 342                 if ("$_" =~ /.*;.*;.*;/ ) {
 343                         push(@newlines,$_);
 344                         $scount++;
 345                 }
 346         }
 347         logger("MIRROR INFO: $scount servers found in list");
 348
 349         if ($scount eq 0) {
 350                 logger("MIRROR INFO: Could not find any servers. Falling back to main server $Conf::mainserver");
 351                 return ("HTTPS", $Conf::mainserver, "/$Conf::version");
 352         }
 353
 354         ### Choose a random server and test if it is online
 355         #   If the check fails try a new server.
 356         #   This will never give up.
 357         my $servers = 0;
 358         while (1) {
 359                 $server = int(rand($scount) + 1);
 360                 $servers = 0;
 361                 my ($line, $proto, $path, $host);
 362                 my @templine;
 363                 foreach $line (@newlines) {
 364                         $servers++;
 365                         if ($servers eq $server) {
 366                                 @templine = split(/\;/, $line);
 367                                 $proto = $templine[0];
 368                                 $host = $templine[1];
 369                                 $path = $templine[2];
 370
 371                                 return ($proto, $host, $path);
 372                         }
 373                 }
 374         }
 375 }
 376
 377 sub dbgetlist {
 378         ### Update the database if the file is older than one day.
 379         #   If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
 380         #   Usage is always with an argument.
 381         my $force = shift;
 382         my $age;
 383
 384         use File::Copy;
 385
 386         if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
 387                 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
 388                 my $time = time();
 389                 $age = $time - $stat[9];
 390                 $force = "force" if ("$age" >= "3600");
 391                 logger("DB INFO: packages_list.db is $age seconds old. - DEBUG: $force");
 392         } else {
 393                 # Force an update.
 394                 $force = "force";
 395         }
 396
 397         if ("$force" eq "force") {
 398                 if (fetchfile("lists/packages_list.db", "")) {
 399                         move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
 400                 } elsif ( -e "$Conf::dbdir/lists/packages_list.db" ) {
 401                         # If we end up with no db file after download error there
 402                         # is nothing more we can do here.
 403                         return 0;
 404                 }
 405         }
 406
 407         # Update the meta database if new packages was in the package list
 408         my $file;
 409         my $line;
 410         my $prog;
 411         my %metadata;
 412         my @templine;
 413
 414     my %paklist = &Pakfire::dblist("all");
 415
 416         opendir(DIR,"$Conf::dbdir/meta");
 417         my @files = readdir(DIR);
 418         closedir(DIR);
 419         foreach $file (@files) {
 420                 next if ( $file eq "." );
 421                 next if ( $file eq ".." );
 422                 next if ( $file eq "meta-" );
 423                 next if ( $file =~ /^old/ );
 424                 %metadata = parsemetafile("$Conf::dbdir/meta/$file");
 425
 426                 if ((defined $paklist{"$metadata{'Name'}"}) && (
 427                         ("$paklist{\"$metadata{'Name'}\"}{'Release'}" ne "$metadata{'Release'}") ||
 428                         (defined $paklist{"$metadata{'Name'}"}{'AvailableRelease'}))
 429                    ) {
 430                         move("$Conf::dbdir/meta/meta-$metadata{'Name'}","$Conf::dbdir/meta/old_meta-$metadata{'Name'}");
 431                         getmetafile($metadata{'Name'});
 432                 }
 433         }
 434 }
 435
 436 sub coredbinfo {
 437         ### This subroutine returns core db version information in a hash.
 438         # Usage is without arguments
 439
 440         eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
 441
 442         my %coredb = (
 443                 CoreVersion => $Conf::version,
 444                 Release => $Conf::core_mine,
 445         );
 446
 447         $coredb{'AvailableRelease'} = $core_release if ("$Conf::core_mine" < "$core_release");
 448
 449         return %coredb;
 450 }
 451
 452 sub dblist {
 453         ### This subroutine returns the packages from the packages_list db in a hash.
 454         #   It uses the currently cached version of packages_list. To ensure latest
 455         #   data, run Pakfire::dbgetlist first.
 456         #   You may also pass a filter: &Pakfire::dblist(filter)
 457         #   Usage is always with one argument.
 458         #   filter may be:
 459         #               - "all": list all known paks,
 460         #               - "notinstalled": list only not installed paks,
 461         #               - "installed": list only installed paks
 462         #               - "upgrade": list only upgradable paks
 463         #
 464         #   Returned hash format:
 465     #   ( "<pak name>" => (
 466         #       "Installed" => "Yes" or "No" wether the pak is installed,
 467         #       "ProgVersion" => Installed program version when "Installed" => "Yes" or
 468     #                        Available version when "Installed" => No,
 469         #       "Release" => Installed pak release number when "Installed" => "Yes" or
 470     #                    Available pak release number when "Installed" => No,
 471         #       "AvailableProgVersion" => Available program version.
 472         #                                 Only defined if an upgrade to a higher version is available,
 473         #       "AvailableRelease" => Available pak release version.
 474         #                             Only defined if an upgrade to a higher version is available
 475         #         ),
 476         #         ...
 477         #   )
 478
 479         my $filter = shift;
 480         my %paklist = ();
 481         my $file;
 482         my $line;
 483         my %metadata;
 484         my @templine;
 485
 486         open(FILE, "<$Conf::dbdir/lists/packages_list.db");
 487         my @db = <FILE>;
 488         close(FILE);
 489
 490         if ("$filter" ne "notinstalled") {
 491                 opendir(DIR,"$Conf::dbdir/installed");
 492                 my @files = readdir(DIR);
 493                 closedir(DIR);
 494
 495                 foreach $file (@files) {
 496                         next if ( $file eq "." );
 497                         next if ( $file eq ".." );
 498                         next if ( $file =~ /^old/ );
 499                         %metadata = parsemetafile("$Conf::dbdir/installed/$file");
 500
 501                         foreach $line (@db) {
 502                                 next unless ($line =~ /.*;.*;.*;/ );
 503                                 @templine = split(/\;/,$line);
 504                                 if (("$metadata{'Name'}" eq "$templine[0]") && ("$metadata{'Release'}" < "$templine[2]")) {
 505                                         # Add all upgradable paks to list
 506                                         $paklist{"$metadata{'Name'}"} = {
 507                                                 ProgVersion => $metadata{'ProgVersion'},
 508                                                 Release => $metadata{'Release'},
 509                                                 AvailableProgVersion => $templine[1],
 510                                                 AvailableRelease => $templine[2],
 511                                                 Installed => "yes"
 512                                         };
 513                                         last;
 514                                 } elsif (("$metadata{'Name'}" eq "$templine[0]") && ("$filter" ne "upgrade")) {
 515                                         # Add installed paks without an upgrade available to list
 516                                         $paklist{"$metadata{'Name'}"} = {
 517                                                 ProgVersion => $metadata{'ProgVersion'},
 518                                                 Release => $metadata{'Release'},
 519                                                 Installed => "yes"
 520                                         };
 521                                         last;
 522                                 }
 523                         }
 524                 }
 525         }
 526
 527         # Add all not installed paks to list
 528         if (("$filter" ne "upgrade") && ("$filter" ne "installed")) {
 529                 foreach $line (@db) {
 530                         next unless ($line =~ /.*;.*;.*;/ );
 531                         @templine = split(/\;/,$line);
 532                         next if ((defined $paklist{"$templine[0]"}) || (&isinstalled($templine[0]) == 0));
 533
 534                         $paklist{"$templine[0]"} = {
 535                                 ProgVersion => "$templine[1]",
 536                                 Release => "$templine[2]",
 537                                 Installed => "no"
 538                         };
 539                 }
 540         }
 541
 542         return %paklist;
 543 }
 544
 545 sub resolvedeps_one {
 546         my $pak = shift;
 547
 548         message("PAKFIRE RESV: $pak: Resolving dependencies...");
 549
 550         unless (getmetafile("$pak")) {
 551                 message("PAKFIRE ERROR: Error retrieving dependency information on $pak. Unable to resolve dependencies.");
 552                 exit 1;
 553         };
 554
 555         my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
 556         my @all;
 557         my @deps = split(/ /, $metadata{'Dependencies'});
 558         chomp (@deps);
 559         foreach (@deps) {
 560                 if ($_) {
 561                   my $return = &isinstalled($_);
 562                   if ($return eq 0) {
 563                         message("PAKFIRE RESV: $pak: Dependency is already installed: $_");
 564                   } else {
 565                         message("PAKFIRE RESV: $pak: Need to install dependency: $_");
 566                                 push(@all,$_);
 567                         }
 568                 }
 569         }
 570
 571         return @all;
 572 }
 573
 574 sub resolvedeps {
 575         my $pak = shift;
 576         my @all;
 577
 578         # Resolve all not yet installed dependencies of $pak
 579         my @deps = &resolvedeps_one($pak);
 580         push(@all, @deps);
 581
 582         # For each dependency, we check if more dependencies exist
 583         while (@deps) {
 584                 my $dep = pop(@deps);
 585
 586                 my @subdeps = &resolvedeps_one($dep);
 587                 foreach my $subdep (@subdeps) {
 588                         # Skip the package we are currently resolving for
 589                         next if ($pak eq $subdep);
 590
 591                         # If the package is not already to be installed,
 592                         # we add it to the list (@all) and check if it has
 593                         # more dependencies on its own.
 594                         unless (grep {$_ eq $subdep} @all) {
 595                                 push(@deps, $subdep);
 596                                 push(@all, $subdep);
 597                         }
 598                 }
 599         }
 600
 601         return @all;
 602 }
 603
 604 sub resolvedeps_recursive {
 605         my @packages = @_;
 606         my @result = ();
 607
 608         foreach my $pkg (@packages) {
 609                 my @deps = &Pakfire::resolvedeps($pkg);
 610
 611                 foreach my $dep (@deps) {
 612                         push(@result, $dep);
 613                 }
 614         }
 615
 616         # Sort the result array and remove dupes
 617         my %sort = map{ $_, 1 } @result;
 618         @result = keys %sort;
 619
 620         return @result;
 621 }
 622
 623 sub cleanup {
 624         my $dir = shift;
 625         my $path;
 626
 627         logger("CLEANUP: $dir");
 628
 629         if ( "$dir" eq "meta" ) {
 630                 $path = "$Conf::dbdir/meta";
 631         } elsif ( "$dir" eq "tmp" ) {
 632                 $path = "$Conf::tmpdir";
 633         }
 634         chdir("$path");
 635         opendir(DIR,".");
 636         my @files = readdir(DIR);
 637         closedir(DIR);
 638         foreach (@files) {
 639           unless (($_ eq ".") || ($_ eq "..")) {
 640                    system("rm -rf $_");
 641                 }
 642         }
 643 }
 644
 645 sub getmetafile {
 646         my $pak = shift;
 647
 648         # Try to download meta-file if we don't have one yet, or it is empty for some reason
 649         if ((! -e "$Conf::dbdir/meta/meta-$pak" ) || ( -z "$Conf::dbdir/meta/meta-$pak" )) {
 650                 return 0 unless (fetchfile("meta/meta-$pak", ""));
 651                 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
 652         }
 653
 654         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 655         my @line = <FILE>;
 656         close(FILE);
 657
 658         open(FILE, ">$Conf::dbdir/meta/meta-$pak");
 659         foreach (@line) {
 660                 my $string = $_;
 661                 $string =~ s/\r\n/\n/g;
 662                 print FILE $string;
 663         }
 664         close(FILE);
 665
 666         return 1;
 667 }
 668
 669 sub getsize {
 670         my $pak = shift;
 671
 672         getmetafile("$pak");
 673
 674         if (my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak")) {
 675                 return $metadata{'Size'};
 676         }
 677         return 0;
 678 }
 679
 680 sub parsemetafile {
 681         ### This subroutine returns a hash with the contents of a meta- file
 682         #   Pass path to metafile as argument: Pakfire::parsemetafile("$Conf::dbdir/meta/meta-$pak")
 683         #   Usage is always with an argument.
 684         my $metafile = shift;
 685
 686         my %metadata = ();
 687
 688         my @templine;
 689         my @file;
 690
 691         if (! -e $metafile ) {
 692                 return 0;
 693         }
 694
 695         open(FILE, "<$metafile");
 696         @file = <FILE>;
 697         close(FILE);
 698
 699         foreach (@file) {
 700                 @templine = split(/\: /,$_);
 701                 if ($templine[1]) {
 702                         chomp($templine[1]);
 703                         $metadata{"$templine[0]"} = $templine[1];
 704                 }
 705         }
 706
 707         return %metadata;
 708 }
 709
 710 sub getmetadata {
 711         ### This subroutine returns a hash of available info for a package
 712         #   Pass package name and type of info as argument: Pakfire::getmetadata(package, type_of_info)
 713         #       Type_of_info can be "latest" or "installed"
 714         #   Usage is always with two argument.
 715         my ($pak, $type) = @_;
 716
 717         my %metadata = (
 718                 Name => $pak,
 719                 Installed => "no",
 720                 Available => "no");
 721         my %installed_metadata = ();
 722
 723         my @templine;
 724         my @file;
 725
 726         ### Get available version information
 727         if ("$type" eq "latest") {
 728                 ### Check if package is in packages_list and get latest available version
 729                 my %db = Pakfire::dblist("all");
 730
 731                 if (defined $db{$pak}) {
 732                         ### Get and parse latest available metadata
 733                         if (getmetafile("$pak")) {
 734                                 %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
 735
 736                                 $metadata{'Available'} = "yes";
 737                                 ### Rename version info fields
 738                                 $metadata{'AvailableProgVersion'} = delete $metadata{'ProgVersion'};
 739                                 $metadata{'AvailableRelease'} = delete $metadata{'Release'};
 740                         }
 741                 }
 742         }
 743
 744         ### Parse installed pak metadata
 745         if (&isinstalled($pak) == 0) {
 746             %installed_metadata = parsemetafile("$Conf::dbdir/installed/meta-$pak");
 747
 748                 if ("$type" eq "latest" && exists($metadata{'AvailableProgVersion'})) {
 749                         ### Add installed version info to latest metadata
 750                         $metadata{'ProgVersion'} = $installed_metadata{'ProgVersion'};
 751                         $metadata{'Release'} = $installed_metadata{'Release'};
 752                 } else {
 753                         ### Use metadata of installed pak
 754                         %metadata = %installed_metadata;
 755                 }
 756                 $metadata{'Installed'} = 'yes';
 757         } else {
 758                 $metadata{'Installed'} = 'no';
 759         }
 760
 761         return %metadata;
 762 }
 763
 764 sub decryptpak {
 765         my $pak = shift;
 766
 767         cleanup("tmp");
 768
 769         my $file = getpak("$pak", "noforce");
 770
 771         logger("DECRYPT STARTED: $pak");
 772         my $return = system("cd $Conf::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf::cachedir/$file 2>/dev/null | tar x");
 773         $return %= 255;
 774         logger("DECRYPT FINISHED: $pak - Status: $return");
 775         if ($return != 0) { exit 1; }
 776 }
 777
 778 sub getpak {
 779         my $pak = shift;
 780         my $force = shift;
 781
 782         unless (getmetafile("$pak")) {
 783                 message("PAKFIRE ERROR: Unable to retrieve $pak metadata.");
 784                 exit 1;
 785         }
 786
 787         my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
 788         my $file = $metadata{'File'};
 789
 790         unless ($file) {
 791                 message("No filename given in meta-file.");
 792                 exit 1;
 793         }
 794
 795         unless ( "$force" eq "force" ) {
 796                 if ( -e "$Conf::cachedir/$file" ) {
 797                         return $file;
 798                 }
 799         }
 800
 801         unless (fetchfile("paks/$file", "")) {
 802                 message("PAKFIRE ERROR: Unable to download $pak.");
 803                 exit 1;
 804         }
 805         return $file;
 806 }
 807
 808 sub setuppak {
 809         my $pak = shift;
 810
 811         message("PAKFIRE INST: $pak: Decrypting...");
 812         decryptpak("$pak");
 813
 814         message("PAKFIRE INST: $pak: Copying files and running post-installation scripts...");
 815         my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
 816         $return %= 255;
 817         if ($return == 0) {
 818           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
 819           cleanup("tmp");
 820           copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
 821                 message("PAKFIRE INST: $pak: Finished.");
 822                 message("");
 823         } else {
 824                 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
 825                 exit $return;
 826         }
 827         return $return;
 828 }
 829
 830 sub upgradecore {
 831         # Safety check for lazy testers:
 832         # Before we upgrade to the latest release, we re-install the previous release
 833         # to make sure that the tester has always been on the latest version.
 834         my $tree = &get_tree();
 835         $Conf::core_mine-- if ($tree eq "testing" || $tree eq "unstable");
 836
 837         message("CORE UPGR: Upgrading from release $Conf::core_mine to $core_release");
 838
 839         my @seq = ($Conf::core_mine .. $core_release);
 840         shift @seq;
 841         my $release;
 842         foreach $release (@seq) {
 843                 chomp($release);
 844                 getpak("core-upgrade-$release");
 845         }
 846
 847         foreach $release (@seq) {
 848                 chomp($release);
 849                 upgradepak("core-upgrade-$release");
 850         }
 851
 852         system("echo $core_release > $Conf::coredir/mine");
 853 }
 854
 855 sub isinstalled {
 856         my $pak = shift;
 857         if ( open(FILE,"<$Conf::dbdir/installed/meta-$pak") ) {
 858                 close(FILE);
 859                 return 0;
 860         } else {
 861                 return 1;
 862         }
 863 }
 864
 865 sub upgradepak {
 866         my $pak = shift;
 867
 868         message("PAKFIRE UPGR: $pak: Decrypting...");
 869         decryptpak("$pak");
 870
 871         message("PAKFIRE UPGR: $pak: Upgrading files and running post-upgrading scripts...");
 872         my $return = system("cd $Conf::tmpdir && NAME=$pak ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
 873         $return %= 255;
 874         if ($return == 0) {
 875           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
 876           cleanup("tmp");
 877                 copy("$Conf::dbdir/meta/meta-$pak", "$Conf::dbdir/installed/");
 878                 message("PAKFIRE UPGR: $pak: Finished.");
 879                 message("");
 880         } else {
 881                 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
 882                 exit $return;
 883         }
 884         return $return;
 885 }
 886
 887 sub removepak {
 888         my $pak = shift;
 889
 890         message("PAKFIRE REMV: $pak: Decrypting...");
 891         decryptpak("$pak");
 892
 893         message("PAKFIRE REMV: $pak: Removing files and running post-removing scripts...");
 894         my $return = system("cd $Conf::tmpdir && NAME=$pak ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
 895         $return %= 255;
 896         if ($return == 0) {
 897           unlink("$Conf::dbdir/rootfiles/$pak");
 898           unlink("$Conf::dbdir/installed/meta-$pak");
 899           cleanup("tmp");
 900                 message("PAKFIRE REMV: $pak: Finished.");
 901                 message("");
 902         } else {
 903                 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
 904                 exit $return;
 905         }
 906         return $return;
 907 }
 908
 909 sub beautifysize {
 910         my $size = shift;
 911         #$size = $size / 1024;
 912         my $unit;
 913
 914         if ($size > 1023*1024) {
 915           $size = ($size / (1024*1024));
 916           $unit = "MB";
 917         } elsif ($size > 1023) {
 918           $size = ($size / 1024);
 919           $unit = "KB";
 920         } else {
 921           $unit = "B";
 922         }
 923         $size = sprintf("%.2f" , $size);
 924         my $string = "$size $unit";
 925         return $string;
 926 }
 927
 928 sub makeuuid {
 929         unless ( -e "$Conf::dbdir/uuid" ) {
 930                 open(FILE, "</proc/sys/kernel/random/uuid");
 931                 my @line = <FILE>;
 932                 close(FILE);
 933
 934                 open(FILE, ">$Conf::dbdir/uuid");
 935                 foreach (@line) {
 936                         print FILE $_;
 937                 }
 938                 close(FILE);
 939         }
 940 }
 941
 942 sub callback {
 943    my ($data, $response, $protocol) = @_;
 944    $final_data .= $data;
 945    print progress_bar( length($final_data), $total_size, 30, '=' );
 946 }
 947
 948 sub progress_bar {
 949     my ( $got, $total, $width, $char ) = @_;
 950     my $show_bfile;
 951     $width ||= 30; $char ||= '=';
 952     my $len_bfile = length $bfile;
 953     if ("$len_bfile" >= "17") {
 954                         $show_bfile = substr($bfile,0,17)."...";
 955                 } else {
 956                         $show_bfile = $bfile;
 957                 }
 958                 $progress = sprintf("%.2f%%", 100*$got/+$total);
 959     sprintf "$color{'lightgreen'}%-20s %7s |%-${width}s| %10s$color{'normal'}\r",$show_bfile, $progress, $char x (($width-1)*$got/$total). '>', beautifysize($got);
 960 }
 961
 962 sub updates_available {
 963         # Get packets with updates available
 964         my %upgradepaks = &Pakfire::dblist("upgrade");
 965
 966         # Get the length of the returned hash
 967         my $updatecount = keys %upgradepaks;
 968
 969         return "$updatecount";
 970 }
 971
 972 sub reboot_required {
 973         if ( -e "/var/run/need_reboot" ) {
 974                 return "yes";
 975         }
 976         else {
 977                 return "no";
 978         }
 979 }
 980
 981 sub status {
 982         ### This subroutine returns pakfire status information in a hash.
 983         # Usage is without arguments
 984
 985         # Add core version info
 986         my %status = &Pakfire::coredbinfo();
 987
 988         # Add last update info
 989         $status{'LastUpdate'} = &General::age("/opt/pakfire/db/core/mine");
 990         $status{'LastCoreListUpdate'} = &General::age("/opt/pakfire/db/lists/core-list.db");
 991         $status{'LastServerListUpdate'} = &General::age("/opt/pakfire/db/lists/server-list.db");
 992         $status{'LastPakListUpdate'} = &General::age("/opt/pakfire/db/lists/packages_list.db");
 993
 994         # Add number of available package updates
 995         $status{'CoreUpdateAvailable'} = (defined $status{'AvailableRelease'}) ? "yes" : "no";
 996         $status{'PakUpdatesAvailable'} = &Pakfire::updates_available();
 997
 998         # Add if reboot is required
 999         $status{'RebootRequired'} = &Pakfire::reboot_required();
1000
1001         return %status;
1002 }
1003
1004 sub get_arch() {
1005         # Append architecture
1006         my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
1007
1008         # We only support armv6l for 32 bit arm
1009         if ($machine =~ m/armv[67]/) {
1010                 return "armv6l";
1011         }
1012
1013         return $machine;
1014 }
1015
1016 sub get_tree() {
1017         # Return stable if nothing is set
1018         return "stable" unless (defined $pakfiresettings{'TREE'});
1019
1020         return $pakfiresettings{'TREE'};
1021 }
1022
1023 sub make_version() {
1024         my $version = "";
1025
1026         # Open /etc/system-release
1027         open(RELEASE, "</etc/system-release");
1028         my $release = <RELEASE>;
1029         close(RELEASE);
1030
1031         # Add the main relase
1032         if ($release =~ m/IPFire ([\d\.]+)/) {
1033                 $version .= $1;
1034         }
1035
1036         # Append suffix for tree
1037         my $tree = &get_tree();
1038         if ($tree eq "testing") {
1039                 $version .= ".1";
1040         } elsif ($tree eq "unstable") {
1041                 $version .= ".2";
1042         }
1043
1044         # Append architecture
1045         $version .= "-" . &get_arch();
1046
1047         return $version;
1048 }
1049
1050 1;