build-aux/announce-gen

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