[ipfire-2.x.git] / src / pakfire / lib / functions.pl

#!/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 HTTP::Headers;
use HTTP::Message;
use HTTP::Request;
use Net::Ping;

package Pakfire;

my $final_data;
my $total_size;
my $bfile;

my %pakfiresettings = ();
&General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);

sub message {
	my $message = shift;
	print "$message\n";
	logger("$message");
}

sub logger {
	my $log = shift;
	system("logger -t pakfire \"$log\"") if "$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 all paks.");
  &Pakfire::message("               <list> - Outputs a short list with all available paks.");
  &Pakfire::message("");
  exit 1;
}

sub pinghost {
	my $host = shift;
	
	$p = Net::Ping->new();
  if ($p->ping($host)) {
  	logger("PING INFO: $host is alive");
  	return 1;
  } else {
		logger("PING INFO: $host is unreachable");
		return 0;
	}
  $p->close();
}

sub fetchfile {
	my $getfile = shift;
	my $gethost = shift;
	my (@server, $host, $proto, $file, $allok, $i);
	
	logger("DOWNLOAD STARTED: $getfile") unless ($bfile =~ /^counter\?.*/);
	use File::Basename;
	$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 {
			$host = $gethost;
			$file = $getfile;
		}
		
		$proto = "HTTP" unless $proto;
		
		unless ($bfile =~ /^counter\?.*/) {
			logger("DOWNLOAD INFO: Host: $host ($proto) - File: $file");
			#message("DOWNLOAD INFO: Loading $bfile from ($proto) $host...");
		}

		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'}) {
			logger("DOWNLOAD INFO: Upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\"") unless ($bfile =~ /^counter\?.*/); 
			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\?.*/);
			} else {
				$ua->proxy("http","http://$proxysettings{'UPSTREAM_PROXY'}/");
			}
		}

		$final_data = undef;
	 	my $url = "http://$host/$file";
		my $response;
		
		unless ($bfile =~ /^counter\?.*/) {
			my $result = $ua->head($url);
			my $remote_headers = $result->headers;
			$total_size = $remote_headers->content_length;
			logger("DOWNLOAD INFO: $file has size of $total_size bytes");
			
			$response = $ua->get($url, ':content_cb' => \&callback );
			message("");
		} else {
			$response = $ua->get($url);
		}
		
		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;
		}
		
		if ($response->is_success) {
			if (open(FILE, ">$Conf::tmpdir/$bfile")) {
				print FILE $final_data;
				close(FILE);
				unless ($bfile =~ /^counter\?.*/) { # Don't check out counterfile cause it's empty
					logger("DOWNLOAD INFO: File received. Start checking signature...");
					if (system("gpg --verify \"$Conf::tmpdir/$bfile\" &>/dev/null") eq 0) {
						logger("DOWNLOAD INFO: Signature of $bfile is fine.");
						move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile");
					} else {
						message("DOWNLOAD ERROR: The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting...");
						exit 1;
					}
				}
				logger("DOWNLOAD FINISHED: $file") unless ($bfile =~ /^counter\?.*/);
				$allok = 1;
				return 0;
			} else {
				logger("DOWNLOAD ERROR: Could not open $Conf::cachedir/$bfile for writing.");
			}
		}	else {
			logger("DOWNLOAD ERROR: $log");
		}
	}
	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;
}

sub getmirrors {
	use File::Copy;

	logger("MIRROR: Trying to get a mirror list.");
	
	fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver");
	move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
}

sub selectmirror {
	### 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();
	}
	if ($count == 5) {
		message("MIRROR ERROR: Could not find or download a server list");
		exit 1;
	}
	my @lines = <FILE>;
	close(FILE);

	### Count the number of the servers in the list
	my $scount = 0;
	my @newlines;
	foreach (@lines) {
		if ("$_" =~ /.*;.*;.*;/ ) {
			push(@newlines,$_);
			$scount++;
		}
	}
	logger("MIRROR INFO: $scount servers found in list");
	
	### 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;
	while ($found == 0) {
		$server = int(rand($scount) + 1);
		$servers = 0;
		my ($line, $proto, $path, $host);
		my @templine;
		foreach $line (@newlines) {
			$servers++;
			if ($servers eq $server) {
				@templine = split(/\;/, $line);
				$proto = $templine[0];
				$host = $templine[1];
				$path = $templine[2];
				if (pinghost("$host")) {
					$found = 1;
					return ($proto, $host, $path);
				}
			}
		}
	}
}

