[Pkg-systemd-maintainers] Bug#704197: Please review: systemd checks

[Michael Stapelberg]

Package: lintian
Version: 2.5.10.4
Severity: wishlist

Attached you can find my first stab at systemd-related checks for
lintian. While some details in parsing the service files are not
implemented (see the TODOs in the code), I’d like you to have a look at
the checks in general. Is there anything that needs to be improved
before these can be shipped with lintian?

Thanks!
-------------- next part --------------
Check-Script: systemd
Author: Michael Stapelberg <stapelberg at debian.org>
Abbrev: systemd
Type: binary
Info: Checks various systemd policy things
Needs-Info: scripts, index, unpacked, file-info

Tag: systemd-service-file-outside-lib
Severity: serious
Certainty: certain
Info: The package ships a systemd service file outside
 <tt>/lib/systemd/system/</tt>
 .
 System administrators should have the possibility to overwrite a service file
 (or parts of it, in newer systemd versions) by placing a file in
 <tt>/etc/systemd/system</tt>, so the canonical location we use for service
 files is <tt>/lib/systemd/system/</tt>.

Tag: systemd-tmpfiles.d-outside-usr-lib
Severity: serious
Certainty: certain
Info: The package ships a systemd tmpfiles.d(5) conf file outside
 <tt>/usr/lib/tmpfiles.d/</tt>

Tag: systemd-service-file-refers-to-obsolete-target
Severity: normal
Certainty: certain
Info: The systemd service file refers to an obsolete target.
 .
 Some targets are obsolete by now, e.g. syslog.target or dbus.target. For
 example, declaring <tt>After=syslog.target</tt> is unnecessary by now because
 syslog is socket-activated and will therefore be started when needed.

Tag: systemd-no-service-for-init-script
Severity: serious
Certainty: certain
Info: The listed init.d script has no systemd equivalent.
 .
 Systemd has a SysV init.d script compatibility mode. It provides access to
 each SysV init.d script as long as there is no native service file with the
 same name (e.g. <tt>/lib/systemd/system/rsyslog.service</tt> corresponds to
 <tt>/etc/init.d/rsyslog</tt>).
 .
 Your package ships a service file, but for the listed init.d script, there is
 no corresponding systemd service file.

Tag: init.d-script-does-not-source-init-functions
Severity: normal
Certainty: certain
Info: The <tt>/etc/init.d</tt> script does not source
 <tt>/lib/lsb/init-functions</tt>. The <tt>systemd</tt> package provides
 <tt>/lib/lsb/init-functions.d/40-systemd</tt> to redirect
 <tt>/etc/init.d/$script</tt> calls to systemctl.
 .
 Please add a line like this to your <tt>/etc/init.d</tt> script:
 .
  . /lib/lsb/init-functions

Tag: maintainer-script-calls-systemctl
Severity: normal
Certainty: certain
Info: The maintainer script calls systemctl directly. Actions such as enabling
 or starting a service have to be done via <tt>update-rc.d</tt> or
 <tt>invoke-rc.d</tt>, respectively, which both do the right thing when systemd
 is installed/running.
-------------- next part --------------
# systemd -- lintian check script -*- perl -*-
#
# Copyright © 2013 Michael Stapelberg
#
# based on the apache2 checks file by:
# Copyright © 2012 Arno Töll
#
# 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 program.  If not, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.

package Lintian::systemd;

use strict;
use warnings;

use File::Basename;
use Lintian::Collect::Binary ();
use Lintian::Tags qw(tag);
use Lintian::Relation qw(:constants);
use Lintian::Util qw(fail);
use Data::Dumper;

