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