announce-gen 15 KB

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