webmin/software/rpm-lib.pl.bak

# rpm-lib.pl
# Functions for redhat linux package management

# list_packages([package]*)
# Fills the array %packages with all or listed packages
sub list_packages
{
local($i, $list); $i = 0;
$list = @_ ? join(' ', @_) : "-a";
open(RPM, "rpm -q $list --queryformat \"%{NAME}\\n%{VERSION}\\n%{GROUP}\\n%{SUMMARY}\\n\\n\" |");
while($packages{$i,'name'} = <RPM>) {
	chop($packages{$i,'name'});
	chop($packages{$i,'version'} = <RPM>);
	chop($packages{$i,'class'} = <RPM>);
	while(<RPM>) {
		s/\r|\n/ /g;
		last if (!/\S/);
		$packages{$i,'desc'} .= $_;
		}
	$i++;
	}
close(RPM);
return $i;
}

# package_info(package)
# Returns an array of package information in the order
#  name, class, description, arch, version, vendor, installtime
sub package_info
{
local(@rv, @tmp, $d);
open(RPM, "rpm -q $_[0] --queryformat \"%{NAME}\\n%{GROUP}\\n%{ARCH}\\n%{VERSION}\\n%{VENDOR}\\n%{INSTALLTIME}\\n\" 2>/dev/null |");
@tmp = <RPM>;
chop(@tmp);
if (!@tmp) { return (); }
close(RPM);
open(RPM, "rpm -q $_[0] --queryformat \"%{DESCRIPTION}\" |");
while(<RPM>) { $d .= $_; }
close(RPM);
return ($tmp[0], $tmp[1], $d, $tmp[2], $tmp[3], $tmp[4], &make_date($tmp[5]));
}

# is_package(file)
# Check if some file is a package file
sub is_package
{
local($out);
if (-d $_[0]) {
	# a directory .. see if it contains any .rpm files
	opendir(DIR, $_[0]);
	local @list = grep { /\.rpm$/ } readdir(DIR);
	closedir(DIR);
	return @list ? 1 : 0;
	}
else {
	# just a normal file
	$out = `rpm -q -p $_[0] 2>&1`;
	return $out !~ /does not appear|No such file/;
	}
}

# file_packages(file)
# Returns a list of all packages in the given file, in the form
#  package description
sub file_packages
{
if (-d $_[0]) {
	local @rv;
	open(RPM, "cd $_[0] ; rpm -q -p *.rpm --queryformat \"%{NAME} %{SUMMARY}\\n\" 2>&1 |");
	while(<RPM>) {
		chop;
		push(@rv, $_) if (!/does not appear|query of.*failed/);
		}
	close(RPM);
	return @rv;
	}
else {
	local($out);
	$out = `rpm -q -p $_[0] --queryformat "%{NAME} %{SUMMARY}" 2>&1`;
	return ($out);
	}
}

$wide_install_options = 1;

# install_options(file, package)
# Outputs HTML for choosing install options for some package
sub install_options
{
print "<tr>\n";
print &yesno_input($text{'rpm_upgrade'}, "upgrade", 1, 0, 1);
print &yesno_input($text{'rpm_replacepkgs'}, "replacepkgs", 1, 0);
print "</tr>\n";

print "<tr>\n";
print &yesno_input($text{'rpm_nodeps'}, "nodeps", 1, 0);
print &yesno_input($text{'rpm_oldpackage'}, "oldpackage", 1, 0);
print "</tr>\n";

print "<tr>\n";
print &yesno_input($text{'rpm_noscripts'}, "noscripts", 0, 1);
print &yesno_input($text{'rpm_excludedocs'}, "excludedocs", 0, 1);
print "</tr>\n";

print "<tr>\n";
print &yesno_input($text{'rpm_replacefiles'}, "replacefiles", 1, 0);
print "<td align=right>",&hlink("<b>$text{'rpm_root'}</b>","root"),"</td>\n";
print "<td><input name=root size=25 value=\"/\">\n";
print &file_chooser_button("root", 1),"</td> </tr>\n";
}

sub yesno_input
{
local $cy = $_[2] ^ $_[4] ? "" : "checked";
local $cn = $_[3] ^ $_[4] ? "" : "checked";
return  "<td align=right>".&hlink("<b>$_[0]</b>", $_[1])."</td> <td>\n".
	"<input type=radio name=$_[1] value=$_[2] $cy> $text{'yes'}\n".
	"<input type=radio name=$_[1] value=$_[3] $cn> $text{'no'}</td>\n";
}

