debd.in 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362
  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. sub quote {
  9. $_ = shift(@_);
  10. s/([^\w\/.+-])/\\$1/g;
  11. return($_);
  12. }
  13. sub bt
  14. {
  15. my ($dt) = @_;
  16. my (@time);
  17. @time = localtime($dt);
  18. $bt = sprintf "%02d-%02d-%d %02d:%02d", $time[4] + 1, $time[3],
  19. $time[5] + 1900, $time[2], $time[1];
  20. return $bt;
  21. }
  22. sub ft
  23. {
  24. my ($f) = @_;
  25. return "d" if -d $f;
  26. return "l" if -l $f;
  27. return "p" if -p $f;
  28. return "S" if -S $f;
  29. return "b" if -b $f;
  30. return "c" if -c $f;
  31. return "-";
  32. }
  33. sub fm
  34. {
  35. my ($n) = @_;
  36. my ($m);
  37. if( $n & 0400 ) {
  38. $m .= "r";
  39. } else {
  40. $m .= "-";
  41. }
  42. if( $n & 0200 ) {
  43. $m .= "w";
  44. } else {
  45. $m .= "-";
  46. }
  47. if( $n & 04000 ) {
  48. $m .= "s";
  49. } elsif( $n & 0100 ) {
  50. $m .= "x";
  51. } else {
  52. $m .= "-";
  53. }
  54. if( $n & 0040 ) {
  55. $m .= "r";
  56. } else {
  57. $m .= "-";
  58. }
  59. if( $n & 0020 ) {
  60. $m .= "w";
  61. } else {
  62. $m .= "-";
  63. }
  64. if( $n & 02000 ) {
  65. $m .= "s";
  66. } elsif( $n & 0010 ) {
  67. $m .= "x";
  68. } else {
  69. $m .= "-";
  70. }
  71. if( $n & 0004 ) {
  72. $m .= "r";
  73. } else {
  74. $m .= "-";
  75. }
  76. if( $n & 0002 ) {
  77. $m .= "w";
  78. } else {
  79. $m .= "-";
  80. }
  81. if( $n & 01000 ) {
  82. $m .= "t";
  83. } elsif( $n & 0001 ) {
  84. $m .= "x";
  85. } else {
  86. $m .= "-";
  87. }
  88. return $m;
  89. }
  90. sub ls {
  91. my ($file) = @_;
  92. my @stat = stat($file);
  93. # mode, nlink, uid, gid, size, mtime, filename
  94. printf "%s%s %d %d %d %d %s CONTENTS%s\n", ft($file), fm($stat[2] & 07777),
  95. $stat[3], $stat[4], $stat[5], $stat[7], bt($stat[9]), $file;
  96. }
  97. sub list
  98. {
  99. my($archive)=@_;
  100. my $qarchive = quote($archive);
  101. chop($date=`LC_ALL=C date "+%m-%d-%Y %H:%M"`);
  102. chop($info_size=`dpkg -s $qarchive | wc -c`);
  103. $repack_size=length($pressrepack);
  104. $reinstall_size=length($pressreinstall);
  105. $remove_size=length($pressremove);
  106. $purge_size=length($presspurge);
  107. $reconfigure_size=length($pressreconfigure);
  108. $reinstall_size=length($pressreinstall);
  109. $select_size=length($pressselect);
  110. $unselect_size=length($pressunselect);
  111. print "dr-xr-xr-x 1 root root 0 $date CONTENTS\n";
  112. print "dr-xr-xr-x 1 root root 0 $date DEBIAN\n";
  113. print "-r--r--r-- 1 root root $info_size $date INFO\n";
  114. print "-r-xr--r-- 1 root root $purge_size $date DPKG-PURGE\n";
  115. chop($status = `dpkg -s $qarchive | grep ^Status`);
  116. if( $status =~ /deinstall/ ) {
  117. print "-r-xr--r-- 1 root root $select_size $date DPKG-SELECT\n";
  118. } elsif( $status =~ /install/ ) {
  119. print "-r-xr--r-- 1 root root $unselect_size $date DPKG-UNSELECT\n";
  120. }
  121. if( $status !~ /config-files/ ) {
  122. if ( -x "/usr/bin/dpkg-repack" ) {
  123. print "-r-xr--r-- 1 root root $repack_size $date DPKG-REPACK\n";
  124. }
  125. print "-r-xr--r-- 1 root root $remove_size $date DPKG-REMOVE\n";
  126. if ( -x "/usr/bin/apt-get" ) {
  127. print "-r-xr--r-- 1 root root $remove_size $date APT-REMOVE\n";
  128. print "-r-xr--r-- 1 root root $reinstall_size $date APT-REINSTALL\n";
  129. print "-r-xr--r-- 1 root root $purge_size $date APT-PURGE\n";
  130. }
  131. }
  132. if( -x "/usr/bin/dpkg-reconfigure" && -x "/var/lib/dpkg/info/$archive.config" ) {
  133. print "-r-xr--r-- 1 root root $reconfigure_size $date DPKG-RECONFIGURE\n";
  134. }
  135. if ( open(PIPEIN, "LANG=C ls -l /var/lib/dpkg/info/$qarchive.* |") ) {
  136. while(<PIPEIN>) {
  137. chop;
  138. next if /\.list$/;
  139. s%/var/lib/dpkg/info/$archive.%DEBIAN/%;
  140. print $_, "\n";
  141. }
  142. close PIPEIN;
  143. }
  144. if ( open(LIST, "/var/lib/dpkg/info/$archive.list") ) {
  145. while(<LIST>) {
  146. chop;
  147. ls($_);
  148. }
  149. close LIST;
  150. }
  151. }
  152. sub copyout
  153. {
  154. my($archive,$filename,$destfile)=@_;
  155. my $qarchive = quote($archive);
  156. my $qfilename = quote($filename);
  157. my $qdestfile = quote($destfile);
  158. if($filename eq "INFO") {
  159. system("dpkg -s $qarchive > $qdestfile");
  160. } elsif($filename eq "DPKG-REPACK") {
  161. if ( open(FILEOUT,">$destfile") ) {
  162. print FILEOUT $pressrepack;
  163. close FILEOUT;
  164. system("chmod a+x $qdestfile");
  165. }
  166. } elsif($filename =~ /^DEBIAN/) {
  167. $qfilename=~s!^DEBIAN/!!;
  168. system("cat /var/lib/dpkg/info/$qarchive.$qfilename > $qdestfile");
  169. } elsif($filename eq "DPKG-REMOVE" || $filename eq "APT-REMOVE") {
  170. if ( open(FILEOUT,">$destfile") ) {
  171. print FILEOUT $pressremove;
  172. close FILEOUT;
  173. system("chmod a+x $qdestfile");
  174. }
  175. } elsif($filename eq "DPKG-PURGE" || $filename eq "APT-PURGE") {
  176. if ( open(FILEOUT,">$destfile") ) {
  177. print FILEOUT $presspurge;
  178. close FILEOUT;
  179. system("chmod a+x $qdestfile");
  180. }
  181. } elsif($filename eq "DPKG-RECONFIGURE") {
  182. if ( open(FILEOUT,">$destfile") ) {
  183. print FILEOUT $pressreconfigure;
  184. close FILEOUT;
  185. system("chmod a+x $qdestfile");
  186. }
  187. } elsif($filename eq "APT-REINSTALL") {
  188. if ( open(FILEOUT,">$destfile") ) {
  189. print FILEOUT $pressreinstall;
  190. close FILEOUT;
  191. system("chmod a+x $destfile");
  192. }
  193. } elsif($filename eq "DPKG-SELECT") {
  194. if ( open(FILEOUT,">$destfile") ) {
  195. print FILEOUT $pressselect;
  196. close FILEOUT;
  197. system("chmod a+x $destfile");
  198. }
  199. } elsif($filename eq "DPKG-UNSELECT") {
  200. if ( open(FILEOUT,">$destfile") ) {
  201. print FILEOUT $pressunselect;
  202. close FILEOUT;
  203. system("chmod a+x $qdestfile");
  204. }
  205. } else {
  206. $qfilename=~s!^CONTENTS!!;
  207. system("cat $qfilename > $qdestfile");
  208. }
  209. }
  210. sub run
  211. {
  212. my($archive,$filename)=@_;
  213. my $qarchive = quote($archive);
  214. my $qfilename = quote($filename);
  215. if($filename eq "DPKG-REMOVE") {
  216. system("dpkg --remove $qarchive");
  217. } elsif($filename eq "APT-REMOVE") {
  218. system("apt-get remove $qarchive");
  219. } elsif($filename eq "DPKG-PURGE") {
  220. system("dpkg --purge $qarchive");
  221. } elsif($filename eq "APT-PURGE") {
  222. system("apt-get --purge remove $qarchive");
  223. } elsif($filename eq "DPKG-REPACK") {
  224. system("dpkg-repack $qarchive");
  225. } elsif($filename eq "DPKG-SELECT") {
  226. system("echo $aqrchive install | dpkg --set-selections");
  227. } elsif($filename eq "DPKG-UNSELECT") {
  228. system("echo $qarchive deinstall | dpkg --set-selections");
  229. } elsif($filename eq "APT-REINSTALL") {
  230. system("apt-get -u --reinstall install $qarchive");
  231. } elsif($filename eq "DPKG-RECONFIGURE") {
  232. system("dpkg-reconfigure $qarchive");
  233. } elsif($filename=~/^DEBIAN/) {
  234. $qfilename=~s!^DEBIAN!!;
  235. system("/var/lib/dpkg/info/$qarchive.$qfilename");
  236. } else {
  237. $qfilename=~s!^CONTENTS!!;
  238. system($qfilename);
  239. }
  240. }
  241. $pressrepack=<<EOInstall;
  242. WARNING
  243. Don\'t use this method if you are not willing to repack this package...
  244. This is not a real file. It is a way to repack the package you are browsing.
  245. To repack this package go back to the panel and press Enter on this file.
  246. EOInstall
  247. $pressreinstall=<<EOInstall;
  248. WARNING
  249. Don\'t use this method if you are not willing to reinstall this package...
  250. This is not a real file. It is a way to reinstall the package you are browsing.
  251. To reinstall this package go back to the panel and press Enter on this file.
  252. EOInstall
  253. $pressremove=<<EOInstall;
  254. WARNING
  255. Don\'t use this method if you are not willing to remove this package...
  256. This is not a real file. It is a way to remove the package you are browsing.
  257. To remove this package go back to the panel and press Enter on this file.
  258. EOInstall
  259. $presspurge=<<EOInstall;
  260. WARNING
  261. Don\'t use this method if you are not willing to purge this package...
  262. This is not a real file. It is a way to purge the package you are browsing.
  263. To purge this package go back to the panel and press Enter on this file.
  264. EOInstall
  265. $pressreconfigure=<<EOInstall;
  266. WARNING
  267. Don\'t use this method if you are not willing to reconfigure this package...
  268. This is not a real file. It is a way to reconfigure the package you are browsing.
  269. To reconfigure this package go back to the panel and press Enter on this file.
  270. EOInstall
  271. $pressreinstall=<<EOInstall;
  272. WARNING
  273. Don\'t use this method if you are not willing to reinstall this package...
  274. This is not a real file. It is a way to reinstall the package you are browsing.
  275. To reinstall this package go back to the panel and press Enter on this file.
  276. EOInstall
  277. $pressselect=<<EOInstall;
  278. WARNING
  279. Don\'t use this method if you are not willing to select this package...
  280. This is not a real file. It is a way to select the package you are browsing.
  281. To select this package go back to the panel and press Enter on this file.
  282. EOInstall
  283. $pressunselect=<<EOInstall;
  284. WARNING
  285. Don\'t use this method if you are not willing to unselect this package...
  286. This is not a real file. It is a way to unselect the package you are browsing.
  287. To unselect this package go back to the panel and press Enter on this file.
  288. EOInstall
  289. umask 077;
  290. chop($name = `if [ -f "$ARGV[1]" ]; then cat $ARGV[1]; else echo $ARGV[1]; fi`);
  291. $name =~ s%.*/([0-9a-z.-]*)_.*%$1%;
  292. exit 1 unless $name;
  293. if($ARGV[0] eq "list") { &list($name); exit 0; }
  294. elsif($ARGV[0] eq "copyout") { &copyout($name,$ARGV[2],$ARGV[3]); exit 0; }
  295. elsif($ARGV[0] eq "run") { &run($name,$ARGV[2]); exit 0; }
  296. exit 1;