]> git.ipfire.org Git - people/teissler/ipfire-2.x.git/blobdiff - src/pakfire/lib/functions.pl
Ein Paar Dateien fuer die GPLv3 angepasst.
[people/teissler/ipfire-2.x.git] / src / pakfire / lib / functions.pl
index 3370162862761b4aa9945a14ebd909a9b7bc2e53..f00d31b0fa398f2f774251e39166b5b901a7ffc6 100644 (file)
@@ -1,4 +1,23 @@
 #!/usr/bin/perl -w
+###############################################################################
+#                                                                             #
+# IPFire.org - A linux based firewall                                         #
+# Copyright (C) 2007  Michael Tremer & Christian Schmidt                      #
+#                                                                             #
+# 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        #
+# the Free Software Foundation, either version 3 of the License, or           #
+# (at your option) any later version.                                         #
+#                                                                             #
+# This program is distributed in the hope that it will be useful,             #
+# but WITHOUT ANY WARRANTY; without even the implied warranty of              #
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               #
+# GNU General Public License for more details.                                #
+#                                                                             #
+# You should have received a copy of the GNU General Public License           #
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.       #
+#                                                                             #
+###############################################################################
 
 require "/opt/pakfire/etc/pakfire.conf";
 require "/var/ipfire/general-functions.pl";
@@ -111,11 +130,13 @@ sub pinghost {
 sub fetchfile {
        my $getfile = shift;
        my $gethost = shift;
-       my (@server, $host, $proto, $file, $allok, $i);
+       my (@server, $host, $proto, $file, $i);
+       my $allok = 0;
        
-       logger("DOWNLOAD STARTED: $getfile") unless ($bfile =~ /^counter\?.*/);
        use File::Basename;
        $bfile = basename("$getfile");
+       
+       logger("DOWNLOAD STARTED: $getfile") unless ($bfile =~ /^counter\?.*/);
 
        $i = 0; 
        while (($allok == 0) && $i < 5) {
@@ -210,40 +231,46 @@ sub fetchfile {
 }
 
 sub getmirrors {
+       my $force = shift;
+       my $age;
+       
        use File::Copy;
-
-       logger("MIRROR: Trying to get a mirror list.");
        
        if ( -e "$Conf::dbdir/lists/server-list.db" ) {
                my @stat = stat("$Conf::dbdir/lists/server-list.db");
                my $time = time();
                $age = $time - $stat[9];
+               $force = "force" if ("$age" >= "3600");
+               logger("MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force");
        } else {
                # Force an update.
-               $age = "86401";
+               $force = "force";
        }
        
-       if ("$age" gt "86400") {
+       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");
        }
 }
 
 sub getcoredb {
+       my $force = shift;
+       my $age;
+       
        use File::Copy;
-
-       logger("CORE: Trying to get a core list.");
        
        if ( -e "$Conf::dbdir/lists/core-list.db" ) {
                my @stat = stat("$Conf::dbdir/lists/core-list.db");
                my $time = time();
                $age = $time - $stat[9];
+               $force = "force" if ("$age" >= "3600");
+               logger("CORE INFO: core-list.db is $age seconds old. - DEBUG: $force");
        } else {
                # Force an update.
-               $age = "3601";
+               $force = "force";
        }
        
-       if ("$age" gt "3600") {
+       if ("$force" eq "force") {
                fetchfile("lists/core-list.db", "");
                move("$Conf::cachedir/core-list.db", "$Conf::dbdir/lists/core-list.db");
        }
@@ -256,7 +283,7 @@ sub selectmirror {
        my $count = 0;
        while (!(open(FILE, "<$Conf::dbdir/lists/server-list.db")) && ($count lt 5)) {
                $count++;
-               getmirrors();
+               getmirrors("noforce");
        }
        if ($count == 5) {
                message("MIRROR ERROR: Could not find or download a server list");
@@ -315,12 +342,14 @@ sub dbgetlist {
                my @stat = stat("$Conf::dbdir/lists/packages_list.db");
                my $time = time();
                $age = $time - $stat[9];
+               $force = "force" if ("$age" >= "3600");
+               logger("DB INFO: packages_list.db is $age seconds old. - DEBUG: $force");
        } else {
                # Force an update.
-               $age = "3601";
+               $force = "force";
        }
        
-       if (("$age" gt "3600") || ("$force" eq "force")) {
+       if ("$force" eq "force") {
                fetchfile("lists/packages_list.db", "");
                move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
        }
@@ -342,13 +371,28 @@ sub dblist {
        my @templine;
        
        ### Make sure that the list is not outdated. 
-       dbgetlist("noforce");
+       #dbgetlist("noforce");
 
        open(FILE, "<$Conf::dbdir/lists/packages_list.db");
        my @db = <FILE>;
        close(FILE);
 
        if ("$filter" eq "upgrade") {
+               getcoredb("noforce");
+               eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
+               if ("$core_release" gt "$Conf::core_mine") {
+                       if ("$forweb" eq "forweb") {
+                               print "<option value=\"core\">Core-Update -- $Conf::version -- Release: $Conf::core_mine -> $core_release</option>\n";
+                       } 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";
+                               }
+                       }
+               }
+       
                opendir(DIR,"$Conf::dbdir/meta");
                my @files = readdir(DIR);
                closedir(DIR);
@@ -616,7 +660,7 @@ sub setuppak {
 }
 
 sub upgradecore {
-       getcoredb();
+       getcoredb("noforce");
        eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
        if ("$core_release" gt "$Conf::core_mine") {
                message("CORE UPGR: Upgrading from release $Conf::core_mine to $core_release");
@@ -760,8 +804,9 @@ sub checkcryptodb {
        unless ( "$ret" eq "0" ) {
                message("CRYPTO WARN: The GnuPG isn't configured corectly. Trying now to fix this.");
                message("CRYPTO WARN: It's normal to see this on first execution.");
-               system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --status-fd 2 --recv-key $myid >> $Conf::logdir/gnupg-database.log 2>&1");
-               system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --status-fd 2 --recv-key $trustid >> $Conf::logdir/gnupg-database.log 2>&1");
+               my $command = "gpg --keyserver pgp.mit.edu --always-trust --status-fd 2";
+               system("$command --recv-key $myid >> $Conf::logdir/gnupg-database.log 2>&1");
+               system("$command --recv-key $trustid >> $Conf::logdir/gnupg-database.log 2>&1");
        } else {
                logger("CRYPTO INFO: Database is okay");
        }