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