You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

560 lines
14 KiB

  1. #!/usr/bin/perl
  2. # Debian task selector, mark II.
  3. # Copyright 2004 by Joey Hess <joeyh@debian.org>.
  4. # Licensed under the GPL, version 2 or higher.
  5. use Locale::gettext;
  6. use Getopt::Long;
  7. use warnings;
  8. use strict;
  9. textdomain('tasksel');
  10. my $debconf_helper="/usr/lib/tasksel/tasksel-debconf";
  11. my $testdir="/usr/lib/tasksel/tests";
  12. my $packagesdir="/usr/lib/tasksel/packages";
  13. my $descdir="/usr/share/tasksel";
  14. my $localdescdir="/usr/local/share/tasksel";
  15. my $statusfile="/var/lib/dpkg/status";
  16. sub warning {
  17. print STDERR "tasksel: @_\n";
  18. }
  19. sub error {
  20. print STDERR "tasksel: @_\n";
  21. exit 1;
  22. }
  23. # A list of all available task desc files.
  24. sub list_task_descs {
  25. return glob("$descdir/*.desc"), glob("$localdescdir/*.desc");
  26. }
  27. # Returns a list of hashes; hash values are arrays for multi-line fields.
  28. sub read_task_desc {
  29. my $desc=shift;
  30. my @ret;
  31. open (DESC, "<$desc") || die "read $desc\: $!";
  32. local $/="\n\n";
  33. while (<DESC>) {
  34. my %data;
  35. my @lines=split("\n");
  36. while (@lines) {
  37. my $line=shift(@lines);
  38. if ($line=~/^([^ ]+):(?: (.*))?/) {
  39. my ($key, $value)=($1, $2);
  40. $key=lc($key);
  41. if (@lines && $lines[0] =~ /^\s+/) {
  42. # multi-line field
  43. my @values;
  44. if (defined $value && length $value) {
  45. push @values, $value;
  46. }
  47. while (@lines && $lines[0] =~ /^\s+(.*)/) {
  48. push @values, $1;
  49. shift @lines;
  50. }
  51. $data{$key}=[@values];
  52. }
  53. else {
  54. $data{$key}=$value;
  55. }
  56. }
  57. else {
  58. warning "parse error in stanza $. of $desc";
  59. }
  60. }
  61. if (%data) {
  62. $data{relevance}=5 unless exists $data{relevance};
  63. $data{shortdesc}=$data{description}->[0];
  64. $data{shortdesctrans}=dgettext("debian-tasks", $data{shortdesc});
  65. push @ret, \%data;
  66. }
  67. }
  68. close DESC;
  69. return @ret;
  70. }
  71. # Loads info for all tasks, and returns a set of task structures.
  72. sub all_tasks {
  73. my %seen;
  74. grep { $seen{$_->{task}}++; $seen{$_->{task}} < 2 }
  75. map { read_task_desc($_) } list_task_descs();
  76. }
  77. # Returns a list of all available packages.
  78. sub list_avail {
  79. my @list;
  80. # Might be better to use the perl apt bindings, but they are not
  81. # currently in base.
  82. open (AVAIL, "apt-cache dumpavail|");
  83. local $_;
  84. while (<AVAIL>) {
  85. chomp;
  86. if (/^Package: (.*)/) {
  87. push @list, $1;
  88. }
  89. }
  90. close AVAIL;
  91. return @list;
  92. }
  93. # Returns a list of all installed packages.
  94. sub list_installed {
  95. my @list;
  96. local $/="\n\n";
  97. open (STATUS, $statusfile);
  98. local $_;
  99. while (<STATUS>) {
  100. if (/^Status: .* installed$/m && /Package: (.*)$/m) {
  101. push @list, $1;
  102. }
  103. }
  104. close STATUS;
  105. return @list;
  106. }
  107. my %avail_pkgs;
  108. # Given a package name, checks to see if it's available. Memoised.
  109. sub package_avail {
  110. my $package=shift;
  111. if (! %avail_pkgs) {
  112. foreach my $pkg (list_avail()) {
  113. $avail_pkgs{$pkg} = 1;
  114. }
  115. }
  116. return $avail_pkgs{$package} || package_installed($package);
  117. }
  118. my %installed_pkgs;
  119. # Given a package name, checks to see if it's installed. Memoised.
  120. sub package_installed {
  121. my $package=shift;
  122. if (! %installed_pkgs) {
  123. foreach my $pkg (list_installed()) {
  124. $installed_pkgs{$pkg} = 1;
  125. }
  126. }
  127. return $installed_pkgs{$package};
  128. }
  129. # Given a task hash, checks if its key packages are available.
  130. sub task_avail {
  131. local $_;
  132. my $task=shift;
  133. if (! ref $task->{key}) {
  134. return 1;
  135. }
  136. else {
  137. foreach my $pkg (@{$task->{key}}) {
  138. if (! package_avail($pkg)) {
  139. return 0;
  140. }
  141. }
  142. return 1;
  143. }
  144. }
  145. # Given a task hash, checks to see if it is already installed.
  146. # (All of its key packages must be installed.)
  147. sub task_installed {
  148. local $_;
  149. my $task=shift;
  150. if (! ref $task->{key}) {
  151. return 0; # can't tell with no key packages
  152. }
  153. else {
  154. foreach my $pkg (@{$task->{key}}) {
  155. if (! package_installed($pkg)) {
  156. return 0;
  157. }
  158. }
  159. return 1;
  160. }
  161. }
  162. # Given task hash, returns a list of all available packages in the task.
  163. # If the aptitude_tasks parameter is true, then it does not expand tasks
  164. # that aptitude knows about, and just returns aptitude task syntax for
  165. # those.
  166. sub task_packages {
  167. my $task=shift;
  168. my $aptitude_tasks=shift;
  169. my %list;
  170. # key packages are always included
  171. if (ref $task->{key}) {
  172. map { $list{$_}=1 } @{$task->{key}};
  173. }
  174. if ($task->{packages} eq 'task-fields') {
  175. # task-fields method is built-in for speed and to support
  176. # aptitude task definitions
  177. if ($aptitude_tasks) {
  178. return '~t^'.$task->{task}.'$';
  179. }
  180. else {
  181. local $/="\n\n";
  182. open (AVAIL, "apt-cache dumpavail|");
  183. while (<AVAIL>) {
  184. if (/^Task: (.*)/m) {
  185. my @tasks=split(", ", $1);
  186. if (grep { $_ eq $task->{task} } @tasks) {
  187. $list{$1}=1 if /^Package: (.*)/m;
  188. }
  189. }
  190. }
  191. close AVAIL;
  192. }
  193. }
  194. elsif ($task->{packages} eq 'standard') {
  195. # standard method is built in since it cannot easily be
  196. # implemented externally.
  197. return "~pstandard", "~prequired", "~pimportant";
  198. }
  199. elsif ($task->{packages} eq 'manual') {
  200. # manual package selection is a special case
  201. return;
  202. }
  203. else {
  204. # external method
  205. my ($method, @params);
  206. if (ref $task->{packages}) {
  207. @params=@{$task->{packages}};
  208. $method=shift @params;
  209. }
  210. else {
  211. $method=$task->{packages};
  212. }
  213. map { $list{$_}=1 }
  214. grep { package_avail($_) }
  215. split(' ', `$packagesdir/$method $task->{task} @params`);
  216. }
  217. return keys %list;
  218. }
  219. # Given a task hash, runs any test program specified in its data, and sets
  220. # the _display and _install fields to 1 or 0 depending on its result.
  221. sub task_test {
  222. my $task=shift;
  223. my $new_install=shift;
  224. $ENV{NEW_INSTALL}=$new_install if defined $new_install;
  225. $task->{_display} = 1;
  226. $task->{_install} = 0;
  227. foreach my $test (grep /^test-.*/, keys %$task) {
  228. $test=~s/^test-//;
  229. if (-x "$testdir/$test") {
  230. my $ret=system("$testdir/$test", $task->{task}, split " ", $task->{"test-$test"}) >> 8;
  231. if ($ret == 0) {
  232. $task->{_display} = 0;
  233. $task->{_install} = 1;
  234. }
  235. elsif ($ret == 1) {
  236. $task->{_display} = 0;
  237. $task->{_install} = 0;
  238. }
  239. elsif ($ret == 2) {
  240. $task->{_display} = 1;
  241. $task->{_install} = 1;
  242. }
  243. elsif ($ret == 3) {
  244. $task->{_display} = 1;
  245. $task->{_install} = 0;
  246. }
  247. }
  248. }
  249. delete $ENV{NEW_INSTALL};
  250. return $task;
  251. }
  252. # Hides a task and marks it not to be installed if it depends on other
  253. # tasks.
  254. sub hide_dependent_tasks {
  255. my $task=shift;
  256. if (exists $task->{depends} && length $task->{depends}) {
  257. $task->{_display} = 0;
  258. $task->{_install} = 0;
  259. }
  260. return $task;
  261. }
  262. # Converts a list of tasks into a debconf list of their short descriptions.
  263. sub task_to_debconf {
  264. my $field = shift;
  265. join ", ", map {
  266. my $desc=$_->{$field};
  267. if ($desc=~/, /) {
  268. warning("task ".$_->{task}." contains a comma in its short description: \"$desc\"");
  269. }
  270. $desc;
  271. } @_;
  272. }
  273. # Given a first parameter that is a debconf list of short descriptions of
  274. # tasks, and then a list of task hashes, returns a list of hashes for all
  275. # the tasks in the debconf list.
  276. sub debconf_to_task {
  277. my $list=shift;
  278. my %desc_to_task = map { $_->{shortdesc} => $_ } @_;
  279. return grep { defined } map { $desc_to_task{$_} } split ", ", $list;
  280. }
  281. # Orders a list of tasks for display.
  282. sub order_for_display {
  283. sort {
  284. $b->{relevance} <=> $a->{relevance}
  285. || 0 ||
  286. $a->{section} cmp $b->{section}
  287. || 0 ||
  288. $a->{shortdesc} cmp $b->{shortdesc}
  289. } @_;
  290. }
  291. # Given a set of tasks and a name, returns the one with that name.
  292. sub name_to_task {
  293. my $name=shift;
  294. return (grep { $_->{task} eq $name } @_)[0];
  295. }
  296. sub usage {
  297. print STDERR gettext(q{Usage:
  298. tasksel install <task>
  299. tasksel remove <task>
  300. tasksel [options]
  301. -t, --test test mode; don't really do anything
  302. --new-install automatically install some tasks
  303. --list-tasks list tasks that would be displayed and exit
  304. --task-packages list available packages in a task
  305. --task-desc returns the description of a task
  306. --logfile file send apt output to the file
  307. --logstderr send apt output to stderr
  308. });
  309. }
  310. # Process command line options and return them in a hash.
  311. sub getopts {
  312. my %ret;
  313. Getopt::Long::Configure ("bundling");
  314. if (! GetOptions(\%ret, "test|t", "new-install", "list-tasks",
  315. "task-packages=s@", "task-desc=s", "logfile=s",
  316. "logstderr")) {
  317. usage();
  318. exit(1);
  319. }
  320. # Special case apt-like syntax.
  321. if (@ARGV && $ARGV[0] eq "install") {
  322. shift @ARGV;
  323. $ret{install} = shift @ARGV;
  324. }
  325. if (@ARGV && $ARGV[0] eq "remove") {
  326. shift @ARGV;
  327. $ret{remove} = shift @ARGV;
  328. }
  329. if (@ARGV) {
  330. usage();
  331. exit 1;
  332. }
  333. return %ret;
  334. }
  335. sub main {
  336. my %options=getopts();
  337. # Options that output stuff and don't need a full processed list of
  338. # tasks.
  339. if (exists $options{"task-packages"}) {
  340. my @tasks=all_tasks();
  341. foreach my $taskname (@{$options{"task-packages"}}) {
  342. my $task=name_to_task($taskname, @tasks);
  343. if ($task) {
  344. print "$_\n" foreach task_packages($task);
  345. }
  346. }
  347. exit(0);
  348. }
  349. elsif ($options{"task-desc"}) {
  350. my $task=name_to_task($options{"task-desc"}, all_tasks());
  351. if ($task) {
  352. my $extdesc=join(" ", @{$task->{description}}[1..$#{$task->{description}}]);
  353. print dgettext("debian-tasks", $extdesc)."\n";
  354. exit(0);
  355. }
  356. else {
  357. exit(1);
  358. }
  359. }
  360. # This is relatively expensive, get the full list of available tasks and
  361. # mark them.
  362. my @tasks=map { hide_dependent_tasks($_) } map { task_test($_, $options{"new-install"}) }
  363. grep { task_avail($_) } all_tasks();
  364. if ($options{"list-tasks"}) {
  365. map { $_->{_installed} = task_installed($_) } @tasks;
  366. print "".($_->{_installed} ? "i" : "u")." ".$_->{task}."\t".$_->{shortdesc}."\n"
  367. foreach order_for_display(grep { $_->{_display} } @tasks);
  368. exit(0);
  369. }
  370. if (! $options{"new-install"}) {
  371. # Don't install hidden tasks if this is not a new install.
  372. map { $_->{_install} = 0 } grep { $_->{_display} == 0 } @tasks;
  373. }
  374. if ($options{"install"}) {
  375. my $task=name_to_task($options{"install"}, @tasks);
  376. $task->{_install} = 1 if $task;
  377. }
  378. my @aptitude_remove;
  379. if ($options{"remove"}) {
  380. my $task=name_to_task($options{"remove"}, @tasks);
  381. push @aptitude_remove, task_packages($task, 0);
  382. }
  383. # The interactive bit.
  384. my $interactive=0;
  385. my @list = order_for_display(grep { $_->{_display} == 1 } @tasks);
  386. if (@list && ! $options{install} && ! $options{remove}) {
  387. $interactive=1;
  388. if (! $options{"new-install"}) {
  389. # Find tasks that are already installed.
  390. map { $_->{_installed} = task_installed($_) } @list;
  391. # Don't install new tasks unless manually selected.
  392. map { $_->{_install} = 0 } @list;
  393. }
  394. else {
  395. # Assume that no tasks are installed, to ensure
  396. # that complete tasks get installed on new
  397. # installs.
  398. map { $_->{_installed} = 0 } @list;
  399. }
  400. my $question="tasksel/tasks";
  401. if ($options{"new-install"}) {
  402. $question="tasksel/first";
  403. }
  404. my @default = grep { $_->{_display} == 1 && ($_->{_install} == 1 || $_->{_installed} == 1) } @tasks;
  405. my $tmpfile=`tempfile`;
  406. chomp $tmpfile;
  407. system($debconf_helper, $tmpfile,
  408. task_to_debconf("shortdesc", @list),
  409. task_to_debconf("shortdesctrans", @list),
  410. task_to_debconf("shortdesc", @default),
  411. $question);
  412. open(IN, "<$tmpfile");
  413. my $ret=<IN>;
  414. if (! defined $ret) {
  415. die "tasksel canceled\n";
  416. }
  417. chomp $ret;
  418. close IN;
  419. unlink $tmpfile;
  420. # Set _install flags based on user selection.
  421. map { $_->{_install} = 0 } @list;
  422. foreach my $task (debconf_to_task($ret, @tasks)) {
  423. if (! $task->{_installed}) {
  424. $task->{_install} = 1;
  425. }
  426. $task->{_selected} = 1;
  427. }
  428. foreach my $task (@list) {
  429. if (! $task->{_selected} && $task->{_installed}) {
  430. push @aptitude_remove, task_packages($task, 0);
  431. }
  432. }
  433. }
  434. # Mark dependnent packages for install if their dependencies are met.
  435. foreach my $task (@tasks) {
  436. if (! $task->{_install} && exists $task->{depends} && length $task->{depends} ) {
  437. $task->{_install} = 1;
  438. foreach my $dep (split(', ', $task->{depends})) {
  439. if (! grep { $_->{task} eq $dep && $_->{_install} } @tasks) {
  440. $task->{_install} = 0;
  441. }
  442. }
  443. }
  444. }
  445. # Add tasks to install and see if any selected task requires manual
  446. # selection.
  447. my @aptitude_install;
  448. my $manual_selection=0;
  449. foreach my $task (grep { $_->{_install} } @tasks) {
  450. push @aptitude_install, task_packages($task, 1);
  451. if ($task->{packages} eq 'manual') {
  452. $manual_selection=1;
  453. }
  454. }
  455. my $aptitude;
  456. if ($manual_selection) {
  457. # Manaul selection and task installs, as best
  458. # aptitude can do it currently. Disables use of
  459. # debconf-apt-progress.
  460. $aptitude="aptitude";
  461. }
  462. elsif (-x "/usr/bin/debconf-apt-progress") {
  463. $aptitude="debconf-apt-progress";
  464. $aptitude.=" --logfile $options{logfile}" if exists $options{logfile};
  465. $aptitude.=" --logstderr" if exists $options{logstderr};
  466. $aptitude.=" -- aptitude";
  467. }
  468. else {
  469. $aptitude="aptitude";
  470. }
  471. # Remove any packages we were asked to.
  472. if (@aptitude_remove) {
  473. if ($options{test}) {
  474. print "$aptitude -y remove ".join(" ", @aptitude_remove)."\n";
  475. }
  476. else {
  477. my $ret=system(split(' ', $aptitude), "-y", "remove", @aptitude_remove) >> 8;
  478. if ($ret != 0) {
  479. error gettext("aptitude failed")." ($ret)";
  480. }
  481. }
  482. }
  483. # And finally, act on selected tasks.
  484. if (@aptitude_install || $manual_selection) {
  485. # If the user selected no tasks and manual package
  486. # selection, run aptitude w/o the --visual-preview parameter.
  487. if (! @aptitude_install && $manual_selection) {
  488. if ($options{test}) {
  489. print "aptitude\n";
  490. }
  491. else {
  492. my $ret=system("aptitude") >> 8;
  493. if ($ret != 0) {
  494. error gettext("aptitude failed")." ($ret)";
  495. }
  496. }
  497. }
  498. else {
  499. if ($manual_selection) {
  500. unshift @aptitude_install, "--visual-preview";
  501. }
  502. if ($options{test}) {
  503. print "$aptitude --without-recommends -y install ".join(" ", @aptitude_install)."\n";
  504. }
  505. else {
  506. my $ret=system(split(' ', $aptitude), "--without-recommends", "-y", "install", @aptitude_install) >> 8;
  507. if ($ret != 0) {
  508. error gettext("aptitude failed");
  509. }
  510. }
  511. }
  512. }
  513. }
  514. main();