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