# RPM Package Management System
# Copyright (C) 1995 Red Hat, Inc
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

# -*-perl-*-

require "flush.pl";

require "dbrecord.pl";
require "dbmisc.pl";
require "header.pl";
require "misc.pl";
require "spec.pl";
require "run.pl";

sub installbinarypackage {
    local ($force, $test, $marker, $upgrade, $packagepath) = @_;
    local ($filename, $lines, $name, %spec, %pspec, %ospec);
    local ($spec_patch, $i, $pid1, $pid2, $pid);
    local ($path, $item, @a, $str, $sub, $label, @list, $size);
    local ($targhash, $hashes, %header, $instmd5, $newmd5, @infofile);
    local (%configlist, @configssaved);
    local (@elements, $element, $bpath, $packagefile);

    $packagefile = &readheader("yes", $packagepath, *header, *spec, *pspec);

    # a binary package only has one subpackage - I'll assume it's zero
    die "Too many subpackages!" if ($spec{"subpackageC"} != 1);

    if ($spec{"subpackage:0:name"}) {
	$name = "$spec{name}-" . $spec{"subpackage:0:name"} . 
		":$spec{version}:$spec{release}";
	$label = "$spec{name}-" . $spec{"subpackage:0:name"} . 
			"-$spec{version}-$spec{release}";
    } else {
	$name = "$spec{name}:$spec{version}:$spec{release}";
	$label = "$spec{name}-$spec{version}-$spec{release}";
    }

    &debug("looking for shared/conflicting files");
    %conflicts = &findshared(0, $upgrade,  *configlist, *spec);
    if (!$force && !$upgrade && keys(%conflicts)) {
	return 1;
    }

    # check if this package has already been installed
    $str = $Packages{$name};
    if (defined $str) {
	# it's already here!

	&debug("package $name is already installed");

	%ospec = &strtorec($str, "all");

	&debug("checking for orphans");

	# Check for orphans
	@list = &spec_diff(*ospec, 0, *spec, 0);
	if (@list) {
	    $message = "Installing $label would create the following " .
			"orphans:\n";
	    foreach $num (@list) {
		$path = $ospec{"subpackage:0:file:$num:path"};
		$message = "$message\t$path\n";
	    }
	
	    if ($force) {
		$message = "$message\nGood god Jim! I'm a package system, " .
			   "not a parent killer. There are some things that " .
			   "I just won't do!";
	    }

	   &warning($message);
	   return
	}

	&debug("none found");

	if (!$force) {
	    &warning("Package $label is already installed");
	    return 1;
	}
    }

    &debug("checking config files");

    # handle the config files 
    # while we're at it, fix a cpio problem. It creates new directories
    # (directories that aren't specifically listed in the filelist) as
    # mode 0700, which is bad. Get a list of directories that it'll need
    # to create and then create them ourself with mode 0755, which is a much
    # more reasonable default
    for ($i = 0; $i < $spec{"subpackage:0:fileC"}; $i++) {
	$path = $spec{"subpackage:0:file:$i:path"};
	&debug("looking for subirs in $path");
	@elements = split("/", $path);
	shift(@elements);
	pop(@elements);
	$bpath = "";
	foreach $element (@elements) {
	    $bpath = $bpath . "/" . $element;
	    if (!(-d $rpm{'root'} . $bpath)) {
		&debug("Creating directory ", $rpm{'root'} . $bpath, "as 0755");
		if (mkdir($rpm{'root'} . $bpath, 0755) == 0) {
		    &error("mkdir ", $rpm{'root'} . $bpath, " failed");
		}
	    }
	}

	if (&is_config($spec{"subpackage:0:file:$i:info"})) {
	    $path = $rpm{'root'} . $path;
	    &debug("looking at config file |", $path, "|");

	    if (!(-f $path)) {
		&debug("no version is currently installed");
		next;
	    } 

	    @infofile = split(" ", $spec{"subpackage:0:file:$i:info"});
	    $newmd5 = $infofile[2];
	    &debug("new md5 is $newmd5");

	    $instmd5 = &md5($path);

	    if (!defined $configlist{$path}) {
		if ($instmd5 eq $newmd5) {
		    &debug("disk md5 == new md5 -- overwriting");
		    next;
		} else {
		    &debug("no version is in db -- saving to .orig");
		    &warning("$path saved as $path.orig");
		    if (! $test) {
			rename($path, "$path.orig");
		    }
		}
		next;
	    } 

	    @infofile = split(" ", $configlist{$path});
	    $dbmd5 = $infofile[2];
	    if ($instmd5 eq $dbmd5) {
		&debug("disk md5 == original md5 -- overwriting");
	    } elsif ($dbmd5 eq $newmd5) {
		&debug("original md5 == new md5 -- leaving file");
		if (! $test) {
		    rename($path, "$path.rpmsaved");
		}
		push(@configssaved, $path);
	    } else {
		&debug("version on disk has been hand modified -- saving");
		&warning("$path saved as $path.orig");
		if (! $test) {
		    rename($path, "$path.orig");
		}
	    }
	}
    }

    if ($test) {
	normal("Installation of $label would succeed");
	close($packagefile);
	return 0;
    }

    $spec{"subpackage:0:insttime"} = time();

    if (&isverbose && $marker eq "hash") {
	printf("%-28s", "$label");
	flush(STDOUT);		# this flush is completely unnecessary
    } else {
	&verbose("Installing $label");
    }

    # find the total size of the package so that percentage's will work
    for ($i = 0; $i < $spec{"subpackage:0:fileC"}; $i++) {
	$spec{"subpackage:0:file:$i:state"} = "normal";
	@f = split(" ", $spec{"subpackage:0:file:$i:info"});
	$size += $f[0];
	$amount{$spec{"subpackage:0:file:$i:path"}} = $f[0];
    }

    &debug("total size: $size");

    if (&run_prepost(*pspec, "pre")) {
	return 1
    }

    # do the cpio and install it (should it be verbose? How can I tell?)
    if ($marker eq percent) {
	print("%f $name\n");
    }
    pipe(CIN, COUT);
    flush(STDERR);
    flush(STDOUT);
    $pid1 = fork();
    if (! $pid1) {
        # this is the gunzip task
	close(CIN);
        close(STDIN);  
	open(STDIN, "<&$packagefile");
	close($packagefile);
	# note that read() uses fread(), and hence does buffering
	#debug("skipping to $header{archiveoffset}");
	#sysread(STDIN, $tmp, $header{archiveoffset});
        close(STDOUT); open(STDOUT, ">&COUT");
        exec("/bin/gzip -d");
	exit(1);
    }

    close(COUT);
    close($packagefile);
    pipe(IN, OUT);
    $pid2 = fork();
    if (! $pid2) {
        # this is the cpio task
	close(IN);

	chdir($rpm{'root'}) if ($rpm{'root'});
	chdir("/") unless ($rpm{'root'});
        close(STDERR); open(STDERR, ">&OUT");
        close(STDIN);  open(STDIN, "<&CIN");
	if ($marker) {
	    exec("/bin/cpio -ivumd");
	} else {
	    exec("/bin/cpio -iumd");
	}
	exit(1);
    } 
    close(CIN);
    close(OUT);

    $running = 0;
    $hashes = 0;
    if ($marker) {
	while (<IN>) {
	    chop;
	    if ($amount{"/$_"}) {
		$running += $amount{"/$_"};
		$percent = ($running / $size) * 100;
		if ($marker eq "percent") {
		    print("%% ", $percent, "\n");
		} elsif ($marker eq "hash") {
		    $targhash = int($percent / 2);
		    if ($targhash > $hashes) {
			print "#" x ($targhash - $hashes);
			$hashes = $targhash;
		    }
		}
		    
		flush(STDOUT);
	    }
	}
    }

    wait(); $rc1 = $?;
    wait(); $rc2 = $?;
    # remove the speci file that just got created in /tmp
    unlink($filename);

    if ($rc1 || $rc2) {
	error("gunzip <  $packagepath | cpio -ivumd failed");
    }

    print "\n" if ($marker eq "hash");

    debug("cpio finished");

    close(IN);
    # Whew -- both ends of both pipes have been closed, so we can continue

    # clean up config files
    &debug("config files saved: @configssaved");
    while (defined ($item = pop(@configssaved))) {
	&debug("restoring $item");
	rename("$item.rpmsaved", $item);
    }
	    
    if (&run_prepost(*pspec, "post")) {
	return 1
    }

    &instupdatedatabase(*spec, *conflicts, *header);

    if ($upgrade) {
	require "uninstall.pl";

	$idxname = "$spec{name}";
	if ($spec{"subpackage:0:name"}) {
	     $idxname = $idxname . "-" . $spec{"subpackage:0:name"};
	}

	$list = $NameIndex{$idxname};
	&debug("\$NameIndex{$idxname} = ", $list);

	foreach $package (split(" ", $list)) {
	    if ($package ne $name) {
		&debug("doing uninstall of $package");
		&uninstallpackage(1, $test, 1, $package);
	    }
	}
    }

    return 0;
}

