[metaconfig.git] / bin / makedist

#!/usr/bin/perl
	eval "exec perl -S $0 $*"
		if $running_under_some_shell;

# $Id: makedist.SH 1 2006-08-24 12:32:52Z rmanfredi $
#
#  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
#  
#  You may redistribute only under the terms of the Artistic Licence,
#  as specified in the README file that comes with the distribution.
#  You may reuse parts of this distribution only within the terms of
#  that same Artistic Licence; a copy of which may be found at the root
#  of the source tree for dist 4.0.
#
# $Log: makedist.SH,v $
# Revision 3.0.1.2  1994/01/24  13:58:20  ram
# patch16: modified call to manifake to trap exceptions manually
# patch16: removed final sed post-processing to allow 'make depend' target
# patch16: added ~/.dist_profile awareness
#
# Revision 3.0.1.1  1993/08/19  06:42:17  ram
# patch1: leading config.sh searching was not aborting properly
#
# Revision 3.0  1993/08/18  12:04:28  ram
# Baseline for dist 3.0 netwide release.
#

$version = '3.5';
$patchlevel = '0';

&profile;					# Read ~/.dist_profile
require 'getopts.pl';
&usage unless &Getopts('c:f:dhvqs:V');

$ENV{'DIST'} = '/dev/null';	# Disable ~/.dist_profile

if ($opt_V) {
	print STDERR "makedist $version PL$patchlevel\n";
	exit 0;
} elsif ($opt_h) {
	&usage;
}

$MAXKITSIZE = 50000 unless $MAXKITSIZE = $opt_s;
$KITOVERHEAD = 1800;
$FILEOVERHEAD = 90;
$CHOPSIZE = $MAXKITSIZE - $KITOVERHEAD - $FILEOVERHEAD;

$NEWMANI = 'MANIFEST.new' unless $NEWMANI = $opt_f;
$MANI = 'MANIFEST' unless $opt_f;
$PACKLIST = 'PACKLIST';
$PACKNOTES = 'PACKNOTES';

$tmpdir = "/tmp/MKst$$";	# Where to copy distribution
$tmpdir = '.' if $opt_q;	# Quick mode: no need to copy distribution

&set_sig('aborted');		# Make sure we clean up in case of emergency

&readpackage;
&get_patchlevel;

eval '&manifake';			# Want to trap possible die and redirect to fatal
if ($@ ne '') {
	chop($@);
	&fatal($@);
}

if ($opt_c) {				# Copy distribution only, no shell archive
	&distcopy;
	exit 0;
}

&distfake;
&copyright'init($copyright) if -f $copyright;

unlink <$package.kit? $package.kit??>;
chop($curdir = `pwd`);
chdir $tmpdir || die "Can't chdir to $tmpdir.\n";

&maniread;
&kitlists;
&manimake;
&kitbuild;
&cleanup;
exit 0;

# Physically build the kits
sub kitbuild {
	$numkits = $#list;
	if ($numkits > 9) {
		$sp = '%02d';
	} else {
		$sp = '%d';
	}

	for ($kitnum = 1; $kitnum <= $numkits; $kitnum++) {
		$list = $list[$kitnum];
		$kit = sprintf("$package.kit" . $sp,$kitnum);
		print "*** Making $kit ***\n";
		open(KIT,">$curdir/$kit") || do fatal("Can't create $curdir/$kit: $!");

		&kitleader;

		@files = split(' ',$list);
		reset 'X';
		for $file (@files) {
			$_ = $file;
			while (s|^(.*)/.*$|$1|) {
				push(@Xdirs,$_) unless $Xseen{$_}++;
			}
		}
		print KIT "mkdir ",join(' ', sort @Xdirs)," 2>/dev/null\n";

		foreach $file (@files) {
			print "\t",$file,"\n" if $opt_v;
			print KIT "echo Extracting $file\n";
			print KIT "sed >$file <<'!STUFFY!FUNK!' -e 's/X//'\n";
			open(FILE, $file);
			&copyright'reset;			# Reset copyright for new file
			while (<FILE>) {
				# Use Lock[e]r as a pattern in case it is applied on ourselves
				s|Lock[e]r:.*\$|\$|;	# Remove locker mark
				print KIT &copyright'filter($_, 'X');
			}
			close FILE;
			print KIT "!STUFFY!FUNK!\n";
			-x "$file" && (print KIT "chmod +x $file\n");
		}
		&kittrailer;
		chmod 0755, $kit;
	}
}

