lib/vfs/mc-vfs/extfs/deba.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 # deba
   8
   9 sub quote {
  10     $_ = shift(@_);
  11     s/([^\w\/.+-])/\\$1/g;
  12     return($_);
  13 }
  14
  15 sub list
  16 {
  17        my($qarchive)=@_;
  18        $qarchive = quote($qarchive);
  19        chop($date=`LC_ALL=C date "+%m-%d-%Y %H:%M"`);
  20        chop($info_size=`apt-cache show $qarchive | wc -c`);
  21        $install_size=length($pressinstall);
  22        $upgrade_size=length($pressupgrade);
  23
  24        print "-r--r--r--   1 root     root     $info_size $date INFO\n";
  25
  26        chop($debd = `dpkg -s $qarchive | grep -i ^Version | sed 's/^version: //i'`);
  27        chop($deba = `apt-cache show $qarchive | grep -i ^Version | sed 's/^version: //i'`);
  28        if( ! $debd ) {
  29            print "-r-xr--r--   1 root     root     $install_size $date INSTALL\n";
  30        } elsif( $debd ne $deba ) {
  31            print "-r-xr--r--   1 root     root     $upgrade_size $date UPGRADE\n";
  32        }
  33 }
  34
  35 sub copyout
  36 {
  37        my($archive,$filename,$destfile)=@_;
  38        my $qarchive = quote($archive);
  39        my $qdestfile = quote($destfile);
  40        if($filename eq "INFO") {
  41            system("apt-cache show $qarchive > $qdestfile");
  42         } elsif($filename eq "INSTALL")        {
  43            if ( open(FILEOUT, "> $destfile") ) {
  44                print FILEOUT $pressinstall;
  45                close FILEOUT;
  46                system("chmod a+x $qdestfile");
  47            }
  48        } elsif($filename eq "UPGRADE") {
  49            if ( open(FILEOUT, ">, $destfile") ) {
  50                print FILEOUT $pressupgrade;
  51                close FILEOUT;
  52                system("chmod a+x $qdestfile");
  53            }
  54        } else {
  55            die "extfs: $filename: No such file or directory\n";
  56        }
  57 }
  58
  59 sub run
  60 {
  61        my($archive,$filename)=@_;
  62        my $qarchive = quote($archive);
  63        if($filename eq "INSTALL") {
  64            system("apt-get install $qarchive");
  65        } elsif($filename eq "UPGRADE") {
  66            system("apt-get install $qarchive");
  67        } else {
  68            die "extfs: $filename: Permission denied\n";
  69        }
  70 }
  71
  72 $pressinstall=<<EOInstall;
  73
  74                                 WARNING
  75   Don\'t use this method if you are not willing to install this package...
  76
  77 This is not a real file. It is a way to install the package you are browsing.
  78
  79 To install this package go back to the panel and press Enter on this file.
  80
  81 EOInstall
  82
  83 $pressupgrade=<<EOInstall;
  84
  85                                 WARNING
  86   Don\'t use this method if you are not willing to upgrade this package...
  87
  88 This is not a real file. It is a way to upgrade the package you are browsing.
  89
  90 To upgrade this package go back to the panel and press Enter on this file.
  91
  92 EOInstall
  93
  94
  95 umask 077;
  96
  97 chop($name = `if [ -f "$ARGV[1]" ]; then cat $ARGV[1]; else echo $ARGV[1]; fi`);
  98 $name =~ s%.*/([0-9a-z.-]*)_.*%$1%;
  99
 100 exit 1 unless $name;
 101
 102 if($ARGV[0] eq "list") { &list($name); exit 0; }
 103 elsif($ARGV[0] eq "copyout") { &copyout($name,$ARGV[2],$ARGV[3]); exit 0; }
 104 elsif($ARGV[0] eq "run") { &run($name,$ARGV[2]); exit 0; }
 105
 106 exit 1;
 107