build-aux/announce-gen

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