]> git.ipfire.org Git - ipfire-2.x.git/blobdiff - src/pakfire/lib/functions.pl
pakfire: Replace dbgetlist duplicate code
[ipfire-2.x.git] / src / pakfire / lib / functions.pl
index d4e338f23ae8ae97d6f18c6d8890d13463dc5d30..971aa2d5956c0d96182efaa1fb7246592e0d14c0 100644 (file)
@@ -2,7 +2,7 @@
 ###############################################################################
 #                                                                             #
 # IPFire.org - A linux based firewall                                         #
-# Copyright (C) 2007-2021   IPFire Team   <info@ipfire.org>                   #
+# Copyright (C) 2007-2022   IPFire Team   <info@ipfire.org>                   #
 #                                                                             #
 # This program is free software: you can redistribute it and/or modify        #
 # it under the terms of the GNU General Public License as published by        #
@@ -44,7 +44,7 @@ my @VALID_KEY_FINGERPRINTS = (
 );
 
 # A small color-hash :D
-my %color;
+our %color;
        $color{'normal'}      = "\033[0m";
        $color{'black'}       = "\033[0;30m";
        $color{'darkgrey'}    = "\033[1;30m";
@@ -206,7 +206,7 @@ sub fetchfile {
 
                if ( $code eq "500" ) {
                        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.");
-                       return 1;
+                       return 0;
                }
 
                if ($response->is_success) {
@@ -226,7 +226,7 @@ sub fetchfile {
                                }
                                logger("DOWNLOAD FINISHED: $file");
                                $allok = 1;
-                               return 0;
+                               return 1;
                        } else {
                                logger("DOWNLOAD ERROR: Could not open $Conf::tmpdir/$bfile for writing.");
                        }
@@ -235,7 +235,7 @@ sub fetchfile {
                }
        }
        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.");
-       return 1;
+       return 0;
 }
 
 sub getmirrors {
@@ -256,9 +256,14 @@ sub getmirrors {
        }
 
        if ("$force" eq "force") {
-               fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver");
-               move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
+               if (fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver")) {
+                       move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
+               } elsif (! -e "$Conf::dbdir/lists/server-list.db" ) {
+                       # if we end up with no server-list at all, return failure
+                       return 0;
+               }
        }
+       return 1;
 }
 
 sub getcoredb {
@@ -279,8 +284,9 @@ sub getcoredb {
        }
 
        if ("$force" eq "force") {
-               fetchfile("lists/core-list.db", "");
-               move("$Conf::cachedir/core-list.db", "$Conf::dbdir/lists/core-list.db");
+               if (fetchfile("lists/core-list.db", "")) {
+                       move("$Conf::cachedir/core-list.db", "$Conf::dbdir/lists/core-list.db");
+               }
        }
 }
 
