Commit | Line | Data |
---|---|---|
459d3fb5 MBT |
1 | #!/usr/bin/perl |
2 | eval "exec perl -S $0 $*" | |
3 | if $running_under_some_shell; | |
4 | ||
5 | # $Id: patpost.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 | # Original Author: Larry Wall <lwall@netlabs.com> | |
16 | # | |
17 | # $Log: patpost.SH,v $ | |
18 | # Revision 3.0.1.4 1995/05/12 12:25:58 ram | |
19 | # patch54: added explicit From: header line pointing to the maintainer | |
20 | # | |
21 | # Revision 3.0.1.3 1994/01/24 14:32:09 ram | |
22 | # patch16: now prefix error messages with program's name | |
23 | # patch16: added ~/.dist_profile awareness | |
24 | # | |
25 | # Revision 3.0.1.2 1993/08/24 12:19:48 ram | |
26 | # patch3: added ~name expansion for orgname | |
27 | # patch3: random cleanup | |
28 | # | |
29 | # Revision 3.0.1.1 1993/08/19 06:42:41 ram | |
30 | # patch1: leading config.sh searching was not aborting properly | |
31 | # | |
32 | # Revision 3.0 1993/08/18 12:10:47 ram | |
33 | # Baseline for dist 3.0 netwide release. | |
34 | # | |
35 | ||
36 | $inews='inews'; | |
37 | $orgname='PROCURA B.V.'; | |
38 | $version = '3.5'; | |
39 | $patchlevel = '0'; | |
40 | ||
41 | $progname = &profile; # Read ~/.dist_profile | |
42 | require 'getopts.pl'; | |
43 | &usage unless $#ARGV >= 0; | |
44 | &usage unless &Getopts("hrV"); | |
45 | ||
46 | if ($opt_V) { | |
47 | print STDERR "$progname $version PL$patchlevel\n"; | |
48 | exit 0; | |
49 | } elsif ($opt_h) { | |
50 | &usage; | |
51 | } | |
52 | ||
53 | $RCSEXT = ',v' unless $RCSEXT; | |
54 | if ($inews eq 'inews') { | |
55 | $inews = '/usr/lib/news/inews' if -f '/usr/lib/news/inews'; | |
56 | } | |
57 | ||
58 | chdir '..' if -d '../bugs'; | |
59 | ||
60 | &readpackage; | |
61 | ||
62 | $orgname = &tilda_expand($orgname); | |
63 | chop($orgname = `cat $orgname`) if $orgname =~ m|^/|; | |
64 | ||
65 | if ($opt_r) { | |
66 | $repost = ' (REPOST)'; | |
67 | } | |
68 | ||
69 | while ($_ = shift) { | |
70 | if (/^(patch)?[1-9][\d\-]*$/) { | |
71 | s/^patch//; | |
72 | push(@argv,$_); | |
73 | } else { | |
74 | push(@newsgroups,$_); | |
75 | } | |
76 | } | |
77 | $newsgroups = join(',',@newsgroups) unless $#newsgroups < 0; | |
78 | &usage unless $newsgroups; | |
79 | ||
80 | @ARGV = @argv; | |
81 | open(PL,"patchlevel.h") || die "$progname: can't open patchlevel.h: $!\n"; | |
82 | while (<PL>) { | |
83 | $maxnum = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/; | |
84 | } | |
85 | close PL; | |
86 | die "$progname: malformed patchlevel.h file.\n" if $maxnum eq ''; | |
87 | ||
88 | if ($#ARGV < 0) { | |
89 | @patseq = &patseq($maxnum); | |
90 | $lastpat = pop(@patseq); | |
91 | $argv = &rangeargs("$lastpat-$maxnum"); | |
92 | } | |
93 | else { | |
94 | $argv = &rangeargs(@ARGV); | |
95 | } | |
96 | ||
97 | @ARGV = split(' ',$argv); | |
98 | $argv =~ s/ $//; | |
99 | ||
100 | if ($#ARGV < 0) { | |
101 | print STDERR "$progname: no patches specified.\n"; | |
102 | &usage; | |
103 | } elsif ($#ARGV) { | |
104 | ||
105 | "$progname: posting $package $baserev patches $argv to $newsgroups...\n"; | |
106 | } else { | |
107 | ||
108 | "$progname: posting $package $baserev patch $argv to $newsgroups...\n"; | |
109 | } | |
110 | ||
111 | chdir 'bugs' || die "$progname: can't cd to bugs: $!\n"; | |
112 | ||
113 | fork && exit; | |
114 | ||
115 | until ($#ARGV < 0) { | |
116 | $patnum = shift; | |
117 | open(PATCH,"patch$patnum") || | |
118 | die "$progname: can't open patch$patnum: $!\n"; | |
119 | open(XHEAD,"|$inews -h") || die "$progname: can't fork $inews: $!\n"; | |
120 | print XHEAD | |
121 | "From: $maintloc ($maintname) | |
122 | Newsgroups: $newsgroups | |
123 | Subject: $package $baserev patch #$patnum$repost | |
124 | Summary: This is an official patch for $package $baserev. Please apply it. | |
125 | Expires: | |
126 | References: | |
127 | Sender: | |
128 | Distribution: | |
129 | Organization: $orgname | |
130 | Keywords: | |
131 | ||
132 | "; | |
133 | while (<PATCH>) { | |
134 | print XHEAD; | |
135 | } | |
136 | close PATCH; | |
137 | close XHEAD; | |
138 | die "$progname: could not post patch$patnum.\n" if $?; | |
139 | } | |
140 | ||
141 | sub usage { | |
142 | print STDERR <<EOM; | |
143 | Usage: $progname [-hrV] patchlist newsgroups | |
144 | -h : print this message and exit | |
145 | -r : signals a repost | |
146 | -V : print version number and exit | |
147 | EOM | |
148 | exit 1; | |
149 | } | |
150 | ||
151 | sub readpackage { | |
152 | if (! -f '.package') { | |
153 | if ( | |
154 | -f '../.package' || | |
155 | -f '../../.package' || | |
156 | -f '../../../.package' || | |
157 | -f '../../../../.package' | |
158 | ) { | |
159 | die "Run in top level directory only.\n"; | |
160 | } else { | |
161 | die "No .package file! Run packinit.\n"; | |
162 | } | |
163 | } | |
164 | open(PACKAGE,'.package'); | |
165 | while (<PACKAGE>) { | |
166 | next if /^:/; | |
167 | next if /^#/; | |
168 | if (($var,$val) = /^\s*(\w+)=(.*)/) { | |
169 | $val = "\"$val\"" unless $val =~ /^['"]/; | |
170 | eval "\$$var = $val;"; | |
171 | } | |
172 | } | |
173 | close PACKAGE; | |
174 | } | |
175 | ||
176 | sub rangeargs { | |
177 | local($result) = ''; | |
178 | local($min,$max,$_); | |
179 | open(PL,"patchlevel.h") || die "Can't open patchlevel.h\n"; | |
180 | while (<PL>) { | |
181 | $maxspec = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/; | |
182 | } | |
183 | close PL; | |
184 | die "Malformed patchlevel.h file.\n" if $maxspec eq ''; | |
185 | while ($#_ >= 0) { | |
186 | $_ = shift(@_); | |
187 | while (/^\s*\d/) { | |
188 | s/^\s*(\d+)//; | |
189 | $min = $1; | |
190 | if (s/^,//) { | |
191 | $max = $min; | |
192 | } elsif (s/^-(\d*)//) { | |
193 | $max = $1; | |
194 | if ($max == 0 && $maxspec) { | |
195 | $max = $maxspec; | |
196 | } | |
197 | s/^[^,],?//; | |
198 | } else { | |
199 | $max = $min; | |
200 | } | |
201 | for ($i = $min; $i <= $max; ++$i) { | |
202 | $result .= $i . ' '; | |
203 | } | |
204 | } | |
205 | } | |
206 | $result; | |
207 | } | |
208 | ||
209 | # Compute patch sequence by scanning the bugs directory and looking for | |
210 | # .logs and/or .mods files to determine what was the last issued patch series. | |
211 | sub patseq { | |
212 | local($cur) = @_; # Current patch level | |
213 | local(@seq); # Issued patch sequence | |
214 | local($i); | |
215 | for ($i = 1; $i <= $cur; $i++) { | |
216 | push(@seq, $i) if -f "bugs/.logs$i" || -f "bugs/.mods$i"; | |
217 | } | |
218 | @seq; | |
219 | } | |
220 | ||
221 | # Perform ~name expansion ala ksh... | |
222 | # (banish csh from your vocabulary ;-) | |
223 | sub tilda_expand { | |
224 | local($path) = @_; | |
225 | return $path unless $path =~ /^~/; | |
226 | $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name | |
227 | $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~ | |
228 | $path; | |
229 | } | |
230 | ||
231 | # Set up profile components into %Profile, add any profile-supplied options | |
232 | # into @ARGV and return the command invocation name. | |
233 | sub profile { | |
234 | local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile'); | |
235 | local($me) = $0; # Command name | |
236 | $me =~ s|.*/(.*)|$1|; # Keep only base name | |
237 | return $me unless -s $profile; | |
238 | local(*PROFILE); # Local file descriptor | |
239 | local($options) = ''; # Options we get back from profile | |
240 | unless (open(PROFILE, $profile)) { | |
241 | warn "$me: cannot open $profile: $!\n"; | |
242 | return; | |
243 | } | |
244 | local($_); | |
245 | local($component); | |
246 | while (<PROFILE>) { | |
247 | next if /^\s*#/; # Skip comments | |
248 | next unless /^$me/o; | |
249 | if (s/^$me://o) { # progname: options | |
250 | chop; | |
251 | $options .= $_; # Merge options if more than one line | |
252 | } | |
253 | elsif (s/^$me-([^:]+)://o) { # progname-component: value | |
254 | $component = $1; | |
255 | chop; | |
256 | s/^\s+//; # Trim leading and trailing spaces | |
257 | s/\s+$//; | |
258 | $Profile{$component} = $_; | |
259 | } | |
260 | } | |
261 | close PROFILE; | |
262 | return unless $options; | |
263 | require 'shellwords.pl'; | |
264 | local(@opts); | |
265 | eval '@opts = &shellwords($options)'; # Protect against mismatched quotes | |
266 | unshift(@ARGV, @opts); | |
267 | return $me; # Return our invocation name | |
268 | } | |
269 |