webmin/software/apk-lib.pl

# apk-lib.pl
# Functions for Alpine Package Keeper package management

$ENV{'PATH'} .= ":/sbin:/usr/sbin";
$apk_installed_db = "/lib/apk/db/installed";

sub list_package_system_commands
{
return ("apk");
}

sub list_update_system_commands
{
return ("apk");
}

# parse_apk_installed()
# Returns installed packages from APK's package database
sub parse_apk_installed
{
my @rv;
my $pkg = { };
my $last;
open(my $db, "<", $apk_installed_db) || return ();
while(my $line = <$db>) {
	$line =~ s/\r?\n$//;
	if ($line eq "") {
		push(@rv, $pkg) if ($pkg->{'P'});
		$pkg = { };
		$last = undef;
		next;
		}
	if ($line =~ /^([A-Za-z]):(.*)$/) {
		$pkg->{$1} = $2;
		$last = $1;
		}
	elsif ($line =~ /^\t(.*)$/ && defined($last)) {
		$pkg->{$last} .= "\n".$1;
		}
	}
close($db);
push(@rv, $pkg) if ($pkg->{'P'});
return @rv;
}

sub apk_package_class
{
return lc($_[0]) =~ /^[a-e]/ ? "A-E" :
       lc($_[0]) =~ /^[f-j]/ ? "F-J" :
       lc($_[0]) =~ /^[k-o]/ ? "K-O" :
       lc($_[0]) =~ /^[p-t]/ ? "P-T" :
       lc($_[0]) =~ /^[u-z]/ ? "U-Z" : "Other";
}

sub split_apk_name_version
{
my ($nv) = @_;
return ($1, $2) if ($nv =~ /^(.+)-([0-9][^\s]*)$/);
return ($nv, undef);
}

sub apk_package_record
{
my ($name, $ver) = @_;
foreach my $p (&parse_apk_installed()) {
	next if ($p->{'P'} ne $name);
	next if ($ver && $p->{'V'} ne $ver);
	return $p;
	}
return undef;
}

sub apk_quote_packages
{
return join(" ", map { quotemeta($_) } split(/\s+/, $_[0]));
}

# list_packages([package]*)
# Fills the array %packages with a list of all packages
sub list_packages
{
my %wanted = map { $_ => 1 } @_;
my $i = 0;
%packages = ( );
foreach my $p (sort { $a->{'P'} cmp $b->{'P'} } &parse_apk_installed()) {
	next if (@_ && !$wanted{$p->{'P'}});
	$packages{$i,'name'} = $p->{'P'};
	$packages{$i,'class'} = &apk_package_class($p->{'P'});
	$packages{$i,'version'} = $p->{'V'};
	$packages{$i,'desc'} = $p->{'T'};
	$packages{$i,'arch'} = $p->{'A'};
	$packages{$i,'url'} = $p->{'U'};
	$i++;
	}
return $i;
}

# package_search(string)
# Searches installed packages by name and description
sub package_search
{
my ($search) = @_;
my $n = &list_packages();
my $i = 0;
my %old = %packages;
%packages = ( );
for(my $j=0; $j<$n; $j++) {
	if ($old{$j,'name'} =~ /\Q$search\E/i ||
	    $old{$j,'desc'} =~ /\Q$search\E/i) {
		foreach my $k ('name', 'class', 'version', 'desc', 'arch',
			       'url') {
			$packages{$i,$k} = $old{$j,$k};
			}
		$i++;
		}
	}
return $i;
}

# package_info(package, [version])
# Returns name, class, description, arch, version, vendor, installtime, url
sub package_info
{
my ($name, $ver) = @_;
my $p = &apk_package_record($name, $ver);
return ( ) if (!$p);
return ( $p->{'P'}, &apk_package_class($p->{'P'}),
	 $p->{'T'} || $text{'apk_unknown'},
	 $p->{'A'} || $text{'apk_unknown'},
	 $p->{'V'} || $text{'apk_unknown'},
	 $p->{'m'} || "Alpine Linux",
	 undef,
	 $p->{'U'} );
}

sub virtual_package_info
{
return ( );
}

# package_files(package)
# Returns a list of all files in some package
sub package_files
{
my ($name) = @_;
my $qname = quotemeta($name);
my @rv;
&open_execute_command(PKGINFO, "apk info -L $qname 2>/dev/null", 1, 1);
while(<PKGINFO>) {
	s/\r|\n//g;
	next if (!$_ || / contains:$/);
	$_ = "/".$_ if ($_ !~ /^\//);
	push(@rv, $_);
	}
close(PKGINFO);
return @rv;
}

# check_files(package)
# Fills in the %files array with information about files belonging to a package
sub check_files
{
my ($name) = @_;
my @pkgfiles = &package_files($name);
%files = ( );
for(my $i=0; $i<@pkgfiles; $i++) {
	my $path = $pkgfiles[$i];
	my $real = &translate_filename($path);
	my @st = stat($real);
	$files{$i,'path'} = $path;
	$files{$i,'type'} = -l $real ? 3 : -d $real ? 1 : 0;
	$files{$i,'user'} = @st ? getpwuid($st[4]) : undef;
	$files{$i,'group'} = @st ? getgrgid($st[5]) : undef;
	$files{$i,'mode'} = @st ? sprintf("%o", $st[2] & 07777) : undef;
	$files{$i,'size'} = @st ? $st[7] : 0;
	$files{$i,'link'} = readlink($real);
	$files{$i,'error'} = "Does not exist" if (!@st);
	}
return scalar(@pkgfiles);
}

# installed_file(file)
# Fills %file with details of the package that owns a file
sub installed_file
{
my ($path) = @_;
my $qpath = quotemeta($path);
my $out = &backquote_command("apk info -W $qpath 2>&1", 1);
return 0 if ($? || $out !~ / is owned by (\S+)/);
my ($pkg, $ver) = &split_apk_name_version($1);
my $real = &translate_filename($path);
my @st = stat($real);
%file = ( );
$file{'path'} = $path;
$file{'type'} = -l $real ? 3 : -d $real ? 1 : 0;
$file{'user'} = @st ? getpwuid($st[4]) : undef;
$file{'group'} = @st ? getgrgid($st[5]) : undef;
$file{'mode'} = @st ? sprintf("%o", $st[2] & 07777) : undef;
$file{'size'} = @st ? $st[7] : 0;
$file{'link'} = readlink($real);
$file{'packages'} = $pkg;
$file{'versions'} = $ver;
return 1;
}

# is_package(file)
sub is_package
{
my ($path) = @_;
my $qpath = quotemeta($path);
my $out = &backquote_command("tar -tzf $qpath .PKGINFO 2>/dev/null", 1);
return $? ? 0 : 1;
}

# file_packages(file)
# Returns a list of packages in an apk file, in "package description" form
sub file_packages
{
my ($path) = @_;
my $qpath = quotemeta($path);
my $out = &backquote_command("tar -xOzf $qpath .PKGINFO 2>/dev/null", 1);
return ( ) if ($?);
my %info;
foreach my $line (split(/\r?\n/, $out)) {
	if ($line =~ /^(\S+)\s*=\s*(.*)$/) {
		$info{$1} = $2;
		}
	}
return $info{'pkgname'} ? ( $info{'pkgname'}." ".$info{'pkgdesc'} ) : ( );
}

sub install_options
{
print &ui_table_row($text{'apk_untrusted'},
	&ui_yesno_radio("untrusted", 0));
}

# install_package(file, package, [&inputs])
sub install_package
{
my ($path, $package, $inref) = @_;
$inref ||= \%in;
my $qpath = quotemeta($path);
my $args = $inref->{'untrusted'} ? "--allow-untrusted " : "";
my $out = &backquote_logged("apk add $args$qpath 2>&1 </dev/null");
return $? ? "<pre>$out</pre>" : undef;
}

# delete_package(package)
sub delete_package
{
my ($name) = @_;
my $out = &backquote_logged("apk del ".quotemeta($name)." 2>&1 </dev/null");
return $? ? "<pre>$out</pre>" : undef;
}

sub package_dependencies
{
my ($name, $ver) = @_;
my $p = &apk_package_record($name, $ver);
return ( ) if (!$p || !$p->{'D'});
my @rv;
foreach my $dep (split(/\s+/, $p->{'D'})) {
	next if (!$dep);
	$dep =~ s/^\!//;
	if ($dep =~ /^([A-Za-z0-9+_.-]+)([<>=~]+)(\S+)$/) {
		push(@rv, { 'package' => $1,
			    'compare' => $2,
			    'version' => $3 });
		}
	elsif ($dep =~ /^[A-Za-z0-9+_.-]+$/) {
		push(@rv, { 'package' => $dep });
		}
	else {
		push(@rv, { 'other' => $dep });
		}
	}
return @rv;
}

sub package_system
{
return $text{'apk_manager'};
}

sub package_help
{
return "apk";
}

###### Update system functions

sub update_system_search
{
my ($search) = @_;
my $pattern = defined($search) && $search ne "" && $search ne ".*" ?
	"*".$search."*" : "*";
my @rv;
&clean_language();
&open_execute_command(SEARCH, "apk search -v ".quotemeta($pattern)." 2>/dev/null", 1, 1);
while(<SEARCH>) {
	s/\r|\n//g;
	if (/^(.+)-([0-9][^\s]*)\s+-\s+(.*)$/) {
		push(@rv, { 'name' => $1,
			    'version' => $2,
			    'desc' => $3 });
		}
	}
close(SEARCH);
&reset_environment();
return @rv;
}

sub update_system_available
{
&execute_command("apk update");
return &update_system_search(".*");
}

sub update_system_updates
{
my @rv;
&execute_command("apk update");
&clean_language();
&open_execute_command(UPDATES, "apk version -l '<' -v 2>/dev/null", 1, 1);
while(<UPDATES>) {
	s/\r|\n//g;
	if (/^(.+)-([0-9][^\s]*)\s+<\s+(\S+)/) {
		push(@rv, { 'name' => $1,
			    'oldversion' => $2,
			    'version' => $3 });
		}
	}
close(UPDATES);
&reset_environment();
return @rv;
}

sub update_system_install
{
my $update = $_[0] || $in{'update'};
my @rv;
my $qupdate = &apk_quote_packages($update);
my $cmd = "apk add --update --upgrade $qupdate";
print &text('apk_install', "<tt>".&html_escape($cmd)."</tt>"),"\n";
print "<pre data-installer>";
&additional_log('exec', undef, $cmd);
&open_execute_command(CMD, "$cmd 2>&1 </dev/null", 2);
while(<CMD>) {
	if (/\b(?:Installing|Upgrading|Downgrading)\s+(\S+)\s+\(/) {
		push(@rv, $1);
		}
	print &html_escape($_);
	}
close(CMD);
print "</pre>\n";
if ($?) { print "$text{'apk_failed'}<p>\n"; }
else { print "$text{'apk_ok'}<p>\n"; }
return &unique(@rv);
}

sub update_system_resolve
{
my ($name) = @_;
return $name eq "apache" ? "apache2" :
       $name eq "dhcpd" ? "dhcp" :
       $name eq "mysql" ? "mariadb mariadb-client mariadb-server-utils" :
       $name eq "postgresql" ? "postgresql postgresql-client" :
       $name eq "openldap" ? "openldap openldap-clients" :
       $name eq "ldap" ? "openldap openldap-clients" :
       $name eq "dovecot" ? "dovecot" :
       $name eq "samba" ? "samba samba-client" :
       $name eq "openssh" ? "openssh" :
       $name eq "squid" ? "squid" :
			    $name;
}

1;