[metaconfig.git] / bin / patsend

#!/usr/bin/perl
	eval "exec perl -S $0 $*"
		if $running_under_some_shell;

# $Id: patsend.SH 1 2006-08-24 12:32:52Z rmanfredi $
#
#  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
#  
#  You may redistribute only under the terms of the Artistic Licence,
#  as specified in the README file that comes with the distribution.
#  You may reuse parts of this distribution only within the terms of
#  that same Artistic Licence; a copy of which may be found at the root
#  of the source tree for dist 4.0.
#
# Original Author: Larry Wall <lwall@netlabs.com>
#
# $Log: patsend.SH,v $
# Revision 3.0.1.6  1995/09/25  09:22:02  ram
# patch59: new -i option to add more instructions for end-users
#
# Revision 3.0.1.5  1994/01/24  14:32:46  ram
# patch16: now prefix error messages with program's name
# patch16: don't feed mailer with more than 50 addresses at a time
# patch16: added ~/.dist_profile awareness
#
# Revision 3.0.1.4  1993/08/25  14:08:01  ram
# patch6: now asks for recipient list edition by default
# patch6: new -q option to suppress that
#
# Revision 3.0.1.3  1993/08/24  12:21:59  ram
# patch3: new -u option
# patch3: added Precedence and X-Mailer headers in mail message
# patch3: added ~name expansion for orgname
#
# Revision 3.0.1.2  1993/08/19  07:10:19  ram
# patch3: was not correctly writing the To: header field
#
# Revision 3.0.1.1  1993/08/19  06:42:42  ram
# patch1: leading config.sh searching was not aborting properly
#
# Revision 3.0  1993/08/18  12:10:49  ram
# Baseline for dist 3.0 netwide release.
#

$orgname='PROCURA B.V.';
$mailer='/usr/sbin/sendmail';
$version = '3.5';
$patchlevel = '0';

$progname = &profile;			# Read ~/.dist_profile
require 'getopts.pl';
&usage unless &Getopts("hiquV");

if ($opt_V) {
	print STDERR "$progname $version PL$patchlevel\n";
	exit 0;
} elsif ($opt_h) {
	&usage;
}

chdir '..' if -d '../bugs';

&readpackage;
&readusers if $opt_u;

$orgname = &tilda_expand($orgname);
chop($orgname = `cat $orgname`) if $orgname =~ m|^/|;

while ($_ = shift) {
	if (/^(patch)?[1-9][\d,-]*$/) {
		s/^patch//;
		push(@argv,$_);
	} else {
		push(@dest,$_);
	}
}
$dest = join(' ',@dest);
$dest .= " $recipients" if $opt_u;
&usage unless $dest;

# Offer to edit the address list unless -q
unless ($opt_q) {
	select((select(STDOUT), $| = 1)[0]);
	print "Do you wish to edit the address list? [y] ";
	$ans = <STDIN>;
	unless ($ans =~ /^n/i) {
		@to = split(' ', $dest);
		&listedit(*to);
		$dest = join(' ', @to);
	}
}

$to = join(', ', split(' ', $dest));
@ARGV = @argv;

open(PL,"patchlevel.h") || die "$progname: can't open patchlevel.h: $!\n";
while (<PL>) {
	$maxnum = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
}
close PL;
die "$progname: malformed patchlevel.h file.\n" if $maxnum eq '';

if ($#ARGV < 0) {
	@patseq = &patseq($maxnum);
	$lastpat = pop(@patseq);
	$argv = &rangeargs("$lastpat-$maxnum");
} else {
	$argv = &rangeargs(@ARGV);
}

@ARGV = split(' ',$argv);
$argv =~ s/ $//;

if ($#ARGV < 0) {
	print STDERR "$progname: no patches specified.\n";
	&usage;
} elsif ($#ARGV) {
	print "$progname: sending $package $baserev patches $argv to $dest...\n";
} else {
	print "$progname: sending $package $baserev patch $argv to $dest...\n";
}

chdir 'bugs' || die "$progname: can't cd to bugs: $!\n";

fork && exit;

$opt = '-odq' if $mailer =~ /sendmail/;

until ($#ARGV < 0) {
	$patnum = shift;

	# I hate broken mailers! Bust it up into smaller groups of people...
	@dest = split(' ', $dest);
	while (@smalldest = splice(@dest, 0, 50)) {
		$to = join(', ', @smalldest);	# Sensible To: for sendmail
		$smalldest = join(' ', @smalldest);

		open(MAILER, "|$mailer $opt $smalldest") ||
			die "$progname: can't fork $mailer: $!\n";
		print MAILER
"To: $to
Subject: $package $baserev patch #$patnum
Precedence: bulk
X-Mailer: dist [version $version PL$patchlevel]
Organization: $orgname

";
		print MAILER
"$package version $baserev has been recently upgraded with the following patch,
which is being mailed directly to you as you requested when running Configure.

If you are not interested in having future patches mailed directly to you,
please send me the following mail:

	Subject: Command
	\@SH package - $package $baserev

-- $progname speaking for $maintname <$maintloc>.

" if ($opt_i || $opt_u);
		print MAILER
"[The latest patch for $package version $baserev is #$maxnum.]

";
		open(PATCH,"patch$patnum") ||
			die "$progname: can't open patch$patnum: $!\n";
		while (<PATCH>) {
			print MAILER;
		}
		close PATCH;
		close MAILER;
		die "$progname: could not mail patch$patnum.\n" if $?;
	}
}

sub usage {
	print STDERR <<EOM;
Usage: $progname [-hiquV] [patchlist] [recipients]
  -h : print this message and exit
  -i : include information on how to stop receiving future patches
  -q : quick mode, do not offer to edit recipient list
  -u : add all to-be-mailed users
  -V : print version number and exit
EOM
	exit 1;
}

