1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
#!/usr/bin/perl -w
# Generate an announcement message.
use strict;
use Getopt::Long;
use Digest::MD5;
use Digest::SHA1;
(my $VERSION = '$Revision: 1.4 $ ') =~ tr/[0-9].//cd;
(my $ME = $0) =~ s|.*/||;
END
{
# Nobody ever checks the status of print()s. That's okay, because
# if any do fail, we're guaranteed to get an indicator when we close()
# the filehandle.
#
# Close stdout now, and if there were no errors, return happy status.
# If stdout has already been closed by the script, though, do nothing.
defined fileno STDOUT
or return;
close STDOUT
and return;
# Errors closing stdout. Indicate that, and hope stderr is OK.
warn "$ME: closing standard output: $!\n";
# Don't be so arrogant as to assume that we're the first END handler
# defined, and thus the last one invoked. There may be others yet
# to come. $? will be passed on to them, and to the final _exit().
#
# If it isn't already an error, make it one (and if it _is_ an error,
# preserve the value: it might be important).
$? ||= 1;
}
sub usage ($)
{
my ($exit_code) = @_;
my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
if ($exit_code != 0)
{
print $STREAM "Try `$ME --help' for more information.\n";
}
else
{
print $STREAM <<EOF;
Usage: $ME [OPTIONS]
OPTIONS:
Generate an announcement message.
FIXME: describe the following
--package-name=PACKAGE_NAME
--previous-version=VER
--current-version=VER
--release-archive-directory=DIR
--url-directory=URL_DIR
--help display this help and exit
--version output version information and exit
EOF
}
exit $exit_code;
}
{
my $package_name;
my $prev_version;
my $curr_version;
my $release_archive_dir;
my @url_dir_list;
GetOptions
(
'package-name=s' => \$package_name,
'previous-version=s' => \$prev_version,
'current-version=s' => \$curr_version,
'release-archive-directory=s' => \$release_archive_dir,
'url-directory=s@' => \@url_dir_list,
help => sub { usage 0 },
version => sub { print "$ME version $VERSION\n"; exit },
) or usage 1;
my $fail = 0;
# Ensure that sure each required option is specified.
$package_name
or (warn "$ME: missing package name\n"), $fail = 1;
$prev_version
or (warn "$ME: missing previous version string\n"), $fail = 1;
$curr_version
or (warn "$ME: missing current version string\n"), $fail = 1;
$release_archive_dir
or (warn "$ME: missing release directory name\n"), $fail = 1;
@url_dir_list
or (warn "$ME: missing URL directory name(s)\n"), $fail = 1;
@ARGV
and (warn "$ME: too many arguments\n"), $fail = 1;
$fail
and usage 1;
my $my_distdir = "$package_name-$curr_version";
my $tgz = "$my_distdir.tar.gz";
my $tbz = "$my_distdir.tar.bz2";
my $xd = "$package_name-$prev_version-$curr_version.xdelta";
my %size;
foreach my $f (($tgz, $tbz, $xd))
{
my $cmd = "du --human $f";
my $t = `$cmd`;
# FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
$@
and (warn "$ME: command failed: `$cmd'\n"), $fail = 1;
chomp $t;
$t =~ s/^([\d.]+[MkK]).*/${1}B/;
$size{$f} = $t;
}
$fail
and exit 1;
print <<EOF;
Subject: $my_distdir released
<#secure method=pgpmime mode=sign>
FIXME: put comments here
EOF
foreach my $url (@url_dir_list)
{
print " $url/$tgz ($size{$tgz})\n";
print " $url/$tbz ($size{$tbz})\n";
}
print "\nAnd here are xdelta-style diffs:\n";
foreach my $url (@url_dir_list)
{
print " $url/$xd ($size{$xd})\n";
}
print "\nHere are GPG detached signatures:\n";
foreach my $url (@url_dir_list)
{
print " $url/$tgz.sig\n";
print " $url/$tbz.sig\n";
}
# FIXME: clean up upon interrupt or die
my $tmpdir = $ENV{TMPDIR} || '/tmp';
my $tmp = "$tmpdir/$ME-$$";
unlink $tmp; # ignore failure
print "\nHere are the MD5 and SHA1 signatures:\n";
print "\n";
print "<#part type=text/plain filename=\"$tmp\" disposition=inline>\n"
. "<#/part>\n";
open OUT, '>', $tmp
or die "$ME: $tmp: cannot open for writing: $!\n";
foreach my $meth (qw (md5 sha1))
{
foreach my $f (($tgz, $tbz, $xd))
{
open IN, '<', $f
or die "$ME: $f: cannot open for reading: $!\n";
binmode IN;
my $dig =
($meth eq 'md5'
? Digest::MD5->new->addfile(*IN)->hexdigest
: Digest::SHA1->new->addfile(*IN)->hexdigest);
close IN;
print OUT "$dig $f\n";
}
}
close OUT
or die "$ME: $tmp: while writing: $!\n";
chmod 0400, $tmp; # ignore failure
# FIXME: depend on whether it's a test release
# sed -n "$news-r1),$news-r2)p" NEWS
# | grep -v '^\[';
# echo;
# echo ChangeLog entries:;
# find . -name ChangeLog -maxdepth 2
# | xargs $(CVS) diff -up -r$(prev-cvs-tag) -rHEAD
# | sed -n 's/^+//p'
# | perl -ne 'm!^\+\+ (\./)?! or print,next;'
# -e 'print "\n"."*"x70 ."\n"; s///; print; print "*"x70 ."\n"';
}
|
