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" "$@"'
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';
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
);
59 my
$STREAM = ($exit_code == 0 ?
*STDOUT
: *STDERR
);
62 print
$STREAM "Try '$ME --help' for more information.\n";
66 my @types
= sort keys
%valid_release_types
;
69 Generate an announcement message. Run this from builddir.
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
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
95 --gpg-keyring-url=URL URL pointing to keyring containing the key used
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
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.
124 foreach my
$f (@
file)
126 my
$cmd = "du -h $f";
128 # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
130 and
(warn
"command failed: '$cmd'\n"), $fail = 1;
132 $t =~ s
/^\s
*([\d.
]+[MkK
]).
*/${1}B
/;
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
>.
145 sub print_locations
($\@\
%@
)
147 my
($title, $url, $size, @
file) = @_
;
148 print
"Here are the $title:\n";
149 foreach my
$url (@
{$url})
154 print
" (", $
$size{$file}, ")"
155 if exists $
$size{$file};
162 =item C
<print_checksums
(@
file)
164 Print the SHA1 and SHA256 signature section
for each C
<@
file>.
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);
175 my
%pad
= (MD5
=> 2, SHA1
=> 1, SHA256
=> 1, SHA384
=> 0, SHA512
=> 2);
176 return $h .
'=' x
$pad{$alg};
179 sub print_checksums
(@
)
183 print
"Here are the SHA1 and SHA256 checksums:\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>.
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.
218 my
$re_prefix = qr
/(?
:\
* )?
(?
:Noteworthy c|Major c|C
)(?i
:hanges
)/;
221 open NEWS
, '<', $news_file
222 or die
"$ME: $news_file: cannot open for reading: $!\n";
223 while (defined
(my
$line = <NEWS
>))
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
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
250 or die
"$ME: $news_file: no matching lines for '$curr_version'\n";
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.
264 find ({wanted
=> sub
{$_ eq
'ChangeLog' && -d 'CVS'
265 and push @changelog
, $File::Find
::name
}},
268 # If there are no ChangeLog files, we're done.
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,
276 my @dir
= qw
( . src lib
m4 config doc
);
278 # A typical @changelog array might look like this:
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";
322 $prev_printed_line_empty
324 print
$separator, $line, $separator;
326 elsif
($line =~
/^\
+/)
330 $prev_printed_line_empty = ($line =~
/^$
/);
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) = @_
;
348 my @tool_version_pair
;
349 foreach my
$t (@
$tool_list)
353 push @tool_version_pair
, ucfirst
$t .
' ' .
$gnulib_version;
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.
-]+)$
/)
362 push @tool_version_pair
, "$t $1";
367 and
$first_line = '';
368 warn
"$t: unexpected --version output\n:$first_line";
376 return @tool_version_pair
;
379 # Print a more human-friendly representation of $SEC seconds.
380 sub readable_interval0
($
)
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;
391 $hr < 24 and
return "$hr hours";
393 my
$day = int
($hr / 24); $hr %= 24;
395 $day < 50 and
return "$day days";
397 my
$wk = int
($day / 7); $day %= 7;
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;
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.
426 my
$print_checksums_p = 1;
430 # Reformat the warnings before displaying them.
431 local $SIG{__WARN__
} = sub
434 # Warnings from GetOptions.
435 $msg =~ s
/Option
(\w
)/option
--$1/;
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 },
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";
467 my
$author = "Jim Meyering";
468 print
"Written by $author.\n";
474 # Ensure that each required option is specified.
476 or
(warn
"release type not specified\n"), $fail = 1;
478 or
(warn
"package name not specified\n"), $fail = 1;
480 or
(warn
"previous version string not specified\n"), $fail = 1;
482 or
(warn
"current version string not specified\n"), $fail = 1;
484 or
(warn
"GnuPG key ID not specified\n"), $fail = 1;
486 or
(warn
"URL directory name(s) not specified\n"), $fail = 1;
488 my @tool_list
= split ',', $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;
504 and
(warn
"too many arguments:\n", join ("\n", @ARGV
), "\n"),
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
;
517 or die
"$ME: none of " .
join(', ', @candidates
) .
" were found\n";
518 my @sizable
= @tarballs
;
520 and push @sizable
, $xd;
521 my
%size
= sizes
(@sizable
);
526 if (defined
$mail_headers)
528 ($headers = $mail_headers) =~ s
/\s
+(\S
+:)/\n$1/g
;
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.
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'`;
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:
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"
592 print_locations
("compressed sources", @url_dir_list
, %size
, @tarballs
);
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
,
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
/!;
615 print
" https://www.gnu.org/order/ftp.html\n\n";
620 and print_checksums
(@sizable
);
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
;
638 The signature should match the fingerprint of the following key:
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) {
651 gpg --locate-external-key $gpg_key_email
656 gpg --recv-keys $gpg_key_id
658 if ($gpg_keyring_url) {
661 wget -q -O- '$gpg_keyring_url' | gpg --import -
666 As a last resort to find the key, you can try the official GNU
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);
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)
681 $release_type eq
'stable'
682 or print_changelog_deltas
($package_name, $prev_version);
687 ### Setup "GNU" style for perl-mode and cperl-mode.
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"