@@ -318,15 +324,13 @@ sub selectmirror {
 
        ### Check if there is a current server list and read it.
        #   If there is no list try to get one.
-       my $count = 0;
-       while (!(open(FILE, "<$Conf::dbdir/lists/server-list.db")) && ($count lt 5)) {
-               $count++;
-               getmirrors("noforce");
-       }
-       if ($count == 5) {
-               message("MIRROR ERROR: Could not find or download a server list");
-               exit 1;
+       unless (open(FILE, "<$Conf::dbdir/lists/server-list.db")) {
+               unless (getmirrors("noforce")) {
+                       message("MIRROR ERROR: Could not find or download a server list");
+                       exit 1;
+               }
        }
+
        my @lines = <FILE>;
        close(FILE);
 
@@ -390,8 +394,13 @@ sub dbgetlist {
        }
 
        if ("$force" eq "force") {
-               fetchfile("lists/packages_list.db", "");
-               move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
+               if (fetchfile("lists/packages_list.db", "")) {
+                       move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
+               } elsif ( -e "$Conf::dbdir/lists/packages_list.db" ) {
+                       # If we end up with no db file after download error there
+                       # is nothing more we can do here.
+                       return 0;
+               }
        }
 
        # Update the meta database if new packages was in the package list
@@ -401,9 +410,7 @@ sub dbgetlist {
        my %metadata;
        my @templine;
 
-       open(FILE, "<$Conf::dbdir/lists/packages_list.db");
-       my @db = <FILE>;
-       close(FILE);
+    my %paklist = &Pakfire::dblist("all");
 
        opendir(DIR,"$Conf::dbdir/meta");
        my @files = readdir(DIR);
@@ -415,128 +422,135 @@ sub dbgetlist {
                next if ( $file =~ /^old/ );
                %metadata = parsemetafile("$Conf::dbdir/meta/$file");
 
-               foreach $prog (@db) {
-                       @templine = split(/\;/,$prog);
-                       if (("$metadata{'Name'}" eq "$templine[0]") && ("$metadata{'Release'}" ne "$templine[2]")) {
-                               move("$Conf::dbdir/meta/meta-$metadata{'Name'}","$Conf::dbdir/meta/old_meta-$metadata{'Name'}");
-                               fetchfile("meta/meta-$metadata{'Name'}", "");
-                               move("$Conf::cachedir/meta-$metadata{'Name'}", "$Conf::dbdir/meta/meta-$metadata{'Name'}");
-                       }
+               if ((defined $paklist{"$metadata{'Name'}"}) && (
+                       ("$paklist{\"$metadata{'Name'}\"}{'Release'}" ne "$metadata{'Release'}") ||
+                       (defined $paklist{"$metadata{'Name'}"}{'AvailableRelease'}))
+                  ) {
+                       move("$Conf::dbdir/meta/meta-$metadata{'Name'}","$Conf::dbdir/meta/old_meta-$metadata{'Name'}");
+                       getmetafile($metadata{'Name'});
                }
        }
 }
 
+sub coredbinfo {
+       ### This subroutine returns core db version information in a hash.
+       # Usage is without arguments
+
+       eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
+
+       my %coredb = (
+               CoreVersion => $Conf::version,
+               Release => $Conf::core_mine,
+       );
+
+       $coredb{'AvailableRelease'} = $core_release if ("$Conf::core_mine" < "$core_release");
+
+       return %coredb;
+}
+
 sub dblist {
-       ### This subroutine lists the packages.
-       #   You may also pass a filter: &Pakfire::dblist(filter)
-       #   Usage is always with two arguments.
-       #   filter may be: all, notinstalled, installed
+       ### This subroutine returns the packages from the packages_list db in a hash.
+       #   It uses the currently cached version of packages_list. To ensure latest 
+       #   data, run Pakfire::dbgetlist first.
+       #   You may also pass a filter: &Pakfire::dblist(filter) 
+       #   Usage is always with one argument.
+       #   filter may be: 
+       #               - "all": list all known paks,
+       #               - "notinstalled": list only not installed paks,
+       #               - "installed": list only installed paks
+       #               - "upgrade": list only upgradable paks
+       #
+       #   Returned hash format:
+    #   ( "<pak name>" => (
+       #       "Installed" => "Yes" or "No" wether the pak is installed,
+       #       "ProgVersion" => Installed program version when "Installed" => "Yes" or
+    #                        Available version when "Installed" => No,
+       #       "Release" => Installed pak release number when "Installed" => "Yes" or
+    #                    Available pak release number when "Installed" => No,
+       #       "AvailableProgVersion" => Available program version. 
+       #                                 Only defined if an upgrade to a higher version is available,
+       #       "AvailableRelease" => Available pak release version. 
+       #                             Only defined if an upgrade to a higher version is available
+       #         ),
+       #         ...   
+       #   )
+       
        my $filter = shift;
-       my $forweb = shift;
-       my @updatepaks;
+       my %paklist = ();
        my $file;
        my $line;
-       my $prog;
        my %metadata;
        my @templine;
-
-       ### Make sure that the list is not outdated.
-       #dbgetlist("noforce");
-
+       
        open(FILE, "<$Conf::dbdir/lists/packages_list.db");
        my @db = <FILE>;
        close(FILE);
 
-       if ("$filter" eq "upgrade") {
-               if ("$forweb" ne "forweb" && "$forweb" ne "notice" ) {getcoredb("noforce");}
-               eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
-               if ("$core_release" > "$Conf::core_mine") {
-                       if ("$forweb" eq "forweb") {
-                               print "<option value=\"core\">Core-Update -- $Conf::version -- Release: $Conf::core_mine -> $core_release</option>\n";
-                       }
-                       elsif ("$forweb" eq "notice") {
-                               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>";
-                       } else {
-                               my $command = "Core-Update $Conf::version\nRelease: $Conf::core_mine -> $core_release\n";
-                               if ("$Pakfire::enable_colors" eq "1") {
-                                       print "$color{'lila'}$command$color{'normal'}\n";
-                               } else {
-                                       print "$command\n";
-                               }
-                       }
-               }
-
+       if ("$filter" ne "notinstalled") {
                opendir(DIR,"$Conf::dbdir/installed");
                my @files = readdir(DIR);
                closedir(DIR);
+
                foreach $file (@files) {
                        next if ( $file eq "." );
                        next if ( $file eq ".." );
                        next if ( $file =~ /^old/ );
                        %metadata = parsemetafile("$Conf::dbdir/installed/$file");
 
-                       foreach $prog (@db) {
-                               @templine = split(/\;/,$prog);
-                               if (("$metadata{'Name'}" eq "$templine[0]") && ("$metadata{'Release'}" < "$templine[2]" && "$forweb" ne "notice")) {
-                                       push(@updatepaks,$metadata{'Name'});
-                                       if ("$forweb" eq "forweb") {
-                                               print "<option value=\"$metadata{'Name'}\">Update: $metadata{'Name'} -- Version: $metadata{'ProgVersion'} -> $templine[1] -- Release: $metadata{'Release'} -> $templine[2]</option>\n";
-                                       } else {
-                                               my $command = "Update: $metadata{'Name'}\nVersion: $metadata{'ProgVersion'} -> $templine[1]\nRelease: $metadata{'Release'} -> $templine[2]\n";
-                                               if ("$Pakfire::enable_colors" eq "1") {
-                                                       print "$color{'lila'}$command$color{'normal'}\n";
-                                               } else {
-                                                       print "$command\n";
-                                               }
-                                       }
+                       foreach $line (@db) {
+                               next unless ($line =~ /.*;.*;.*;/ );
+                               @templine = split(/\;/,$line);
+                               if (("$metadata{'Name'}" eq "$templine[0]") && ("$metadata{'Release'}" < "$templine[2]")) {
+                                       # Add all upgradable paks to list
+                                       $paklist{"$metadata{'Name'}"} = {
+                                               ProgVersion => $metadata{'ProgVersion'},
+                                               Release => $metadata{'Release'},
+                                               AvailableProgVersion => $templine[1],
+                                               AvailableRelease => $templine[2],
+                                               Installed => "yes"
+                                       };
+                                       last;
+                               } elsif (("$metadata{'Name'}" eq "$templine[0]") && ("$filter" ne "upgrade")) {
+                                       # Add installed paks without an upgrade available to list
+                                       $paklist{"$metadata{'Name'}"} = {
+                                               ProgVersion => $metadata{'ProgVersion'},
+                                               Release => $metadata{'Release'},
+                                               Installed => "yes"
+                                       };
+                                       last;
                                }
                        }
                }
-               return @updatepaks;
-       } else {
-               my $line;
-               my $use_color;
-               my @templine;
-               my $count;
-               foreach $line (sort @db) {
+       }
+
+       # Add all not installed paks to list
+       if (("$filter" ne "upgrade") && ("$filter" ne "installed")) {
+               foreach $line (@db) {
                        next unless ($line =~ /.*;.*;.*;/ );
-                       $use_color = "";
                        @templine = split(/\;/,$line);
-                       if ("$filter" eq "notinstalled") {
-                               next if ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
-                       } elsif ("$filter" eq "installed") {
-                               next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
-                       }
-                       $count++;
-                       if ("$forweb" eq "forweb")
-                        {
-                               if ("$filter" eq "notinstalled") {
-                                       print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
-                               } else {
-                                       print "<option value=\"$templine[0]\">$templine[0]</option>\n";
-                               }
-                       } else {
-                               if ("$Pakfire::enable_colors" eq "1") {
-                                       if (&isinstalled("$templine[0]")) {
-                                               $use_color = "$color{'red'}"
-                                       } else {
-                                               $use_color = "$color{'green'}"
-                                       }
-                               }
-                               print "${use_color}Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]$color{'normal'}\n\n";
-                       }
+                       next if ((defined $paklist{"$templine[0]"}) || (&isinstalled($templine[0]) == 0));
+
+                       $paklist{"$templine[0]"} = {
+                               ProgVersion => "$templine[1]",
+                               Release => "$templine[2]",
+                               Installed => "no"
+                       };
                }
-               print "$count packages total.\n" unless ("$forweb" eq "forweb");
        }
+
+       return %paklist;
 }
 
 sub resolvedeps_one {
        my $pak = shift;
-
-       getmetafile("$pak");
-
+       
        message("PAKFIRE RESV: $pak: Resolving dependencies...");
 
+       unless (getmetafile("$pak")) {
+               message("PAKFIRE ERROR: Error retrieving dependency information on $pak. Unable to resolve dependencies.");
+               exit 1;
+       };
+       
        my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
        my @all;
        my @deps = split(/ /, $metadata{'Dependencies'});
@@ -629,14 +643,10 @@ sub cleanup {
 
 sub getmetafile {
        my $pak = shift;
-
-       unless ( -e "$Conf::dbdir/meta/meta-$pak" ) {
-               fetchfile("meta/meta-$pak", "");
-               move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
-       }
-
-       if ( -z "$Conf::dbdir/meta/meta-$pak" ) {
-               fetchfile("meta/meta-$pak", "");
+       
+       # Try to download meta-file if we don't have one yet, or it is empty for some reason
+       if ((! -e "$Conf::dbdir/meta/meta-$pak" ) || ( -z "$Conf::dbdir/meta/meta-$pak" )) {
+               return 0 unless (fetchfile("meta/meta-$pak", ""));
                move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
        }
 
@@ -651,6 +661,7 @@ sub getmetafile {
                print FILE $string;
        }
        close(FILE);
+
        return 1;
 }
 
@@ -713,8 +724,11 @@ sub getpak {
        my $pak = shift;
        my $force = shift;
 
-       getmetafile("$pak");
-
+       unless (getmetafile("$pak")) {
+               message("PAKFIRE ERROR: Unable to retrieve $pak metadata.");
+               exit 1;
+       }
+       
        my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
        my $file = $metadata{'File'};
 
@@ -728,8 +742,11 @@ sub getpak {
                        return $file;
                }
        }
-
-       fetchfile("paks/$file", "");
+       
+       unless (fetchfile("paks/$file", "")) {
+               message("PAKFIRE ERROR: Unable to download $pak.");
+               exit 1;
+       }
        return $file;
 }
 
@@ -783,7 +800,7 @@ sub upgradecore {
                system("echo $core_release > $Conf::coredir/mine");
 
        } else {
-               message("CORE ERROR: No new upgrades available. You are on release $Conf::core_mine.");
+               message("CORE INFO: No new upgrades available. You are on release $Conf::core_mine.");
        }
 }
 
@@ -896,10 +913,10 @@ sub progress_bar {
 
 sub updates_available {
        # Get packets with updates available
-       my @upgradepaks = &Pakfire::dblist("upgrade", "noweb");
+       my %upgradepaks = &Pakfire::dblist("upgrade");
 
-       # Get the length of the returned array
-       my $updatecount = scalar @upgradepaks;
+       # Get the length of the returned hash
+       my $updatecount = keys %upgradepaks;
 
        return "$updatecount";
 }