#  -*- Perl -*-
eval "exec perl -S $0 $*"
    if $running_under_some_shell;
chomp($yard_version= `cat VERSION`);

#####  Edit these destination directories to your liking
#####  ===>  ALL OF THESE WILL BE RELATIVE TO PREFIX, IF SUPPLIED.

#  Destination for the scripts (make_root_fs, check_root_fs, etc)
$scripts_dest   =  "sbin";

#  Destination for the immutable library files (original contents of
#  Replacements/ and extras/).
$lib_dest       =  "lib/yard";

#  Destination for the configuration and editable files.  This includes
#  Config.pl and Bootdisk_Contents, and everything under Replacements
$config_dest = "etc/yard";

#  Destination for documentation files (in Doc subdirectory)
$doc_dest	=  "usr/doc/yard-${yard_version}";


##############################################################################
#####  Nothing below this line should need changing
##############################################################################
require 5.002;			# Need Perl >= 5.002 for all scripts
use POSIX qw(tmpnam);
use Config;
use English;
use FileHandle;

if ($Config{'osname'} !~/linux/i) {	# Just to be careful
  die "You're not running Linux?!\n";
}

my($archname) = $Config{'archname'};
die "Can't figure out your archname!" unless defined($archname);
#  This matches i386, i486, i586...
my($arch_iX86) = $archname =~ /^i\d86-/;

#  These are to test for old bugs.  Probably unnecessary, but  may as
#  well keep them.
#test_cp();
#test_lstat();
#test_ldconfig();

##############################################################################
#  Convert all paths to use PREFIX
##############################################################################
use Getopt::Long;
my($PREFIX);
GetOptions("prefix=s" => \$PREFIX) or
    die "Something's wrong with your options: $!";
#  Don't call the user "dude"
print "PREFIX = \"$PREFIX\"\n";

#  Prepend PREFIX onto all of these
$scripts_dest  = "$PREFIX/$scripts_dest";
$config_dest   = "$PREFIX/$config_dest";
$lib_dest      = "$PREFIX/$lib_dest";
$doc_dest      = "$PREFIX/$doc_dest";

@directories = qw(scripts_dest config_dest lib_dest doc_dest);

@output_scripts = qw(scripts/check_root_fs
		     scripts/create_loopback_file
		     scripts/create_replacements
		     scripts/identify_bootdisk
		     scripts/make_root_fs
		     scripts/write_rescue_disk);

@output_others = qw(Makefile
		    doc/Makefile
		    extras/Makefile
		    scripts/Makefile
		    Config.pl
		    Bootdisk_Contents
		    yardconfig.pm
		    doc/yard.8
		   );


@necessary_progs = qw(chroot cp ln dd gunzip gzip install
		      ldconfig ldd make mkdir mke2fs
		      mount mv perl rm sync umount uname);

@optional_progs = qw(as86 bzip2 dvips install-info latex ld86 lilo objcopy
		     sgml2html sgml2info sgml2latex sgml2txt tar
		    );


#  rdev is necessary on X86, optional on others (eg, m68K)
if ($arch_iX86) {
   push(@necessary_progs, "rdev")
} else {
   push(@optional_progs,  "rdev")
}


@misc_substitutions = qw(configure_input yard_version);


@pathdirs = split(':', "$ENV{'PATH'}:/sbin/:/usr/sbin");

##############################################################################
#####  Find and record locations of important programs
##############################################################################
foreach $prog (@necessary_progs) {
    record_loc($prog, find_file_in_path($prog, 1));
}
print "== Optional programs.  Don't worry if these are not found.\n";
foreach $prog (@optional_progs)  {
    record_loc($prog, find_file_in_path($prog, 0));
}

if (!defined($loc{'objcopy'})) {
    print "Warning: objcopy not found -- unable to strip binaries.\n";
}
print "\n";

##############################################################################
#####  Build substitutions
##############################################################################
$substs = "";
foreach $prog (@necessary_progs, @optional_progs) {
    $substs .= "s|\\\@${prog}\\\@|$loc{$prog}|gi;\n"; }
foreach $var (@directories, @misc_substitutions) {
    $substs .= "s|\\\@${var}\\\@|\$$var|gi;\n"}

#####  Substitute into scripts
foreach $script (@output_scripts, @output_others) {
    print "Creating $script\n";
    $source = "${script}.in";
    if (!open(SOURCE, $source))  { print "$source: $!\n"; next };
    if (!open(DEST, ">$script")) { print "Writing $script: $!\n"; next };
    $configure_input = "This script created automatically from $source";
    while (<SOURCE>) {
	eval $substs if /\@/;
	print DEST;
    }
    close(DEST) or print "Closing $script: $!";
    close(SOURCE) or print "Closing $source: $!";
}

#####  Make the scripts executable
chmod(0755, @output_scripts);

