server/usr/share/perl5/NeedRestart/UI/Debconf.pm

# needrestart - Restart daemons after library updates.
#
# Authors:
#   Thomas Liske <thomas@fiasko-nw.net>
#
# Copyright Holder:
#   2013 - 2022 (C) Thomas Liske [http://fiasko-nw.net/~thomas/]
#
# License:
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this package; if not, write to the Free Software
#   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
#

package NeedRestart::UI::Debconf;

use strict;
use warnings;

use parent qw(NeedRestart::UI);
use NeedRestart qw(:ui);
use Sort::Naturally;

use constant {
    DCTMPL => '/usr/share/needrestart/needrestart.templates',
};

BEGIN {
    die __PACKAGE__." is not supported as normal user!\n" if($<);
}

use Debconf::Client::ConfModule qw(:all);

version('2.0');
capb('backup');

needrestart_ui_register(__PACKAGE__, NEEDRESTART_PRIO_HIGH);

sub dcres(@) {
    return unless(scalar @_);

    my ($rc, @bulk) = @_;

    if($rc != 0 && $rc != 30) {
	stop;

	die "Debconf: $bulk[0]\n";
    }

    return @bulk;
}

sub new {
    my $class = shift;
    my $verbosity = shift;

    dcres( x_loadtemplatefile(DCTMPL) ) if(-r DCTMPL);

    return bless {
	verbosity => $verbosity,
    }, $class;
}

sub _announce {
    my $self = shift;
    my $templ = shift;
    my %vars = @_;

    foreach my $k (keys %vars) {
	dcres( subst($templ, $k, $vars{$k}) );
    }

    dcres( fset($templ, 'seen', 0) );
    dcres( settitle('needrestart/ui-kernel_title') );
    dcres( input('critical', $templ) );
    dcres( go );
}

sub announce_abi {
    my $self = shift;

    $self->_announce('needrestart/ui-kernel_announce_abi', @_);
}

sub announce_ver {
    my $self = shift;

    $self->_announce('needrestart/ui-kernel_announce_ver', @_);
}

sub announce_ehint {
    my $self = shift;
    my %vars = @_;
    my $templ = q(needrestart/ui-ehint_announce);

    foreach my $k (keys %vars) {
	dcres( subst($templ, $k, $vars{$k}) );
    }

    dcres( fset($templ, 'seen', 0) );
    dcres( settitle('needrestart/ui-ehint_title') );
    dcres( input('critical', $templ) );
    dcres( go );
}

sub announce_ucode {
    my $self = shift;
    my %vars = @_;
    my $templ = 'needrestart/ui-ucode_announce';

    foreach my $k (keys %vars) {
        dcres( subst($templ, $k, $vars{$k}) );
    }

    dcres( fset($templ, 'seen', 0) );
    dcres( settitle('needrestart/ui-ucode_title') );
    dcres( input('critical', $templ) );
    dcres( go );
}


sub notice {
    my $self = shift;
    my $out = shift;

    return unless($self->{verbosity});

    my $indent = ' ';
    $indent .= $1 if($out =~ /^(\s+)/);

    $self->wprint(\*STDERR, '', $indent, "$out\n");
}

sub vspace {
    my $self = shift;

    return unless($self->{verbosity});

    $self->SUPER::vspace(\*STDERR);
}


sub command {
    my $self = shift;
    my $out = shift;

    print STDERR "$out\n";
}


sub query_pkgs($$$$$$) {
    my $self = shift;
    my $out = shift;
    my $defno = shift;
    my $pkgs = shift;
    my $overrides = shift;
    my $cb = shift;

    # prepare checklist array
    my @l = nsort keys %$pkgs;

    # apply rc selection overrides
    my @selected = ();
    foreach my $pkg (@l) {
	my $found;
	foreach my $re (keys %$overrides) {
	    next unless($pkg =~ /$re/);

	    push(@selected, $pkg) if($overrides->{$re});
	    $found++;
	    last;
	}

	push(@selected, $pkg) unless($defno || $found);
    }
    dcres(set('needrestart/ui-query_pkgs', join(', ', @selected)));

    dcres( subst('needrestart/ui-query_pkgs', 'OUT', $out) );
    dcres( subst('needrestart/ui-query_pkgs', 'PKGS', join(', ', @l)) );
    dcres( fset('needrestart/ui-query_pkgs', 'seen', 0) );
    dcres( settitle('needrestart/ui-query_pkgs_title') );
    dcres( input('critical', 'needrestart/ui-query_pkgs') );
    my ($r) = dcres( go );

    my ($s) = dcres( get('needrestart/ui-query_pkgs') );

    # user has canceled
    return unless(defined($s));
    return if($r eq 'backup');

    # get selected rc.d script
    my @s = split(/, /, $s);

    $self->runcmd(sub {
	# restart each selected service script
	&$cb($_) for @s;
		  });
}

sub query_conts($$$$$$) {
    my $self = shift;
    my $out = shift;
    my $defno = shift;
    my $pkgs = shift;
    my $overrides = shift;
    my $cb = shift;

    # prepare checklist array
    my @l = nsort keys %$pkgs;

    # apply rc selection overrides
    my @selected = ();
    foreach my $pkg (@l) {
	my $found;
	foreach my $re (keys %$overrides) {
	    next unless($pkg =~ /$re/);

	    push(@selected, $pkg) if($overrides->{$re});
	    $found++;
	    last;
	}

	push(@selected, $pkg) unless($defno || $found);
    }
    dcres(set('needrestart/ui-query_conts', join(', ', @selected)));

    dcres( subst('needrestart/ui-query_conts', 'OUT', $out) );
    dcres( subst('needrestart/ui-query_conts', 'CONTS', join(', ', @l)) );
    dcres( fset('needrestart/ui-query_conts', 'seen', 0) );
    dcres( settitle('needrestart/ui-query_conts_title') );
    dcres( input('critical', 'needrestart/ui-query_conts') );
    my ($r) = dcres( go );

    my ($s) = dcres( get('needrestart/ui-query_conts') );

    # user has canceled
    return unless(defined($s));
    return if($r eq 'backup');

    # get selected rc.d script
    my @s = split(/, /, $s);

    $self->runcmd(sub {
	# restart each selected service script
	&$cb($_) for @s;
		  });
}

sub runcmd {
    my $self = shift;

    local *STDOUT;

    # Debconf kills STDOUT... try to restore it
    open(STDOUT, '> /dev/tty') || open(STDOUT, '>&2');

    $self->SUPER::runcmd(@_);

    close(STDOUT);
}

# Workaround for Debian Bug#893152
#
# Using Debconf leaks a fd to this module's source file. Since Perl seems
# not to set O_CLOEXEC the fd keeps open if the Debconf package uses fork
# to restart needrestart piped to Debconf. The FD will leak into restarted
# daemons if using Sys-V init.
foreach my $fn (</proc/self/fd/*>) {
    my $dst = readlink($fn);

    # check if the FD is the package source file
    if ($dst && ($dst eq __FILE__) && $fn =~ /\/(\d+)$/) {
        open(my $fh, "<&=", $1) || warn("$!\n");
        close($fh);
    }
}

1;