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 | ||
f0007cad | 6 | my $VERSION = '2012-01-06 07:46'; # 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 | ||
f0007cad | 12 | # Copyright (C) 2002-2012 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 | { | |
f0007cad | 47 | print $STREAM "Try '$ME --help' for more information.\n"; |
c84bdaf6 LC |
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 | $@ | |
f0007cad | 109 | and (warn "$ME: command failed: '$cmd'\n"), $fail = 1; |
c84bdaf6 LC |
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) | |
3d458a81 AW |
131 | { |
132 | print " $url/$file"; | |
133 | print " (", $$size{$file}, ")" | |
134 | if exists $$size{$file}; | |
135 | print "\n"; | |
136 | } | |
c84bdaf6 LC |
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) | |
3d458a81 AW |
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 | } | |
c84bdaf6 LC |
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 | ||
3d458a81 AW |
183 | my $news_name = $news_file; |
184 | $news_name =~ s|^\./||; | |
185 | ||
186 | print "\n$news_name\n\n"; | |
c84bdaf6 LC |
187 | |
188 | # Print all lines from $news_file, starting with the first one | |
189 | # that mentions $curr_version up to but not including | |
190 | # the first occurrence of $prev_version. | |
191 | my $in_items; | |
192 | ||
193 | my $re_prefix = qr/(?:\* )?(?:Noteworthy c|Major c|C)(?i:hanges)/; | |
194 | ||
3d458a81 | 195 | my $found_news; |
c84bdaf6 LC |
196 | open NEWS, '<', $news_file |
197 | or die "$ME: $news_file: cannot open for reading: $!\n"; | |
198 | while (defined (my $line = <NEWS>)) | |
199 | { | |
200 | if ( ! $in_items) | |
3d458a81 AW |
201 | { |
202 | # Match lines like these: | |
203 | # * Major changes in release 5.0.1: | |
204 | # * Noteworthy changes in release 6.6 (2006-11-22) [stable] | |
205 | $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$curr_version\E(?:[^\d.]|$)/o | |
206 | or next; | |
207 | $in_items = 1; | |
208 | print $line; | |
209 | } | |
c84bdaf6 | 210 | else |
3d458a81 AW |
211 | { |
212 | # This regexp must not match version numbers in NEWS items. | |
f0007cad | 213 | # For example, they might well say "introduced in 4.5.5", |
3d458a81 AW |
214 | # and we don't want that to match. |
215 | $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$prev_version\E(?:[^\d.]|$)/o | |
216 | and last; | |
217 | print $line; | |
218 | $line =~ /\S/ | |
219 | and $found_news = 1; | |
220 | } | |
c84bdaf6 LC |
221 | } |
222 | close NEWS; | |
223 | ||
224 | $in_items | |
f0007cad | 225 | or die "$ME: $news_file: no matching lines for '$curr_version'\n"; |
3d458a81 | 226 | $found_news |
f0007cad | 227 | or die "$ME: $news_file: no news item found for '$curr_version'\n"; |
c84bdaf6 LC |
228 | } |
229 | ||
230 | sub print_changelog_deltas ($$) | |
231 | { | |
232 | my ($package_name, $prev_version) = @_; | |
233 | ||
234 | # Print new ChangeLog entries. | |
235 | ||
236 | # First find all CVS-controlled ChangeLog files. | |
237 | use File::Find; | |
238 | my @changelog; | |
239 | find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS' | |
3d458a81 AW |
240 | and push @changelog, $File::Find::name}}, |
241 | '.'); | |
c84bdaf6 LC |
242 | |
243 | # If there are no ChangeLog files, we're done. | |
244 | @changelog | |
245 | or return; | |
246 | my %changelog = map {$_ => 1} @changelog; | |
247 | ||
248 | # Reorder the list of files so that if there are ChangeLog | |
249 | # files in the specified directories, they're listed first, | |
250 | # in this order: | |
251 | my @dir = qw ( . src lib m4 config doc ); | |
252 | ||
253 | # A typical @changelog array might look like this: | |
254 | # ./ChangeLog | |
255 | # ./po/ChangeLog | |
256 | # ./m4/ChangeLog | |
257 | # ./lib/ChangeLog | |
258 | # ./doc/ChangeLog | |
259 | # ./config/ChangeLog | |
260 | my @reordered; | |
261 | foreach my $d (@dir) | |
262 | { | |
263 | my $dot_slash = $d eq '.' ? $d : "./$d"; | |
264 | my $target = "$dot_slash/ChangeLog"; | |
265 | delete $changelog{$target} | |
3d458a81 | 266 | and push @reordered, $target; |
c84bdaf6 LC |
267 | } |
268 | ||
269 | # Append any remaining ChangeLog files. | |
270 | push @reordered, sort keys %changelog; | |
271 | ||
f0007cad | 272 | # Remove leading './'. |
c84bdaf6 LC |
273 | @reordered = map { s!^\./!!; $_ } @reordered; |
274 | ||
275 | print "\nChangeLog entries:\n\n"; | |
276 | # print join ("\n", @reordered), "\n"; | |
277 | ||
278 | $prev_version =~ s/\./_/g; | |
279 | my $prev_cvs_tag = "\U$package_name\E-$prev_version"; | |
280 | ||
281 | my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered"; | |
282 | open DIFF, '-|', $cmd | |
f0007cad | 283 | or die "$ME: cannot run '$cmd': $!\n"; |
c84bdaf6 | 284 | # Print two types of lines, making minor changes: |
f0007cad | 285 | # Lines starting with '+++ ', e.g., |
c84bdaf6 | 286 | # +++ ChangeLog 22 Feb 2003 16:52:51 -0000 1.247 |
f0007cad | 287 | # and those starting with '+'. |
c84bdaf6 LC |
288 | # Don't print the others. |
289 | my $prev_printed_line_empty = 1; | |
290 | while (defined (my $line = <DIFF>)) | |
291 | { | |
292 | if ($line =~ /^\+\+\+ /) | |
3d458a81 AW |
293 | { |
294 | my $separator = "*"x70 ."\n"; | |
295 | $line =~ s///; | |
296 | $line =~ s/\s.*//; | |
297 | $prev_printed_line_empty | |
298 | or print "\n"; | |
299 | print $separator, $line, $separator; | |
300 | } | |
c84bdaf6 | 301 | elsif ($line =~ /^\+/) |
3d458a81 AW |
302 | { |
303 | $line =~ s///; | |
304 | print $line; | |
305 | $prev_printed_line_empty = ($line =~ /^$/); | |
306 | } | |
c84bdaf6 LC |
307 | } |
308 | close DIFF; | |
309 | ||
310 | # The exit code should be 1. | |
311 | # Allow in case there are no modified ChangeLog entries. | |
312 | $? == 256 || $? == 128 | |
f0007cad | 313 | or warn "$ME: warning: '$cmd' had unexpected exit code or signal ($?)\n"; |
c84bdaf6 LC |
314 | } |
315 | ||
316 | sub get_tool_versions ($$) | |
317 | { | |
318 | my ($tool_list, $gnulib_version) = @_; | |
319 | @$tool_list | |
320 | or return (); | |
321 | ||
322 | my $fail; | |
323 | my @tool_version_pair; | |
324 | foreach my $t (@$tool_list) | |
325 | { | |
326 | if ($t eq 'gnulib') | |
3d458a81 AW |
327 | { |
328 | push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version; | |
329 | next; | |
330 | } | |
c84bdaf6 | 331 | # Assume that the last "word" on the first line of |
f0007cad | 332 | # 'tool --version' output is the version string. |
c84bdaf6 LC |
333 | my ($first_line, undef) = split ("\n", `$t --version`); |
334 | if ($first_line =~ /.* (\d[\w.-]+)$/) | |
3d458a81 AW |
335 | { |
336 | $t = ucfirst $t; | |
337 | push @tool_version_pair, "$t $1"; | |
338 | } | |
c84bdaf6 | 339 | else |
3d458a81 AW |
340 | { |
341 | defined $first_line | |
342 | and $first_line = ''; | |
343 | warn "$ME: $t: unexpected --version output\n:$first_line"; | |
344 | $fail = 1; | |
345 | } | |
c84bdaf6 LC |
346 | } |
347 | ||
348 | $fail | |
349 | and exit 1; | |
350 | ||
351 | return @tool_version_pair; | |
352 | } | |
353 | ||
354 | { | |
355 | # Neutralize the locale, so that, for instance, "du" does not | |
356 | # issue "1,2" instead of "1.2", what confuses our regexps. | |
357 | $ENV{LC_ALL} = "C"; | |
358 | ||
a927b6c1 | 359 | my $mail_headers; |
c84bdaf6 LC |
360 | my $release_type; |
361 | my $package_name; | |
362 | my $prev_version; | |
363 | my $curr_version; | |
364 | my $gpg_key_id; | |
365 | my @url_dir_list; | |
366 | my @news_file; | |
367 | my $bootstrap_tools; | |
368 | my $gnulib_version; | |
369 | my $print_checksums_p = 1; | |
370 | ||
371 | GetOptions | |
372 | ( | |
a927b6c1 | 373 | 'mail-headers=s' => \$mail_headers, |
c84bdaf6 LC |
374 | 'release-type=s' => \$release_type, |
375 | 'package-name=s' => \$package_name, | |
376 | 'previous-version=s' => \$prev_version, | |
377 | 'current-version=s' => \$curr_version, | |
378 | 'gpg-key-id=s' => \$gpg_key_id, | |
379 | 'url-directory=s' => \@url_dir_list, | |
380 | 'news=s' => \@news_file, | |
381 | 'bootstrap-tools=s' => \$bootstrap_tools, | |
382 | 'gnulib-version=s' => \$gnulib_version, | |
383 | 'print-checksums!' => \$print_checksums_p, | |
384 | 'archive-suffix=s' => \@archive_suffixes, | |
385 | ||
386 | help => sub { usage 0 }, | |
387 | version => sub { print "$ME version $VERSION\n"; exit }, | |
388 | ) or usage 1; | |
389 | ||
390 | my $fail = 0; | |
391 | # Ensure that sure each required option is specified. | |
392 | $release_type | |
393 | or (warn "$ME: release type not specified\n"), $fail = 1; | |
394 | $package_name | |
395 | or (warn "$ME: package name not specified\n"), $fail = 1; | |
396 | $prev_version | |
397 | or (warn "$ME: previous version string not specified\n"), $fail = 1; | |
398 | $curr_version | |
399 | or (warn "$ME: current version string not specified\n"), $fail = 1; | |
400 | $gpg_key_id | |
401 | or (warn "$ME: GnuPG key ID not specified\n"), $fail = 1; | |
402 | @url_dir_list | |
403 | or (warn "$ME: URL directory name(s) not specified\n"), $fail = 1; | |
404 | ||
405 | my @tool_list = split ',', $bootstrap_tools; | |
406 | ||
407 | grep (/^gnulib$/, @tool_list) ^ defined $gnulib_version | |
408 | and (warn "$ME: when specifying gnulib as a tool, you must also specify\n" | |
3d458a81 AW |
409 | . "--gnulib-version=V, where V is the result of running git describe\n" |
410 | . "in the gnulib source directory.\n"), $fail = 1; | |
c84bdaf6 LC |
411 | |
412 | exists $valid_release_types{$release_type} | |
f0007cad | 413 | or (warn "$ME: '$release_type': invalid release type\n"), $fail = 1; |
c84bdaf6 LC |
414 | |
415 | @ARGV | |
416 | and (warn "$ME: too many arguments:\n", join ("\n", @ARGV), "\n"), | |
417 | $fail = 1; | |
418 | $fail | |
419 | and usage 1; | |
420 | ||
421 | my $my_distdir = "$package_name-$curr_version"; | |
422 | ||
423 | my $xd = "$package_name-$prev_version-$curr_version.xdelta"; | |
424 | ||
425 | my @candidates = map { "$my_distdir.$_" } @archive_suffixes; | |
426 | my @tarballs = grep {-f $_} @candidates; | |
427 | ||
428 | @tarballs | |
429 | or die "$ME: none of " . join(', ', @candidates) . " were found\n"; | |
430 | my @sizable = @tarballs; | |
431 | -f $xd | |
432 | and push @sizable, $xd; | |
433 | my %size = sizes (@sizable); | |
434 | %size | |
435 | or exit 1; | |
436 | ||
a927b6c1 LC |
437 | my $headers = ''; |
438 | if (defined $mail_headers) | |
439 | { | |
440 | ($headers = $mail_headers) =~ s/\s+(\S+:)/\n$1/g; | |
441 | $headers .= "\n"; | |
442 | } | |
443 | ||
c84bdaf6 LC |
444 | # The markup is escaped as <\# so that when this script is sent by |
445 | # mail (or part of a diff), Gnus is not triggered. | |
446 | print <<EOF; | |
447 | ||
a927b6c1 | 448 | ${headers}Subject: $my_distdir released [$release_type] |
c84bdaf6 LC |
449 | |
450 | <\#secure method=pgpmime mode=sign> | |
451 | ||
452 | FIXME: put comments here | |
453 | ||
454 | EOF | |
455 | ||
7f1ea859 LC |
456 | if (@url_dir_list == 1 && @tarballs == 1) |
457 | { | |
458 | # When there's only one tarball and one URL, use a more concise form. | |
459 | my $m = "$url_dir_list[0]/$tarballs[0]"; | |
460 | print "Here are the compressed sources and a GPG detached signature[*]:\n" | |
461 | . " $m\n" | |
462 | . " $m.sig\n\n"; | |
463 | } | |
464 | else | |
465 | { | |
466 | print_locations ("compressed sources", @url_dir_list, %size, @tarballs); | |
467 | -f $xd | |
468 | and print_locations ("xdelta diffs (useful? if so, " | |
469 | . "please tell bug-gnulib\@gnu.org)", | |
470 | @url_dir_list, %size, $xd); | |
471 | my @sig_files = map { "$_.sig" } @tarballs; | |
472 | print_locations ("GPG detached signatures[*]", @url_dir_list, %size, | |
473 | @sig_files); | |
474 | } | |
475 | ||
414e4441 LC |
476 | if ($url_dir_list[0] =~ "gnu\.org") |
477 | { | |
7f1ea859 LC |
478 | print "Use a mirror for higher download bandwidth:\n"; |
479 | if (@tarballs == 1 && $url_dir_list[0] =~ m!http://ftp\.gnu\.org/gnu/!) | |
480 | { | |
481 | (my $m = "$url_dir_list[0]/$tarballs[0]") | |
482 | =~ s!http://ftp\.gnu\.org/gnu/!http://ftpmirror\.gnu\.org/!; | |
483 | print " $m\n" | |
484 | . " $m.sig\n\n"; | |
485 | ||
486 | } | |
487 | else | |
488 | { | |
489 | print " http://www.gnu.org/order/ftp.html\n\n"; | |
490 | } | |
414e4441 | 491 | } |
c84bdaf6 LC |
492 | |
493 | $print_checksums_p | |
494 | and print_checksums (@sizable); | |
495 | ||
496 | print <<EOF; | |
7f1ea859 LC |
497 | [*] Use a .sig file to verify that the corresponding file (without the |
498 | .sig suffix) is intact. First, be sure to download both the .sig file | |
499 | and the corresponding tarball. Then, run a command like this: | |
c84bdaf6 LC |
500 | |
501 | gpg --verify $tarballs[0].sig | |
502 | ||
503 | If that command fails because you don't have the required public key, | |
504 | then run this command to import it: | |
505 | ||
506 | gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_id | |
507 | ||
f0007cad | 508 | and rerun the 'gpg --verify' command. |
c84bdaf6 LC |
509 | EOF |
510 | ||
511 | my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version); | |
512 | @tool_versions | |
513 | and print "\nThis release was bootstrapped with the following tools:", | |
514 | join ('', map {"\n $_"} @tool_versions), "\n"; | |
515 | ||
516 | print_news_deltas ($_, $prev_version, $curr_version) | |
517 | foreach @news_file; | |
518 | ||
519 | $release_type eq 'stable' | |
520 | or print_changelog_deltas ($package_name, $prev_version); | |
521 | ||
522 | exit 0; | |
523 | } | |
524 | ||
525 | ### Setup "GNU" style for perl-mode and cperl-mode. | |
526 | ## Local Variables: | |
527 | ## mode: perl | |
528 | ## perl-indent-level: 2 | |
529 | ## perl-continued-statement-offset: 2 | |
530 | ## perl-continued-brace-offset: 0 | |
531 | ## perl-brace-offset: 0 | |
532 | ## perl-brace-imaginary-offset: 0 | |
533 | ## perl-label-offset: -2 | |
534 | ## perl-extra-newline-before-brace: t | |
535 | ## perl-merge-trailing-else: nil | |
536 | ## eval: (add-hook 'write-file-hooks 'time-stamp) | |
537 | ## time-stamp-start: "my $VERSION = '" | |
538 | ## time-stamp-format: "%:y-%02m-%02d %02H:%02M" | |
539 | ## time-stamp-time-zone: "UTC" | |
540 | ## time-stamp-end: "'; # UTC" | |
541 | ## End: |