diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-04 17:44:12 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-04 17:44:12 +0000 |
commit | 8ccb487c21368a7fdc8c7c72315325bf0aa06147 (patch) | |
tree | b2056fae01d325924508a41731edfbd4c3cddd23 /src/vfs/extfs/helpers/dpkg+.in | |
parent | Initial commit. (diff) | |
download | mc-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+.in | 337 |
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); + |