sub run {
    my ($pkg, $type, $info) = @_;

    if ($type eq 'binary') {
        # Figure out whether the maintainer of this package did any effort to
        # make the package work with systemd. If not, we will not warn in case
        # of an init script that has no systemd equivalent, for example.
        my $ships_systemd_file = (scalar ( grep { m,/systemd/, } $info->sorted_index ) > 0);

        # An array of names which are provided by the service files.
        # This includes Alias= directives, so after parsing
        # NetworkManager.service, it will contain NetworkManager and
        # network-manager.
        my @systemd_targets;

        for my $file ($info->sorted_index) {
            if ($file =~ m,^etc/tmpfiles\.d/.*\.conf$,) {
                tag('systemd-tmpfiles.d-outside-usr-lib', $file);
            }
            if ($file =~ m,^etc/systemd/system/.*\.service$,) {
                tag('systemd-service-file-outside-lib', $file);
            }
            if ($file =~ m,/systemd/system/.*\.service$,) {
                check_systemd_service_file($pkg, $info, $file);
                for my $name (extract_service_file_names($pkg, $info, $file)) {
                    push @systemd_targets, $name;
                }
            }
        }

        my @init_scripts = grep(m,^etc/init\.d/.+,, $info->sorted_index);

        # Verify that each init script includes /lib/lsb/init-functions,
        # because that is where the systemd diversion happens.
        for my $init_script (@init_scripts) {
            check_init_script($pkg, $info, $init_script);
        }

        @init_scripts = map { basename($_) } @init_scripts;

        if ($ships_systemd_file) {
            for my $init_script (@init_scripts) {
                if (grep(/\Q$init_script\E\.service/, @systemd_targets) == 0) {
                    tag('systemd-no-service-for-init-script', $init_script);
                }
            }
        }

        check_maintainer_scripts($info);
    }
}

sub check_init_script {
    my ($pkg, $info, $file) = @_;
    
    my $lsb_source_seen;
    open(my $fh, '<', $info->unpacked($file));
    while (<$fh>) {
        s/^\s+//;
        next if /^#/;
        if (m,^(?:\.|source)\s+/lib/lsb/init-functions,) {
            $lsb_source_seen = 1;
            last;
        }
    }
    close($fh);

    if (!$lsb_source_seen) {
        tag('init.d-script-does-not-source-init-functions', $file);
    }
}

sub check_systemd_service_file {
    my ($pkg, $info, $file) = @_;

    my $filename =  $info->unpacked ($file);
    open(my $fh, '<', $filename);
    while (<$fh>) {
        if (/After.*((?:syslog|dbus).target)/) {
            tag('systemd-service-file-refers-to-obsolete-target', $file, $1);
        }
    }
    close($fh);
}

sub split_quoted {
    my ($input) = @_;

    my @result;

    while ($input ne '') {
        $input =~ s/^[ \t\n\r]+//;

        # by default, capture until whitespace
        my $end = "[ \t\n\r]";

        # or a specific delimiter, if present
        my ($begin) = ($input =~ /^([\'\"]?)/);
        $end = $begin if $begin ne '';

        $input =~ s/^$begin(.*?[^\\])(?:$end|$)//;
        push @result, $1;
    }

    return @result;
}

sub extract_service_file_names {
    my ($pkg, $info, $file) = @_;

    my @aliases;
    my $section;
    open(my $fh, '<', $info->unpacked($file));
    while (<$fh>) {
# TODO: continuation handling
        # equivalent of strstrip(l)
        $_ =~ s,[ \t\n\r]+$,,g;

        next if $_ eq '';

        next if /^[#;\n]/;

        # TODO: .include

        # section header
        if (/^\[([^\]]+)\]$/) {
            $section = $1;
            next;
        }

        if (!defined($section)) {
            # Assignment outside of section. Ignoring.
            next;
        }

        my ($key, $value) = ($_ =~ m,^(.*)=(.*)$,);
# TODO: where is the key comparison?
        if ($key eq 'Alias') {
            if ($value eq '') {
                # Empty assignment resets the list
                @aliases = ();
            }

            @aliases = (@aliases, split_quoted($value));
        }
    }
    close($fh);

    return (basename($file), @aliases);
}

sub check_maintainer_scripts {
    my ($info) = @_;

# TODO: use lab_data_path before submitting
    open my $fd, '<', $info->base_dir . '/control-scripts'
        or fail "cannot open lintian control-scripts file: $!";

    while (<$fd>) {
        m/^(\S*) (.*)$/ or fail("bad line in control-scripts file: $_");
        my $interpreter = $1;
        my $file = $2;
        my $filename = $info->control ($file);

        # Don't follow links
        next if -l $filename;
        # Don't try to parse the file if it does not appear to be a shell script
        next if $interpreter !~ m/sh\b/;

        open my $sfd, '<', $filename or fail "cannot open maintainer script $filename: $!";
        while (<$sfd>) {
            # skip comments
            next if substr ($_, 0, $-[0]) =~ /#/;

            # systemctl should not be called in maintainer scripts at all.
            if (m/\bsystemctl\b/) {
                tag('maintainer-script-calls-systemctl', $file);
            }
        }
        close $sfd;
    }

    close $fd;
}

1;

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et