src/pakfire/lib/functions.pl

   1 #!/usr/bin/perl -w
   2 ###############################################################################
   3 #                                                                             #
   4 # IPFire.org - A linux based firewall                                         #
   5 # Copyright (C) 2007-2015   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
  34 use Switch;
  35
  36 package Pakfire;
  37
  38 my @VALID_KEY_FINGERPRINTS = (
  39         # 2018
  40         "3ECA8AA4478208B924BB96206FEF7A8ED713594B",
  41         # 2007
  42         "179740DC4D8C47DC63C099C74BDE364C64D96617",
  43 );
  44
  45 # A small color-hash :D
  46 my %color;
  47         $color{'normal'}      = "\033[0m";
  48         $color{'black'}       = "\033[0;30m";
  49         $color{'darkgrey'}    = "\033[1;30m";
  50         $color{'blue'}        = "\033[0;34m";
  51         $color{'lightblue'}   = "\033[1;34m";
  52         $color{'green'}       = "\033[0;32m";
  53         $color{'lightgreen'}  = "\033[1;32m";
  54         $color{'cyan'}        = "\033[0;36m";
  55         $color{'lightcyan'}   = "\033[1;36m";
  56         $color{'red'}         = "\033[0;31m";
  57         $color{'lightred'}    = "\033[1;31m";
  58         $color{'purple'}      = "\033[0;35m";
  59         $color{'lightpurple'} = "\033[1;35m";
  60         $color{'brown'}       = "\033[0;33m";
  61         $color{'lightgrey'}   = "\033[0;37m";
  62         $color{'yellow'}      = "\033[1;33m";
  63         $color{'white'}       = "\033[1;37m";
  64 our $enable_colors = 1;
  65
  66 my $final_data;
  67 my $total_size;
  68 my $bfile;
  69
  70 my %pakfiresettings = ();
  71 &General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
  72
  73 sub message {
  74         my $message = shift;
  75
  76         logger("$message");
  77         if ( $enable_colors == 1 ) {
  78                 if ("$message" =~ /ERROR/) {
  79                         $message = "$color{'red'}$message$color{'normal'}";
  80                 } elsif ("$message" =~ /INFO/) {
  81                         $message = "$color{'cyan'}$message$color{'normal'}";
  82                 } elsif ("$message" =~ /WARN/) {
  83                         $message = "$color{'yellow'}$message$color{'normal'}";
  84                 } elsif ("$message" =~ /RESV/) {
  85                         $message = "$color{'purple'}$message$color{'normal'}";
  86                 } elsif ("$message" =~ /INST/) {
  87                         $message = "$color{'green'}$message$color{'normal'}";
  88                 } elsif ("$message" =~ /REMV/) {
  89                         $message = "$color{'lightred'}$message$color{'normal'}";
  90                 } elsif ("$message" =~ /UPGR/) {
  91                         $message = "$color{'lightblue'}$message$color{'normal'}";
  92                 }
  93         }
  94         print "$message\n";
  95
  96 }
  97
  98 sub logger {
  99         my $log = shift;
 100         if ($log) {
 101                 #system("echo \"`date`: $log\" >> /var/log/pakfire.log");
 102                 system("logger -t pakfire \"$log\"");
 103         }
 104 }
 105
 106 sub usage {
 107   &Pakfire::message("Usage: pakfire <install|remove> [options] <pak(s)>");
 108   &Pakfire::message("               <update> - Contacts the servers for new lists of paks.");
 109   &Pakfire::message("               <upgrade> - Installs the latest version of all paks.");
 110   &Pakfire::message("               <list> - Outputs a short list with all available paks.");
 111   &Pakfire::message("");
 112   &Pakfire::message("       Global options:");
 113   &Pakfire::message("               --non-interactive --> Enables the non-interactive mode.");
 114   &Pakfire::message("                                     You won't see any question here.");
 115   &Pakfire::message("                              -y --> Short for --non-interactive.");
 116   &Pakfire::message("                     --no-colors --> Turns off the wonderful colors.");
 117   &Pakfire::message("");
 118   exit 1;
 119 }
 120
 121 sub pinghost {
 122         my $host = shift;
 123
 124         $p = Net::Ping->new("icmp");
 125   if ($p->ping($host)) {
 126          logger("PING INFO: $host is alive");
 127         return 1;
 128   } else {
 129                 logger("PING INFO: $host is unreachable");
 130                 return 0;
 131         }
 132   $p->close();
 133 }
 134
 135 sub fetchfile {
 136         my $getfile = shift;
 137         my $gethost = shift;
 138         my (@server, $host, $proto, $file, $i);
 139         my $allok = 0;
 140
 141         use File::Basename;
 142         $bfile = basename("$getfile");
 143
 144         logger("DOWNLOAD STARTED: $getfile") unless ($bfile =~ /^counter\?.*/);
 145
 146         $i = 0;
 147         while (($allok == 0) && $i < 5) {
 148                 $i++;
 149
 150                 if ("$gethost" eq "") {
 151                         @server = selectmirror();
 152                         $proto = $server[0];
 153                         $host = $server[1];
 154                         $file = "$server[2]/$getfile";
 155                 } else {
 156                         $host = $gethost;
 157                         $file = $getfile;
 158                 }
 159
 160                 $proto = "HTTP" unless $proto;
 161
 162                 unless ($bfile =~ /^counter\?.*/) {
 163                         logger("DOWNLOAD INFO: Host: $host ($proto) - File: $file");
 164                 }
 165
 166                 my $ua = LWP::UserAgent->new;
 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'}\"") unless ($bfile =~ /^counter.py\?.*/);
 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'}\" - \"$proxysettings{'UPSTREAM_PASSWORD'}\"") unless ($bfile =~ /^counter.py\?.*/);
 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 $response;
 197
 198                 unless ($bfile =~ /^counter.py\?.*/) {
 199                         my $result = $ua->head($url);
 200                         my $remote_headers = $result->headers;
 201                         $total_size = $remote_headers->content_length;
 202                         logger("DOWNLOAD INFO: $file has size of $total_size bytes");
 203
 204                         $response = $ua->get($url, ':content_cb' => \&callback );
 205                         message("");
 206                 } else {
 207                         $response = $ua->get($url);
 208                 }
 209
 210                 my $code = $response->code();
 211                 my $log = $response->status_line;
 212                 logger("DOWNLOAD INFO: HTTP-Status-Code: $code - $log");
 213
 214                 if ( $code eq "500" ) {
 215                         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.");
 216                         return 1;
 217                 }
 218
 219                 if ($response->is_success) {
 220                         unless ($bfile =~ /^counter.py\?.*/) {
 221                                 if (open(FILE, ">$Conf::tmpdir/$bfile")) {
 222                                         print FILE $final_data;
 223                                         close(FILE);
 224                                         logger("DOWNLOAD INFO: File received. Start checking signature...");
 225                                         if (&valid_signature("$Conf::tmpdir/$bfile")) {
 226                                                 logger("DOWNLOAD INFO: Signature of $bfile is fine.");
 227                                                 move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile");
 228                                         } else {
 229                                                 message("DOWNLOAD ERROR: The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting...");
 230                                                 my $ntp = `ntpdate -q -t 10 pool.ntp.org 2>/dev/null | tail -1`;
 231                                                 if ( $ntp !~ /time\ server(.*)offset(.*)/ ){message("TIME ERROR: Unable to get the nettime, this may lead to the verification error.");}
 232                                                 else { $ntp =~ /time\ server(.*)offset(.*)/; message("TIME INFO: Time Server$1has$2 offset to localtime.");}
 233                                                 exit 1;
 234                                         }
 235                                         logger("DOWNLOAD FINISHED: $file");
 236                                         $allok = 1;
 237                                         return 0;
 238                                 } else {
 239                                         logger("DOWNLOAD ERROR: Could not open $Conf::tmpdir/$bfile for writing.");
 240                                 }
 241                         } else {
 242                                 return 0;
 243                         }
 244                 }       else {
 245                         logger("DOWNLOAD ERROR: $log");
 246                 }
 247         }
 248         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.");
 249         return 1;
 250 }
 251
 252 sub getmirrors {
 253         my $force = shift;
 254         my $age;
 255
 256         use File::Copy;
 257
 258         if ( -e "$Conf::dbdir/lists/server-list.db" ) {
 259                 my @stat = stat("$Conf::dbdir/lists/server-list.db");
 260                 my $time = time();
 261                 $age = $time - $stat[9];
 262                 $force = "force" if ("$age" >= "3600");
 263                 logger("MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force");
 264         } else {
 265                 # Force an update.
 266                 $force = "force";
 267         }
 268
 269         if ("$force" eq "force") {
 270                 fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver");
 271                 move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
 272         }
 273 }
 274
 275 sub getcoredb {
 276         my $force = shift;
 277         my $age;
 278
 279         use File::Copy;
 280
 281         if ( -e "$Conf::dbdir/lists/core-list.db" ) {
 282                 my @stat = stat("$Conf::dbdir/lists/core-list.db");
 283                 my $time = time();
 284                 $age = $time - $stat[9];
 285                 $force = "force" if ("$age" >= "3600");
 286                 logger("CORE INFO: core-list.db is $age seconds old. - DEBUG: $force");
 287         } else {
 288                 # Force an update.
 289                 $force = "force";
 290         }
 291
 292         if ("$force" eq "force") {
 293                 fetchfile("lists/core-list.db", "");
 294                 move("$Conf::cachedir/core-list.db", "$Conf::dbdir/lists/core-list.db");
 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         ### Check if there is a current server list and read it.
 320         #   If there is no list try to get one.
 321         my $count = 0;
 322         while (!(open(FILE, "<$Conf::dbdir/lists/server-list.db")) && ($count lt 5)) {
 323                 $count++;
 324                 getmirrors("noforce");
 325         }
 326         if ($count == 5) {
 327                 message("MIRROR ERROR: Could not find or download a server list");
 328                 exit 1;
 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 ("HTTP", $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 $found = 0;
 353         my $servers = 0;
 354         my $pingdelay = 1;
 355         while ($found == 0) {
 356                 $server = int(rand($scount) + 1);
 357                 $servers = 0;
 358                 my ($line, $proto, $path, $host);
 359                 my @templine;
 360                 foreach $line (@newlines) {
 361                         $servers++;
 362                         if ($servers eq $server) {
 363                                 @templine = split(/\;/, $line);
 364                                 $proto = $templine[0];
 365                                 $host = $templine[1];
 366                                 $path = $templine[2];
 367                                 if ($pakfiresettings{'HEALTHCHECK'} eq "off") {
 368                                         logger("PING INFO: Healthcheck is disabled");
 369                                         $found = 1;
 370                                         return ($proto, $host, $path);
 371                                 }
 372                                 elsif (pinghost("$host")) {
 373                                         $found = 1;
 374                                         return ($proto, $host, $path);
 375                                 }
 376                                 if ($found == 0) {
 377                                         sleep($pingdelay);
 378                                         $pingdelay=$pingdelay*2;
 379                                         if ($pingdelay>1200) {
 380                                                 $pingdelay=1200;
 381                                         }
 382                                 }
 383                         }
 384                 }
 385         }
 386 }
 387
 388 sub dbgetlist {
 389         ### Update the database if the file is older than one day.
 390         #   If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
 391         #   Usage is always with an argument.
 392         my $force = shift;
 393         my $age;
 394
 395         use File::Copy;
 396
 397         if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
 398                 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
 399                 my $time = time();
 400                 $age = $time - $stat[9];
 401                 $force = "force" if ("$age" >= "3600");
 402                 logger("DB INFO: packages_list.db is $age seconds old. - DEBUG: $force");
 403         } else {
 404                 # Force an update.
 405                 $force = "force";
 406         }
 407
 408         if ("$force" eq "force") {
 409                 fetchfile("lists/packages_list.db", "");
 410                 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
 411         }
 412
 413         # Update the meta database if new packages was in the package list
 414         my @meta;
 415         my $file;
 416         my $line;
 417         my $prog;
 418         my ($name, $version, $release);
 419         my @templine;
 420
 421         open(FILE, "<$Conf::dbdir/lists/packages_list.db");
 422         my @db = <FILE>;
 423         close(FILE);
 424
 425         opendir(DIR,"$Conf::dbdir/meta");
 426         my @files = readdir(DIR);
 427         closedir(DIR);
 428         foreach $file (@files) {
 429                 next if ( $file eq "." );
 430                 next if ( $file eq ".." );
 431                 next if ( $file eq "meta-" );
 432                 next if ( $file =~ /^old/ );
 433                 open(FILE, "<$Conf::dbdir/meta/$file");
 434                 @meta = <FILE>;
 435                 close(FILE);
 436                 foreach $line (@meta) {
 437                         @templine = split(/\: /,$line);
 438                         if ("$templine[0]" eq "Name") {
 439                                 $name = $templine[1];
 440                                 chomp($name);
 441                         } elsif ("$templine[0]" eq "ProgVersion") {
 442                                 $version = $templine[1];
 443                                 chomp($version);
 444                         } elsif ("$templine[0]" eq "Release") {
 445                                 $release = $templine[1];
 446                                 chomp($release);
 447                         }
 448                 }
 449                 foreach $prog (@db) {
 450                         @templine = split(/\;/,$prog);
 451                         if (("$name" eq "$templine[0]") && ("$release" ne "$templine[2]")) {
 452                                 move("$Conf::dbdir/meta/meta-$name","$Conf::dbdir/meta/old_meta-$name");
 453                                 fetchfile("meta/meta-$name", "");
 454                                 move("$Conf::cachedir/meta-$name", "$Conf::dbdir/meta/meta-$name");
 455                         }
 456                 }
 457         }
 458 }
 459
 460 sub dblist {
 461         ### This subroutine lists the packages.
 462         #   You may also pass a filter: &Pakfire::dblist(filter)
 463         #   Usage is always with two arguments.
 464         #   filter may be: all, notinstalled, installed
 465         my $filter = shift;
 466         my $forweb = shift;
 467         my @meta;
 468         my @updatepaks;
 469         my $file;
 470         my $line;
 471         my $prog;
 472         my ($name, $version, $release);
 473         my @templine;
 474
 475         ### Make sure that the list is not outdated.
 476         #dbgetlist("noforce");
 477
 478         open(FILE, "<$Conf::dbdir/lists/packages_list.db");
 479         my @db = <FILE>;
 480         close(FILE);
 481
 482         if ("$filter" eq "upgrade") {
 483                 if ("$forweb" ne "forweb" && "$forweb" ne "notice" ) {getcoredb("noforce");}
 484                 eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
 485                 if ("$core_release" > "$Conf::core_mine") {
 486                         if ("$forweb" eq "forweb") {
 487                                 print "<option value=\"core\">Core-Update -- $Conf::version -- Release: $Conf::core_mine -> $core_release</option>\n";
 488                         }
 489                         elsif ("$forweb" eq "notice") {
 490                                 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>";
 491                         } else {
 492                                 my $command = "Core-Update $Conf::version\nRelease: $Conf::core_mine -> $core_release\n";
 493                                 if ("$Pakfire::enable_colors" eq "1") {
 494                                         print "$color{'lila'}$command$color{'normal'}\n";
 495                                 } else {
 496                                         print "$command\n";
 497                                 }
 498                         }
 499                 }
 500
 501                 opendir(DIR,"$Conf::dbdir/installed");
 502                 my @files = readdir(DIR);
 503                 closedir(DIR);
 504                 foreach $file (@files) {
 505                         next if ( $file eq "." );
 506                         next if ( $file eq ".." );
 507                         next if ( $file =~ /^old/ );
 508                         open(FILE, "<$Conf::dbdir/installed/$file");
 509                         @meta = <FILE>;
 510                         close(FILE);
 511                         foreach $line (@meta) {
 512                                 @templine = split(/\: /,$line);
 513                                 if ("$templine[0]" eq "Name") {
 514                                         $name = $templine[1];
 515                                         chomp($name);
 516                                 } elsif ("$templine[0]" eq "ProgVersion") {
 517                                         $version = $templine[1];
 518                                         chomp($version);
 519                                 } elsif ("$templine[0]" eq "Release") {
 520                                         $release = $templine[1];
 521                                         chomp($release);
 522                                 }
 523                         }
 524                         foreach $prog (@db) {
 525                                 @templine = split(/\;/,$prog);
 526                                 if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" && "$forweb" ne "notice")) {
 527                                         push(@updatepaks,$name);
 528                                         if ("$forweb" eq "forweb") {
 529                                                 print "<option value=\"$name\">Update: $name -- Version: $version -> $templine[1] -- Release: $release -> $templine[2]</option>\n";
 530                                         } else {
 531                                                 my $command = "Update: $name\nVersion: $version -> $templine[1]\nRelease: $release -> $templine[2]\n";
 532                                                 if ("$Pakfire::enable_colors" eq "1") {
 533                                                         print "$color{'lila'}$command$color{'normal'}\n";
 534                                                 } else {
 535                                                         print "$command\n";
 536                                                 }
 537                                         }
 538                                 }
 539                         }
 540                 }
 541                 return @updatepaks;
 542         } else {
 543                 my $line;
 544                 my $use_color;
 545                 my @templine;
 546                 my $count;
 547                 foreach $line (sort @db) {
 548                         next unless ($line =~ /.*;.*;.*;/ );
 549                         $use_color = "";
 550                         $count++;
 551                         @templine = split(/\;/,$line);
 552                         if ("$filter" eq "notinstalled") {
 553                                 next if ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
 554                         } elsif ("$filter" eq "installed") {
 555                                 next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
 556                         }
 557                         if ("$forweb" eq "forweb")
 558                          {
 559                                 if ("$filter" eq "notinstalled") {
 560                                         print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
 561                                 } else {
 562                                         print "<option value=\"$templine[0]\">$templine[0]</option>\n";
 563                                 }
 564                         } else {
 565                                 if ("$Pakfire::enable_colors" eq "1") {
 566                                         if (&isinstalled("$templine[0]")) {
 567                                                 $use_color = "$color{'red'}"
 568                                         } else {
 569                                                 $use_color = "$color{'green'}"
 570                                         }
 571                                 }
 572                                 print "${use_color}Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]$color{'normal'}\n\n";
 573                         }
 574                 }
 575                 print "$count packages total.\n" unless ("$forweb" eq "forweb");
 576         }
 577 }
 578
 579 sub resolvedeps_one {
 580         my $pak = shift;
 581
 582         getmetafile("$pak");
 583
 584         message("PAKFIRE RESV: $pak: Resolving dependencies...");
 585
 586         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 587         my @file = <FILE>;
 588         close(FILE);
 589
 590         my $line;
 591         my (@templine, @deps, @all);
 592         foreach $line (@file) {
 593                 @templine = split(/\: /,$line);
 594                 if ("$templine[0]" eq "Dependencies") {
 595                         @deps = split(/ /, $templine[1]);
 596                 }
 597         }
 598         chomp (@deps);
 599         foreach (@deps) {
 600                 if ($_) {
 601                   my $return = &isinstalled($_);
 602                   if ($return eq 0) {
 603                         message("PAKFIRE RESV: $pak: Dependency is already installed: $_");
 604                   } else {
 605                         message("PAKFIRE RESV: $pak: Need to install dependency: $_");
 606                                 push(@all,$_);
 607                         }
 608                 }
 609         }
 610
 611         return @all;
 612 }
 613
 614 sub resolvedeps {
 615         my $pak = shift;
 616         my @all;
 617
 618         # Resolve all not yet installed dependencies of $pak
 619         my @deps = &resolvedeps_one($pak);
 620         push(@all, @deps);
 621
 622         # For each dependency, we check if more dependencies exist
 623         while (@deps) {
 624                 my $dep = pop(@deps);
 625
 626                 my @subdeps = &resolvedeps_one($dep);
 627                 foreach my $subdep (@subdeps) {
 628                         # Skip the package we are currently resolving for
 629                         next if ($pak eq $subdep);
 630
 631                         # If the package is not already to be installed,
 632                         # we add it to the list (@all) and check if it has
 633                         # more dependencies on its own.
 634                         unless (grep {$_ eq $subdep} @all) {
 635                                 push(@deps, $subdep);
 636                                 push(@all, $subdep);
 637                         }
 638                 }
 639         }
 640
 641         return @all;
 642 }
 643
 644 sub resolvedeps_recursive {
 645         my @packages = @_;
 646         my @result = ();
 647
 648         foreach my $pkg (@packages) {
 649                 my @deps = &Pakfire::resolvedeps($pkg);
 650
 651                 foreach my $dep (@deps) {
 652                         push(@result, $dep);
 653                 }
 654         }
 655
 656         # Sort the result array and remove dupes
 657         my %sort = map{ $_, 1 } @result;
 658         @result = keys %sort;
 659
 660         return @result;
 661 }
 662
 663 sub cleanup {
 664         my $dir = shift;
 665         my $path;
 666
 667         logger("CLEANUP: $dir");
 668
 669         if ( "$dir" eq "meta" ) {
 670                 $path = "$Conf::dbdir/meta";
 671         } elsif ( "$dir" eq "tmp" ) {
 672                 $path = "$Conf::tmpdir";
 673         }
 674         chdir("$path");
 675         opendir(DIR,".");
 676         my @files = readdir(DIR);
 677         closedir(DIR);
 678         foreach (@files) {
 679           unless (($_ eq ".") || ($_ eq "..")) {
 680                    system("rm -rf $_");
 681                 }
 682         }
 683 }
 684
 685 sub getmetafile {
 686         my $pak = shift;
 687
 688         unless ( -e "$Conf::dbdir/meta/meta-$pak" ) {
 689                 fetchfile("meta/meta-$pak", "");
 690                 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
 691         }
 692
 693         if ( -z "$Conf::dbdir/meta/meta-$pak" ) {
 694                 fetchfile("meta/meta-$pak", "");
 695                 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
 696         }
 697
 698         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 699         my @line = <FILE>;
 700         close(FILE);
 701
 702         open(FILE, ">$Conf::dbdir/meta/meta-$pak");
 703         foreach (@line) {
 704                 my $string = $_;
 705                 $string =~ s/\r\n/\n/g;
 706                 print FILE $string;
 707         }
 708         close(FILE);
 709         return 1;
 710 }
 711
 712 sub getsize {
 713         my $pak = shift;
 714
 715         getmetafile("$pak");
 716
 717         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 718         my @file = <FILE>;
 719         close(FILE);
 720
 721         my $line;
 722         my @templine;
 723         foreach $line (@file) {
 724                 @templine = split(/\: /,$line);
 725                 if ("$templine[0]" eq "Size") {
 726                         chomp($templine[1]);
 727                         return $templine[1];
 728                 }
 729         }
 730         return 0;
 731 }
 732
 733 sub decryptpak {
 734         my $pak = shift;
 735
 736         cleanup("tmp");
 737
 738         my $file = getpak("$pak", "noforce");
 739
 740         logger("DECRYPT STARTED: $pak");
 741         my $return = system("cd $Conf::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf::cachedir/$file 2>/dev/null | tar x");
 742         $return %= 255;
 743         logger("DECRYPT FINISHED: $pak - Status: $return");
 744         if ($return != 0) { exit 1; }
 745 }
 746
 747 sub getpak {
 748         my $pak = shift;
 749         my $force = shift;
 750
 751         getmetafile("$pak");
 752
 753         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 754         my @file = <FILE>;
 755         close(FILE);
 756
 757         my $line;
 758         my $file;
 759         my @templine;
 760         foreach $line (@file) {
 761                 @templine = split(/\: /,$line);
 762                 if ("$templine[0]" eq "File") {
 763                         chomp($templine[1]);
 764                         $file = $templine[1];
 765                 }
 766         }
 767
 768         unless ($file) {
 769                 message("No filename given in meta-file.");
 770                 exit 1;
 771         }
 772
 773         unless ( "$force" eq "force" ) {
 774                 if ( -e "$Conf::cachedir/$file" ) {
 775                         return $file;
 776                 }
 777         }
 778
 779         fetchfile("paks/$file", "");
 780         return $file;
 781 }
 782
 783 sub setuppak {
 784         my $pak = shift;
 785
 786         message("PAKFIRE INST: $pak: Decrypting...");
 787         decryptpak("$pak");
 788
 789         message("PAKFIRE INST: $pak: Copying files and running post-installation scripts...");
 790         my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
 791         $return %= 255;
 792         if ($pakfiresettings{'UUID'} ne "off") {
 793                 fetchfile("counter.py?ver=$Conf::version&uuid=$Conf::uuid&ipak=$pak&return=$return", "$Conf::mainserver");
 794         }
 795         if ($return == 0) {
 796           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
 797           cleanup("tmp");
 798           copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
 799                 message("PAKFIRE INST: $pak: Finished.");
 800                 message("");
 801         } else {
 802                 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
 803                 exit $return;
 804         }
 805         return $return;
 806 }
 807
 808 sub upgradecore {
 809         getcoredb("noforce");
 810         eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
 811         if ("$core_release" > "$Conf::core_mine") {
 812                 message("CORE UPGR: Upgrading from release $Conf::core_mine to $core_release");
 813
 814                 my @seq = `seq $Conf::core_mine $core_release`;
 815                 shift @seq;
 816                 my $release;
 817                 foreach $release (@seq) {
 818                         chomp($release);
 819                         getpak("core-upgrade-$release");
 820                 }
 821
 822                 foreach $release (@seq) {
 823                         chomp($release);
 824                         upgradepak("core-upgrade-$release");
 825                 }
 826
 827                 system("echo $core_release > $Conf::coredir/mine");
 828
 829         } else {
 830                 message("CORE ERROR: No new upgrades available. You are on release $Conf::core_mine.");
 831         }
 832 }
 833
 834 sub isinstalled {
 835         my $pak = shift;
 836         if ( open(FILE,"<$Conf::dbdir/installed/meta-$pak") ) {
 837                 close(FILE);
 838                 return 0;
 839         } else {
 840                 return 1;
 841         }
 842 }
 843
 844 sub upgradepak {
 845         my $pak = shift;
 846
 847         message("PAKFIRE UPGR: $pak: Decrypting...");
 848         decryptpak("$pak");
 849
 850         message("PAKFIRE UPGR: $pak: Upgrading files and running post-upgrading scripts...");
 851         my $return = system("cd $Conf::tmpdir && NAME=$pak ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
 852         $return %= 255;
 853         if ($pakfiresettings{'UUID'} ne "off") {
 854                 fetchfile("counter.py?ver=$Conf::version&uuid=$Conf::uuid&upak=$pak&return=$return", "$Conf::mainserver");
 855         }
 856         if ($return == 0) {
 857           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
 858           cleanup("tmp");
 859                 copy("$Conf::dbdir/meta/meta-$pak", "$Conf::dbdir/installed/");
 860                 message("PAKFIRE UPGR: $pak: Finished.");
 861                 message("");
 862         } else {
 863                 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
 864                 exit $return;
 865         }
 866         return $return;
 867 }
 868
 869 sub removepak {
 870         my $pak = shift;
 871
 872         message("PAKFIRE REMV: $pak: Decrypting...");
 873         decryptpak("$pak");
 874
 875         message("PAKFIRE REMV: $pak: Removing files and running post-removing scripts...");
 876         my $return = system("cd $Conf::tmpdir && NAME=$pak ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
 877         $return %= 255;
 878         if ($pakfiresettings{'UUID'} ne "off") {
 879                 fetchfile("counter.py?ver=$Conf::version&uuid=$Conf::uuid&dpak=$pak&return=$return", "$Conf::mainserver");
 880         }
 881         if ($return == 0) {
 882           unlink("$Conf::dbdir/rootfiles/$pak");
 883           unlink("$Conf::dbdir/installed/meta-$pak");
 884           cleanup("tmp");
 885                 message("PAKFIRE REMV: $pak: Finished.");
 886                 message("");
 887         } else {
 888                 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
 889                 exit $return;
 890         }
 891         return $return;
 892 }
 893
 894 sub beautifysize {
 895         my $size = shift;
 896         #$size = $size / 1024;
 897         my $unit;
 898
 899         if ($size > 1023*1024) {
 900           $size = ($size / (1024*1024));
 901           $unit = "MB";
 902         } elsif ($size > 1023) {
 903           $size = ($size / 1024);
 904           $unit = "KB";
 905         } else {
 906           $unit = "B";
 907         }
 908         $size = sprintf("%.2f" , $size);
 909         my $string = "$size $unit";
 910         return $string;
 911 }
 912
 913 sub makeuuid {
 914         unless ( -e "$Conf::dbdir/uuid" ) {
 915                 open(FILE, "</proc/sys/kernel/random/uuid");
 916                 my @line = <FILE>;
 917                 close(FILE);
 918
 919                 open(FILE, ">$Conf::dbdir/uuid");
 920                 foreach (@line) {
 921                         print FILE $_;
 922                 }
 923                 close(FILE);
 924         }
 925 }
 926
 927 sub senduuid {
 928         if ($pakfiresettings{'UUID'} ne "off") {
 929                 unless("$Conf::uuid") {
 930                         $Conf::uuid = `cat $Conf::dbdir/uuid`;
 931                 }
 932                 logger("Sending my uuid: $Conf::uuid");
 933                 fetchfile("counter.py?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
 934                 system("rm -f $Conf::tmpdir/counter* 2>/dev/null");
 935         }
 936 }
 937
 938 sub callback {
 939    my ($data, $response, $protocol) = @_;
 940    $final_data .= $data;
 941    print progress_bar( length($final_data), $total_size, 30, '=' );
 942 }
 943
 944 sub progress_bar {
 945     my ( $got, $total, $width, $char ) = @_;
 946     my $show_bfile;
 947     $width ||= 30; $char ||= '=';
 948     my $len_bfile = length $bfile;
 949     if ("$len_bfile" >= "17") {
 950                         $show_bfile = substr($bfile,0,17)."...";
 951                 } else {
 952                         $show_bfile = $bfile;
 953                 }
 954                 $progress = sprintf("%.2f%%", 100*$got/+$total);
 955     sprintf "$color{'lightgreen'}%-20s %7s |%-${width}s| %10s$color{'normal'}\r",$show_bfile, $progress, $char x (($width-1)*$got/$total). '>', beautifysize($got);
 956 }
 957
 958 1;