sub kitlists {
	for $filename (keys %comment) {
		next if $filename =~ m|/$|;		# Skip directories
		next if -d $filename;			# Better safe than sorry
		($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
		   $blksize,$blocks) = stat($filename);

		# Make sure file is not larger than the CHOPSIZE limit. If it is,
		# a split is attempted.
		if ($size > $CHOPSIZE) {
			print "Splitting $filename...\n" if $opt_v;
			$file_comment = $comment{$filename};
			open(FILE, $filename) || die "Can't open $filename: $!\n";
			$piece = 'AA';
			($dir, $name) = ('.', $filename)
				unless ($dir, $name) = ($filename =~ m|(.*)/(.*)|);
			$chopped = $dir . '/' . substr($name, 0, 11);
			$chopped =~ s|^\./||;
			&fatal("There is already a split file named $chopped")
				if defined $Chopped{$chopped};
			$Chopped{$chopped} = $filename;	# Association split <-> real file
			$size = 0;
			open(CURPIECE, ">$chopped:$piece") ||
				&fatal("Can't create $chopped:$piece: $!");
			while (<FILE>) {
				if ($size + length($_) > $CHOPSIZE) {
					close CURPIECE;
					$size{"$chopped:$piece"} = $size;
					$comment{"$chopped:$piece"} = "$file_comment (part $piece)";
					push(@files, "$chopped:$piece");
					print "\t$chopped:$piece ($size bytes)\n" if $opt_v;
					$size = 0;
					$piece++;		# AA -> AB, etc...
					open(CURPIECE, ">$chopped:$piece") ||
						&fatal("Can't create $chopped:$piece: $!");
				}
				print CURPIECE $_;
				$size += length($_);
			}
			close FILE;
			close CURPIECE;
			$size{"$chopped:$piece"} = $size;
			$comment{"$chopped:$piece"} = "$file_comment (part $piece)";
			push(@files, "$chopped:$piece");
			print "\t$chopped:$piece ($size bytes)\n" if $opt_v;
			delete $comment{$filename};		# File split, not in PACKLIST
		} else {
			$size += 1000000 if $filename =~ /README/;
			$size{$filename} = $size;
			push(@files, "$filename");
		}
	}

	# Build a file PACKNOTES to reconstruct split files
	if (defined %Chopped) {
		open(PACKNOTES, ">$PACKNOTES") || &fatal("Can't create PACKNOTES: $!");
		foreach (keys %Chopped) {
			print PACKNOTES <<EOC;
echo 'Building $Chopped{$_}...'
cat $_:[A-Z][A-Z] > $Chopped{$_}
rm -f $_:[A-Z][A-Z]
EOC
		}
		close PACKNOTES;
		push(@files, $PACKNOTES);
		$comment{$PACKNOTES} = 'Script to reconstruct split files';
		($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
		   $blksize,$blocks) = stat($PACKNOTES);
		$size{$PACKNOTES} = $size;
	}

	# Currently, file PACKLIST does not exist, so its size is unknown and
	# it cannot be correctly put in one archive. Therefore, we take the
	# size of MANIFEST.new, which will give us a good estimation.
	push(@files, 'PACKLIST');

	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
	   $blksize,$blocks) = stat($NEWMANI);
	$size{$PACKLIST} = $size;

	sub revnum { $size{$a} < $size{$b} ? 1 : $size{$a} > $size{$b} ? -1 : 0; }
	@files = sort revnum @files;

	for (@files) {
		$size = $size{$_};
		$size -= 1000000 if /README/;
		$i=1;
		while (($newtot = int($tot[$i] + $size + $size/40 + $FILEOVERHEAD)) >
			$MAXKITSIZE-$KITOVERHEAD && $tot[$i]) {
				$i++;
		}
		$tot[$i] = $newtot;
		print "Adding $_ to kit $i giving $newtot bytes\n" if $opt_d;
		$kit{$_} = $i;
		$list[$i] .= " $_";
	}
}

# Read manifest file and initialize the %comment array.
sub maniread {
	do fatal("You don't have a $NEWMANI file.  Run manifake")
		unless -f "$NEWMANI";
	open(NEWMANI,$NEWMANI) || do fatal("Can't read $NEWMANI: $!");
	while (<NEWMANI>) {
		($key,$val) = split(' ',$_,1) unless ($key,$val) = /^(\S+)\s+(.*)/;
		$comment{$key} = $val;
	}
	close NEWMANI;
}

# MANIFEST and MANIFEST.new must say the same thing.  Create the
# PACKLIST file (thus avoiding kit numbers in MANIFEST, which causes big
# patches when only re-ordering occurred).  Note that PACKLIST should
# not appear in MANIFEST.new (the user may remove it).
sub manimake {
	# Add built packlist
	$comment{$PACKLIST} = 'Which files came with which kits';

	open(PACKLIST, ">$PACKLIST") || do fatal("Can't create $PACKLIST: $!");
	print PACKLIST
"After all the $package kits are run you should have the following files:

Filename                   Kit Description
--------                   --- -----------
";
	for (sort keys(comment)) {
		printf PACKLIST "%-27s %2s %.47s\n", $_, $kit{$_}, $comment{$_};
	}
	close PACKLIST;
}

sub kitleader {
	local($plevel);
	$plevel = " at patchlevel $patch_level" if $patch_level ne '';
	print KIT <<EOH;
#! /bin/sh
#
# This is $package version $baserev$plevel.
# Make a new directory for the $package sources, cd to it, and run kits 1 up
# to $numkits through sh.  When all $numkits kits have been run, read README.
#
echo " "
cat <<EOM
This is $package $baserev$plevel, kit $kitnum (of $numkits):
If this shell archive is complete, the line "End of kit $kitnum (of $numkits)"
will echo at the end.
EOM
export PATH || (echo "Please use sh to unpack this archive." ; kill \$\$)
EOH
}

