debsigs 0.1.19 / usr / bin / debsigs-signchanges

#!/usr/bin/perl -w

# Copyright (C) 2001,2002 Progeny Linux Systems, Inc.
# Authors: John Goerzen, Branden Robinson
# Copyright (C) 2009  Peter Pentchev <roam@ringlet.net>

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;

use File::Basename;
use Getopt::Long;
use IO::File;

use Debian::debsigs::debsigsmain;
use Debian::debsigs::forktools qw/forkreader/;

sub syntax($);
sub version();

my ($showhelp, $showversion);
Getopt::Long::Configure('no_ignore_case');
GetOptions ('help|h' => \$showhelp,
	    'version|V' => \$showversion);

version() if $showversion;
syntax(0) if $showhelp;
exit(0) if $showhelp || $showversion;

syntax(1) unless (@ARGV && $ARGV[0] =~ /\.changes$/);

my $changesfile = $ARGV[0];
my $changespath = (fileparse($changesfile))[1];
my $newchangesfile = "$changesfile.debsigs-signchanges.$$";
my $ADDSIG = $ENV{DEBSIGSSIG} ? $ENV{DEBSIGSSIG} : 'maint';
my $DEBSIGSOPTIONS = $ENV{DEBSIGSOPTIONS} ? $ENV{DEBSIGSOPTIONS} : '';
open(CHANGES, "<$changesfile") or die "Couldn't open $changesfile: $!";
open(NEWCHANGES, ">$newchangesfile") or
  die "Couldn't open $newchangesfile: $!";

# Look for the Files section.

my ($line, $cline, $sigtype, $defkeyname);
my @changes;
my %debs;

while (defined($line = <CHANGES>)) {
  $cline = $line;
  chomp $cline;

  if ($sigtype && $line =~ /^\S/) {
    undef $sigtype;
  }
  if (!defined($sigtype)) {
    push @changes, $line;

    # A default key?
    if ($cline =~ /^Changed-By:\s+(.*)$/) {
      $defkeyname = $1;
    } elsif ($cline =~ /^Maintainer:\s+(.*)$/ && !defined($defkeyname)) {
      $defkeyname = $1;
    }

    # A new section?
    if ($cline =~ /Files:/) {
      $sigtype = 'md5';
    } elsif ($cline =~ /^Checksums-(\w+):/) {
      $sigtype = $1;
    }
  } else {
    if ($cline !~ /\s(\S+\.deb)$/) {
      push @changes, $line;
      next;
    }

    $debs{$1}{$sigtype} = $line;
    push @changes, {'t' => 'sig', 'sigtype' => $sigtype, 'file' => $1};
  }
}
close CHANGES;

# Do we need to determine the default key?
if ($defkeyname && $DEBSIGSOPTIONS !~ /(^|\s)--?(k|default-key)/) {
  my ($defkey);
  eval {
    my ($fd, $pid) = forkreader(undef,
      'gpg', '--list-secret-keys', '--with-colons', $defkeyname);
    die("Couldn't exec gpg: $!\n") unless defined($fd);
    my $keyline;
    while ($keyline = <$fd>) {
      if ($keyline =~ /^sec:[^:]*:[^:]*:[^:]*:([^:]+):/) {
	die("More than one secret key present - $defkey, $1\n") if $defkey;
	$defkey = $1;
      }
    }
    close($fd) or die("Couldn't close the gpg reader: $!\n");
    die("No secret key found\n") unless $defkey;
  };
  die("Couldn't determine the secret key for '$defkeyname': $@") if $@;
  $DEBSIGSOPTIONS .= " --default-key='$defkey'";
}

# Sign each .deb file and recalculate the checksums
my $file;
foreach $file (keys %debs) {
  my ($fname);

  print "Changespath is '$changespath'\n";
  $fname = "$changespath/$file";

  print "Signing $file...\n";
  system("debsigs $DEBSIGSOPTIONS --sign=$ADDSIG $fname") &&
    die "Couldn't sign $fname\n";

  foreach $sigtype (keys %{$debs{$file}}) {
    my ($progname, $csum, $size, $section, $priority, $nfile);
    my @el;

    $cline = $debs{$file}{$sigtype};
    chomp $cline;
    if ($sigtype eq 'md5') {
      ($csum, $size, $section, $priority, $nfile) = split(' ', $cline);
    } else {
      ($csum, $size, $nfile) = split(' ', $cline);
    }

    # Recalculate the checksum; $sigtype has already been validated
    $progname = lc($sigtype).'sum';
    $csum = `$progname $fname`;
    if (!defined($csum)) {
      die("$sigtype checksum for $file: $progname: $!\n");
    }
    chomp $csum;
    @el = split /\s+/, $csum;
    if ($#el != 1 || $el[1] ne $fname || $el[0] !~ /^([0-9a-f]+)$/) {
      die("$sigtype checksum for $file: bad $progname output: $csum\n");
    }
    $csum = $el[0];

    # Store it with all the other fields
    $size = (stat($fname))[7];
    if ($sigtype eq 'md5') {
      $line = " $csum $size $section $priority $file\n";
    } else {
      $line = " $csum $size $file\n";
    }
    $debs{$file}{$sigtype} = $line;
  }
}

# Output the changes file
foreach (@changes) {
  if (ref($_) eq '') {
    print NEWCHANGES;
    next;
  } elsif (ref($_) ne 'HASH') {
    die("INTERNAL ERROR: invalid \@changes ref '".ref($_)."'\n");
  } elsif (!defined($_->{'t'})) {
    die("INTERNAL ERROR: \@changes ref without a type\n");
  } elsif ($_->{'t'} eq 'sig') {
    if (!defined($_->{'file'})) {
      die("INTERNAL ERROR: \@changes sig without a sigtype\n");
    } elsif (!defined($_->{'file'})) {
      die("INTERNAL ERROR: \@changes sig $_->{sigtype} for no file\n");
    }
    $line = $debs{$_->{'file'}}{$_->{'sigtype'}};
    if (!defined($line)) {
      die("INTERNAL ERROR: \@changes sig $_->{sigtype} nofile $_->{file}\n");
    }
    print NEWCHANGES $line;
  } else {
    die("INTERNAL ERROR: \@changes ref of unknown type '$_->{t}'\n");
  }
}
close NEWCHANGES;

rename($newchangesfile, $changesfile) or
  die "Couldn't rename $newchangesfile to $changesfile: $!";

sub syntax($) {
  my ($err) = @_;
  my $s = "Usage: debsigs-signchanges file\n";

  if ($err) {
    print STDERR "$s";
    exit(1);
  } else {
    print "$s";
  }
}

sub version() {
  print "debsigs-signchanges $Debian::debsigs::debsigsmain::VERSION\n";
}

__END__

=head1 NAME

debsigs-signchanges - cryptographically sign Debian packages based on
package changes file

=head1 SYNOPSIS

B<debsigs-signchanges> I<file>

=head1 DESCRIPTION

I<debsigs-signchanges> reads the Debian package changes file specified
as an operand and runs I<debsigs>(1) on each package listed within.  It
then updates the changes file to reflect the new cryptographic hash and
size of the signed Debian packages.

=head1 OPERANDS

I<debsigs-signchanges> takes one operand: the name of a Debian package
changes file to scan and update.

=head1 AUTHORS

=over 5

=item John Goerzen <jgoerzen@complete.org>

=item Branden Robinson <branden@debian.org>

=back

=head1 SEE ALSO

debsigs(1), debsig-verify(1), gpg(1)

=cut

# vim:set et ai sts=2 sw=2 tw=72: