bin/kitsend

   1 #!/usr/bin/perl
   2         eval 'exec perl -S $0 "$@"'
   3                 if $running_under_some_shell;
   4
   5 # $Id: kitsend.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: Harlan Stenn <harlan@mumps.pfcs.com>
  16 #
  17 # $Log: kitsend.SH,v $
  18 # Revision 3.0.1.2  1994/05/06  13:59:57  ram
  19 # patch23: random code cleanup to follow pat tools style
  20 # patch23: made configurable from dist profile
  21 # patch23: now understands -V and -h options
  22 # patch23: mails now flagged with a bulk precedence
  23 # patch23: added X-Mailer header and now calls mailer via open()
  24 #
  25 # Revision 3.0.1.1  1993/08/19  06:42:15  ram
  26 # patch1: leading config.sh searching was not aborting properly
  27 #
  28 # Revision 3.0  1993/08/18  12:04:25  ram
  29 # Baseline for dist 3.0 netwide release.
  30 #
  31
  32 $orgname='PROCURA B.V.';
  33 $mailer='/usr/sbin/sendmail';
  34 $version = '3.5';
  35 $patchlevel = '0';
  36
  37 $progname = &profile;           # Read ~/.dist_profile
  38 require 'getopts.pl';
  39 &usage unless &Getopts('hV');
  40
  41 if ($opt_V) {
  42         print STDERR "$progname $version PL$patchlevel\n";
  43         exit 0;
  44 } elsif ($opt_h) {
  45         &usage;
  46 }
  47
  48 $orgname = &tilda_expand($orgname);
  49 chop($orgname = `cat $orgname`) if $orgname =~ m|^/|;
  50
  51 &readpackage;
  52
  53 while ($_ = shift) {
  54         if (/^(kit)?[1-9][\d,-]*$/) {
  55                 s/^kit//;
  56                 push(@argv, $_);
  57         }
  58         else {
  59                 push(@dest, $_);
  60         }
  61 }
  62 $dest = join(' ',@dest);
  63 &usage unless $dest;
  64
  65 @ARGV = @argv;
  66
  67 if (-f "$package.kit10") {
  68         @filelist = <$package.kit[0-9][0-9]>;
  69 }
  70 else {
  71         @filelist = <$package.kit[0-9]>;
  72 }
  73 pop(@filelist) =~ /(\d+)$/ && ($maxnum = $1 + 0);
  74
  75 if ($#ARGV < 0) {
  76         $argv = "1-$maxnum";
  77         @ARGV = $argv;
  78 }
  79 $argv = &rangeargs(@ARGV);
  80 @ARGV = split(' ', $argv);
  81
  82 $argv =~ s/ $//;
  83
  84 if ($#ARGV < 0) {
  85         die "$progname: no kits specified.\n";
  86 } elsif ($#ARGV) {
  87         print "$progname: sending $package $baserev kits $argv to $dest...\n";
  88 } else {
  89         print "$progname: sending $package $baserev kit $argv to $dest...\n";
  90 }
  91
  92 fork && exit;
  93
  94 $opt = '-odq' if $mailer =~ /sendmail/;
  95
  96 until ($#ARGV < 0) {
  97         $kitnum = shift;
  98
  99         # Provision for broken mailers...
 100         @dest = split(' ', $dest);
 101         while (@smalldest = splice(@dest, 0, 50)) {
 102                 $to = join(', ', @smalldest);   # Sensible To: for sendmail
 103                 $smalldest = join(' ', @smalldest);
 104
 105                 open(MAILER, "|$mailer $opt $smalldest") ||
 106                         die "$progname: can't fork $mailer: $!\n";
 107                 print MAILER
 108 "To: $to
 109 Subject: $package $baserev kit #$kitnum
 110 Precedence: bulk
 111 X-Mailer: dist [version $version PL$patchlevel]
 112 Organization: $orgname
 113
 114 [There are $maxnum kits for $package version $baserev.]
 115
 116 ";
 117                 $kitnum = "0$kitnum" if $kitnum < 10 && $maxnum >= 10;
 118                 open(FILE,"$package.kit$kitnum") ||
 119                         die "$progname: can't open $package.kit$kitnum: $!\n";
 120                 while (<FILE>) {
 121                         print MAILER;
 122                 }
 123                 close FILE;
 124                 close MAILER;
 125                 warn "$progname: ERROR mailing of $package.kit$kitnum to $dest\n" if $?;
 126         }
 127 }
 128
 129 sub usage {
 130         print STDERR <<EOM;
 131 Usage: $progname [-hV] [kits] dest
 132   -h : print this message and exit
 133   -V : print version number and exit
 134 EOM
 135         exit 1;
 136 }
 137
 138 sub rangeargs {
 139         local($result) = '';
 140         local($min,$max,$_);
 141         while ($#_ >= 0) {
 142                 $_ = shift(@_);
 143                 while (/^\s*\d/) {
 144                         s/^\s*(\d+)//;
 145                         $min = $1;
 146                         if (s/^,//) {
 147                                 $max = $min;
 148                         }
 149                         elsif (s/^-(\d*)//) {
 150                                 $max = $1;
 151                                 if ($max == 0 && $maxnum) {
 152                                         $max = $maxnum;
 153                                 }
 154                                 s/^[^,],?//;
 155                         }
 156                         else {
 157                                 $max = $min;
 158                         }
 159                         for ($i = $min; $i <= $max; ++$i) {
 160                                 $result .= $i . ' ';
 161                         }
 162                 }
 163         }
 164         $result;
 165 }
 166
 167 sub readpackage {
 168         if (! -f '.package') {
 169                 if (
 170                         -f '../.package' ||
 171                         -f '../../.package' ||
 172                         -f '../../../.package' ||
 173                         -f '../../../../.package'
 174                 ) {
 175                         die "Run in top level directory only.\n";
 176                 } else {
 177                         die "No .package file!  Run packinit.\n";
 178                 }
 179         }
 180         open(PACKAGE,'.package');
 181         while (<PACKAGE>) {
 182                 next if /^:/;
 183                 next if /^#/;
 184                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
 185                         $val = "\"$val\"" unless $val =~ /^['"]/;
 186                         eval "\$$var = $val;";
 187                 }
 188         }
 189         close PACKAGE;
 190 }
 191
 192 # Perform ~name expansion ala ksh...
 193 # (banish csh from your vocabulary ;-)
 194 sub tilda_expand {
 195         local($path) = @_;
 196         return $path unless $path =~ /^~/;
 197         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
 198         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
 199         $path;
 200 }
 201
 202 # Set up profile components into %Profile, add any profile-supplied options
 203 # into @ARGV and return the command invocation name.
 204 sub profile {
 205         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
 206         local($me) = $0;                # Command name
 207         $me =~ s|.*/(.*)|$1|;   # Keep only base name
 208         return $me unless -s $profile;
 209         local(*PROFILE);                # Local file descriptor
 210         local($options) = '';   # Options we get back from profile
 211         unless (open(PROFILE, $profile)) {
 212                 warn "$me: cannot open $profile: $!\n";
 213                 return;
 214         }
 215         local($_);
 216         local($component);
 217         while (<PROFILE>) {
 218                 next if /^\s*#/;        # Skip comments
 219                 next unless /^$me/o;
 220                 if (s/^$me://o) {       # progname: options
 221                         chop;
 222                         $options .= $_; # Merge options if more than one line
 223                 }
 224                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
 225                         $component = $1;
 226                         chop;
 227                         s/^\s+//;               # Trim leading and trailing spaces
 228                         s/\s+$//;
 229                         $Profile{$component} = $_;
 230                 }
 231         }
 232         close PROFILE;
 233         return unless $options;
 234         require 'shellwords.pl';
 235         local(@opts);
 236         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
 237         unshift(@ARGV, @opts);
 238         return $me;                             # Return our invocation name
 239 }
 240