package Bootstrap;

use strict;

BEGIN {
    use File::Basename;
    use Net::FTP;

    require Exporter;

    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    $VERSION = 1.0;
    
    @ISA = qw(Exporter);
    @EXPORT = qw($bootstrap_pm_ver
		 &close_ftp
		 &copy_cached_if_available 
		 &get_provides
		 &get_requires
		 &get_rpm_filename
                 &get_rpm_package
		 &guess_repository
		 &libraryp
		 &open_ftp
		 &print_spec
		 $rpm_command
		 $rpm_extension
		 $rpm_rpm_dir
                 $rpm_spec_dir
		 &set_repository
		 $sources_list
		 $sun_contents
		 $sun_pkg_dir
		 $tint_database);

    %EXPORT_TAGS = ();
    @EXPORT_OK = qw(&get_exec_requires);
    use vars qw($bootstrap_pm_ver
		$date
		$ftp
		$ftp_cache_dir
                %ftp_cache_manifest
		$ftp_prefix
		$ftp_rpm_dir
		$ftp_server
		$hostname
		%repositories
		$rpm_command
		$rpm_extension
		$rpm_rpm_dir
		$rpm_spec_dir
		$sources_list
         	$sun_contents
		$sun_pkg_dir
		$tint_database);
    
    $bootstrap_pm_ver = '$Id: Bootstrap.pm,v 1.21 2002/06/19 19:36:33 chrisjs Exp $';

    chomp($date = `date`);
    chomp($hostname = `uname -n`);

    %repositories = (
        'sparc-sun-solaris2.6' => {
             'RPMBUILD' => '/usr/local/bin/rpmbuild --target sparc-sun-solaris2.6',
             'RPMS' => 'sparc-sun-solaris2.6/RPMS.stable',
             'LOCAL_RPMS' => '/usr/local/src/rpm-packages/RPMS/sparc',
             'CACHE' => 'sparc-sun-solaris2.6/CACHE',
             'EXTENSION' => '.solaris2.6-sparc.rpm',
             'SOURCES_LIST' => 
   'rpm ftp://rpm.rutgers.edu rpm-packages/sparc-sun-solaris2.6 stable'
        },
        'sparc-sun-solaris2.7' => {
             'RPMBUILD' => '/usr/local/bin/rpmbuild --target sparc-sun-solaris2.7',
             'RPMS' => 'sparc-sun-solaris2.7/RPMS.stable',
             'LOCAL_RPMS' => '/usr/local/src/rpm-packages/RPMS/sparc',
             'CACHE' => 'sparc-sun-solaris2.7/CACHE',
             'EXTENSION' => '.solaris2.7-sparc.rpm',
             'SOURCES_LIST' => 
   'rpm ftp://rpm.rutgers.edu rpm-packages/sparc-sun-solaris2.7 stable'
        },
        'sparc-sun-solaris2.8' => {
             'RPMBUILD' => '/usr/local/bin/rpmbuild --target sparc-sun-solaris2.8',
             'RPMS' => 'sparc-sun-solaris2.8/RPMS.stable',
             'LOCAL_RPMS' => '/usr/local/src/rpm-packages/RPMS/sparc',
             'CACHE' => 'sparc-sun-solaris2.8/CACHE',
             'EXTENSION' => '.solaris2.8-sparc.rpm',
             'SOURCES_LIST' => 
   'rpm ftp://rpm.rutgers.edu rpm-packages/sparc-sun-solaris2.8 stable'
        },
        'sparc64-sun-solaris2.7' => {
             'RPMBUILD' => '/usr/local/bin/rpmbuild',
             'RPMS' => 'sparc64-sun-solaris2.7/RPMS.stable',
             'LOCAL_RPMS' => '/usr/local/src/rpm-packages/RPMS/sparc64',
             'CACHE' => 'sparc64-sun-solaris2.7/CACHE',
             'EXTENSION' => '.solaris2.7-sparc64.rpm',
             'SOURCES_LIST' => 
   'rpm ftp://rpm.rutgers.edu rpm-packages/sparc64-sun-solaris2.7 stable'
        },
        'sparc64-sun-solaris2.8' => {
             'RPMBUILD' => '/usr/local/bin/rpmbuild',
             'RPMS' => 'sparc64-sun-solaris2.8/RPMS.stable',
             'LOCAL_RPMS' => '/usr/local/src/rpm-packages/RPMS/sparc64',
             'CACHE' => 'sparc64-sun-solaris2.8/CACHE',
             'EXTENSION' => '.solaris2.8-sparc64.rpm',
             'SOURCES_LIST' => 
   'rpm ftp://rpm.rutgers.edu rpm-packages/sparc64-sun-solaris2.8 stable'
        },
        'sparc64-sun-solaris2.8_sun-perl,gnome' => {
             'RPMBUILD' => '/usr/local/bin/rpmbuild',
             'RPMS' => 'sparc64-sun-solaris2.8_sun-perl,gnome/RPMS.stable',
             'LOCAL_RPMS' => '/usr/local/src/rpm-packages/RPMS/sparc64',
             'CACHE' => 'sparc64-sun-solaris2.8_sun-perl,gnome/CACHE',
             'EXTENSION' => '.solaris2.8-sparc64.sun-perl,gnome.rpm',
             'SOURCES_LIST' => 
   'rpm ftp://rpm.rutgers.edu rpm-packages/sparc64-sun-solaris2.8_sun-perl,gnome stable'
        },
        'sparc64-sun-solaris2.9' => {
             'RPMBUILD' => '/usr/local/bin/rpmbuild',
             'RPMS' => 'sparc64-sun-solaris2.9/RPMS.stable',
             'LOCAL_RPMS' => '/usr/local/src/rpm-packages/RPMS/sparc64',
             'CACHE' => 'sparc64-sun-solaris2.9/CACHE',
             'EXTENSION' => '.solaris2.9-sparc64.rpm',
             'SOURCES_LIST' =>
   'rpm ftp://rpm.rutgers.edu rpm-packages/sparc64-sun-solaris2.9 stable'
	});
    
    # This is where the vpkg specs are placed; it need not be 
    # /usr/local/src/rpm-packages/SPECS:
    $rpm_spec_dir   = "/usr/local/src/rpm-packages/VPKG-SPECS";
    $sun_contents   = "/var/sadm/install/contents";
    $sun_pkg_dir    = "/var/sadm/pkg";
    $tint_database  = "/var/tint/INSTALLED";

    $ftp_server = "rpm.rutgers.edu";
    $ftp_prefix = "/rpm-packages";

    %ftp_cache_manifest = ();
}

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

