123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359 |
- #! @PERL@
- #
- # 1999 (c) Piotr Roszatycki <dexter@debian.org>
- # This software is under GNU license
- # last modification: 1999-12-08
- #
- # apt
- 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($check,$stats,$config);
- chop($check = `apt-get -q check 2>/dev/null`);
- chop($available = `apt-cache dumpavail 2>/dev/null`);
- chop($stats = `apt-cache stats 2>/dev/null`);
- chop($config = `apt-config dump 2>&1`);
- $sz = length($check);
- print "-r--r--r-- 1 root root $sz $DATE CHECK\n";
- $sz = length($available);
- print "-r--r--r-- 1 root root $sz $DATE AVAILABLE\n";
- $sz = length($stats);
- print "-r--r--r-- 1 root root $sz $DATE STATS\n";
- $sz = length($config);
- print "-r--r--r-- 1 root root $sz $DATE CONFIG\n";
- $sz = length($pressupdate);
- print "-r-xr--r-- 1 root root $sz $DATE UPDATE\n";
- $sz = length($pressupgrade);
- print "-r-xr--r-- 1 root root $sz $DATE UPGRADE\n";
- print "-r-xr--r-- 1 root root $sz $DATE DIST-UPGRADE\n";
- ls("/etc/apt/sources.list","sources.list");
- ls('/etc/apt/apt.conf','apt.conf') if (-f '/etc/apt/apt.conf');
- print "drwxr-xr-x 1 root root 0 $DATE all\n";
- if ( open(PIPEIN, "find /var/cache/apt/archives -type f |") ) {
- while(<PIPEIN>) {
- chop;
- next if /\/lock$/;
- my $file = $_;
- s%/var/cache/apt/archives/%CACHE/%;
- ls($file, $_);
- }
- close PIPEIN;
- }
-
- my %sects = ();
- my %debd = ();
- my %deba = ();
- open STAT, "/var/lib/dpkg/status"
- or exit 1;
- while( <STAT> ) {
- chop;
- if( /^([\w-]*): (.*)/ ) {
- $pkg = $2 if( lc($1) eq 'package' );
- $debd{$pkg}{lc($1)} = $2;
- }
- }
- close STAT;
- foreach $pkg (sort keys %debd) {
- next if $debd{$pkg}{status} =~ /not-installed/;
- $fn = $debd{$pkg}{package}. "_". $debd{$pkg}{version};
- $dn = $debd{$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 = $debd{$pkg}{'status'} =~ /config-files/ ? 0 : $debd{$pkg}{'installed-size'} * 1024;
- @stat = stat("/var/lib/dpkg/info/".$debd{$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";
- }
- open STAT, "apt-cache dumpavail |"
- or exit 1;
- while( <STAT> ) {
- chop;
- if( /^([\w-]*): (.*)/ ) {
- $pkg = $2 if( lc($1) eq 'package' );
- $deba{$pkg}{lc($1)} = $2;
- }
- }
- close STAT;
- foreach $pkg (sort keys %deba) {
- next if $deba{$pkg}{version} eq $debd{$pkg}{version};
- $fn = $deba{$pkg}{package}. "_". $deba{$pkg}{version};
- $dn = $deba{$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 = $deba{$pkg}{'status'} =~ /config-files/ ? 0 : $deba{$pkg}{'installed-size'} * 1024;
- print "-rw-r--r-- 1 root root $sz $DATE $dn/$fn.deba\n";
- print "lrwxrwxrwx 1 root root $sz $DATE all/$fn.deba -> ../$dn/$fn.deba\n";
- }
- }
- sub copyout
- {
- my($archive,$filename) = @_;
- my $qarchive = quote($archive);
- my $qfilename = quote($filename);
- if( $archive eq 'CHECK' ) {
- system("apt-get -q check > $qfilename");
- } elsif( $archive eq 'AVAILABLE' ) {
- system("apt-cache dumpavail > $qfilename");
- } elsif( $archive eq 'STATS' ) {
- system("apt-cache stats > $qfilename");
- } elsif( $archive eq 'CONFIG' ) {
- system("(apt-config dump 2>&1) > $qfilename");
- } elsif( $archive eq 'UPDATE' ) {
- open O, ">$filename";
- print O $pressupdate;
- close O;
- } elsif( $archive eq 'UPGRADE' || $archive eq 'DIST-UPGRADE' ) {
- open O, ">$filename";
- print O $pressupgrade;
- close O;
- } elsif( $archive eq 'apt.conf' ) {
- system("cp /etc/apt/apt.conf $qfilename");
- } elsif( $archive eq 'sources.list' ) {
- system("cp /etc/apt/sources.list $qfilename");
- } elsif( $archive =~ /^CACHE\// ) {
- $archive =~ s%^CACHE/%/var/cache/apt/archives/%;
- system("cp $qarchive $qfilename");
- } else {
- open O, ">$filename";
- print O $archive, "\n";
- close O;
- }
- }
- sub copyin
- {
- my($archive,$filename) = @_;
- my $qarchive = quote($archive);
- my $qfilename = quote($filename);
- if( $archive =~ /\.deb$/ ) {
- system("dpkg -i $qfilename>/dev/null");
- } elsif( $archive eq 'apt.conf' ) {
- system("cp $qfilename /etc/apt/apt.conf");
- } elsif( $archive eq 'sources.list' ) {
- system("cp $qfilename /etc/apt/sources.list");
- } elsif( $archive =~ /^CACHE\// ) {
- $qarchive =~ s%^CACHE/%/var/cache/apt/archives/%;
- system("cp $qfilename $qarchive");
- } else {
- die "extfs: cannot create regular file \`$archive\': Permission denied\n";
- }
- }
- sub run
- {
- my($archive,$filename) = @_;
- if( $archive eq 'UPDATE' ) {
- system("apt-get update");
- } elsif( $archive eq 'UPGRADE' ) {
- system("apt-get upgrade -u");
- } elsif( $archive eq 'DIST-UPGRADE' ) {
- system("apt-get dist-upgrade -u");
- } else {
- die "extfs: $archive: command not found\n";
- }
- }
- sub rm
- {
- my($archive) = @_;
- my $qarchive = quote($archive);
- if( $archive =~ /^CACHE\// ) {
- $qarchive =~ s%^CACHE/%/var/cache/apt/archives/%;
- system("rm -f $qarchive");
- } elsif( $archive eq 'apt.conf' ) {
- system("rm -f /etc/apt/apt.conf");
- } elsif( $archive eq 'sources.list' ) {
- system("rm -f /etc/apt/sources.list");
- } elsif( $archive =~ /\.debd?$/ ) {
- # uncommented and changed to use dpkg - alpha
- my $qname = $qarchive;
- $qname =~ s%.*/%%g;
- $qname =~ s%_.*%%g;
- system("dpkg --remove $qname >/dev/null");
- die("extfs: $archive: Operation not permitted\n") if $? != 0;
- } else {
- die "extfs: $archive: Operation not permitted\n";
- }
- }
- $pressupdate=<<EOInstall;
- WARNING
- Don\'t use this method if you don't want to retrieve new lists of packages.
- ==========================================================================
- This is not a real file. It is a way to retrieve new lists of packages.
- To update this information go back to the panel and press Enter on this file.
- EOInstall
- $pressupgrade=<<EOInstall;
- WARNING
- Don\'t use this method if you are not willing to perform an upgrade.
- ===================================================================
- This is not a real file. It is a way to perform an upgrade.
- To upgrade 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]); exit(0); }
- elsif ($ARGV[0] eq "rm") { rm($ARGV[2]); exit(0); }
- exit(1);
|