###############################################################################
# #
# 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";
+our %color;
+ $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 {
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");
- my @db = <FILE>;
- close(FILE);
+ my %paklist = &Pakfire::dblist("all");
opendir(DIR,"$Conf::dbdir/meta");
my @files = readdir(DIR);
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);
- }
- }
- 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");
- }
+ %metadata = parsemetafile("$Conf::dbdir/meta/$file");
+
+ 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.
+ ### 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 two arguments.
- # filter may be: all, notinstalled, installed
+ # 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 @meta;
- my @updatepaks;
+ my %paklist = ();
my $file;
my $line;
- my $prog;
- my ($name, $version, $release);
+ 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/ );
- 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);
- }
- }
- foreach $prog (@db) {
- @templine = split(/\;/,$prog);
- if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" && "$forweb" ne "notice")) {
- push(@updatepaks,$name);
- if ("$forweb" eq "forweb") {
- print "<option value=\"$name\">Update: $name -- Version: $version -> $templine[1] -- Release: $release -> $templine[2]</option>\n";
- } else {
- my $command = "Update: $name\nVersion: $version -> $templine[1]\nRelease: $release -> $templine[2]\n";
- if ("$Pakfire::enable_colors" eq "1") {
- print "$color{'lila'}$command$color{'normal'}\n";
- } else {
- print "$command\n";
- }
- }
+ %metadata = parsemetafile("$Conf::dbdir/installed/$file");
+
+ 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 = "";
- $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]" );
- }
- 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;
+ };
- 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", "");
- 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");
}
-
+
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;
}
sub upgradecore {
- getcoredb("noforce");
- eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
- 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`;
- shift @seq;
- my $release;
- foreach $release (@seq) {
- 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.");
+ # 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 = ($Conf::core_mine .. $core_release);
+ shift @seq;
+ my $release;
+ foreach $release (@seq) {
+ chomp($release);
+ getpak("core-upgrade-$release");
}
+
+ foreach $release (@seq) {
+ chomp($release);
+ upgradepak("core-upgrade-$release");
+ }
+
+ system("echo $core_release > $Conf::coredir/mine");
}
sub isinstalled {
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");
+ 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";
}
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;