mirror of
https://github.com/webmin/webmin.git
synced 2026-02-08 00:12:14 +00:00
255 lines
6.4 KiB
Perl
255 lines
6.4 KiB
Perl
# pkgadd-lib.pl
|
|
# Functions for solaris package management
|
|
|
|
&foreign_require("proc", "proc-lib.pl");
|
|
|
|
# list_packages([package]*)
|
|
# Fills the array %packages with a list of all packages
|
|
sub list_packages
|
|
{
|
|
local($_, $list, $i); $i = 0;
|
|
$list = join(' ', @_);
|
|
open(PKGINFO, "pkginfo $list |");
|
|
while(<PKGINFO>) {
|
|
last if (/The following software/i);
|
|
if (/^(\S+)\s+(\S+)\s+(.*)$/) {
|
|
$packages{$i,'name'} = $2;
|
|
$packages{$i,'class'} = $1;
|
|
$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, @rv);
|
|
$out = `pkginfo -l $_[0] 2>&1`;
|
|
if ($out =~ /^ERROR:/) { return (); }
|
|
push(@rv, $_[0]);
|
|
push(@rv, $out =~ /CATEGORY:\s+(.*)\n/ ? $1 : "");
|
|
push(@rv, $out =~ /DESC:\s+(.*)\n/ ? $1 :
|
|
$out =~ /NAME:\s+(.*)\n/ ? $1 : $_[0]);
|
|
push(@rv, $out =~ /ARCH:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
|
|
push(@rv, $out =~ /VERSION:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
|
|
push(@rv, $out =~ /VENDOR:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
|
|
push(@rv, $out =~ /INSTDATE:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
|
|
return @rv;
|
|
}
|
|
|
|
# is_package(file)
|
|
# Tests if some file is a valid package file
|
|
sub is_package
|
|
{
|
|
local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec",
|
|
"pkgadd -d $_[0]");
|
|
$rv = &wait_for($ph, 'ERROR', 'Select package|more choices');
|
|
close($ph);
|
|
return $rv;
|
|
}
|
|
|
|
# file_packages(file)
|
|
# Returns a list of all packages in the given file, in the form
|
|
# package description
|
|
sub file_packages
|
|
{
|
|
local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec",
|
|
"pkgadd -d $_[0]");
|
|
&wait_for($ph, 'available:');
|
|
while($rv = &wait_for($ph, 'Select package',
|
|
'\r?\n\s+(\d+)\s+(\S+)\s+(.*)\r?\n',
|
|
'more choices.*:')) {
|
|
if ($rv == 1) { push(@rv, "$matches[2] $matches[3]"); }
|
|
else { &sysprint($ph, "\n"); }
|
|
}
|
|
close($ph);
|
|
return @rv;
|
|
}
|
|
|
|
# install_options(file, package)
|
|
# Outputs HTML for choosing install options
|
|
sub install_options
|
|
{
|
|
print "<tr> <td>",&hlink("<b>$text{'pkgadd_root'}</b>","root"),"</td>\n";
|
|
print "<td colspan=3><input name=root size=30 value=/>\n";
|
|
print &file_chooser_button("root", 1); print "</td> </tr>\n";
|
|
}
|
|
|
|
# install_package(file, package)
|
|
# Installs the package in the given file, with options from %in
|
|
sub install_package
|
|
{
|
|
local(@opts, %seen, $wf, $rv, $old_input);
|
|
local $in = $_[2] ? $_[2] : \%in;
|
|
if ($in->{'root'} =~ /^\/.+/) {
|
|
if (!(-d $in->{'root'})) { &error(&text('pkgadd_eroot', $in->{'root'})); }
|
|
@opts = ("-R", $in->{'root'});
|
|
}
|
|
local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec_logged",
|
|
"pkgadd -d $_[0] ".join(" ",@opts)." $_[1]);
|
|
while(1) {
|
|
$wf = &wait_for($ph, '(.*) \[\S+\]',
|
|
'Installation of \S+ failed',
|
|
'Installation of \S+ was successful',
|
|
'No changes were made to the system');
|
|
if ($wf == 0) {
|
|
# some question which should not have appeared before
|
|
if ($seen{$matches[1]}++) {
|
|
$rv = "<pre>$old_input$wait_for_input</pre>";
|
|
last;
|
|
}
|
|
&sysprint($ph, "y\n");
|
|
}
|
|
elsif ($wf == 1 || $wf == 3) {
|
|
# failed for some reason.. give up
|
|
$rv = "<pre>$old_input$wait_for_input</pre>";
|
|
last;
|
|
}
|
|
elsif ($wf == 2) {
|
|
# done ok!
|
|
$rv = undef;
|
|
last;
|
|
}
|
|
$old_input = $wait_for_input;
|
|
}
|
|
close($ph);
|
|
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, %errs, $curr, $line, %file);
|
|
undef(%files);
|
|
$chk = `pkgchk -n $_[0] 2>&1`;
|
|
while($chk =~ /^(\S+): (\S+)\n((\s+.*\n)+)([\0-\177]*)$/) {
|
|
if ($1 eq "ERROR") { $errs{$2} = $3; }
|
|
$chk = $5;
|
|
}
|
|
|
|
open(CHK, "pkgchk -l $_[0] 2>&1 |");
|
|
FILES: for($i=0; 1; $i++) {
|
|
# read one package
|
|
$curr = "";
|
|
while(1) {
|
|
if (!($line = <CHK>)) { last FILES; }
|
|
if ($line =~ /Current status/) { $line = <CHK>; last; }
|
|
$curr .= $line;
|
|
}
|
|
|
|
# extract information
|
|
&parse_pkgchk($curr);
|
|
foreach $k (keys %file) { $files{$i,$k} = $file{$k}; }
|
|
$files{$i,'error'} = $errs{$files{$i,'path'}};
|
|
}
|
|
close(CHK);
|
|
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
|
|
{
|
|
$temp = &tempname();
|
|
open(TEMP, "> $temp");
|
|
print TEMP "$_[0]\n";
|
|
close(TEMP);
|
|
|
|
$out = `pkgchk -l -i $temp 2>&1`;
|
|
unlink($temp);
|
|
if ($out =~ /\S/) {
|
|
&parse_pkgchk($out);
|
|
return 1;
|
|
}
|
|
else { return 0; }
|
|
}
|
|
|
|
# delete_package(package)
|
|
# Totally remove some package
|
|
sub delete_package
|
|
{
|
|
local($ph, $pth, $ppid, $wf, %seen, $old_input);
|
|
local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec_logged",
|
|
"pkgrm", $_[0]);
|
|
if (&wait_for($ph, 'remove this package', 'ERROR')) {
|
|
return "package does not exist";
|
|
}
|
|
&sysprint($ph, "y\n");
|
|
while(1) {
|
|
$wf = &wait_for($ph, '(.*) \[\S+\]',
|
|
'Removal of \S+ failed',
|
|
'Removal of \S+ was successful');
|
|
if ($wf == 0) {
|
|
# some question which should not have appeared before
|
|
if ($seen{$matches[1]}++) {
|
|
$rv = "<pre>$old_input$wait_for_input</pre>";
|
|
last;
|
|
}
|
|
&sysprint($ph, "y\n");
|
|
}
|
|
elsif ($wf == 1) {
|
|
# failed for some reason.. give up
|
|
$rv = "<pre>$old_input$wait_for_input</pre>";
|
|
last;
|
|
}
|
|
elsif ($wf == 2) {
|
|
# done ok!
|
|
$rv = undef;
|
|
last;
|
|
}
|
|
$old_input = $wait_for_input;
|
|
}
|
|
close($ph);
|
|
return $rv;
|
|
}
|
|
|
|
# parse_pkgchk(output)
|
|
# Parse output about one file from pkgchk into the array %file
|
|
sub parse_pkgchk
|
|
{
|
|
undef(%file);
|
|
if ($_[0] =~ /Pathname:\s+(.*)/) { $file{'path'} = $1; }
|
|
if ($_[0] =~ /Type:\s+(.*)/) {
|
|
$file{'type'} = $1 eq "regular file" ? 0 :
|
|
$1 eq "directory" ? 1 :
|
|
$1 eq "special file" ? 2 :
|
|
$1 eq "symbolic link" ? 3 :
|
|
$1 eq "linked file" ? 4 :
|
|
$1 eq "volatile file" ? 5 :
|
|
$1 eq "editted file" ? 5 :
|
|
$1 eq "edited file" ? 5 :
|
|
-1;
|
|
}
|
|
if ($_[0] =~ /Source of link:\s+(\S+)/) { $file{'link'} = $1; }
|
|
if ($_[0] =~ /Expected owner:\s+(\S+)/) { $file{'user'} = $1; }
|
|
if ($_[0] =~ /Expected group:\s+(\S+)/) { $file{'group'} = $1; }
|
|
if ($_[0] =~ /Expected mode:\s+(\S+)/) { $file{'mode'} = $1; }
|
|
if ($_[0] =~ /size \(bytes\):\s+(\d+)/) { $file{'size'} = $1; }
|
|
if ($_[0] =~ /following packages:\n(((\s+.*\n)|\n)+)/)
|
|
{ $file{'packages'} = join(' ', split(/\s+/, $1)); }
|
|
}
|
|
|
|
|
|
sub package_system
|
|
{
|
|
return $text{'pkgadd_manager'};
|
|
}
|
|
|
|
sub package_help
|
|
{
|
|
return "pkgadd pkginfo pkgchk pkgrm";
|
|
}
|
|
|
|
1;
|
|
|