vfs/extfs/debd.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 # debd
   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) = @_;
 102     my @stat = stat($file);
 103     # mode, nlink, uid, gid, size, mtime, filename
 104     printf "%s%s %d %d %d %d %s CONTENTS%s\n", ft($file), fm($stat[2] & 07777),
 105     $stat[3], $stat[4], $stat[5], $stat[7], bt($stat[9]), $file;
 106 }
 107
 108 sub list
 109 {
 110        my($archive)=@_;
 111        my $qarchive = quote($archive);
 112        chop($date=`LC_ALL=C date "+%b %d %Y %H:%M"`);
 113        chop($info_size=`dpkg -s $qarchive | wc -c`);
 114        $repack_size=length($pressrepack);
 115        $reinstall_size=length($pressreinstall);
 116        $remove_size=length($pressremove);
 117        $purge_size=length($presspurge);
 118        $reconfigure_size=length($pressreconfigure);
 119        $reinstall_size=length($pressreinstall);
 120        $select_size=length($pressselect);
 121        $unselect_size=length($pressunselect);
 122
 123        print "dr-xr-xr-x   1 root     root     0 $date CONTENTS\n";
 124        print "dr-xr-xr-x   1 root     root     0 $date DEBIAN\n";
 125        print "-r--r--r--   1 root     root     $info_size $date INFO\n";
 126        print "-r-xr--r--   1 root     root     $purge_size $date DPKG-PURGE\n";
 127
 128        chop($status = `dpkg -s $qarchive | grep ^Status`);
 129        if( $status =~ /deinstall/ ) {
 130            print "-r-xr--r--   1 root     root     $select_size $date DPKG-SELECT\n";
 131        } elsif( $status =~ /install/ ) {
 132            print "-r-xr--r--   1 root     root     $unselect_size $date DPKG-UNSELECT\n";
 133        }
 134        if( $status !~ /config-files/ ) {
 135            if ( -x "/usr/bin/dpkg-repack" ) {
 136                print "-r-xr--r--   1 root     root     $repack_size $date DPKG-REPACK\n";
 137            }
 138            print "-r-xr--r--   1 root     root     $remove_size $date DPKG-REMOVE\n";
 139            if ( -x "/usr/bin/apt-get" ) {
 140                print "-r-xr--r--   1 root     root     $remove_size $date APT-REMOVE\n";
 141                print "-r-xr--r--   1 root     root     $reinstall_size $date APT-REINSTALL\n";
 142                print "-r-xr--r--   1 root     root     $purge_size $date APT-PURGE\n";
 143            }
 144        }
 145        if( -x "/usr/bin/dpkg-reconfigure" && -x "/var/lib/dpkg/info/$archive.config" ) {
 146            print "-r-xr--r--   1 root     root     $reconfigure_size $date DPKG-RECONFIGURE\n";
 147        }
 148
 149
 150
 151        if ( open(PIPEIN, "LANG=C ls -l /var/lib/dpkg/info/$qarchive.* |") ) {
 152            while(<PIPEIN>) {
 153                chop;
 154                next if /\.list$/;
 155                s%/var/lib/dpkg/info/$archive.%DEBIAN/%;
 156                print $_, "\n";
 157            }
 158            close PIPEIN;
 159        }
 160
 161         if ( open(LIST, "/var/lib/dpkg/info/$archive.list") ) {
 162             while(<LIST>) {
 163                chop;
 164                ls($_);
 165             }
 166            close LIST;
 167         }
 168 }
 169
 170 sub copyout
 171 {
 172        my($archive,$filename,$destfile)=@_;
 173        my $qarchive = quote($archive);
 174        my $qfilename = quote($filename);
 175        my $qdestfile = quote($destfile);
 176
 177        if($filename eq "INFO") {
 178            system("dpkg -s $qarchive > $qdestfile");
 179         } elsif($filename eq "DPKG-REPACK") {
 180            if ( open(FILEOUT,">$destfile") ) {
 181                print FILEOUT $pressrepack;
 182                close FILEOUT;
 183                system("chmod a+x $qdestfile");
 184            }
 185         } elsif($filename =~ /^DEBIAN/) {
 186             $filename=~s!^DEBIAN/!!;
 187             system("cat /var/lib/dpkg/info/$qarchive.$qfilename > $qdestfile");
 188        } elsif($filename eq "DPKG-REMOVE" || $filename eq "APT-REMOVE") {
 189            if ( open(FILEOUT,">$destfile") ) {
 190                print FILEOUT $pressremove;
 191                close FILEOUT;
 192                system("chmod a+x $qdestfile");
 193            }
 194        } elsif($filename eq "DPKG-PURGE" || $filename eq "APT-PURGE") {
 195            if ( open(FILEOUT,">$destfile") ) {
 196                print FILEOUT $presspurge;
 197                close FILEOUT;
 198                system("chmod a+x $qdestfile");
 199            }
 200        } elsif($filename eq "DPKG-RECONFIGURE") {
 201            if ( open(FILEOUT,">$destfile") ) {
 202                print FILEOUT $pressreconfigure;
 203                close FILEOUT;
 204                system("chmod a+x $qdestfile");
 205            }
 206        } elsif($filename eq "APT-REINSTALL") {
 207            if ( open(FILEOUT,">$destfile") ) {
 208                print FILEOUT $pressreinstall;
 209                close FILEOUT;
 210                system("chmod a+x $destfile");
 211            }
 212        } elsif($filename eq "DPKG-SELECT") {
 213            if ( open(FILEOUT,">$destfile") ) {
 214                print FILEOUT $pressselect;
 215                close FILEOUT;
 216                system("chmod a+x $destfile");
 217            }
 218        } elsif($filename eq "DPKG-UNSELECT") {
 219            if ( open(FILEOUT,">$destfile") ) {
 220                print FILEOUT $pressunselect;
 221                close FILEOUT;
 222                system("chmod a+x $qdestfile");
 223            }
 224        } else {
 225            $qfilename=~s!^CONTENTS!!;
 226            system("cat $qfilename > $qdestfile");
 227        }
 228 }
 229
 230 sub run
 231 {
 232        my($archive,$filename)=@_;
 233        my $qarchive = quote($archive);
 234        my $qfilename = quote($filename);
 235        if($filename eq "DPKG-REMOVE") {
 236            system("dpkg --remove $qarchive");
 237        } elsif($filename eq "APT-REMOVE") {
 238            system("apt-get remove $qarchive");
 239        } elsif($filename eq "DPKG-PURGE") {
 240            system("dpkg --purge $qarchive");
 241        } elsif($filename eq "APT-PURGE") {
 242            system("apt-get --purge remove $qarchive");
 243        } elsif($filename eq "DPKG-REPACK") {
 244            system("dpkg-repack $qarchive");
 245        } elsif($filename eq "DPKG-SELECT") {
 246            system("echo $aqrchive install | dpkg --set-selections");
 247        } elsif($filename eq "DPKG-UNSELECT") {
 248            system("echo $qarchive deinstall | dpkg --set-selections");
 249        } elsif($filename eq "APT-REINSTALL") {
 250            system("apt-get -u --reinstall install $qarchive");
 251        } elsif($filename eq "DPKG-RECONFIGURE") {
 252            system("dpkg-reconfigure $qarchive");
 253        } elsif($filename=~/^DEBIAN/) {
 254            $filename=~s!^DEBIAN!!;
 255            system("/var/lib/dpkg/info/$qarchive.$qfilename");
 256        } else {
 257            $qfilename=~s!^CONTENTS!!;
 258            system($qfilename);
 259        }
 260 }
 261
 262 $pressrepack=<<EOInstall;
 263
 264                                 WARNING
 265   Don\'t use this method if you are not willing to repack this package...
 266
 267 This is not a real file. It is a way to repack the package you are browsing.
 268
 269 To repack this package go back to the panel and press Enter on this file.
 270
 271 EOInstall
 272
 273 $pressreinstall=<<EOInstall;
 274
 275                                 WARNING
 276   Don\'t use this method if you are not willing to reinstall this package...
 277
 278 This is not a real file. It is a way to reinstall the package you are browsing.
 279
 280 To reinstall this package go back to the panel and press Enter on this file.
 281
 282 EOInstall
 283
 284 $pressremove=<<EOInstall;
 285
 286                                 WARNING
 287   Don\'t use this method if you are not willing to remove this package...
 288
 289 This is not a real file. It is a way to remove the package you are browsing.
 290
 291 To remove this package go back to the panel and press Enter on this file.
 292
 293 EOInstall
 294
 295 $presspurge=<<EOInstall;
 296
 297                                 WARNING
 298   Don\'t use this method if you are not willing to purge this package...
 299
 300 This is not a real file. It is a way to purge the package you are browsing.
 301
 302 To purge this package go back to the panel and press Enter on this file.
 303
 304 EOInstall
 305
 306 $pressreconfigure=<<EOInstall;
 307
 308                                 WARNING
 309   Don\'t use this method if you are not willing to reconfigure this package...
 310
 311 This is not a real file. It is a way to reconfigure the package you are browsing.
 312
 313 To reconfigure this package go back to the panel and press Enter on this file.
 314
 315 EOInstall
 316
 317 $pressreinstall=<<EOInstall;
 318
 319                                 WARNING
 320   Don\'t use this method if you are not willing to reinstall this package...
 321
 322 This is not a real file. It is a way to reinstall the package you are browsing.
 323
 324 To reinstall this package go back to the panel and press Enter on this file.
 325
 326 EOInstall
 327
 328 $pressselect=<<EOInstall;
 329
 330                                 WARNING
 331   Don\'t use this method if you are not willing to select this package...
 332
 333 This is not a real file. It is a way to select the package you are browsing.
 334
 335 To select this package go back to the panel and press Enter on this file.
 336
 337 EOInstall
 338
 339 $pressunselect=<<EOInstall;
 340
 341                                 WARNING
 342   Don\'t use this method if you are not willing to unselect this package...
 343
 344 This is not a real file. It is a way to unselect the package you are browsing.
 345
 346 To unselect this package go back to the panel and press Enter on this file.
 347
 348 EOInstall
 349
 350 umask 077;
 351
 352 chop($name = `if [ -f "$ARGV[1]" ]; then cat $ARGV[1]; else echo $ARGV[1]; fi`);
 353 $name =~ s%.*/([0-9a-z.-]*)_.*%$1%;
 354
 355 exit 1 unless $name;
 356
 357 if($ARGV[0] eq "list") { &list($name); exit 0; }
 358 elsif($ARGV[0] eq "copyout") { &copyout($name,$ARGV[2],$ARGV[3]); exit 0; }
 359 elsif($ARGV[0] eq "run") { &run($name,$ARGV[2]); exit 0; }
 360
 361 exit 1;
 362