--- /dev/null
+# Maemian::Check -- Maemian checks shared between multiple scripts
+
+# Copyright (C) 2009 Jeremiah C. Foster
+# Copyright (C) 2009 Russ Allbery
+# Copyright (C) 2004 Marc Brockschmidt
+# Copyright (C) 1998 Richard Braakman
+#
+# This program is free software; you can redistribute it and/or modify it
+# 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, see <http://www.gnu.org/licenses/>.
+
+package Maemian::Check;
+
+use strict;
+use warnings;
+
+use Exporter ();
+use Tags qw(tag);
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(check_maintainer);
+
+=head1 NAME
+
+Maemian::Check -- Maemian checks shared between multiple scripts
+
+=head1 SYNOPSIS
+
+ use Maemian::Check qw(check_maintainer);
+
+ check_maintainer ($maintainer, $field);
+
+=head1 DESCRIPTION
+
+This module provides functions to do some Maemian checks that need to be
+done in multiple places. There are certain low-level checks, such as
+validating a maintainer name and e-mail address or checking spelling,
+which apply in multiple situations and should be done in multiple checks
+scripts or in checks scripts and the Maemian front-end.
+
+The functions provided by this module issue tags directly, usually either
+taking the tag name to issue as an argument or dynamically constructing
+the tag name based on function parameters. The caller is responsible for
+ensuring that all tags are declared in the relevant *.desc file with
+proper descriptions and other metadata. The possible tags issued by each
+function are described in the documentation for that function.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item check_maintainer(MAINTAINER, FIELD)
+
+Checks the maintainer name and address MAINTAINER for Policy compliance
+and other issues. FIELD is the context in which the maintainer name and
+address was seen and should be one of C<maintainer> (the Maintainer field
+in a control file), C<uploader> (the Uploaders field in a control file),
+or C<changed-by> (the Changed-By field in a changes file).
+
+The following tags may be issued by this function. The string C<%s> in
+the tags below will be replaced with the value of FIELD.
+
+=over 4
+
+=item %s-address-is-on-localhost
+
+The e-mail address portion of MAINTAINER is at C<localhost> or some other
+similar domain.
+
+=item %s-address-looks-weird
+
+MAINTAINER may be syntactically correct, but it isn't conventionally
+formatted. Currently this tag is only issued for missing whitespace
+between the name and the address.
+
+=item %s-address-malformed
+
+MAINTAINER doesn't fit the basic syntax of a maintainer name and address
+as specified in Policy.
+
+=item %s-address-missing
+
+MAINTAINER does not contain an e-mail address in angle brackets (<>).
+
+=item %s-name-missing
+
+MAINTAINER does not contain a full name before the address, or the e-mail
+address was not in angle brackets.
+
+=item %s-not-full-name
+
+The name portion of MAINTAINER is a single word. This tag is not issued
+for a FIELD of C<changed-by>.
+
+=item wrong-debian-qa-address-set-as-maintainer
+
+MAINTAINER appears to be the Debian QA Group, but the e-mail address
+portion is wrong for orphaned packages. This tag is only issued for a
+FIELD of C<maintainer>.
+
+=item wrong-debian-qa-group-name
+
+MAINTAINER appears to be the Debian QA Group, but the name portion is not
+C<Debian QA Group>. This tag is only issued for a FIELD of C<maintainer>.
+
+=back
+
+The last two tags are issued here rather than in a location more specific
+to checks of the Maintainer control field because they take advantage of
+the parsing done by the rest of the function.
+
+=cut
+
+sub check_maintainer {
+ my ($maintainer, $field) = @_;
+
+ # Do the initial parse.
+ $maintainer =~ /^([^<\s]*(?:\s+[^<\s]+)*)?(\s*)(?:<(.+)>)?(.*)$/;
+ my ($name, $del, $mail, $extra) = ($1, $2, $3, $4);
+ if (not $mail and $name =~ m/@/) {
+ # Name probably missing and address has no <>.
+ $mail = $name;
+ $name = undef;
+ }
+
+ # Some basic tests.
+ my $malformed;
+ if ($extra) {
+ tag "$field-address-malformed", $maintainer;
+ $malformed = 1;
+ }
+ tag "$field-address-looks-weird", $maintainer
+ if (not $del and $name and $mail);
+
+ # Wookey really only has one name. If we get more of these, consider
+ # removing the check. Skip the full name check for changes files as it's
+ # not important there; we'll get it from the debian/control checks if
+ # needed.
+ if (not $name) {
+ tag "$field-name-missing", $maintainer;
+ } elsif ($name !~ /^\S+\s+\S+/ and $name ne 'Wookey') {
+ tag "$field-not-full-name", $name
+ if $field ne 'changed-by';
+ }
+
+ # This should really be done with Email::Valid. Don't issue the malformed
+ # tag twice if we already saw problems.
+ if (not $mail) {
+ tag "$field-address-missing", $maintainer;
+ } else {
+ if (not $malformed and $mail !~ /^[^()<>@,;:\\\"\[\]]+@(\S+\.)+\S+/) {
+ tag "$field-address-malformed", $maintainer;
+ }
+ if ($mail =~ /(?:localhost|\.localdomain|\.localnet)$/) {
+ tag "$field-address-is-on-localhost", $maintainer;
+ }
+
+ # Some additional checks that we only do for maintainer fields.
+ if ($field eq 'maintainer') {
+ if ($mail eq 'debian-qa@lists.debian.org') {
+ tag 'wrong-debian-qa-address-set-as-maintainer', $maintainer;
+ } elsif ($mail eq 'packages@qa.debian.org') {
+ tag 'wrong-debian-qa-group-name', $maintainer
+ if ($name ne 'Debian QA Group');
+ }
+ }
+ }
+}
+
+=back
+
+=head1 AUTHOR
+
+Originally written by Russ Allbery <rra@debian.org> for Maemian. Based on
+code from checks scripts by Marc Brockschmidt and Richard Braakman. Adapted for
+Maemian by Jeremiah C. Foster
+
+=head1 SEE ALSO
+
+lintian(1)
+
+=cut
+
+1;