3 # Written by Fernando Alegre <alegre@debian.org> 1996
5 # Applied patch by Dimitri Maziuk <emaziuk@curtin.edu.au> 1997
6 # (to handle new tar format)
8 # Modified by Fernando Alegre <alegre@debian.org> 1997
9 # (to handle both new and old tar formats)
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)
15 # Modified by Martin Bialasinski <martinb@debian.org> 1999
16 # (deal with change in tar format)
19 # Copyright (C) 1997 Free Software Foundation
24 s/([^\w\/.+-])/\\$1/g;
31 # CAVEAT: Hard links are listed as if they were symlinks
32 # Empty directories do not appear at all
34 local($archivename)=@_;
35 local $qarchivename = quote($archivename);
36 chop($date=`LC_ALL=C date "+%b %d %H:%M"`);
37 chop($info_size=`LC_ALL=C dpkg -I $qarchivename | wc -c`);
38 $install_size=length($pressinstall);
40 print "dr-xr-xr-x 1 root root 0 $date CONTENTS\n";
41 print "dr-xr-xr-x 1 root root 0 $date DEBIAN\n";
42 print "-r--r--r-- 1 root root $info_size $date INFO\n";
43 print "-r-xr--r-- 1 root root $install_size $date INSTALL\n";
45 if ( open(PIPEIN, "dpkg-deb -c $qarchivename |") )
51 $perm=$_[0]; $owgr=$_[1]; $size=$_[2];
52 if($_[3] =~ /^\d\d\d\d\-/) { # New tar format
54 ($year,$mon,$day) = split(/-/,$_[3]);
55 $month = ("Gee","Jan","Feb","Mar","Apr","May","Jun",
56 "Jul","Aug","Sep","Oct","Nov","Dec")[$mon] || "Gee";
61 $mstring='GeeJanFebMarAprMayJunJulAugSepOctNovDec';
63 $mon=index($mstring,$month) / 3;
70 $path=$_[$pathindex++];
71 $arrow=$_[$pathindex++];
72 $link=$_[$pathindex++];
73 $link2=$_[$pathindex++];
78 # report hard links as soft links
79 $arrow='->'; $link="/$link2";
80 substr($perm, 0, 1) = "l";
88 ($thisyear, $thismon) = split(/ /, $now);
89 # show time for files younger than 6 months
90 # but not for files with dates in the future
91 if ($year * 12 + $mon > $thisyear * 12 + $thismon - 6 &&
92 $year * 12 + $mon <= $thisyear * 12 + $thismon) {
93 print "$perm 1 $owgr $size $month $day $time CONTENTS/$path$arrow$link\n";
95 print "$perm 1 $owgr $size $month $day $year CONTENTS/$path$arrow$link\n";
99 if ( open(PIPEIN, "LC_ALL=C dpkg-deb -I $qarchivename |") )
105 last if $size =~ /:/;
106 next if $size !~ /\d+/;
117 print "$perm 1 root root $size $date DEBIAN/$name\n";
124 local($archive,$filename,$destfile)=@_;
125 local $qarchive = quote($archive);
126 local $qfilename = quote($filename);
127 local $qdestfile = quote($destfile);
129 if($filename eq "INFO")
131 system("dpkg-deb -I $qarchive > $qdestfile");
133 elsif($filename =~ /^DEBIAN/)
135 $qfilename=~s!^DEBIAN/!!;
136 system("dpkg-deb -I $qarchive $qfilename > $qdestfile");
138 elsif($filename eq "INSTALL")
140 if ( open(FILEOUT,">$destfile") )
142 print FILEOUT $pressinstall;
144 system("chmod a+x $qdestfile");
149 # files can be prepended with ./ or not, depending on the version of tar
150 $qfilename=~s!^CONTENTS/!!;
151 system("dpkg-deb --fsys-tarfile $qarchive | tar xOf - $qfilename ./$qfilename > $qdestfile 2>/dev/null");
157 local($archive,$filename)=@_;
158 local $qarchive = quote($archive);
159 if($filename eq "INSTALL")
161 print "Installing $archive\n";
162 system("dpkg -i $qarchive");
166 use File::Temp qw(mkdtemp);
167 my $template = "/tmp/mcdebfs.run.XXXXXX";
168 $template="$ENV{MC_TMPDIR}/mcdebfs.XXXXXX" if ($ENV{MC_TMPDIR});
169 $tmpdir = mkdtemp($template);
170 $tmpcmd="$tmpdir/run";
171 &mcdebfs_copyout($archive, $filename, $tmpcmd);
172 system("chmod u+x $tmpcmd");
179 $pressinstall=<<EOInstall;
182 Don\'t use this method if you are not willing to reinstall everything...
184 This is not a real file. It is a way to install the package you are browsing.
186 To install this package go back to the panel and press Enter on this file.
188 In Debian systems, a package is automatically upgraded when you install a new
189 version of it. There is no special upgrade option. Install always works.
195 if($ARGV[0] eq "list") { shift; &mcdebfs_list(@ARGV); exit 0; }
196 elsif($ARGV[0] eq "copyout") { shift; &mcdebfs_copyout(@ARGV); exit 0; }
197 elsif($ARGV[0] eq "run") { shift; &mcdebfs_run(@ARGV); exit 0; }