pthread-cond: Fix compilation error on native Windows.
[gnulib.git] / build-aux / announce-gen
blob9728aeee9e7b66bc42a16d801b832ee2888e3df6
1 #!/bin/sh
2 #! -*-perl-*-
4 # Generate a release announcement message.
6 # Copyright (C) 2002-2024 Free Software Foundation, Inc.
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.
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.
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/>.
21 # Written by Jim Meyering
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;
38 my $VERSION = '2024-07-04 10:55'; # 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.
44 my $copyright_year = '2022';
46 use strict;
47 use Getopt::Long;
48 use POSIX qw(strftime);
50 (my $ME = $0) =~ s|.*/||;
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 $srcdir = '.';
56 sub usage ($)
58 my ($exit_code) = @_;
59 my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
60 if ($exit_code != 0)
62 print $STREAM "Try '$ME --help' for more information.\n";
64 else
66 my @types = sort keys %valid_release_types;
67 print $STREAM <<EOF;
68 Usage: $ME [OPTIONS]
69 Generate an announcement message. Run this from builddir.
71 OPTIONS:
73 These options must be specified:
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
82 The following are optional:
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 --gpg-key-email=EMAIL The email address of the key used to
94 sign the tarballs
95 --gpg-keyring-url=URL URL pointing to keyring containing the key used
96 to sign the tarballs
97 --no-print-checksums do not emit SHA1 or SHA256 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,...
102 --help display this help and exit
103 --version output version information and exit
107 exit $exit_code;
111 =item C<%size> = C<sizes (@file)>
113 Compute the sizes of the C<@file> and return them as a hash. Return
114 C<undef> if one of the computation failed.
116 =cut
118 sub sizes (@)
120 my (@file) = @_;
122 my $fail = 0;
123 my %res;
124 foreach my $f (@file)
126 my $cmd = "du -h $f";
127 my $t = `$cmd`;
128 # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
130 and (warn "command failed: '$cmd'\n"), $fail = 1;
131 chomp $t;
132 $t =~ s/^\s*([\d.]+[MkK]).*/${1}B/;
133 $res{$f} = $t;
135 return $fail ? undef : %res;
138 =item C<print_locations ($title, \@url, \%size, @file)
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>.
143 =cut
145 sub print_locations ($\@\%@)
147 my ($title, $url, $size, @file) = @_;
148 print "Here are the $title:\n";
149 foreach my $url (@{$url})
151 for my $file (@file)
153 print " $url/$file";
154 print " (", $$size{$file}, ")"
155 if exists $$size{$file};
156 print "\n";
159 print "\n";
162 =item C<print_checksums (@file)
164 Print the SHA1 and SHA256 signature section for each C<@file>.
166 =cut
168 # This digest function omits the "=" padding that is required by cksum,
169 # so add the 0..2 bytes of padding required for each of Digest's algorithms.
170 sub digest_file_base64_wrap ($$)
172 my ($file, $alg) = @_;
173 my $h = digest_file_base64($file, $alg);
174 $alg =~ tr{-}{}d;
175 my %pad = (MD5 => 2, SHA1 => 1, SHA256 => 1, SHA384 => 0, SHA512 => 2);
176 return $h . '=' x $pad{$alg};
179 sub print_checksums (@)
181 my (@file) = @_;
183 print "Here are the SHA1 and SHA256 checksums:\n";
184 print "\n";
186 use Digest::file qw(digest_file_hex digest_file_base64);
188 foreach my $f (@file)
190 print ' ', digest_file_hex ($f, "SHA-1"), " $f\n";
191 print ' ', digest_file_base64_wrap ($f, "SHA-256"), " $f\n";
193 print "\nVerify the base64 SHA256 checksum with cksum -a sha256 --check\n";
194 print "from coreutils-9.2 or OpenBSD's cksum since 2007.\n\n";
197 =item C<print_news_deltas ($news_file, $prev_version, $curr_version)
199 Print the section of the NEWS file C<$news_file> addressing changes
200 between versions C<$prev_version> and C<$curr_version>.
202 =cut
204 sub print_news_deltas ($$$)
206 my ($news_file, $prev_version, $curr_version) = @_;
208 my $news_name = $news_file;
209 $news_name =~ s|^\Q$srcdir\E/||;
211 print "\n$news_name\n\n";
213 # Print all lines from $news_file, starting with the first one
214 # that mentions $curr_version up to but not including
215 # the first occurrence of $prev_version.
216 my $in_items;
218 my $re_prefix = qr/(?:\* )?(?:Noteworthy c|Major c|C)(?i:hanges)/;
220 my $found_news;
221 open NEWS, '<', $news_file
222 or die "$ME: $news_file: cannot open for reading: $!\n";
223 while (defined (my $line = <NEWS>))
225 if ( ! $in_items)
227 # Match lines like these:
228 # * Major changes in release 5.0.1:
229 # * Noteworthy changes in release 6.6 (2006-11-22) [stable]
230 $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$curr_version\E(?:[^\d.]|$)/o
231 or next;
232 $in_items = 1;
233 print $line;
235 else
237 # This regexp must not match version numbers in NEWS items.
238 # For example, they might well say "introduced in 4.5.5",
239 # and we don't want that to match.
240 $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$prev_version\E(?:[^\d.]|$)/o
241 and last;
242 print $line;
243 $line =~ /\S/
244 and $found_news = 1;
247 close NEWS;
249 $in_items
250 or die "$ME: $news_file: no matching lines for '$curr_version'\n";
251 $found_news
252 or die "$ME: $news_file: no news item found for '$curr_version'\n";
255 sub print_changelog_deltas ($$)
257 my ($package_name, $prev_version) = @_;
259 # Print new ChangeLog entries.
261 # First find all CVS-controlled ChangeLog files.
262 use File::Find;
263 my @changelog;
264 find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS'
265 and push @changelog, $File::Find::name}},
266 '.');
268 # If there are no ChangeLog files, we're done.
269 @changelog
270 or return;
271 my %changelog = map {$_ => 1} @changelog;
273 # Reorder the list of files so that if there are ChangeLog
274 # files in the specified directories, they're listed first,
275 # in this order:
276 my @dir = qw ( . src lib m4 config doc );
278 # A typical @changelog array might look like this:
279 # ./ChangeLog
280 # ./po/ChangeLog
281 # ./m4/ChangeLog
282 # ./lib/ChangeLog
283 # ./doc/ChangeLog
284 # ./config/ChangeLog
285 my @reordered;
286 foreach my $d (@dir)
288 my $dot_slash = $d eq '.' ? $d : "./$d";
289 my $target = "$dot_slash/ChangeLog";
290 delete $changelog{$target}
291 and push @reordered, $target;
294 # Append any remaining ChangeLog files.
295 push @reordered, sort keys %changelog;
297 # Remove leading './'.
298 @reordered = map { s!^\./!!; $_ } @reordered;
300 print "\nChangeLog entries:\n\n";
301 # print join ("\n", @reordered), "\n";
303 $prev_version =~ s/\./_/g;
304 my $prev_cvs_tag = "\U$package_name\E-$prev_version";
306 my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered";
307 open DIFF, '-|', $cmd
308 or die "$ME: cannot run '$cmd': $!\n";
309 # Print two types of lines, making minor changes:
310 # Lines starting with '+++ ', e.g.,
311 # +++ ChangeLog 22 Feb 2003 16:52:51 -0000 1.247
312 # and those starting with '+'.
313 # Don't print the others.
314 my $prev_printed_line_empty = 1;
315 while (defined (my $line = <DIFF>))
317 if ($line =~ /^\+\+\+ /)
319 my $separator = "*"x70 ."\n";
320 $line =~ s///;
321 $line =~ s/\s.*//;
322 $prev_printed_line_empty
323 or print "\n";
324 print $separator, $line, $separator;
326 elsif ($line =~ /^\+/)
328 $line =~ s///;
329 print $line;
330 $prev_printed_line_empty = ($line =~ /^$/);
333 close DIFF;
335 # The exit code should be 1.
336 # Allow in case there are no modified ChangeLog entries.
337 $? == 256 || $? == 128
338 or warn "warning: '$cmd' had unexpected exit code or signal ($?)\n";
341 sub get_tool_versions ($$)
343 my ($tool_list, $gnulib_version) = @_;
344 @$tool_list
345 or return ();
347 my $fail;
348 my @tool_version_pair;
349 foreach my $t (@$tool_list)
351 if ($t eq 'gnulib')
353 push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version;
354 next;
356 # Assume that the last "word" on the first line of
357 # 'tool --version' output is the version string.
358 my ($first_line, undef) = split ("\n", `$t --version`);
359 if ($first_line =~ /.* (\d[\w.-]+)$/)
361 $t = ucfirst $t;
362 push @tool_version_pair, "$t $1";
364 else
366 defined $first_line
367 and $first_line = '';
368 warn "$t: unexpected --version output\n:$first_line";
369 $fail = 1;
373 $fail
374 and exit 1;
376 return @tool_version_pair;
379 # Print a more human-friendly representation of $SEC seconds.
380 sub readable_interval0($)
382 my $sec = shift;
383 $sec < 60 and return "$sec seconds";
385 my $min = int($sec / 60); $sec %= 60;
386 30 < $sec and $min++;
387 $min < 60 and return "$min minutes";
389 my $hr = int($min / 60); $min %= 60;
390 30 < $min and $hr++;
391 $hr < 24 and return "$hr hours";
393 my $day = int($hr / 24); $hr %= 24;
394 12 < $hr and $day++;
395 $day < 50 and return "$day days";
397 my $wk = int($day / 7); $day %= 7;
398 4 < $day and $wk++;
399 return "$wk weeks";
402 # Convert e.g., "1 weeks", to "1 week".
403 sub readable_interval($)
405 my $interval_str = shift;
406 my $i = readable_interval0 $interval_str;
407 $i =~ m{^1 \w+s$} and chop $i;
408 return $i;
412 # Use the C locale so that, for instance, "du" does not
413 # print "1,2" instead of "1.2", which would confuse our regexps.
414 $ENV{LC_ALL} = "C";
416 my $mail_headers;
417 my $release_type;
418 my $package_name;
419 my $prev_version;
420 my $curr_version;
421 my $gpg_key_id;
422 my @url_dir_list;
423 my @news_file;
424 my $bootstrap_tools;
425 my $gnulib_version;
426 my $print_checksums_p = 1;
427 my $gpg_key_email;
428 my $gpg_keyring_url;
430 # Reformat the warnings before displaying them.
431 local $SIG{__WARN__} = sub
433 my ($msg) = @_;
434 # Warnings from GetOptions.
435 $msg =~ s/Option (\w)/option --$1/;
436 warn "$ME: $msg";
439 GetOptions
441 'mail-headers=s' => \$mail_headers,
442 'release-type=s' => \$release_type,
443 'package-name=s' => \$package_name,
444 'previous-version=s' => \$prev_version,
445 'current-version=s' => \$curr_version,
446 'gpg-key-id=s' => \$gpg_key_id,
447 'gpg-key-email=s' => \$gpg_key_email,
448 'gpg-keyring-url=s' => \$gpg_keyring_url,
449 'url-directory=s' => \@url_dir_list,
450 'news=s' => \@news_file,
451 'srcdir=s' => \$srcdir,
452 'bootstrap-tools=s' => \$bootstrap_tools,
453 'gnulib-version=s' => \$gnulib_version,
454 'print-checksums!' => \$print_checksums_p,
455 'archive-suffix=s' => \@archive_suffixes,
457 help => sub { usage 0 },
458 version =>
461 print "$ME version $VERSION\n";
462 print "Copyright (C) $copyright_year Free Software Foundation, Inc.\n";
463 print "License GPLv3+: GNU GPL version 3 or later <https://gnu.org/licenses/gpl.html>.\n"
464 . "This is free software: you are free to change and redistribute it.\n"
465 . "There is NO WARRANTY, to the extent permitted by law.\n";
466 print "\n";
467 my $author = "Jim Meyering";
468 print "Written by $author.\n";
469 exit
471 ) or usage 1;
473 my $fail = 0;
474 # Ensure that each required option is specified.
475 $release_type
476 or (warn "release type not specified\n"), $fail = 1;
477 $package_name
478 or (warn "package name not specified\n"), $fail = 1;
479 $prev_version
480 or (warn "previous version string not specified\n"), $fail = 1;
481 $curr_version
482 or (warn "current version string not specified\n"), $fail = 1;
483 $gpg_key_id
484 or (warn "GnuPG key ID not specified\n"), $fail = 1;
485 @url_dir_list
486 or (warn "URL directory name(s) not specified\n"), $fail = 1;
488 my @tool_list = split ',', $bootstrap_tools
489 if $bootstrap_tools;
491 grep (/^gnulib$/, @tool_list) && ! defined $gnulib_version
492 and (warn "when specifying gnulib as a tool, you must also specify\n"
493 . "--gnulib-version=V, where V is the result of running git describe\n"
494 . "in the gnulib source directory.\n"), $fail = 1;
496 ! grep (/^gnulib$/, @tool_list) && defined $gnulib_version
497 and (warn "with --gnulib-version=V you must use --bootstrap-tools=...\n"
498 . "including gnulib in that list"), $fail = 1;
500 !$release_type || exists $valid_release_types{$release_type}
501 or (warn "'$release_type': invalid release type\n"), $fail = 1;
503 @ARGV
504 and (warn "too many arguments:\n", join ("\n", @ARGV), "\n"),
505 $fail = 1;
506 $fail
507 and usage 1;
509 my $my_distdir = "$package_name-$curr_version";
511 my $xd = "$package_name-$prev_version-$curr_version.xdelta";
513 my @candidates = map { "$my_distdir.$_" } @archive_suffixes;
514 my @tarballs = grep {-f $_} @candidates;
516 @tarballs
517 or die "$ME: none of " . join(', ', @candidates) . " were found\n";
518 my @sizable = @tarballs;
519 -f $xd
520 and push @sizable, $xd;
521 my %size = sizes (@sizable);
522 %size
523 or exit 1;
525 my $headers = '';
526 if (defined $mail_headers)
528 ($headers = $mail_headers) =~ s/\s+(\S+:)/\n$1/g;
529 $headers .= "\n";
532 # The markup is escaped as <\# so that when this script is sent by
533 # mail (or part of a diff), Gnus is not triggered.
534 print <<EOF;
536 ${headers}Subject: $my_distdir released [$release_type]
538 <\#secure method=pgpmime mode=sign>
539 This is to announce $package_name-$curr_version, a $release_type release.
541 FIXME: put comments here
545 my $v0 = $prev_version;
546 my $v1 = $curr_version;
548 (my $first_name = `git config user.name|cut -d' ' -f1`)
549 =~ m{\S} or die "no name? set user.name in ~/.gitconfig\n";
551 chomp (my $n_ci = `git rev-list "v$v0..v$v1" | wc -l`);
552 chomp (my $n_p = `git shortlog "v$v0..v$v1" | grep -c '^[^ ]'`);
554 my $prev_release_date = `git log --pretty=%ct -1 "v$v0"`;
555 my $this_release_date = `git log --pretty=%ct -1 "v$v1"`;
556 my $n_seconds = $this_release_date - $prev_release_date;
557 my $time_since_prev = readable_interval $n_seconds;
558 my $names = `git shortlog "v$v0..v$v1"|perl -lne '/^(\\w.*):/ and print " ".\$1'`;
560 print <<EOF;
561 There have been $n_ci commits by $n_p people in the $time_since_prev since $v0.
563 See the NEWS below for a brief summary.
565 Thanks to everyone who has contributed!
566 The following people contributed changes to this release:
568 $names
569 $first_name [on behalf of the $package_name maintainers]
570 ==================================================================
572 Here is the GNU $package_name home page:
573 https://gnu.org/s/$package_name/
575 For a summary of changes and contributors, see:
576 https://git.sv.gnu.org/gitweb/?p=$package_name.git;a=shortlog;h=v$v1
577 or run this command from a git-cloned $package_name directory:
578 git shortlog v$v0..v$v1
582 if (@url_dir_list == 1 && @tarballs == 1)
584 # When there's only one tarball and one URL, use a more concise form.
585 my $m = "$url_dir_list[0]/$tarballs[0]";
586 print "Here are the compressed sources and a GPG detached signature:\n"
587 . " $m\n"
588 . " $m.sig\n\n";
590 else
592 print_locations ("compressed sources", @url_dir_list, %size, @tarballs);
593 -f $xd
594 and print_locations ("xdelta diffs (useful? if so, "
595 . "please tell bug-gnulib\@gnu.org)",
596 @url_dir_list, %size, $xd);
597 my @sig_files = map { "$_.sig" } @tarballs;
598 print_locations ("GPG detached signatures", @url_dir_list, %size,
599 @sig_files);
602 if ($url_dir_list[0] =~ "gnu\.org")
604 print "Use a mirror for higher download bandwidth:\n";
605 if (@tarballs == 1 && $url_dir_list[0] =~ m!https://ftp\.gnu\.org/gnu/!)
607 (my $m = "$url_dir_list[0]/$tarballs[0]")
608 =~ s!https://ftp\.gnu\.org/gnu/!https://ftpmirror\.gnu\.org/!;
609 print " $m\n"
610 . " $m.sig\n\n";
613 else
615 print " https://www.gnu.org/order/ftp.html\n\n";
619 $print_checksums_p
620 and print_checksums (@sizable);
622 print <<EOF;
623 Use a .sig file to verify that the corresponding file (without the
624 .sig suffix) is intact. First, be sure to download both the .sig file
625 and the corresponding tarball. Then, run a command like this:
627 gpg --verify $tarballs[0].sig
630 my $gpg_fingerprint = `LC_ALL=C gpg --fingerprint $gpg_key_id | grep -v ^sub`;
631 if ($gpg_fingerprint =~ /^pub/)
633 chop $gpg_fingerprint;
634 $gpg_fingerprint =~ s/ \[expires:.*//mg;
635 $gpg_fingerprint =~ s/^uid \[ultimate\]/uid /mg;
636 $gpg_fingerprint =~ s/^/ /mg;
637 print<<EOF
638 The signature should match the fingerprint of the following key:
640 $gpg_fingerprint
643 print <<EOF;
644 If that command fails because you don't have the required public key,
645 or that public key has expired, try the following commands to retrieve
646 or refresh it, and then rerun the 'gpg --verify' command.
648 if ($gpg_key_email) {
649 print <<EOF;
651 gpg --locate-external-key $gpg_key_email
654 print <<EOF;
656 gpg --recv-keys $gpg_key_id
658 if ($gpg_keyring_url) {
659 print <<EOF;
661 wget -q -O- '$gpg_keyring_url' | gpg --import -
664 print <<EOF;
666 As a last resort to find the key, you can try the official GNU
667 keyring:
669 wget -q https://ftp.gnu.org/gnu/gnu-keyring.gpg
670 gpg --keyring gnu-keyring.gpg --verify $tarballs[0].sig
673 my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);
674 @tool_versions
675 and print "\nThis release was bootstrapped with the following tools:",
676 join ('', map {"\n $_"} @tool_versions), "\n";
678 print_news_deltas ($_, $prev_version, $curr_version)
679 foreach @news_file;
681 $release_type eq 'stable'
682 or print_changelog_deltas ($package_name, $prev_version);
684 exit 0;
687 ### Setup "GNU" style for perl-mode and cperl-mode.
688 ## Local Variables:
689 ## mode: perl
690 ## perl-indent-level: 2
691 ## perl-continued-statement-offset: 2
692 ## perl-continued-brace-offset: 0
693 ## perl-brace-offset: 0
694 ## perl-brace-imaginary-offset: 0
695 ## perl-label-offset: -2
696 ## perl-extra-newline-before-brace: t
697 ## perl-merge-trailing-else: nil
698 ## eval: (add-hook 'before-save-hook 'time-stamp nil t)
699 ## time-stamp-line-limit: 50
700 ## time-stamp-start: "my $VERSION = '"
701 ## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
702 ## time-stamp-time-zone: "UTC0"
703 ## time-stamp-end: "'; # UTC"
704 ## End: