src/pakfire/lib/functions.pl

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