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