#!/usr/bin/perl
use warnings;
use strict;
use Dpkg::ErrorHandling;
use Dpkg::IPC;
use File::FcntlLock;
use File::Copy;
use File::Path qw(make_path);
use constant {
INCOMING_APPDIR => "/usr/share/kali-menu/applications",
OUTGOING_APPDIR => "/usr/share/applications",
DPKG_LOCKFILE => "/var/lib/dpkg/lock",
KALI_MENU_LOCKFILE => "/var/lock/kali-menu",
};
our %pkg2desktop;
our %desktop2pkg;
our %installed;
make_path(OUTGOING_APPDIR, mode => 0755);
my $lock = get_lock(); # Can stop here if another instance is already running
parse_kali_desktop_files();
my $arg = shift @ARGV || "";
wait_dpkg() if (defined $ENV{'DPKG_RUNNING_VERSION'} or $arg eq "wait_dpkg");
# Scan installed packages to identify desktop files to install
foreach my $pkg (list_installed_packages()) {
$installed{$pkg} = 1;
next unless exists $pkg2desktop{$pkg};
foreach my $desktop (@{$pkg2desktop{$pkg}}) {
my $target = OUTGOING_APPDIR . "/$desktop";
my $source = INCOMING_APPDIR . "/$desktop";
take_control_of($target);
copy($source, $target);
}
}
# Scan installed desktop files to remove the entries that are no longer
# relevant
FILE: foreach my $desktop (list_installed_desktop_files()) {
my $ref_file = INCOMING_APPDIR . "/$desktop";
my $out_file = OUTGOING_APPDIR . "/$desktop";
next unless is_managed($out_file);
# Drop unknown files
unless (-e $ref_file and exists $desktop2pkg{$desktop}) {
release_desktop_file($out_file);
next;
}
# Ensure the corresponding package is still installed
foreach my $pkg (@{$desktop2pkg{$desktop}}) {
next FILE if $installed{$pkg};
}
release_desktop_file($out_file);
}
close($lock);
### HELPER FUNCTIONS
sub release_desktop_file {
my ($file) = @_;
my $infos = get_dpkg_infos($file);
unlink($file) or syserr("can't remove %s", $file);
remove_diversion($file) if $infos->{'diverted'};
}
sub take_control_of {
my ($target) = @_;
return if not -e $target; # No conflicting file, go ahead
return if is_managed($target); # Already managed, nothing else to do
my $infos = get_dpkg_infos($target);
if ($infos->{'known'} and not $infos->{'diverted'}) {
divert($target);
}
}
sub get_dpkg_infos {
my ($target) = @_;
my $pipe;
my $pid = spawn(exec => [ 'dpkg-query', '-S', $target ],
to_pipe => \$pipe, error_to_file => "/dev/null",
env => { LC_ALL => 'C' });
my $res = {
diverted => 0,
known => 0,
};
while (<$pipe>) {
if (/^(diversion by|local diversion)/) {
$res->{'diverted'} = 1;
next;
}
$res->{'known'} = 1 if /: \Q$target\E/;
}
wait_child($pid, cmdline => "dpkg-query -S $target", nocheck => 1);
return $res;
}
sub divert {
my ($target) = @_;
spawn(exec => [ "dpkg-divert", "--local", "--rename", "--divert",
"$target.disabled-by-kali-menu", "--add", $target ],
wait_child => 1, to_file => "/dev/null");
}
sub remove_diversion {
my ($target) = @_;
spawn(exec => [ "dpkg-divert", "--local", "--rename", "--divert",
"$target.disabled-by-kali-menu", "--remove", $target ],
wait_child => 1, to_file => "/dev/null");
}
sub is_managed {
my ($target) = @_;
my $res = 0;
open(my $fh, "<", $target) or syserr("can't open %s", $target);
if (grep { /^X-Kali-Package=/i } <$fh>) {
$res = 1;
}
close($fh);
return $res;
}
sub list_installed_packages {
my (@list, $pipe);
my $pid = spawn(exec => [ 'dpkg-query', '-f', '${Package} ${Status}\n', '-W' ],
to_pipe => \$pipe);
while (<$pipe>) {
my ($pkg, $want, $ok, $status) = split;
if ($status ne "not-installed" and $status ne "config-files") {
push @list, $pkg;
}
}
wait_child($pid, cmdline => "dpkg-query");
return @list;
}
sub list_installed_desktop_files {
opendir(my $dh, OUTGOING_APPDIR) or syserr("can't opendir %s", OUTGOING_APPDIR);
my @files = grep(/\.desktop$/, readdir($dh));
closedir($dh);
return @files;
}
sub parse_kali_desktop_files {
opendir(my $dh, INCOMING_APPDIR) or syserr("can't opendir %s", INCOMING_APPDIR);
foreach my $file (readdir $dh) {
next unless ($file =~ /\.desktop$/);
my $path = INCOMING_APPDIR . "/$file";
open(my $fh, "<", $path) or syserr("can't open %s", $path);
my $found = 0;
while (<$fh>) {
if (/X-Kali-Package=\s*(.*)$/i) {
$found = 1;
foreach my $pkg (split(/\s+|\s*,\s*/, $1)) {
$pkg2desktop{$pkg} = [] unless exists $pkg2desktop{$pkg};
$desktop2pkg{$file} = [] unless exists $desktop2pkg{$file};
push @{$pkg2desktop{$pkg}}, $file;
push @{$desktop2pkg{$file}}, $pkg;
}
}
}
close($fh);
unless ($found) {
warning("%s is missing the X-Kali-Package header", $path);
}
}
closedir($dh);
}
sub get_lock {
my $lockfile = KALI_MENU_LOCKFILE;
system("touch $lockfile") unless -e $lockfile;
open my $fh, '>>', $lockfile or syserr("Can't open %s", $lockfile);
my $fs = new File::FcntlLock l_type => F_WRLCK;
if (not $fs->lock($fh, F_SETLK)) {
exit 0; # Failed to lock, another instance is already running
}
return $fh;
}
sub wait_dpkg {
return unless -e DPKG_LOCKFILE;
open my $fh, '<', DPKG_LOCKFILE or syserr("Can't open %s", DPKG_LOCKFILE);
my $fs = new File::FcntlLock l_type => F_WRLCK;
# Wait until dpkg releases the lock and doesn't grab it back in the
# next 5 seconds
my $count = 0;
while ($count < 2) {
if (can_lock($fh, $fs)) {
$count++;
} else {
$count = 0;
}
sleep(5);
}
close $fh;
}
sub can_lock {
my ($fh, $fs) = @_;
$fs->l_type(F_WRLCK);
if (not $fs->lock($fh, F_GETLK)) {
error("Failed to analyze lock on %s: %s", DPKG_LOCKFILE, $fs->error());
}
return $fs->l_type == F_UNLCK;
}