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-11-09 21:30'; # 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   my $found_news;
 196   open NEWS, '<', $news_file
 197     or die "$ME: $news_file: cannot open for reading: $!\n";
 198   while (defined (my $line = <NEWS>))
 199     {
 200       if ( ! $in_items)
 201         {
 202           # Match lines like these:
 203           # * Major changes in release 5.0.1:
 204           # * Noteworthy changes in release 6.6 (2006-11-22) [stable]
 205           $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$curr_version\E(?:[^\d.]|$)/o
 206             or next;
 207           $in_items = 1;
 208           print $line;
 209         }
 210       else
 211         {
 212           # This regexp must not match version numbers in NEWS items.
 213           # For example, they might well say `introduced in 4.5.5',
 214           # and we don't want that to match.
 215           $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$prev_version\E(?:[^\d.]|$)/o
 216             and last;
 217           print $line;
 218           $line =~ /\S/
 219             and $found_news = 1;
 220         }
 221     }
 222   close NEWS;
 223
 224   $in_items
 225     or die "$ME: $news_file: no matching lines for `$curr_version'\n";
 226   $found_news
 227     or die "$ME: $news_file: no news item found for `$curr_version'\n";
 228 }
 229
 230 sub print_changelog_deltas ($$)
 231 {
 232   my ($package_name, $prev_version) = @_;
 233
 234   # Print new ChangeLog entries.
 235
 236   # First find all CVS-controlled ChangeLog files.
 237   use File::Find;
 238   my @changelog;
 239   find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS'
 240                           and push @changelog, $File::Find::name}},
 241         '.');
 242
 243   # If there are no ChangeLog files, we're done.
 244   @changelog
 245     or return;
 246   my %changelog = map {$_ => 1} @changelog;
 247
 248   # Reorder the list of files so that if there are ChangeLog
 249   # files in the specified directories, they're listed first,
 250   # in this order:
 251   my @dir = qw ( . src lib m4 config doc );
 252
 253   # A typical @changelog array might look like this:
 254   # ./ChangeLog
 255   # ./po/ChangeLog
 256   # ./m4/ChangeLog
 257   # ./lib/ChangeLog
 258   # ./doc/ChangeLog
 259   # ./config/ChangeLog
 260   my @reordered;
 261   foreach my $d (@dir)
 262     {
 263       my $dot_slash = $d eq '.' ? $d : "./$d";
 264       my $target = "$dot_slash/ChangeLog";
 265       delete $changelog{$target}
 266         and push @reordered, $target;
 267     }
 268
 269   # Append any remaining ChangeLog files.
 270   push @reordered, sort keys %changelog;
 271
 272   # Remove leading `./'.
 273   @reordered = map { s!^\./!!; $_ } @reordered;
 274
 275   print "\nChangeLog entries:\n\n";
 276   # print join ("\n", @reordered), "\n";
 277
 278   $prev_version =~ s/\./_/g;
 279   my $prev_cvs_tag = "\U$package_name\E-$prev_version";
 280
 281   my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered";
 282   open DIFF, '-|', $cmd
 283     or die "$ME: cannot run `$cmd': $!\n";
 284   # Print two types of lines, making minor changes:
 285   # Lines starting with `+++ ', e.g.,
 286   # +++ ChangeLog   22 Feb 2003 16:52:51 -0000      1.247
 287   # and those starting with `+'.
 288   # Don't print the others.
 289   my $prev_printed_line_empty = 1;
 290   while (defined (my $line = <DIFF>))
 291     {
 292       if ($line =~ /^\+\+\+ /)
 293         {
 294           my $separator = "*"x70 ."\n";
 295           $line =~ s///;
 296           $line =~ s/\s.*//;
 297           $prev_printed_line_empty
 298             or print "\n";
 299           print $separator, $line, $separator;
 300         }
 301       elsif ($line =~ /^\+/)
 302         {
 303           $line =~ s///;
 304           print $line;
 305           $prev_printed_line_empty = ($line =~ /^$/);
 306         }
 307     }
 308   close DIFF;
 309
 310   # The exit code should be 1.
 311   # Allow in case there are no modified ChangeLog entries.
 312   $? == 256 || $? == 128
 313     or warn "$ME: warning: `cmd' had unexpected exit code or signal ($?)\n";
 314 }
 315
 316 sub get_tool_versions ($$)
 317 {
 318   my ($tool_list, $gnulib_version) = @_;
 319   @$tool_list
 320     or return ();
 321
 322   my $fail;
 323   my @tool_version_pair;
 324   foreach my $t (@$tool_list)
 325     {
 326       if ($t eq 'gnulib')
 327         {
 328           push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version;
 329           next;
 330         }
 331       # Assume that the last "word" on the first line of
 332       # `tool --version` output is the version string.
 333       my ($first_line, undef) = split ("\n", `$t --version`);
 334       if ($first_line =~ /.* (\d[\w.-]+)$/)
 335         {
 336           $t = ucfirst $t;
 337           push @tool_version_pair, "$t $1";
 338         }
 339       else
 340         {
 341           defined $first_line
 342             and $first_line = '';
 343           warn "$ME: $t: unexpected --version output\n:$first_line";
 344           $fail = 1;
 345         }
 346     }
 347
 348   $fail
 349     and exit 1;
 350
 351   return @tool_version_pair;
 352 }
 353
 354 {
 355   # Neutralize the locale, so that, for instance, "du" does not
 356   # issue "1,2" instead of "1.2", what confuses our regexps.
 357   $ENV{LC_ALL} = "C";
 358
 359   my $mail_headers;
 360   my $release_type;
 361   my $package_name;
 362   my $prev_version;
 363   my $curr_version;
 364   my $gpg_key_id;
 365   my @url_dir_list;
 366   my @news_file;
 367   my $bootstrap_tools;
 368   my $gnulib_version;
 369   my $print_checksums_p = 1;
 370
 371   GetOptions
 372     (
 373      'mail-headers=s'     => \$mail_headers,
 374      'release-type=s'     => \$release_type,
 375      'package-name=s'     => \$package_name,
 376      'previous-version=s' => \$prev_version,
 377      'current-version=s'  => \$curr_version,
 378      'gpg-key-id=s'       => \$gpg_key_id,
 379      'url-directory=s'    => \@url_dir_list,
 380      'news=s'             => \@news_file,
 381      'bootstrap-tools=s'  => \$bootstrap_tools,
 382      'gnulib-version=s'   => \$gnulib_version,
 383      'print-checksums!'   => \$print_checksums_p,
 384      'archive-suffix=s'   => \@archive_suffixes,
 385
 386      help => sub { usage 0 },
 387      version => sub { print "$ME version $VERSION\n"; exit },
 388     ) or usage 1;
 389
 390   my $fail = 0;
 391   # Ensure that sure each required option is specified.
 392   $release_type
 393     or (warn "$ME: release type not specified\n"), $fail = 1;
 394   $package_name
 395     or (warn "$ME: package name not specified\n"), $fail = 1;
 396   $prev_version
 397     or (warn "$ME: previous version string not specified\n"), $fail = 1;
 398   $curr_version
 399     or (warn "$ME: current version string not specified\n"), $fail = 1;
 400   $gpg_key_id
 401     or (warn "$ME: GnuPG key ID not specified\n"), $fail = 1;
 402   @url_dir_list
 403     or (warn "$ME: URL directory name(s) not specified\n"), $fail = 1;
 404
 405   my @tool_list = split ',', $bootstrap_tools;
 406
 407   grep (/^gnulib$/, @tool_list) ^ defined $gnulib_version
 408     and (warn "$ME: when specifying gnulib as a tool, you must also specify\n"
 409         . "--gnulib-version=V, where V is the result of running git describe\n"
 410         . "in the gnulib source directory.\n"), $fail = 1;
 411
 412   exists $valid_release_types{$release_type}
 413     or (warn "$ME: `$release_type': invalid release type\n"), $fail = 1;
 414
 415   @ARGV
 416     and (warn "$ME: too many arguments:\n", join ("\n", @ARGV), "\n"),
 417       $fail = 1;
 418   $fail
 419     and usage 1;
 420
 421   my $my_distdir = "$package_name-$curr_version";
 422
 423   my $xd = "$package_name-$prev_version-$curr_version.xdelta";
 424
 425   my @candidates = map { "$my_distdir.$_" } @archive_suffixes;
 426   my @tarballs = grep {-f $_} @candidates;
 427
 428   @tarballs
 429     or die "$ME: none of " . join(', ', @candidates) . " were found\n";
 430   my @sizable = @tarballs;
 431   -f $xd
 432     and push @sizable, $xd;
 433   my %size = sizes (@sizable);
 434   %size
 435     or exit 1;
 436
 437   my $headers = '';
 438   if (defined $mail_headers)
 439     {
 440       ($headers = $mail_headers) =~ s/\s+(\S+:)/\n$1/g;
 441       $headers .= "\n";
 442     }
 443
 444   # The markup is escaped as <\# so that when this script is sent by
 445   # mail (or part of a diff), Gnus is not triggered.
 446   print <<EOF;
 447
 448 ${headers}Subject: $my_distdir released [$release_type]
 449
 450 <\#secure method=pgpmime mode=sign>
 451
 452 FIXME: put comments here
 453
 454 EOF
 455
 456   if (@url_dir_list == 1 && @tarballs == 1)
 457     {
 458       # When there's only one tarball and one URL, use a more concise form.
 459       my $m = "$url_dir_list[0]/$tarballs[0]";
 460       print "Here are the compressed sources and a GPG detached signature[*]:\n"
 461         . "  $m\n"
 462         . "  $m.sig\n\n";
 463     }
 464   else
 465     {
 466       print_locations ("compressed sources", @url_dir_list, %size, @tarballs);
 467       -f $xd
 468         and print_locations ("xdelta diffs (useful? if so, "
 469                              . "please tell bug-gnulib\@gnu.org)",
 470                              @url_dir_list, %size, $xd);
 471       my @sig_files = map { "$_.sig" } @tarballs;
 472       print_locations ("GPG detached signatures[*]", @url_dir_list, %size,
 473                        @sig_files);
 474     }
 475
 476   if ($url_dir_list[0] =~ "gnu\.org")
 477     {
 478       print "Use a mirror for higher download bandwidth:\n";
 479       if (@tarballs == 1 && $url_dir_list[0] =~ m!http://ftp\.gnu\.org/gnu/!)
 480         {
 481           (my $m = "$url_dir_list[0]/$tarballs[0]")
 482             =~ s!http://ftp\.gnu\.org/gnu/!http://ftpmirror\.gnu\.org/!;
 483           print "  $m\n"
 484               . "  $m.sig\n\n";
 485
 486         }
 487       else
 488         {
 489           print "  http://www.gnu.org/order/ftp.html\n\n";
 490         }
 491     }
 492
 493   $print_checksums_p
 494     and print_checksums (@sizable);
 495
 496   print <<EOF;
 497 [*] Use a .sig file to verify that the corresponding file (without the
 498 .sig suffix) is intact.  First, be sure to download both the .sig file
 499 and the corresponding tarball.  Then, run a command like this:
 500
 501   gpg --verify $tarballs[0].sig
 502
 503 If that command fails because you don't have the required public key,
 504 then run this command to import it:
 505
 506   gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_id
 507
 508 and rerun the \`gpg --verify' command.
 509 EOF
 510
 511   my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);
 512   @tool_versions
 513     and print "\nThis release was bootstrapped with the following tools:",
 514       join ('', map {"\n  $_"} @tool_versions), "\n";
 515
 516   print_news_deltas ($_, $prev_version, $curr_version)
 517     foreach @news_file;
 518
 519   $release_type eq 'stable'
 520     or print_changelog_deltas ($package_name, $prev_version);
 521
 522   exit 0;
 523 }
 524
 525 ### Setup "GNU" style for perl-mode and cperl-mode.
 526 ## Local Variables:
 527 ## mode: perl
 528 ## perl-indent-level: 2
 529 ## perl-continued-statement-offset: 2
 530 ## perl-continued-brace-offset: 0
 531 ## perl-brace-offset: 0
 532 ## perl-brace-imaginary-offset: 0
 533 ## perl-label-offset: -2
 534 ## perl-extra-newline-before-brace: t
 535 ## perl-merge-trailing-else: nil
 536 ## eval: (add-hook 'write-file-hooks 'time-stamp)
 537 ## time-stamp-start: "my $VERSION = '"
 538 ## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
 539 ## time-stamp-time-zone: "UTC"
 540 ## time-stamp-end: "'; # UTC"
 541 ## End: