git.maemo.org Git - maemian/blob - lib/Maemian/Check.pm

   1 # Maemian::Check -- Maemian checks shared between multiple scripts
   2
   3 # Copyright (C) 2009 Jeremiah C. Foster
   4 # Copyright (C) 2009 Russ Allbery
   5 # Copyright (C) 2004 Marc Brockschmidt
   6 # Copyright (C) 1998 Richard Braakman
   7 #
   8 # This program is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by the Free
  10 # Software Foundation; either version 2 of the License, or (at your option)
  11 # any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful, but WITHOUT
  14 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  16 # more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along with
  19 # this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 package Maemian::Check;
  22
  23 use strict;
  24 use warnings;
  25
  26 use Exporter ();
  27 use Tags qw(tag);
  28
  29 our @ISA    = qw(Exporter);
  30 our @EXPORT = qw(check_maintainer);
  31
  32 =head1 NAME
  33
  34 Maemian::Check -- Maemian checks shared between multiple scripts
  35
  36 =head1 SYNOPSIS
  37
  38     use Maemian::Check qw(check_maintainer);
  39
  40     check_maintainer ($maintainer, $field);
  41
  42 =head1 DESCRIPTION
  43
  44 This module provides functions to do some Maemian checks that need to be
  45 done in multiple places. There are certain low-level checks, such as
  46 validating a maintainer name and e-mail address or checking spelling,
  47 which apply in multiple situations and should be done in multiple checks
  48 scripts or in checks scripts and the Maemian front-end.
  49
  50 The functions provided by this module issue tags directly, usually either
  51 taking the tag name to issue as an argument or dynamically constructing
  52 the tag name based on function parameters.  The caller is responsible for
  53 ensuring that all tags are declared in the relevant *.desc file with
  54 proper descriptions and other metadata.  The possible tags issued by each
  55 function are described in the documentation for that function.
  56
  57 =head1 FUNCTIONS
  58
  59 =over 4
  60
  61 =item check_maintainer(MAINTAINER, FIELD)
  62
  63 Checks the maintainer name and address MAINTAINER for Policy compliance
  64 and other issues.  FIELD is the context in which the maintainer name and
  65 address was seen and should be one of C<maintainer> (the Maintainer field
  66 in a control file), C<uploader> (the Uploaders field in a control file),
  67 or C<changed-by> (the Changed-By field in a changes file).
  68
  69 The following tags may be issued by this function.  The string C<%s> in
  70 the tags below will be replaced with the value of FIELD.
  71
  72 =over 4
  73
  74 =item %s-address-is-on-localhost
  75
  76 The e-mail address portion of MAINTAINER is at C<localhost> or some other
  77 similar domain.
  78
  79 =item %s-address-looks-weird
  80
  81 MAINTAINER may be syntactically correct, but it isn't conventionally
  82 formatted.  Currently this tag is only issued for missing whitespace
  83 between the name and the address.
  84
  85 =item %s-address-malformed
  86
  87 MAINTAINER doesn't fit the basic syntax of a maintainer name and address
  88 as specified in Policy.
  89
  90 =item %s-address-missing
  91
  92 MAINTAINER does not contain an e-mail address in angle brackets (<>).
  93
  94 =item %s-name-missing
  95
  96 MAINTAINER does not contain a full name before the address, or the e-mail
  97 address was not in angle brackets.
  98
  99 =item %s-not-full-name
 100
 101 The name portion of MAINTAINER is a single word.  This tag is not issued
 102 for a FIELD of C<changed-by>.
 103
 104 =item wrong-debian-qa-address-set-as-maintainer
 105
 106 MAINTAINER appears to be the Debian QA Group, but the e-mail address
 107 portion is wrong for orphaned packages.  This tag is only issued for a
 108 FIELD of C<maintainer>.
 109
 110 =item wrong-debian-qa-group-name
 111
 112 MAINTAINER appears to be the Debian QA Group, but the name portion is not
 113 C<Debian QA Group>.  This tag is only issued for a FIELD of C<maintainer>.
 114
 115 =back
 116
 117 The last two tags are issued here rather than in a location more specific
 118 to checks of the Maintainer control field because they take advantage of
 119 the parsing done by the rest of the function.
 120
 121 =cut
 122
 123 sub check_maintainer {
 124     my ($maintainer, $field) = @_;
 125
 126     # Do the initial parse.
 127     $maintainer =~ /^([^<\s]*(?:\s+[^<\s]+)*)?(\s*)(?:<(.+)>)?(.*)$/;
 128     my ($name, $del, $mail, $extra) = ($1, $2, $3, $4);
 129     if (not $mail and $name =~ m/@/) {
 130         # Name probably missing and address has no <>.
 131         $mail = $name;
 132         $name = undef;
 133     }
 134
 135     # Some basic tests.
 136     my $malformed;
 137     if ($extra) {
 138         tag "$field-address-malformed", $maintainer;
 139         $malformed = 1;
 140     }
 141     tag "$field-address-looks-weird", $maintainer
 142         if (not $del and $name and $mail);
 143
 144     # Wookey really only has one name.  If we get more of these, consider
 145     # removing the check.  Skip the full name check for changes files as it's
 146     # not important there; we'll get it from the debian/control checks if
 147     # needed.
 148     if (not $name) {
 149         tag "$field-name-missing", $maintainer;
 150     } elsif ($name !~ /^\S+\s+\S+/ and $name ne 'Wookey') {
 151         tag "$field-not-full-name", $name
 152             if $field ne 'changed-by';
 153     }
 154
 155     # This should really be done with Email::Valid.  Don't issue the malformed
 156     # tag twice if we already saw problems.
 157     if (not $mail) {
 158         tag "$field-address-missing", $maintainer;
 159     } else {
 160         if (not $malformed and $mail !~ /^[^()<>@,;:\\\"\[\]]+@(\S+\.)+\S+/) {
 161             tag "$field-address-malformed", $maintainer;
 162         }
 163         if ($mail =~ /(?:localhost|\.localdomain|\.localnet)$/) {
 164             tag "$field-address-is-on-localhost", $maintainer;
 165         }
 166
 167         # Some additional checks that we only do for maintainer fields.
 168         if ($field eq 'maintainer') {
 169             if ($mail eq 'debian-qa@lists.debian.org') {
 170                 tag 'wrong-debian-qa-address-set-as-maintainer', $maintainer;
 171             } elsif ($mail eq 'packages@qa.debian.org') {
 172                 tag 'wrong-debian-qa-group-name', $maintainer
 173                     if ($name ne 'Debian QA Group');
 174             }
 175         }
 176     }
 177 }
 178
 179 =back
 180
 181 =head1 AUTHOR
 182
 183 Originally written by Russ Allbery <rra@debian.org> for Maemian. Based on
 184 code from checks scripts by Marc Brockschmidt and Richard Braakman. Adapted for
 185 Maemian by Jeremiah C. Foster
 186
 187 =head1 SEE ALSO
 188
 189 lintian(1)
 190
 191 =cut
 192
 193 1;