sjero.net Git - wget/blob - build-aux/announce-gen

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