bin/patmake

   1 #!/usr/bin/perl
   2         eval "exec perl -S $0 $*"
   3                 if $running_under_some_shell;
   4
   5 # $Id: patmake.SH 20 2008-01-04 23:14:00Z 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 # Contribution by: Graham Stoney <greyham@research.canon.oz.au>
  17 #
  18 # $Log: patmake.SH,v $
  19 # Revision 3.0.1.5  1995/09/25  09:21:19  ram
  20 # patch59: now calls patsend with -i to add more instructions
  21 #
  22 # Revision 3.0.1.4  1994/10/29  16:43:09  ram
  23 # patch36: a lot of setup is now performed by patlog
  24 # patch36: added various escapes in strings for perl5 support
  25 #
  26 # Revision 3.0.1.3  1994/01/24  14:30:55  ram
  27 # patch16: now prefix error messages with program's name
  28 # patch16: added ~/.dist_profile awareness
  29 #
  30 # Revision 3.0.1.2  1993/08/24  12:18:59  ram
  31 # patch3: now asks for patch mailing/posting after all patches edited
  32 # patch3: patch release notification is done via new patnotify
  33 # patch3: random cleanup, removed old RCS logs
  34 #
  35 # Revision 3.0.1.1  1993/08/19  06:42:38  ram
  36 # patch1: leading config.sh searching was not aborting properly
  37 #
  38 # Revision 3.0  1993/08/18  12:10:45  ram
  39 # Baseline for dist 3.0 netwide release.
  40 #
  41
  42 $defeditor='/usr/bin/vi';
  43 $version = '3.5';
  44 $patchlevel = '0';
  45 $mailer = '/usr/sbin/sendmail';
  46
  47 $progname = &profile;   # Read ~/.dist_profile
  48 require 'getopts.pl';
  49 &usage unless &Getopts("hV");
  50
  51 if ($opt_V) {
  52         print STDERR "$progname $version PL$patchlevel\n";
  53         exit 0;
  54 } elsif ($opt_h) {
  55         &usage;
  56 }
  57
  58 &readpackage;
  59 &readusers;
  60
  61 $FILEOVERHEAD = 40;             # Name of files, Index, Prereq
  62 $MAXPATSIZE = 50000;    # Maximum allowed size for a patch
  63 $PATOVERHEAD = 2500;    # Litterature
  64 $FIRST_PAT = 3000;              # Give space for first patch (descriptions)
  65
  66 if (-f 'patchlevel.h') {
  67         open(PL,"patchlevel.h") || die "$progname: can't open patchlevel.h: $!\n";
  68         while (<PL>) {
  69                 if (/^#define\s+PATCHLEVEL\s+(\d+)/) {
  70                         $last = $1;
  71                         $patchline = $.;        # Record PATCHLEVEL line
  72                 }
  73         }
  74         die "$progname: malformed patchlevel.h file.\n" if $last eq '';
  75         $bnum = $last + 1;
  76 }
  77 else {
  78         $patchline = 1;
  79         $bnum = 1;
  80         $last = '';
  81 }
  82
  83 @ARGV = <[Mm]akefile*>;
  84 $mf = '';
  85 if ($#ARGV > 0) {
  86         while (<>) {
  87                 $mf .= $_ if /^[a-z.]+\s*:/;    # Rules in makefile
  88         }
  89 }
  90 $after = '';
  91 $after .= "\t\tConfigure -ders\n" if -f 'Configure';
  92 $after .= "\t\tmake depend\n" if $mf =~ /^depend:/m;
  93 $after .= "\t\tmake\n" if $mf;
  94 $after .= "\t\tmake test\n" if $mf =~ /^test:/m;
  95 $after .= "\t\tmake install\n" if $mf =~ /^install:/m;
  96 $after .= "\t\tmake install.man\n" if $mf =~ /^install\.man:/m;
  97
  98 chdir 'bugs' if -d 'bugs';
  99 die "$progname: patch #$bnum already exists.\n" if -f "patch$bnum";
 100
 101 @patlist=<*.$bnum>;
 102 die "$progname: no diff files for patch #$bnum.\n" if
 103         $patlist[0] =~ /^\*/ || $patlist[0] eq '';
 104
 105 # Whether they asked for a changelog file or not, call patlog.
 106 # This will create at least the .pri and .subj and .clog files that we need.
 107 # If a changelog file is needed, it will update it and create the necessary
 108 # patch before we go on and put all those patches together.
 109 # Note that we make use of the '-r' option, in case they have already
 110 # run patlog themselves and made the necessary adjustments. Since -r supersedes
 111 # -u, it's safe to allow ~/.dist_profile processing anyway.
 112
 113 chdir '..' if -d '../bugs';
 114 system 'perl', '-S', 'patlog', '-r';    # Must be called from top-level dir
 115 chdir 'bugs' if -d 'bugs';
 116
 117 @patlist=<*.$bnum>;             # Reget it, in case Changes.xx appeared due to patlog
 118
 119 # Look for size of each diff file
 120 for (@patlist) {
 121         ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
 122                 $blksize,$blocks) = stat($_);
 123         $size{$_} = $size;
 124 }
 125
 126 # Sort the array, biggest sizes first
 127 sub revnum { $size{$a} < $size{$b} ? 1 : $size{$a} > $size{$b} ? -1 : 0; }
 128 @patlist = sort revnum @patlist;
 129
 130 # Put files in a patch
 131 for (@patlist) {
 132         $i=1;
 133         # Find the patch in which the current file can go
 134         # Divide size by 15 to count the 3 spaces added in front of each line
 135         while (($newtot = int($tot[$i] + $size{$_} + $size{$_}/15 + $FILEOVERHEAD)) >
 136                         $MAXPATSIZE-$PATOVERHEAD-($i == 1 ? $FIRST_PAT : 0) && $tot[$i]) {
 137                 $i++;
 138         }
 139         # Adding $_ to patch $i giving $newtot bytes
 140         $tot[$i] = $newtot;             # Update size of kit $i
 141         $list[$i] .= " $_";             # Add file to the kit $i
 142 }
 143
 144 $numpat = $#list;               # Number of patches to generate
 145
 146 if ($numpat > 1) {
 147         print "$progname: Warning: generating $numpat patches.\n";
 148         sleep(1);
 149 }
 150
 151 $hah = " (hah!)" if $bnum == 1;
 152 $patbase = $bnum;                       # First patch generated
 153
 154 open(PRIORITY, ".pri$bnum");
 155 chop($priority = <PRIORITY>);
 156 close PRIORITY;
 157 $priority = 'LOW' unless $priority;
 158
 159 for ($i = 1; $i <= $numpat; $i++) {             # For all patches...
 160         open(PATCH,">patch$bnum") || die "Can't create patch #$bnum";
 161         chop($date=`date`);
 162         print PATCH
 163 "System: $package version $baserev
 164 Patch #: $bnum
 165 ";
 166         print PATCH "Priority: $priority\n" unless $priority eq '';
 167         # Print subjects only for first patch
 168         if ($i == 1) {
 169                 open(SUBJECTS, ".subj$bnum");
 170                 print PATCH while <SUBJECTS>;
 171                 close SUBJECTS;
 172         } else {
 173                 print PATCH "Subject: patch #$patbase, continued\n";
 174         }
 175         print PATCH
 176 "Date: $date
 177 From: $maintname <$maintloc>
 178
 179 Description:
 180 ";
 181         # Print description and repeat-by only for first patch
 182         if ($i == 1) {
 183                 open(LOGS, ".clog$bnum");
 184                 $_ = <LOGS>; $_ = <LOGS>; $_ = <LOGS>;  # Skip first three lines
 185                 print PATCH while <LOGS>;
 186                 close LOGS;
 187                 print PATCH "Repeat-By: \n";
 188         } else {
 189                 print PATCH "\tSee patch #$patbase.\n\n";
 190         }
 191         print PATCH
 192 "
 193 Fix:    From rn, say \"| patch -p -N -d DIR\", where DIR is your $package source
 194         directory.  Outside of rn, say \"cd DIR; patch -p -N <thisarticle\".
 195         If you don't have the patch program, apply the following by hand,
 196         or get patch (version 2.0, latest patchlevel).
 197
 198         After patching:
 199 ";
 200         # Do $after only after last patch
 201         if ($i == $numpat) {
 202                 print PATCH $after;
 203         } else {
 204                 printf PATCH
 205 "\t\t*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #%d FIRST ***\n",
 206 $patbase + $numpat - 1;
 207         }
 208         print PATCH "
 209         If patch indicates that patchlevel is the wrong version, you may need
 210         to apply one or more previous patches, or the patch may already
 211         have been applied.  See the patchlevel.h file to find out what has or
 212         has not been applied.  In any event, don't continue with the patch.
 213
 214         If you are missing previous patches$hah they can be obtained from me:
 215
 216                 $maintname <$maintloc>
 217
 218 ";
 219         if ($mailagent ne 'false') {
 220                 print PATCH
 221 "       If you send a mail message of the following form it will greatly speed
 222         processing:
 223
 224                 Subject: Command
 225                 \@SH mailpatch PATH $package $baserev LIST
 226                            ^ note the c
 227
 228         where PATH is a return path FROM ME TO YOU either in Internet notation,
 229         or in bang notation from some well-known host, and LIST is the number
 230         of one or more patches you need, separated by spaces, commas, and/or
 231         hyphens.  Saying 35- says everything from 35 to the end.
 232
 233         To get some more detailed instructions, send me the following mail:
 234
 235                 Subject: Command
 236                 \@SH mailhelp PATH
 237
 238 ";
 239         }
 240         if ($ftpsite) {
 241                 print PATCH
 242 "       You can also get the patches via anonymous FTP from
 243         $ftpsite.
 244 ";
 245         }
 246         # Print patchlevel at the top of each patch
 247         print PATCH "
 248 Index: patchlevel.h
 249 ";
 250         if ($last eq '') {
 251                 `echo "#define PATCHLEVEL 1" >patchlevel.h`;
 252                 `cp /dev/null patchlevel.h.null`;
 253                 print PATCH `diff -c patchlevel.h.null patchlevel.h`;
 254                 unlink 'patchlevel.h', 'patchlevel.h.null';
 255         }
 256         else {
 257                 print PATCH
 258 "Prereq: $last
 259 ${patchline}c${patchline}
 260 < #define PATCHLEVEL $last
 261 ---
 262 > #define PATCHLEVEL $bnum
 263 ";
 264         }
 265         $last = $bnum;                  # Update last patch
 266         push(@patset, $bnum);   # Record set of generated patch(es)
 267
 268         @ARGV = split(' ', $list[$i]);
 269         while (<>) { print PATCH; }
 270         print PATCH "\n*** End of Patch $bnum ***\n";
 271         close PATCH;
 272
 273         # Update patchlevel.h file
 274         $editor = $ENV{'VISUAL'};
 275         $editor = $ENV{'EDITOR'} unless $editor;
 276         $editor = $defeditor unless $editor;
 277         $editor = 'vi' unless $editor;
 278         system $editor, "patch$bnum";
 279         if (-s "patch$bnum") {
 280                 system 'chmod', '-w', "patch$bnum";             # Protect newly created patch
 281                 chdir '..';
 282                 `echo "#define PATCHLEVEL 0" >patchlevel.h` unless -f 'patchlevel.h';
 283                 open(PL,"patchlevel.h") ||
 284                         die "$progname: can't open patchlevel.h: $!\n";
 285                 open(PLN,">patchlevel.h+") ||
 286                         die "$progname: can't create new patchlevel.h: $!\n";
 287                 while (<PL>) {
 288                         if (/^#define\s+PATCHLEVEL\s+(\d+)/) {
 289                                 $bnum = $1;
 290                                 $bnum++;                # Update patch level
 291                                 print PLN "#define PATCHLEVEL $bnum\n";
 292                         } else {
 293                                 print PLN;              # Simply copy other lines
 294                         }
 295                 }
 296                 close PLN;
 297                 close PL;
 298                 `mv -f patchlevel.h+ patchlevel.h`;
 299                 die "$progname: malformed patchlevel.h file.\n" if $bnum eq '';
 300         } else {
 301                 unlink "patch$bnum";
 302                 die "$progname: aborted.\n";
 303         }
 304
 305         chdir 'bugs' || die "$progname: cannot cd to bugs: $!\n";
 306
 307         # Find priority for next patch in loop
 308         $priority='';
 309         open(PATCH, "patch$bnum") || die "Cannot re-open patch #$bnum !\n";
 310         while (<PATCH>) {
 311                 /^Priority:\s*(\S+)\s*$/ && ($priority = $1);
 312         }
 313         close PATCH;
 314
 315         $bnum++;        # For next patch in loop
 316 }
 317
 318 utime time, time, 'patchlevel.h';       # Reset timestamp on patchlevel
 319
 320 if (@patset == 1) {
 321         $bnum = pop(@patset);
 322         $patch = "patch #$bnum";
 323 } else {
 324         $bmin = shift(@patset);
 325         $bmax = pop(@patset);
 326         $bnum = "$bmin-$bmax";
 327         $patch = "patches #$bmin thru #$bmax";
 328 }
 329
 330 # Post generated patches
 331 if ($newsgroups) {
 332         print "\nDo you wish to post $patch to $newsgroups? [y] ";
 333         $ans = <stdin>;
 334         system 'patpost', $bnum unless $ans =~ /^n/i;
 335 }
 336
 337 # Mail generated patches
 338 if ($recipients) {
 339         print "\n";
 340         if (0 == ($recipients =~ tr/ //)) {
 341                 print "Do you wish to send $patch to $recipients? [y] ";
 342         } else {
 343                 print "The following people are on the recipient list:\n\n";
 344                 foreach $addr (split(' ', $recipients)) {
 345                         print "\t$addr\n";
 346                 }
 347                 print "\nDo you wish to send $patch to them? [y] ";
 348         }
 349         $ans = <stdin>;
 350         system 'patsend', '-i', $bnum, $recipients unless $ans =~ /^n/i;
 351 }
 352
 353 # Copy patches to FTP directory
 354 if ($ftpdir) {
 355         print "\nDo you wish to copy $patch to $ftpdir? [y] ";
 356         $ans = <stdin>;
 357         system 'patftp', $bnum unless $ans =~ /^n/i;
 358 }
 359
 360 # Notify people about it.
 361 if ($notify) {
 362         print "\n";
 363         if (0 == ($notify =~ tr/ //)) {
 364                 print "Do you wish to notify $notify? [y] ";
 365         } else {
 366                 print "The following people are on the notify list:\n\n";
 367                 foreach $addr (split(' ', $notify)) {
 368                         print "\t$addr\n";
 369                 }
 370                 print "\nDo you wish to notify them? [y] ";
 371         }
 372         $ans = <STDIN>;
 373         system 'patnotify', $notify unless $ans =~ /^n/i;
 374 }
 375
 376 sub usage {
 377         print STDERR <<EOM;
 378 Usage: $progname [-hV]
 379   -h : print this message and exit
 380   -V : print version number and exit
 381 EOM
 382         exit 1;
 383 }
 384
 385 sub readpackage {
 386         if (! -f '.package') {
 387                 if (
 388                         -f '../.package' ||
 389                         -f '../../.package' ||
 390                         -f '../../../.package' ||
 391                         -f '../../../../.package'
 392                 ) {
 393                         die "Run in top level directory only.\n";
 394                 } else {
 395                         die "No .package file!  Run packinit.\n";
 396                 }
 397         }
 398         open(PACKAGE,'.package');
 399         while (<PACKAGE>) {
 400                 next if /^:/;
 401                 next if /^#/;
 402                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
 403                         $val = "\"$val\"" unless $val =~ /^['"]/;
 404                         eval "\$$var = $val;";
 405                 }
 406         }
 407         close PACKAGE;
 408 }
 409
 410 sub readusers {
 411         return unless open(USERS, 'users');
 412         local($_);
 413         local($status, $name, $pl);
 414         while (<USERS>) {
 415                 next if /^#/;
 416                 chop if /\n$/;                          # Emacs may leave final line without \n
 417                 ($status, $pl, $name) = split;
 418                 # Handle oldstyle two-field user file format (PL13 and before)
 419                 $name = $pl unless defined $name;
 420                 if ($status eq 'M') {
 421                         $recipients = $recipients ? "$recipients $name" : $name;
 422                 } elsif ($status eq 'N') {
 423                         $notify = $notify ? "$notify $name" : $name;
 424                 }
 425         }
 426         close USERS;
 427 }
 428
 429 # Perform ~name expansion ala ksh...
 430 # (banish csh from your vocabulary ;-)
 431 sub tilda_expand {
 432         local($path) = @_;
 433         return $path unless $path =~ /^~/;
 434         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
 435         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
 436         $path;
 437 }
 438
 439 # Set up profile components into %Profile, add any profile-supplied options
 440 # into @ARGV and return the command invocation name.
 441 sub profile {
 442         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
 443         local($me) = $0;                # Command name
 444         $me =~ s|.*/(.*)|$1|;   # Keep only base name
 445         return $me unless -s $profile;
 446         local(*PROFILE);                # Local file descriptor
 447         local($options) = '';   # Options we get back from profile
 448         unless (open(PROFILE, $profile)) {
 449                 warn "$me: cannot open $profile: $!\n";
 450                 return;
 451         }
 452         local($_);
 453         local($component);
 454         while (<PROFILE>) {
 455                 next if /^\s*#/;        # Skip comments
 456                 next unless /^$me/o;
 457                 if (s/^$me://o) {       # progname: options
 458                         chop;
 459                         $options .= $_; # Merge options if more than one line
 460                 }
 461                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
 462                         $component = $1;
 463                         chop;
 464                         s/^\s+//;               # Trim leading and trailing spaces
 465                         s/\s+$//;
 466                         $Profile{$component} = $_;
 467                 }
 468         }
 469         close PROFILE;
 470         return unless $options;
 471         require 'shellwords.pl';
 472         local(@opts);
 473         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
 474         unshift(@ARGV, @opts);
 475         return $me;                             # Return our invocation name
 476 }
 477