From: Jeremiah Foster Date: Thu, 16 Jul 2009 15:12:42 +0000 (+0300) Subject: new_maemian got moved to minimae, which is the new working frontend for maemian. X-Git-Url: https://vcs.maemo.org/git/?a=commitdiff_plain;ds=sidebyside;h=2d5a71039f9d11f4f3a2e59598758af849bd1cc9;p=maemian new_maemian got moved to minimae, which is the new working frontend for maemian. --- diff --git a/lib/Maemian/Command.pm b/lib/Maemian/Command.pm index 46c361d..c7b76e7 100644 --- a/lib/Maemian/Command.pm +++ b/lib/Maemian/Command.pm @@ -59,8 +59,8 @@ Maemian::Command - Utilities to execute other commands from lintian code =head1 DESCRIPTION -Maemian::Command is a thin wrapper around IPC::Run, that catches exception -and implements a useful default behaviour for input and output redirection. +Maemian::Command is a thin wrapper around IPC::Run, that catches exceptions +and implements useful default behaviour for input and output redirection. Maemian::Command provides a function spawn() which is a wrapper around IPC::Run::run() resp. IPC::Run::start() (depending on whether a @@ -219,13 +219,13 @@ sub spawn { and !$opts->{success}) { require Util; if ($opts->{description}) { - Util::fail("$opts->{description} failed with error code ". - $opts->{harness}->result); + Util::fail("$opts->{description} failed with error code ". + $opts->{harness}->result); } elsif (@cmds == 1) { - Util::fail("$cmds[0][0] failed with error code ". - $opts->{harness}->result); + Util::fail("$cmds[0][0] failed with error code ". + $opts->{harness}->result); } else { - Util::fail("command failed with error code ". + Util::fail("command failed with error code ". $opts->{harness}->result); } } @@ -283,7 +283,7 @@ sub reap { Util::fail("$opts->{description} failed with error code ". $opts->{harness}->result); } else { - Util::fail("command failed with error code ". + Util::fail("command failed with error code ". $opts->{harness}->result); } } diff --git a/maemian b/maemian index 81f7ff4..7c00ab2 100755 --- a/maemian +++ b/maemian @@ -28,7 +28,7 @@ maemian - Maemo package checker =head1 -Maemian is the maemo version of maemian - a policy checker designed to +Maemian is the maemo version of lintian - a policy checker designed to assure the quality of a package uploaded into the maemo.org repositories. The goal of maemian is to improve quality by checking that the maemo packaging policy is followed. In order to do that it reads files in the @@ -37,7 +37,7 @@ ascertain who uploaded it, and if they used the correct email address. =cut -use strict; +use strict; # Warnings turned on via -w use lib qw(lib/); use Getopt::Long; @@ -72,12 +72,11 @@ my $packages_file = 0; #string for the -p option our $OPT_MAEMIAN_LAB = ""; #string for the --lab option our $OPT_MAEMIAN_ARCHIVEDIR = "";#string for the --archivedir option our $OPT_MAEMIAN_DIST = ""; #string for the --dist option -our $OPT_MAEMIAN_ARCH = ""; #string for the --arch option our $OPT_MAEMIAN_AREA = ""; #string for the --area option # These options can also be used via default or environment variables our $MAEMIAN_CFG = ""; #config file to use our $MAEMIAN_ROOT = "/home/jeremiah/maemian/"; #location of the maemian modules -our $OPT_MAEMIAN_SECTION = ""; #old name for OPT_MAEMIAN_ARCH +my $MAEMIAN_ARCH = "any"; my $experimental_output_opts = undef; @@ -110,7 +109,6 @@ our $MAEMIAN_LAB = undef; our $MAEMIAN_ARCHIVEDIR = undef; our $MAEMIAN_DIST = undef; our $MAEMIAN_UNPACK_LEVEL = undef; -our $MAEMIAN_ARCH = undef; our $MAEMIAN_SECTION = undef; our $MAEMIAN_AREA = undef; @@ -454,7 +452,6 @@ my %opthash = ( "dist=s" => \$OPT_MAEMIAN_DIST, "area=s" => \$OPT_MAEMIAN_AREA, "section=s" => \$OPT_MAEMIAN_AREA, - "arch=s" => \$OPT_MAEMIAN_ARCH, "root=s" => \$MAEMIAN_ROOT, # ------------------ package selection options @@ -585,15 +582,6 @@ foreach (VARS) { $$var = $$opt_var if $$opt_var; } -# MAEMIAN_ARCH must have a value. -unless (defined $MAEMIAN_ARCH) { - if ($MAEMIAN_DIST) { - chop($MAEMIAN_ARCH=`dpkg --print-architecture`); - } else { - $MAEMIAN_ARCH = 'any'; - } -} - # MAEMIAN_SECTION is deprecated in favour of MAEMIAN_AREA if (defined $MAEMIAN_SECTION) { print STDERR "warning: MAEMIAN_SECTION has been deprecated in favour of MAEMIAN_AREA.\n"; diff --git a/minimae b/minimae new file mode 100755 index 0000000..81428a8 --- /dev/null +++ b/minimae @@ -0,0 +1,108 @@ +#!/usr/bin/perl + +# Copyright (C) Jeremiah C. Foster 2009, based on: +# Lintian -- Debian package checker +# Copyright (C) 1998 Christian Schwarz and Richard Braakman + +=head1 NAME + +minimae - A small, cuddly version of maemian + +=head1 PURPOSE + +Maemian is the maemo version of lintian - a policy checker designed to +assure the quality of a package uploaded into the maemo.org repositories. +The goal of maemian is to improve quality by checking that the maemo +packaging policy is followed. In order to do that it reads files in the +uploaded deb. Currently maemian only looks at the .dsc file and tries to +ascertain who uploaded it, and if they used the correct email address. + +=head1 SYNOPSIS + + # Check a debian description file + minimae -i file.dsc + +=cut + +use strict; +use warnings; +use Getopt::Long; +use Pod::Usage; +use Carp; +use lib qw(lib/); +use Maemian::Output; + +# --- Command line options +my $inputfile; # --- A file passed on the command line +my ($help, $verbose); + +GetOptions + ( + 'help' => \$help, + 'verbose' => \$verbose, + 'inputfile|i=s' => \$inputfile, + ); + +# --- Process Command line options +pod2usage() if $help; +pod2usage() if not $inputfile; + +# --- Output settings. +my $out = new Maemian::Output; +if ($verbose) { + $out->verbose(1); + $out->v_msg("Verbose on"); +} + # --- If this is set to true, then you only get msgs +$out->quiet(0); +$out->msg("Notice on"); +# --- If this is set to true, then you will get verbose messages. +$out->color("auto"); + + + + + + + + + + + +sub file_tests { + use File::Basename; + my $path = shift; + if (-r $path) { + my ($filename, $dirs) = fileparse($path); + # --- maemo is a trademarked term + if ($filename =~ /maemo/) { + print "W: Any use of the word \"maemo\" in the package name (not package version) is subject to trademark.\n"; + } + # --- Open file into an array + open my $file, '<', $path or die "Cannot open file: $!\n"; + my @lines = <$file>; + close $file; + + my ($field, $maintainer) = map { split /: / } grep /Maintainer/, @lines; + chomp($maintainer); + if ($maintainer =~ /(ubuntu|debian)/i) { + print "W: Maintainer email address ($maintainer) might be the same as upstream.\n"; + } + else { + $out->msg("$maintainer"); + } + if (grep /BEGIN PGP SIGNED MESSAGE/, @lines) { + $out->v_msg("$filename is signed"); + } + $out->debug_msg(3, "\n$dirs\n$filename\n"); + } + else { + croak "File not readable: $!\n"; + } +} + +if ($inputfile) { + file_tests($inputfile); +} else { + croak "No input file found: $!\n"; +} diff --git a/unpack/unpack-srcpkg-l1 b/unpack/unpack-srcpkg-l1 index b10776a..c079b31 100755 --- a/unpack/unpack-srcpkg-l1 +++ b/unpack/unpack-srcpkg-l1 @@ -170,9 +170,3 @@ for my $bin (split(/,\s+/o,$data->{'binary'})) { reap($job); exit 0; - -# Local Variables: -# indent-tabs-mode: nil -# cperl-indent-level: 4 -# End: -# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround