summaryrefslogtreecommitdiffstats
path: root/t/helpers.pm
blob: 72d4f68f99fe13a54d8c6297fcd116e2b8b41031 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
use strict;
use warnings;
use English;
use File::Temp qw(tempdir); # in core since perl 5.6.1
use File::Copy qw(cp);
use File::Path qw(make_path);

sub check_fakechroot_running() {
    my $content = `FAKECHROOT_DETECT=1 sh -c "echo This should not be printed"`;
    my $result = 0;
    if ($content =~ /^fakechroot [0-9.]+\n$/) {
        $result = 1;
    }
    return $result;
}

sub test_setup() {
    if (length $ENV{TEST_DPKG_ROOT}) {
        print STDERR "test_setup() with DPKG_ROOT\n";
        $ENV{DPKG_ROOT} = tempdir( CLEANUP => 1 );
        return;
    }

    if ( !check_fakechroot_running ) {
	print STDERR "you have to run this script inside fakechroot and fakeroot:\n";
	print STDERR ("    fakechroot fakeroot perl $PROGRAM_NAME" . (join " ", @ARGV) . "\n");
	exit 1;
    }

    # Set up a chroot that contains everything necessary to run
    # deb-systemd-helper under fakechroot.
    print STDERR "test_setup() with fakechroot\n";

    my $tmpdir = tempdir( CLEANUP => 1 );
    mkdir "$tmpdir/dev";
    0 == system 'mknod', "$tmpdir/dev/null", 'c', '1', '3' or die "cannot mknod: $?";
    mkdir "$tmpdir/tmp";
    make_path("$tmpdir/usr/bin");
    make_path("$tmpdir/usr/lib/systemd/user");
    make_path("$tmpdir/lib/systemd/system/");
    make_path("$tmpdir/var/lib/systemd");
    make_path("$tmpdir/etc/systemd");
    if ( length $ENV{TEST_INSTALLED} ) {
        # if we test the installed deb-systemd-helper we copy it from the
        # system's installation
        cp "/usr/bin/deb-systemd-helper", "$tmpdir/usr/bin/deb-systemd-helper"
          or die "cannot copy: $!";
    }
    else {
        cp "$FindBin::Bin/../script/deb-systemd-helper",
          "$tmpdir/usr/bin/deb-systemd-helper"
          or die "cannot copy: $!";
    }

    # make sure that dpkg diversion messages are not translated
    local $ENV{LC_ALL} = 'C.UTF-8';
    # the chroot only needs to contain a working perl-base
    open my $fh, '-|', 'dpkg-query', '--listfiles', 'perl-base';

    while ( my $path = <$fh> ) {
        chomp $path;
        # filter out diversion messages in the same way that dpkg-repack does
        # https://git.dpkg.org/cgit/dpkg/dpkg-repack.git/tree/dpkg-repack#n238
        if ($path =~ /^package diverts others to: /) {
            next;
        }
        if ($path =~ /^diverted by [^ ]+ to: /) {
            next;
        }
        if ($path =~ /^locally diverted to: /) {
            next;
        }
        if ($path !~ /^\//) {
            die "path must start with a slash";
        }
        if ( -e "$tmpdir$path" ) {
            # ignore paths that were already created
            next;
        } elsif ( !-r $path ) {
            # if the host's path is not readable, assume it's a directory
            mkdir "$tmpdir$path" or die "cannot mkdir $path: $!";
        } elsif ( -l $path ) {
            symlink readlink($path), "$tmpdir$path";
        } elsif ( -d $path ) {
            mkdir "$tmpdir$path" or die "cannot mkdir $path: $!";
        } elsif ( -f $path ) {
            cp $path, "$tmpdir$path" or die "cannot cp $path: $!";
        } else {
            die "cannot handle $path";
        }
    }
    close $fh;

    $ENV{'SYSTEMCTL_INSTALL_CLIENT_SIDE'} = '1';

    # we run the chroot call in a child process because we need the parent
    # process remaining un-chrooted or otherwise it cannot clean-up the
    # temporary directory on exit
    my $pid = fork() // die "cannot fork: $!";
    if ( $pid == 0 ) {
        chroot $tmpdir or die "cannot chroot: $!";
        chdir "/"      or die "cannot chdir to /: $!";
        return;
    }
    waitpid($pid, 0);

    exit $?;
}

# reads in a whole file
sub slurp {
    open my $fh, '<', shift;
    local $/;
    <$fh>;
}

sub state_file_entries {
    my ($path) = @_;
    my $bytes = slurp($path);
    my $dpkg_root = $ENV{DPKG_ROOT} // '';
    return map { "$dpkg_root$_" } split("\n", $bytes);
}

my $dsh = '';
if ( length $ENV{TEST_INSTALLED} ) {
    # if we are to test the installed version of deb-systemd-helper then even
    # in DPKG_ROOT mode, we want to run /usr/bin/deb-systemd-helper
    $dsh = "/usr/bin/deb-systemd-helper";
} else {
    if ( length $ENV{TEST_DPKG_ROOT} ) {
        # when testing deb-systemd-helper from source, then in DPKG_ROOT mode,
        # we take the script from the source directory
        $dsh = "$FindBin::Bin/../script/deb-systemd-helper";
    } else {
        $dsh = "/usr/bin/deb-systemd-helper";
    }
}
$ENV{'DPKG_MAINTSCRIPT_PACKAGE'} = 'deb-systemd-helper-test';

sub dsh {
    return system($dsh, @_);
}

sub _unit_check {
    my ($cmd, $cb, $verb, $unit, %opts) = @_;

    my $retval = dsh($opts{'user'} ? '--user' : '--system', $cmd, $unit);

    isnt($retval, -1, 'deb-systemd-helper could be executed');
    ok(!($retval & 127), 'deb-systemd-helper did not exit due to a signal');
    $cb->($retval >> 8, 0, "random unit file '$unit' $verb $cmd");
}

sub is_enabled { _unit_check('is-enabled', \&is, 'is', @_) }
sub isnt_enabled { _unit_check('is-enabled', \&isnt, 'isnt', @_) }

sub is_debian_installed { _unit_check('debian-installed', \&is, 'is', @_) }
sub isnt_debian_installed { _unit_check('debian-installed', \&isnt, 'isnt', @_) }

1;