root/src/vfs/extfs/helpers/deb.in

/*   */

#! @PERL@
#
# Written by Fernando Alegre <alegre@debian.org> 1996
#
# Applied patch by Dimitri Maziuk <emaziuk@curtin.edu.au> 1997
#         (to handle new tar format)
#
# Modified by Fernando Alegre <alegre@debian.org> 1997
#         (to handle both new and old tar formats)
#
# Modified by Patrik Rak <prak@post.cz> 1998
#         (add by Michael Bramer Debian-mc-maintainer <grisu@debian.org>)
#         (to allow access to package control files)
#
# Modified by Martin Bialasinski <martinb@debian.org> 1999
#         (deal with change in tar format)
#
#
# Copyright (C) 1997 Free Software Foundation
#
 
sub quote {
    $_ = shift(@_);
    s/([^\w\/.+-])/\\$1/g;
    return($_);
}
 
sub mcdebfs_list
{
#
#       CAVEAT: Hard links are listed as if they were symlinks
#               Empty directories do not appear at all
#
        local($archivename)=@_;
        local $qarchivename = quote($archivename);
        chop($date=`LC_ALL=C date "+%b %d %H:%M"`);
        chop($info_size=`dpkg -I $qarchivename | wc -c`);
        $install_size=length($pressinstall);
 
        print "dr-xr-xr-x   1 root     root     0 $date CONTENTS\n";
        print "dr-xr-xr-x   1 root     root     0 $date DEBIAN\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, "LC_ALL=C dpkg-deb -c $qarchivename |") )
        {
                while(<PIPEIN>)
                {
                        @_ = split;
 
                        $perm=$_[0]; $owgr=$_[1]; $size=$_[2];
                        if($_[3] =~ /^\d\d\d\d\-/) { # New tar format
                                
                                ($year,$mon,$day) = split(/-/,$_[3]);
                                $month = ("Gee","Jan","Feb","Mar","Apr","May","Jun",
                                                  "Jul","Aug","Sep","Oct","Nov","Dec")[$mon] || "Gee";
                                $time=$_[4];
                                $pathindex=5;
                        }
                        else {
                                $mstring='GeeJanFebMarAprMayJunJulAugSepOctNovDec';
                                $month=$_[3];
                                $mon=index($mstring,$month) / 3;
                                $day=$_[4];
                                $time=$_[5];
                                $year=$_[6];
                                $pathindex=7;
                        }
                        
                        $path=$_[$pathindex++];
                        # remove leading ./
                        $path=~s/^\.\///;
                        next if ($path eq '');
                        $arrow=$_[$pathindex++];
                        $link=$_[$pathindex++];
                        $link2=$_[$pathindex++];
 
                        $owgr=~s!/! !;
                        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;
                        }
                        $now=`date "+%Y %m"`;
                        ($thisyear, $thismon) = split(/ /, $now);
                        # show time for files younger than 6 months
                        # but not for files with dates in the future
                        if ($year * 12 + $mon > $thisyear * 12 + $thismon - 6 &&
                                $year * 12 + $mon <= $thisyear * 12 + $thismon) {
                                print "$perm 1 $owgr $size $month $day $time CONTENTS/$path$arrow$link\n";
                        } else {
                                print "$perm 1 $owgr $size $month $day $year CONTENTS/$path$arrow$link\n";
                        }
                }
        }
        if ( open(PIPEIN, "LC_ALL=C dpkg-deb -I $qarchivename |") )
        {
               while(<PIPEIN>)
               {
                       @_ = split;
                       $size=$_[0];
                       last if $size =~ /:/;
                       next if $size !~ /\d+/;
                       if($_[4] eq '*')
                       {
                           $perm='-r-xr-xr-x';
                           $name=$_[5];
                       }
                       else
                       {
                           $perm='-r--r--r--';
                           $name=$_[4];
                       }
                       print "$perm 1 root root $size $date DEBIAN/$name\n";
               }
        }
}
 
sub mcdebfs_copyout
{
        local($archive,$filename,$destfile)=@_;
        local $qarchive = quote($archive);
        local $qfilename = quote($filename);
        local $qdestfile = quote($destfile);
 
        if($filename eq "INFO")
        {
                system("dpkg-deb -I $qarchive > $qdestfile");
        }
        elsif($filename =~ /^DEBIAN/)
        {
               $qfilename=~s!^DEBIAN/!!;
               system("dpkg-deb -I $qarchive $qfilename > $qdestfile");
        }
        elsif($filename eq "INSTALL")
        {
                if ( open(FILEOUT,">$destfile") )
                {
                        print FILEOUT $pressinstall;
                        close FILEOUT;
                        system("chmod a+x $qdestfile");
                }
        }
        else
        {
        # files can be prepended with ./ or not, depending on the version of tar
                $qfilename=~s!^CONTENTS/!!;
                system("dpkg-deb --fsys-tarfile $qarchive | tar xOf - $qfilename ./$qfilename > $qdestfile 2>/dev/null");
        }
}
 
sub mcdebfs_run
{
        local($archive,$filename)=@_;
        local $qarchive = quote($archive);
        if($filename eq "INSTALL")
        {
                print "Installing $archive\n";
                system("dpkg -i $qarchive");
        }
        else
        {
                use File::Temp qw(mkdtemp);
                my $template = "/tmp/mcdebfs.run.XXXXXX";
                $template="$ENV{MC_TMPDIR}/mcdebfs.XXXXXX" if ($ENV{MC_TMPDIR});
                $tmpdir = mkdtemp($template);
                $tmpcmd="$tmpdir/run";
                &mcdebfs_copyout($archive, $filename, $tmpcmd);
                system("chmod u+x $tmpcmd");
                system($tmpcmd);
                unlink($tmpcmd);
                rmdir($tmpdir);
        }
}
 
$pressinstall=<<EOInstall;
 
                              WARNING
     Don\'t use this method if you are not willing to reinstall everything...
 
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
 
umask 077;
 
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;
 

/*   */