build-aux/announce-gen

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