sub instupdatedatabase {
    local (*spec, *conflicts, *header) = @_;
    local ($name, $package, $i, %fullspec, $nameline);
    local ($inlist, $item, $titem, $thelist, $idxname);
    local ($ostr, %ospec, $fileinfo, $filenum, $ofilenum);

    if ($spec{"subpackage:0:name"}) {
	$name = "$spec{name}" . "-" . $spec{"subpackage:0:name"} . 
		":$spec{version}:$spec{release}";
	$idxname = "$spec{name}-" . $spec{"subpackage:0:name"};
    } else {
	$name = "$spec{name}:$spec{version}:$spec{release}";
	$idxname = "$spec{name}";
    }

    if (defined $Packages{$name}) {
	# we're reinstalling it
	&debug("package $name has already been installed - I'll redo it");
	&debug("removing old package's db entry");

	delete($Packages{$name});
    } 
	
    debug("setting \$Packages{$name}");
    $Packages{$name} = &rectostr(%spec);
    if (defined $spec{"subpackage:0:group"}) {
	debug("setting \$GroupIndex{$idxname} to ", 
		$spec{"subpackage:0:group"});
	$GroupIndex{$idxname} = $spec{"subpackage:0:group"};
	if (defined $pspec{"preun:0"}) {
	    $PreIndex{"$name:pre"} = $pspec{"preun:0"};
	}
	if (defined $pspec{"postun:0"}) {
	    $PostIndex{"$name:post"} = $pspec{"postun:0"};
	}
    }
    if (defined $header{icon}) {
	debug("setting \$IconIndex{$name}");
	$IconIndex{$name} = $header{icon};
    }

    # now update the NameIndex in case it needs some work
    $nameline = $NameIndex{$idxname};
    if (defined $nameline) {
	debug("Packages named ", $name, " already exist");
	# other packages (perhaps this very one!) exist with this name
	# if we're not in the list, add us. Otherwise, leave it alone
	$inlist = 0;
	foreach $package ($nameline) {
	    if ($package eq $name) {
		$inlist = 1;
		last;
	    }
	}
	if (!$inlist) {
	    $NameIndex{$idxname} = "$nameline $name";
	}
    } else {
	# first package w/ this name
	$NameIndex{$idxname} = $name;
	&debug("setting \$NameIndex{$idxname} = $name");
    }

    # Now go through the paths list. We *don't* look for conflicts here
    # We had a list of conflicts passed to us -- we'll mark replaced
    # files using that. We just need to insure that the package name and
    # numbers are in the list somewhere. They could be there already (if
    # we're just replacing something), but just in case...

    $sub = $spec{"subpackage:0:name"};
    for ( $i = 0; $i < $spec{"subpackage:0:fileC"}; $i++ ) {
	$path = $spec{"subpackage:0:file:$i:path"};
	$paths = $PathIndex{$path};
	$item = "$name:$i";
	$thelist = $item;
	if (defined($paths)) {
	    $inlist = 0;
	    foreach $titem (split(" ", $paths)) {
		if ($titem ne $item) {
		    $thelist = "$thelist $titem";
		}
	    }
	}
	$PathIndex{$path} = $thelist;
	&debug("set \$PathIndex{$path} = $thelist");
    }

    # The only thing left to do is deal with conflicts. The %conflicts
    # array tells us what's been replaced though, so that should be
    # easy
    
    foreach $package (keys(%conflicts)) {
	$ostr = $Packages{$package};
	if (!defined $ostr) { 
	    &error("RPM database is corrupt. Use --rebuild to ",
		   "reconstruct it");
	}
	%ospec = strtorec($ostr, "all");

	foreach $fileinfo (split(" ", $conflicts{$package}))
	{
	    ($filenum, $ofilenum) = ($fileinfo =~ /(.*):(.*)/);
	    $ospec{"subpackage:0:file:$ofilenum:state"} = "replaced";
	    debug("set replaced file in $package");
	}

	$Packages{$package} = &rectostr(%ospec);
    }
}

sub installpackages {
    local($force, $test, $marker, $upgrade, @list) = @_;
        local ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
	   $atime, $mtime, $ctime, $blksize, $blocks ) ;
    local ($ftped, $local_filename) = 0;

    &opendatabase("rw");

    foreach $package (@list) {
	$ftped = 0;
	if ($package =~ m|^ftp://|) {
            require "rpmftp.pl";
	    $local_filename = &tempname();
	    $local_filename .= "-ftpinstall.bin.rpm";
	    if ($rpm{'root'}) {
	        $local_filename = $rpm{'root'} . $local_filename;
	    }
	    &verbose("Retrieving: $package");
	    if (! &ftp_file($package, $local_filename)) {
		warning("FTP $package failed: $ftp_error");
		next;
	    }
	    $package = $local_filename;
	    $ftped = 1;
	}
	if (&package_type($package) eq "bin") {
	    warning("$package not installed") if 
		&installbinarypackage($force, $test, $marker, $upgrade, $package);
	} elsif (&package_type($package) eq "src") {
	    &installsourcepackage($package);
	} else {
	    &error("$package is not a valid rpm package");
 	}
	if ($ftped) {
	    unlink($package);
	}
    }

    &closedatabase;
}

sub installsourcepackage {
    local($packagepath) = @_;
    local ($pid1, $pid2, $rc1, $rc2, $specfile);
    local (%header, %spec, %pspec);
    local ($m1, $m2, $m3, $m4, $hasheader);

    &debug("installing source package $packagepath in $rpm{sourcedir}");

    # hack to determine if it's a old gzipped cpio archive or something
    # better
    open(FILE, "<$packagepath");
    read(FILE, $header, 4);
    close($FILE);
    ($m1, $m2, $m3, $m4) = unpack("CCCC", $header);
    if (($m1, $m2, $m3, $m4) == (0xed, 0xab, 0xee, 0xdb)) {
	&debug("new format");
	$hasheader = 1;
    } else {
	&debug("old format \$m1 = 0x", hex($m1));
    }

    if ($hasheader) {
	&readheader("", $packagepath, *header, *spec, *pspec);
	&verbose("$header{name}");
    }

    pipe(CIN, COUT);
    $pid1 = fork();
    if (! $pid1) {
        # this is the gunzip task
	close(CIN);
        close(STDOUT); open(STDOUT, ">&COUT");
        close(STDIN);  open(STDIN, $packagepath);
	# note that read() uses fread(), and hence does buffering
	sysread(STDIN, $tmp, $header{archiveoffset}) if $hasheader;
        exec("/bin/gzip -d");
	exit(1);
    }

    close(COUT);
    pipe(IN, OUT);
    $pid2 = fork();
    if (! $pid2) {
        # this is the cpio task
	&debug("chdir($rpm{sourcedir})");
	chdir($rpm{"sourcedir"});

	close(IN);

        close(STDERR); open(STDERR, ">&OUT");
        close(STDIN);  open(STDIN, "<&CIN");
        exec("/bin/cpio -ivumd");
	exit(1);
    } 
    close(CIN);
    close(OUT);

    while (<IN>) {
	chop;
	/\.[sS]pec$/ && ($specfile = $_) && &debug("spec file name: $specfile");
	verbose($_);
    }

    wait(); $rc1 = $?;
    wait(); $rc2 = $?;

    if ($rc1 || $rc2) {
	error("gunzip <  $packagepath | cpio -ivumd failed");
    }

    debug("cpio finished");

    debug("moving $rpm{sourcedir}/$specfile to $rpm{specdir}");

    if (!rename("$rpm{sourcedir}/$specfile", "$rpm{specdir}/$specfile")) {
	open(IFILE, "<$rpm{sourcedir}/$specfile");
	open(OFILE, ">$rpm{specdir}/$specfile") || 
		error("couldn't write $rpm{specdir}/$specfile");
	while (<FILE>) {
	    print OFILE;
	}
	close(IFILE);
	close(OFILE);
	unlink("$rpm{sourcedir}/$specfile");
    }
}