#!/usr/bin/perl -w
require "/opt/pakfire/etc/pakfire.conf";
+require "/var/ipfire/general-functions.pl";
use File::Basename;
use File::Copy;
use LWP::UserAgent;
+use HTTP::Response;
use Net::Ping;
package Pakfire;
+my %pakfiresettings = ();
+&General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
+
sub message {
my $message = shift;
print "$message\n";
system("logger -t pakfire \"$log\"");
}
+sub usage {
+ &Pakfire::message("Usage: pakfire <install|remove> <pak(s)>");
+ &Pakfire::message(" <update> - Contacts the servers for new lists of paks.");
+ &Pakfire::message(" <upgrade> - Installs the latest version of a pak.");
+ &Pakfire::message(" <list> - Outputs a short list with all available paks.");
+ exit 1;
+}
+
sub pinghost {
my $host = shift;
}
sub fetchfile {
- my $file = shift;
- my $host = shift;
- my (@server, $proto);
+ my $getfile = shift;
+ my $gethost = shift;
+ my (@server, $host, $proto, $file, $allok, $i);
use File::Basename;
-
- if ("$host" eq "") {
- @server = selectmirror();
- $proto = $server[0];
- $host = $server[1];
- $file = "$server[2]/$file";
- }
-
- logger("Trying to get $file from $host ($proto).");
-
- $bfile = basename("$file");
-
- my $ua = LWP::UserAgent->new;
- $ua->agent('Pakfire/2.1');
- #$ua->timeout(5);
- #$ua->env_proxy;
-
- my $response = $ua->get("http://$host/$file");
- if ($response->is_success) {
- if (open(FILE, ">$Conf::cachedir/$bfile")) {
- print FILE $response->content;
- close(FILE);
+ $bfile = basename("$getfile");
+
+ $i = 0;
+ while (($allok == 0) && $i < 5) {
+ $i++;
+
+ if ("$gethost" eq "") {
+ @server = selectmirror();
+ $proto = $server[0];
+ $host = $server[1];
+ $file = "$server[2]/$getfile";
} else {
- message("Could not open $Conf::cachedir/$bfile for writing.");
+ $host = $gethost;
+ $file = $getfile;
}
- logger("$host sends file: $file.");
- return 1;
- }
- else {
- my $log = $response->status_line;
- logger("$log");
- return 0;
- }
-}
-
-sub testhost {
- my $host = shift;
-
- my $ua = LWP::UserAgent->new;
- $ua->agent('Pakfire/2.1');
- $ua->timeout(5);
- # $ua->env_proxy;
-
- my $response = $ua->get("http://$host/dummy");
- if ($response->is_success) {
- logger("$host answers my request.");
- return 1;
- }
- else {
+
+ $proto = "HTTP" unless $proto;
+
+ logger("Trying to get $file from $host ($proto).");
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("Pakfire/$Conf::version");
+ $ua->timeout(5);
+
+ my %proxysettings=();
+ &General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings);
+
+ if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
+ my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
+ if ($proxysettings{'UPSTREAM_USER'}) {
+ $ua->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$peer:$peerport/");
+ } else {
+ $ua->proxy("http","http://$peer:$peerport/");
+ }
+ }
+
+ my $response = $ua->get("http://$host/$file");
+
+ my $code = $response->code();
my $log = $response->status_line;
- logger("Server does not work properly: $log");
- return 0;
+ logger("HTTP-Status-Code: $code - $log");
+
+ if ( $code eq "500" ) {
+ message("Giving up: There was no chance to get teh file \"$getfile\" from any available server.\nThere was an error on the way. Please fix it.");
+ return 1;
+ }
+
+ if ($response->is_success) {
+ if (open(FILE, ">$Conf::cachedir/$bfile")) {
+ print FILE $response->content;
+ close(FILE);
+ logger("Download successfully done from $host (file: $file).");
+ $allok = 1;
+ return 0;
+ } else {
+ logger("Could not open $Conf::cachedir/$bfile for writing.");
+ }
+ } else {
+ logger("Download $file failed from $host ($proto): $log");
+ }
}
+ message("Giving up: 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;
}
sub getmirrors {
$proto = $templine[0];
$host = $templine[1];
$path = $templine[2];
- if ((pinghost("$host")) && testhost("$host") ) {
+ if (pinghost("$host")) {
$found = 1;
return ($proto, $host, $path);
}
}
}
- }
+ }
}
sub dbgetlist {
}
if (("$age" gt 86400) || ("$force" eq "force")) {
- cleanup();
+ #cleanup();
fetchfile("lists/packages_list.db", "");
move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
}
# filter may be: all, notinstalled, installed
my $filter = shift;
my $forweb = shift;
+ my @meta;
+ my $file;
+ my $line;
+ my $prog;
+ my ($name, $version, $release);
+ 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);
-
- my $line;
- my @templine;
- foreach $line (sort @db) {
- @templine = split(/\;/,$line);
- ### filter here...
- if ("$forweb" eq "forweb") {
- print "<option value=\"$templine[0]\">$templine[1]</option>\n";
- } else {
- print "$templine[0] $templine[1]\n";
+
+ if ("$filter" eq "upgrade") {
+ opendir(DIR,"$Conf::dbdir/meta");
+ my @files = readdir(DIR);
+ closedir(DIR);
+ foreach $file (@files) {
+ next if ( $file eq "." );
+ next if ( $file eq ".." );
+ 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" < "$templine[2]" )) {
+ if ("$forweb" eq "forweb") {
+ print "<option value=\"$name\">Update: $name -- Version: $version -> $templine[1] -- Release: $release -> $templine[2]</option>\n";
+ } else {
+ print "Update: $name\nVersion: $version -> $templine[1]\nRelease: $release -> $templine[2]\n\n";
+ }
+ }
+ }
+ }
+ } else {
+ my $line;
+ my @templine;
+ foreach $line (sort @db) {
+ @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") {
+ print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
+ } else {
+ print "Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]\n\n";
+ }
}
}
}
return $templine[1];
}
}
-}
-
-sub addsizes {
- my @paks = shift;
-
- my @sizes;
- foreach (@paks) {
- my $paksize = getsize("$_");
- push(@sizes, $paksize);
- }
-
- my $totalsize = 0;
- foreach (@sizes) {
- $totalsize += $_;
- }
- return $totalsize;
+ return 0;
}
sub decryptpak {
my $file = getpak("$pak", "noforce");
- my $return = system("gpg -d < $Conf::cachedir/$file | tar xj -C $Conf::tmpdir/");
+ my $return = system("cd $Conf::tmpdir/ && gpg -d < $Conf::cachedir/$file | cpio -i >/dev/null 2>&1");
logger("Decryption process returned the following: $return");
- if ($return == 1) { exit 1; }
+ if ($return != 0) { exit 1; }
}
sub getpak {
exit 1;
}
- message("\n## Downloading $file...");
-
unless ( "$force" eq "force" ) {
if ( -e "$Conf::cachedir/$file" ) {
- message("$file is already there. Skipping download.");
return $file;
}
}
decryptpak("$pak");
my $return = system("cd $Conf::tmpdir && ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
+ $return %= 255;
if ($return == 0) {
move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
cleanup("tmp");
+ copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
message("Setup completed. Congratulations!");
} else {
message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
exit $return;
}
-
- exit $return;
+ return $return;
}
sub updatepak {
message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
exit $return;
}
-
- exit $return;
+ return $return;
}
sub removepak {
message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
exit $return;
}
-
- exit $return;
+ return $return;
}
sub beautifysize {
my $size = shift;
+ $size = $size / 1024;
+ my $unit;
if ($size > 1023) {
- my $newsize = $size / 1024;
- return "$newsize MB";
+ $size = ($size / 1024);
+ $unit = "MB";
} else {
- return "$size KB";
+ $unit = "KB";
}
+ $size = sprintf("%.2f" , $size);
+ my $string = "$size $unit";
+ return $string;
}
+sub makeuuid {
+ unless ( -e "$Conf::dbdir/uuid" ) {
+ open(FILE, "</proc/sys/kernel/random/uuid");
+ my @line = <FILE>;
+ close(FILE);
+
+ open(FILE, ">$Conf::dbdir/uuid");
+ foreach (@line) {
+ print FILE $_;
+ }
+ close(FILE);
+ }
+}
+
+sub senduuid {
+ if ($pakfiresettings{'UUID'} eq "on") {
+ unless("$Conf::uuid") {
+ $Conf::uuid = `cat $Conf::dbdir/uuid`;
+ }
+ logger("Sending my uuid: $Conf::uuid");
+ fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
+ system("rm -f $Conf::cachedir/counter* 2>/dev/null");
+ }
+}
+
+sub lock {
+ my $status = shift;
+ if ("$status" eq "on") {
+ system("touch /opt/pakfire/pakfire.lock");
+ system("chmod 777 /opt/pakfire/pakfire.lock");
+ logger("Created lock");
+ } else {
+ if (system("rm -f /opt/pakfire/pakfire.lock >/dev/null 2>&1")) {
+ logger("Successfully removed lock.");
+ } else {
+ logger("Couldn't remove lock.");
+ }
+ }
+ return 0;
+}
+
+sub checkcryptodb {
+ my $myid = "64D96617"; # Our own gpg-key
+ my $trustid = "65D0FD58"; # Id of CaCert
+ my $ret = system("gpg --list-keys | grep -q $myid");
+ unless ( "$ret" eq "0" ) {
+ message("The GnuPG isn't configured corectly. Trying now to fix this.");
+ system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $myid");
+ system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $trustid");
+ }
+}
1;
projects / ipfire-2.x.git / blobdiff