#!/usr/bin/perl
#
# Written by Fernando Alegre (alegre@debian.org) 1996
#
# Copyright (C) 1996 Debian Association, Inc
#
#
# VERY_BIG_WARNING!!
# VERY_BIG_WARNING!!
#
#	This an ALPHA release and it is less than perfect.
#	Don't use it if you are not willing to reinstall everything...
#
# VERY_BIG_WARNING!!
# VERY_BIG_WARNING!!
#

sub mcdebfs_list
{
#
#	CAVEAT: Hard links are listed as if they were symlinks
#		Empty directories do not appear at all
#
	local($archivename)=@_;
	chop($date=`date "+%b %d %Y %H:%M"`);
	chop($info_size=`dpkg -I $archivename | wc -c`);
	$install_size=length($pressinstall);

	print "dr-xr-xr-x   1 root     root     0 $date CONTENTS\n";
	print "-r--r--r--   1 root     root     $info_size $date INFO\n";
	print "-r-xr--r--   1 root     root     $install_size $date INSTALL\n";

	if ( open(PIPEIN, "dpkg-deb -c $archivename |") )
	{
		while(<PIPEIN>)
		{
			($perm,$owgr,$size,$month,$day,$time,$year,$path,$arrow,$link,$link2)
				= split;
			$owgr=~s!/! !;
			next if $path=~m!/$!;
			if($arrow eq 'link')
			{
# report hard links as soft links
				$arrow='->'; $link="/$link2"; 
				substr($perm, 0, 1) = "l";
			}
			if($arrow ne '')
			{
				$arrow=' ' . $arrow;
				$link= ' ' . $link;
			}
			print "$perm 1 $owgr $size $month $day $year $time CONTENTS/$path$arrow$link\n";
		}
	}
}

sub mcdebfs_copyout
{
	local($archive,$filename,$destfile)=@_;

	if($filename eq "INFO")
	{
		system("dpkg-deb -I $archive > $destfile");
	}
	elsif($filename eq "INSTALL")
	{
		if ( open(FILEOUT,">$destfile") )
		{
			print FILEOUT $pressinstall;
			close FILEOUT;
			system("chmod a+x $destfile");
		}
	}
	else
	{
		$filename=~s!^CONTENTS/!!;
		system("dpkg-deb --fsys-tarfile $archive | tar xOf - $filename > $destfile");
	}
}

sub mcdebfs_run
{
	local($archive,$filename)=@_;
	if($filename eq "INSTALL")
	{
		print "Installing $archive\n";
		system("dpkg -i $archive");
	}
	else
	{
		$tmpcmd="/tmp/mcdebfs.run.$$";
		&mcdebfs_copyout($archive, $filename, $tmpcmd);
		system("chmod u+x $tmpcmd");
		system($tmpcmd);
		unlink($tmpcmd);
	}
}

$pressinstall=<<EOInstall;
# VERY_BIG_WARNING!!
# VERY_BIG_WARNING!!
#
#	This an ALPHA release and it is less than perfect.
#	Don't use it if you are not willing to reinstall everything...
#
# VERY_BIG_WARNING!!
# VERY_BIG_WARNING!!
#
This is not a real file. It is a way to install the package you are browsing.

To install this package go back to the panel and press Enter on this file.

In Debian systems, a package is automatically upgraded when you install a new
version of it. There is no special upgrade option. Install always works.

EOInstall

if($ARGV[0] eq "list") { shift; &mcdebfs_list(@ARGV); exit 0; }
elsif($ARGV[0] eq "copyout") { shift; &mcdebfs_copyout(@ARGV); exit 0; }
elsif($ARGV[0] eq "run") { shift; &mcdebfs_run(@ARGV); exit 0; }

exit 1;