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