#! /usr/bin/perl
#
# 1999 (c) Piotr Roszatycki <dexter@debian.org>
# This software is under GNU license
# last modification: 1999-12-08
#
# apt

sub bt
{
    my ($dt) = @_;
    my (@time);
    @time = localtime($dt);
    $bt = sprintf "%02d-%02d-%02d %02d:%02d", $time[4], $time[3], $time[5], $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) = @_;
    my @stat = stat($file);
    # 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");

    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) = @_;
    if( $archive eq 'CHECK' ) {
       system("apt-get -q check > $filename");
    } elsif( $archive eq 'AVAILABLE' ) {
       system("apt-cache dumpavail > $filename");
    } elsif( $archive eq 'STATS' ) {
       system("apt-cache stats > $filename");
    } elsif( $archive eq 'CONFIG' ) {
       system("(apt-config dump 2>&1) > $filename");
    } 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 $filename");
    } elsif( $archive eq 'sources.list' ) {
       system("cp /etc/apt/sources.list $filename");
    } elsif( $archive =~ /^CACHE\// ) {
       $archive =~ s%^CACHE/%/var/cache/apt/archives/%;
       system("cp $archive $filename");
    } else {
       open O, ">$filename";
       print O $archive, "\n";
       close O;
    }
}

sub copyin
{
    my($archive,$filename) = @_;
    if( $archive =~ /\.deb$/ ) {
       system("dpkg -i $filename>/dev/null");
    } elsif( $archive eq 'apt.conf' ) {
       system("cp $filename /etc/apt/apt.conf");
    } elsif( $archive eq 'sources.list' ) {
       system("cp $filename /etc/apt/sources.list");
    } elsif( $archive =~ /^CACHE\// ) {
       $archive =~ s%^CACHE/%/var/cache/apt/archives/%;
       system("cp $filename $archive");
    } 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) = @_;
    if( $archive =~ /^CACHE\// ) {
       $archive =~ s%^CACHE/%/var/cache/apt/archives/%;
       system("rm -f $archive");
    } elsif( $archive eq 'apt.conf' ) {
       system("rm -f /etc/apt/apt.conf");
    } elsif( $archive eq 'sources.list' ) {
       system("rm -f /etc/apt/sources.list");
# This interact with user - it can't be execute :-(
#    } elsif( $archive =~ /\.deb[ad]?$/ ) {
#       my $name = $archive;
#       $name =~ s%.*/%%g;
#       $name =~ s%_.*%%g;
#       system("apt-get remove $name");
#       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 are not willing 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);