build-aux/announce-gen

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