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