4 # Generate a release announcement message.
6 # Copyright (C) 2002-2021 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 = '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.
44 my $copyright_year = '2021';
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);
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'))
65 my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
68 print $STREAM "Try '$ME --help' for more information.\n";
72 my @types = sort keys %valid_release_types;
75 Generate an announcement message. Run this from builddir.
79 These options must be specified:
81 --release-type=TYPE TYPE must be one of @types
82 --package-name=PACKAGE_NAME
83 --previous-version=VER
85 --gpg-key-id=ID The GnuPG ID of the key used to sign the tarballs
86 --url-directory=URL_DIR
88 The following are optional:
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,...
104 --help display this help and exit
105 --version output version information and exit
113 =item C<%size> = C<sizes (@file)>
115 Compute the sizes of the C<@file> and return them as a hash. Return
116 C<undef> if one of the computation failed.
126 foreach my $f (@file)
128 my $cmd = "du -h $f";
130 # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
132 and (warn "command failed: '$cmd'\n"), $fail = 1;
134 $t =~ s/^\s*([\d.]+[MkK]).*/${1}B/;
137 return $fail ? undef : %res;
140 =item C<print_locations ($title, \@url, \%size, @file)
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>.
147 sub print_locations ($\@\%@)
149 my ($title, $url, $size, @file) = @_;
150 print "Here are the $title:\n";
151 foreach my $url (@{$url})
156 print " (", $$size{$file}, ")"
157 if exists $$size{$file};
164 =item C<print_checksums (@file)
166 Print the MD5 and SHA1 signature section for each C<@file>.
170 sub print_checksums (@)
174 print "Here are the MD5 and SHA1 checksums:\n";
177 foreach my $meth (qw (md5 sha1))
179 my $class = $digest_classes{$meth} or next;
180 foreach my $f (@file)
183 or die "$ME: $f: cannot open for reading: $!\n";
185 my $dig = $class->new->addfile(*IN)->hexdigest;
193 =item C<print_news_deltas ($news_file, $prev_version, $curr_version)
195 Print the section of the NEWS file C<$news_file> addressing changes
196 between versions C<$prev_version> and C<$curr_version>.
200 sub print_news_deltas ($$$)
202 my ($news_file, $prev_version, $curr_version) = @_;
204 my $news_name = $news_file;
205 $news_name =~ s|^\Q$srcdir\E/||;
207 print "\n$news_name\n\n";
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.
214 my $re_prefix = qr/(?:\* )?(?:Noteworthy c|Major c|C)(?i:hanges)/;
217 open NEWS, '<', $news_file
218 or die "$ME: $news_file: cannot open for reading: $!\n";
219 while (defined (my $line = <NEWS>))
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
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
246 or die "$ME: $news_file: no matching lines for '$curr_version'\n";
248 or die "$ME: $news_file: no news item found for '$curr_version'\n";
251 sub print_changelog_deltas ($$)
253 my ($package_name, $prev_version) = @_;
255 # Print new ChangeLog entries.
257 # First find all CVS-controlled ChangeLog files.
260 find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS'
261 and push @changelog, $File::Find::name}},
264 # If there are no ChangeLog files, we're done.
267 my %changelog = map {$_ => 1} @changelog;
269 # Reorder the list of files so that if there are ChangeLog
270 # files in the specified directories, they're listed first,
272 my @dir = qw ( . src lib m4 config doc );
274 # A typical @changelog array might look like this:
284 my $dot_slash = $d eq '.' ? $d : "./$d";
285 my $target = "$dot_slash/ChangeLog";
286 delete $changelog{$target}
287 and push @reordered, $target;
290 # Append any remaining ChangeLog files.
291 push @reordered, sort keys %changelog;
293 # Remove leading './'.
294 @reordered = map { s!^\./!!; $_ } @reordered;
296 print "\nChangeLog entries:\n\n";
297 # print join ("\n", @reordered), "\n";
299 $prev_version =~ s/\./_/g;
300 my $prev_cvs_tag = "\U$package_name\E-$prev_version";
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>))
313 if ($line =~ /^\+\+\+ /)
315 my $separator = "*"x70 ."\n";
318 $prev_printed_line_empty
320 print $separator, $line, $separator;
322 elsif ($line =~ /^\+/)
326 $prev_printed_line_empty = ($line =~ /^$/);
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";
337 sub get_tool_versions ($$)
339 my ($tool_list, $gnulib_version) = @_;
344 my @tool_version_pair;
345 foreach my $t (@$tool_list)
349 push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version;
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.-]+)$/)
358 push @tool_version_pair, "$t $1";
363 and $first_line = '';
364 warn "$t: unexpected --version output\n:$first_line";
372 return @tool_version_pair;
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.
390 my $print_checksums_p = 1;
392 # Reformat the warnings before displaying them.
393 local $SIG{__WARN__} = sub
396 # Warnings from GetOptions.
397 $msg =~ s/Option (\w)/option --$1/;
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,
417 help => sub { usage 0 },
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";
427 my $author = "Jim Meyering";
428 print "Written by $author.\n";
434 # Ensure that each required option is specified.
436 or (warn "release type not specified\n"), $fail = 1;
438 or (warn "package name not specified\n"), $fail = 1;
440 or (warn "previous version string not specified\n"), $fail = 1;
442 or (warn "current version string not specified\n"), $fail = 1;
444 or (warn "GnuPG key ID not specified\n"), $fail = 1;
446 or (warn "URL directory name(s) not specified\n"), $fail = 1;
448 my @tool_list = split ',', $bootstrap_tools
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;
456 !$release_type || exists $valid_release_types{$release_type}
457 or (warn "'$release_type': invalid release type\n"), $fail = 1;
460 and (warn "too many arguments:\n", join ("\n", @ARGV), "\n"),
465 my $my_distdir = "$package_name-$curr_version";
467 my $xd = "$package_name-$prev_version-$curr_version.xdelta";
469 my @candidates = map { "$my_distdir.$_" } @archive_suffixes;
470 my @tarballs = grep {-f $_} @candidates;
473 or die "$ME: none of " . join(', ', @candidates) . " were found\n";
474 my @sizable = @tarballs;
476 and push @sizable, $xd;
477 my %size = sizes (@sizable);
482 if (defined $mail_headers)
484 ($headers = $mail_headers) =~ s/\s+(\S+:)/\n$1/g;
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.
492 ${headers}Subject: $my_distdir released [$release_type]
494 <\#secure method=pgpmime mode=sign>
496 FIXME: put comments here
500 if (@url_dir_list == 1 && @tarballs == 1)
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"
510 print_locations ("compressed sources", @url_dir_list, %size, @tarballs);
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,
520 if ($url_dir_list[0] =~ "gnu\.org")
522 print "Use a mirror for higher download bandwidth:\n";
523 if (@tarballs == 1 && $url_dir_list[0] =~ m!https://ftp\.gnu\.org/gnu/!)
525 (my $m = "$url_dir_list[0]/$tarballs[0]")
526 =~ s!https://ftp\.gnu\.org/gnu/!https://ftpmirror\.gnu\.org/!;
533 print " https://www.gnu.org/order/ftp.html\n\n";
538 and print_checksums (@sizable);
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:
545 gpg --verify $tarballs[0].sig
547 If that command fails because you don't have the required public key,
548 then run this command to import it:
550 gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_id
552 and rerun the 'gpg --verify' command.
555 my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);
557 and print "\nThis release was bootstrapped with the following tools:",
558 join ('', map {"\n $_"} @tool_versions), "\n";
560 print_news_deltas ($_, $prev_version, $curr_version)
563 $release_type eq 'stable'
564 or print_changelog_deltas ($package_name, $prev_version);
569 ### Setup "GNU" style for perl-mode and cperl-mode.
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"