# Sets the repository for bootstrap, et al. to use.  This -must- be called
# (usually "set_repository guess_repository;" );

sub set_repository ($) {
    my $repository = shift;

    die "Unknown repository: $repository\n"
	unless(defined($repositories{$repository}));

    $rpm_command   = $repositories{$repository}->{'RPMBUILD'};
    $rpm_rpm_dir   = $repositories{$repository}->{'LOCAL_RPMS'};
    $ftp_rpm_dir   = "$ftp_prefix/$repositories{$repository}->{'RPMS'}";
    $ftp_cache_dir = "$ftp_prefix/$repositories{$repository}->{'CACHE'}";
    $rpm_extension = $repositories{$repository}->{'EXTENSION'};
    $sources_list  = $repositories{$repository}->{'SOURCES_LIST'};
}

# Guesses the architecture-manufacturer-os string (which should
# correspond.  to a valid repository).  Note that this will -never-
# return "sparc64-sun-solaris2.8_sun-perl,gnome".

sub guess_repository () {
    my $arch;
    chomp (my $os = qx(uname -r));

    if ($os =~ /5\.(\d+)/) {
        $os = "solaris2.$1";
    } else {
        warn "$os unexpected Solaris release number\n";
    }

    if ($os ne "solaris2.6" && qx(isainfo -b) =~ /64/) {
        $arch = "sparc64";
    } else {
        $arch = "sparc";
    }

    return "$arch-sun-$os";
}

sub libraryp ($) {
    my $fn = shift;

    return ($fn =~ /\.so(?:\.|$)/);
}

# For some reason, a lot of the gifs, classes, etc. in my
# /usr/demo/Java1.2/demos tree are executable.  Also, some kernel
# files that look like executables generate hundreds of lines of
# errors when you ldd them.

sub not_solaris_oddity ($) {
    return ($_[0] !~ m((?:\.(?:aiff|au|bat|class|fls|gif|html|pf|
			     jar|java|jpg|ldb|MDB|mid|obj|pmf|png|ttf|gm|
			     properties|rmf|theme|txt|wav|xyz|a|xpm.Z)|
	                     COPYRIGHT)$|^(?:|/usr|/platform).*/kernel)x);
}

# get_exec_requires runs ldd to find the libraries required by a
# single executable or shared library.  I could use rpm's
# find-requires script; but this is (hopefully) slightly faster.

sub get_exec_requires ($) {
    my $fn = shift;

    my @requires;
    my $ldd;

    if (-x $fn && !(-d $fn) && -B $fn && not_solaris_oddity($fn)) {
	open (LDD, "ldd -r $fn |")
	    or die "Cannot run ldd pipe: $!";
	
	while (defined ($ldd = <LDD>) && $ldd !~ /symbol/ &&
	       $ldd =~ /^\s*?(\S+)\s*\=\>/) {
	    push @requires, (basename $1);
	}
	while (<LDD>) { } # flush rest of input
	close LDD or warn "Pipe error: $!";
    } 

    return \@requires;
}

