#!/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 = < 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 () { print INEWS; print MAILER; } close HEAD; } while () { 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 <= 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 () { 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 () { 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 }