dist-3.0at70b/pat/patsend

   1 #!/usr/bin/perl
   2         eval "exec perl -S $0 $*"
   3                 if $running_under_some_shell;
   4
   5 # $Id: patsend.SH,v 3.0.1.6 1995/09/25 09:22:02 ram Exp $
   6 #
   7 #  Copyright (c) 1991-1993, 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 3.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='Illuminati';
  46 $mailer='/usr/sbin/sendmail';
  47 $version = '3.0';
  48 $patchlevel = '70';
  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