]> Sergey Matveev's repositories - public-inbox.git/blob - ci/deps.perl
Merge remote-tracking branch 'origin/git-cleanup'
[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 # 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 }