123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107 |
- #! @PERL@
- #
- # 1999 (c) Piotr Roszatycki <dexter@debian.org>
- # This software is under GNU license
- # last modification: 1999-12-08
- #
- # deba
- sub quote {
- $_ = shift(@_);
- s/([^\w\/.+-])/\\$1/g;
- return($_);
- }
- sub list
- {
- my($qarchive)=@_;
- $qarchive = quote($qarchive);
- chop($date=`LC_ALL=C date "+%m-%d-%Y %H:%M"`);
- chop($info_size=`apt-cache show $qarchive | wc -c`);
- $install_size=length($pressinstall);
- $upgrade_size=length($pressupgrade);
- print "-r--r--r-- 1 root root $info_size $date INFO\n";
- chop($debd = `dpkg -s $qarchive | grep -i ^Version | sed 's/^version: //i'`);
- chop($deba = `apt-cache show $qarchive | grep -i ^Version | sed 's/^version: //i'`);
- if( ! $debd ) {
- print "-r-xr--r-- 1 root root $install_size $date INSTALL\n";
- } elsif( $debd ne $deba ) {
- print "-r-xr--r-- 1 root root $upgrade_size $date UPGRADE\n";
- }
- }
- sub copyout
- {
- my($archive,$filename,$destfile)=@_;
- my $qarchive = quote($archive);
- my $qdestfile = quote($destfile);
- if($filename eq "INFO") {
- system("apt-cache show $qarchive > $qdestfile");
- } elsif($filename eq "INSTALL") {
- if ( open(FILEOUT, "> $destfile") ) {
- print FILEOUT $pressinstall;
- close FILEOUT;
- system("chmod a+x $qdestfile");
- }
- } elsif($filename eq "UPGRADE") {
- if ( open(FILEOUT, ">, $destfile") ) {
- print FILEOUT $pressupgrade;
- close FILEOUT;
- system("chmod a+x $qdestfile");
- }
- } else {
- die "extfs: $filename: No such file or directory\n";
- }
- }
- sub run
- {
- my($archive,$filename)=@_;
- my $qarchive = quote($archive);
- if($filename eq "INSTALL") {
- system("apt-get install $qarchive");
- } elsif($filename eq "UPGRADE") {
- system("apt-get install $qarchive");
- } else {
- die "extfs: $filename: Permission denied\n";
- }
- }
- $pressinstall=<<EOInstall;
- WARNING
- Don\'t use this method if you are not willing to install this package...
- This is not a real file. It is a way to install the package you are browsing.
- To install this package 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 upgrade this package...
- This is not a real file. It is a way to upgrade the package you are browsing.
- To upgrade this package go back to the panel and press Enter on this file.
- EOInstall
- umask 077;
- chop($name = `if [ -f "$ARGV[1]" ]; then cat $ARGV[1]; else echo $ARGV[1]; fi`);
- $name =~ s%.*/([0-9a-z.-]*)_.*%$1%;
- exit 1 unless $name;
- if($ARGV[0] eq "list") { &list($name); exit 0; }
- elsif($ARGV[0] eq "copyout") { ©out($name,$ARGV[2],$ARGV[3]); exit 0; }
- elsif($ARGV[0] eq "run") { &run($name,$ARGV[2]); exit 0; }
- exit 1;
|