ci/deps.perl

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