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