apt.in 9.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359
  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. # apt
  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,$path,$mode) = @_;
  92. if (-f $file) {
  93. my @stat = stat(_);
  94. # mode, nlink, uid, gid, size, mtime, filename
  95. printf "%s %d %d %d %d %s %s\n", $mode || ft($file).fm($stat[2] & 07777),
  96. $stat[3], $stat[4], $stat[5], $stat[7], bt($stat[9]), $path;
  97. }
  98. }
  99. $DATE=bt(time());
  100. sub list
  101. {
  102. my ($pkg, $fn, $dn, $sz, $bt);
  103. my($check,$stats,$config);
  104. chop($check = `apt-get -q check 2>/dev/null`);
  105. chop($available = `apt-cache dumpavail 2>/dev/null`);
  106. chop($stats = `apt-cache stats 2>/dev/null`);
  107. chop($config = `apt-config dump 2>&1`);
  108. $sz = length($check);
  109. print "-r--r--r-- 1 root root $sz $DATE CHECK\n";
  110. $sz = length($available);
  111. print "-r--r--r-- 1 root root $sz $DATE AVAILABLE\n";
  112. $sz = length($stats);
  113. print "-r--r--r-- 1 root root $sz $DATE STATS\n";
  114. $sz = length($config);
  115. print "-r--r--r-- 1 root root $sz $DATE CONFIG\n";
  116. $sz = length($pressupdate);
  117. print "-r-xr--r-- 1 root root $sz $DATE UPDATE\n";
  118. $sz = length($pressupgrade);
  119. print "-r-xr--r-- 1 root root $sz $DATE UPGRADE\n";
  120. print "-r-xr--r-- 1 root root $sz $DATE DIST-UPGRADE\n";
  121. ls("/etc/apt/sources.list","sources.list");
  122. ls('/etc/apt/apt.conf','apt.conf') if (-f '/etc/apt/apt.conf');
  123. print "drwxr-xr-x 1 root root 0 $DATE all\n";
  124. if ( open(PIPEIN, "find /var/cache/apt/archives -type f |") ) {
  125. while(<PIPEIN>) {
  126. chop;
  127. next if /\/lock$/;
  128. my $file = $_;
  129. s%/var/cache/apt/archives/%CACHE/%;
  130. ls($file, $_);
  131. }
  132. close PIPEIN;
  133. }
  134. my %sects = ();
  135. my %debd = ();
  136. my %deba = ();
  137. open STAT, "/var/lib/dpkg/status"
  138. or exit 1;
  139. while( <STAT> ) {
  140. chop;
  141. if( /^([\w-]*): (.*)/ ) {
  142. $pkg = $2 if( lc($1) eq 'package' );
  143. $debd{$pkg}{lc($1)} = $2;
  144. }
  145. }
  146. close STAT;
  147. foreach $pkg (sort keys %debd) {
  148. next if $debd{$pkg}{status} =~ /not-installed/;
  149. $fn = $debd{$pkg}{package}. "_". $debd{$pkg}{version};
  150. $dn = $debd{$pkg}{section};
  151. if( ! $dn ) {
  152. $dn = "unknown";
  153. } elsif( $dn =~ /^(non-us)$/i ) {
  154. $dn .= "/main";
  155. } elsif( $dn !~ /\// ) {
  156. $dn = "main/". $dn;
  157. }
  158. unless( $sects{$dn} ) {
  159. my $sub = $dn;
  160. while( $sub =~ s!^(.*)/[^/]*$!$1! ) {
  161. unless( $sects{$sub} ) {
  162. print "drwxr-xr-x 1 root root 0 $DATE $sub/\n";
  163. $sects{$sub} = 1;
  164. }
  165. }
  166. print "drwxr-xr-x 1 root root 0 $DATE $dn/\n";
  167. $sects{$dn} = 1;
  168. }
  169. $sz = $debd{$pkg}{'status'} =~ /config-files/ ? 0 : $debd{$pkg}{'installed-size'} * 1024;
  170. @stat = stat("/var/lib/dpkg/info/".$debd{$pkg}{package}.".list");
  171. $bt = bt($stat[9]);
  172. print "-rw-r--r-- 1 root root $sz $bt $dn/$fn.debd\n";
  173. print "lrwxrwxrwx 1 root root $sz $bt all/$fn.debd -> ../$dn/$fn.debd\n";
  174. }
  175. open STAT, "apt-cache dumpavail |"
  176. or exit 1;
  177. while( <STAT> ) {
  178. chop;
  179. if( /^([\w-]*): (.*)/ ) {
  180. $pkg = $2 if( lc($1) eq 'package' );
  181. $deba{$pkg}{lc($1)} = $2;
  182. }
  183. }
  184. close STAT;
  185. foreach $pkg (sort keys %deba) {
  186. next if $deba{$pkg}{version} eq $debd{$pkg}{version};
  187. $fn = $deba{$pkg}{package}. "_". $deba{$pkg}{version};
  188. $dn = $deba{$pkg}{section};
  189. if( ! $dn ) {
  190. $dn = "unknown";
  191. } elsif( $dn =~ /^(non-us)$/i ) {
  192. $dn .= "/main";
  193. } elsif( $dn !~ /\// ) {
  194. $dn = "main/". $dn;
  195. }
  196. unless( $sects{$dn} ) {
  197. my $sub = $dn;
  198. while( $sub =~ s!^(.*)/[^/]*$!$1! ) {
  199. unless( $sects{$sub} ) {
  200. print "drwxr-xr-x 1 root root 0 $DATE $sub/\n";
  201. $sects{$sub} = 1;
  202. }
  203. }
  204. print "drwxr-xr-x 1 root root 0 $DATE $dn/\n";
  205. $sects{$dn} = 1;
  206. }
  207. $sz = $deba{$pkg}{'status'} =~ /config-files/ ? 0 : $deba{$pkg}{'installed-size'} * 1024;
  208. print "-rw-r--r-- 1 root root $sz $DATE $dn/$fn.deba\n";
  209. print "lrwxrwxrwx 1 root root $sz $DATE all/$fn.deba -> ../$dn/$fn.deba\n";
  210. }
  211. }
  212. sub copyout
  213. {
  214. my($archive,$filename) = @_;
  215. my $qarchive = quote($archive);
  216. my $qfilename = quote($filename);
  217. if( $archive eq 'CHECK' ) {
  218. system("apt-get -q check > $qfilename");
  219. } elsif( $archive eq 'AVAILABLE' ) {
  220. system("apt-cache dumpavail > $qfilename");
  221. } elsif( $archive eq 'STATS' ) {
  222. system("apt-cache stats > $qfilename");
  223. } elsif( $archive eq 'CONFIG' ) {
  224. system("(apt-config dump 2>&1) > $qfilename");
  225. } elsif( $archive eq 'UPDATE' ) {
  226. open O, ">$filename";
  227. print O $pressupdate;
  228. close O;
  229. } elsif( $archive eq 'UPGRADE' || $archive eq 'DIST-UPGRADE' ) {
  230. open O, ">$filename";
  231. print O $pressupgrade;
  232. close O;
  233. } elsif( $archive eq 'apt.conf' ) {
  234. system("cp /etc/apt/apt.conf $qfilename");
  235. } elsif( $archive eq 'sources.list' ) {
  236. system("cp /etc/apt/sources.list $qfilename");
  237. } elsif( $archive =~ /^CACHE\// ) {
  238. $archive =~ s%^CACHE/%/var/cache/apt/archives/%;
  239. system("cp $qarchive $qfilename");
  240. } else {
  241. open O, ">$filename";
  242. print O $archive, "\n";
  243. close O;
  244. }
  245. }
  246. sub copyin
  247. {
  248. my($archive,$filename) = @_;
  249. my $qarchive = quote($archive);
  250. my $qfilename = quote($filename);
  251. if( $archive =~ /\.deb$/ ) {
  252. system("dpkg -i $qfilename>/dev/null");
  253. } elsif( $archive eq 'apt.conf' ) {
  254. system("cp $qfilename /etc/apt/apt.conf");
  255. } elsif( $archive eq 'sources.list' ) {
  256. system("cp $qfilename /etc/apt/sources.list");
  257. } elsif( $archive =~ /^CACHE\// ) {
  258. $qarchive =~ s%^CACHE/%/var/cache/apt/archives/%;
  259. system("cp $qfilename $qarchive");
  260. } else {
  261. die "extfs: cannot create regular file \`$archive\': Permission denied\n";
  262. }
  263. }
  264. sub run
  265. {
  266. my($archive,$filename) = @_;
  267. if( $archive eq 'UPDATE' ) {
  268. system("apt-get update");
  269. } elsif( $archive eq 'UPGRADE' ) {
  270. system("apt-get upgrade -u");
  271. } elsif( $archive eq 'DIST-UPGRADE' ) {
  272. system("apt-get dist-upgrade -u");
  273. } else {
  274. die "extfs: $archive: command not found\n";
  275. }
  276. }
  277. sub rm
  278. {
  279. my($archive) = @_;
  280. my $qarchive = quote($archive);
  281. if( $archive =~ /^CACHE\// ) {
  282. $qarchive =~ s%^CACHE/%/var/cache/apt/archives/%;
  283. system("rm -f $qarchive");
  284. } elsif( $archive eq 'apt.conf' ) {
  285. system("rm -f /etc/apt/apt.conf");
  286. } elsif( $archive eq 'sources.list' ) {
  287. system("rm -f /etc/apt/sources.list");
  288. } elsif( $archive =~ /\.debd?$/ ) {
  289. # uncommented and changed to use dpkg - alpha
  290. my $qname = $qarchive;
  291. $qname =~ s%.*/%%g;
  292. $qname =~ s%_.*%%g;
  293. system("dpkg --remove $qname >/dev/null");
  294. die("extfs: $archive: Operation not permitted\n") if $? != 0;
  295. } else {
  296. die "extfs: $archive: Operation not permitted\n";
  297. }
  298. }
  299. $pressupdate=<<EOInstall;
  300. WARNING
  301. Don\'t use this method if you don't want to retrieve new lists of packages.
  302. ==========================================================================
  303. This is not a real file. It is a way to retrieve new lists of packages.
  304. To update this information go back to the panel and press Enter on this file.
  305. EOInstall
  306. $pressupgrade=<<EOInstall;
  307. WARNING
  308. Don\'t use this method if you are not willing to perform an upgrade.
  309. ===================================================================
  310. This is not a real file. It is a way to perform an upgrade.
  311. To upgrade this information go back to the panel and press Enter on this file.
  312. EOInstall
  313. # override any locale for dates
  314. $ENV{"LC_ALL"}="C";
  315. if ($ARGV[0] eq "list") { list(); exit(0); }
  316. elsif ($ARGV[0] eq "copyout") { copyout($ARGV[2], $ARGV[3]); exit(0); }
  317. elsif ($ARGV[0] eq "copyin") { copyin($ARGV[2], $ARGV[3]); exit(0); }
  318. elsif ($ARGV[0] eq "run") { run($ARGV[2]); exit(0); }
  319. elsif ($ARGV[0] eq "rm") { rm($ARGV[2]); exit(0); }
  320. exit(1);