debian-lib.pl

Unix下基于Web的管理工具

# debian-lib.pl
# Functions for debian DPKG package management

# list_packages([package]*)
# Fills the array %packages with a list of all packages
sub list_packages
{
local $i = 0;
local $arg = @_ ? join(" ", @_) : "";
open(PKGINFO, "dpkg --list $arg |");
while(<PKGINFO>) {
	next if (/^\|/ || /^\+/);
	if (/^ii..(\S+)\s+(\S+)\s+(.*)/) {
		$packages{$i,'name'} = $1;
		$packages{$i,'class'} = "";
		$packages{$i,'desc'} = $3;
		$i++;
		}
	}
close(PKGINFO);
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 $out = `dpkg --print-avail $_[0] 2>&1`;
return () if ($? || $out =~ /Package .* is not available/i);
local @rv = ( $_[0], "" );
push(@rv, $out =~ /Description:\s+([\0-\177]*\S)/i ? $1
						   : $text{'debian_unknown'});
push(@rv, $out =~ /Architecture:\s+(\S+)/i ? $1 : $text{'debian_unknown'});
push(@rv, $out =~ /Version:\s+(\S+)/i ? $1 : $text{'debian_unknown'});
push(@rv, $out =~ /Maintainer:\s+(.*)/i ? &html_escape($1)
					 : $text{'debian_unknown'});
push(@rv, $text{'debian_unknown'});
return @rv;
}

# 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 mode size error
sub check_files
{
local $i = 0;
local $file;
open(PKGINFO, "dpkg --listfiles $_[0] |");
while($file = <PKGINFO>) {
	$file =~ s/\r|\n//g;
	next if ($file !~ /^\/[^\.]/);
	local @st = stat($file);
	$files{$i,'path'} = $file;
	$files{$i,'type'} = -l $file ? 3 :
			    -d $file ? 1 : 0;
	$files{$i,'user'} = getpwuid($st[4]);
	$files{$i,'group'} = getgrgid($st[5]);
	$files{$i,'mode'} = sprintf "%o", $st[2] & 07777;
	$files{$i,'size'} = $st[7];
	$files{$i,'link'} = readlink($file);
	$i++;
	}
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 $out = `dpkg --search $_[0] 2>&1`;
return 0 if ($out =~ /not found/i);
$out =~ s/:\s+\S+\n$//;
local @pkgin = split(/[\s,]+/, $out);
local @st = stat($_[0]);
$file{'path'} = $_[0];
$file{'type'} = -l $_[0] ? 3 :
		-d $_[0] ? 1 : 0;
$file{'user'} = getpwuid($st[4]);
$file{'group'} = getgrgid($st[5]);
$file{'mode'} = sprintf "%o", $st[2] & 07777;
$file{'size'} = $st[7];
$file{'link'} = readlink($_[0]);
$file{'packages'} = join(" ", @pkgin);
return 1;
}

# is_package(file)
sub is_package
{
local $out = `dpkg --info $_[0] 2>&1`;
return $? || $out !~ /Package:/ ? 0 : 1;
}

# file_packages(file)
# Returns a list of all packages in the given file, in the form
#  package description
sub file_packages
{
local $out = `dpkg --info $_[0] 2>&1`;
local $name;
if ($out =~ /Package:\s+(\S+)/i && ($name=$1) &&
    $out =~ /Description:\s+(.*)/i) {
	return ( "$name $1" );
	}
return ();
}

# install_options(file, package)
# Outputs HTML for choosing install options
sub install_options
{
print "<tr> <td><b>$text{'debian_depends'}</b></td>\n";
print "<td><input type=radio name=depends value=1> $text{'yes'}\n";
print "<input type=radio name=depends value=0 checked> $text{'no'}</td> </tr>\n";

print "<tr> <td><b>$text{'debian_conflicts'}</b></td>\n";
print "<td><input type=radio name=conflicts value=1> $text{'yes'}\n";
print "<input type=radio name=conflicts value=0 checked> $text{'no'}</td> </tr>\n";

print "<tr> <td><b>$text{'debian_overwrite'}</b></td>\n";
print "<td><input type=radio name=overwrite value=1> $text{'yes'}\n";
print "<input type=radio name=overwrite value=0 checked> $text{'no'}</td> </tr>\n";

print "<tr> <td><b>$text{'debian_downgrade'}</b></td>\n";
print "<td><input type=radio name=downgrade value=1> $text{'yes'}\n";
print "<input type=radio name=downgrade value=0 checked> $text{'no'}</td> </tr>\n";
}

# install_package(file, package)
# Installs the package in the given file, with options from %in
sub install_package
{
local $args = ($in{'depends'} ? " --force-depends" : "").
	      ($in{'conflicts'} ? " --force-conflicts" : "").
	      ($in{'overwrite'} ? " --force-overwrite" : "").
	      ($in{'downgrade'} ? " --force-downgrade" : "");
local $out = `dpkg --install $args $_[0] 2>&1 </dev/null`;
if ($?) {
	return "<pre>$out</pre>";
	}
return undef;
}

# delete_package(package)
# Totally remove some package
sub delete_package
{
local $out = `dpkg --remove $_[0] 2>&1 </dev/null`;
if ($? || $out =~ /which isn.t installed/i) {
	return "<pre>$out</pre>";
	}
return undef;
}

sub package_system
{
return "Debian DPKG";
}

1;