###############################################################################
# #
# IPFire.org - A linux based firewall #
-# Copyright (C) 2007-2015 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 #
use HTTP::Message;
use HTTP::Request;
use Net::Ping;
+use URI;
use Switch;
# A small color-hash :D
my %color;
- $color{'normal'} = "\033[0m";
+ $color{'normal'} = "\033[0m";
$color{'black'} = "\033[0;30m";
$color{'darkgrey'} = "\033[1;30m";
$color{'blue'} = "\033[0;34m";
my %pakfiresettings = ();
&General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
+# Make version
+$Conf::version = &make_version();
+
+# Pakfire lock file.
+our $lockfile = "/tmp/pakfire_lock";
+
sub message {
my $message = shift;
-
+
logger("$message");
if ( $enable_colors == 1 ) {
if ("$message" =~ /ERROR/) {
}
}
print "$message\n";
-
+
}
sub logger {
&Pakfire::message(" <update> - Contacts the servers for new lists of paks.");
&Pakfire::message(" <upgrade> - Installs the latest version of all paks.");
&Pakfire::message(" <list> - Outputs a short list with all available paks.");
+ &Pakfire::message(" <status> - Outputs a summary about available core upgrades, updates and a required reboot");
&Pakfire::message("");
&Pakfire::message(" Global options:");
&Pakfire::message(" --non-interactive --> Enables the non-interactive mode.");
my $gethost = shift;
my (@server, $host, $proto, $file, $i);
my $allok = 0;
-
+
use File::Basename;
$bfile = basename("$getfile");
-
+
logger("DOWNLOAD STARTED: $getfile");
- $i = 0;
+ $i = 0;
while (($allok == 0) && $i < 5) {
$i++;
-
+
if ("$gethost" eq "") {
@server = selectmirror();
$proto = $server[0];
$host = $gethost;
$file = $getfile;
}
-
- $proto = "HTTP" unless $proto;
-
+
+ $proto = "HTTPS" unless $proto;
+
logger("DOWNLOAD INFO: Host: $host ($proto) - File: $file");
- my $ua = LWP::UserAgent->new;
+ # Init LWP::UserAgent, request SSL hostname verification
+ # and specify CA file.
+ my $ua = LWP::UserAgent->new(
+ ssl_opts => {
+ SSL_ca_file => '/etc/ssl/cert.pem',
+ verify_hostname => 1,
+ }
+ );
$ua->agent("Pakfire/$Conf::version");
$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'}\"");
if ($proxysettings{'UPSTREAM_USER'}) {
- $ua->proxy([["http", "https"] => "http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/"]);
- logger("DOWNLOAD INFO: Logging in with: \"$proxysettings{'UPSTREAM_USER'}\" - \"$proxysettings{'UPSTREAM_PASSWORD'}\"");
+ $ua->proxy(["http", "https"], "http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/");
+ logger("DOWNLOAD INFO: Logging in with \"$proxysettings{'UPSTREAM_USER'}\" against \"$proxysettings{'UPSTREAM_PROXY'}\"");
} else {
- $ua->proxy([["http", "https"] => "http://$proxysettings{'UPSTREAM_PROXY'}/"]);
+ $ua->proxy(["http", "https"], "http://$proxysettings{'UPSTREAM_PROXY'}/");
}
}
my $remote_headers = $result->headers;
$total_size = $remote_headers->content_length;
logger("DOWNLOAD INFO: $file has size of $total_size bytes");
-
+
my $response = $ua->get($url, ':content_cb' => \&callback );
message("");
-
+
my $code = $response->code();
my $log = $response->status_line;
logger("DOWNLOAD INFO: HTTP-Status-Code: $code - $log");
-
+
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) {
if (open(FILE, ">$Conf::tmpdir/$bfile")) {
print FILE $final_data;
}
logger("DOWNLOAD FINISHED: $file");
$allok = 1;
- return 0;
+ return 1;
} else {
logger("DOWNLOAD ERROR: Could not open $Conf::tmpdir/$bfile for writing.");
}
}
}
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 {
my $force = shift;
my $age;
-
+
use File::Copy;
-
+
if ( -e "$Conf::dbdir/lists/server-list.db" ) {
my @stat = stat("$Conf::dbdir/lists/server-list.db");
my $time = time();
# Force an update.
$force = "force";
}
-
+
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 {
my $force = shift;
my $age;
-
+
use File::Copy;
-
+
if ( -e "$Conf::dbdir/lists/core-list.db" ) {
my @stat = stat("$Conf::dbdir/lists/core-list.db");
my $time = time();
# Force an update.
$force = "force";
}
-
+
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");
+ }
}
}
}
sub selectmirror {
+ if (defined ${Conf::mirror}) {
+ my $uri = URI->new("${Conf::mirror}");
+
+ # Only accept HTTPS mirrors
+ if ($uri->scheme eq "https") {
+ return ("HTTPS", $uri->host, $uri->path . "/" . ${Conf::version});
+ } else {
+ message("MIRROR ERROR: Unsupported mirror: " . ${Conf::mirror});
+ }
+ }
+
### 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);
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");
+ return ("HTTPS", $Conf::mainserver, "/$Conf::version");
}
### Choose a random server and test if it is online
# Usage is always with an argument.
my $force = shift;
my $age;
-
+
use File::Copy;
-
+
if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
my @stat = stat("$Conf::dbdir/lists/packages_list.db");
my $time = time();
# Force an update.
$force = "force";
}
-
+
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
- my @meta;
my $file;
my $line;
my $prog;
- my ($name, $version, $release);
+ my %metadata;
my @templine;
open(FILE, "<$Conf::dbdir/lists/packages_list.db");
next if ( $file eq ".." );
next if ( $file eq "meta-" );
next if ( $file =~ /^old/ );
- open(FILE, "<$Conf::dbdir/meta/$file");
- @meta = <FILE>;
- 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);
- }
- }
+ %metadata = parsemetafile("$Conf::dbdir/meta/$file");
+
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");
+ 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'}");
+ getmetafile($metadata{'Name'});
}
}
}
sub dblist {
### This subroutine lists the packages.
- # You may also pass a filter: &Pakfire::dblist(filter)
+ # You may also pass a filter: &Pakfire::dblist(filter)
# Usage is always with two arguments.
# filter may be: all, notinstalled, installed
my $filter = shift;
my $forweb = shift;
- my @meta;
my @updatepaks;
my $file;
my $line;
my $prog;
- my ($name, $version, $release);
+ my %metadata;
my @templine;
-
- ### Make sure that the list is not outdated.
+
+ ### Make sure that the list is not outdated.
#dbgetlist("noforce");
open(FILE, "<$Conf::dbdir/lists/packages_list.db");
}
}
}
-
+
opendir(DIR,"$Conf::dbdir/installed");
my @files = readdir(DIR);
closedir(DIR);
next if ( $file eq "." );
next if ( $file eq ".." );
next if ( $file =~ /^old/ );
- open(FILE, "<$Conf::dbdir/installed/$file");
- @meta = <FILE>;
- 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);
- }
- }
+ %metadata = parsemetafile("$Conf::dbdir/installed/$file");
+
foreach $prog (@db) {
@templine = split(/\;/,$prog);
- if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" && "$forweb" ne "notice")) {
- push(@updatepaks,$name);
+ if (("$metadata{'Name'}" eq "$templine[0]") && ("$metadata{'Release'}" < "$templine[2]" && "$forweb" ne "notice")) {
+ push(@updatepaks,$metadata{'Name'});
if ("$forweb" eq "forweb") {
- print "<option value=\"$name\">Update: $name -- Version: $version -> $templine[1] -- Release: $release -> $templine[2]</option>\n";
+ print "<option value=\"$metadata{'Name'}\">Update: $metadata{'Name'} -- Version: $metadata{'ProgVersion'} -> $templine[1] -- Release: $metadata{'Release'} -> $templine[2]</option>\n";
} else {
- my $command = "Update: $name\nVersion: $version -> $templine[1]\nRelease: $release -> $templine[2]\n";
+ 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 {
foreach $line (sort @db) {
next unless ($line =~ /.*;.*;.*;/ );
$use_color = "";
- $count++;
@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") {
} else {
if ("$Pakfire::enable_colors" eq "1") {
if (&isinstalled("$templine[0]")) {
- $use_color = "$color{'red'}"
+ $use_color = "$color{'red'}"
} else {
$use_color = "$color{'green'}"
}
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;
+ };
- open(FILE, "<$Conf::dbdir/meta/meta-$pak");
- my @file = <FILE>;
- close(FILE);
-
- my $line;
- my (@templine, @deps, @all);
- foreach $line (@file) {
- @templine = split(/\: /,$line);
- if ("$templine[0]" eq "Dependencies") {
- @deps = split(/ /, $templine[1]);
- }
- }
+ my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
+ my @all;
+ my @deps = split(/ /, $metadata{'Dependencies'});
chomp (@deps);
foreach (@deps) {
if ($_) {
} else {
message("PAKFIRE RESV: $pak: Need to install dependency: $_");
push(@all,$_);
- }
+ }
}
}
sub cleanup {
my $dir = shift;
my $path;
-
+
logger("CLEANUP: $dir");
-
+
if ( "$dir" eq "meta" ) {
$path = "$Conf::dbdir/meta";
} elsif ( "$dir" eq "tmp" ) {
sub getmetafile {
my $pak = shift;
- unless ( -e "$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");
}
-
- if ( -z "$Conf::dbdir/meta/meta-$pak" ) {
- fetchfile("meta/meta-$pak", "");
- move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
- }
-
+
open(FILE, "<$Conf::dbdir/meta/meta-$pak");
my @line = <FILE>;
close(FILE);
-
+
open(FILE, ">$Conf::dbdir/meta/meta-$pak");
foreach (@line) {
my $string = $_;
print FILE $string;
}
close(FILE);
+
return 1;
}
sub getsize {
my $pak = shift;
-
+
getmetafile("$pak");
-
- open(FILE, "<$Conf::dbdir/meta/meta-$pak");
- my @file = <FILE>;
- close(FILE);
-
- my $line;
+
+ if (my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak")) {
+ return $metadata{'Size'};
+ }
+ return 0;
+}
+
+sub parsemetafile {
+ ### This subroutine returns a hash with the contents of a meta- file
+ # Pass path to metafile as argument: Pakfire::parsemetafile("$Conf::dbdir/meta/meta-$pak")
+ # Usage is always with an argument.
+ my $metafile = shift;
+
+ my %metadata = ();
+
my @templine;
- foreach $line (@file) {
- @templine = split(/\: /,$line);
- if ("$templine[0]" eq "Size") {
+ my @file;
+
+ if (! -e $metafile ) {
+ return 0;
+ }
+
+ open(FILE, "<$metafile");
+ @file = <FILE>;
+ close(FILE);
+
+ foreach (@file) {
+ @templine = split(/\: /,$_);
+ if ($templine[1]) {
chomp($templine[1]);
- return $templine[1];
+ $metadata{"$templine[0]"} = $templine[1];
}
}
- return 0;
+
+ return %metadata;
}
sub decryptpak {
my $pak = shift;
-
+
cleanup("tmp");
-
+
my $file = getpak("$pak", "noforce");
-
+
logger("DECRYPT STARTED: $pak");
my $return = system("cd $Conf::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf::cachedir/$file 2>/dev/null | tar x");
$return %= 255;
my $pak = shift;
my $force = shift;
- getmetafile("$pak");
-
- open(FILE, "<$Conf::dbdir/meta/meta-$pak");
- my @file = <FILE>;
- close(FILE);
-
- my $line;
- my $file;
- my @templine;
- foreach $line (@file) {
- @templine = split(/\: /,$line);
- if ("$templine[0]" eq "File") {
- chomp($templine[1]);
- $file = $templine[1];
- }
+ 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'};
+
unless ($file) {
message("No filename given in meta-file.");
exit 1;
}
-
+
unless ( "$force" eq "force" ) {
if ( -e "$Conf::cachedir/$file" ) {
return $file;
}
}
- fetchfile("paks/$file", "");
+ unless (fetchfile("paks/$file", "")) {
+ message("PAKFIRE ERROR: Unable to download $pak.");
+ exit 1;
+ }
return $file;
}
sub setuppak {
my $pak = shift;
-
+
message("PAKFIRE INST: $pak: Decrypting...");
decryptpak("$pak");
-
+
message("PAKFIRE INST: $pak: Copying files and running post-installation scripts...");
my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
$return %= 255;
getcoredb("noforce");
eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
if ("$core_release" > "$Conf::core_mine") {
+ # Safety check for lazy testers:
+ # Before we upgrade to the latest release, we re-install the previous release
+ # to make sure that the tester has always been on the latest version.
+ my $tree = &get_tree();
+ $Conf::core_mine-- if ($tree eq "testing" || $tree eq "unstable");
+
message("CORE UPGR: Upgrading from release $Conf::core_mine to $core_release");
-
+
my @seq = `seq $Conf::core_mine $core_release`;
shift @seq;
my $release;
chomp($release);
getpak("core-upgrade-$release");
}
-
+
foreach $release (@seq) {
chomp($release);
upgradepak("core-upgrade-$release");
}
-
+
system("echo $core_release > $Conf::coredir/mine");
-
+
} else {
message("CORE ERROR: No new upgrades available. You are on release $Conf::core_mine.");
}
my $size = shift;
#$size = $size / 1024;
my $unit;
-
+
if ($size > 1023*1024) {
$size = ($size / (1024*1024));
$unit = "MB";
open(FILE, "</proc/sys/kernel/random/uuid");
my @line = <FILE>;
close(FILE);
-
+
open(FILE, ">$Conf::dbdir/uuid");
foreach (@line) {
print FILE $_;
$show_bfile = substr($bfile,0,17)."...";
} else {
$show_bfile = $bfile;
- }
+ }
$progress = sprintf("%.2f%%", 100*$got/+$total);
sprintf "$color{'lightgreen'}%-20s %7s |%-${width}s| %10s$color{'normal'}\r",$show_bfile, $progress, $char x (($width-1)*$got/$total). '>', beautifysize($got);
}
+sub updates_available {
+ # Get packets with updates available
+ my @upgradepaks = &Pakfire::dblist("upgrade", "noweb");
+
+ # Get the length of the returned array
+ my $updatecount = scalar @upgradepaks;
+
+ return "$updatecount";
+}
+
+sub coreupdate_available {
+ eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
+ if ("$core_release" > "$Conf::core_mine") {
+ return "yes ($core_release)";
+ }
+ else {
+ return "no";
+ }
+}
+
+sub reboot_required {
+ if ( -e "/var/run/need_reboot" ) {
+ return "yes";
+ }
+ else {
+ return "no";
+ }
+}
+
+sub status {
+ # General info
+ my $return = "Core-Version: $Conf::version\n";
+ $return .= "Core-Update-Level: $Conf::core_mine\n";
+ $return .= "Last update: " . &General::age("/opt/pakfire/db/core/mine") . " ago\n";
+ $return .= "Last core-list update: " . &General::age("/opt/pakfire/db/lists/core-list.db") . " ago\n";
+ $return .= "Last server-list update: " . &General::age("/opt/pakfire/db/lists/server-list.db") . " ago\n";
+ $return .= "Last packages-list update: " . &General::age("/opt/pakfire/db/lists/packages_list.db") . " ago\n";
+
+ # Get availability of core updates
+ $return .= "Core-Update available: " . &Pakfire::coreupdate_available() . "\n";
+
+ # Get availability of package updates
+ $return .= "Package-Updates available: " . &Pakfire::updates_available() . "\n";
+
+ # Test if reboot is required
+ $return .= "Reboot required: " . &Pakfire::reboot_required() . "\n";
+
+ # Return status text
+ print "$return";
+ exit 1;
+}
+
+sub get_arch() {
+ # Append architecture
+ my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
+
+ # We only support armv6l for 32 bit arm
+ if ($machine =~ m/armv[67]/) {
+ return "armv6l";
+ }
+
+ return $machine;
+}
+
+sub get_tree() {
+ # Return stable if nothing is set
+ return "stable" unless (defined $pakfiresettings{'TREE'});
+
+ return $pakfiresettings{'TREE'};
+}
+
+sub make_version() {
+ my $version = "";
+
+ # Open /etc/system-release
+ open(RELEASE, "</etc/system-release");
+ my $release = <RELEASE>;
+ close(RELEASE);
+
+ # Add the main relase
+ if ($release =~ m/IPFire ([\d\.]+)/) {
+ $version .= $1;
+ }
+
+ # Append suffix for tree
+ my $tree = &get_tree();
+ if ($tree eq "testing") {
+ $version .= ".1";
+ } elsif ($tree eq "unstable") {
+ $version .= ".2";
+ }
+
+ # Append architecture
+ $version .= "-" . &get_arch();
+
+ return $version;
+}
+
1;
projects / ipfire-2.x.git / blobdiff