bin/kitpost

   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