src/vfs/extfs/helpers/deb.in

   1 #! @PERL@
   2 #
   3 # Written by Fernando Alegre <alegre@debian.org> 1996
   4 #
   5 # Applied patch by Dimitri Maziuk <emaziuk@curtin.edu.au> 1997
   6 #         (to handle new tar format)
   7 #
   8 # Modified by Fernando Alegre <alegre@debian.org> 1997
   9 #         (to handle both new and old tar formats)
  10 #
  11 # Modified by Patrik Rak <prak@post.cz> 1998
  12 #         (add by Michael Bramer Debian-mc-maintainer <grisu@debian.org>)
  13 #         (to allow access to package control files)
  14 #
  15 # Modified by Martin Bialasinski <martinb@debian.org> 1999
  16 #         (deal with change in tar format)
  17 #
  18 #
  19 # Copyright (C) 1997 Free Software Foundation
  20 #
  21
  22 sub quote {
  23     $_ = shift(@_);
  24     s/([^\w\/.+-])/\\$1/g;
  25     return($_);
  26 }
  27
  28 sub mcdebfs_list
  29 {
  30 #
  31 #       CAVEAT: Hard links are listed as if they were symlinks
  32 #               Empty directories do not appear at all
  33 #
  34         local($archivename)=@_;
  35         local $qarchivename = quote($archivename);
  36         chop($date=`LC_ALL=C date "+%b %d %H:%M"`);
  37         chop($info_size=`dpkg -I $qarchivename | wc -c`);
  38         $install_size=length($pressinstall);
  39
  40         print "dr-xr-xr-x   1 0        0        0 $date CONTENTS\n";
  41         print "dr-xr-xr-x   1 0        0        0 $date DEBIAN\n";
  42         print "-r--r--r--   1 0        0        $info_size $date INFO\n";
  43         print "-r-xr--r--   1 0        0        $install_size $date INSTALL\n";
  44
  45         if ( open(PIPEIN, "LC_ALL=C dpkg-deb -c $qarchivename |") )
  46         {
  47                 while(<PIPEIN>)
  48                 {
  49                         @_ = split;
  50
  51                         $perm=$_[0]; $owgr=$_[1]; $size=$_[2];
  52                         if($_[3] =~ /^\d\d\d\d\-/) { # New tar format
  53
  54                                 ($year,$mon,$day) = split(/-/,$_[3]);
  55                                 $month = ("Gee","Jan","Feb","Mar","Apr","May","Jun",
  56                                                   "Jul","Aug","Sep","Oct","Nov","Dec")[$mon] || "Gee";
  57                                 $time=$_[4];
  58                                 $pathindex=5;
  59                         }
  60                         else {
  61                                 $mstring='GeeJanFebMarAprMayJunJulAugSepOctNovDec';
  62                                 $month=$_[3];
  63                                 $mon=index($mstring,$month) / 3;
  64                                 $day=$_[4];
  65                                 $time=$_[5];
  66                                 $year=$_[6];
  67                                 $pathindex=7;
  68                         }
  69
  70                         $path=$_[$pathindex++];
  71                         # remove leading ./
  72                         $path=~s/^\.\///;
  73                         next if ($path eq '');
  74                         $arrow=$_[$pathindex++];
  75                         $link=$_[$pathindex++];
  76                         $link2=$_[$pathindex++];
  77
  78                         $owgr=~s!/! !;
  79                         if($arrow eq 'link')
  80                         {
  81 # report hard links as soft links
  82                                 $arrow='->'; $link="/$link2";
  83                                 substr($perm, 0, 1) = "l";
  84                         }
  85                         if($arrow ne '')
  86                         {
  87                                 $arrow=' ' . $arrow;
  88                                 $link= ' ' . $link;
  89                         }
  90                         $now=`date "+%Y %m"`;
  91                         ($thisyear, $thismon) = split(/ /, $now);
  92                         # show time for files younger than 6 months
  93                         # but not for files with dates in the future
  94                         if ($year * 12 + $mon > $thisyear * 12 + $thismon - 6 &&
  95                                 $year * 12 + $mon <= $thisyear * 12 + $thismon) {
  96                                 print "$perm 1 $owgr $size $month $day $time CONTENTS/$path$arrow$link\n";
  97                         } else {
  98                                 print "$perm 1 $owgr $size $month $day $year CONTENTS/$path$arrow$link\n";
  99                         }
 100                 }
 101         }
 102         if ( open(PIPEIN, "LC_ALL=C dpkg-deb -I $qarchivename |") )
 103         {
 104                while(<PIPEIN>)
 105                {
 106                        @_ = split;
 107                        $size=$_[0];
 108                        last if $size =~ /:/;
 109                        next if $size !~ /\d+/;
 110                        if($_[4] eq '*')
 111                        {
 112                            $perm='-r-xr-xr-x';
 113                            $name=$_[5];
 114                        }
 115                        else
 116                        {
 117                            $perm='-r--r--r--';
 118                            $name=$_[4];
 119                        }
 120                        print "$perm 1 0    0    $size $date DEBIAN/$name\n";
 121                }
 122         }
 123 }
 124
 125 sub mcdebfs_copyout
 126 {
 127         local($archive,$filename,$destfile)=@_;
 128         local $qarchive = quote($archive);
 129         local $qfilename = quote($filename);
 130         local $qdestfile = quote($destfile);
 131
 132         if($filename eq "INFO")
 133         {
 134                 system("dpkg-deb -I $qarchive > $qdestfile");
 135         }
 136         elsif($filename =~ /^DEBIAN/)
 137         {
 138                $qfilename=~s!^DEBIAN/!!;
 139                system("dpkg-deb -I $qarchive $qfilename > $qdestfile");
 140         }
 141         elsif($filename eq "INSTALL")
 142         {
 143                 if ( open(FILEOUT,">$destfile") )
 144                 {
 145                         print FILEOUT $pressinstall;
 146                         close FILEOUT;
 147                         system("chmod a+x $qdestfile");
 148                 }
 149         }
 150         else
 151         {
 152         # files can be prepended with ./ or not, depending on the version of tar
 153                 $qfilename=~s!^CONTENTS/!!;
 154                 system("dpkg-deb --fsys-tarfile $qarchive | tar xOf - $qfilename ./$qfilename > $qdestfile 2>/dev/null");
 155         }
 156 }
 157
 158 sub mcdebfs_run
 159 {
 160         local($archive,$filename)=@_;
 161         local $qarchive = quote($archive);
 162         if($filename eq "INSTALL")
 163         {
 164                 print "Installing $archive\n";
 165                 system("dpkg -i $qarchive");
 166         }
 167         else
 168         {
 169                 use File::Temp qw(mkdtemp);
 170                 my $template = "/tmp/mcdebfs.run.XXXXXX";
 171                 $template="$ENV{MC_TMPDIR}/mcdebfs.XXXXXX" if ($ENV{MC_TMPDIR});
 172                 $tmpdir = mkdtemp($template);
 173                 $tmpcmd="$tmpdir/run";
 174                 &mcdebfs_copyout($archive, $filename, $tmpcmd);
 175                 system("chmod u+x $tmpcmd");
 176                 system($tmpcmd);
 177                 unlink($tmpcmd);
 178                 rmdir($tmpdir);
 179         }
 180 }
 181
 182 $pressinstall=<<EOInstall;
 183
 184                               WARNING
 185      Don\'t use this method if you are not willing to reinstall everything...
 186
 187 This is not a real file. It is a way to install the package you are browsing.
 188
 189 To install this package go back to the panel and press Enter on this file.
 190
 191 In Debian systems, a package is automatically upgraded when you install a new
 192 version of it. There is no special upgrade option. Install always works.
 193
 194 EOInstall
 195
 196 umask 077;
 197
 198 if($ARGV[0] eq "list") { shift; &mcdebfs_list(@ARGV); exit 0; }
 199 elsif($ARGV[0] eq "copyout") { shift; &mcdebfs_copyout(@ARGV); exit 0; }
 200 elsif($ARGV[0] eq "run") { shift; &mcdebfs_run(@ARGV); exit 0; }
 201
 202 exit 1;
 203