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