sub kittrailer {
	$rangelist = '';
	for ($i = 1; $i <= $numkits; $i++) {
		$rangelist .= ' ' . $i;
	}
	print KIT <<EOM;
echo \"End of kit $kitnum (of $numkits)\"
echo \" \"
cat /dev/null >kit${kitnum}isdone
run=''
config=''
for iskit in$rangelist; do
	if test -f kit\${iskit}isdone; then
		run=\"\$run \$iskit\"
	else
		todo=\"\$todo \$iskit\"
	fi
done
case \$todo in
	'')
		echo \"You have run all your kits.\"
EOM
	if (defined %Chopped) {		# Some splitting occurred
		print KIT <<EOM;
		if test -f $PACKNOTES; then
			sh $PACKNOTES
		else
			echo \"You have to rebuild split files by hand (see $PACKLIST).\"
		fi
EOM
	}
	if (-f "README" && -f "Configure") {
		print KIT
"		echo \"Please read README and then type Configure.\"
		chmod 755 Configure\n";
	} elsif (-f "README") {
		print KIT
"		echo \"Please read README first.\"\n";
	} elsif (-f "Configure") {
		print KIT
"		echo \"Please run Configure first.\"
		chmod 755 Configure\n";
	}
	print KIT <<EOM;
		rm -f kit*isdone
		;;
	*)  echo \"You have run\$run.\"
		echo \"You still need to run\$todo.\"
		;;
esac
: Someone might mail this, so exit before signature...
exit 0
EOM
}

sub get_patchlevel {
	$patch_level = '';
	if (-f 'patchlevel.h') {
		open(PL, 'patchlevel.h');
		while (<PL>) {
			/^#define\s+PATCHLEVEL\s+(\w+)/ && ($patch_level = $1);
		}
		close PL;
	}
}

sub distfake {
	return if $opt_q;
	local($sw);
	$sw = 's' unless $opt_v;
	mkdir($tmpdir, 0700) || die "Can't create directory $tmpdir.\n";
	print "Building a copy of distribution in $tmpdir...\n" if $opt_v;
	system 'perl', '-S', 'patcol', "-a$sw", '-f', $NEWMANI, '-d', $tmpdir;
	system 'cp', $NEWMANI, "$tmpdir/$NEWMANI"
		unless -f "$tmpdir/$NEWMANI" && !$opt_f;
}

sub distcopy {
	local($sw);			# Switch to force patcol to copy checked out files
	&makedir($opt_c);
	print "Building a copy of distribution in $opt_c...\n" if $opt_v;
	$sw = 'c' if $opt_q;
	$sw .= 's' unless $opt_v;
	system 'perl', '-S', 'patcol', "-aRC$sw", '-f', $NEWMANI, '-d', $opt_c;
}

sub distrm {
	return if $opt_q;
	print "Removing distribution in $tmpdir...\n" if $opt_v;
	chdir "/";			# Do not stay in removed directory...
	system '/bin/rm', '-rf', "$tmpdir";
}

sub splitrm {
	foreach $base (keys %Chopped) {
		print "Removing split files for $base:\n" if $opt_v;
		$piece = 'AA';
		while (-f "$base:$piece") {
			print "\t$base:$piece\n" if $opt_v;
			unlink "$base:$piece";
			$piece++;		# AA -> AB, etc...
		}
	}
}

sub cleanup {
	&distrm if -d $tmpdir;
	if ($opt_q) {
		&splitrm;		# Remove in-place split files
		unlink $PACKLIST, $PACKNOTES;
	}
}

sub fatal {
	local($reason) = shift(@_);
	&cleanup;
	die "$reason\n";
}

sub set_sig {
	local($handler) = @_;
	$SIG{'HUP'} = $handler;
	$SIG{'INT'} = $handler;
	$SIG{'QUIT'} = $handler;
	$SIG{'TERM'} = $handler;
}

sub aborted {
	&set_sig('IGNORE');
	$opt_v = 1;		# Force verbose message in distrm
	&cleanup;
	print "Aborted.\n";
	exit 1;
}

sub usage {
	print STDERR <<EOM;
Usage: makedist [-dhqvV] [-c dir] [-s size] [-f manifest]
  -c : copy files in dir, do not build any shell archive.
  -d : debug mode.
  -f : use this file as manifest.
  -h : print this help message and exits.
  -q : quick mode: use checked-out files.
  -s : set maximum pack size.
  -v : verbose mode.
  -V : print version number and exits.
EOM
	exit 1;
}

