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