X-Git-Url: http://git.ipfire.org/?p=ipfire-2.x.git;a=blobdiff_plain;f=src%2Fpakfire%2Flib%2Ffunctions.pl;h=cfb7e51175f30a7ffb790ade89a7ae5a19bc38f9;hp=8544e054f191765555bd07ab55a749e5e7d21ec6;hb=bb6481a82072cf2df27306508c8b72b584eb4f80;hpb=8a8a50ad09fa96292c21f5096c6b617f38e3791d diff --git a/src/pakfire/lib/functions.pl b/src/pakfire/lib/functions.pl index 8544e054f1..cfb7e51175 100644 --- a/src/pakfire/lib/functions.pl +++ b/src/pakfire/lib/functions.pl @@ -1,4 +1,23 @@ #!/usr/bin/perl -w +############################################################################### +# # +# IPFire.org - A linux based firewall # +# Copyright (C) 2007-2015 IPFire Team # +# # +# 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 . # +# # +############################################################################### require "/opt/pakfire/etc/pakfire.conf"; require "/var/ipfire/general-functions.pl"; @@ -15,8 +34,8 @@ use Net::Ping; package Pakfire; # GPG Keys -my $myid = "64D96617"; # Our own gpg-key paks@ipfire.org -my $trustid = "65D0FD58"; # gpg-key of CaCert +my $myid = "179740DC4D8C47DC63C099C74BDE364C64D96617"; # Our own gpg-key paks@ipfire.org +my $trustid = "A31D4F81EF4EBD07B456FA04D2BB0D0165D0FD58"; # gpg-key of CaCert # A small color-hash :D my %color; @@ -74,8 +93,8 @@ sub message { sub logger { my $log = shift; if ($log) { - system("echo \"`date`: $log\" >> /var/log/pakfire.log"); - #system("logger -t pakfire \"$log\""); + #system("echo \"`date`: $log\" >> /var/log/pakfire.log"); + system("logger -t pakfire \"$log\""); } } @@ -97,9 +116,9 @@ sub usage { sub pinghost { my $host = shift; - $p = Net::Ping->new(); + $p = Net::Ping->new("icmp"); if ($p->ping($host)) { - logger("PING INFO: $host is alive"); + logger("PING INFO: $host is alive"); return 1; } else { logger("PING INFO: $host is unreachable"); @@ -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) { @@ -139,16 +160,16 @@ sub fetchfile { my $ua = LWP::UserAgent->new; $ua->agent("Pakfire/$Conf::version"); - $ua->timeout(5); + $ua->timeout(20); my %proxysettings=(); &General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings); if ($proxysettings{'UPSTREAM_PROXY'}) { - logger("DOWNLOAD INFO: Upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\"") unless ($bfile =~ /^counter\?.*/); + logger("DOWNLOAD INFO: Upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\"") unless ($bfile =~ /^counter.py\?.*/); if ($proxysettings{'UPSTREAM_USER'}) { $ua->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/"); - logger("DOWNLOAD INFO: Logging in with: \"$proxysettings{'UPSTREAM_USER'}\" - \"$proxysettings{'UPSTREAM_PASSWORD'}\"") unless ($bfile =~ /^counter\?.*/); + logger("DOWNLOAD INFO: Logging in with: \"$proxysettings{'UPSTREAM_USER'}\" - \"$proxysettings{'UPSTREAM_PASSWORD'}\"") unless ($bfile =~ /^counter.py\?.*/); } else { $ua->proxy("http","http://$proxysettings{'UPSTREAM_PROXY'}/"); } @@ -158,7 +179,7 @@ sub fetchfile { my $url = "http://$host/$file"; my $response; - unless ($bfile =~ /^counter\?.*/) { + unless ($bfile =~ /^counter.py\?.*/) { my $result = $ua->head($url); my $remote_headers = $result->headers; $total_size = $remote_headers->content_length; @@ -180,7 +201,7 @@ sub fetchfile { } if ($response->is_success) { - unless ($bfile =~ /^counter\?.*/) { + unless ($bfile =~ /^counter.py\?.*/) { if (open(FILE, ">$Conf::tmpdir/$bfile")) { print FILE $final_data; close(FILE); @@ -190,13 +211,16 @@ sub fetchfile { move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile"); } else { message("DOWNLOAD ERROR: The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting..."); + my $ntp = `ntpdate -q -t 10 pool.ntp.org 2>/dev/null | tail -1`; + if ( $ntp !~ /time\ server(.*)offset(.*)/ ){message("TIME ERROR: Unable to get the nettime, this may lead to the verification error.");} + else { $ntp =~ /time\ server(.*)offset(.*)/; message("TIME INFO: Time Server$1has$2 offset to localtime.");} exit 1; } logger("DOWNLOAD FINISHED: $file"); $allok = 1; return 0; } else { - logger("DOWNLOAD ERROR: Could not open $Conf::cachedir/$bfile for writing."); + logger("DOWNLOAD ERROR: Could not open $Conf::tmpdir/$bfile for writing."); } } else { return 0; @@ -210,40 +234,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 +286,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"); @@ -275,12 +305,18 @@ sub selectmirror { } } logger("MIRROR INFO: $scount servers found in list"); - + + if ($scount eq 0) { + logger("MIRROR INFO: Could not find any servers. Falling back to main server $Conf::mainserver"); + return ("HTTP", $Conf::mainserver, "/$Conf::version"); + } + ### Choose a random server and test if it is online # If the check fails try a new server. # This will never give up. my $found = 0; my $servers = 0; + my $pingdelay = 1; while ($found == 0) { $server = int(rand($scount) + 1); $servers = 0; @@ -293,10 +329,22 @@ sub selectmirror { $proto = $templine[0]; $host = $templine[1]; $path = $templine[2]; - if (pinghost("$host")) { + if ($pakfiresettings{'HEALTHCHECK'} eq "off") { + logger("PING INFO: Healthcheck is disabled"); $found = 1; return ($proto, $host, $path); } + elsif (pinghost("$host")) { + $found = 1; + return ($proto, $host, $path); + } + if ($found == 0) { + sleep($pingdelay); + $pingdelay=$pingdelay*2; + if ($pingdelay>1200) { + $pingdelay=1200; + } + } } } } @@ -315,15 +363,63 @@ 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"); } + + # Update the meta database if new packages was in the package list + my @meta; + my $file; + my $line; + my $prog; + my ($name, $version, $release); + my @templine; + + open(FILE, "<$Conf::dbdir/lists/packages_list.db"); + my @db = ; + close(FILE); + + opendir(DIR,"$Conf::dbdir/meta"); + my @files = readdir(DIR); + closedir(DIR); + foreach $file (@files) { + next if ( $file eq "." ); + next if ( $file eq ".." ); + next if ( $file eq "meta-" ); + next if ( $file =~ /^old/ ); + open(FILE, "<$Conf::dbdir/meta/$file"); + @meta = ; + close(FILE); + foreach $line (@meta) { + @templine = split(/\: /,$line); + if ("$templine[0]" eq "Name") { + $name = $templine[1]; + chomp($name); + } elsif ("$templine[0]" eq "ProgVersion") { + $version = $templine[1]; + chomp($version); + } elsif ("$templine[0]" eq "Release") { + $release = $templine[1]; + chomp($release); + } + } + foreach $prog (@db) { + @templine = split(/\;/,$prog); + if (("$name" eq "$templine[0]") && ("$release" ne "$templine[2]")) { + move("$Conf::dbdir/meta/meta-$name","$Conf::dbdir/meta/old_meta-$name"); + fetchfile("meta/meta-$name", ""); + move("$Conf::cachedir/meta-$name", "$Conf::dbdir/meta/meta-$name"); + } + } + } } sub dblist { @@ -342,18 +438,21 @@ 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 = ; close(FILE); if ("$filter" eq "upgrade") { - getcoredb(); + if ("$forweb" ne "forweb" && "$forweb" ne "notice" ) {getcoredb("noforce");} eval(`grep "core_" $Conf::dbdir/lists/core-list.db`); - if ("$core_release" gt "$Conf::core_mine") { + if ("$core_release" > "$Conf::core_mine") { if ("$forweb" eq "forweb") { print "\n"; + } + elsif ("$forweb" eq "notice") { + print "


$Lang::tr{'core notice 1'} $Conf::core_mine $Lang::tr{'core notice 2'} $core_release $Lang::tr{'core notice 3'}"; } else { my $command = "Core-Update $Conf::version\nRelease: $Conf::core_mine -> $core_release\n"; if ("$Pakfire::enable_colors" eq "1") { @@ -364,13 +463,14 @@ sub dblist { } } - opendir(DIR,"$Conf::dbdir/meta"); + opendir(DIR,"$Conf::dbdir/installed"); my @files = readdir(DIR); closedir(DIR); foreach $file (@files) { next if ( $file eq "." ); next if ( $file eq ".." ); - open(FILE, "<$Conf::dbdir/meta/$file"); + next if ( $file =~ /^old/ ); + open(FILE, "<$Conf::dbdir/installed/$file"); @meta = ; close(FILE); foreach $line (@meta) { @@ -388,7 +488,7 @@ sub dblist { } foreach $prog (@db) { @templine = split(/\;/,$prog); - if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" )) { + if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" && "$forweb" ne "notice")) { push(@updatepaks,$name); if ("$forweb" eq "forweb") { print "\n"; @@ -419,8 +519,13 @@ sub dblist { } elsif ("$filter" eq "installed") { next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" ); } - if ("$forweb" eq "forweb") { - print "\n"; + if ("$forweb" eq "forweb") + { + if ("$filter" eq "notinstalled") { + print "\n"; + } else { + print "\n"; + } } else { if ("$Pakfire::enable_colors" eq "1") { if (&isinstalled("$templine[0]")) { @@ -436,7 +541,7 @@ sub dblist { } } -sub resolvedeps { +sub resolvedeps_one { my $pak = shift; getmetafile("$pak"); @@ -448,7 +553,7 @@ sub resolvedeps { close(FILE); my $line; - my (@templine, @deps, @tempdeps, @all); + my (@templine, @deps, @all); foreach $line (@file) { @templine = split(/\: /,$line); if ("$templine[0]" eq "Dependencies") { @@ -463,33 +568,63 @@ sub resolvedeps { message("PAKFIRE RESV: $pak: Dependency is already installed: $_"); } else { message("PAKFIRE RESV: $pak: Need to install dependency: $_"); - push(@tempdeps,$_); push(@all,$_); } } } - foreach (@tempdeps) { - if ($_) { - my @newdeps = resolvedeps("$_"); - foreach(@newdeps) { - unless (($_ eq " ") || ($_ eq "")) { - my $return = &isinstalled($_); - if ($return eq 0) { - message("PAKFIRE RESV: $pak: Dependency is already installed: $_"); - } else { - message("PAKFIRE RESV: $pak: Need to install dependency: $_"); - push(@all,$_); - } - } + return @all; +} + +sub resolvedeps { + my $pak = shift; + my @all; + + # Resolve all not yet installed dependencies of $pak + my @deps = &resolvedeps_one($pak); + push(@all, @deps); + + # For each dependency, we check if more dependencies exist + while (@deps) { + my $dep = pop(@deps); + + my @subdeps = &resolvedeps_one($dep); + foreach my $subdep (@subdeps) { + # Skip the package we are currently resolving for + next if ($pak eq $subdep); + + # If the package is not already to be installed, + # we add it to the list (@all) and check if it has + # more dependencies on its own. + unless (grep {$_ eq $subdep} @all) { + push(@deps, $subdep); + push(@all, $subdep); } } } - message(""); - chomp (@all); + return @all; } +sub resolvedeps_recursive { + my @packages = @_; + my @result = (); + + foreach my $pkg (@packages) { + my @deps = &Pakfire::resolvedeps($pkg); + + foreach my $dep (@deps) { + push(@result, $dep); + } + } + + # Sort the result array and remove dupes + my %sort = map{ $_, 1 } @result; + @result = keys %sort; + + return @result; +} + sub cleanup { my $dir = shift; my $path; @@ -515,7 +650,12 @@ sub cleanup { sub getmetafile { my $pak = shift; - unless ( -e "$Conf::dbdir/meta/meta-$pak") { + 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", ""); move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak"); } @@ -591,7 +731,7 @@ sub getpak { } unless ($file) { - message("No filename given in meta-file. Please phone the developers."); + message("No filename given in meta-file."); exit 1; } @@ -615,7 +755,7 @@ sub setuppak { my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1"); $return %= 255; if ($pakfiresettings{'UUID'} ne "off") { - fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&ipak=$pak&return=$return", "$Conf::mainserver"); + fetchfile("counter.py?ver=$Conf::version&uuid=$Conf::uuid&ipak=$pak&return=$return", "$Conf::mainserver"); } if ($return == 0) { move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak"); @@ -631,9 +771,9 @@ sub setuppak { } sub upgradecore { - getcoredb(); + getcoredb("noforce"); eval(`grep "core_" $Conf::dbdir/lists/core-list.db`); - if ("$core_release" gt "$Conf::core_mine") { + if ("$core_release" > "$Conf::core_mine") { message("CORE UPGR: Upgrading from release $Conf::core_mine to $core_release"); my @seq = `seq $Conf::core_mine $core_release`; @@ -676,12 +816,12 @@ sub upgradepak { my $return = system("cd $Conf::tmpdir && NAME=$pak ./update.sh >> $Conf::logdir/update-$pak.log 2>&1"); $return %= 255; if ($pakfiresettings{'UUID'} ne "off") { - fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&upak=$pak&return=$return", "$Conf::mainserver"); + fetchfile("counter.py?ver=$Conf::version&uuid=$Conf::uuid&upak=$pak&return=$return", "$Conf::mainserver"); } if ($return == 0) { move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak"); cleanup("tmp"); - copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/"); + copy("$Conf::dbdir/meta/meta-$pak", "$Conf::dbdir/installed/"); message("PAKFIRE UPGR: $pak: Finished."); message(""); } else { @@ -701,18 +841,9 @@ sub removepak { my $return = system("cd $Conf::tmpdir && NAME=$pak ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1"); $return %= 255; if ($pakfiresettings{'UUID'} ne "off") { - fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&dpak=$pak&return=$return", "$Conf::mainserver"); + fetchfile("counter.py?ver=$Conf::version&uuid=$Conf::uuid&dpak=$pak&return=$return", "$Conf::mainserver"); } if ($return == 0) { - open(FILE, "<$Conf::dbdir/rootfiles/$pak"); - my @file = ; - close(FILE); - foreach (@file) { - my $line = $_; - chomp($line); - system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1"); - system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1"); - } unlink("$Conf::dbdir/rootfiles/$pak"); unlink("$Conf::dbdir/installed/meta-$pak"); cleanup("tmp"); @@ -764,7 +895,7 @@ sub senduuid { $Conf::uuid = `cat $Conf::dbdir/uuid`; } logger("Sending my uuid: $Conf::uuid"); - fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver"); + fetchfile("counter.py?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver"); system("rm -f $Conf::tmpdir/counter* 2>/dev/null"); } } @@ -775,7 +906,8 @@ 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."); - my $command = "gpg --keyserver pgp.mit.edu --always-trust --status-fd 2"; + message("CRYPTO WARN: If this message is being shown repeatedly, check if time and date are set correctly, and if IPFire can connect via port 11371 TCP."); + my $command = "gpg --keyserver pgp.ipfire.org --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 {