sub readpackage {
	if (! -f '.package') {
		if (
			-f '../.package' ||
			-f '../../.package' ||
			-f '../../../.package' ||
			-f '../../../../.package'
		) {
			die "Run in top level directory only.\n";
		} else {
			die "No .package file!  Run packinit.\n";
		}
	}
	open(PACKAGE,'.package');
	while (<PACKAGE>) {
		next if /^:/;
		next if /^#/;
		if (($var,$val) = /^\s*(\w+)=(.*)/) {
			$val = "\"$val\"" unless $val =~ /^['"]/;
			eval "\$$var = $val;";
		}
	}
	close PACKAGE;
}

sub manifake {
    # make MANIFEST and MANIFEST.new say the same thing
    if (! -f $NEWMANI) {
        if (-f $MANI) {
            open(IN,$MANI) || die "Can't open $MANI";
            open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
            while (<IN>) {
                if (/---/) {
					# Everything until now was a header...
					close OUT;
					open(OUT,">$NEWMANI") ||
						die "Can't recreate $NEWMANI";
					next;
				}
                s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
				print OUT;
				print OUT "\n" unless /\n$/;	# If no description
            }
            close IN;
			close OUT;
        }
        else {
die "You need to make a $NEWMANI file, with names and descriptions.\n";
        }
    }
}

package copyright;

# Read in copyright file
sub init {
	local($file) = @_;		# Copyright file
	undef @copyright;
	open(COPYRIGHT, $file) || die "Can't open $file: $!\n";
	chop(@copyright = <COPYRIGHT>);
	close COPYRIGHT;
}

# Reset the automaton for a new file.
sub reset {
	$copyright_seen = @copyright ? 0 : 1;
	$marker_seen = 0;
}

# Filter file, line by line, and expand the copyright string. The @COPYRIGHT@
# symbol may be preceded by some random comment. A leader can be defined and
# will be pre-pended to all the input lines.
sub filter {
	local($line, $leader) = @_;		# Leader is optional
	return $leader . $line if $copyright_seen || $marker_seen;
	$marker_seen = 1 if $line =~ /\$Log[:\$]/;
	$copyright_seen = 1 if $line =~ /\@COPYRIGHT\@/;
	return $leader . $line unless $copyright_seen;
	local($comment, $trailer) = $line =~ /^(.*)\@COPYRIGHT\@\s*(.*)/;
	$comment = $leader . $comment;
	$comment . join("\n$comment", @copyright) . "\n";
}

# Filter output of $cmd redirected into $file by expanding copyright, if any.
sub expand {
	local($cmd, $file) = @_;
	if (@copyright) {
		open(CMD,"$cmd|") || die "Can't start '$cmd': $!\n";
		open(OUT, ">$file") || die "Can't create $file: $!\n";
		&reset;
		local($_);
		while (<CMD>) {
			print OUT &filter($_);
		}
		close OUT;
		close CMD;
	} else {
		system "$cmd > $file";
		die "Command '$cmd' failed!" if $?;
	}
}

package main;

# Make directories for files
# E.g, for /usr/lib/perl/foo, it will check for all the
# directories /usr, /usr/lib, /usr/lib/perl and make
# them if they do not exist.
sub makedir {
    local($_) = shift;
    local($dir) = $_;
    if (!-d && $_ ne '') {
        # Make dirname first
        do makedir($_) if s|(.*)/.*|\1|;
		mkdir($dir, 0700) if ! -d $dir;
    }
}

# Perform ~name expansion ala ksh...
# (banish csh from your vocabulary ;-)
sub tilda_expand {
	local($path) = @_;
	return $path unless $path =~ /^~/;
	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;			# ~name
	$path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;	# ~
	$path;
}

# Set up profile components into %Profile, add any profile-supplied options
# into @ARGV and return the command invocation name.
sub profile {
	local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
	local($me) = $0;		# Command name
	$me =~ s|.*/(.*)|$1|;	# Keep only base name
	return $me unless -s $profile;
	local(*PROFILE);		# Local file descriptor
	local($options) = '';	# Options we get back from profile
	unless (open(PROFILE, $profile)) {
		warn "$me: cannot open $profile: $!\n";
		return;
	}
	local($_);
	local($component);
	while (<PROFILE>) {
		next if /^\s*#/;	# Skip comments
		next unless /^$me/o;
		if (s/^$me://o) {	# progname: options
			chop;
			$options .= $_;	# Merge options if more than one line
		}
		elsif (s/^$me-([^:]+)://o) {	# progname-component: value
			$component = $1;
			chop;
			s/^\s+//;		# Trim leading and trailing spaces
			s/\s+$//;
			$Profile{$component} = $_;
		}
	}
	close PROFILE;
	return unless $options;
	require 'shellwords.pl';
	local(@opts);
	eval '@opts = &shellwords($options)';	# Protect against mismatched quotes
	unshift(@ARGV, @opts);
	return $me;				# Return our invocation name
}
Commit	Line	Data
459d3fb5 MBT	1	#!/usr/bin/perl
	2	eval "exec perl -S $0 $*"
	3	if $running_under_some_shell;
	4
	5	# $Id: makedist.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: makedist.SH,v $
	16	# Revision 3.0.1.2 1994/01/24 13:58:20 ram
	17	# patch16: modified call to manifake to trap exceptions manually
	18	# patch16: removed final sed post-processing to allow 'make depend' target
	19	# patch16: added ~/.dist_profile awareness
	20	#
	21	# Revision 3.0.1.1 1993/08/19 06:42:17 ram
	22	# patch1: leading config.sh searching was not aborting properly
	23	#
	24	# Revision 3.0 1993/08/18 12:04:28 ram
	25	# Baseline for dist 3.0 netwide release.
	26	#
	27
	28	$version = '3.5';
	29	$patchlevel = '0';
	30
	31	&profile; # Read ~/.dist_profile
	32	require 'getopts.pl';
	33	&usage unless &Getopts('c:f:dhvqs:V');
	34
	35	$ENV{'DIST'} = '/dev/null'; # Disable ~/.dist_profile
	36
	37	if ($opt_V) {
	38	print STDERR "makedist $version PL$patchlevel\n";
	39	exit 0;
	40	} elsif ($opt_h) {
	41	&usage;
	42	}
	43
	44	$MAXKITSIZE = 50000 unless $MAXKITSIZE = $opt_s;
	45	$KITOVERHEAD = 1800;
	46	$FILEOVERHEAD = 90;
	47	$CHOPSIZE = $MAXKITSIZE - $KITOVERHEAD - $FILEOVERHEAD;
	48
	49	$NEWMANI = 'MANIFEST.new' unless $NEWMANI = $opt_f;
	50	$MANI = 'MANIFEST' unless $opt_f;
	51	$PACKLIST = 'PACKLIST';
	52	$PACKNOTES = 'PACKNOTES';
	53
	54	$tmpdir = "/tmp/MKst$$"; # Where to copy distribution
	55	$tmpdir = '.' if $opt_q; # Quick mode: no need to copy distribution
	56
	57	&set_sig('aborted'); # Make sure we clean up in case of emergency
	58
	59	&readpackage;
	60	&get_patchlevel;
	61
	62	eval '&manifake'; # Want to trap possible die and redirect to fatal
	63	if ($@ ne '') {
	64	chop($@);
65	&fatal($@);
66	}
67
68	if ($opt_c) { # Copy distribution only, no shell archive
69	&distcopy;
70	exit 0;
71	}
72
73	&distfake;
74	&copyright'init($copyright) if -f $copyright;
75
76	unlink <$package.kit? $package.kit??>;
77	chop($curdir = `pwd`);
78	chdir $tmpdir \|\| die "Can't chdir to $tmpdir.\n";
79
80	&maniread;
81	&kitlists;
82	&manimake;
83	&kitbuild;
84	&cleanup;
85	exit 0;
86
87	# Physically build the kits
88	sub kitbuild {
89	$numkits = $#list;
90	if ($numkits > 9) {
91	$sp = '%02d';
92	} else {
93	$sp = '%d';
94	}
95
96	for ($kitnum = 1; $kitnum <= $numkits; $kitnum++) {
97	$list = $list[$kitnum];
98	$kit = sprintf("$package.kit" . $sp,$kitnum);
99	print "* Making $kit *\n";
100	open(KIT,">$curdir/$kit") \|\| do fatal("Can't create $curdir/$kit: $!");
101
102	&kitleader;
103
104	@files = split(' ',$list);
105	reset 'X';
106	for $file (@files) {
107	$_ = $file;
108	while (s\|^(.)/.$\|$1\|) {
109	push(@Xdirs,$_) unless $Xseen{$_}++;
110	}
111	}
112	print KIT "mkdir ",join(' ', sort @Xdirs)," 2>/dev/null\n";
113
114	foreach $file (@files) {
115	print "\t",$file,"\n" if $opt_v;
116	print KIT "echo Extracting $file\n";
117	print KIT "sed >$file <<'!STUFFY!FUNK!' -e 's/X//'\n";
118	open(FILE, $file);
119	&copyright'reset; # Reset copyright for new file
120	while (<FILE>) {
121	# Use Lock[e]r as a pattern in case it is applied on ourselves
122	s\|Lock[e]r:.*\$\|\$\|; # Remove locker mark
123	print KIT &copyright'filter($_, 'X');
124	}
125	close FILE;
126	print KIT "!STUFFY!FUNK!\n";
127	-x "$file" && (print KIT "chmod +x $file\n");
128	}
129	&kittrailer;
130	chmod 0755, $kit;
131	}
132	}
133
134	sub kitlists {
135	for $filename (keys %comment) {
136	next if $filename =~ m\|/$\|; # Skip directories
137	next if -d $filename; # Better safe than sorry
138	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
139	$blksize,$blocks) = stat($filename);
140
141	# Make sure file is not larger than the CHOPSIZE limit. If it is,
142	# a split is attempted.
143	if ($size > $CHOPSIZE) {
144	print "Splitting $filename...\n" if $opt_v;
145	$file_comment = $comment{$filename};
146	open(FILE, $filename) \|\| die "Can't open $filename: $!\n";
147	$piece = 'AA';
148	($dir, $name) = ('.', $filename)
149	unless ($dir, $name) = ($filename =~ m\|(.)/(.)\|);
150	$chopped = $dir . '/' . substr($name, 0, 11);
151	$chopped =~ s\|^\./\|\|;
152	&fatal("There is already a split file named $chopped")
153	if defined $Chopped{$chopped};
154	$Chopped{$chopped} = $filename; # Association split <-> real file
155	$size = 0;
156	open(CURPIECE, ">$chopped:$piece") \|\|
157	&fatal("Can't create $chopped:$piece: $!");
158	while (<FILE>) {
159	if ($size + length($_) > $CHOPSIZE) {
160	close CURPIECE;
161	$size{"$chopped:$piece"} = $size;
162	$comment{"$chopped:$piece"} = "$file_comment (part $piece)";
163	push(@files, "$chopped:$piece");
164	print "\t$chopped:$piece ($size bytes)\n" if $opt_v;
165	$size = 0;
166	$piece++; # AA -> AB, etc...
167	open(CURPIECE, ">$chopped:$piece") \|\|
168	&fatal("Can't create $chopped:$piece: $!");
169	}
170	print CURPIECE $_;
171	$size += length($_);
172	}
173	close FILE;
174	close CURPIECE;
175	$size{"$chopped:$piece"} = $size;
176	$comment{"$chopped:$piece"} = "$file_comment (part $piece)";
177	push(@files, "$chopped:$piece");
178	print "\t$chopped:$piece ($size bytes)\n" if $opt_v;
179	delete $comment{$filename}; # File split, not in PACKLIST
180	} else {
181	$size += 1000000 if $filename =~ /README/;
182	$size{$filename} = $size;
183	push(@files, "$filename");
184	}
185	}
186
187	# Build a file PACKNOTES to reconstruct split files
188	if (defined %Chopped) {
189	open(PACKNOTES, ">$PACKNOTES") \|\| &fatal("Can't create PACKNOTES: $!");
190	foreach (keys %Chopped) {
191	print PACKNOTES <<EOC;
192	echo 'Building $Chopped{$_}...'
193	cat $_:[A-Z][A-Z] > $Chopped{$_}
194	rm -f $_:[A-Z][A-Z]
195	EOC
196	}
197	close PACKNOTES;
198	push(@files, $PACKNOTES);
199	$comment{$PACKNOTES} = 'Script to reconstruct split files';
200	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
201	$blksize,$blocks) = stat($PACKNOTES);
202	$size{$PACKNOTES} = $size;
203	}
204
205	# Currently, file PACKLIST does not exist, so its size is unknown and
206	# it cannot be correctly put in one archive. Therefore, we take the
207	# size of MANIFEST.new, which will give us a good estimation.
208	push(@files, 'PACKLIST');
209
210	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
211	$blksize,$blocks) = stat($NEWMANI);
212	$size{$PACKLIST} = $size;
213
214	sub revnum { $size{$a} < $size{$b} ? 1 : $size{$a} > $size{$b} ? -1 : 0; }
215	@files = sort revnum @files;
216
217	for (@files) {
218	$size = $size{$_};
219	$size -= 1000000 if /README/;
220	$i=1;
221	while (($newtot = int($tot[$i] + $size + $size/40 + $FILEOVERHEAD)) >
222	$MAXKITSIZE-$KITOVERHEAD && $tot[$i]) {
223	$i++;
224	}
225	$tot[$i] = $newtot;
226	print "Adding $_ to kit $i giving $newtot bytes\n" if $opt_d;
227	$kit{$_} = $i;
228	$list[$i] .= " $_";
229	}
230	}
231
232	# Read manifest file and initialize the %comment array.
233	sub maniread {
234	do fatal("You don't have a $NEWMANI file. Run manifake")
235	unless -f "$NEWMANI";
236	open(NEWMANI,$NEWMANI) \|\| do fatal("Can't read $NEWMANI: $!");
237	while (<NEWMANI>) {
238	($key,$val) = split(' ',$_,1) unless ($key,$val) = /^(\S+)\s+(.*)/;
239	$comment{$key} = $val;
240	}
241	close NEWMANI;
242	}
243
244	# MANIFEST and MANIFEST.new must say the same thing. Create the
245	# PACKLIST file (thus avoiding kit numbers in MANIFEST, which causes big
246	# patches when only re-ordering occurred). Note that PACKLIST should
247	# not appear in MANIFEST.new (the user may remove it).
248	sub manimake {
249	# Add built packlist
250	$comment{$PACKLIST} = 'Which files came with which kits';
251
252	open(PACKLIST, ">$PACKLIST") \|\| do fatal("Can't create $PACKLIST: $!");
253	print PACKLIST
254	"After all the $package kits are run you should have the following files:
255
256	Filename Kit Description
257	-------- --- -----------
258	";
259	for (sort keys(comment)) {
260	printf PACKLIST "%-27s %2s %.47s\n", $_, $kit{$_}, $comment{$_};
261	}
262	close PACKLIST;
263	}
264
265	sub kitleader {
266	local($plevel);
267	$plevel = " at patchlevel $patch_level" if $patch_level ne '';
268	print KIT <<EOH;
269	#! /bin/sh
270	#
271	# This is $package version $baserev$plevel.
272	# Make a new directory for the $package sources, cd to it, and run kits 1 up
273	# to $numkits through sh. When all $numkits kits have been run, read README.
274	#
275	echo " "
276	cat <<EOM
277	This is $package $baserev$plevel, kit $kitnum (of $numkits):
278	If this shell archive is complete, the line "End of kit $kitnum (of $numkits)"
279	will echo at the end.
280	EOM
281	export PATH \|\| (echo "Please use sh to unpack this archive." ; kill \$\$)
282	EOH
283	}
284
285	sub kittrailer {
286	$rangelist = '';
287	for ($i = 1; $i <= $numkits; $i++) {
288	$rangelist .= ' ' . $i;
289	}
290	print KIT <<EOM;
291	echo \"End of kit $kitnum (of $numkits)\"
292	echo \" \"
293	cat /dev/null >kit${kitnum}isdone
294	run=''
295	config=''
296	for iskit in$rangelist; do
297	if test -f kit\${iskit}isdone; then
298	run=\"\$run \$iskit\"
299	else
300	todo=\"\$todo \$iskit\"
301	fi
302	done
303	case \$todo in
304	'')
305	echo \"You have run all your kits.\"
306	EOM
307	if (defined %Chopped) { # Some splitting occurred
308	print KIT <<EOM;
309	if test -f $PACKNOTES; then
310	sh $PACKNOTES
311	else
312	echo \"You have to rebuild split files by hand (see $PACKLIST).\"
313	fi
314	EOM
315	}
316	if (-f "README" && -f "Configure") {
317	print KIT
318	" echo \"Please read README and then type Configure.\"
319	chmod 755 Configure\n";
320	} elsif (-f "README") {
321	print KIT
322	" echo \"Please read README first.\"\n";
323	} elsif (-f "Configure") {
324	print KIT
325	" echo \"Please run Configure first.\"
326	chmod 755 Configure\n";
327	}
328	print KIT <<EOM;
329	rm -f kit*isdone
330	;;
331	*) echo \"You have run\$run.\"
332	echo \"You still need to run\$todo.\"
333	;;
334	esac
335	: Someone might mail this, so exit before signature...
336	exit 0
337	EOM
338	}
339
340	sub get_patchlevel {
341	$patch_level = '';
342	if (-f 'patchlevel.h') {
343	open(PL, 'patchlevel.h');
344	while (<PL>) {
345	/^#define\s+PATCHLEVEL\s+(\w+)/ && ($patch_level = $1);
346	}
347	close PL;
348	}
349	}
350
351	sub distfake {
352	return if $opt_q;
353	local($sw);
354	$sw = 's' unless $opt_v;
355	mkdir($tmpdir, 0700) \|\| die "Can't create directory $tmpdir.\n";
356	print "Building a copy of distribution in $tmpdir...\n" if $opt_v;
357	system 'perl', '-S', 'patcol', "-a$sw", '-f', $NEWMANI, '-d', $tmpdir;
358	system 'cp', $NEWMANI, "$tmpdir/$NEWMANI"
359	unless -f "$tmpdir/$NEWMANI" && !$opt_f;
360	}
361
362	sub distcopy {
363	local($sw); # Switch to force patcol to copy checked out files
364	&makedir($opt_c);
365	print "Building a copy of distribution in $opt_c...\n" if $opt_v;
366	$sw = 'c' if $opt_q;
367	$sw .= 's' unless $opt_v;
368	system 'perl', '-S', 'patcol', "-aRC$sw", '-f', $NEWMANI, '-d', $opt_c;
369	}
370
371	sub distrm {
372	return if $opt_q;
373	print "Removing distribution in $tmpdir...\n" if $opt_v;
374	chdir "/"; # Do not stay in removed directory...
375	system '/bin/rm', '-rf', "$tmpdir";
376	}
377
378	sub splitrm {
379	foreach $base (keys %Chopped) {
380	print "Removing split files for $base:\n" if $opt_v;
381	$piece = 'AA';
382	while (-f "$base:$piece") {
383	print "\t$base:$piece\n" if $opt_v;
384	unlink "$base:$piece";
385	$piece++; # AA -> AB, etc...
386	}
387	}
388	}
389
390	sub cleanup {
391	&distrm if -d $tmpdir;
392	if ($opt_q) {
393	&splitrm; # Remove in-place split files
394	unlink $PACKLIST, $PACKNOTES;
395	}
396	}
397
398	sub fatal {
399	local($reason) = shift(@_);
400	&cleanup;
401	die "$reason\n";
402	}
403
404	sub set_sig {
405	local($handler) = @_;
406	$SIG{'HUP'} = $handler;
407	$SIG{'INT'} = $handler;
408	$SIG{'QUIT'} = $handler;
409	$SIG{'TERM'} = $handler;
410	}
411
412	sub aborted {
413	&set_sig('IGNORE');
414	$opt_v = 1; # Force verbose message in distrm
415	&cleanup;
416	print "Aborted.\n";
417	exit 1;
418	}
419
420	sub usage {
421	print STDERR <<EOM;
422	Usage: makedist [-dhqvV] [-c dir] [-s size] [-f manifest]
423	-c : copy files in dir, do not build any shell archive.
424	-d : debug mode.
425	-f : use this file as manifest.
426	-h : print this help message and exits.
427	-q : quick mode: use checked-out files.
428	-s : set maximum pack size.
429	-v : verbose mode.
430	-V : print version number and exits.
431	EOM
432	exit 1;
433	}
434
435	sub readpackage {
436	if (! -f '.package') {
437	if (
438	-f '../.package' \|\|
439	-f '../../.package' \|\|
440	-f '../../../.package' \|\|
441	-f '../../../../.package'
442	) {
443	die "Run in top level directory only.\n";
444	} else {
445	die "No .package file! Run packinit.\n";
446	}
447	}
448	open(PACKAGE,'.package');
449	while (<PACKAGE>) {
450	next if /^:/;
451	next if /^#/;
452	if (($var,$val) = /^\s(\w+)=(.)/) {
453	$val = "\"$val\"" unless $val =~ /^['"]/;
454	eval "\$$var = $val;";
455	}
456	}
457	close PACKAGE;
458	}
459
460	sub manifake {
461	# make MANIFEST and MANIFEST.new say the same thing
462	if (! -f $NEWMANI) {
463	if (-f $MANI) {
464	open(IN,$MANI) \|\| die "Can't open $MANI";
465	open(OUT,">$NEWMANI") \|\| die "Can't create $NEWMANI";
466	while (<IN>) {
467	if (/---/) {
468	# Everything until now was a header...
469	close OUT;
470	open(OUT,">$NEWMANI") \|\|
471	die "Can't recreate $NEWMANI";
472	next;
473	}
474	s/^\s(\S+\s+)[0-9]\s(.)/$1$2/;
475	print OUT;
476	print OUT "\n" unless /\n$/; # If no description
477	}
478	close IN;
479	close OUT;
480	}
481	else {
482	die "You need to make a $NEWMANI file, with names and descriptions.\n";
483	}
484	}
485	}
486
487	package copyright;
488
489	# Read in copyright file
490	sub init {
491	local($file) = @_; # Copyright file
492	undef @copyright;
493	open(COPYRIGHT, $file) \|\| die "Can't open $file: $!\n";
494	chop(@copyright = <COPYRIGHT>);
495	close COPYRIGHT;
496	}
497
498	# Reset the automaton for a new file.
499	sub reset {
500	$copyright_seen = @copyright ? 0 : 1;
501	$marker_seen = 0;
502	}
503
504	# Filter file, line by line, and expand the copyright string. The @COPYRIGHT@
505	# symbol may be preceded by some random comment. A leader can be defined and
506	# will be pre-pended to all the input lines.
507	sub filter {
508	local($line, $leader) = @_; # Leader is optional
509	return $leader . $line if $copyright_seen \|\| $marker_seen;
510	$marker_seen = 1 if $line =~ /\$Log[:\$]/;
511	$copyright_seen = 1 if $line =~ /\@COPYRIGHT\@/;
512	return $leader . $line unless $copyright_seen;
513	local($comment, $trailer) = $line =~ /^(.)\@COPYRIGHT\@\s(.*)/;
514	$comment = $leader . $comment;
515	$comment . join("\n$comment", @copyright) . "\n";
516	}
517
518	# Filter output of $cmd redirected into $file by expanding copyright, if any.
519	sub expand {
520	local($cmd, $file) = @_;
521	if (@copyright) {
522	open(CMD,"$cmd\|") \|\| die "Can't start '$cmd': $!\n";
523	open(OUT, ">$file") \|\| die "Can't create $file: $!\n";
524	&reset;
525	local($_);
526	while (<CMD>) {
527	print OUT &filter($_);
528	}
529	close OUT;
530	close CMD;
531	} else {
532	system "$cmd > $file";
533	die "Command '$cmd' failed!" if $?;
534	}
535	}
536
537	package main;
538
539	# Make directories for files
540	# E.g, for /usr/lib/perl/foo, it will check for all the
541	# directories /usr, /usr/lib, /usr/lib/perl and make
542	# them if they do not exist.
543	sub makedir {
544	local($_) = shift;
545	local($dir) = $_;
546	if (!-d && $_ ne '') {
547	# Make dirname first
548	do makedir($_) if s\|(.)/.\|\1\|;
549	mkdir($dir, 0700) if ! -d $dir;
550	}
551	}
552
553	# Perform ~name expansion ala ksh...
554	# (banish csh from your vocabulary ;-)
555	sub tilda_expand {
556	local($path) = @_;
557	return $path unless $path =~ /^~/;
558	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
559	$path =~ s:^~:$ENV{'HOME'} \|\| (getpwuid($<))[$[+7]:e; # ~
560	$path;
561	}
562
563	# Set up profile components into %Profile, add any profile-supplied options
564	# into @ARGV and return the command invocation name.
565	sub profile {
566	local($profile) = &tilda_expand($ENV{'DIST'} \|\| '~/.dist_profile');
567	local($me) = $0; # Command name
568	$me =~ s\|./(.)\|$1\|; # Keep only base name
569	return $me unless -s $profile;
570	local(*PROFILE); # Local file descriptor
571	local($options) = ''; # Options we get back from profile
572	unless (open(PROFILE, $profile)) {
573	warn "$me: cannot open $profile: $!\n";
574	return;
575	}
576	local($_);
577	local($component);
578	while (<PROFILE>) {
579	next if /^\s*#/; # Skip comments
580	next unless /^$me/o;
581	if (s/^$me://o) { # progname: options
582	chop;
583	$options .= $_; # Merge options if more than one line
584	}
585	elsif (s/^$me-([^:]+)://o) { # progname-component: value
586	$component = $1;
587	chop;
588	s/^\s+//; # Trim leading and trailing spaces
589	s/\s+$//;
590	$Profile{$component} = $_;
591	}
592	}
593	close PROFILE;
594	return unless $options;
595	require 'shellwords.pl';
596	local(@opts);
597	eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
598	unshift(@ARGV, @opts);
599	return $me; # Return our invocation name
600	}
601