src/vfs/extfs/helpers/apt+.in

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