# install_package(file, package, [&inputs])
# Install the given package from the given file, using options from %in
sub install_package
{
local $file = $_[0];
local $in = $_[2] ? $_[2] : \%in;
foreach $o ('oldpackage', 'replacefiles', 'replacepkgs', 'noscripts',
	    'excludedocs', 'nodeps', 'upgrade') {
	if ($in->{$o}) { $opts .= " --$o"; }
	}
if ($in->{'root'} =~ /^\/.+/) {
	if (!(-d $in{'root'})) {
		return &text('rpm_eroot', $in->{'root'});
		}
	$opts .= " --root $in->{'root'}";
	}
if (-d $file) {
	# Find the package in the directory
	local ($f, $out);
	opendir(DIR, $file);
	while($f = readdir(DIR)) {
		next if ($f !~ /\.rpm$/);
		($out = `rpm -q -p $file/$f --queryformat '%{NAME}' 2>&1`) =~ s/\r|\n//g;
		if ($out eq $_[1]) {
			$file = "$file/$f";
			last;
			}
		}
	closedir(DIR);
	&error(&text('rpm_erpm', $_[1], $out)) if ($file eq $_[0]);
	}
local $temp = &tempname();
local $rv = &system_logged("rpm -i $opts $file >$temp 2>&1");
local $out = `cat $temp`;
unlink($temp);
if ($rv) {
	return "<pre>$out</pre>";
	}
return undef;
}

# check_files(package)
# Fills in the %files array with information about the files belonging
# to some package. Values in %files are  path type user group size error
sub check_files
{
local($i, $_, @w, %errs, $epath); $i = 0;
open(RPM, "rpm -V $_[0] |");
while(<RPM>) {
	/^(.{8}) (.) (.*)$/;
	if ($1 eq "missing ") {
		$errs{$3} = $text{'rpm_missing'};
		}
	else {
		$epath = $3;
		@w = grep { $_ ne "." } split(//, $1);
		$errs{$epath} =
			join("\n", map { &text('rpm_checkfail', $etype{$_}) } @w);
		}
	}
close(RPM);
open(RPM, "rpm -q $_[0] -l --dump |");
while(<RPM>) {
	chop;
	@w = split(/ /);
	$files{$i,'path'} = $w[0];
	if ($w[10] ne "X") { $files{$i,'link'} = $w[10]; }
	$files{$i,'type'} = $w[10] ne "X" ? 3 :
			    (-d $w[0]) ? 1 :
			    $w[7] ? 5 : 0;
	$files{$i,'user'} = $w[5];
	$files{$i,'group'} = $w[6];
	$files{$i,'size'} = $w[1];
	$files{$i,'error'} = $w[7] ? "" : $errs{$w[0]};
	$i++;
	}
close(RPM);
return $i;
}

# installed_file(file)
# Given a filename, fills %file with details of the given file and returns 1.
# If the file is not known to the package system, returns 0
# Usable values in %file are  path type user group mode size packages
sub installed_file
{
local($pkg, @w, $_);
undef(%file);
$pkg = `rpm -q -f $_[0] --queryformat "%{NAME}\\n" 2>&1`;
if ($pkg =~ /not owned/ || $?) { return 0; }
@pkgs = split(/\n/, $pkg);
open(RPM, "rpm -q $pkgs[0] -l --dump |");
while(<RPM>) {
	chop;
	@w = split(/ /);
	if ($w[0] eq $_[0]) {
		$file{'packages'} = join(' ', @pkgs);
		$file{'path'} = $w[0];
		if ($w[10] ne "X") { $files{$i,'link'} = $w[10]; }
		$file{'type'} = $w[10] ne "X" ? 3 :
				(-d $w[0]) ? 1 :
				$w[7] ? 5 : 0;
		$file{'user'} = $w[5];
		$file{'group'} = $w[6];
		$file{'mode'} = substr($w[4], -4);
		$file{'size'} = $w[1];
		last;
		}
	}
close(RPM);
return 1;
}

# delete_package(package)
# Attempt to remove some package
sub delete_package
{
$out = &backquote_logged("rpm -e $_[0] 2>&1");
if ($out) { return "<pre>$out</pre>"; }
return undef;
}

sub package_system
{
return "RPM";
}

sub package_help
{
return "rpm";
}

%etype = (	"5", $text{'rpm_md5'},	"S", $text{'rpm_fsize'},
		"L", $text{'rpm_sym'},	"T", $text{'rpm_mtime'},
		"D", $text{'rpm_dev'},	"U", $text{'rpm_user'},
		"M", $text{'rpm_perm'},	"G", $text{'rpm_group'} );

1;