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