deba.in 3.0 KB

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