ci/deps.perl

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 2019-2020 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 # Helper script for installing/uninstalling packages for CI use
   5 # Intended for use on non-production chroots or VMs since it
   6 # changes installed packages
   7 use strict;
   8 my $usage = "$0 PKG_FMT PROFILE [PROFILE_MOD]";
   9 my $pkg_fmt = shift;
  10 @ARGV or die $usage, "\n";
  11
  12 my @test_essential = qw(Test::Simple); # we actually use Test::More
  13
  14 # package profiles
  15 my $profiles = {
  16         # the smallest possible profile for testing
  17         # TODO: trim URI::Escape from this, maybe
  18         essential => [ qw(
  19                 git
  20                 perl
  21                 Devel::Peek
  22                 Digest::SHA
  23                 Encode
  24                 ExtUtils::MakeMaker
  25                 IO::Compress::Gzip
  26                 URI::Escape
  27                 ), @test_essential ],
  28
  29         # everything optional for normal use
  30         optional => [ qw(
  31                 Date::Parse
  32                 BSD::Resource
  33                 DBD::SQLite
  34                 DBI
  35                 Inline::C
  36                 Net::Server
  37                 Plack
  38                 Plack::Test
  39                 Plack::Middleware::ReverseProxy
  40                 Search::Xapian
  41                 Socket6
  42                 highlight.pm
  43                 xapian-compact
  44                 ) ],
  45
  46         # optional developer stuff
  47         devtest => [ qw(
  48                 XML::TreePP
  49                 curl
  50                 w3m
  51                 ) ],
  52 };
  53
  54 # account for granularity differences between package systems and OSes
  55 my @precious;
  56 if ($^O eq 'freebsd') {
  57         @precious = qw(perl curl Socket6 IO::Compress::Gzip);
  58 } elsif ($pkg_fmt eq 'rpm') {
  59         @precious = qw(perl curl);
  60 }
  61
  62 if (@precious) {
  63         my $re = join('|', map { quotemeta($_) } @precious);
  64         for my $list (values %$profiles) {
  65                 @$list = grep(!/\A(?:$re)\z/, @$list);
  66         }
  67         push @{$profiles->{essential}}, @precious;
  68 }
  69
  70
  71 # bare minimum for v2
  72 $profiles->{v2essential} = [ @{$profiles->{essential}}, qw(DBD::SQLite DBI) ];
  73
  74 # package names which can't be mapped automatically:
  75 my $non_auto = {
  76         'perl' => { pkg => 'perl5' },
  77         'Date::Parse' => {
  78                 deb => 'libtimedate-perl',
  79                 pkg => 'p5-TimeDate',
  80                 rpm => 'perl-TimeDate',
  81         },
  82         'Devel::Peek' => {
  83                 deb => 'perl', # libperl5.XX, but the XX varies
  84                 pkg => 'perl5',
  85         },
  86         'Digest::SHA' => {
  87                 deb => 'perl', # libperl5.XX, but the XX varies
  88                 pkg => 'perl5',
  89         },
  90         'Encode' => {
  91                 deb => 'perl', # libperl5.XX, but the XX varies
  92                 pkg => 'perl5',
  93                 rpm => 'perl-Encode',
  94         },
  95         'ExtUtils::MakeMaker' => {
  96                 deb => 'perl', # perl-modules-5.xx
  97                 pkg => 'perl5',
  98                 rpm => 'perl-ExtUtils-MakeMaker',
  99         },
 100         'IO::Compress::Gzip' => {
 101                 deb => 'perl', # perl-modules-5.xx
 102                 pkg => 'perl5',
 103                 rpm => 'perl-IO-Compress',
 104         },
 105         'DBD::SQLite' => { deb => 'libdbd-sqlite3-perl' },
 106         'Plack::Test' => {
 107                 deb => 'libplack-perl',
 108                 pkg => 'p5-Plack',
 109                 rpm => 'perl-Plack-Test',
 110         },
 111         'URI::Escape' => {
 112                 deb => 'liburi-perl',
 113                 pkg => 'p5-URI',
 114                 rpm => 'perl-URI',
 115         },
 116         'Test::Simple' => {
 117                 deb => 'perl', # perl-modules-5.XX, but the XX varies
 118                 pkg => 'perl5',
 119                 rpm => 'perl-Test-Simple',
 120         },
 121         'highlight.pm' => {
 122                 deb => 'libhighlight-perl',
 123                 pkg => [],
 124                 rpm => [],
 125         },
 126
 127         # we call xapian-compact(1) in public-inbox-compact(1)
 128         'xapian-compact' => {
 129                 deb => 'xapian-tools',
 130                 pkg => 'xapian-core',
 131                 rpm => 'xapian-core', # ???
 132         },
 133
 134         # OS-specific
 135         'IO::KQueue' => {
 136                 deb => [],
 137                 pkg => 'p5-IO-KQueue',
 138                 rpm => [],
 139         },
 140 };
 141
 142 my (@pkg_install, @pkg_remove, %all);
 143 for my $ary (values %$profiles) {
 144         $all{$_} = \@pkg_remove for @$ary;
 145 }
 146 if ($^O eq 'freebsd') {
 147         $all{'IO::KQueue'} = \@pkg_remove;
 148 }
 149 $profiles->{all} = [ keys %all ]; # pseudo-profile for all packages
 150
 151 # parse the profile list from the command-line
 152 for my $profile (@ARGV) {
 153         if ($profile =~ s/-\z//) {
 154                 # like apt-get, trailing "-" means remove
 155                 profile2dst($profile, \@pkg_remove);
 156         } else {
 157                 profile2dst($profile, \@pkg_install);
 158         }
 159 }
 160
 161 # fill in @pkg_install and @pkg_remove:
 162 while (my ($pkg, $dst_pkg_list) = each %all) {
 163         push @$dst_pkg_list, list(pkg2ospkg($pkg, $pkg_fmt));
 164 }
 165
 166 my @apt_opts =
 167         qw(-o APT::Install-Recommends=false -o APT::Install-Suggests=false);
 168
 169 # OS-specific cleanups appreciated
 170
 171 if ($pkg_fmt eq 'deb') {
 172         my @quiet = $ENV{V} ? () : ('-q');
 173         root('apt-get', @apt_opts, qw(install --purge -y), @quiet,
 174                 @pkg_install,
 175                 # apt-get lets you suffix a package with "-" to
 176                 # remove it in an "install" sub-command:
 177                 map { "$_-" } @pkg_remove);
 178         root('apt-get', @apt_opts, qw(autoremove --purge -y), @quiet);
 179 } elsif ($pkg_fmt eq 'pkg') {
 180         my @quiet = $ENV{V} ? () : ('-q');
 181         # FreeBSD, maybe other *BSDs are similar?
 182
 183         # don't remove stuff that isn't installed:
 184         exclude_uninstalled(\@pkg_remove);
 185         root(qw(pkg remove -y), @quiet, @pkg_remove) if @pkg_remove;
 186         root(qw(pkg install -y), @quiet, @pkg_install) if @pkg_install;
 187         root(qw(pkg autoremove -y), @quiet);
 188 # TODO: yum / rpm support
 189 } elsif ($pkg_fmt eq 'rpm') {
 190         my @quiet = $ENV{V} ? () : ('-q');
 191         exclude_uninstalled(\@pkg_remove);
 192         root(qw(yum remove -y), @quiet, @pkg_remove) if @pkg_remove;
 193         root(qw(yum install -y), @quiet, @pkg_install) if @pkg_install;
 194 } else {
 195         die "unsupported package format: $pkg_fmt\n";
 196 }
 197 exit 0;
 198
 199
 200 # map a generic package name to an OS package name
 201 sub pkg2ospkg {
 202         my ($pkg, $fmt) = @_;
 203
 204         # check explicit overrides, first:
 205         if (my $ospkg = $non_auto->{$pkg}->{$fmt}) {
 206                 return $ospkg;
 207         }
 208
 209         # check common Perl module name patterns:
 210         if ($pkg =~ /::/ || $pkg =~ /\A[A-Z]/) {
 211                 if ($fmt eq 'deb') {
 212                         $pkg =~ s/::/-/g;
 213                         $pkg =~ tr/A-Z/a-z/;
 214                         return "lib$pkg-perl";
 215                 } elsif ($fmt eq 'rpm') {
 216                         $pkg =~ s/::/-/g;
 217                         return "perl-$pkg"
 218                 } elsif ($fmt eq 'pkg') {
 219                         $pkg =~ s/::/-/g;
 220                         return "p5-$pkg"
 221                 } else {
 222                         die "unsupported package format: $fmt for $pkg\n"
 223                 }
 224         }
 225
 226         # use package name as-is (e.g. 'curl' or 'w3m')
 227         $pkg;
 228 }
 229
 230 # maps a install profile to a package list (@pkg_remove or @pkg_install)
 231 sub profile2dst {
 232         my ($profile, $dst_pkg_list) = @_;
 233         if (my $pkg_list = $profiles->{$profile}) {
 234                 $all{$_} = $dst_pkg_list for @$pkg_list;
 235         } elsif ($all{$profile}) { # $profile is just a package name
 236                 $all{$profile} = $dst_pkg_list;
 237         } else {
 238                 die "unrecognized profile or package: $profile\n";
 239         }
 240 }
 241
 242 sub exclude_uninstalled {
 243         my ($list) = @_;
 244         my %inst_check = (
 245                 pkg => sub { system(qw(pkg info -q), $_[0]) == 0 },
 246                 deb => sub { system("dpkg -s $_[0] >/dev/null 2>&1") == 0 },
 247                 rpm => sub { system("rpm -qs $_[0] >/dev/null 2>&1") == 0 },
 248         );
 249
 250         my $cb = $inst_check{$pkg_fmt} || die <<"";
 251 don't know how to check install status for $pkg_fmt
 252
 253         my @tmp;
 254         for my $pkg (@$list) {
 255                 push @tmp, $pkg if $cb->($pkg);
 256         }
 257         @$list = @tmp;
 258 }
 259
 260 sub root {
 261         print join(' ', @_), "\n";
 262         return if $ENV{DRY_RUN};
 263         return if system(@_) == 0;
 264         warn 'command failed: ', join(' ', @_), "\n";
 265         exit($? >> 8);
 266 }
 267
 268 # ensure result can be pushed into an array:
 269 sub list {
 270         my ($pkg) = @_;
 271         ref($pkg) eq 'ARRAY' ? @$pkg : $pkg;
 272 }