announce-gen 18 KB

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