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