[people/pmueller/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;

# GPG Keys
my $myid = "64D96617";			# Our own gpg-key paks@ipfire.org
my $trustid = "65D0FD58";		# gpg-key of CaCert

# A small color-hash :D
my %color;
	$color{'normal'}      = "\033[0m"; 
	$color{'black'}       = "\033[0;30m";
	$color{'darkgrey'}    = "\033[1;30m";
	$color{'blue'}        = "\033[0;34m";
	$color{'lightblue'}   = "\033[1;34m";
	$color{'green'}       = "\033[0;32m";
	$color{'lightgreen'}  = "\033[1;32m";
	$color{'cyan'}        = "\033[0;36m";
	$color{'lightcyan'}   = "\033[1;36m";
	$color{'red'}         = "\033[0;31m";
	$color{'lightred'}    = "\033[1;31m";
	$color{'purple'}      = "\033[0;35m";
	$color{'lightpurple'} = "\033[1;35m";
	$color{'brown'}       = "\033[0;33m";
	$color{'lightgrey'}   = "\033[0;37m";
	$color{'yellow'}      = "\033[1;33m";
	$color{'white'}       = "\033[1;37m";
our $enable_colors = 1;

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

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

sub message {
	my $message = shift;
		
	logger("$message");
	if ( $enable_colors == 1 ) {
		if ("$message" =~ /ERROR/) {
			$message = "$color{'red'}$message$color{'normal'}";
		} elsif ("$message" =~ /INFO/) {
			$message = "$color{'cyan'}$message$color{'normal'}";
		} elsif ("$message" =~ /WARN/) {
			$message = "$color{'yellow'}$message$color{'normal'}";
		} elsif ("$message" =~ /RESV/) {
			$message = "$color{'purple'}$message$color{'normal'}";
		} elsif ("$message" =~ /INST/) {
			$message = "$color{'green'}$message$color{'normal'}";
		} elsif ("$message" =~ /REMV/) {
			$message = "$color{'lightred'}$message$color{'normal'}";
		} elsif ("$message" =~ /UPGR/) {
			$message = "$color{'lightblue'}$message$color{'normal'}";
		}
	}
	print "$message\n";
	
}

sub logger {
	my $log = shift;
	if ($log) {
		system("echo \"`date`: $log\" >> /var/log/pakfire.log");
		#system("logger -t pakfire \"$log\"");
	}
}

sub usage {
  &Pakfire::message("Usage: pakfire <install|remove> [options] <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("");
  &Pakfire::message("       Global options:");
  &Pakfire::message("               --non-interactive --> Enables the non-interactive mode.");
  &Pakfire::message("                                     You won't see any question here.");
  &Pakfire::message("                              -y --> Short for --non-interactive.");
  &Pakfire::message("                     --no-colors --> Turns off the wonderful colors.");
  &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");
		}

		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) {
			unless ($bfile =~ /^counter\?.*/) {
				if (open(FILE, ">$Conf::tmpdir/$bfile")) {
					print FILE $final_data;
					close(FILE);
					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");
					$allok = 1;
					return 0;
				} else {
					logger("DOWNLOAD ERROR: Could not open $Conf::cachedir/$bfile for writing.");
				}
			} else {
				return 0;
			}
		}	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.");
	
	if ( -e "$Conf::dbdir/lists/server_list.db" ) {
		my @stat = stat("$Conf::dbdir/lists/server_list.db");
		my $time = time();
		$age = $time - $stat[9];
	} else {
		# Force an update.
		$age = "86401";
	}
	
	if ("$age" gt "86400") {
		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")) {
		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 {
						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";
						}
					}
				}
			}
		}
		return @updatepaks;
	} else {
		my $line;
		my $use_color;
		my @templine;
		my $count;
		foreach $line (sort @db) {
			next unless ($line =~ /.*;.*;.*;/ );
			$use_color = "";
			$count++;
			@templine = split(/\;/,$line);
			if ("$filter" eq "notinstalled") {
				next if ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
			} elsif ("$filter" eq "installed") {
				next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
			}
			if ("$forweb" eq "forweb") {
				print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</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";
			}
		}
		print "$count packages total.\n" unless ("$forweb" eq "forweb");
	}
}

sub resolvedeps {
	my $pak = shift;
	
	getmetafile("$pak");
	
	message("PAKFIRE RESV: $pak: Resolving dependencies...");
	
	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("PAKFIRE RESV: $pak: Dependency is already installed: $_");
		  } else {
		  	message("PAKFIRE RESV: $pak: 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("PAKFIRE RESV: $pak: Dependency is already installed: $_");
					} else {
						message("PAKFIRE RESV: $pak: Need to install dependency: $_");
						push(@all,$_);
					}
				}
			}
		}
	}
	message("");
	chomp (@all);
	return @all;
}

sub cleanup {
	my $dir = shift;
	my $path;
	
	logger("CLEANUP: $dir");
	
	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 --batch --quiet --no-verbose --status-fd 2 --output - < $Conf::cachedir/$file 2>/dev/null | tar x");
	$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("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;
	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("PAKFIRE INST: $pak: Finished.");
		message("");
	} else {
		message("PAKFIRE ERROR: Returncode: $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("PAKFIRE UPGR: $pak: Decrypting...");
	decryptpak("$pak");

	message("PAKFIRE UPGR: $pak: Upgrading files and running post-upgrading scripts...");
	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("PAKFIRE UPGR: $pak: Finished.");
		message("");
	} else {
		message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
		exit $return;
	}
	return $return;
}

sub removepak {
	my $pak = shift;

	message("PAKFIRE REMV: $pak: Decrypting...");
	decryptpak("$pak");

	message("PAKFIRE REMV: $pak: Removing files and running post-removing scripts...");
	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");
	  unlink("$Conf::dbdir/installed/meta-$pak");
	  cleanup("tmp");
		message("PAKFIRE REMV: $pak: Finished.");
		message("");
	} else {
		message("PAKFIRE ERROR: Returncode: $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*1024) {
	  $size = ($size / (1024*1024));
	  $unit = "MB";
	} elsif ($size > 1023) {
	  $size = ($size / 1024);
	  $unit = "KB";
	} else {
	  $unit = "B";
	}
	$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 $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 --status-fd 2 --recv-key $myid >> $Conf::logdir/gnupg-database.log 2>&1");
		system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --status-fd 2 --recv-key $trustid >> $Conf::logdir/gnupg-database.log 2>&1");
	} else {
		logger("CRYPTO INFO: Database is okay");
	}
}

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

sub progress_bar {
    my ( $got, $total, $width, $char ) = @_;
    my $show_bfile;
    $width ||= 30; $char ||= '=';
    my $len_bfile = length $bfile;
    if ("$len_bfile" >= "17") {
			$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);
}

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