diff options
Diffstat (limited to 't/helpers.pm')
| -rw-r--r-- | t/helpers.pm | 160 |
1 files changed, 160 insertions, 0 deletions
diff --git a/t/helpers.pm b/t/helpers.pm new file mode 100644 index 0000000..72d4f68 --- /dev/null +++ b/t/helpers.pm @@ -0,0 +1,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; |