# get_provides accumulates a list of the files provided by a list of
# files.
# 2002-06-17 chrisjs: Changes have been made here to map Sun packages
# to our package name. The Sun package name is passed in on the top
# of the stack then popped off. %mangler keeps our correlation between
# Sun and RPM names. Elements are 'SUNpkgname osver', 'rpmname = rpmver'.
# 2002-06-17 richton: The original mangler wouldn't allow for multiple
# provides by one package. Extended to use a hash of lists.

sub get_provides (@, $) {
    local $_;
    my @provides;
    my $pkg = pop(@_);
    print "PACKAGE:" . $pkg . "\n";

	my %mangler = (
		'SUNWzlib 5.9' => [ "zlib = 1.1.3" ],
		'SUNWpl5u 5.9' => [ "perl = 5.6.1" ],
		'SUNWopl5u 5.9' => [ "perl = 5.00503" ],
		'SUNWbash 5.9' => [ "bash = 2.05" ],
		'SUNWtcsh 5.9' => [ "tcsh = 6.10" ],
		'SUNWzsh 5.9' => [ "zsh = 3.0.8" ],
		'SUNWcsu 5.9' => [ "/bin/sh", "traceroute" ],
		'SUNWpng 5.9' => [ "libpng = 1.0.12" ],
		'SUNWjpg 5.9' => [ "libjpeg = 6b" ],
		'SUNWxwrtl 5.9' => [ "xpm = 3.4k" ],
		'SUNWgzip 5.9' => [ "gzip = 1.3" ],
		'SUNWtexi 5.9' => [ "texinfo = 4.0" ],
		'SUNWTcl 5.9' => [ "tcl = 8.3.3" ],
		'SUNWTk 5.9' => [ "tcl-tk = 8.3.3" ],
		'SUNWGtku 5.9' => [ "gtk+ = 1.2.10" ],
		'SUNWGlib 5.9' => [ "glib = 1.2.10" ],
		'SUNWless 5.9' => [ "less = 358" ],
		'SUNWj2rt 5.9' => [ "libodbcinst.so.1", "libodbc.so.1" ],
		'SUNWbzip 5.9' => [ 'bzip2 = 1.0.1'],
                'SUNWadmap 5.9' => [ "sysidlib", "sysiduilib" ],
                'SUNWTiff 5.9' => [ "tiff = 3.5.5" ],
                'SUNWj3rt 5.9' => [ "libodbcinst.so.1", "libodbc.so.1" ],
		'SUNWlxml 5.9' => [ "libxml2 = 2.4.12", "libxml2-devel = 2.4.12" ],
		'SUNWlxmlx 5.9' => [ "libxml2 = 2.4.12", "libxml2-devel = 2.4.12" ],
		'SUNWtcpd 5.9' => [ "tcp_wrappers = 7.6", "tcp_wrappers-ipv6 = 7.6"],
		'SUNWpl5u 5.8' => [ "perl = 5.005_03" ],
		'SUNWpl5u 5.8' => [ "perl = 5.00503" ],
                'SUNWbash 5.8' => [ "bash = 2.03" ],
		'SUNWtcsh 5.8' => [ "tcsh = 6.09.00" ],
                'SUNWzsh 5.8' => [ "zsh = 3.0.6" ],
                'SUNWcsu 5.8' => [ "/bin/sh", "traceroute", "libpicl.so.1" ],
                'SUNWzlib 5.8' => [ "zlib = 1.1.3" ],
                'SUNWj2rt 5.8' => [ "libodbcinst.so.1", "libodbc.so.1" ],
		'SUNWgtk+ 5.8' => [ "gtk+ = 1.2.0", "gtk+-devel = 1.2.0" ],
		'SUNWglib 5.8' => [ "glib = 1.2.0" ],
                'SUNWadmap 5.8' => [ "sysidlib", "sysiduilib" ],
		'SUNWami 5.8' => [ "libami.so.1" ],
                'SUNWamix 5.8' => [ "libami.so.1" ],
                'SUNWcsu 5.7' => [ "/bin/sh", "jsh", "ksh", "csh", "traceroute", "libpicl.so.1" ],
		'SUNWesu 5.7' => [ "awk", "oawk", "nawk" ],
		'SUNWadmap 5.7' => [ "sysidlib", "sysiduilib" ],
		'SUNWjvrt 5.7' => [ "libodbcinst.so.1", "libodbc.so.1" ],
        );

    chomp(my $os = qx(uname -r)); 
    my $temp = $pkg . " " . $os;
    @provides =  grep { libraryp $_ } (map { basename $_ } @_);

    my $providemetoo;

    foreach $providemetoo (@{$mangler{$temp}}) {
        print "\n" . $pkg . " will provide " . $providemetoo . "\n"; 
        push(@provides, $providemetoo);
    }

    return \@provides;
}