sub dbgetlist {
	### Update the database if the file is older than one day.
	#   If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
	#   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();
		$age = $time - $stat[9];
	} else {
		# Force an update.
		$age = "86401";
	}
	
	if (("$age" gt 86400) || ("$force" eq "force")) {
		#cleanup();
		fetchfile("lists/packages_list.db", "");
		move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
	}
}

sub dblist {
	### This subroutine lists the packages.
	#   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 @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") {
		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]" )) {
					push(@updatepaks,$name);
					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";
					}
				}
			}
		}
		return @updatepaks;
	} else {
		my $line;
		my @templine;
		foreach $line (sort @db) {
			next unless ($line =~ /.*;.*;.*;/ );
			@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";
			}
		}
	}
}

sub resolvedeps {
	my $pak = shift;
	
	getmetafile("$pak");
	
	message("");
	message("## Resolving dependencies for $pak...");
	
	open(FILE, "<$Conf::dbdir/meta/meta-$pak");
	my @file = <FILE>;
	close(FILE);
	
	my $line;
	my (@templine, @deps, @tempdeps, @all);
	foreach $line (@file) {
		@templine = split(/\: /,$line);
		if ("$templine[0]" eq "Dependencies") {
			@deps = split(/ /, $templine[1]);
		}
	}
	chomp (@deps);
	foreach (@deps) {
		if ($_) {
		  my $return = &isinstalled($_);
		  if ($return eq 0) {
		  	message("### Dependency is already installed: $_");
		  } else {
		  	message("### 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("### Dependency is already installed: $_");
					} else {
						message("### Need to install dependency: $_");
						push(@all,$_);
					}
				}
			}
		}
	}
	chomp (@all);
	return @all;
}

sub cleanup {
	my $dir = shift;
	my $path;
	
	if ( "$dir" eq "meta" ) {
		$path = "$Conf::dbdir/meta";
	} elsif ( "$dir" eq "tmp" ) {
		$path = "$Conf::tmpdir";
	}
	chdir("$path");
	opendir(DIR,".");
	my @files = readdir(DIR);
	closedir(DIR);
	foreach (@files) {
	  unless (($_ eq ".") || ($_ eq "..")) {
		   system("rm -rf $_");
		}
	}
}

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");
	}
	
	open(FILE, "<$Conf::dbdir/meta/meta-$pak");
	my @line = <FILE>;
	close(FILE);
	
	open(FILE, ">$Conf::dbdir/meta/meta-$pak");
	foreach (@line) {
		my $string = $_;
		$string =~ s/\r\n/\n/g;
		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;
	my @templine;
	foreach $line (@file) {
		@templine = split(/\: /,$line);
		if ("$templine[0]" eq "Size") {
			chomp($templine[1]);
			return $templine[1];
		}
	}
	return 0;
}

sub decryptpak {
	my $pak = shift;
	
	cleanup("tmp");
	
	my $file = getpak("$pak", "noforce");
	
	logger("DECRYPT STARTED: $pak");
	my $return = system("cd $Conf::tmpdir/ && gpg -d < $Conf::cachedir/$file | tar x &>/dev/null");
	$return %= 255;
	logger("DECRYPT FINISHED: $pak - Status: $return");
	if ($return != 0) { exit 1; }
}

sub getpak {
	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 ($file) {
		message("No filename given in meta-file. Please phone the developers.");
		exit 1;
	}
	
	unless ( "$force" eq "force" ) {
		if ( -e "$Conf::cachedir/$file" ) {
			return $file;
		}
	}
	
	fetchfile("paks/$file", "");
	return $file;
}

sub setuppak {
	my $pak = shift;
	
	message("################################################################################");
	message("# --> Installing: $pak");
	message("################################################################################");
	
	decryptpak("$pak");
	
	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");
	}
	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!");
		message("################################################################################");
	} else {
		message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
		exit $return;
	}
	return $return;
}

sub isinstalled {
	my $pak = shift;
	if ( open(FILE,"<$Conf::dbdir/installed/meta-$pak") ) {
		close(FILE);
		return 0;
	} else {
		return 1;
	}
}

sub upgradepak {
	my $pak = shift;

	message("We are going to upgrade: $pak");

	decryptpak("$pak");

	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");
	}
	if ($return == 0) {
	  move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
	  cleanup("tmp");
		copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
		message("Upgrade completed. Congratulations!");
	} else {
		message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
		exit $return;
	}
	return $return;
}

sub removepak {
	my $pak = shift;

	message("We are going to uninstall: $pak");

	decryptpak("$pak");

	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");
	}
	if ($return == 0) {
	  open(FILE, "<$Conf::dbdir/rootfiles/$pak");
		my @file = <FILE>;
		close(FILE);
		message("Removing files...");
		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");
	  message("Finished removing files!");
	  cleanup("tmp");
		message("Uninstall completed. Congratulations!");
	} else {
		message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
		exit $return;
	}
	return $return;
}

sub beautifysize {
	my $size = shift;
	$size = $size / 1024;
	my $unit;
	
	if ($size > 1023) {
	  $size = ($size / 1024);
	  $unit = "MB";
	} else {
	  $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'} ne "off") {
		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::tmpdir/counter* 2>/dev/null");
	}
}

sub checkcryptodb {
	logger("CRYPTO INFO: Checking GnuPG Database");
	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("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 --recv-key $myid &>>$Conf::logdir/gnupg-database.log");
		system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $trustid &>>$Conf::logdir/gnupg-database.log");
	} else {
		logger("CRYPTO INFO: Database is okay");
	}
}

sub callback {
   my ($data, $response, $protocol) = @_;
   $final_data .= $data;
   print progress_bar( length($final_data), $total_size, 25, '=' );
}

sub progress_bar {
    my ( $got, $total, $width, $char ) = @_;
    my $show_bfile;
    $width ||= 25; $char ||= '=';
    my $num_width = length $total;
    my $len_bfile = length $bfile;
    if ("$len_bfile" >= "12") {
			$show_bfile = substr($bfile,0,12)."...";
		} else {
			$show_bfile = $bfile;
		} 
    sprintf "$show_bfile [%-${width}s] Got %${num_width}s bytes of %s (%.2f%%)\r", $char x (($width-1)*$got/$total). '>', $got, $total, 100*$got/+$total;
}

1;
Commit	Line	Data
1bd42c89 MT	1	#!/usr/bin/perl -w
	2
	3	require "/opt/pakfire/etc/pakfire.conf";
4b122800	4	require "/var/ipfire/general-functions.pl";
1bd42c89 MT	5
	6	use File::Basename;
	7	use File::Copy;
	8	use LWP::UserAgent;
4d504812	9	use HTTP::Response;
a6d327a7 MT	10	use HTTP::Headers;
	11	use HTTP::Message;
	12	use HTTP::Request;
1bd42c89 MT	13	use Net::Ping;
	14
	15	package Pakfire;
	16
a6d327a7 MT	17	my $final_data;
	18	my $total_size;
	19	my $bfile;
	20
4b122800 MT	21	my %pakfiresettings = ();
	22	&General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
	23
1bd42c89 MT	24	sub message {
	25	my $message = shift;
	26	print "$message\n";
	27	logger("$message");
	28	}
	29
	30	sub logger {
	31	my $log = shift;
a6d327a7	32	system("logger -t pakfire \"$log\"") if "$log";
1bd42c89 MT	33	}
1bd42c89 MT	34
5b2a12ff MT	35	sub usage {
	36	&Pakfire::message("Usage: pakfire <install\|remove> <pak(s)>");
	37	&Pakfire::message(" <update> - Contacts the servers for new lists of paks.");
99e6df8e	38	&Pakfire::message(" <upgrade> - Installs the latest version of all paks.");
5b2a12ff	39	&Pakfire::message(" <list> - Outputs a short list with all available paks.");
99e6df8e	40	&Pakfire::message("");
5b2a12ff MT	41	exit 1;
	42	}
	43
1bd42c89 MT	44	sub pinghost {
	45	my $host = shift;
	46
	47	$p = Net::Ping->new();
	48	if ($p->ping($host)) {
a6d327a7	49	logger("PING INFO: $host is alive");
1bd42c89 MT	50	return 1;
1bd42c89 MT	51	} else {
a6d327a7	52	logger("PING INFO: $host is unreachable");
1bd42c89 MT	53	return 0;
	54	}
	55	$p->close();
	56	}
	57
	58	sub fetchfile {
4d504812 MT	59	my $getfile = shift;
	60	my $gethost = shift;
	61	my (@server, $host, $proto, $file, $allok, $i);
1bd42c89	62
a6d327a7	63	logger("DOWNLOAD STARTED: $getfile") unless ($bfile =~ /^counter\?.*/);
1bd42c89	64	use File::Basename;
4d504812	65	$bfile = basename("$getfile");
1bd42c89	66
4d504812 MT	67	$i = 0;
	68	while (($allok == 0) && $i < 5) {
	69	$i++;
	70
	71	if ("$gethost" eq "") {
	72	@server = selectmirror();
	73	$proto = $server[0];
	74	$host = $server[1];
	75	$file = "$server[2]/$getfile";
1bd42c89	76	} else {
4d504812	77	$host = $gethost;
afabe9f7	78	$file = $getfile;
1bd42c89	79	}
4d504812 MT	80
	81	$proto = "HTTP" unless $proto;
	82
a6d327a7 MT	83	unless ($bfile =~ /^counter\?.*/) {
	84	logger("DOWNLOAD INFO: Host: $host ($proto) - File: $file");
	85	#message("DOWNLOAD INFO: Loading $bfile from ($proto) $host...");
	86	}
1bd42c89	87
4d504812 MT	88	my $ua = LWP::UserAgent->new;
4d504812 MT	89	$ua->agent("Pakfire/$Conf::version");
afabe9f7	90	$ua->timeout(5);
4b122800 MT	91
	92	my %proxysettings=();
	93	&General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings);
	94
99e6df8e	95	if ($proxysettings{'UPSTREAM_PROXY'}) {
a6d327a7	96	logger("DOWNLOAD INFO: Upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\"") unless ($bfile =~ /^counter\?.*/);
4b122800	97	if ($proxysettings{'UPSTREAM_USER'}) {
99e6df8e	98	$ua->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/");
a6d327a7	99	logger("DOWNLOAD INFO: Logging in with: \"$proxysettings{'UPSTREAM_USER'}\" - \"$proxysettings{'UPSTREAM_PASSWORD'}\"") unless ($bfile =~ /^counter\?.*/);
4b122800	100	} else {
99e6df8e	101	$ua->proxy("http","http://$proxysettings{'UPSTREAM_PROXY'}/");
4b122800 MT	102	}
4b122800 MT	103	}
a6d327a7 MT	104
	105	$final_data = undef;
	106	my $url = "http://$host/$file";
	107	my $response;
	108
	109	unless ($bfile =~ /^counter\?.*/) {
	110	my $result = $ua->head($url);
	111	my $remote_headers = $result->headers;
	112	$total_size = $remote_headers->content_length;
	113	logger("DOWNLOAD INFO: $file has size of $total_size bytes");
	114
	115	$response = $ua->get($url, ':content_cb' => \&callback );
	116	message("");
	117	} else {
	118	$response = $ua->get($url);
	119	}
4d504812	120
4b122800 MT	121	my $code = $response->code();
4b122800 MT	122	my $log = $response->status_line;
a6d327a7	123	logger("DOWNLOAD INFO: HTTP-Status-Code: $code - $log");
4b122800 MT	124
4b122800 MT	125	if ( $code eq "500" ) {
e44b26cf	126	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.");
4b122800 MT	127	return 1;
	128	}
	129
4d504812	130	if ($response->is_success) {
186e3d2c	131	if (open(FILE, ">$Conf::tmpdir/$bfile")) {
a6d327a7	132	print FILE $final_data;
4d504812	133	close(FILE);
06209efc	134	unless ($bfile =~ /^counter\?.*/) { # Don't check out counterfile cause it's empty
a6d327a7	135	logger("DOWNLOAD INFO: File received. Start checking signature...");
06209efc	136	if (system("gpg --verify \"$Conf::tmpdir/$bfile\" &>/dev/null") eq 0) {
a6d327a7	137	logger("DOWNLOAD INFO: Signature of $bfile is fine.");
06209efc MT	138	move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile");
06209efc MT	139	} else {
a6d327a7	140	message("DOWNLOAD ERROR: The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting...");
06209efc MT	141	exit 1;
06209efc MT	142	}
186e3d2c	143	}
a6d327a7	144	logger("DOWNLOAD FINISHED: $file") unless ($bfile =~ /^counter\?.*/);
4d504812 MT	145	$allok = 1;
	146	return 0;
	147	} else {
a6d327a7	148	logger("DOWNLOAD ERROR: Could not open $Conf::cachedir/$bfile for writing.");
4d504812 MT	149	}
4d504812 MT	150	} else {
a6d327a7	151	logger("DOWNLOAD ERROR: $log");
4d504812	152	}
1bd42c89	153	}
a6d327a7	154	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.");
4d504812	155	return 1;
1bd42c89 MT	156	}
	157
	158	sub getmirrors {
	159	use File::Copy;
	160
a6d327a7	161	logger("MIRROR: Trying to get a mirror list.");
1bd42c89	162
06209efc MT	163	fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver");
06209efc MT	164	move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
1bd42c89 MT	165	}
	166
	167	sub selectmirror {
	168	### Check if there is a current server list and read it.
	169	# If there is no list try to get one.
	170	my $count = 0;
06209efc	171	while (!(open(FILE, "<$Conf::dbdir/lists/server-list.db")) && ($count lt 5)) {
1bd42c89 MT	172	$count++;
	173	getmirrors();
	174	}
	175	if ($count == 5) {
a6d327a7	176	message("MIRROR ERROR: Could not find or download a server list");
1bd42c89 MT	177	exit 1;
	178	}
	179	my @lines = <FILE>;
	180	close(FILE);
	181
	182	### Count the number of the servers in the list
	183	my $scount = 0;
e44b26cf	184	my @newlines;
1bd42c89	185	foreach (@lines) {
e44b26cf MT	186	if ("$_" =~ /.;.;.*;/ ) {
	187	push(@newlines,$_);
	188	$scount++;
	189	}
1bd42c89	190	}
a6d327a7	191	logger("MIRROR INFO: $scount servers found in list");
1bd42c89 MT	192
	193	### Choose a random server and test if it is online
	194	# If the check fails try a new server.
	195	# This will never give up.
	196	my $found = 0;
	197	my $servers = 0;
	198	while ($found == 0) {
	199	$server = int(rand($scount) + 1);
	200	$servers = 0;
	201	my ($line, $proto, $path, $host);
	202	my @templine;
e44b26cf	203	foreach $line (@newlines) {
1bd42c89 MT	204	$servers++;
	205	if ($servers eq $server) {
	206	@templine = split(/\;/, $line);
	207	$proto = $templine[0];
	208	$host = $templine[1];
	209	$path = $templine[2];
a08c3a2e	210	if (pinghost("$host")) {
1bd42c89 MT	211	$found = 1;
	212	return ($proto, $host, $path);
	213	}
	214	}
	215	}
4d504812	216	}
1bd42c89 MT	217	}
	218
	219	sub dbgetlist {
	220	### Update the database if the file is older than one day.
	221	# If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
	222	# Usage is always with an argument.
	223	my $force = shift;
	224	my $age;
	225
	226	use File::Copy;
	227
	228	if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
	229	my @stat = stat("$Conf::dbdir/lists/packages_list.db");
	230	my $time = time();
	231	$age = $time - $stat[9];
	232	} else {
	233	# Force an update.
	234	$age = "86401";
	235	}
	236
	237	if (("$age" gt 86400) \|\| ("$force" eq "force")) {
5b2a12ff	238	#cleanup();
1bd42c89 MT	239	fetchfile("lists/packages_list.db", "");
	240	move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
	241	}
	242	}
	243
	244	sub dblist {
	245	### This subroutine lists the packages.
	246	# You may also pass a filter: &Pakfire::dblist(filter)
	247	# Usage is always with two arguments.
	248	# filter may be: all, notinstalled, installed
	249	my $filter = shift;
	250	my $forweb = shift;
4b122800	251	my @meta;
99e6df8e	252	my @updatepaks;
4b122800 MT	253	my $file;
	254	my $line;
	255	my $prog;
	256	my ($name, $version, $release);
	257	my @templine;
1bd42c89 MT	258
	259	### Make sure that the list is not outdated.
	260	dbgetlist("noforce");
	261
	262	open(FILE, "<$Conf::dbdir/lists/packages_list.db");
	263	my @db = <FILE>;
	264	close(FILE);
4b122800 MT	265
	266	if ("$filter" eq "upgrade") {
	267	opendir(DIR,"$Conf::dbdir/meta");
	268	my @files = readdir(DIR);
	269	closedir(DIR);
	270	foreach $file (@files) {
	271	next if ( $file eq "." );
	272	next if ( $file eq ".." );
	273	open(FILE, "<$Conf::dbdir/meta/$file");
	274	@meta = <FILE>;
	275	close(FILE);
	276	foreach $line (@meta) {
	277	@templine = split(/\: /,$line);
	278	if ("$templine[0]" eq "Name") {
	279	$name = $templine[1];
	280	chomp($name);
	281	} elsif ("$templine[0]" eq "ProgVersion") {
	282	$version = $templine[1];
	283	chomp($version);
	284	} elsif ("$templine[0]" eq "Release") {
	285	$release = $templine[1];
	286	chomp($release);
	287	}
	288	}
	289	foreach $prog (@db) {
	290	@templine = split(/\;/,$prog);
	291	if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" )) {
99e6df8e	292	push(@updatepaks,$name);
4b122800 MT	293	if ("$forweb" eq "forweb") {
	294	print "<option value=\"$name\">Update: $name -- Version: $version -> $templine[1] -- Release: $release -> $templine[2]</option>\n";
	295	} else {
	296	print "Update: $name\nVersion: $version -> $templine[1]\nRelease: $release -> $templine[2]\n\n";
	297	}
	298	}
	299	}
5b2a12ff	300	}
99e6df8e	301	return @updatepaks;
4b122800 MT	302	} else {
	303	my $line;
	304	my @templine;
	305	foreach $line (sort @db) {
06209efc	306	next unless ($line =~ /.;.;.*;/ );
4b122800 MT	307	@templine = split(/\;/,$line);
	308	if ("$filter" eq "notinstalled") {
	309	next if ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
	310	} elsif ("$filter" eq "installed") {
	311	next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
	312	}
	313	if ("$forweb" eq "forweb") {
	314	print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
	315	} else {
	316	print "Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]\n\n";
	317	}
1bd42c89 MT	318	}
	319	}
	320	}
	321
	322	sub resolvedeps {
	323	my $pak = shift;
	324
	325	getmetafile("$pak");
	326
186e3d2c MT	327	message("");
186e3d2c MT	328	message("## Resolving dependencies for $pak...");
1bd42c89 MT	329
	330	open(FILE, "<$Conf::dbdir/meta/meta-$pak");
	331	my @file = <FILE>;
	332	close(FILE);
	333
	334	my $line;
186e3d2c	335	my (@templine, @deps, @tempdeps, @all);
1bd42c89 MT	336	foreach $line (@file) {
	337	@templine = split(/\: /,$line);
	338	if ("$templine[0]" eq "Dependencies") {
	339	@deps = split(/ /, $templine[1]);
	340	}
	341	}
	342	chomp (@deps);
	343	foreach (@deps) {
	344	if ($_) {
186e3d2c MT	345	my $return = &isinstalled($_);
	346	if ($return eq 0) {
	347	message("### Dependency is already installed: $_");
	348	} else {
	349	message("### Need to install dependency: $_");
	350	push(@tempdeps,$_);
	351	push(@all,$_);
	352	}
1bd42c89 MT	353	}
1bd42c89 MT	354	}
e44b26cf	355
1bd42c89 MT	356	foreach (@tempdeps) {
	357	if ($_) {
	358	my @newdeps = resolvedeps("$_");
	359	foreach(@newdeps) {
	360	unless (($_ eq " ") \|\| ($_ eq "")) {
186e3d2c MT	361	my $return = &isinstalled($_);
	362	if ($return eq 0) {
	363	message("### Dependency is already installed: $_");
	364	} else {
	365	message("### Need to install dependency: $_");
	366	push(@all,$_);
	367	}
1bd42c89 MT	368	}
	369	}
	370	}
	371	}
186e3d2c MT	372	chomp (@all);
186e3d2c MT	373	return @all;
1bd42c89 MT	374	}
	375
	376	sub cleanup {
	377	my $dir = shift;
	378	my $path;
	379
	380	if ( "$dir" eq "meta" ) {
	381	$path = "$Conf::dbdir/meta";
	382	} elsif ( "$dir" eq "tmp" ) {
	383	$path = "$Conf::tmpdir";
	384	}
	385	chdir("$path");
	386	opendir(DIR,".");
	387	my @files = readdir(DIR);
	388	closedir(DIR);
	389	foreach (@files) {
	390	unless (($_ eq ".") \|\| ($_ eq "..")) {
	391	system("rm -rf $_");
	392	}
	393	}
	394	}
	395
	396	sub getmetafile {
	397	my $pak = shift;
	398
1bd42c89 MT	399	unless ( -e "$Conf::dbdir/meta/meta-$pak") {
	400	fetchfile("meta/meta-$pak", "");
	401	move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
	402	}
	403
	404	open(FILE, "<$Conf::dbdir/meta/meta-$pak");
	405	my @line = <FILE>;
	406	close(FILE);
	407
	408	open(FILE, ">$Conf::dbdir/meta/meta-$pak");
	409	foreach (@line) {
	410	my $string = $_;
	411	$string =~ s/\r\n/\n/g;
	412	print FILE $string;
	413	}
	414	close(FILE);
	415	return 1;
	416	}
	417
	418	sub getsize {
	419	my $pak = shift;
	420
	421	getmetafile("$pak");
	422
	423	open(FILE, "<$Conf::dbdir/meta/meta-$pak");
	424	my @file = <FILE>;
	425	close(FILE);
	426
	427	my $line;
	428	my @templine;
	429	foreach $line (@file) {
	430	@templine = split(/\: /,$line);
	431	if ("$templine[0]" eq "Size") {
	432	chomp($templine[1]);
	433	return $templine[1];
	434	}
	435	}
4b122800	436	return 0;
1bd42c89 MT	437	}
	438
	439	sub decryptpak {
	440	my $pak = shift;
	441
	442	cleanup("tmp");
	443
	444	my $file = getpak("$pak", "noforce");
	445
a6d327a7 MT	446	logger("DECRYPT STARTED: $pak");
a6d327a7 MT	447	my $return = system("cd $Conf::tmpdir/ && gpg -d < $Conf::cachedir/$file \| tar x &>/dev/null");
99e6df8e	448	$return %= 255;
a6d327a7	449	logger("DECRYPT FINISHED: $pak - Status: $return");
cde0e116	450	if ($return != 0) { exit 1; }
1bd42c89 MT	451	}
	452
	453	sub getpak {
	454	my $pak = shift;
	455	my $force = shift;
	456
	457	getmetafile("$pak");
	458
	459	open(FILE, "<$Conf::dbdir/meta/meta-$pak");
	460	my @file = <FILE>;
	461	close(FILE);
	462
	463	my $line;
	464	my $file;
	465	my @templine;
	466	foreach $line (@file) {
	467	@templine = split(/\: /,$line);
	468	if ("$templine[0]" eq "File") {
	469	chomp($templine[1]);
	470	$file = $templine[1];
	471	}
	472	}
	473
	474	unless ($file) {
	475	message("No filename given in meta-file. Please phone the developers.");
	476	exit 1;
	477	}
	478
1bd42c89 MT	479	unless ( "$force" eq "force" ) {
1bd42c89 MT	480	if ( -e "$Conf::cachedir/$file" ) {
1bd42c89 MT	481	return $file;
	482	}
	483	}
	484
	485	fetchfile("paks/$file", "");
	486	return $file;
	487	}
	488
	489	sub setuppak {
	490	my $pak = shift;
	491
186e3d2c MT	492	message("################################################################################");
	493	message("# --> Installing: $pak");
	494	message("################################################################################");
1bd42c89 MT	495
	496	decryptpak("$pak");
	497
99e6df8e	498	my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
cde0e116	499	$return %= 255;
e44b26cf MT	500	if ($pakfiresettings{'UUID'} ne "off") {
	501	fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&ipak=$pak&return=$return", "$Conf::mainserver");
	502	}
1bd42c89 MT	503	if ($return == 0) {
	504	move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
	505	cleanup("tmp");
4d504812	506	copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
1bd42c89	507	message("Setup completed. Congratulations!");
186e3d2c	508	message("################################################################################");
1bd42c89 MT	509	} else {
	510	message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
	511	exit $return;
	512	}
a08c3a2e	513	return $return;
1bd42c89 MT	514	}
1bd42c89 MT	515
186e3d2c MT	516	sub isinstalled {
	517	my $pak = shift;
	518	if ( open(FILE,"<$Conf::dbdir/installed/meta-$pak") ) {
	519	close(FILE);
	520	return 0;
	521	} else {
	522	return 1;
	523	}
	524	}
	525
99e6df8e	526	sub upgradepak {
1bd42c89 MT	527	my $pak = shift;
1bd42c89 MT	528
99e6df8e	529	message("We are going to upgrade: $pak");
1bd42c89 MT	530
	531	decryptpak("$pak");
	532
99e6df8e MT	533	my $return = system("cd $Conf::tmpdir && NAME=$pak ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
99e6df8e MT	534	$return %= 255;
e44b26cf MT	535	if ($pakfiresettings{'UUID'} ne "off") {
	536	fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&upak=$pak&return=$return", "$Conf::mainserver");
	537	}
1bd42c89 MT	538	if ($return == 0) {
	539	move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
	540	cleanup("tmp");
99e6df8e MT	541	copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
99e6df8e MT	542	message("Upgrade completed. Congratulations!");
1bd42c89 MT	543	} else {
	544	message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
	545	exit $return;
	546	}
8e58bd37	547	return $return;
1bd42c89 MT	548	}
	549
	550	sub removepak {
	551	my $pak = shift;
	552
	553	message("We are going to uninstall: $pak");
	554
	555	decryptpak("$pak");
	556
99e6df8e MT	557	my $return = system("cd $Conf::tmpdir && NAME=$pak ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
99e6df8e MT	558	$return %= 255;
e44b26cf MT	559	if ($pakfiresettings{'UUID'} ne "off") {
	560	fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&dpak=$pak&return=$return", "$Conf::mainserver");
	561	}
1bd42c89 MT	562	if ($return == 0) {
	563	open(FILE, "<$Conf::dbdir/rootfiles/$pak");
	564	my @file = <FILE>;
	565	close(FILE);
a6d327a7	566	message("Removing files...");
1bd42c89 MT	567	foreach (@file) {
	568	my $line = $_;
	569	chomp($line);
	570	system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
	571	system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
	572	}
	573	unlink("$Conf::dbdir/rootfiles/$pak");
a6d327a7 MT	574	unlink("$Conf::dbdir/installed/meta-$pak");
a6d327a7 MT	575	message("Finished removing files!");
1bd42c89 MT	576	cleanup("tmp");
	577	message("Uninstall completed. Congratulations!");
	578	} else {
	579	message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
	580	exit $return;
	581	}
8e58bd37	582	return $return;
1bd42c89 MT	583	}
	584
	585	sub beautifysize {
	586	my $size = shift;
a08c3a2e MT	587	$size = $size / 1024;
a08c3a2e MT	588	my $unit;
1bd42c89 MT	589
1bd42c89 MT	590	if ($size > 1023) {
a08c3a2e MT	591	$size = ($size / 1024);
a08c3a2e MT	592	$unit = "MB";
1bd42c89	593	} else {
a08c3a2e	594	$unit = "KB";
1bd42c89	595	}
a08c3a2e MT	596	$size = sprintf("%.2f" , $size);
	597	my $string = "$size $unit";
	598	return $string;
1bd42c89 MT	599	}
1bd42c89 MT	600
8e58bd37 MT	601	sub makeuuid {
8e58bd37 MT	602	unless ( -e "$Conf::dbdir/uuid" ) {
8e58bd37 MT	603	open(FILE, "</proc/sys/kernel/random/uuid");
	604	my @line = <FILE>;
	605	close(FILE);
	606
	607	open(FILE, ">$Conf::dbdir/uuid");
	608	foreach (@line) {
	609	print FILE $_;
	610	}
	611	close(FILE);
	612	}
	613	}
	614
	615	sub senduuid {
99e6df8e	616	if ($pakfiresettings{'UUID'} ne "off") {
4b122800 MT	617	unless("$Conf::uuid") {
	618	$Conf::uuid = `cat $Conf::dbdir/uuid`;
	619	}
	620	logger("Sending my uuid: $Conf::uuid");
	621	fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
06209efc	622	system("rm -f $Conf::tmpdir/counter* 2>/dev/null");
8e58bd37	623	}
8e58bd37	624	}
1bd42c89	625
cde0e116	626	sub checkcryptodb {
a6d327a7	627	logger("CRYPTO INFO: Checking GnuPG Database");
cde0e116 MT	628	my $myid = "64D96617"; # Our own gpg-key
	629	my $trustid = "65D0FD58"; # Id of CaCert
	630	my $ret = system("gpg --list-keys \| grep -q $myid");
	631	unless ( "$ret" eq "0" ) {
a6d327a7 MT	632	message("CRYPTO WARN: The GnuPG isn't configured corectly. Trying now to fix this.");
	633	message("CRYPTO WARN: It's normal to see this on first execution.");
	634	system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $myid &>>$Conf::logdir/gnupg-database.log");
	635	system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $trustid &>>$Conf::logdir/gnupg-database.log");
	636	} else {
	637	logger("CRYPTO INFO: Database is okay");
cde0e116 MT	638	}
	639	}
	640
a6d327a7 MT	641	sub callback {
	642	my ($data, $response, $protocol) = @_;
	643	$final_data .= $data;
	644	print progress_bar( length($final_data), $total_size, 25, '=' );
	645	}
	646
	647	sub progress_bar {
	648	my ( $got, $total, $width, $char ) = @_;
	649	my $show_bfile;
	650	$width \|\|= 25; $char \|\|= '=';
	651	my $num_width = length $total;
	652	my $len_bfile = length $bfile;
	653	if ("$len_bfile" >= "12") {
	654	$show_bfile = substr($bfile,0,12)."...";
	655	} else {
	656	$show_bfile = $bfile;
	657	}
	658	sprintf "$show_bfile [%-${width}s] Got %${num_width}s bytes of %s (%.2f%%)\r", $char x (($width-1)$got/$total). '>', $got, $total, 100$got/+$total;
	659	}
	660
1bd42c89	661	1;