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-05-23 08:55'; # 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 -h $f";
 107       my $t = `$cmd`;
 108       # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
 109       $@
 110         and (warn "command failed: '$cmd'\n"), $fail = 1;
 111       chomp $t;
 112       $t =~ s/^\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 "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 "$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   # Reformat the warnings before displaying them.
 373   local $SIG{__WARN__} = sub
 374     {
 375       my ($msg) = @_;
 376       # Warnings from GetOptions.
 377       $msg =~ s/Option (\w)/option --$1/;
 378       warn "$ME: $msg";
 379     };
 380
 381   GetOptions
 382     (
 383      'mail-headers=s'     => \$mail_headers,
 384      'release-type=s'     => \$release_type,
 385      'package-name=s'     => \$package_name,
 386      'previous-version=s' => \$prev_version,
 387      'current-version=s'  => \$curr_version,
 388      'gpg-key-id=s'       => \$gpg_key_id,
 389      'url-directory=s'    => \@url_dir_list,
 390      'news=s'             => \@news_file,
 391      'bootstrap-tools=s'  => \$bootstrap_tools,
 392      'gnulib-version=s'   => \$gnulib_version,
 393      'print-checksums!'   => \$print_checksums_p,
 394      'archive-suffix=s'   => \@archive_suffixes,
 395
 396      help => sub { usage 0 },
 397      version => sub { print "$ME version $VERSION\n"; exit },
 398     ) or usage 1;
 399
 400   my $fail = 0;
 401   # Ensure that each required option is specified.
 402   $release_type
 403     or (warn "release type not specified\n"), $fail = 1;
 404   $package_name
 405     or (warn "package name not specified\n"), $fail = 1;
 406   $prev_version
 407     or (warn "previous version string not specified\n"), $fail = 1;
 408   $curr_version
 409     or (warn "current version string not specified\n"), $fail = 1;
 410   $gpg_key_id
 411     or (warn "GnuPG key ID not specified\n"), $fail = 1;
 412   @url_dir_list
 413     or (warn "URL directory name(s) not specified\n"), $fail = 1;
 414
 415   my @tool_list = split ',', $bootstrap_tools;
 416
 417   grep (/^gnulib$/, @tool_list) ^ defined $gnulib_version
 418     and (warn "when specifying gnulib as a tool, you must also specify\n"
 419         . "--gnulib-version=V, where V is the result of running git describe\n"
 420         . "in the gnulib source directory.\n"), $fail = 1;
 421
 422   exists $valid_release_types{$release_type}
 423     or (warn "'$release_type': invalid release type\n"), $fail = 1;
 424
 425   @ARGV
 426     and (warn "too many arguments:\n", join ("\n", @ARGV), "\n"),
 427       $fail = 1;
 428   $fail
 429     and usage 1;
 430
 431   my $my_distdir = "$package_name-$curr_version";
 432
 433   my $xd = "$package_name-$prev_version-$curr_version.xdelta";
 434
 435   my @candidates = map { "$my_distdir.$_" } @archive_suffixes;
 436   my @tarballs = grep {-f $_} @candidates;
 437
 438   @tarballs
 439     or die "$ME: none of " . join(', ', @candidates) . " were found\n";
 440   my @sizable = @tarballs;
 441   -f $xd
 442     and push @sizable, $xd;
 443   my %size = sizes (@sizable);
 444   %size
 445     or exit 1;
 446
 447   my $headers = '';
 448   if (defined $mail_headers)
 449     {
 450       ($headers = $mail_headers) =~ s/\s+(\S+:)/\n$1/g;
 451       $headers .= "\n";
 452     }
 453
 454   # The markup is escaped as <\# so that when this script is sent by
 455   # mail (or part of a diff), Gnus is not triggered.
 456   print <<EOF;
 457
 458 ${headers}Subject: $my_distdir released [$release_type]
 459
 460 <\#secure method=pgpmime mode=sign>
 461
 462 FIXME: put comments here
 463
 464 EOF
 465
 466   if (@url_dir_list == 1 && @tarballs == 1)
 467     {
 468       # When there's only one tarball and one URL, use a more concise form.
 469       my $m = "$url_dir_list[0]/$tarballs[0]";
 470       print "Here are the compressed sources and a GPG detached signature[*]:\n"
 471         . "  $m\n"
 472         . "  $m.sig\n\n";
 473     }
 474   else
 475     {
 476       print_locations ("compressed sources", @url_dir_list, %size, @tarballs);
 477       -f $xd
 478         and print_locations ("xdelta diffs (useful? if so, "
 479                              . "please tell bug-gnulib\@gnu.org)",
 480                              @url_dir_list, %size, $xd);
 481       my @sig_files = map { "$_.sig" } @tarballs;
 482       print_locations ("GPG detached signatures[*]", @url_dir_list, %size,
 483                        @sig_files);
 484     }
 485
 486   if ($url_dir_list[0] =~ "gnu\.org")
 487     {
 488       print "Use a mirror for higher download bandwidth:\n";
 489       if (@tarballs == 1 && $url_dir_list[0] =~ m!http://ftp\.gnu\.org/gnu/!)
 490         {
 491           (my $m = "$url_dir_list[0]/$tarballs[0]")
 492             =~ s!http://ftp\.gnu\.org/gnu/!http://ftpmirror\.gnu\.org/!;
 493           print "  $m\n"
 494               . "  $m.sig\n\n";
 495
 496         }
 497       else
 498         {
 499           print "  http://www.gnu.org/order/ftp.html\n\n";
 500         }
 501     }
 502
 503   $print_checksums_p
 504     and print_checksums (@sizable);
 505
 506   print <<EOF;
 507 [*] Use a .sig file to verify that the corresponding file (without the
 508 .sig suffix) is intact.  First, be sure to download both the .sig file
 509 and the corresponding tarball.  Then, run a command like this:
 510
 511   gpg --verify $tarballs[0].sig
 512
 513 If that command fails because you don't have the required public key,
 514 then run this command to import it:
 515
 516   gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_id
 517
 518 and rerun the 'gpg --verify' command.
 519 EOF
 520
 521   my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);
 522   @tool_versions
 523     and print "\nThis release was bootstrapped with the following tools:",
 524       join ('', map {"\n  $_"} @tool_versions), "\n";
 525
 526   print_news_deltas ($_, $prev_version, $curr_version)
 527     foreach @news_file;
 528
 529   $release_type eq 'stable'
 530     or print_changelog_deltas ($package_name, $prev_version);
 531
 532   exit 0;
 533 }
 534
 535 ### Setup "GNU" style for perl-mode and cperl-mode.
 536 ## Local Variables:
 537 ## mode: perl
 538 ## perl-indent-level: 2
 539 ## perl-continued-statement-offset: 2
 540 ## perl-continued-brace-offset: 0
 541 ## perl-brace-offset: 0
 542 ## perl-brace-imaginary-offset: 0
 543 ## perl-label-offset: -2
 544 ## perl-extra-newline-before-brace: t
 545 ## perl-merge-trailing-else: nil
 546 ## eval: (add-hook 'write-file-hooks 'time-stamp)
 547 ## time-stamp-start: "my $VERSION = '"
 548 ## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
 549 ## time-stamp-time-zone: "UTC"
 550 ## time-stamp-end: "'; # UTC"
 551 ## End: