[metaconfig.git] / bin / kitpost

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

# $Id: kitpost.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.
#
# $Log: kitpost.SH,v $
# Revision 3.0.1.2  1994/10/29  15:48:26  ram
# patch36: don't use rootid as a variable, it is known by metaconfig
#
# Revision 3.0.1.1  1994/05/06  13:54:53  ram
# patch23: created
#

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

$progname = &profile;	# Read ~/.dist_profile
require 'getopts.pl';
&usage unless $#ARGV >= 0;
&usage unless &Getopts("hrVm:D:H:");

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

$RCSEXT = ',v' unless $RCSEXT;
if ($inews eq 'inews') {
	$inews = '/usr/lib/news/inews' if -f '/usr/lib/news/inews';
}

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

&readpackage;

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

if ($opt_r) {
	$repost = ' (REPOST)';
}

while ($_ = shift) {
	if (/^(kit)?[1-9][\d\-]*$/) {
		s/^kit//;
		push(@argv,$_);
	} else {
		push(@ngroups,$_);
	}
}
$ngroups = join(',',@ngroups) unless $#ngroups < 0;
$dest = $opt_m;
&usage unless $ngroups || $dest;

@ARGV = @argv;

if (-f "$package.kit10") {
	@filelist = <$package.kit[0-9][0-9]>;
}
else {
	@filelist = <$package.kit[0-9]>;
}
pop(@filelist) =~ /(\d+)$/ && ($maxnum = $1 + 0);

if ($#ARGV < 0) {
	$argv = "1-$maxnum";
	@ARGV = $argv;
}

$argv = &rangeargs(@ARGV);
@ARGV = split(' ', $argv);

$argv =~ s/ $//;

if ($#ARGV < 0) {
	print STDERR "$progname: no kits specified.\n";
	&usage;
} else {
	local($s) = $#ARGV ? 's' : '';
	print "$progname: posting $package $baserev kit$s $argv to $ngroups...\n"
		if $ngroups;
	print "$progname: mailing $package $baserev kit$s $argv to $dest...\n"
		if $dest;
}

$desc = "$opt_D, " if $opt_D;

fork && exit;

# Compute a suitable root message ID that all parts will reference, so that
# threaded news readers will correctly process them.
# Unfortunately, this works only when all kits are sent.
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
	localtime(time);
$mon++;
$rootmid = "$year$mon$mday$hour$min$sec.AA$$";
$first = $maxnum >= 10 ? "01" : "1";
$rootmsgid = "<$rootmid.P$first.$maintloc>";

until ($#ARGV < 0) {
	$kitnum = shift;
	$kitnum = "0$kitnum" if $kitnum < 10 && $maxnum >= 10;
	open(FILE, "$package.kit$kitnum") ||
		die "$progname: can't open $package.kit$kitnum: $!\n";
	if ($ngroups) {
		open(INEWS,"|$inews -h") || die "$progname: can't fork $inews: $!\n";
	}
	if ($dest) {
		$opt = '-odq' if $mailer =~ /sendmail/;
		$dest =~ s/,/ /g;
		($to = $dest) =~ s/\s+/, /g;
		open(MAILER,"|$mailer $opt $dest") ||
			die "$progname: can't fork $mailer: $!\n";
	}

	$msg_id = "<$rootmid.P$kitnum.$maintloc>";
	$msg_id = $rootmsgid if $kitnum == 1;
	$msg_id .= "\nReferences: $rootmsgid" if $kitnum != 1;

	print INEWS "Newsgroups: $ngroups\n";
	print MAILER "To: $to\n";
$head = <<EOH;
Subject: $package $baserev - ${desc}part$kitnum/$maxnum$repost
Message-ID: $msg_id
Organization: $orgname

Submitted-by: $maintname <$maintloc>
Archive-name: $package-$baserev/part$kitnum
Environment: UNIX

EOH
	print INEWS $head;
	print MAILER $head;

	if ($kitnum == 1 && $opt_H) {
		open(HEAD, $opt_H) || warn "$progname: can't open $opt_H: $!\n";
		while (<HEAD>) {
			print INEWS;
			print MAILER;
		}
		close HEAD;
	}

	while (<FILE>) {
		print INEWS;
		print MAILER;
	}
	close FILE;
	close INEWS;
	die "$progname: could not post part$kitnum.\n" if $ngroups && $?;
	close MAILER;
	die "$progname: could not send part$kitnum.\n" if $dest && $?;
}

sub usage {
	print STDERR <<EOM;
Usage: $progname [-hrV] [-H file] [-D desc] [-m dest1,dest2] [kits] [newsgroups]
  -h : print this message and exit
  -m : set-up recipients for (additional) mailing
  -r : signals a repost
  -D : specify description string for subject line
  -H : specify file to be used as header for first part
  -V : print version number and exit
EOM
	exit 1;
}

sub rangeargs {
	local($result) = '';
	local($min,$max,$_);
	while ($#_ >= 0) {
		$_ = shift(@_);
		while (/^\s*\d/) {
			s/^\s*(\d+)//;
			$min = $1;
			if (s/^,//) {
				$max = $min;
			}
			elsif (s/^-(\d*)//) {
				$max = $1;
				if ($max == 0 && $maxnum) {
					$max = $maxnum;
				}
				s/^[^,],?//;
			}
			else {
				$max = $min;
			}
			for ($i = $min; $i <= $max; ++$i) {
				$result .= $i . ' ';
			}
		}
	}
	$result;
}

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;
}

# 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;
}

# 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: 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