devspec.en_US/project/recutils/build-aux/announce-gen

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