]> Sergey Matveev's repositories - public-inbox.git/blob - ci/deps.perl
t/httpd-unix.t: avoid race in between bind() and listen()
[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 Plack::Test);
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                 Date::Parse
23                 Devel::Peek
24                 Digest::SHA
25                 Email::Simple
26                 Email::MIME
27                 Email::MIME::ContentType
28                 Encode
29                 ExtUtils::MakeMaker
30                 Filesys::Notify::Simple
31                 Plack
32                 URI::Escape
33                 ), @test_essential ],
34
35         # everything optional for normal use
36         optional => [ qw(
37                 BSD::Resource
38                 DBD::SQLite
39                 DBI
40                 IO::Compress::Gzip
41                 Inline::C
42                 Net::Server
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                 IPC::Run
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 }