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