vfs/extfs/apt

   1 #! /usr/bin/perl
   2 #
   3 # 1999 (c) Piotr Roszatycki <dexter@debian.org>
   4 # This software is under GNU license
   5 # last modification: 1999-12-08
   6 #
   7 # apt
   8
   9 sub bt
  10 {
  11     my ($dt) = @_;
  12     my (@time);
  13     @time = localtime($dt);
  14     $bt = sprintf "%02d-%02d-%02d %02d:%02d", $time[4], $time[3], $time[5], $time[2], $time[1];
  15     return $bt;
  16 }
  17
  18
  19 sub ft
  20 {
  21     my ($f) = @_;
  22     return "d" if -d $f;
  23     return "l" if -l $f;
  24     return "p" if -p $f;
  25     return "S" if -S $f;
  26     return "b" if -b $f;
  27     return "c" if -c $f;
  28     return "-";
  29 }
  30
  31 sub fm
  32 {
  33     my ($n) = @_;
  34     my ($m);
  35
  36     if( $n & 0400 ) {
  37        $m .= "r";
  38     } else {
  39        $m .= "-";
  40     }
  41     if( $n & 0200 ) {
  42        $m .= "w";
  43     } else {
  44        $m .= "-";
  45     }
  46     if( $n & 04000 ) {
  47        $m .= "s";
  48     } elsif( $n & 0100 ) {
  49        $m .= "x";
  50     } else {
  51        $m .= "-";
  52     }
  53
  54     if( $n & 0040 ) {
  55        $m .= "r";
  56     } else {
  57        $m .= "-";
  58     }
  59     if( $n & 0020 ) {
  60        $m .= "w";
  61     } else {
  62        $m .= "-";
  63     }
  64     if( $n & 02000 ) {
  65        $m .= "s";
  66     } elsif( $n & 0010 ) {
  67        $m .= "x";
  68     } else {
  69        $m .= "-";
  70     }
  71
  72     if( $n & 0004 ) {
  73        $m .= "r";
  74     } else {
  75        $m .= "-";
  76     }
  77     if( $n & 0002 ) {
  78        $m .= "w";
  79     } else {
  80        $m .= "-";
  81     }
  82     if( $n & 01000 ) {
  83        $m .= "t";
  84     } elsif( $n & 0001 ) {
  85        $m .= "x";
  86     } else {
  87        $m .= "-";
  88     }
  89
  90     return $m;
  91 }
  92
  93 sub ls {
  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;
  99 }
 100
 101 $DATE=bt(time());
 102
 103 sub list
 104 {
 105     my ($pkg, $fn, $dn, $sz, $bt);
 106
 107     my($check,$stats,$config);
 108     chop($check = `apt-get -q check 2>/dev/null`);
 109     chop($available = `apt-cache dumpavail 2>/dev/null`);
 110     chop($stats = `apt-cache stats 2>/dev/null`);
 111     chop($config = `apt-config dump 2>&1`);
 112     $sz = length($check);
 113     print "-r--r--r-- 1 root root $sz $DATE CHECK\n";
 114     $sz = length($available);
 115     print "-r--r--r-- 1 root root $sz $DATE AVAILABLE\n";
 116     $sz = length($stats);
 117     print "-r--r--r-- 1 root root $sz $DATE STATS\n";
 118     $sz = length($config);
 119     print "-r--r--r-- 1 root root $sz $DATE CONFIG\n";
 120     $sz = length($pressupdate);
 121     print "-r-xr--r-- 1 root root $sz $DATE UPDATE\n";
 122     $sz = length($pressupgrade);
 123     print "-r-xr--r-- 1 root root $sz $DATE UPGRADE\n";
 124     print "-r-xr--r-- 1 root root $sz $DATE DIST-UPGRADE\n";
 125
 126     ls("/etc/apt/sources.list","sources.list");
 127     ls("/etc/apt/apt.conf","apt.conf");
 128
 129     print "drwxr-xr-x 1 root root 0 $DATE all\n";
 130
 131    if ( open(PIPEIN, "find /var/cache/apt/archives -type f |") ) {
 132        while(<PIPEIN>) {
 133            chop;
 134            next if /\/lock$/;
 135            my $file = $_;
 136            s%/var/cache/apt/archives/%CACHE/%;
 137            ls($file, $_);
 138        }
 139        close PIPEIN;
 140     }
 141
 142     my %sects = ();
 143     my %debd = ();
 144     my %deba = ();
 145
 146     open STAT, "/var/lib/dpkg/status"
 147        or exit 1;
 148     while( <STAT> ) {
 149        chop;
 150        if( /^([\w-]*): (.*)/ ) {
 151            $pkg = $2 if( lc($1) eq 'package' );
 152            $debd{$pkg}{lc($1)} = $2;
 153        }
 154     }
 155     close STAT;
 156
 157     foreach $pkg (sort keys %debd) {
 158        next if $debd{$pkg}{status} =~ /not-installed/;
 159        $fn = $debd{$pkg}{package}. "_". $debd{$pkg}{version};
 160        $dn = $debd{$pkg}{section};
 161        if( ! $dn ) {
 162            $dn = "unknown";
 163        } elsif( $dn =~ /^(non-us)$/i ) {
 164            $dn .= "/main";
 165        } elsif( $dn !~ /\// ) {
 166            $dn = "main/". $dn;
 167        }
 168        unless( $sects{$dn} ) {
 169            my $sub = $dn;
 170            while( $sub =~ s!^(.*)/[^/]*$!$1! ) {
 171                unless( $sects{$sub} ) {
 172                    print "drwxr-xr-x 1 root root 0 $DATE $sub/\n";
 173                    $sects{$sub} = 1;
 174                }
 175            }
 176            print "drwxr-xr-x 1 root root 0 $DATE $dn/\n";
 177            $sects{$dn} = 1;
 178        }
 179        $sz = $debd{$pkg}{'status'} =~ /config-files/ ? 0 : $debd{$pkg}{'installed-size'} * 1024;
 180        @stat = stat("/var/lib/dpkg/info/".$debd{$pkg}{package}.".list");
 181        $bt = bt($stat[9]);
 182        print "-rw-r--r-- 1 root root $sz $bt $dn/$fn.debd\n";
 183        print "lrwxrwxrwx 1 root root $sz $bt all/$fn.debd -> ../$dn/$fn.debd\n";
 184     }
 185
 186     open STAT, "apt-cache dumpavail |"
 187        or exit 1;
 188     while( <STAT> ) {
 189        chop;
 190        if( /^([\w-]*): (.*)/ ) {
 191            $pkg = $2 if( lc($1) eq 'package' );
 192            $deba{$pkg}{lc($1)} = $2;
 193        }
 194     }
 195     close STAT;
 196
 197     foreach $pkg (sort keys %deba) {
 198        next if $deba{$pkg}{version} eq $debd{$pkg}{version};
 199        $fn = $deba{$pkg}{package}. "_". $deba{$pkg}{version};
 200        $dn = $deba{$pkg}{section};
 201        if( ! $dn ) {
 202            $dn = "unknown";
 203        } elsif( $dn =~ /^(non-us)$/i ) {
 204            $dn .= "/main";
 205        } elsif( $dn !~ /\// ) {
 206            $dn = "main/". $dn;
 207        }
 208        unless( $sects{$dn} ) {
 209            my $sub = $dn;
 210            while( $sub =~ s!^(.*)/[^/]*$!$1! ) {
 211                unless( $sects{$sub} ) {
 212                    print "drwxr-xr-x 1 root root 0 $DATE $sub/\n";
 213                    $sects{$sub} = 1;
 214                }
 215            }
 216            print "drwxr-xr-x 1 root root 0 $DATE $dn/\n";
 217            $sects{$dn} = 1;
 218        }
 219        $sz = $deba{$pkg}{'status'} =~ /config-files/ ? 0 : $deba{$pkg}{'installed-size'} * 1024;
 220        print "-rw-r--r-- 1 root root $sz $DATE $dn/$fn.deba\n";
 221        print "lrwxrwxrwx 1 root root $sz $DATE all/$fn.deba -> ../$dn/$fn.deba\n";
 222     }
 223 }
 224
 225 sub copyout
 226 {
 227     my($archive,$filename) = @_;
 228     if( $archive eq 'CHECK' ) {
 229        system("apt-get -q check > $filename");
 230     } elsif( $archive eq 'AVAILABLE' ) {
 231        system("apt-cache dumpavail > $filename");
 232     } elsif( $archive eq 'STATS' ) {
 233        system("apt-cache stats > $filename");
 234     } elsif( $archive eq 'CONFIG' ) {
 235        system("(apt-config dump 2>&1) > $filename");
 236     } elsif( $archive eq 'UPDATE' ) {
 237        open O, ">$filename";
 238        print O $pressupdate;
 239        close O;
 240     } elsif( $archive eq 'UPGRADE' || $archive eq 'DIST-UPGRADE' ) {
 241        open O, ">$filename";
 242        print O $pressupgrade;
 243        close O;
 244     } elsif( $archive eq 'apt.conf' ) {
 245        system("cp /etc/apt/apt.conf $filename");
 246     } elsif( $archive eq 'sources.list' ) {
 247        system("cp /etc/apt/sources.list $filename");
 248     } elsif( $archive =~ /^CACHE\// ) {
 249        $archive =~ s%^CACHE/%/var/cache/apt/archives/%;
 250        system("cp $archive $filename");
 251     } else {
 252        open O, ">$filename";
 253        print O $archive, "\n";
 254        close O;
 255     }
 256 }
 257
 258 sub copyin
 259 {
 260     my($archive,$filename) = @_;
 261     if( $archive =~ /\.deb$/ ) {
 262        system("dpkg -i $filename>/dev/null");
 263     } elsif( $archive eq 'apt.conf' ) {
 264        system("cp $filename /etc/apt/apt.conf");
 265     } elsif( $archive eq 'sources.list' ) {
 266        system("cp $filename /etc/apt/sources.list");
 267     } elsif( $archive =~ /^CACHE\// ) {
 268        $archive =~ s%^CACHE/%/var/cache/apt/archives/%;
 269        system("cp $filename $archive");
 270     } else {
 271        die "extfs: cannot create regular file \`$archive\': Permission denied\n";
 272     }
 273 }
 274
 275 sub run
 276 {
 277     my($archive,$filename) = @_;
 278     if( $archive eq 'UPDATE' ) {
 279        system("apt-get update");
 280     } elsif( $archive eq 'UPGRADE' ) {
 281        system("apt-get upgrade -u");
 282     } elsif( $archive eq 'DIST-UPGRADE' ) {
 283        system("apt-get dist-upgrade -u");
 284     } else {
 285        die "extfs: $archive: command not found\n";
 286     }
 287 }
 288
 289 sub rm
 290 {
 291     my($archive) = @_;
 292     if( $archive =~ /^CACHE\// ) {
 293        $archive =~ s%^CACHE/%/var/cache/apt/archives/%;
 294        system("rm -f $archive");
 295     } elsif( $archive eq 'apt.conf' ) {
 296        system("rm -f /etc/apt/apt.conf");
 297     } elsif( $archive eq 'sources.list' ) {
 298        system("rm -f /etc/apt/sources.list");
 299 # This interact with user - it can't be execute :-(
 300 #    } elsif( $archive =~ /\.deb[ad]?$/ ) {
 301 #       my $name = $archive;
 302 #       $name =~ s%.*/%%g;
 303 #       $name =~ s%_.*%%g;
 304 #       system("apt-get remove $name");
 305 #       die("extfs: $archive: Operation not permitted\n") if $? != 0;
 306     } else {
 307        die "extfs: $archive: Operation not permitted\n";
 308     }
 309 }
 310
 311
 312 $pressupdate=<<EOInstall;
 313
 314                               WARNING
 315      Don\'t use this method if you are not willing to retrieve new lists
 316                            of packages.
 317
 318 This is not a real file. It is a way to retrieve new lists of packages.
 319
 320 To update this information go back to the panel and press Enter on this file.
 321
 322 EOInstall
 323
 324 $pressupgrade=<<EOInstall;
 325
 326                               WARNING
 327     Don\'t use this method if you are not willing to perform an upgrade.
 328
 329 This is not a real file. It is a way to perform an upgrade.
 330
 331 To upgrade this information go back to the panel and press Enter on this file.
 332
 333 EOInstall
 334
 335
 336 # override any locale for dates
 337 $ENV{"LC_ALL"}="C";
 338
 339 if ($ARGV[0] eq "list") { list(); exit(0); }
 340 elsif ($ARGV[0] eq "copyout") { copyout($ARGV[2], $ARGV[3]); exit(0); }
 341 elsif ($ARGV[0] eq "copyin") { copyin($ARGV[2], $ARGV[3]); exit(0); }
 342 elsif ($ARGV[0] eq "run") { run($ARGV[2]); exit(0); }
 343 elsif ($ARGV[0] eq "rm") { rm($ARGV[2]); exit(0); }
 344 exit(1);
 345