3 # 1999 (c) Piotr Roszatycki <dexter@debian.org>
4 # This software is under GNU license
5 # last modification: 1999-12-08
13 @time = localtime($dt);
14 $bt = sprintf "%02d-%02d-%02d %02d:%02d", $time[4], $time[3], $time[5], $time[2], $time[1];
48 } elsif( $n & 0100 ) {
66 } elsif( $n & 0010 ) {
84 } elsif( $n & 0001 ) {
94 my ($file,$path,$mode) = @_;
95 my @stat = stat($file);
96 # mode, nlink, uid, gid, size, mtime, filename
97 printf "%s %d %d %d %d %s %s\n", $mode || ft
($file).fm
($stat[2] & 07777),
98 $stat[3], $stat[4], $stat[5], $stat[7], bt
($stat[9]), $path;
105 my ($pkg, $fn, $dn, $sz, $bt);
109 my($diversions,$architecture);
110 chop($diversions = `dpkg-divert --list 2>/dev/null`);
111 chop($architecture = `dpkg-architecture 2>/dev/null`);
112 chop($list = `dpkg -l '*' 2>/dev/null`);
113 chop($getselections = `dpkg --get-selections 2>/dev/null`);
114 chop($audit = `dpkg --audit 2>/dev/null`);
115 $sz = length($diversions);
116 print "-r--r--r-- 1 root root $sz $DATE DIVERSIONS\n";
117 $sz = length($architecture);
118 print "-r--r--r-- 1 root root $sz $DATE ARCHITECTURE\n";
120 print "-r--r--r-- 1 root root $sz $DATE LIST\n";
121 $sz = length($getselections);
122 print "-r--r--r-- 1 root root $sz $DATE GET-SELECTIONS\n";
123 $sz = length($audit);
124 print "-r--r--r-- 1 root root $sz $DATE AUDIT\n";
125 $sz = length($pressconfigure);
126 print "-r-xr--r-- 1 root root $sz $DATE CONFIGURE\n";
127 $sz = length($pressremove);
128 print "-r-xr--r-- 1 root root $sz $DATE REMOVE\n";
129 $sz = length($pressclearavail);
130 print "-r-xr--r-- 1 root root $sz $DATE CLEAR-AVAIL\n";
131 $sz = length($pressforgetoldunavail);
132 print "-r-xr--r-- 1 root root $sz $DATE FORGET-OLD-UNAVAIL\n";
133 ls
("/var/lib/dpkg/status","STATUS","-r--r--r--");
134 # ls("/var/lib/dpkg/available","AVAILABLE","-r--r--r--");
136 print "drwxr-xr-x 1 root root 0 $DATE all\n";
138 open STAT
, "/var/lib/dpkg/status"
142 if( /^([\w-]*): (.*)/ ) {
143 $pkg = $2 if( lc($1) eq 'package' );
144 $debs{$pkg}{lc($1)} = $2;
149 foreach $pkg (sort keys %debs) {
150 next if $debs{$pkg}{status
} =~ /not-installed/;
151 $fn = $debs{$pkg}{package}. "_". $debs{$pkg}{version
};
152 $dn = $debs{$pkg}{section
};
155 } elsif( $dn =~ /^(non-us)$/i ) {
157 } elsif( $dn !~ /\// ) {
160 unless( $sects{$dn} ) {
162 while( $sub =~ s!^(.*)/[^/]*$!$1! ) {
163 unless( $sects{$sub} ) {
164 print "drwxr-xr-x 1 root root 0 $DATE $sub/\n";
168 print "drwxr-xr-x 1 root root 0 $DATE $dn/\n";
171 $sz = $debs{$pkg}{'status'} =~ /config-files/ ?
0 : $debs{$pkg}{'installed-size'} * 1024;
172 @stat = stat("/var/lib/dpkg/info/".$debs{$pkg}{package}.".list");
174 print "-rw-r--r-- 1 root root $sz $bt $dn/$fn.debd\n";
175 print "lrwxrwxrwx 1 root root $sz $bt all/$fn.debd -> ../$dn/$fn.debd\n";
181 my($archive,$filename) = @_;
182 if( $archive eq 'DIVERSIONS' ) {
183 system("dpkg-divert --list > $filename 2>/dev/null");
184 } elsif( $archive eq 'ARCHITECTURE' ) {
185 system("dpkg-architecture > $filename 2>/dev/null");
186 } elsif( $archive eq 'LIST' ) {
187 system("dpkg -l '*' > $filename 2>/dev/null");
188 } elsif( $archive eq 'AUDIT' ) {
189 system("dpkg --audit > $filename 2>/dev/null");
190 } elsif( $archive eq 'GET-SELECTIONS' ) {
191 system("dpkg --get-selections > $filename 2>/dev/null");
192 } elsif( $archive eq 'STATUS' ) {
193 system("cp /var/lib/dpkg/status $filename");
194 } elsif( $archive eq 'AVAILABLE' ) {
195 system("cp /var/lib/dpkg/available $filename");
196 } elsif( $archive eq 'CONFIGURE' ) {
197 open O
, ">$filename";
198 print O
$pressconfigure;
200 } elsif( $archive eq 'REMOVE' ) {
201 open O
, ">$filename";
202 print O
$pressremove;
204 } elsif( $archive eq 'CLEAR-AVAIL' ) {
205 open O
, ">$filename";
206 print O
$pressclearavail;
208 } elsif( $archive eq 'FORGET-OLD-UNAVAIL' ) {
209 open O
, ">$filename";
210 print O
$pressforgetoldunavail;
213 open O
, ">$filename";
214 print O
$archive, "\n";
219 # too noisy but less dangerouse
222 my($archive,$filename) = @_;
223 if( $archive =~ /\.deb$/ ) {
224 system("dpkg -i $filename>/dev/null");
226 die "extfs: cannot create regular file \`$archive\': Permission denied\n";
232 my($archive,$filename) = @_;
233 if( $archive eq 'CONFIGURE' ) {
234 system("dpkg --pending --configure");
235 } elsif( $archive eq 'REMOVE' ) {
236 system("dpkg --pending --remove");
237 } elsif( $archive eq 'CLEAR-AVAIL' ) {
238 system("dpkg --clear-avail");
239 } elsif( $archive eq 'FORGET-OLD-UNAVAIL' ) {
240 system("dpkg --forget-old-unavail");
242 die "extfs: $filename: command not found\n";
246 # Disabled - too dangerous and too noisy
250 if( $archive =~ /\.debd?$/ ) {
254 system("if dpkg -s $name | grep ^Status | grep -qs config-files; \
255 then dpkg --purge $name>/dev/null; \
256 else dpkg --remove $name>/dev/null; fi");
257 die("extfs: $archive: Operation not permitted\n") if $?
!= 0;
259 die "extfs: $archive: Operation not permitted\n";
264 $pressconfigure=<<EOInstall;
267 Don\'t use this method if you are not willing to configure all
268 non configured packages.
270 This is not a real file. It is a way to configure all non configured packages.
272 To configure packages go back to the panel and press Enter on this file.
276 $pressremove=<<EOInstall;
279 Don\'t use this method if you are not willing to remove all
282 This is not a real file. It is a way to remove all unselected packages.
284 To remove packages go back to the panel and press Enter on this file.
288 $pressforgetoldunavail=<<EOInstall;
291 Don\'t use this method if you are not willing to forget about
292 uninstalled unavailable packages.
294 This is not a real file. It is a way to forget about uninstalled
295 unavailable packages.
297 To forget this information go back to the panel and press Enter on this file.
301 $pressclearavail=<<EOInstall;
304 Don\'t use this method if you are not willing to erase the existing
305 information about what packages are available.
307 This is not a real file. It is a way to erase the existing information
308 about what packages are available.
310 To clear this information go back to the panel and press Enter on this file.
316 # override any locale for dates
319 if ($ARGV[0] eq "list") { list
(); exit(0); }
320 elsif ($ARGV[0] eq "copyout") { copyout
($ARGV[2], $ARGV[3]); exit(0); }
321 elsif ($ARGV[0] eq "copyin") { copyin
($ARGV[2], $ARGV[3]); exit(0); }
322 elsif ($ARGV[0] eq "run") { run
($ARGV[2],$ARGV[3]); exit(0); }
323 #elsif ($ARGV[0] eq "rm") { rm($ARGV[2]); exit(0); }