sub readpackage {
	if (! -f '.package') {
		if (
			-f '../.package' ||
			-f '../../.package' ||
			-f '../../../.package' ||
			-f '../../../../.package'
		) {
			die "Run in top level directory only.\n";
		} else {
			die "No .package file!  Run packinit.\n";
		}
	}
	open(PACKAGE,'.package');
	while (<PACKAGE>) {
		next if /^:/;
		next if /^#/;
		if (($var,$val) = /^\s*(\w+)=(.*)/) {
			$val = "\"$val\"" unless $val =~ /^['"]/;
			eval "\$$var = $val;";
		}
	}
	close PACKAGE;
}

sub rangeargs {
	local($result) = '';
	local($min,$max,$_);
	open(PL,"patchlevel.h") || die "Can't open patchlevel.h\n";
	while (<PL>) {
		$maxspec = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
	}
	close PL;
	die "Malformed patchlevel.h file.\n" if $maxspec eq '';
	while ($#_ >= 0) {
		$_ = shift(@_);
		while (/^\s*\d/) {
			s/^\s*(\d+)//;
			$min = $1;
			if (s/^,//) {
				$max = $min;
			} elsif (s/^-(\d*)//) {
				$max = $1;
				if ($max == 0 && $maxspec) {
					$max = $maxspec;
				}
				s/^[^,],?//;
			} else {
				$max = $min;
			}
			for ($i = $min; $i <= $max; ++$i) {
				$result .= $i . ' ';
			}
		}
	}
	$result;
}

sub readusers {
	return unless open(USERS, 'users');
	local($_);
	local($status, $name, $pl);
	while (<USERS>) {
		next if /^#/;
		chop if /\n$/;				# Emacs may leave final line without \n
		($status, $pl, $name) = split;
		# Handle oldstyle two-field user file format (PL13 and before)
		$name = $pl unless defined $name;
		if ($status eq 'M') {
			$recipients = $recipients ? "$recipients $name" : $name;
		} elsif ($status eq 'N') {
			$notify = $notify ? "$notify $name" : $name;
		}
	}
	close USERS;
}

# Compute patch sequence by scanning the bugs directory and looking for
# .logs and/or .mods files to determine what was the last issued patch series.
sub patseq {
	local($cur) = @_;		# Current patch level
	local(@seq);			# Issued patch sequence
	local($i);
	for ($i = 1; $i <= $cur; $i++) {
		push(@seq, $i) if -f "bugs/.logs$i" || -f "bugs/.mods$i";
	}
	@seq;
}

# Perform ~name expansion ala ksh...
# (banish csh from your vocabulary ;-)
sub tilda_expand {
	local($path) = @_;
	return $path unless $path =~ /^~/;
	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;			# ~name
	$path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;	# ~
	$path;
}

# Compute suitable editor name
sub geteditor {
	local($editor) = $ENV{'VISUAL'};
	$editor = $ENV{'EDITOR'} unless $editor;
	$editor = $defeditor unless $editor;
	$editor = 'vi' unless $editor;
	$editor;
}

# Allow user to inplace-edit a list of items held in an array
sub listedit {
	local(*list) = @_;
	local($tmp) = "/tmp/dist.$$";
	local($editor) = &geteditor;
	open(TMP, ">$tmp") || die "Can't create $tmp: $!\n";
	foreach $item (@list) {
		print TMP $item, "\n";
	}
	close TMP;
	system "$editor $tmp";
	open(TMP, "$tmp") || die "Can't reopen $tmp: $!\n";
	chop(@list = <TMP>);
	close TMP;
	unlink $tmp;
}

# Set up profile components into %Profile, add any profile-supplied options
# into @ARGV and return the command invocation name.
sub profile {
	local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
	local($me) = $0;		# Command name
	$me =~ s|.*/(.*)|$1|;	# Keep only base name
	return $me unless -s $profile;
	local(*PROFILE);		# Local file descriptor
	local($options) = '';	# Options we get back from profile
	unless (open(PROFILE, $profile)) {
		warn "$me: cannot open $profile: $!\n";
		return;
	}
	local($_);
	local($component);
	while (<PROFILE>) {
		next if /^\s*#/;	# Skip comments
		next unless /^$me/o;
		if (s/^$me://o) {	# progname: options
			chop;
			$options .= $_;	# Merge options if more than one line
		}
		elsif (s/^$me-([^:]+)://o) {	# progname-component: value
			$component = $1;
			chop;
			s/^\s+//;		# Trim leading and trailing spaces
			s/\s+$//;
			$Profile{$component} = $_;
		}
	}
	close PROFILE;
	return unless $options;
	require 'shellwords.pl';
	local(@opts);
	eval '@opts = &shellwords($options)';	# Protect against mismatched quotes
	unshift(@ARGV, @opts);
	return $me;				# Return our invocation name
}
Commit	Line	Data
459d3fb5 MBT	1	#!/usr/bin/perl
	2	eval "exec perl -S $0 $*"
	3	if $running_under_some_shell;
	4
	5	# $Id: patsend.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: patsend.SH,v $
	18	# Revision 3.0.1.6 1995/09/25 09:22:02 ram
	19	# patch59: new -i option to add more instructions for end-users
	20	#
	21	# Revision 3.0.1.5 1994/01/24 14:32:46 ram
	22	# patch16: now prefix error messages with program's name
	23	# patch16: don't feed mailer with more than 50 addresses at a time
	24	# patch16: added ~/.dist_profile awareness
	25	#
	26	# Revision 3.0.1.4 1993/08/25 14:08:01 ram
	27	# patch6: now asks for recipient list edition by default
	28	# patch6: new -q option to suppress that
	29	#
	30	# Revision 3.0.1.3 1993/08/24 12:21:59 ram
	31	# patch3: new -u option
	32	# patch3: added Precedence and X-Mailer headers in mail message
	33	# patch3: added ~name expansion for orgname
	34	#
	35	# Revision 3.0.1.2 1993/08/19 07:10:19 ram
	36	# patch3: was not correctly writing the To: header field
	37	#
	38	# Revision 3.0.1.1 1993/08/19 06:42:42 ram
	39	# patch1: leading config.sh searching was not aborting properly
	40	#
	41	# Revision 3.0 1993/08/18 12:10:49 ram
	42	# Baseline for dist 3.0 netwide release.
	43	#
	44
	45	$orgname='PROCURA B.V.';
	46	$mailer='/usr/sbin/sendmail';
	47	$version = '3.5';
	48	$patchlevel = '0';
	49
	50	$progname = &profile; # Read ~/.dist_profile
	51	require 'getopts.pl';
	52	&usage unless &Getopts("hiquV");
	53
	54	if ($opt_V) {
	55	print STDERR "$progname $version PL$patchlevel\n";
	56	exit 0;
	57	} elsif ($opt_h) {
	58	&usage;
	59	}
	60
	61	chdir '..' if -d '../bugs';
	62
	63	&readpackage;
	64	&readusers if $opt_u;
65
66	$orgname = &tilda_expand($orgname);
67	chop($orgname = `cat $orgname`) if $orgname =~ m\|^/\|;
68
69	while ($_ = shift) {
70	if (/^(patch)?[1-9][\d,-]*$/) {
71	s/^patch//;
72	push(@argv,$_);
73	} else {
74	push(@dest,$_);
75	}
76	}
77	$dest = join(' ',@dest);
78	$dest .= " $recipients" if $opt_u;
79	&usage unless $dest;
80
81	# Offer to edit the address list unless -q
82	unless ($opt_q) {
83	select((select(STDOUT), $\| = 1)[0]);
84	print "Do you wish to edit the address list? [y] ";
85	$ans = <STDIN>;
86	unless ($ans =~ /^n/i) {
87	@to = split(' ', $dest);
88	&listedit(*to);
89	$dest = join(' ', @to);
90	}
91	}
92
93	$to = join(', ', split(' ', $dest));
94	@ARGV = @argv;
95
96	open(PL,"patchlevel.h") \|\| die "$progname: can't open patchlevel.h: $!\n";
97	while (<PL>) {
98	$maxnum = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
99	}
100	close PL;
101	die "$progname: malformed patchlevel.h file.\n" if $maxnum eq '';
102
103	if ($#ARGV < 0) {
104	@patseq = &patseq($maxnum);
105	$lastpat = pop(@patseq);
106	$argv = &rangeargs("$lastpat-$maxnum");
107	} else {
108	$argv = &rangeargs(@ARGV);
109	}
110
111	@ARGV = split(' ',$argv);
112	$argv =~ s/ $//;
113
114	if ($#ARGV < 0) {
115	print STDERR "$progname: no patches specified.\n";
116	&usage;
117	} elsif ($#ARGV) {
118	print "$progname: sending $package $baserev patches $argv to $dest...\n";
119	} else {
120	print "$progname: sending $package $baserev patch $argv to $dest...\n";
121	}
122
123	chdir 'bugs' \|\| die "$progname: can't cd to bugs: $!\n";
124
125	fork && exit;
126
127	$opt = '-odq' if $mailer =~ /sendmail/;
128
129	until ($#ARGV < 0) {
130	$patnum = shift;
131
132	# I hate broken mailers! Bust it up into smaller groups of people...
133	@dest = split(' ', $dest);
134	while (@smalldest = splice(@dest, 0, 50)) {
135	$to = join(', ', @smalldest); # Sensible To: for sendmail
136	$smalldest = join(' ', @smalldest);
137
138	open(MAILER, "\|$mailer $opt $smalldest") \|\|
139	die "$progname: can't fork $mailer: $!\n";
140	print MAILER
141	"To: $to
142	Subject: $package $baserev patch #$patnum
143	Precedence: bulk
144	X-Mailer: dist [version $version PL$patchlevel]
145	Organization: $orgname
146
147	";
148	print MAILER
149	"$package version $baserev has been recently upgraded with the following patch,
150	which is being mailed directly to you as you requested when running Configure.
151
152	If you are not interested in having future patches mailed directly to you,
153	please send me the following mail:
154
155	Subject: Command
156	\@SH package - $package $baserev
157
158	-- $progname speaking for $maintname <$maintloc>.
159
160	" if ($opt_i \|\| $opt_u);
161	print MAILER
162	"[The latest patch for $package version $baserev is #$maxnum.]
163
164	";
165	open(PATCH,"patch$patnum") \|\|
166	die "$progname: can't open patch$patnum: $!\n";
167	while (<PATCH>) {
168	print MAILER;
169	}
170	close PATCH;
171	close MAILER;
172	die "$progname: could not mail patch$patnum.\n" if $?;
173	}
174	}
175
176	sub usage {
177	print STDERR <<EOM;
178	Usage: $progname [-hiquV] [patchlist] [recipients]
179	-h : print this message and exit
180	-i : include information on how to stop receiving future patches
181	-q : quick mode, do not offer to edit recipient list
182	-u : add all to-be-mailed users
183	-V : print version number and exit
184	EOM
185	exit 1;
186	}
187
188	sub readpackage {
189	if (! -f '.package') {
190	if (
191	-f '../.package' \|\|
192	-f '../../.package' \|\|
193	-f '../../../.package' \|\|
194	-f '../../../../.package'
195	) {
196	die "Run in top level directory only.\n";
197	} else {
198	die "No .package file! Run packinit.\n";
199	}
200	}
201	open(PACKAGE,'.package');
202	while (<PACKAGE>) {
203	next if /^:/;
204	next if /^#/;
205	if (($var,$val) = /^\s(\w+)=(.)/) {
206	$val = "\"$val\"" unless $val =~ /^['"]/;
207	eval "\$$var = $val;";
208	}
209	}
210	close PACKAGE;
211	}
212
213	sub rangeargs {
214	local($result) = '';
215	local($min,$max,$_);
216	open(PL,"patchlevel.h") \|\| die "Can't open patchlevel.h\n";
217	while (<PL>) {
218	$maxspec = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
219	}
220	close PL;
221	die "Malformed patchlevel.h file.\n" if $maxspec eq '';
222	while ($#_ >= 0) {
223	$_ = shift(@_);
224	while (/^\s*\d/) {
225	s/^\s*(\d+)//;
226	$min = $1;
227	if (s/^,//) {
228	$max = $min;
229	} elsif (s/^-(\d*)//) {
230	$max = $1;
231	if ($max == 0 && $maxspec) {
232	$max = $maxspec;
233	}
234	s/^[^,],?//;
235	} else {
236	$max = $min;
237	}
238	for ($i = $min; $i <= $max; ++$i) {
239	$result .= $i . ' ';
240	}
241	}
242	}
243	$result;
244	}
245
246	sub readusers {
247	return unless open(USERS, 'users');
248	local($_);
249	local($status, $name, $pl);
250	while (<USERS>) {
251	next if /^#/;
252	chop if /\n$/; # Emacs may leave final line without \n
253	($status, $pl, $name) = split;
254	# Handle oldstyle two-field user file format (PL13 and before)
255	$name = $pl unless defined $name;
256	if ($status eq 'M') {
257	$recipients = $recipients ? "$recipients $name" : $name;
258	} elsif ($status eq 'N') {
259	$notify = $notify ? "$notify $name" : $name;
260	}
261	}
262	close USERS;
263	}
264
265	# Compute patch sequence by scanning the bugs directory and looking for
266	# .logs and/or .mods files to determine what was the last issued patch series.
267	sub patseq {
268	local($cur) = @_; # Current patch level
269	local(@seq); # Issued patch sequence
270	local($i);
271	for ($i = 1; $i <= $cur; $i++) {
272	push(@seq, $i) if -f "bugs/.logs$i" \|\| -f "bugs/.mods$i";
273	}
274	@seq;
275	}
276
277	# Perform ~name expansion ala ksh...
278	# (banish csh from your vocabulary ;-)
279	sub tilda_expand {
280	local($path) = @_;
281	return $path unless $path =~ /^~/;
282	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
283	$path =~ s:^~:$ENV{'HOME'} \|\| (getpwuid($<))[$[+7]:e; # ~
284	$path;
285	}
286
287	# Compute suitable editor name
288	sub geteditor {
289	local($editor) = $ENV{'VISUAL'};
290	$editor = $ENV{'EDITOR'} unless $editor;
291	$editor = $defeditor unless $editor;
292	$editor = 'vi' unless $editor;
293	$editor;
294	}
295
296	# Allow user to inplace-edit a list of items held in an array
297	sub listedit {
298	local(*list) = @_;
299	local($tmp) = "/tmp/dist.$$";
300	local($editor) = &geteditor;
301	open(TMP, ">$tmp") \|\| die "Can't create $tmp: $!\n";
302	foreach $item (@list) {
303	print TMP $item, "\n";
304	}
305	close TMP;
306	system "$editor $tmp";
307	open(TMP, "$tmp") \|\| die "Can't reopen $tmp: $!\n";
308	chop(@list = <TMP>);
309	close TMP;
310	unlink $tmp;
311	}
312
313	# Set up profile components into %Profile, add any profile-supplied options
314	# into @ARGV and return the command invocation name.
315	sub profile {
316	local($profile) = &tilda_expand($ENV{'DIST'} \|\| '~/.dist_profile');
317	local($me) = $0; # Command name
318	$me =~ s\|./(.)\|$1\|; # Keep only base name
319	return $me unless -s $profile;
320	local(*PROFILE); # Local file descriptor
321	local($options) = ''; # Options we get back from profile
322	unless (open(PROFILE, $profile)) {
323	warn "$me: cannot open $profile: $!\n";
324	return;
325	}
326	local($_);
327	local($component);
328	while (<PROFILE>) {
329	next if /^\s*#/; # Skip comments
330	next unless /^$me/o;
331	if (s/^$me://o) { # progname: options
332	chop;
333	$options .= $_; # Merge options if more than one line
334	}
335	elsif (s/^$me-([^:]+)://o) { # progname-component: value
336	$component = $1;
337	chop;
338	s/^\s+//; # Trim leading and trailing spaces
339	s/\s+$//;
340	$Profile{$component} = $_;
341	}
342	}
343	close PROFILE;
344	return unless $options;
345	require 'shellwords.pl';
346	local(@opts);
347	eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
348	unshift(@ARGV, @opts);
349	return $me; # Return our invocation name
350	}
351