scripts/t/Dpkg_Control.t

   1 #!/usr/bin/perl
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 use strict;
  17 use warnings;
  18
  19 use Test::More;
  20 use Test::Dpkg qw(:needs :paths);
  21
  22 BEGIN {
  23     plan tests => 24;
  24
  25     use_ok('Dpkg::Control');
  26     use_ok('Dpkg::Control::Info');
  27 }
  28
  29 my $datadir = test_get_data_path();
  30
  31 sub parse_ctrl {
  32     my ($type, $path) = @_;
  33
  34     my $ctrl = Dpkg::Control->new(type => $type);
  35     eval {
  36         $ctrl->load($path);
  37         1;
  38     } or return;
  39
  40     return $ctrl;
  41 }
  42
  43 sub parse_dsc {
  44     my $path = shift;
  45
  46     return parse_ctrl(CTRL_PKG_SRC, $path);
  47 }
  48
  49 my $c = Dpkg::Control::Info->new("$datadir/control-1");
  50
  51 my $io_data;
  52 my $io;
  53
  54 open $io, '>', \$io_data or die "canno open io string\n";;
  55
  56 $c->output($io);
  57 my $expected = 'Source: mysource
  58 Empty-Field:
  59 Long-Field: line1
  60  line 2 line 2 line 2
  61  .
  62    line 3 line 3 line 3
  63  .
  64  ..
  65  line 4
  66 My-Field-One: myvalue1
  67 My-Field-Two: myvalue2
  68 Numeric-Field: 0
  69
  70 Package: mypackage1
  71 Architecture: any
  72 Depends: libc6
  73
  74 Package: mypackage2
  75 Architecture: all
  76 Depends: hello
  77
  78 Package: mypackage3
  79 Architecture: all
  80 Depends: hello
  81 Description: short one
  82  long one
  83  very long one
  84 ';
  85 is($io_data, $expected, "Dump of $datadir/control-1");
  86
  87 my $src = $c->get_source();
  88 is($src, $c->[0], 'array representation of Dpkg::Control::Info 1/2');
  89 is($src->{'numeric-field'}, '0', 'Numeric 0 value parsed correctly');
  90 is($src->{'my-field-one'}, 'myvalue1', 'Access field through badly capitalized field name');
  91 is($src->{'long-field'},
  92 'line1
  93 line 2 line 2 line 2
  94
  95   line 3 line 3 line 3
  96
  97 .
  98 line 4', 'Get multi-line field');
  99 is($src->{'Empty-field'}, '', 'Get empty field');
 100
 101 my $pkg = $c->get_pkg_by_idx(1);
 102 is($pkg, $c->[1], 'array representation of Dpkg::Control::Info 2/2');
 103 is($pkg->{package}, 'mypackage1', 'Name of first package');
 104
 105 $pkg = $c->get_pkg_by_name('mypackage3');
 106 is($pkg->{package}, 'mypackage3', 'Name of third package');
 107 is($pkg->{Depends}, 'hello', 'Name of third package');
 108
 109 $pkg = $c->get_pkg_by_idx(2);
 110 open $io, '>', \$io_data or die "canno open io string\n";;
 111 $pkg->output($io);
 112
 113 is($io_data,
 114 'Package: mypackage2
 115 Architecture: all
 116 Depends: hello
 117 ', "Dump of second binary package of $datadir/control-1");
 118
 119 # Check OpenPGP armored signatures in source control files
 120
 121 my $dsc;
 122
 123 $dsc = parse_dsc("$datadir/bogus-unsigned.dsc");
 124 is($dsc, undef, 'Unsigned .dsc w/ OpenPGP armor');
 125
 126 $dsc = parse_dsc("$datadir/bogus-armor-no-sig.dsc");
 127 is($dsc, undef, 'Signed .dsc w/ OpenPGP armor missing signature');
 128
 129 $dsc = parse_dsc("$datadir/bogus-armor-trail.dsc");
 130 is($dsc, undef, 'Signed .dsc w/ bogus OpenPGP armor trailer');
 131
 132 $dsc = parse_dsc("$datadir/bogus-armor-inline.dsc");
 133 is($dsc, undef, 'Signed .dsc w/ bogus OpenPGP inline armor');
 134
 135 $dsc = parse_dsc("$datadir/bogus-armor-formfeed.dsc");
 136 is($dsc, undef, 'Signed .dsc w/ bogus OpenPGP armor line');
 137
 138 $dsc = parse_dsc("$datadir/bogus-armor-double.dsc");
 139 ok(defined $dsc, 'Signed .dsc w/ two OpenPGP armor signatures');
 140 is($dsc->{Source}, 'pass', 'Signed spaced .dsc package name');
 141
 142 $dsc = parse_dsc("$datadir/bogus-armor-spaces.dsc");
 143 ok(defined $dsc, 'Signed .dsc w/ spaced OpenPGP armor');
 144 is($dsc->{Source}, 'pass', 'Signed spaced .dsc package name');
 145
 146 $dsc = parse_dsc("$datadir/bogus-armor-nested.dsc");
 147 ok(defined $dsc, 'Signed .dsc w/ nested OpenPGP armor');
 148 is($dsc->{Source}, 'pass', 'Signed nested .dsc package name');