modules/extfs/deb.in

   1 #!/usr/bin/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 #
  16 #
  17 # Copyright (C) 1997 Free Software Foundation
  18 #
  19
  20 sub mcdebfs_list
  21 {
  22 #
  23 #       CAVEAT: Hard links are listed as if they were symlinks
  24 #               Empty directories do not appear at all
  25 #
  26         local($archivename)=@_;
  27         chop($date=`LC_ALL=C date "+%b %d %Y %H:%M"`);
  28         chop($info_size=`dpkg -I $archivename | wc -c`);
  29         $install_size=length($pressinstall);
  30
  31         print "dr-xr-xr-x   1 root     root     0 $date CONTENTS\n";
  32         # from Patrik Rak
  33         print "dr-xr-xr-x   1 root     root     0 $date DEBIAN\n";
  34         print "-r--r--r--   1 root     root     $info_size $date INFO\n";
  35         print "-r-xr--r--   1 root     root     $install_size $date INSTALL\n";
  36
  37         if ( open(PIPEIN, "dpkg-deb -c $archivename |") )
  38         {
  39                 while(<PIPEIN>)
  40                 {
  41                         split;
  42
  43                         $perm=$_[0]; $owgr=$_[1]; $size=$_[2];
  44                         if($_[3] =~ /^\d\d\d\d\-/) { # New tar format
  45
  46                                 ($year,$mon,$day) = split(/-/,$_[3]);
  47                                 $month = ("Gee","Jan","Feb","Mar","Apr","May","Jun",
  48                                                   "Jul","Aug","Sep","Oct","Nov","Dec")[$mon] || "Gee";
  49                                 $time=$_[4];
  50                                 $pathindex=5;
  51                         }
  52                         else {
  53                                 $month=$_[3];
  54                                 $day=$_[4];
  55                                 $time=$_[5];
  56                                 $year=$_[6];
  57                                 $pathindex=7;
  58                         }
  59
  60                         $path=$_[$pathindex++];
  61                         $arrow=$_[$pathindex++];
  62                         $link=$_[$pathindex++];
  63                         $link2=$_[$pathindex++];
  64
  65                         $owgr=~s!/! !;
  66                         next if $path=~m!/$!;
  67                         if($arrow eq 'link')
  68                         {
  69 # report hard links as soft links
  70                                 $arrow='->'; $link="/$link2";
  71                                 substr($perm, 0, 1) = "l";
  72                         }
  73                         if($arrow ne '')
  74                         {
  75                                 $arrow=' ' . $arrow;
  76                                 $link= ' ' . $link;
  77                         }
  78                         print "$perm 1 $owgr $size $month $day $year $time CONTENTS/$path$arrow$link\n";
  79                 }
  80         }
  81         # begin from Patrik Rak
  82         if ( open(PIPEIN, "dpkg-deb -I $archivename |") )
  83         {
  84                while(<PIPEIN>)
  85                {
  86                        split;
  87                        $size=$_[0];
  88                        last if $size =~ /:/;
  89                        next if $size !~ /\d+/;
  90                        if($_[4] eq '*')
  91                        {
  92                            $perm='-r-xr-xr-x';
  93                            $name=$_[5];
  94                        }
  95                        else
  96                        {
  97                            $perm='-r--r--r--';
  98                            $name=$_[4];
  99                        }
 100                        print "$perm 1 root root $size $date DEBIAN/$name\n";
 101                }
 102         }
 103         # end from Patrik Rak
 104
 105 }
 106
 107 sub mcdebfs_copyout
 108 {
 109         local($archive,$filename,$destfile)=@_;
 110
 111         if($filename eq "INFO")
 112         {
 113                 system("dpkg-deb -I $archive > $destfile");
 114         # begin from Patrik Rak
 115         }
 116         elsif($filename =~ /^DEBIAN/)
 117         {
 118                $filename=~s!^DEBIAN/!!;
 119                system("dpkg-deb -I $archive $filename > $destfile");
 120         # end from Patrik Rak
 121
 122         }
 123         elsif($filename eq "INSTALL")
 124         {
 125                 if ( open(FILEOUT,">$destfile") )
 126                 {
 127                         print FILEOUT $pressinstall;
 128                         close FILEOUT;
 129                         system("chmod a+x $destfile");
 130                 }
 131         }
 132         else
 133         {
 134                 $filename=~s!^CONTENTS/!!;
 135                 system("dpkg-deb --fsys-tarfile $archive | tar xOf - $filename > $destfile");
 136         }
 137 }
 138
 139 sub mcdebfs_run
 140 {
 141         local($archive,$filename)=@_;
 142         if($filename eq "INSTALL")
 143         {
 144                 print "Installing $archive\n";
 145                 system("dpkg -i $archive");
 146         }
 147         else
 148         {
 149                 $suffix = "aaa";
 150                 while (1) {
 151                     $tmpdir = "/tmp/mcdebfs.run".$$.$suffix;
 152                     last if mkdir $tmpdir, 0700;
 153                     $suffix++;
 154                     # Somebody is being really nasty, give up
 155                     exit 1 if $suffix eq "zzz";
 156                 }
 157
 158                 $tmpcmd="$tmpdir/run";
 159                 &mcdebfs_copyout($archive, $filename, $tmpcmd);
 160                 system("chmod u+x $tmpcmd");
 161                 system($tmpcmd);
 162                 unlink($tmpcmd);
 163                 rmdir($tmpdir);
 164         }
 165 }
 166
 167 $pressinstall=<<EOInstall;
 168
 169                               WARNING
 170      Don't use this method if you are not willing to reinstall everything...
 171
 172 This is not a real file. It is a way to install the package you are browsing.
 173
 174 To install this package go back to the panel and press Enter on this file.
 175
 176 In Debian systems, a package is automatically upgraded when you install a new
 177 version of it. There is no special upgrade option. Install always works.
 178
 179 EOInstall
 180
 181 umask 077;
 182
 183 if($ARGV[0] eq "list") { shift; &mcdebfs_list(@ARGV); exit 0; }
 184 elsif($ARGV[0] eq "copyout") { shift; &mcdebfs_copyout(@ARGV); exit 0; }
 185 elsif($ARGV[0] eq "run") { shift; &mcdebfs_run(@ARGV); exit 0; }
 186
 187 exit 1;
 188