bin/patftp

   1 #!/usr/bin/perl
   2         eval "exec perl -S $0 $*"
   3                 if $running_under_some_shell;
   4
   5 # $Id: patftp.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: Larry Wall <lwall@netlabs.com>
  16 #
  17 # $Log: patftp.SH,v $
  18 # Revision 3.0.1.3  1994/01/24  14:30:43  ram
  19 # patch16: now prefix error messages with program's name
  20 # patch16: added ~/.dist_profile awareness
  21 #
  22 # Revision 3.0.1.2  1993/08/24  12:16:57  ram
  23 # patch3: removed useless orgname variable
  24 #
  25 # Revision 3.0.1.1  1993/08/19  06:42:36  ram
  26 # patch1: leading config.sh searching was not aborting properly
  27 #
  28 # Revision 3.0  1993/08/18  12:10:44  ram
  29 # Baseline for dist 3.0 netwide release.
  30 #
  31
  32 $version = '3.5';
  33 $patchlevel = '0';
  34
  35 $progname = &profile;   # Read ~/.dist_profile
  36 require 'getopts.pl';
  37 &usage unless &Getopts("hV");
  38
  39 if ($opt_V) {
  40         print STDERR "$progname $version PL$patchlevel\n";
  41         exit 0;
  42 } elsif ($opt_h) {
  43         &usage;
  44 }
  45
  46 $RCSEXT = ',v' unless $RCSEXT;
  47 chdir '..' if -d '../bugs';
  48
  49 &readpackage;
  50
  51 if ($#ARGV < 0) {
  52         open(PL,"patchlevel.h") || die "$progname: can't open patchlevel.h: $!\n";
  53         while (<PL>) {
  54                 $argv = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
  55         }
  56         close PL;
  57         die "$progname: malformed patchlevel.h file.\n" if $argv eq '';
  58         @ARGV = $argv;
  59 } else {
  60         for (@ARGV) {
  61                 s/^patch//;
  62         }
  63         $argv = &rangeargs(@ARGV);
  64         @ARGV = split(' ',$argv);
  65 }
  66
  67 if ($#ARGV < 0) {
  68         print STDERR  "$progname: no patches specified.\n";
  69         &usage;
  70 } elsif ($#ARGV) {
  71         print "$progname: copying $package $baserev patches $argv to $ftpdir...\n";
  72 } else {
  73         print "$progname: copying $package $baserev patch $argv to $ftpdir...\n";
  74 }
  75
  76 chdir 'bugs' || die "$progname: can't cd to bugs: $!\n";
  77
  78 until ($#ARGV < 0) {
  79         $patnum = shift;
  80         `cp patch$patnum $ftpdir`;
  81 }
  82
  83 sub usage {
  84         print STDERR <<EOM;
  85 Usage: $progname [-hV] patchlist
  86   -h : print this message and exit
  87   -V : print version number and exit
  88 EOM
  89         exit 1;
  90 }
  91
  92 sub readpackage {
  93         if (! -f '.package') {
  94                 if (
  95                         -f '../.package' ||
  96                         -f '../../.package' ||
  97                         -f '../../../.package' ||
  98                         -f '../../../../.package'
  99                 ) {
 100                         die "Run in top level directory only.\n";
 101                 } else {
 102                         die "No .package file!  Run packinit.\n";
 103                 }
 104         }
 105         open(PACKAGE,'.package');
 106         while (<PACKAGE>) {
 107                 next if /^:/;
 108                 next if /^#/;
 109                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
 110                         $val = "\"$val\"" unless $val =~ /^['"]/;
 111                         eval "\$$var = $val;";
 112                 }
 113         }
 114         close PACKAGE;
 115 }
 116
 117 sub rangeargs {
 118         local($result) = '';
 119         local($min,$max,$_);
 120         open(PL,"patchlevel.h") || die "Can't open patchlevel.h\n";
 121         while (<PL>) {
 122                 $maxspec = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
 123         }
 124         close PL;
 125         die "Malformed patchlevel.h file.\n" if $maxspec eq '';
 126         while ($#_ >= 0) {
 127                 $_ = shift(@_);
 128                 while (/^\s*\d/) {
 129                         s/^\s*(\d+)//;
 130                         $min = $1;
 131                         if (s/^,//) {
 132                                 $max = $min;
 133                         } elsif (s/^-(\d*)//) {
 134                                 $max = $1;
 135                                 if ($max == 0 && $maxspec) {
 136                                         $max = $maxspec;
 137                                 }
 138                                 s/^[^,],?//;
 139                         } else {
 140                                 $max = $min;
 141                         }
 142                         for ($i = $min; $i <= $max; ++$i) {
 143                                 $result .= $i . ' ';
 144                         }
 145                 }
 146         }
 147         $result;
 148 }
 149
 150 # Perform ~name expansion ala ksh...
 151 # (banish csh from your vocabulary ;-)
 152 sub tilda_expand {
 153         local($path) = @_;
 154         return $path unless $path =~ /^~/;
 155         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
 156         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
 157         $path;
 158 }
 159
 160 # Set up profile components into %Profile, add any profile-supplied options
 161 # into @ARGV and return the command invocation name.
 162 sub profile {
 163         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
 164         local($me) = $0;                # Command name
 165         $me =~ s|.*/(.*)|$1|;   # Keep only base name
 166         return $me unless -s $profile;
 167         local(*PROFILE);                # Local file descriptor
 168         local($options) = '';   # Options we get back from profile
 169         unless (open(PROFILE, $profile)) {
 170                 warn "$me: cannot open $profile: $!\n";
 171                 return;
 172         }
 173         local($_);
 174         local($component);
 175         while (<PROFILE>) {
 176                 next if /^\s*#/;        # Skip comments
 177                 next unless /^$me/o;
 178                 if (s/^$me://o) {       # progname: options
 179                         chop;
 180                         $options .= $_; # Merge options if more than one line
 181                 }
 182                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
 183                         $component = $1;
 184                         chop;
 185                         s/^\s+//;               # Trim leading and trailing spaces
 186                         s/\s+$//;
 187                         $Profile{$component} = $_;
 188                 }
 189         }
 190         close PROFILE;
 191         return unless $options;
 192         require 'shellwords.pl';
 193         local(@opts);
 194         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
 195         unshift(@ARGV, @opts);
 196         return $me;                             # Return our invocation name
 197 }
 198