#  From the doc subdirectory Makefile:
my($manfile_dest) = cleanup_link("$doc_dest/../../man/man8");

print "\nSummary of destinations (PREFIX = \"$PREFIX\"):\n";
print "\tExecutables:\t\t$scripts_dest\n";
print "\tConfiguration files:\t$config_dest\n";
print "\tVarious library files:\t$lib_dest\n";
print "\tMain documentation:\t$doc_dest\n";
print "\tMan pages:\t\t$manfile_dest\n";

print "Done.\n";
exit;

##############################################################################

sub find_file_in_path {
    my($file, $necessary) = @_;
    print "Looking for $file...";

    if ($file =~ m|/|) {
	#####  Absolute
	if (-e $file) {
	    print "Found it\n";
	    return($file);
	}

    } else {
	#####  Relative filename, search for it
	foreach $path (@pathdirs) {
	    $abs_file = "$path/$file";
	    if (-e $abs_file) {
		print "$abs_file\n";
		return $abs_file;
	    }
	}
    }

    print "NOT FOUND\n";
    if ($necessary) {
	print "$file is necessary, cannot continue.\n",
	      "Install it or fix your PATH so I can find it.\n";
	die("\n");
    }
    undef
}


sub record_loc {
    my($prog, $loc) = @_;
    $loc{$prog} = defined($loc) ? $loc : "";
}


#####  Check the cp command.  It's broken in fileutils 3.13.
sub test_cp {
    print  "Checking your version of cp...";
    my($dirname)  = tmpnam();
    my($filename) = tmpnam();

    my($setup_problem) = system("mkdir $dirname") ||
			 system("touch $filename");
    if (!$setup_problem) {
	if (system("cp --parents -R $filename $dirname")) {

	    print "\n***** Your cp command is broken and can't be used with Yard.\n";
	    print "***** Read the file doc/Broken_cp which explains",
		  " how to fix it.\n";
	    exit;

	} else {
	    print "OK\n";
	    system("rm -rf $dirname $filename");
	}
    } else {
	die "Problem in setting up test_cp in /tmp !!";
    }
}


sub test_lstat {
  #  Create a temp file
  my($file) = tmpnam();
  open(X, ">$file") or die "Can't create $file!\n";
  close(X);
  #  Try to set up a symlink to it
  my($link) = tmpnam();
  if (!symlink($file, $link)) {
    print "Can't symlink $link -> $file ?!?!\n";
    print "Something's wrong!\n";
    unlink($file);
    die;

  } elsif (!-l $link) {		#  Test the -l operator on the link
    print "ERROR: Your perl can't recognize symlinks with -l\n",
	  "\$Config{\"d_lstat\"} = \"$Config{'d_lstat'}\"\n",
	  "Yard may not work properly.\n",
	  "See doc/Broken_lstat for further information.\n";
    unlink($file, $link);
    exit;

  } else {			#  Probably unnecessary, but test lstat too.
    my($stat) = join(',', stat($link));
    my($lstat) = join(',', lstat($link));

    if ($stat eq $lstat) {
      print "ERROR: lstat is broken in this perl\n",
	    "(both stat and lstat returned the same info on a link)\n",
	    "\$Config{\"d_lstat\"} = \"$Config{'d_lstat'}\"\n",
	    "Yard may not work properly.\n",
	    "See doc/Broken_lstat for further information.\n";
      unlink($file, $link);
      exit;

  } else {
      print "Both lstat and -l seem to work -- good\n";
      unlink($file, $link);
    }
  }
}

sub test_ldconfig {
   #  ldconfig, when given an option it doesn't understand, outputs
   #  a usage summary and options to STDERR.  The 2>&1 captures this.
   my($ldconfig_help) = scalar(`ldconfig --help 2>&1`);
   if (($CHILD_ERROR >> 8) == 127) {
      print "ERROR, cannot execute ldconfig.  Please put it in your path.\n";
      exit;

   } elsif (($CHILD_ERROR >> 8) != 128) {
      print "ERROR, trouble with ldconfig.  Maybe it's very old?\n";
      exit;

   } elsif ($ldconfig_help =~ /\-r\sroot/m) {
      print "Your ldconfig accepts a -r option -- good.\n";

   } else {
      print "ERROR, your ldconfig does not have a -r (chroot) option.\n",
	    "Please upgrade to a newer version that has this option.\n",
	    "Yard now depends upon it.\n";
      exit;
   }
}


#  This was taken from yard_utils.pl, but we don't want to load the whole file.
sub cleanup_link {
  my($link) = @_;
  # Collapse all occurrences of /./
  1 while $link =~ s|/\./|/|g;
  # Cancel occurrences of /somedir/../
  # Make sure somedir isn't ".."
  1 while $link =~ s|/(?!\.\.)[^/]+/\.\./|/|g;
  $link
}