git.maemo.org Git - maemian/blob - minimae

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) Jeremiah C. Foster 2009, based on:
   4 #   Lintian -- Debian package checker
   5 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
   6
   7 =head1 NAME
   8
   9 minimae - A small, cuddly version of maemian
  10
  11 =head1 PURPOSE
  12
  13 Maemian is the maemo version of lintian - a policy checker designed to
  14 assure the quality of a package uploaded into the maemo.org repositories.
  15 The goal of maemian is to improve quality by checking that the maemo
  16 packaging policy is followed. In order to do that it reads files in the
  17 uploaded deb. Currently maemian only looks at the .dsc file and tries to
  18 ascertain who uploaded it, and if they used the correct email address.
  19
  20 =head1 SYNOPSIS
  21
  22     # Check a debian description file
  23     minimae -i file.dsc
  24
  25 =cut
  26
  27 use strict;
  28 use warnings;
  29 use Getopt::Long;
  30 use Pod::Usage;
  31 use Carp;
  32 use lib qw(lib/);
  33 use Maemian::Output;
  34
  35 # --- Command line options
  36 my $inputfile;                     # --- A file passed on the command line
  37 my ($help, $verbose);
  38
  39 GetOptions
  40   (
  41    'help' => \$help,
  42    'verbose' => \$verbose,
  43    'inputfile|i=s' => \$inputfile,
  44   );
  45
  46 # --- Process Command line options
  47 pod2usage() if $help;
  48 pod2usage() if not $inputfile;
  49
  50 # --- Output settings.
  51 my $out = new Maemian::Output;
  52 if ($verbose) {
  53   $out->verbose(1);
  54   $out->v_msg("Verbose on");
  55 }
  56   # --- If this is set to true, then you only get msgs
  57 $out->quiet(0);
  58 $out->msg("Notice on");
  59 # --- If this is set to true, then you will get verbose messages.
  60 $out->color("auto");
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72 sub file_tests {
  73   use File::Basename;
  74   my $path = shift;
  75   if (-r $path) {
  76     my ($filename, $dirs) = fileparse($path);
  77     # --- maemo is a trademarked term
  78     if ($filename =~ /maemo/) {
  79       print "W: Any use of the word \"maemo\" in the package name (not package version) is subject to trademark.\n";
  80     }
  81     # --- Open file into an array
  82     open my $file, '<', $path or die "Cannot open file: $!\n";
  83     my @lines = <$file>;
  84     close $file;
  85
  86     my ($field, $maintainer) = map { split /: / } grep /Maintainer/, @lines;
  87     chomp($maintainer);
  88     if ($maintainer =~ /(ubuntu|debian)/i) {
  89       print "W: Maintainer email address ($maintainer) might be the same as upstream.\n";
  90     }
  91     else {
  92       $out->msg("$maintainer");
  93     }
  94     if (grep /BEGIN PGP SIGNED MESSAGE/, @lines) {
  95       $out->v_msg("$filename is signed");
  96     }
  97     $out->debug_msg(3, "\n$dirs\n$filename\n");
  98   }
  99   else {
 100     croak "File not readable: $!\n";
 101   }
 102 }
 103
 104 if ($inputfile) {
 105   file_tests($inputfile);
 106 } else {
 107   croak "No input file found: $!\n";
 108 }