git.gag.com Git - debian/gzip/blob - build-aux/announce-gen

   1 eval '(exit $?0)' && eval 'exec perl -wS "$0" ${1+"$@"}'
   2   & eval 'exec perl -wS "$0" $argv:q'
   3     if 0;
   4 # Generate a release announcement message.
   5
   6 my $VERSION = '2009-10-30 15:59'; # UTC
   7 # The definition above must lie within the first 8 lines in order
   8 # for the Emacs time-stamp write hook (at end) to update it.
   9 # If you change this file with Emacs, please let the write hook
  10 # do its job.  Otherwise, update this string manually.
  11
  12 # Copyright (C) 2002-2009 Free Software Foundation, Inc.
  13
  14 # This program is free software: you can redistribute it and/or modify
  15 # it under the terms of the GNU General Public License as published by
  16 # the Free Software Foundation, either version 3 of the License, or
  17 # (at your option) any later version.
  18
  19 # This program is distributed in the hope that it will be useful,
  20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 # GNU General Public License for more details.
  23
  24 # You should have received a copy of the GNU General Public License
  25 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 # Written by Jim Meyering
  28
  29 use strict;
  30
  31 use Getopt::Long;
  32 use Digest::MD5;
  33 use Digest::SHA1;
  34 use POSIX qw(strftime);
  35
  36 (my $ME = $0) =~ s|.*/||;
  37
  38 my %valid_release_types = map {$_ => 1} qw (alpha beta stable);
  39 my @archive_suffixes = ('tar.gz', 'tar.bz2', 'tar.lzma', 'tar.xz');
  40
  41 sub usage ($)
  42 {
  43   my ($exit_code) = @_;
  44   my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
  45   if ($exit_code != 0)
  46     {
  47       print $STREAM "Try `$ME --help' for more information.\n";
  48     }
  49   else
  50     {
  51       my @types = sort keys %valid_release_types;
  52       print $STREAM <<EOF;
  53 Usage: $ME [OPTIONS]
  54 Generate an announcement message.
  55
  56 OPTIONS:
  57
  58 These options must be specified:
  59
  60    --release-type=TYPE          TYPE must be one of @types
  61    --package-name=PACKAGE_NAME
  62    --previous-version=VER
  63    --current-version=VER
  64    --gpg-key-id=ID         The GnuPG ID of the key used to sign the tarballs
  65    --url-directory=URL_DIR
  66
  67 The following are optional:
  68
  69    --news=NEWS_FILE
  70    --bootstrap-tools=TOOL_LIST  a comma-separated list of tools, e.g.,
  71                                 autoconf,automake,bison,gnulib
  72    --gnulib-version=VERSION     report VERSION as the gnulib version, where
  73                                 VERSION is the result of running git describe
  74                                 in the gnulib source directory.
  75                                 required if gnulib is in TOOL_LIST.
  76    --no-print-checksums         do not emit MD5 or SHA1 checksums
  77    --archive-suffix=SUF         add SUF to the list of archive suffixes
  78
  79    --help             display this help and exit
  80    --version          output version information and exit
  81
  82 EOF
  83     }
  84   exit $exit_code;
  85 }
  86
  87
  88 =item C<%size> = C<sizes (@file)>
  89
  90 Compute the sizes of the C<@file> and return them as a hash.  Return
  91 C<undef> if one of the computation failed.
  92
  93 =cut
  94
  95 sub sizes (@)
  96 {
  97   my (@file) = @_;
  98
  99   my $fail = 0;
 100   my %res;
 101   foreach my $f (@file)
 102     {
 103       my $cmd = "du --human $f";
 104       my $t = `$cmd`;
 105       # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
 106       $@
 107         and (warn "$ME: command failed: `$cmd'\n"), $fail = 1;
 108       chomp $t;
 109       $t =~ s/^([\d.]+[MkK]).*/${1}B/;
 110       $res{$f} = $t;
 111     }
 112   return $fail ? undef : %res;
 113 }
 114
 115 =item C<print_locations ($title, \@url, \%size, @file)
 116
 117 Print a section C<$title> dedicated to the list of <@file>, which
 118 sizes are stored in C<%size>, and which are available from the C<@url>.
 119
 120 =cut
 121
 122 sub print_locations ($\@\%@)
 123 {
 124   my ($title, $url, $size, @file) = @_;
 125   print "Here are the $title:\n";
 126   foreach my $url (@{$url})
 127     {
 128       for my $file (@file)
 129         {
 130           print "  $url/$file";
 131           print "   (", $$size{$file}, ")"
 132             if exists $$size{$file};
 133           print "\n";
 134         }
 135     }
 136   print "\n";
 137 }
 138
 139 =item C<print_checksums (@file)
 140
 141 Print the MD5 and SHA1 signature section for each C<@file>.
 142
 143 =cut
 144
 145 sub print_checksums (@)
 146 {
 147   my (@file) = @_;
 148
 149   print "Here are the MD5 and SHA1 checksums:\n";
 150   print "\n";
 151
 152   foreach my $meth (qw (md5 sha1))
 153     {
 154       foreach my $f (@file)
 155         {
 156           open IN, '<', $f
 157             or die "$ME: $f: cannot open for reading: $!\n";
 158           binmode IN;
 159           my $dig =
 160             ($meth eq 'md5'
 161              ? Digest::MD5->new->addfile(*IN)->hexdigest
 162              : Digest::SHA1->new->addfile(*IN)->hexdigest);
 163           close IN;
 164           print "$dig  $f\n";
 165         }
 166     }
 167   print "\n";
 168 }
 169
 170 =item C<print_news_deltas ($news_file, $prev_version, $curr_version)
 171
 172 Print the section of the NEWS file C<$news_file> addressing changes
 173 between versions C<$prev_version> and C<$curr_version>.
 174
 175 =cut
 176
 177 sub print_news_deltas ($$$)
 178 {
 179   my ($news_file, $prev_version, $curr_version) = @_;
 180
 181   print "\n$news_file\n\n";
 182
 183   # Print all lines from $news_file, starting with the first one
 184   # that mentions $curr_version up to but not including
 185   # the first occurrence of $prev_version.
 186   my $in_items;
 187
 188   my $re_prefix = qr/(?:\* )?(?:Noteworthy c|Major c|C)(?i:hanges)/;
 189
 190   open NEWS, '<', $news_file
 191     or die "$ME: $news_file: cannot open for reading: $!\n";
 192   while (defined (my $line = <NEWS>))
 193     {
 194       if ( ! $in_items)
 195         {
 196           # Match lines like these:
 197           # * Major changes in release 5.0.1:
 198           # * Noteworthy changes in release 6.6 (2006-11-22) [stable]
 199           $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$curr_version\E(?:[^\d.]|$)/o
 200             or next;
 201           $in_items = 1;
 202           print $line;
 203         }
 204       else
 205         {
 206           # This regexp must not match version numbers in NEWS items.
 207           # For example, they might well say `introduced in 4.5.5',
 208           # and we don't want that to match.
 209           $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$prev_version\E(?:[^\d.]|$)/o
 210             and last;
 211           print $line;
 212         }
 213     }
 214   close NEWS;
 215
 216   $in_items
 217     or die "$ME: $news_file: no matching lines for `$curr_version'\n";
 218 }
 219
 220 sub print_changelog_deltas ($$)
 221 {
 222   my ($package_name, $prev_version) = @_;
 223
 224   # Print new ChangeLog entries.
 225
 226   # First find all CVS-controlled ChangeLog files.
 227   use File::Find;
 228   my @changelog;
 229   find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS'
 230                           and push @changelog, $File::Find::name}},
 231         '.');
 232
 233   # If there are no ChangeLog files, we're done.
 234   @changelog
 235     or return;
 236   my %changelog = map {$_ => 1} @changelog;
 237
 238   # Reorder the list of files so that if there are ChangeLog
 239   # files in the specified directories, they're listed first,
 240   # in this order:
 241   my @dir = qw ( . src lib m4 config doc );
 242
 243   # A typical @changelog array might look like this:
 244   # ./ChangeLog
 245   # ./po/ChangeLog
 246   # ./m4/ChangeLog
 247   # ./lib/ChangeLog
 248   # ./doc/ChangeLog
 249   # ./config/ChangeLog
 250   my @reordered;
 251   foreach my $d (@dir)
 252     {
 253       my $dot_slash = $d eq '.' ? $d : "./$d";
 254       my $target = "$dot_slash/ChangeLog";
 255       delete $changelog{$target}
 256         and push @reordered, $target;
 257     }
 258
 259   # Append any remaining ChangeLog files.
 260   push @reordered, sort keys %changelog;
 261
 262   # Remove leading `./'.
 263   @reordered = map { s!^\./!!; $_ } @reordered;
 264
 265   print "\nChangeLog entries:\n\n";
 266   # print join ("\n", @reordered), "\n";
 267
 268   $prev_version =~ s/\./_/g;
 269   my $prev_cvs_tag = "\U$package_name\E-$prev_version";
 270
 271   my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered";
 272   open DIFF, '-|', $cmd
 273     or die "$ME: cannot run `$cmd': $!\n";
 274   # Print two types of lines, making minor changes:
 275   # Lines starting with `+++ ', e.g.,
 276   # +++ ChangeLog   22 Feb 2003 16:52:51 -0000      1.247
 277   # and those starting with `+'.
 278   # Don't print the others.
 279   my $prev_printed_line_empty = 1;
 280   while (defined (my $line = <DIFF>))
 281     {
 282       if ($line =~ /^\+\+\+ /)
 283         {
 284           my $separator = "*"x70 ."\n";
 285           $line =~ s///;
 286           $line =~ s/\s.*//;
 287           $prev_printed_line_empty
 288             or print "\n";
 289           print $separator, $line, $separator;
 290         }
 291       elsif ($line =~ /^\+/)
 292         {
 293           $line =~ s///;
 294           print $line;
 295           $prev_printed_line_empty = ($line =~ /^$/);
 296         }
 297     }
 298   close DIFF;
 299
 300   # The exit code should be 1.
 301   # Allow in case there are no modified ChangeLog entries.
 302   $? == 256 || $? == 128
 303     or warn "$ME: warning: `cmd' had unexpected exit code or signal ($?)\n";
 304 }
 305
 306 sub get_tool_versions ($$)
 307 {
 308   my ($tool_list, $gnulib_version) = @_;
 309   @$tool_list
 310     or return ();
 311
 312   my $fail;
 313   my @tool_version_pair;
 314   foreach my $t (@$tool_list)
 315     {
 316       if ($t eq 'gnulib')
 317         {
 318           push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version;
 319           next;
 320         }
 321       # Assume that the last "word" on the first line of
 322       # `tool --version` output is the version string.
 323       my ($first_line, undef) = split ("\n", `$t --version`);
 324       if ($first_line =~ /.* (\d[\w.-]+)$/)
 325         {
 326           $t = ucfirst $t;
 327           push @tool_version_pair, "$t $1";
 328         }
 329       else
 330         {
 331           defined $first_line
 332             and $first_line = '';
 333           warn "$ME: $t: unexpected --version output\n:$first_line";
 334           $fail = 1;
 335         }
 336     }
 337
 338   $fail
 339     and exit 1;
 340
 341   return @tool_version_pair;
 342 }
 343
 344 {
 345   # Neutralize the locale, so that, for instance, "du" does not
 346   # issue "1,2" instead of "1.2", what confuses our regexps.
 347   $ENV{LC_ALL} = "C";
 348
 349   my $release_type;
 350   my $package_name;
 351   my $prev_version;
 352   my $curr_version;
 353   my $gpg_key_id;
 354   my @url_dir_list;
 355   my @news_file;
 356   my $bootstrap_tools;
 357   my $gnulib_version;
 358   my $print_checksums_p = 1;
 359
 360   GetOptions
 361     (
 362      'release-type=s'     => \$release_type,
 363      'package-name=s'     => \$package_name,
 364      'previous-version=s' => \$prev_version,
 365      'current-version=s'  => \$curr_version,
 366      'gpg-key-id=s'       => \$gpg_key_id,
 367      'url-directory=s'    => \@url_dir_list,
 368      'news=s'             => \@news_file,
 369      'bootstrap-tools=s'  => \$bootstrap_tools,
 370      'gnulib-version=s'   => \$gnulib_version,
 371      'print-checksums!'   => \$print_checksums_p,
 372      'archive-suffix=s'   => \@archive_suffixes,
 373
 374      help => sub { usage 0 },
 375      version => sub { print "$ME version $VERSION\n"; exit },
 376     ) or usage 1;
 377
 378   my $fail = 0;
 379   # Ensure that sure each required option is specified.
 380   $release_type
 381     or (warn "$ME: release type not specified\n"), $fail = 1;
 382   $package_name
 383     or (warn "$ME: package name not specified\n"), $fail = 1;
 384   $prev_version
 385     or (warn "$ME: previous version string not specified\n"), $fail = 1;
 386   $curr_version
 387     or (warn "$ME: current version string not specified\n"), $fail = 1;
 388   $gpg_key_id
 389     or (warn "$ME: GnuPG key ID not specified\n"), $fail = 1;
 390   @url_dir_list
 391     or (warn "$ME: URL directory name(s) not specified\n"), $fail = 1;
 392
 393   my @tool_list = split ',', $bootstrap_tools;
 394
 395   grep (/^gnulib$/, @tool_list) ^ defined $gnulib_version
 396     and (warn "$ME: when specifying gnulib as a tool, you must also specify\n"
 397         . "--gnulib-version=V, where V is the result of running git describe\n"
 398         . "in the gnulib source directory.\n"), $fail = 1;
 399
 400   exists $valid_release_types{$release_type}
 401     or (warn "$ME: `$release_type': invalid release type\n"), $fail = 1;
 402
 403   @ARGV
 404     and (warn "$ME: too many arguments:\n", join ("\n", @ARGV), "\n"),
 405       $fail = 1;
 406   $fail
 407     and usage 1;
 408
 409   my $my_distdir = "$package_name-$curr_version";
 410
 411   my $xd = "$package_name-$prev_version-$curr_version.xdelta";
 412
 413   my @candidates = map { "$my_distdir.$_" } @archive_suffixes;
 414   my @tarballs = grep {-f $_} @candidates;
 415
 416   @tarballs
 417     or die "$ME: none of " . join(', ', @candidates) . " were found\n";
 418   my @sizable = @tarballs;
 419   -f $xd
 420     and push @sizable, $xd;
 421   my %size = sizes (@sizable);
 422   %size
 423     or exit 1;
 424
 425   # The markup is escaped as <\# so that when this script is sent by
 426   # mail (or part of a diff), Gnus is not triggered.
 427   print <<EOF;
 428
 429 Subject: $my_distdir released [$release_type]
 430
 431 <\#secure method=pgpmime mode=sign>
 432
 433 FIXME: put comments here
 434
 435 EOF
 436
 437   print_locations ("compressed sources", @url_dir_list, %size, @tarballs);
 438   -f $xd
 439     and print_locations ("xdelta diffs (useful? if so, "
 440                          . "please tell bug-gnulib\@gnu.org)",
 441                          @url_dir_list, %size, $xd);
 442   my @sig_files = map { "$_.sig" } @tarballs;
 443   print_locations ("GPG detached signatures[*]", @url_dir_list, %size,
 444                    @sig_files);
 445
 446   $print_checksums_p
 447     and print_checksums (@sizable);
 448
 449   print <<EOF;
 450 [*] You can use either of the above signature files to verify that
 451 the corresponding file (without the .sig suffix) is intact.  First,
 452 be sure to download both the .sig file and the corresponding tarball.
 453 Then, run a command like this:
 454
 455   gpg --verify $tarballs[0].sig
 456
 457 If that command fails because you don't have the required public key,
 458 then run this command to import it:
 459
 460   gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_id
 461
 462 and rerun the \`gpg --verify' command.
 463 EOF
 464
 465   my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);
 466   @tool_versions
 467     and print "\nThis release was bootstrapped with the following tools:",
 468       join ('', map {"\n  $_"} @tool_versions), "\n";
 469
 470   print_news_deltas ($_, $prev_version, $curr_version)
 471     foreach @news_file;
 472
 473   $release_type eq 'stable'
 474     or print_changelog_deltas ($package_name, $prev_version);
 475
 476   exit 0;
 477 }
 478
 479 ### Setup "GNU" style for perl-mode and cperl-mode.
 480 ## Local Variables:
 481 ## mode: perl
 482 ## perl-indent-level: 2
 483 ## perl-continued-statement-offset: 2
 484 ## perl-continued-brace-offset: 0
 485 ## perl-brace-offset: 0
 486 ## perl-brace-imaginary-offset: 0
 487 ## perl-label-offset: -2
 488 ## perl-extra-newline-before-brace: t
 489 ## perl-merge-trailing-else: nil
 490 ## eval: (add-hook 'write-file-hooks 'time-stamp)
 491 ## time-stamp-start: "my $VERSION = '"
 492 ## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
 493 ## time-stamp-time-zone: "UTC"
 494 ## time-stamp-end: "'; # UTC"
 495 ## End: