Commit | Line | Data |
---|---|---|
459d3fb5 MBT |
1 | #!/usr/bin/perl |
2 | eval "exec perl -S $0 $*" | |
3 | if $running_under_some_shell; | |
4 | ||
5 | # $Id: kitpost.SH 1 2006-08-24 12:32:52Z rmanfredi $ | |
6 | # | |
7 | # Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi | |
8 | # | |
9 | # You may redistribute only under the terms of the Artistic Licence, | |
10 | # as specified in the README file that comes with the distribution. | |
11 | # You may reuse parts of this distribution only within the terms of | |
12 | # that same Artistic Licence; a copy of which may be found at the root | |
13 | # of the source tree for dist 4.0. | |
14 | # | |
15 | # $Log: kitpost.SH,v $ | |
16 | # Revision 3.0.1.2 1994/10/29 15:48:26 ram | |
17 | # patch36: don't use rootid as a variable, it is known by metaconfig | |
18 | # | |
19 | # Revision 3.0.1.1 1994/05/06 13:54:53 ram | |
20 | # patch23: created | |
21 | # | |
22 | ||
23 | $inews='inews'; | |
24 | $mailer='/usr/sbin/sendmail'; | |
25 | $orgname='PROCURA B.V.'; | |
26 | $version = '3.5'; | |
27 | $patchlevel = '0'; | |
28 | ||
29 | $progname = &profile; # Read ~/.dist_profile | |
30 | require 'getopts.pl'; | |
31 | &usage unless $#ARGV >= 0; | |
32 | &usage unless &Getopts("hrVm:D:H:"); | |
33 | ||
34 | if ($opt_V) { | |
35 | print STDERR "$progname $version PL$patchlevel\n"; | |
36 | exit 0; | |
37 | } elsif ($opt_h) { | |
38 | &usage; | |
39 | } | |
40 | ||
41 | $RCSEXT = ',v' unless $RCSEXT; | |
42 | if ($inews eq 'inews') { | |
43 | $inews = '/usr/lib/news/inews' if -f '/usr/lib/news/inews'; | |
44 | } | |
45 | ||
46 | chdir '..' if -d '../bugs'; | |
47 | ||
48 | &readpackage; | |
49 | ||
50 | $orgname = &tilda_expand($orgname); | |
51 | chop($orgname = `cat $orgname`) if $orgname =~ m|^/|; | |
52 | ||
53 | if ($opt_r) { | |
54 | $repost = ' (REPOST)'; | |
55 | } | |
56 | ||
57 | while ($_ = shift) { | |
58 | if (/^(kit)?[1-9][\d\-]*$/) { | |
59 | s/^kit//; | |
60 | push(@argv,$_); | |
61 | } else { | |
62 | push(@ngroups,$_); | |
63 | } | |
64 | } | |
65 | $ngroups = join(',',@ngroups) unless $#ngroups < 0; | |
66 | $dest = $opt_m; | |
67 | &usage unless $ngroups || $dest; | |
68 | ||
69 | @ARGV = @argv; | |
70 | ||
71 | if (-f "$package.kit10") { | |
72 | @filelist = <$package.kit[0-9][0-9]>; | |
73 | } | |
74 | else { | |
75 | @filelist = <$package.kit[0-9]>; | |
76 | } | |
77 | pop(@filelist) =~ /(\d+)$/ && ($maxnum = $1 + 0); | |
78 | ||
79 | if ($#ARGV < 0) { | |
80 | $argv = "1-$maxnum"; | |
81 | @ARGV = $argv; | |
82 | } | |
83 | ||
84 | $argv = &rangeargs(@ARGV); | |
85 | @ARGV = split(' ', $argv); | |
86 | ||
87 | $argv =~ s/ $//; | |
88 | ||
89 | if ($#ARGV < 0) { | |
90 | print STDERR "$progname: no kits specified.\n"; | |
91 | &usage; | |
92 | } else { | |
93 | local($s) = $#ARGV ? 's' : ''; | |
94 | print "$progname: posting $package $baserev kit$s $argv to $ngroups...\n" | |
95 | if $ngroups; | |
96 | print "$progname: mailing $package $baserev kit$s $argv to $dest...\n" | |
97 | if $dest; | |
98 | } | |
99 | ||
100 | $desc = "$opt_D, " if $opt_D; | |
101 | ||
102 | fork && exit; | |
103 | ||
104 | # Compute a suitable root message ID that all parts will reference, so that | |
105 | # threaded news readers will correctly process them. | |
106 | # Unfortunately, this works only when all kits are sent. | |
107 | ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = | |
108 | localtime(time); | |
109 | $mon++; | |
110 | $rootmid = "$year$mon$mday$hour$min$sec.AA$$"; | |
111 | $first = $maxnum >= 10 ? "01" : "1"; | |
112 | $rootmsgid = "<$rootmid.P$first.$maintloc>"; | |
113 | ||
114 | until ($#ARGV < 0) { | |
115 | $kitnum = shift; | |
116 | $kitnum = "0$kitnum" if $kitnum < 10 && $maxnum >= 10; | |
117 | open(FILE, "$package.kit$kitnum") || | |
118 | die "$progname: can't open $package.kit$kitnum: $!\n"; | |
119 | if ($ngroups) { | |
120 | open(INEWS,"|$inews -h") || die "$progname: can't fork $inews: $!\n"; | |
121 | } | |
122 | if ($dest) { | |
123 | $opt = '-odq' if $mailer =~ /sendmail/; | |
124 | $dest =~ s/,/ /g; | |
125 | ($to = $dest) =~ s/\s+/, /g; | |
126 | open(MAILER,"|$mailer $opt $dest") || | |
127 | die "$progname: can't fork $mailer: $!\n"; | |
128 | } | |
129 | ||
130 | $msg_id = "<$rootmid.P$kitnum.$maintloc>"; | |
131 | $msg_id = $rootmsgid if $kitnum == 1; | |
132 | $msg_id .= "\nReferences: $rootmsgid" if $kitnum != 1; | |
133 | ||
134 | print INEWS "Newsgroups: $ngroups\n"; | |
135 | print MAILER "To: $to\n"; | |
136 | $head = <<EOH; | |
137 | Subject: $package $baserev - ${desc}part$kitnum/$maxnum$repost | |
138 | Message-ID: $msg_id | |
139 | Organization: $orgname | |
140 | ||
141 | Submitted-by: $maintname <$maintloc> | |
142 | Archive-name: $package-$baserev/part$kitnum | |
143 | Environment: UNIX | |
144 | ||
145 | EOH | |
146 | print INEWS $head; | |
147 | print MAILER $head; | |
148 | ||
149 | if ($kitnum == 1 && $opt_H) { | |
150 | open(HEAD, $opt_H) || warn "$progname: can't open $opt_H: $!\n"; | |
151 | while (<HEAD>) { | |
152 | print INEWS; | |
153 | print MAILER; | |
154 | } | |
155 | close HEAD; | |
156 | } | |
157 | ||
158 | while (<FILE>) { | |
159 | print INEWS; | |
160 | print MAILER; | |
161 | } | |
162 | close FILE; | |
163 | close INEWS; | |
164 | die "$progname: could not post part$kitnum.\n" if $ngroups && $?; | |
165 | close MAILER; | |
166 | die "$progname: could not send part$kitnum.\n" if $dest && $?; | |
167 | } | |
168 | ||
169 | sub usage { | |
170 | print STDERR <<EOM; | |
171 | Usage: $progname [-hrV] [-H file] [-D desc] [-m dest1,dest2] [kits] [newsgroups] | |
172 | -h : print this message and exit | |
173 | -m : set-up recipients for (additional) mailing | |
174 | -r : signals a repost | |
175 | -D : specify description string for subject line | |
176 | -H : specify file to be used as header for first part | |
177 | -V : print version number and exit | |
178 | EOM | |
179 | exit 1; | |
180 | } | |
181 | ||
182 | sub rangeargs { | |
183 | local($result) = ''; | |
184 | local($min,$max,$_); | |
185 | while ($#_ >= 0) { | |
186 | $_ = shift(@_); | |
187 | while (/^\s*\d/) { | |
188 | s/^\s*(\d+)//; | |
189 | $min = $1; | |
190 | if (s/^,//) { | |
191 | $max = $min; | |
192 | } | |
193 | elsif (s/^-(\d*)//) { | |
194 | $max = $1; | |
195 | if ($max == 0 && $maxnum) { | |
196 | $max = $maxnum; | |
197 | } | |
198 | s/^[^,],?//; | |
199 | } | |
200 | else { | |
201 | $max = $min; | |
202 | } | |
203 | for ($i = $min; $i <= $max; ++$i) { | |
204 | $result .= $i . ' '; | |
205 | } | |
206 | } | |
207 | } | |
208 | $result; | |
209 | } | |
210 | ||
211 | sub readpackage { | |
212 | if (! -f '.package') { | |
213 | if ( | |
214 | -f '../.package' || | |
215 | -f '../../.package' || | |
216 | -f '../../../.package' || | |
217 | -f '../../../../.package' | |
218 | ) { | |
219 | die "Run in top level directory only.\n"; | |
220 | } else { | |
221 | die "No .package file! Run packinit.\n"; | |
222 | } | |
223 | } | |
224 | open(PACKAGE,'.package'); | |
225 | while (<PACKAGE>) { | |
226 | next if /^:/; | |
227 | next if /^#/; | |
228 | if (($var,$val) = /^\s*(\w+)=(.*)/) { | |
229 | $val = "\"$val\"" unless $val =~ /^['"]/; | |
230 | eval "\$$var = $val;"; | |
231 | } | |
232 | } | |
233 | close PACKAGE; | |
234 | } | |
235 | ||
236 | # Perform ~name expansion ala ksh... | |
237 | # (banish csh from your vocabulary ;-) | |
238 | sub tilda_expand { | |
239 | local($path) = @_; | |
240 | return $path unless $path =~ /^~/; | |
241 | $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name | |
242 | $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~ | |
243 | $path; | |
244 | } | |
245 | ||
246 | # Set up profile components into %Profile, add any profile-supplied options | |
247 | # into @ARGV and return the command invocation name. | |
248 | sub profile { | |
249 | local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile'); | |
250 | local($me) = $0; # Command name | |
251 | $me =~ s|.*/(.*)|$1|; # Keep only base name | |
252 | return $me unless -s $profile; | |
253 | local(*PROFILE); # Local file descriptor | |
254 | local($options) = ''; # Options we get back from profile | |
255 | unless (open(PROFILE, $profile)) { | |
256 | warn "$me: cannot open $profile: $!\n"; | |
257 | return; | |
258 | } | |
259 | local($_); | |
260 | local($component); | |
261 | while (<PROFILE>) { | |
262 | next if /^\s*#/; # Skip comments | |
263 | next unless /^$me/o; | |
264 | if (s/^$me://o) { # progname: options | |
265 | chop; | |
266 | $options .= $_; # Merge options if more than one line | |
267 | } | |
268 | elsif (s/^$me-([^:]+)://o) { # progname-component: value | |
269 | $component = $1; | |
270 | chop; | |
271 | s/^\s+//; # Trim leading and trailing spaces | |
272 | s/\s+$//; | |
273 | $Profile{$component} = $_; | |
274 | } | |
275 | } | |
276 | close PROFILE; | |
277 | return unless $options; | |
278 | require 'shellwords.pl'; | |
279 | local(@opts); | |
280 | eval '@opts = &shellwords($options)'; # Protect against mismatched quotes | |
281 | unshift(@ARGV, @opts); | |
282 | return $me; # Return our invocation name | |
283 | } | |
284 |