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