summaryrefslogtreecommitdiffstats
path: root/src/vfs/extfs/helpers/dpkg+.in
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-04 17:44:12 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-04 17:44:12 +0000
commit8ccb487c21368a7fdc8c7c72315325bf0aa06147 (patch)
treeb2056fae01d325924508a41731edfbd4c3cddd23 /src/vfs/extfs/helpers/dpkg+.in
parentInitial commit. (diff)
downloadmc-upstream.tar.xz
mc-upstream.zip
Adding upstream version 3:4.8.29.upstream/3%4.8.29upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'src/vfs/extfs/helpers/dpkg+.in')
-rw-r--r--src/vfs/extfs/helpers/dpkg+.in337
1 files changed, 337 insertions, 0 deletions
diff --git a/src/vfs/extfs/helpers/dpkg+.in b/src/vfs/extfs/helpers/dpkg+.in
new file mode 100644
index 0000000..048862e
--- /dev/null
+++ b/src/vfs/extfs/helpers/dpkg+.in
@@ -0,0 +1,337 @@
+#! @PERL@
+#
+# 1999 (c) Piotr Roszatycki <dexter@debian.org>
+# This software is under GNU license
+# last modification: 1999-12-08
+#
+# dpkg
+
+sub quote {
+ $_ = shift(@_);
+ s/([^\w\/.+-])/\\$1/g;
+ return($_);
+}
+
+sub bt
+{
+ my ($dt) = @_;
+ my (@time);
+ @time = localtime($dt);
+ $bt = sprintf "%02d-%02d-%d %02d:%02d", $time[4] + 1, $time[3],
+ $time[5] + 1900, $time[2], $time[1];
+ return $bt;
+}
+
+
+sub ft
+{
+ my ($f) = @_;
+ return "d" if -d $f;
+ return "l" if -l $f;
+ return "p" if -p $f;
+ return "S" if -S $f;
+ return "b" if -b $f;
+ return "c" if -c $f;
+ return "-";
+}
+
+sub fm
+{
+ my ($n) = @_;
+ my ($m);
+
+ if( $n & 0400 ) {
+ $m .= "r";
+ } else {
+ $m .= "-";
+ }
+ if( $n & 0200 ) {
+ $m .= "w";
+ } else {
+ $m .= "-";
+ }
+ if( $n & 04000 ) {
+ $m .= "s";
+ } elsif( $n & 0100 ) {
+ $m .= "x";
+ } else {
+ $m .= "-";
+ }
+
+ if( $n & 0040 ) {
+ $m .= "r";
+ } else {
+ $m .= "-";
+ }
+ if( $n & 0020 ) {
+ $m .= "w";
+ } else {
+ $m .= "-";
+ }
+ if( $n & 02000 ) {
+ $m .= "s";
+ } elsif( $n & 0010 ) {
+ $m .= "x";
+ } else {
+ $m .= "-";
+ }
+
+ if( $n & 0004 ) {
+ $m .= "r";
+ } else {
+ $m .= "-";
+ }
+ if( $n & 0002 ) {
+ $m .= "w";
+ } else {
+ $m .= "-";
+ }
+ if( $n & 01000 ) {
+ $m .= "t";
+ } elsif( $n & 0001 ) {
+ $m .= "x";
+ } else {
+ $m .= "-";
+ }
+
+ return $m;
+}
+
+sub ls {
+ my ($file,$path,$mode) = @_;
+
+ if (-f $file) {
+ my @stat = stat(_);
+ # mode, nlink, uid, gid, size, mtime, filename
+ printf "%s %d %d %d %d %s %s\n", $mode || ft($file).fm($stat[2] & 07777),
+ $stat[3], $stat[4], $stat[5], $stat[7], bt($stat[9]), $path;
+ }
+}
+
+$DATE=bt(time());
+
+sub list
+{
+ my ($pkg, $fn, $dn, $sz, $bt);
+ my %debs = ();
+ my %sects = ();
+
+ my($diversions,$architecture);
+ chop($diversions = `dpkg-divert --list 2>/dev/null`);
+ chop($architecture = `dpkg-architecture 2>/dev/null`);
+ chop($list = `dpkg -l '*' 2>/dev/null`);
+ chop($getselections = `dpkg --get-selections 2>/dev/null`);
+ chop($audit = `dpkg --audit 2>/dev/null`);
+ $sz = length($diversions);
+ print "-r--r--r-- 1 root root $sz $DATE DIVERSIONS\n";
+ $sz = length($architecture);
+ print "-r--r--r-- 1 root root $sz $DATE ARCHITECTURE\n";
+ $sz = length($list);
+ print "-r--r--r-- 1 root root $sz $DATE LIST\n";
+ $sz = length($getselections);
+ print "-r--r--r-- 1 root root $sz $DATE GET-SELECTIONS\n";
+ $sz = length($audit);
+ print "-r--r--r-- 1 root root $sz $DATE AUDIT\n";
+ $sz = length($pressconfigure);
+ print "-r-xr--r-- 1 root root $sz $DATE CONFIGURE\n";
+ $sz = length($pressremove);
+ print "-r-xr--r-- 1 root root $sz $DATE REMOVE\n";
+ $sz = length($pressclearavail);
+ print "-r-xr--r-- 1 root root $sz $DATE CLEAR-AVAIL\n";
+ $sz = length($pressforgetoldunavail);
+ print "-r-xr--r-- 1 root root $sz $DATE FORGET-OLD-UNAVAIL\n";
+ ls("/var/lib/dpkg/status","STATUS","-r--r--r--");
+ # ls("/var/lib/dpkg/available","AVAILABLE","-r--r--r--");
+
+ print "drwxr-xr-x 1 root root 0 $DATE all\n";
+
+ open STAT, "/var/lib/dpkg/status"
+ or exit 1;
+ while( <STAT> ) {
+ chop;
+ if( /^([\w-]*): (.*)/ ) {
+ $pkg = $2 if( lc($1) eq 'package' );
+ $debs{$pkg}{lc($1)} = $2;
+ }
+ }
+ close STAT;
+
+ foreach $pkg (sort keys %debs) {
+ next if $debs{$pkg}{status} =~ /not-installed/;
+ $fn = $debs{$pkg}{package}. "_". $debs{$pkg}{version};
+ $dn = $debs{$pkg}{section};
+ if( ! $dn ) {
+ $dn = "unknown";
+ } elsif( $dn =~ /^(non-us)$/i ) {
+ $dn .= "/main";
+ } elsif( $dn !~ /\// ) {
+ $dn = "main/". $dn;
+ }
+ unless( $sects{$dn} ) {
+ my $sub = $dn;
+ while( $sub =~ s!^(.*)/[^/]*$!$1! ) {
+ unless( $sects{$sub} ) {
+ print "drwxr-xr-x 1 root root 0 $DATE $sub/\n";
+ $sects{$sub} = 1;
+ }
+ }
+ print "drwxr-xr-x 1 root root 0 $DATE $dn/\n";
+ $sects{$dn} = 1;
+ }
+ $sz = $debs{$pkg}{'status'} =~ /config-files/ ? 0 : $debs{$pkg}{'installed-size'} * 1024;
+ @stat = stat("/var/lib/dpkg/info/".$debs{$pkg}{package}.".list");
+ $bt = bt($stat[9]);
+ print "-rw-r--r-- 1 root root $sz $bt $dn/$fn.debd\n";
+ print "lrwxrwxrwx 1 root root $sz $bt all/$fn.debd -> ../$dn/$fn.debd\n";
+ }
+}
+
+sub copyout
+{
+ my($archive,$filename) = @_;
+ my $qfilename = quote($filename);
+ if( $archive eq 'DIVERSIONS' ) {
+ system("dpkg-divert --list > $qfilename 2>/dev/null");
+ } elsif( $archive eq 'ARCHITECTURE' ) {
+ system("dpkg-architecture > $qfilename 2>/dev/null");
+ } elsif( $archive eq 'LIST' ) {
+ system("dpkg -l '*' > $qfilename 2>/dev/null");
+ } elsif( $archive eq 'AUDIT' ) {
+ system("dpkg --audit > $qfilename 2>/dev/null");
+ } elsif( $archive eq 'GET-SELECTIONS' ) {
+ system("dpkg --get-selections > $qfilename 2>/dev/null");
+ } elsif( $archive eq 'STATUS' ) {
+ system("cp /var/lib/dpkg/status $qfilename");
+ } elsif( $archive eq 'AVAILABLE' ) {
+ system("cp /var/lib/dpkg/available $qfilename");
+ } elsif( $archive eq 'CONFIGURE' ) {
+ open O, ">$filename";
+ print O $pressconfigure;
+ close O;
+ } elsif( $archive eq 'REMOVE' ) {
+ open O, ">$filename";
+ print O $pressremove;
+ close O;
+ } elsif( $archive eq 'CLEAR-AVAIL' ) {
+ open O, ">$filename";
+ print O $pressclearavail;
+ close O;
+ } elsif( $archive eq 'FORGET-OLD-UNAVAIL' ) {
+ open O, ">$filename";
+ print O $pressforgetoldunavail;
+ close O;
+ } else {
+ open O, ">$filename";
+ print O $archive, "\n";
+ close O;
+ }
+}
+
+# too noisy but less dangerouse
+sub copyin
+{
+ my($archive,$filename) = @_;
+ my $qfilename = quote($filename);
+ if( $archive =~ /\.deb$/ ) {
+ system("dpkg -i $qfilename>/dev/null");
+ } else {
+ die "extfs: cannot create regular file \`$archive\': Permission denied\n";
+ }
+}
+
+sub run
+{
+ my($archive,$filename) = @_;
+ if( $archive eq 'CONFIGURE' ) {
+ system("dpkg --pending --configure");
+ } elsif( $archive eq 'REMOVE' ) {
+ system("dpkg --pending --remove");
+ } elsif( $archive eq 'CLEAR-AVAIL' ) {
+ system("dpkg --clear-avail");
+ } elsif( $archive eq 'FORGET-OLD-UNAVAIL' ) {
+ system("dpkg --forget-old-unavail");
+ } else {
+ die "extfs: $filename: command not found\n";
+ }
+}
+
+# Disabled - too dangerous and too noisy
+sub rm_disabled
+{
+ my($archive) = @_;
+ if( $archive =~ /\.debd?$/ ) {
+ my $qname = quote($archive);
+ $qname =~ s%.*/%%g;
+ $qname =~ s%_.*%%g;
+ system("if dpkg -s $qname | grep ^Status | grep -qs config-files; \
+ then dpkg --purge $qname>/dev/null; \
+ else dpkg --remove $qname>/dev/null; fi");
+ die("extfs: $archive: Operation not permitted\n") if $? != 0;
+ } else {
+ die "extfs: $archive: Operation not permitted\n";
+ }
+}
+
+
+$pressconfigure=<<EOInstall;
+
+ WARNING
+ Don\'t use this method if you are not willing to configure all
+ non configured packages.
+
+This is not a real file. It is a way to configure all non configured packages.
+
+To configure packages go back to the panel and press Enter on this file.
+
+EOInstall
+
+$pressremove=<<EOInstall;
+
+ WARNING
+ Don\'t use this method if you are not willing to remove all
+ unselected packages.
+
+This is not a real file. It is a way to remove all unselected packages.
+
+To remove packages go back to the panel and press Enter on this file.
+
+EOInstall
+
+$pressforgetoldunavail=<<EOInstall;
+
+ WARNING
+ Don\'t use this method if you are not willing to forget about
+ uninstalled unavailable packages.
+
+This is not a real file. It is a way to forget about uninstalled
+unavailable packages.
+
+To forget this information go back to the panel and press Enter on this file.
+
+EOInstall
+
+$pressclearavail=<<EOInstall;
+
+ WARNING
+ Don\'t use this method if you are not willing to erase the existing
+ information about what packages are available.
+
+This is not a real file. It is a way to erase the existing information
+about what packages are available.
+
+To clear this information go back to the panel and press Enter on this file.
+
+EOInstall
+
+
+
+# override any locale for dates
+$ENV{"LC_ALL"}="C";
+
+if ($ARGV[0] eq "list") { list(); exit(0); }
+elsif ($ARGV[0] eq "copyout") { copyout($ARGV[2], $ARGV[3]); exit(0); }
+elsif ($ARGV[0] eq "copyin") { copyin($ARGV[2], $ARGV[3]); exit(0); }
+elsif ($ARGV[0] eq "run") { run($ARGV[2],$ARGV[3]); exit(0); }
+#elsif ($ARGV[0] eq "rm") { rm($ARGV[2]); exit(0); }
+exit(1);
+