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