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

   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 - Executes some tests on a gzipped tarball, looking for
  10 debian packaging files and conventions. minimae gets a json string
  11 as input and parses that string to do its checks and find resources.
  12
  13 =cut
  14
  15 =head1 VERSION
  16
  17 This document describes minimae version 2.0
  18
  19 =head1 PURPOSE
  20
  21 Maemian is the maemo version of lintian - a policy checker designed to
  22 assure the quality of a package uploaded into the maemo.org repositories.
  23 The goal of maemian is to improve quality by checking that the maemo
  24 packaging policy is followed. In order to do that it reads files in the
  25 tarball that has been uploaded to the maemo repositories.
  26
  27 =head1 SYNOPSIS
  28
  29     # Check tarball
  30     minimae -i file.deb
  31
  32 =cut
  33
  34 use strict;
  35 use warnings;
  36 use Test::More tests => 8;
  37 use IPC::System::Simple qw/ capture /;
  38 use feature ":5.10";
  39 use Control;
  40 use Archive::Tar;
  41 use Perl6::Slurp;
  42 use RepoUtils;
  43 use File::Basename;
  44
  45 my $tarball = $ARGV[0];                       # Orignal tarball
  46 my $repo = RepoUtils->new();
  47 $repo->copy_file($tarball, "lab/");           # copy the tarball to the lab
  48 my $package_name = basename $tarball;
  49
  50 my $tar = Archive::Tar->new;
  51 $tar->read("lab/$package_name",1);
  52 if ($package_name =~ /orig.tar.gz/) {
  53   $package_name =~ s/.orig.tar.gz$//;         # Remove suffixes
  54 }
  55 else {
  56   $package_name =~ s/.tar.gz$//;              # Remove suffixes
  57 }
  58 $package_name =~ tr/_/-/;                     # translate underscore into dash
  59 $package_name =~ s/-[\d]$//;                  # trim package version
  60 $package_name =~ s/-.?maemo.$//;              # trim package version
  61 chdir("lab/");                                # We're in /lab now!
  62 $tar->extract();                              # extracted tarball now in lab/
  63
  64 my $changelog_file = "$package_name/debian/changelog";
  65 my $copyright_file = "$package_name/debian/copyright";
  66 my $control_file = "$package_name/debian/control";
  67
  68 # Check control file
  69 my $file_type = capture("file -i $control_file");
  70 ok(($file_type), "File type defined.");
  71 my ($name, $content, $charset) = split / /, $file_type;
  72 chomp($charset);
  73 given($charset) {
  74   when ("charset=us-ascii") {
  75     ok($charset, 'charset is ASCII.');
  76   }
  77   when ("charset=utf-8") {
  78     ok($charset, 'charset is UTF-8');
  79   }
  80   default {
  81     not_ok($charset, "$charset");
  82     die qq(Unknown charset for $charset.);
  83   }
  84 }
  85
  86 # Each chunk is a discreet package
  87 my @chunks = slurp $control_file, {irs => qr/\n\n/xms};
  88 print map { $_ . "\n" } @chunks;
  89
  90
  91 my @fields = slurp $control_file, {irs => qr/\n\n/xms};
  92 diag((grep /XB-Maemo-Icon/, split /\n/, $fields[-1]), ' Found icon in control file.');
  93 my @arches = grep /Architecture/, split /\n/, $fields[-1];
  94
  95 ok((grep /Architecture/, split /\n/, $fields[-1]), "Arches: $arches[-1]");
  96 ok((grep /XSBC/, @fields), 'Maemo specific maintainer field');
  97 my $package = grep /Package:/, split /\n/, $fields[-1];
  98 ok($package !~ /[M|m]aemo/, 'No potential copyright clash with maemo name');
  99
 100 # Check copyright file
 101 ok(-s $copyright_file, 'Copyright file exists and is non-empty');
 102 @fields = slurp $copyright_file, {irs => qr/\n\n/xms};
 103 my ($file_name, $type) = split / /, capture("file -i $copyright_file");
 104 ok($file_type !~ /application\/x-gzip/, 'Copyright not compressed.');
 105 my @copylines = map { $_ } grep /copyright|\(C\)/, @fields;
 106 ok((scalar @copylines > 1), 'Found copyright assignment.');
 107
 108 # check changelog
 109
 110
 111
 112 1;  # Nothing to see here, move along.
 113