summaryrefslogtreecommitdiffstats
path: root/bin
diff options
context:
space:
mode:
Diffstat (limited to 'bin')
-rwxr-xr-xbin/lintian1055
-rwxr-xr-xbin/lintian-annotate-hints206
-rwxr-xr-xbin/lintian-explain-tags171
-rwxr-xr-xbin/spellintian161
4 files changed, 1593 insertions, 0 deletions
diff --git a/bin/lintian b/bin/lintian
new file mode 100755
index 0000000..4f44e6f
--- /dev/null
+++ b/bin/lintian
@@ -0,0 +1,1055 @@
+#!/usr/bin/perl
+#
+# Lintian -- Debian package checker
+#
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2013 Niels Thykier
+# Copyright (C) 2017-2019 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020 Felix Lechner
+#
+# This program is free software. It is distributed under the terms of
+# the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any
+# later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Cwd qw(realpath);
+use File::Basename qw(dirname);
+
+# neither Path::This nor lib::relative are in Debian
+use constant THISFILE => realpath __FILE__;
+use constant THISDIR => dirname realpath __FILE__;
+
+# use Lintian modules that belong to this program
+use lib THISDIR . '/../lib';
+
+# substituted during package build
+my $LINTIAN_VERSION;
+
+use Carp qw(croak confess verbose);
+use Config::Tiny;
+use Const::Fast;
+use File::BaseDir qw(config_files);
+use Getopt::Long ();
+use IO::Interactive qw(is_interactive);
+use List::Compare;
+use List::SomeUtils qw(any none first_value);
+use Path::Tiny;
+use POSIX qw(:sys_wait_h);
+use Syntax::Keyword::Try;
+use Term::ReadKey;
+use Unicode::UTF8 qw(encode_utf8 decode_utf8);
+
+use Lintian::Changelog;
+use Lintian::IPC::Run3 qw(safe_qx);
+use Lintian::Pool;
+use Lintian::Processable::Installable;
+use Lintian::Processable::Buildinfo;
+use Lintian::Processable::Changes;
+use Lintian::Processable::Source;
+use Lintian::Profile;
+use Lintian::Version qw(guess_version);
+
+const my $EMPTY => q{};
+const my $SPACE => q{ };
+const my $NEWLINE => qq{\n};
+const my $COMMA => q{,};
+const my $SLASH => q{/};
+const my $DOT => q{.};
+const my $DOUBLE_DOT => q{..};
+const my $PLUS => q{+};
+const my $EQUAL => q{=};
+const my $HYPHEN => q{-};
+const my $OPEN_PIPE => q{-|};
+
+const my $DEFAULT_TAG_LIMIT => 4;
+const my $DEFAULT_OUTPUT_WIDTH => 80;
+
+# place early, may need original environment to determine terminal blacklist
+my $hyperlinks_capable = is_interactive;
+
+# Globally ignore SIGPIPE. We'd rather deal with error returns from write
+# than randomly delivered signals.
+$SIG{PIPE} = 'IGNORE';
+
+my $TERMINAL_WIDTH;
+($TERMINAL_WIDTH, undef, undef, undef) = GetTerminalSize()
+ if is_interactive;
+$TERMINAL_WIDTH //= $DEFAULT_OUTPUT_WIDTH;
+
+my %PRESERVE_ENV = map { $_ => 1 } qw(
+ DEB_VENDOR
+ DEBRELEASE_DEBS_DIR
+ HOME
+ NO_COLOR
+ LANG
+ LC_ALL
+ LC_MESSAGES
+ PATH
+ TMPDIR
+ XDG_CACHE_HOME
+ XDG_CONFIG_DIRS
+ XDG_CONFIG_HOME
+ XDG_DATA_DIRS
+ XDG_DATA_HOME
+);
+
+my @disallowed= grep { !exists $PRESERVE_ENV{$_} && !/^LINTIAN_/ } keys %ENV;
+
+delete $ENV{$_} for @disallowed;
+
+# PATH may be unset in some environments; use sane default
+$ENV{PATH} //= '/bin:/usr/bin';
+
+# needed for tar
+$ENV{LC_ALL} = 'C';
+$ENV{TZ} = $EMPTY;
+
+$ENV{LINTIAN_BASE} = realpath(THISDIR . '/..')
+ // die encode_utf8('Cannot resolve LINTIAN_BASE');
+
+$ENV{LINTIAN_VERSION} = $LINTIAN_VERSION // guess_version($ENV{LINTIAN_BASE});
+die encode_utf8('Unable to determine the version automatically!?')
+ unless length $ENV{LINTIAN_VERSION};
+
+if (my $coverage_arg = $ENV{LINTIAN_COVERAGE}) {
+ my $p5opt = $ENV{PERL5OPT} // $EMPTY;
+ $p5opt .= $SPACE unless $p5opt eq $EMPTY;
+ $ENV{PERL5OPT} = "${p5opt} ${coverage_arg}";
+}
+
+my @getoptions = qw(
+ allow-root!
+ cfg=s
+ check|c
+ check-part|C=s@
+ color=s
+ debug|d+
+ default-display-level
+ display-experimental|E!
+ display-level|L=s@
+ display-info|I
+ display-source=s@
+ dont-check-part|X=s@
+ exp-output:s
+ fail-on=s@
+ ftp-master-rejects|F
+ help|h
+ hide-overrides
+ hyperlinks=s
+ ignore-lintian-env
+ include-dir=s@
+ info|i!
+ jobs|j=i
+ no-cfg
+ no-override|o
+ no-tag-display-limit
+ output-width=i
+ packages-from-file=s
+ pedantic
+ perf-debug
+ print-version
+ profile=s
+ quiet|q
+ show-overrides!
+ status-log=s
+ suppress-tags=s@
+ suppress-tags-from-file=s
+ tag-display-limit=i
+ tags|T=s@
+ tags-from-file=s
+ user-dirs!
+ verbose|v
+ version|V
+);
+
+my %command_line;
+
+Getopt::Long::Configure('default', 'bundling',
+ 'no_getopt_compat','no_auto_abbrev','permute');
+
+Getopt::Long::GetOptions(\%command_line, @getoptions)
+ or die encode_utf8("error parsing options\n");
+
+my @basenames = map { path($_)->basename } @ARGV;
+$0 = join($SPACE, THISFILE, @basenames);
+
+if (exists $command_line{'version'}) {
+ say encode_utf8("Lintian v$ENV{LINTIAN_VERSION}");
+ exit;
+}
+
+if (exists $command_line{'print-version'}) {
+ say encode_utf8($ENV{LINTIAN_VERSION});
+ exit;
+}
+
+show_help()
+ if exists $command_line{help};
+
+if (exists $command_line{'hide-overrides'}) {
+ $command_line{'show-overrides'} = 0;
+ warn encode_utf8(
+"A future release will drop --hide-overrides; please use --no-show-overrides instead.\n"
+ );
+}
+
+if (exists $command_line{'no-tag-display-limit'}) {
+ $command_line{'tag-display-limit'} = 0;
+ warn encode_utf8(
+"A future release will drop --no-tag-display-limit; please use '--tag-display-limit 0' instead.\n"
+ );
+}
+
+my $LINTIAN_CFG = $command_line{cfg};
+
+$LINTIAN_CFG ||= $ENV{LINTIAN_CFG}
+ if length $ENV{LINTIAN_CFG} && -e $ENV{LINTIAN_CFG};
+
+unless ($command_line{'no-user-dirs'}) {
+
+ my @user_configs;
+
+ # XDG user config
+ push(@user_configs, config_files('lintian/lintianrc'));
+
+ # legacy per-user config
+ push(@user_configs, "$ENV{HOME}/.lintianrc")
+ if length $ENV{HOME};
+
+ # system wide user config
+ push(@user_configs, '/etc/lintianrc');
+
+ $LINTIAN_CFG ||= first_value { length && -e } @user_configs;
+}
+
+$LINTIAN_CFG = $EMPTY
+ if $command_line{'no-cfg'};
+
+my %config;
+
+# some environment variables can be set from the config file
+my @ENV_FROM_CONFIG = qw(
+ TMPDIR
+);
+
+if (length $LINTIAN_CFG) {
+
+ # for keys appearing multiple times, now uses the last value
+ my $object = Config::Tiny->read($LINTIAN_CFG, 'utf8');
+ my $error = Config::Tiny->errstr;
+ die encode_utf8(
+ "syntax error in configuration file $LINTIAN_CFG: $error\n")
+ if length $error;
+
+ # used elsewhere to check for values already set
+ %config = %{$object->{_} // {}};
+
+ my @allowed = qw(
+ color
+ display-experimental
+ display-info
+ display-level
+ hyperlinks
+ info
+ jobs
+ LINTIAN_PROFILE
+ override
+ pedantic
+ profile
+ quiet
+ show-overrides
+ suppress-tags
+ suppress-tags-from-file
+ tag-display-limit
+ TMPDIR
+ verbose
+ );
+
+ my $knownlc
+ = List::Compare->new([keys %config], [@allowed, @ENV_FROM_CONFIG]);
+ my @unknown = $knownlc->get_Lonly;
+ die encode_utf8(
+ "Unknown setting in $LINTIAN_CFG: ". join($SPACE, @unknown). $NEWLINE)
+ if @unknown;
+}
+
+# substitute home directory
+s{\$HOME/}{$ENV{HOME}/}g for values %config;
+s{\~/}{$ENV{HOME}/}g for values %config;
+
+# option inverted in config file
+$config{'no-override'} = !$config{'no-override'}
+ if exists $config{'no-override'};
+
+my @GETOPT_ARRAYS = qw(
+ display-level
+ suppress-tags
+);
+
+# convert some strings to array references
+for my $name (@GETOPT_ARRAYS) {
+ if (exists $config{$name}) {
+ $config{$name} = [$config{$name}];
+ } else {
+ $config{$name} = [];
+ }
+}
+
+# Translate boolean strings to "0" or "1"; ignore
+# errors as not all values are (intended to be)
+# booleans.
+my $booleanlc
+ = List::Compare->new([keys %config], [qw(jobs tag-display-limit)]);
+eval { $config{$_} = parse_boolean($config{$_}); }for $booleanlc->get_Lonly;
+
+# our defaults
+my %selected = (
+ 'check-part' => [],
+ 'color' => 'auto',
+ 'debug' => 0,
+ 'display-level' => [],
+ 'display-source' => [],
+ 'dont-check-part' => [],
+ 'fail-on' => [qw(error)],
+ 'include-dir' => [],
+ 'jobs' => default_jobs(),
+ 'output-width' => $TERMINAL_WIDTH,
+ 'tags' => [],
+ 'suppress-tags' => [],
+ 'user-dirs' => 1,
+ 'verbose' => 0,
+);
+
+$selected{$_} = $config{$_} for keys %config;
+
+my @MUTUAL_OPTIONS = (
+ [qw(verbose quiet)],
+ [qw(default-display-level display-level display-info pedantic)],
+);
+
+# for precedence of command line
+for my $exclusive (@MUTUAL_OPTIONS) {
+
+ if (any { defined $command_line{$_} } @{$exclusive}) {
+ my @scalars = grep { ref $selected{$_} eq 'SCALAR' } @{$exclusive};
+ delete $selected{$_} for @scalars;
+
+ my @arrays = grep { ref $selected{$_} eq 'ARRAY' } @{$exclusive};
+ $selected{$_} = [] for @arrays;
+ }
+}
+
+$selected{$_} = $command_line{$_} for keys %command_line;
+
+@{$selected{'display-level'}}
+ = split(/\s*,\s*/, join($COMMA, @{$selected{'display-level'}}));
+
+my @display_level;
+
+push(@display_level,[$EQUAL, '>=', 'warning'])
+ if $selected{'default-display-level'};
+
+push(@display_level, [$PLUS, '>=', 'info'])
+ if $selected{'display-info'};
+
+push(@display_level, [$PLUS, $EQUAL, 'pedantic'])
+ if $selected{'pedantic'};
+
+sub display_classificationtags {
+ push(@display_level, [$PLUS, $EQUAL, 'classification']);
+ return;
+}
+
+for my $level (@{$selected{'display-level'}}) {
+
+ my $operator;
+ if ($level =~ s/^([+=-])//) {
+ $operator = $1;
+ }
+
+ my $relation;
+ if ($level =~ s/^([<>]=?|=)//) {
+ $relation = $1;
+ }
+
+ my $severity = $level;
+ $operator //= $EQUAL;
+ $relation //= $EQUAL;
+
+ push(@display_level, [$operator, $relation, $severity]);
+}
+
+@{$selected{'display-source'}}
+ = split(/\s*,\s*/, join($COMMA, @{$selected{'display-source'}}));
+
+@{$selected{'check-part'}}
+ = split(/\s*,\s*/, join($COMMA, @{$selected{'check-part'}}));
+@{$selected{'dont-check-part'}}
+ = split(/\s*,\s*/, join($COMMA, @{$selected{'dont-check-part'}}));
+
+@{$selected{tags}} = split(/\s*,\s*/, join($COMMA, @{$selected{tags}}));
+@{$selected{'suppress-tags'}}
+ = split(/\s*,\s*/, join($COMMA, @{$selected{'suppress-tags'}}));
+
+if (length $selected{'tags-from-file'}) {
+
+ my @lines = path($selected{'tags-from-file'})->lines_utf8;
+ for my $line (@lines) {
+
+ # trim both ends
+ $line =~ s/^\s+|\s+$//g;
+
+ next
+ unless length $line;
+ next
+ if $line =~ /^\#/;
+
+ my @activate = split(/\s*,\s*/, $line);
+ push(@{$selected{tags}}, @activate);
+ }
+}
+
+if (length $selected{'suppress-tags-from-file'}) {
+
+ my @lines = path($selected{'suppress-tags-from-file'})->lines_utf8;
+ for my $line (@lines) {
+
+ # trim both ends
+ $line =~ s/^\s+|\s+$//g;
+
+ next
+ unless length $line;
+ next
+ if $line =~ /^\#/;
+
+ my @suppress = split(/\s*,\s*/, $line);
+ push(@{$selected{'suppress-tags'}}, @suppress);
+ }
+}
+
+my $exit_code = 0;
+
+# root permissions?
+# check if effective UID is 0
+warn encode_utf8("running with root privileges is not recommended!\n")
+ if $> == 0 && !$selected{'allow-root'};
+
+if ($selected{'ignore-lintian-env'}) {
+ delete($ENV{$_}) for grep { m/^LINTIAN_/ } keys %ENV;
+}
+
+# option --all and packages specified at the same time?
+if ($selected{'packages-from-file'} && $#ARGV+1 > 0) {
+ warn encode_utf8(
+"option --packages-from-file cannot be mixed with package parameters!\n"
+ );
+ warn encode_utf8("(will ignore --packages-from-file option)\n");
+
+ delete($selected{'packages-from-file'});
+}
+
+@{$selected{'fail-on'}} = split(/,/, join($COMMA, @{$selected{'fail-on'}}));
+my @known_fail_on = qw(
+ error
+ warning
+ info
+ pedantic
+ experimental
+ override
+ none
+);
+my $fail_on_lc = List::Compare->new($selected{'fail-on'}, \@known_fail_on);
+my @unknown_fail_on = $fail_on_lc->get_Lonly;
+die encode_utf8("Unrecognized fail-on argument: @unknown_fail_on\n")
+ if @unknown_fail_on;
+
+if (any { $_ eq 'none' } @{$selected{'fail-on'}}) {
+
+ die encode_utf8(
+"Cannot combine 'none' with other conditions: @{$selected{'fail-on'}}\n"
+ )if @{$selected{'fail-on'}} > 1;
+
+ $selected{'fail-on'} = [];
+}
+
+# environment variables override settings in conf file, so load them now
+# assuming they were not set by cmd-line options
+for my $var (@ENV_FROM_CONFIG) {
+# note $selected{$var} will usually always exists due to the call to GetOptions
+# so we have to use "defined" here
+ $selected{$var} = $ENV{$var} if $ENV{$var} && !defined $selected{$var};
+}
+
+my %output
+ = map { split(/=/) } split(/,/, ($selected{'exp-output'} // $EMPTY));
+$selected{'output-format'} = lc($output{format} // 'ewi');
+
+my $PROFILE = Lintian::Profile->new;
+
+# dies on error
+$PROFILE->load(
+ $selected{profile},
+ $selected{'include-dir'},
+ !$command_line{'no-user-dirs'}
+);
+say {*STDERR} encode_utf8('Using profile ' . $PROFILE->name . $DOT)
+ if $selected{debug};
+
+if ($selected{'ftp-master-rejects'}) {
+ say {*STDERR}
+ encode_utf8(
+ 'But only with tags enabled from the FTP Master Auto-Reject list.')
+ if $selected{debug};
+
+ my $rejection = $PROFILE->data->auto_rejection;
+
+ my @certain = @{$rejection->certain};
+ my @preventable = @{$rejection->preventable};
+
+ # disable all tags
+ $PROFILE->disable_tag($_) for $PROFILE->known_tags;
+
+ # enable the ones they want
+ $PROFILE->enable_tag($_) for (@certain, @preventable);
+
+ # no overrides allowed
+ $PROFILE->set_durable($_, 1) for @certain;
+
+ # overrides okay
+ $PROFILE->set_durable($_, 0) for @preventable;
+}
+
+my $envlc = List::Compare->new([keys %config], \@ENV_FROM_CONFIG);
+my @from_file = $envlc->get_intersection;
+
+my @already = grep { defined $ENV{$_} } @from_file;
+warn encode_utf8(
+ 'The environment overrides these settings in the configuration file: '
+ . join($SPACE, @already)
+ . $NEWLINE)
+ if @already;
+
+my @not_yet = grep { !defined $ENV{$_} } @from_file;
+if (@not_yet) {
+ say {*STDERR}
+ encode_utf8('Setting environment variables from configuration file: '
+ . join($SPACE, @not_yet))
+ if $selected{debug};
+}
+$ENV{$_} = $config{$_} for @not_yet;
+
+die encode_utf8("The color value must be one of auto, always, or never.\n")
+ unless (any { $selected{color} eq $_ } qw(auto always never));
+
+$selected{hyperlinks} //= 'off'
+ if $selected{color} eq 'never';
+
+# change to 'on' after gcc's terminal blacklist was implemented here
+$selected{hyperlinks} //= 'on';
+
+die encode_utf8("The hyperlink value must be on or off\n")
+ unless any { $selected{hyperlinks} eq $_ } qw(on off);
+
+$selected{hyperlinks} = $hyperlinks_capable && $selected{hyperlinks} eq 'on';
+
+if ($selected{color} eq 'always') {
+ $selected{color} = 1;
+} elsif (exists $ENV{NO_COLOR}) {
+ $selected{color} = 0;
+} elsif ($selected{color} eq 'auto' && is_interactive) {
+ $selected{color} = 1;
+} else {
+ $selected{color} = 0;
+}
+
+$selected{verbose} = 0
+ if $selected{quiet};
+
+if ($selected{verbose} || !is_interactive) {
+ $selected{'tag-display-limit'} //= 0;
+} else {
+ $selected{'tag-display-limit'} //= $DEFAULT_TAG_LIMIT;
+}
+
+if ($selected{debug}) {
+ $selected{verbose} = 1;
+ $ENV{LINTIAN_DEBUG} = $selected{debug};
+ $SIG{__DIE__} = sub {
+ confess(map { encode_utf8($_) } @_);
+ };
+}
+
+# check for arguments
+unless (@ARGV || $selected{'packages-from-file'}) {
+
+ my $ok = 0;
+ # If debian/changelog exists, assume an implied
+ # "../<source>_<version>_<arch>.changes" (or
+ # "../<source>_<version>_source.changes").
+ if (-e 'debian/changelog') {
+ my $file = _find_changes();
+ push @ARGV, $file;
+ $ok = 1;
+ }
+
+ show_help()
+ unless $ok;
+}
+
+if ($selected{debug}) {
+ say {*STDERR} encode_utf8("Lintian v$ENV{LINTIAN_VERSION}");
+ say {*STDERR} encode_utf8("Lintian root directory: $ENV{LINTIAN_BASE}");
+ say {*STDERR} encode_utf8('Configuration file: '.($LINTIAN_CFG//'(none)'));
+}
+
+if (defined $selected{LINTIAN_PROFILE}) {
+ warn encode_utf8(
+ "Please use 'profile' in config file; LINTIAN_PROFILE is obsolete.\n");
+ $selected{profile} //= $selected{LINTIAN_PROFILE};
+ delete $selected{LINTIAN_PROFILE};
+}
+
+# if tags are listed explicitly (--tags) then show them even if
+# they are pedantic/experimental etc. However, for --check-part
+# people explicitly have to pass the relevant options.
+
+if (@{$selected{'check-part'}} || @{$selected{tags}}) {
+
+ $PROFILE->disable_tag($_) for $PROFILE->enabled_tags;
+
+ if (@{$selected{tags}}) {
+ $selected{'display-experimental'} = 1;
+
+ # discard current display level; get everything
+ @display_level
+ = ([$PLUS, '>=', 'pedantic'], [$PLUS, $EQUAL, 'classification']);
+
+ $PROFILE->enable_tag($_) for @{$selected{tags}};
+
+ } else {
+ for my $check_name (@{$selected{'check-part'}}) {
+ if ($check_name eq 'all') {
+ my @tags = map { @{$PROFILE->tag_names_for_check->{$_} // []} }
+ $PROFILE->known_checks;
+ $PROFILE->enable_tag($_) for @tags;
+ next;
+ }
+
+ die encode_utf8("Unrecognized check (via -C): $check_name\n")
+ unless exists $PROFILE->check_module_by_name->{$check_name};
+
+ $PROFILE->enable_tag($_)
+ for @{$PROFILE->tag_names_for_check->{$check_name} // []};
+ }
+ }
+
+} elsif (@{$selected{'dont-check-part'}}) {
+ # we are disabling checks
+ for my $check_name (@{$selected{'dont-check-part'}}) {
+
+ die encode_utf8("Unrecognized check (via -X): $check_name\n")
+ unless exists $PROFILE->check_module_by_name->{$check_name};
+
+ $PROFILE->disable_tag($_)
+ for @{$PROFILE->tag_names_for_check->{$check_name} // []};
+ }
+}
+
+# ignore --suppress-tags when used with --tags.
+if (@{$selected{'suppress-tags'}} && !@{$selected{tags}}) {
+ $PROFILE->disable_tag($_) for @{$selected{'suppress-tags'}};
+}
+
+# initialize display level settings; dies on error
+$PROFILE->display(@{$_}) for @display_level;
+
+my @subjects;
+push(@subjects, @ARGV);
+
+if ($selected{'packages-from-file'}){
+ my $fd = open_file_or_fd($selected{'packages-from-file'}, '<');
+
+ while (my $bytes = <$fd>) {
+ my $line = decode_utf8($bytes);
+ chomp $line;
+
+ next
+ if $line =~ /^\s*$/;
+
+ push(@subjects, $line);
+ }
+
+ # close unless it is STDIN (else we will see a lot of warnings
+ # about STDIN being reopened as "output only")
+ close($fd)
+ unless fileno($fd) == fileno(STDIN);
+}
+
+my $pool = Lintian::Pool->new;
+
+for my $subject (@subjects) {
+ die encode_utf8("$subject is not a readable file\n") unless -r $subject;
+
+ # in ubuntu, automatic dbgsym packages end with .ddeb
+ die encode_utf8(
+"bad package file name $subject (neither .deb, .udeb, .ddeb, .changes, .dsc or .buildinfo file)\n"
+ ) unless $subject =~ /\.(?:[u|d]?deb|dsc|changes|buildinfo)$/;
+
+ try {
+ # create a new group
+ my $group = Lintian::Group->new;
+ $group->pooldir($pool->basedir);
+ $group->profile($PROFILE);
+
+ my $processable = create_processable_from_file($subject);
+ $group->add_processable($processable);
+
+ my $parent = path($subject)->parent->stringify;
+
+ my @files;
+
+ # pull in any additional files
+ @files = keys %{$processable->files}
+ if $processable->can('files');
+
+ for my $basename (@files) {
+
+ # ignore traversal attempts
+ next
+ if $basename =~ m{/};
+
+ die encode_utf8("$parent/$basename does not exist, exiting\n")
+ unless -e "$parent/$basename";
+
+ # only care about some files; ddeb is ubuntu dbgsym
+ next
+ unless $basename =~ /\.[ud]?deb$/
+ || $basename =~ /\.dsc$/
+ || $basename =~ /\.buildinfo$/;
+
+ my $additional = create_processable_from_file("$parent/$basename");
+ $group->add_processable($additional);
+ }
+
+ $pool->add_group($group);
+
+ } catch {
+ warn encode_utf8("Skipping $subject: $@\n");
+ $exit_code = 1;
+ }
+}
+
+$pool->process($PROFILE, \$exit_code, \%selected);
+
+exit $exit_code;
+
+=item create_processable_from_file
+
+=cut
+
+sub create_processable_from_file {
+ my ($path) = @_;
+
+ croak encode_utf8("Cannot resolve $path: $!")
+ unless -e $path;
+
+ my $processable;
+
+ if ($path =~ /\.dsc$/) {
+ $processable = Lintian::Processable::Source->new;
+
+ } elsif ($path =~ /\.buildinfo$/) {
+ $processable = Lintian::Processable::Buildinfo->new;
+
+ } elsif ($path =~ /\.d?deb$/) {
+ # in ubuntu, automatic dbgsym packages end with .ddeb
+ $processable = Lintian::Processable::Installable->new;
+ $processable->type('binary');
+
+ } elsif ($path =~ /\.udeb$/) {
+ $processable = Lintian::Processable::Installable->new;
+ $processable->type('udeb');
+
+ } elsif ($path =~ /\.changes$/) {
+ $processable = Lintian::Processable::Changes->new;
+
+ } else {
+ croak encode_utf8("$path is not a known type of package");
+ }
+
+ $processable->init_from_file($path);
+
+ return $processable;
+}
+
+=item parse_boolean (STR)
+
+Attempt to parse STR as a boolean and return its value.
+If STR is not a valid/recognised boolean, the sub will
+invoke croak.
+
+The following values recognised (string checks are not
+case sensitive):
+
+=over 4
+
+=item The integer 0 is considered false
+
+=item Any non-zero integer is considered true
+
+=item "true", "y" and "yes" are considered true
+
+=item "false", "n" and "no" are considered false
+
+=back
+
+=cut
+
+sub parse_boolean {
+ my ($str) = @_;
+
+ return $str == 0 ? 0 : 1
+ if $str =~ /^-?\d++$/;
+
+ $str = lc $str;
+
+ return 1
+ if $str eq 'true' || $str =~ m/^y(?:es)?$/;
+
+ return 0
+ if $str eq 'false' || $str =~ m/^no?$/;
+
+ croak encode_utf8("'$str' is not a valid boolean value");
+}
+
+sub _find_changes {
+ # read bytes to side-step any encoding errors
+ my $contents = path('debian/changelog')->slurp;
+ my $changelog = Lintian::Changelog->new;
+ $changelog->parse($contents);
+ my @entries = @{$changelog->entries};
+ my $latest = @entries ? $entries[0] : undef;
+ my ($source, $version);
+ my $changes;
+ my @archs;
+ my @dirs = ($DOUBLE_DOT, '../build-area', '/var/cache/pbuilder/result');
+
+ unshift(@dirs, $ENV{DEBRELEASE_DEBS_DIR})
+ if exists $ENV{DEBRELEASE_DEBS_DIR};
+
+ if (not $latest) {
+ my @errors = @{$changelog->errors};
+ if (@errors) {
+ warn encode_utf8("Cannot parse debian/changelog due to errors:\n");
+ for my $error (@errors) {
+ warn encode_utf8("$error->[2] (line $error->[1])\n");
+ }
+ } else {
+ warn encode_utf8("debian/changelog does not have any data?\n");
+ }
+ exit 1;
+ }
+ $version = $latest->Version;
+ $source = $latest->Source;
+ unless (defined $version && defined $source) {
+ $version //= '<N/A>';
+ $source //= '<N/A>';
+ warn encode_utf8(
+ "Cannot determine source and version from debian/changelog:\n");
+ warn encode_utf8("Source: $source\n");
+ warn encode_utf8("Version: $source\n");
+ exit 1;
+ }
+ # remove the epoch
+ $version =~ s/^\d+://;
+ if (exists $ENV{DEB_BUILD_ARCH}) {
+ push(@archs, decode_utf8($ENV{DEB_BUILD_ARCH}));
+ } else {
+ my $arch = decode_utf8(safe_qx('dpkg', '--print-architecture'));
+ chomp $arch;
+ push(@archs, $arch) if length $arch;
+ }
+ push(@archs, decode_utf8($ENV{DEB_HOST_ARCH}))
+ if exists $ENV{DEB_HOST_ARCH};
+ # Maybe cross-built for something dpkg knows about...
+ my @command = qw{dpkg --print-foreign-architectures};
+ open(my $foreign, $OPEN_PIPE, @command)
+ or die encode_utf8("Cannot open pipe to @command");
+
+ while (my $bytes = <$foreign>) {
+ my $line = decode_utf8($bytes);
+ chomp($line);
+ # Skip already attempted architectures (e.g. via DEB_BUILD_ARCH)
+ next
+ if any { $_ eq $line } @archs;
+ push(@archs, $line);
+ }
+ close($foreign);
+ push @archs, qw(multi all source);
+ for my $dir (@dirs) {
+ for my $arch (@archs) {
+ $changes = "$dir/${source}_${version}_${arch}.changes";
+ return $changes if -e $changes;
+ }
+ }
+
+ warn encode_utf8(
+"Cannot find a changes file for ${source}/${version}. It would be named like:\n"
+ );
+
+ warn encode_utf8(" ${source}_${version}_${_}.changes\n") for @archs;
+
+ warn encode_utf8(" in any of those places:\n");
+ warn encode_utf8(" $_\n") for @dirs;
+
+ exit 0;
+}
+
+=item open_file_or_fd
+
+=cut
+
+# open_file_or_fd(TO_OPEN, MODE)
+#
+# Open a given file or FD based on TO_OPEN and MODE and returns the
+# open handle. Will croak / throw a trappable error on failure.
+#
+# MODE can be one of "<" (read) or ">" (write).
+#
+# TO_OPEN is one of:
+# * "-", alias of "&0" or "&1" depending on MODE
+# * "&N", reads/writes to the file descriptor numbered N
+# based on MODE.
+# * "+FILE" (MODE eq '>' only), open FILE in append mode
+# * "FILE", open FILE in read or write depending on MODE.
+# Note that this will truncate the file if MODE
+# is ">".
+sub open_file_or_fd {
+ my ($to_open, $mode) = @_;
+
+ my $fd;
+ # autodie trips this for some reasons (possibly fixed
+ # in v2.26)
+ no autodie qw(open);
+ if ($mode eq '<') {
+ if ($to_open eq $HYPHEN || $to_open eq '&0') {
+ $fd = \*STDIN;
+ } elsif ($to_open =~ m/^\&\d+$/) {
+ open($fd, '<&=', substr($to_open, 1))
+ or die encode_utf8("fdopen $to_open for reading: $!\n");
+ } else {
+ open($fd, '<', $to_open)
+ or die encode_utf8("open $to_open for reading: $!\n");
+ }
+
+ } elsif ($mode eq '>') {
+ if ($to_open eq $HYPHEN || $to_open eq '&1') {
+ $fd = \*STDOUT;
+ } elsif ($to_open =~ m/^\&\d+$/) {
+ open($fd, '>&=', substr($to_open, 1))
+ or die encode_utf8("fdopen $to_open for writing: $!\n");
+ } else {
+ $mode = ">$mode" if $to_open =~ s/^\+//;
+ open($fd, $mode, $to_open)
+ or
+ die encode_utf8("open $to_open for write/append ($mode): $!\n");
+ }
+
+ } else {
+ croak encode_utf8("Invalid mode '$mode' for open_file_or_fd");
+ }
+
+ return $fd;
+}
+
+=item default_jobs
+
+=cut
+
+sub default_jobs {
+
+ my $cpus = decode_utf8(safe_qx('nproc'));
+
+ return 2
+ unless $cpus =~ m/^\d+$/;
+
+ # could be 2x
+ return $cpus + 1;
+}
+
+sub show_help {
+
+ say encode_utf8("Lintian v$ENV{LINTIAN_VERSION}");
+
+ my $message =<<"EOT";
+Syntax: lintian [action] [options] [--] [packages] ...
+Actions:
+ -c, --check check packages (default action)
+ -C X, --check-part X check only certain aspects
+ -F, --ftp-master-rejects only check for automatic reject tags
+ -T X, --tags X only run checks needed for requested tags
+ --tags-from-file X like --tags, but read list from file
+ -X X, --dont-check-part X don't check certain aspects
+General options:
+ -h, --help display this help text
+ --print-version print unadorned version number and exit
+ -q, --quiet suppress all informational messages
+ -v, --verbose verbose messages
+ -V, --version display Lintian version and exit
+Behavior options:
+ --color never/always/auto disable, enable, or enable color for TTY
+ --hyperlinks on/off hyperlinks for TTY (when supported)
+ --default-display-level reset the display level to the default
+ --display-source X restrict displayed tags by source
+ -E, --display-experimental display "X:" tags (normally suppressed)
+ --no-display-experimental suppress "X:" tags
+ --fail-on error,warning,info,pedantic,experimental,override
+ define condition for exit status 2 (default: error)
+ -i, --info give detailed info about tags
+ -I, --display-info display "I:" tags (normally suppressed)
+ -L, --display-level display tags with the specified level
+ -o, --no-override ignore overrides
+ --output-width NUM set output width instead of probing terminal
+ --pedantic display "P:" tags (normally suppressed)
+ --profile X Use the profile X or use vendor X checks
+ --show-overrides output tags that have been overridden
+ --suppress-tags T,... don't show the specified tags
+ --suppress-tags-from-file X don't show the tags listed in file X
+ --tag-display-limit NUM Specify "tag per package" display limit
+
+Configuration options:
+ --cfg CONFIGFILE read CONFIGFILE for configuration
+ --no-cfg do not read any config files
+ --ignore-lintian-env ignore LINTIAN_* env variables
+ --include-dir DIR include checks, libraries (etc.) from DIR
+ -j NUM, --jobs NUM limit the number of parallel jobs to NUM
+ --[no-]user-dirs whether to use files from user directories
+
+Some options were omitted. Please check the manual page for the complete list.
+EOT
+
+ print encode_utf8($message);
+
+ exit;
+}
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/bin/lintian-annotate-hints b/bin/lintian-annotate-hints
new file mode 100755
index 0000000..bbedbf8
--- /dev/null
+++ b/bin/lintian-annotate-hints
@@ -0,0 +1,206 @@
+#!/usr/bin/perl
+#
+# annotate-lintian-hints -- transform lintian tags into descriptive text
+#
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2013 Niels Thykier
+# Copyright (C) 2017 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020 Felix Lechner
+#
+# This program is free software. It is distributed under the terms of
+# the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any
+# later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Cwd qw(realpath);
+use File::Basename qw(dirname);
+
+# neither Path::This nor lib::relative are in Debian
+use constant THISFILE => realpath __FILE__;
+use constant THISDIR => dirname realpath __FILE__;
+
+# use Lintian modules that belong to this program
+use lib THISDIR . '/../lib';
+
+# substituted during package build
+my $LINTIAN_VERSION;
+
+use Const::Fast;
+use Getopt::Long ();
+use IO::Interactive qw(is_interactive);
+use Term::ReadKey;
+use Unicode::UTF8 qw(encode_utf8 decode_utf8);
+
+use Lintian::Output::EWI;
+use Lintian::Profile;
+use Lintian::Version qw(guess_version);
+
+const my $EMPTY => q{};
+const my $SPACE => q{ };
+
+const my $DEFAULT_OUTPUT_WIDTH => 80;
+
+const my $NEW_PROGRAM_NAME => q{lintian-annotate-hints};
+
+my $TERMINAL_WIDTH;
+($TERMINAL_WIDTH, undef, undef, undef) = GetTerminalSize()
+ if is_interactive;
+$TERMINAL_WIDTH //= $DEFAULT_OUTPUT_WIDTH;
+
+if (my $coverage_arg = $ENV{'LINTIAN_COVERAGE'}) {
+ my $p5opt = $ENV{'PERL5OPT'}//$EMPTY;
+ $p5opt .= $SPACE if $p5opt ne $EMPTY;
+ $ENV{'PERL5OPT'} = "${p5opt} ${coverage_arg}";
+}
+
+$ENV{LINTIAN_BASE} = realpath(THISDIR . '/..')
+ // die encode_utf8('Cannot resolve LINTIAN_BASE');
+
+$ENV{LINTIAN_VERSION} = $LINTIAN_VERSION // guess_version($ENV{LINTIAN_BASE});
+die encode_utf8('Unable to determine the version automatically!?')
+ unless length $ENV{LINTIAN_VERSION};
+
+my $annotate;
+my @INCLUDE_DIRS;
+my $profile_name;
+my $user_dirs = 1;
+
+my %options = (
+ 'annotate|a' => \$annotate,
+ 'help|h' => \&show_help,
+ 'include-dir=s' => \@INCLUDE_DIRS,
+ 'output-width=i' => \$TERMINAL_WIDTH,
+ 'profile=s' => \$profile_name,
+ 'user-dirs!' => \$user_dirs,
+ 'version' => \&show_version,
+);
+
+Getopt::Long::Configure('gnu_getopt');
+Getopt::Long::GetOptions(%options)
+ or die encode_utf8("error parsing options\n");
+
+my $profile = Lintian::Profile->new;
+$profile->load($profile_name, \@INCLUDE_DIRS, $user_dirs);
+
+my $output = Lintian::Output::EWI->new;
+
+# Matches something like: (1:2.0-3) [arch1 arch2]
+# - captures the version and the architectures
+my $verarchre = qr{(?: \s* \(( [^)]++ )\) \s* \[ ( [^]]++ ) \])}x;
+
+my $type_re = qr/(?:binary|changes|source|udeb)/;
+
+my %already_displayed;
+
+# Otherwise, read input files or STDIN, watch for tags, and add
+# descriptions whenever we see one, can, and haven't already
+# explained that tag.
+while(my $bytes = <STDIN>) {
+
+ my $line = decode_utf8($bytes);
+ chomp $line;
+
+ say encode_utf8('N:');
+ say encode_utf8($line);
+
+ next
+ if $line =~ /^\s*$/;
+
+ # strip color
+ $line =~ s/\e[\[\d;]*m//g;
+
+ # strip HTML
+ $line =~ s/<span style=\"[^\"]+\">//g;
+ $line =~ s{</span>}{}g;
+
+ my $tag_name;
+ if ($annotate) {
+
+ # used for override files only; combine if possible
+
+ next
+ unless $line =~ m{^(?: # start optional part
+ (?:\S+)? # Optionally starts with package name
+ (?: \s*+ \[[^\]]+?\])? # optionally followed by an [arch-list] (like in B-D)
+ (?: \s*+ $type_re)? # optionally followed by the type
+ :\s++)? # end optional part
+ ([\-\.a-zA-Z_0-9]+ (?:\s.+)?)$}x; # <tag-name> [extra] -> $1
+
+ my $tagdata = $1;
+ ($tag_name, undef) = split(/ /, $tagdata, 2);
+
+ } elsif ($line
+ =~ m{^([^N]): (\S+)(?: (\S+)(?:$verarchre)?)?: (\S+)(?:\s+(.*))?$}) {
+
+ # matches the full deal:
+ # 1 222 3333 4444444 5555 666 777
+ # - T: pkg type (version) [arch]: tag [...]
+ # ^^^^^^^^^^^^^^^^^^^^^
+ # Where the marked part(s) are optional values. The numbers above
+ # the example are the capture groups.
+
+ my $pkg_type = $3 // 'binary';
+
+ $tag_name = $6;
+
+ } else {
+ next;
+ }
+
+ next
+ if $already_displayed{$tag_name}++;
+
+ my $tag = $profile->get_tag($tag_name);
+ next
+ unless defined $tag;
+
+ $output->describe_tag($profile->data, $tag, $TERMINAL_WIDTH);
+}
+
+exit;
+
+sub show_version {
+ say encode_utf8("$NEW_PROGRAM_NAME v$ENV{LINTIAN_VERSION}");
+
+ exit;
+}
+
+sub show_help {
+ my $message =<<"EOT";
+Usage: $NEW_PROGRAM_NAME [log-file...] ...
+ $NEW_PROGRAM_NAME --annotate [overrides ...]
+
+Options:
+ -a, --annotate display descriptions of tags in Lintian overrides
+ --include-dir DIR check for Lintian data in DIR
+ --profile X use vendor profile X to determine severities
+ --output-width NUM set output width instead of probing terminal
+ --[no-]user-dirs whether to include profiles from user directories
+ --version show version info and exit
+EOT
+
+ print encode_utf8($message);
+
+ exit;
+}
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/bin/lintian-explain-tags b/bin/lintian-explain-tags
new file mode 100755
index 0000000..770bb7d
--- /dev/null
+++ b/bin/lintian-explain-tags
@@ -0,0 +1,171 @@
+#!/usr/bin/perl
+#
+# explain-lintian-tags -- transform lintian tags into descriptive text
+#
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2013 Niels Thykier
+# Copyright (C) 2017 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020 Felix Lechner
+#
+# This program is free software. It is distributed under the terms of
+# the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any
+# later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Cwd qw(realpath);
+use File::Basename qw(dirname);
+
+# neither Path::This nor lib::relative are in Debian
+use constant THISFILE => realpath __FILE__;
+use constant THISDIR => dirname realpath __FILE__;
+
+# use Lintian modules that belong to this program
+use lib THISDIR . '/../lib';
+
+# substituted during package build
+my $LINTIAN_VERSION;
+
+use Const::Fast;
+use Getopt::Long ();
+use IO::Interactive qw(is_interactive);
+use List::SomeUtils qw(any);
+use Term::ReadKey;
+use Unicode::UTF8 qw(encode_utf8);
+
+use Lintian::Output::EWI;
+use Lintian::Output::HTML;
+use Lintian::Output::JSON;
+use Lintian::Profile;
+use Lintian::Version qw(guess_version);
+
+const my $EMPTY => q{};
+const my $SPACE => q{ };
+
+const my $DEFAULT_OUTPUT_WIDTH => 80;
+
+const my $NEW_PROGRAM_NAME => q{lintian-explain-tags};
+
+my $TERMINAL_WIDTH;
+($TERMINAL_WIDTH, undef, undef, undef) = GetTerminalSize()
+ if is_interactive;
+$TERMINAL_WIDTH //= $DEFAULT_OUTPUT_WIDTH;
+
+if (my $coverage_arg = $ENV{'LINTIAN_COVERAGE'}) {
+ my $p5opt = $ENV{'PERL5OPT'}//$EMPTY;
+ $p5opt .= $SPACE if $p5opt ne $EMPTY;
+ $ENV{'PERL5OPT'} = "${p5opt} ${coverage_arg}";
+}
+
+$ENV{LINTIAN_BASE} = realpath(THISDIR . '/..')
+ // die encode_utf8('Cannot resolve LINTIAN_BASE');
+
+$ENV{LINTIAN_VERSION} = $LINTIAN_VERSION // guess_version($ENV{LINTIAN_BASE});
+die encode_utf8('Unable to determine the version automatically!?')
+ unless length $ENV{LINTIAN_VERSION};
+
+my $format = 'ewi';
+my @INCLUDE_DIRS;
+my $list_tags;
+my $profile_name;
+my $tags;
+my $user_dirs = 1;
+
+my %options = (
+ 'format|f=s' => \$format,
+ 'help|h' => \&show_help,
+ 'include-dir=s' => \@INCLUDE_DIRS,
+ 'list-tags|l' => \$list_tags,
+ 'output-width=i' => \$TERMINAL_WIDTH,
+ 'profile=s' => \$profile_name,
+ 'tags|tag|t' => \$tags,
+ 'user-dirs!' => \$user_dirs,
+ 'version' => \&show_version,
+);
+
+Getopt::Long::Configure('gnu_getopt');
+Getopt::Long::GetOptions(%options)
+ or die encode_utf8("error parsing options\n");
+
+my $profile = Lintian::Profile->new;
+$profile->load($profile_name, \@INCLUDE_DIRS, $user_dirs);
+
+my $output;
+
+$format = lc $format;
+if ($format eq 'ewi') {
+ $output = Lintian::Output::EWI->new;
+
+} elsif ($format eq 'json') {
+ $output = Lintian::Output::JSON->new;
+
+} elsif ($format eq 'html') {
+ $output = Lintian::Output::HTML->new;
+
+} else {
+ die encode_utf8("Invalid output format $format\n");
+}
+
+if ($list_tags) {
+ say encode_utf8($_) for sort { lc($a) cmp lc($b) } $profile->enabled_tags;
+ exit;
+}
+
+# show all tags when none were specified
+my @selected = @ARGV;
+@selected = $profile->enabled_tags
+ unless @selected;
+
+my @available = grep { defined} map { $profile->get_tag($_) } @selected;
+
+my @sorted = sort { lc($a->name) cmp lc($b->name) } @available;
+
+$output->describe_tags($profile->data, \@sorted, $TERMINAL_WIDTH);
+
+exit any { !defined $profile->get_tag($_) } @selected;
+
+sub show_version {
+ say encode_utf8("$NEW_PROGRAM_NAME v$ENV{LINTIAN_VERSION}");
+
+ exit;
+}
+
+sub show_help {
+ my $message =<<"EOT";
+Usage: $NEW_PROGRAM_NAME [log-file...] ...
+ $NEW_PROGRAM_NAME [--tags] tag ...
+
+Options:
+ -l, --list-tags list all tags Lintian knows about
+ -t, --tag, --tags display tag descriptions
+ --include-dir DIR check for Lintian data in DIR
+ --profile X use vendor profile X to determine severities
+ --output-width NUM set output width instead of probing terminal
+ --[no-]user-dirs whether to include profiles from user directories
+ --version show version info and exit
+EOT
+
+ print encode_utf8($message);
+
+ exit;
+}
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/bin/spellintian b/bin/spellintian
new file mode 100755
index 0000000..c3dc7c9
--- /dev/null
+++ b/bin/spellintian
@@ -0,0 +1,161 @@
+#!/usr/bin/perl
+
+# Copyright (C) 1998 Christian Schwarz, Richard Braakman (and others)
+# Copyright (C) 2013 Niels Thykier
+# Copyright (C) 2014 Jakub Wilk <jwilk@jwilk.net>
+# Copyright (C) 2020 Felix Lechner
+
+# This program is free software. It is distributed under the terms of
+# the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any
+# later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at <https://www.gnu.org/copyleft/gpl.html>, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Cwd qw(realpath);
+use File::Basename qw(dirname);
+
+# neither Path::This nor lib::relative are in Debian
+use constant THISFILE => realpath __FILE__;
+use constant THISDIR => dirname realpath __FILE__;
+
+# use Lintian modules that belong to this program
+use lib THISDIR . '/../lib';
+
+# substituted during package build
+my $LINTIAN_VERSION;
+
+use Const::Fast;
+use Getopt::Long ();
+use Path::Tiny;
+use Unicode::UTF8 qw(encode_utf8 decode_utf8);
+
+use Lintian::Spelling qw(check_spelling check_spelling_picky);
+use Lintian::Profile;
+use Lintian::Version qw(guess_version);
+
+const my $EMPTY => q{};
+const my $SPACE => q{ };
+
+$SIG{__WARN__} = sub {
+ my ($message) = @_;
+
+ $message =~ s/\A([[:upper:]])/lc($1)/e;
+ $message =~ s/\n+\z//;
+
+ die encode_utf8("spellintian: $message\n");
+};
+
+if (my $coverage_arg = $ENV{'LINTIAN_COVERAGE'}) {
+ my $p5opt = $ENV{'PERL5OPT'} // $EMPTY;
+ $p5opt .= $SPACE if $p5opt ne $EMPTY;
+ $ENV{'PERL5OPT'} = "${p5opt} ${coverage_arg}";
+}
+
+$ENV{LINTIAN_BASE} = realpath(THISDIR . '/..')
+ // die encode_utf8('Cannot resolve LINTIAN_BASE');
+
+$ENV{LINTIAN_VERSION} = $LINTIAN_VERSION // guess_version($ENV{LINTIAN_BASE});
+die encode_utf8('Unable to determine the version automatically!?')
+ unless length $ENV{LINTIAN_VERSION};
+
+my @INCLUDE_DIRS;
+my $picky = 0;
+my $user_dirs = 1;
+
+my %options = (
+ 'h|help' => \&show_help,
+ 'include-dir=s' => \@INCLUDE_DIRS,
+ 'picky' => \$picky,
+ 'user-dirs!' => \$user_dirs,
+ 'version' => \&show_version,
+);
+
+Getopt::Long::Configure('gnu_getopt');
+
+Getopt::Long::GetOptions(%options)
+ or die encode_utf8("error parsing options\n");
+
+my $PROFILE = Lintian::Profile->new;
+$PROFILE->load(undef, \@INCLUDE_DIRS, $user_dirs);
+
+my $exit_code = 0;
+
+unless (@ARGV) {
+ my $text = do { local $/ = undef; decode_utf8(<STDIN>) };
+ spellcheck($PROFILE->data, undef, $picky, $text);
+}
+
+for my $path (@ARGV) {
+
+ unless (-r $path) {
+ print {*STDERR} encode_utf8("$path is not a readable file\n");
+ $exit_code = 1;
+
+ next;
+ }
+
+ my $text = path($path)->slurp_utf8;
+ spellcheck($PROFILE->data, $path, $picky, $text);
+}
+
+exit $exit_code;
+
+sub show_version {
+ say encode_utf8("spellintian v$ENV{LINTIAN_VERSION}");
+
+ exit;
+}
+
+sub show_help {
+ my $message =<<'EOF' ;
+Usage: spellintian [--picky] [FILE...]
+
+Options:
+ --picky be extra picky
+ --include-dir DIR check for Lintian data in DIR
+ --[no-]user-dirs whether to include profiles from user directories
+ --version show version info and exit
+EOF
+
+ print encode_utf8($message);
+
+ exit;
+}
+
+sub spellcheck {
+ my ($lintian_data, $path, $be_picky, $text) = @_;
+
+ my $prefix = $path ? "$path: " : $EMPTY;
+
+ my $spelling_error_handler = sub {
+ my ($mistake, $correction) = @_;
+ say encode_utf8("$prefix$mistake -> $correction");
+ };
+
+ check_spelling($lintian_data, $text, $spelling_error_handler);
+ check_spelling_picky($lintian_data, $text, $spelling_error_handler)
+ if $be_picky;
+
+ return;
+}
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et