build-aux/announce-gen

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