[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 Net::Ping;

package Pakfire;

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\"");
}

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("$host is alive.");
  	return 1;
  } else {
		logger("$host is dead.");
		return 0;
	}
  $p->close();
}

sub fetchfile {
	my $getfile = shift;
	my $gethost = shift;
	my (@server, $host, $proto, $file, $allok, $i);
	
	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;
		
		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'}) {
			logger("Using upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\""); 
			if ($proxysettings{'UPSTREAM_USER'}) {
				$ua->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/");
				logger("  Logging in with: \"$proxysettings{'UPSTREAM_USER'}\" - \"$proxysettings{'UPSTREAM_PASSWORD'}\"");
			} else {
				$ua->proxy("http","http://$proxysettings{'UPSTREAM_PROXY'}/");
			}
		}
	 
		my $response = $ua->get("http://$host/$file");
		
		my $code = $response->code();
		my $log = $response->status_line;
		logger("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 $response->content;
				close(FILE);
				unless ($bfile =~ /^counter\?.*/) { # Don't check out counterfile cause it's empty
					logger("File received. Start checking signature...");
					if (system("gpg --verify \"$Conf::tmpdir/$bfile\" &>/dev/null") eq 0) {
						logger("Signature of $bfile is fine.");
						move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile");
					} else {
						message("The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting...");
						exit 1;
					}
				}
				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 {
	use File::Copy;

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