# get_requires accumulates a list of the libraries required by a list
# of files.

sub get_requires (@) {
    my @requires;
    my %requires;
    my $file;
    local $_;

    foreach $file (@_) {
	@requires{ @{ get_exec_requires($file) } } = ();
    }
    
    return [ map { basename $_ } (keys %requires) ];
}

# get_rpm_filename returns the filename that rpm will produce for a
# virtual package, given a name, version, and release.

sub get_rpm_filename ($$$) {
    my ($name, $version, $release) = @_;

    return "vpkg-$name-$version-$release$rpm_extension";
}

# get_rpm_package downloads the first argument from the ftp server and
# saves it in $rpm_rpm_dir.  It returns 1 on success and undef on 
# failure.

sub get_rpm_package ($) {
    my $rpmname = shift;

    $ftp->cwd($ftp_rpm_dir)  or goto FAILURE;
    $ftp->binary             or goto FAILURE;
    $ftp->get("$rpmname$rpm_extension", "$rpm_rpm_dir/$rpmname$rpm_extension")
                             or goto FAILURE;
    $ftp->cwd("/")           or goto FAILURE;

    return 1;
  FAILURE: 
    return undef;
}

# copy_cached_if_available copies a cached virtual package if it is
# available and returns the name of the cached file; otherwise it
# returns 0.  If there is an FTP error, it returns undef.

sub copy_cached_if_available ($$$) {
    my ($name, $version, $release) = @_;
    my $fn = get_rpm_filename($name, $version, $release);

    unless (%ftp_cache_manifest) {
        my @ls;

        $ftp->cwd($ftp_cache_dir) or goto FAILURE;
        $ftp->binary              or goto FAILURE;
        @ls = $ftp->ls            or goto FAILURE;
        $ftp->cwd("/")            or goto FAILURE;

        @ftp_cache_manifest{@ls} = (1) x @ls;
    }

    if ($ftp_cache_manifest{$fn}) {
	$ftp->cwd($ftp_cache_dir) or goto FAILURE;
	$ftp->binary              or goto FAILURE;
	$ftp->get($fn, "$rpm_rpm_dir/$fn")
	    or goto FAILURE;
	$ftp->cwd("/")            or goto FAILURE;
	
        return $fn;
    }
    return 0;
  FAILURE:
    return undef;
}

# This opens a connection to the ftp server.  If it fails, bootstrap dies.

sub open_ftp () {
    $ftp = Net::FTP->new($ftp_server, Debug => 0) # Passive => 1 ?
                or goto FAILURE;
    $ftp->login or goto FAILURE;
    return;
  FAILURE:
    die "FTP error: $!";
}

sub close_ftp () {
    $ftp->quit;
}

# This prints a specfile.
#
# print_spec { NAME => "foo-bar", 
#              VERSION => "2.71828",
#              RELEASE => 1,
#              PROVIDES => [ "foo", "bar" ]
#              REQUIRES => [ "flarp", "quux" ] };

sub print_spec ($) {
    my $params   = shift;
    my ($pkg, $version, $release, $provides, $requires) =
	@$params{qw(NAME VERSION RELEASE PROVIDES REQUIRES)};

    my $library;
    my $fn;

    $fn = "$rpm_spec_dir/vpkg-$pkg-$version-$release.spec";

    open (SPEC, "> $fn")
	or die "Cannot open $fn for writing: $!";

    foreach $library (@{ $provides }) {
	print SPEC "Provides: $library\n";
    }

    foreach $library (@{ $requires }) {
	print SPEC "Requires: $library\n";
    }
	
    print SPEC <<EOTEXT;
Name: vpkg-$pkg
Version: $version
Release: $release
Summary: virtual package
Group: ---
License: ---

\%description
This is a virtual RPM package.  It contains no actual files.  It uses the
\`Provides' token from RPM 3.x and later to list many of the shared libraries
and interpreters that are part of the base operating system and associated
subsets for Solaris.

This virtual package was constructed based on the vendor/system software
installed on the Solaris machine named $hostname, as of the date
$date.  It is intended to supply dependency 
information about the package: $pkg, version: $version.

\%prep
# nothing to do

\%build
# nothing to do

\%install
# nothing to do

\%clean
# nothing to do


\%files

EOTEXT
    close SPEC;
    return;
}

return 1;
