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.
 
 
 

649 lines
16 KiB

  1. #!/usr/bin/perl
  2. # Debian task selector, mark II.
  3. # Copyright 2004-2011 by Joey Hess <joeyh@debian.org>.
  4. # Licensed under the GPL, version 2 or higher.
  5. use 5.014;
  6. use Locale::gettext;
  7. use Getopt::Long;
  8. use warnings;
  9. use strict;
  10. textdomain('tasksel');
  11. my $debconf_helper="/usr/lib/tasksel/tasksel-debconf";
  12. my $testdir="/usr/lib/tasksel/tests";
  13. my $packagesdir="/usr/lib/tasksel/packages";
  14. my $descdir="/usr/share/tasksel/descs";
  15. my $localdescdir="/usr/local/share/tasksel/descs";
  16. my $statusfile="/var/lib/dpkg/status";
  17. my $infodir="/usr/lib/tasksel/info";
  18. my $testmode=0;
  19. my $taskpackageprefix="task-";
  20. sub warning {
  21. print STDERR "tasksel: @_\n";
  22. }
  23. sub error {
  24. print STDERR "tasksel: @_\n";
  25. exit 1;
  26. }
  27. # Run a shell command except in test mode, and returns its exit code.
  28. # Prints the command in test mode. Parameters should be pre-split for
  29. # system.
  30. sub run {
  31. if ($testmode) {
  32. print join(" ", @_)."\n";
  33. return 0;
  34. }
  35. else {
  36. return system(@_) >> 8;
  37. }
  38. }
  39. # A list of all available task desc files.
  40. sub list_task_descs {
  41. return glob("$descdir/*.desc"), glob("$localdescdir/*.desc");
  42. }
  43. # Returns a list of hashes; hash values are arrays for multi-line fields.
  44. sub read_task_desc {
  45. my $desc=shift;
  46. my @ret;
  47. open (DESC, "<$desc") || die "read $desc\: $!";
  48. local $/="\n\n";
  49. while (<DESC>) {
  50. my %data;
  51. my @lines=split("\n");
  52. while (@lines) {
  53. my $line=shift(@lines);
  54. if ($line=~/^([^ ]+):(?: (.*))?/) {
  55. my ($key, $value)=($1, $2);
  56. $key=lc($key);
  57. if (@lines && $lines[0] =~ /^\s+/) {
  58. # multi-line field
  59. my @values;
  60. if (defined $value && length $value) {
  61. push @values, $value;
  62. }
  63. while (@lines && $lines[0] =~ /^\s+(.*)/) {
  64. push @values, $1;
  65. shift @lines;
  66. }
  67. $data{$key}=[@values];
  68. }
  69. else {
  70. $data{$key}=$value;
  71. }
  72. }
  73. else {
  74. warning "parse error in stanza $. of $desc";
  75. }
  76. }
  77. if (%data) {
  78. $data{relevance}=5 unless exists $data{relevance};
  79. push @ret, \%data;
  80. }
  81. }
  82. close DESC;
  83. return @ret;
  84. }
  85. # Loads info for all tasks, and returns a set of task structures.
  86. sub all_tasks {
  87. my %seen;
  88. grep { $seen{$_->{task}}++; $seen{$_->{task}} < 2 }
  89. map { read_task_desc($_) } list_task_descs();
  90. }
  91. sub _info_avail {
  92. my %ret = ();
  93. # Might be better to use the perl apt bindings, but they are not
  94. # currently in base.
  95. open (AVAIL, "apt-cache dumpavail|");
  96. local $_;
  97. my ($package, $section, $priority);
  98. while (<AVAIL>) {
  99. chomp;
  100. if (not $_) {
  101. if (defined $package && defined $priority && defined $section) {
  102. $ret{$package} = {
  103. "priority" => $priority,
  104. "section" => $section,
  105. };
  106. }
  107. }
  108. elsif (/^Package: (.*)/) {
  109. $package = $1;
  110. }
  111. elsif (/^Priority: (.*)/) {
  112. $priority = $1;
  113. }
  114. elsif (/^Section: (.*)/) {
  115. $section = $1;
  116. }
  117. }
  118. close AVAIL;
  119. return %ret;
  120. }
  121. # Returns a list of all installed packages.
  122. sub list_installed {
  123. my @list;
  124. open (LIST, q{LANG=C dpkg-query -W -f='${Package} ${Status}\n' |});
  125. while (<LIST>) {
  126. if (/^([^ ]+) .* installed$/m) {
  127. push @list, $1;
  128. }
  129. }
  130. close LIST;
  131. return @list;
  132. }
  133. my %_info_avail_cache;
  134. # Returns a hash of all available packages.
  135. sub info_avail {
  136. my $package = shift;
  137. if (!%_info_avail_cache) {
  138. %_info_avail_cache = _info_avail();
  139. }
  140. return \%_info_avail_cache;
  141. }
  142. # Given a package name, checks to see if it's available. Memoised.
  143. sub package_avail {
  144. my $package = shift;
  145. return info_avail()->{$package} || package_installed($package);
  146. }
  147. my %installed_pkgs;
  148. # Given a package name, checks to see if it's installed. Memoised.
  149. sub package_installed {
  150. my $package=shift;
  151. if (! %installed_pkgs) {
  152. foreach my $pkg (list_installed()) {
  153. $installed_pkgs{$pkg} = 1;
  154. }
  155. }
  156. return $installed_pkgs{$package};
  157. }
  158. # Given a task hash, checks if its key packages are available.
  159. sub task_avail {
  160. local $_;
  161. my $task=shift;
  162. if (! ref $task->{key}) {
  163. return 1;
  164. }
  165. else {
  166. foreach my $pkg (@{$task->{key}}) {
  167. if (! package_avail($pkg)) {
  168. return 0;
  169. }
  170. }
  171. return 1;
  172. }
  173. }
  174. # Given a task hash, checks to see if it is already installed.
  175. # (All of its key packages must be installed.)
  176. sub task_installed {
  177. local $_;
  178. my $task=shift;
  179. if (! ref $task->{key}) {
  180. return 0; # can't tell with no key packages
  181. }
  182. else {
  183. foreach my $pkg (@{$task->{key}}) {
  184. if (! package_installed($pkg)) {
  185. return 0;
  186. }
  187. }
  188. return 1;
  189. }
  190. }
  191. # Given task hash, returns a list of all available packages in the task.
  192. sub task_packages {
  193. my $task=shift;
  194. my %list;
  195. # key packages are always included
  196. if (ref $task->{key}) {
  197. map { $list{$_}=1 } @{$task->{key}};
  198. }
  199. if (! defined $task->{packages}) {
  200. # only key
  201. }
  202. elsif ($task->{packages} eq 'standard') {
  203. my %info_avail=%{info_avail()};
  204. while (my ($package, $info) = each(%info_avail)) {
  205. my ($priority, $section) = ($info->{priority}, $info->{section});
  206. if (($priority eq 'required' ||
  207. $priority eq 'important' ||
  208. $priority eq 'standard') &&
  209. # Exclude packages in non-main and library sections
  210. $section !~ /^lib|\// &&
  211. # Exclude already installed packages
  212. !package_installed($package)) {
  213. $list{$package} = 1;
  214. }
  215. }
  216. }
  217. else {
  218. # external method
  219. my ($method, @params);
  220. if (ref $task->{packages}) {
  221. @params=@{$task->{packages}};
  222. $method=shift @params;
  223. }
  224. else {
  225. $method=$task->{packages};
  226. }
  227. map { $list{$_}=1 }
  228. grep { package_avail($_) }
  229. split(' ', `$packagesdir/$method $task->{task} @params`);
  230. }
  231. return keys %list;
  232. }
  233. # Given a task hash, runs any test program specified in its data, and sets
  234. # the _display and _install fields to 1 or 0 depending on its result.
  235. sub task_test {
  236. my $task=shift;
  237. my $new_install=shift;
  238. $task->{_display} = shift; # default
  239. $task->{_install} = shift; # default
  240. $ENV{NEW_INSTALL}=$new_install if defined $new_install;
  241. foreach my $test (grep /^test-.*/, keys %$task) {
  242. $test=~s/^test-//;
  243. if (-x "$testdir/$test") {
  244. my $ret=system("$testdir/$test", $task->{task}, split " ", $task->{"test-$test"}) >> 8;
  245. if ($ret == 0) {
  246. $task->{_display} = 0;
  247. $task->{_install} = 1;
  248. }
  249. elsif ($ret == 1) {
  250. $task->{_display} = 0;
  251. $task->{_install} = 0;
  252. }
  253. elsif ($ret == 2) {
  254. $task->{_display} = 1;
  255. $task->{_install} = 1;
  256. }
  257. elsif ($ret == 3) {
  258. $task->{_display} = 1;
  259. $task->{_install} = 0;
  260. }
  261. }
  262. }
  263. delete $ENV{NEW_INSTALL};
  264. return $task;
  265. }
  266. # Hides a task and marks it not to be installed if it enhances other
  267. # tasks.
  268. sub hide_enhancing_tasks {
  269. my $task=shift;
  270. if (exists $task->{enhances} && length $task->{enhances}) {
  271. $task->{_display} = 0;
  272. $task->{_install} = 0;
  273. }
  274. return $task;
  275. }
  276. # Looks up the descriptions of a set of tasks, returning a new list
  277. # with the shortdesc fields filled in.
  278. sub getdescriptions {
  279. my @tasks=@_;
  280. # If the task has a description field in the task desc file,
  281. # just use it, looking up a translation in gettext.
  282. @tasks = map {
  283. if (defined $_->{description}) {
  284. $_->{shortdesc}=dgettext("debian-tasks", $_->{description}->[0]);
  285. }
  286. $_;
  287. } @tasks;
  288. # Otherwise, a more expensive apt-cache query is done,
  289. # to use the descriptions of task packages.
  290. my @todo = grep { ! defined $_->{shortdesc} } @tasks;
  291. if (@todo) {
  292. open(APT_CACHE, "apt-cache show ".join(" ", map { $taskpackageprefix.$_->{task} } @todo)." |") || die "apt-cache show: $!";
  293. local $/="\n\n";
  294. while (<APT_CACHE>) {
  295. my ($name)=/^Package: $taskpackageprefix(.*)$/m;
  296. my ($description)=/^Description-(?:[a-z][a-z](?:_[A-Z][A-Z])?): (.*)$/m;
  297. ($description)=/^Description: (.*)$/m
  298. unless defined $description;
  299. if (defined $name && defined $description) {
  300. @tasks = map {
  301. if ($_->{task} eq $name) {
  302. $_->{shortdesc}=$description;
  303. }
  304. $_;
  305. } @tasks;
  306. }
  307. }
  308. close APT_CACHE;
  309. }
  310. return @tasks;
  311. }
  312. # Converts a list of tasks into a debconf list of the task short
  313. # descriptions.
  314. sub task_to_debconf {
  315. join ", ", map { my $d=$_->{shortdesc}; $d=~s/,/\\,/g; $d } getdescriptions(@_);
  316. }
  317. # Converts a list of tasks into a debconf list of the task names.
  318. sub task_to_debconf_C {
  319. join ", ", map { $_->{task} } @_;
  320. }
  321. # Given a first parameter that is a string listing task names, and then a
  322. # list of task hashes, returns a list of hashes for all the tasks
  323. # in the list.
  324. sub list_to_tasks {
  325. my $list=shift;
  326. my %lookup = map { $_->{task} => $_ } @_;
  327. return grep { defined } map { $lookup{$_} } split /[, ]+/, $list;
  328. }
  329. # Orders a list of tasks for display.
  330. sub order_for_display {
  331. sort {
  332. $b->{relevance} <=> $a->{relevance}
  333. || 0 ||
  334. $a->{section} cmp $b->{section}
  335. || 0 ||
  336. $a->{task} cmp $b->{task}
  337. } @_;
  338. }
  339. # Given a set of tasks and a name, returns the one with that name.
  340. sub name_to_task {
  341. my $name=shift;
  342. return (grep { $_->{task} eq $name } @_)[0];
  343. }
  344. sub task_script {
  345. my $task=shift;
  346. my $script=shift;
  347. my $path="$infodir/$task.$script";
  348. if (-e $path && -x _) {
  349. my $ret=run($path);
  350. if ($ret != 0) {
  351. warning("$path exited with nonzero code $ret");
  352. return 0;
  353. }
  354. }
  355. return 1;
  356. }
  357. sub usage {
  358. print STDERR gettext(q{Usage:
  359. tasksel install <task>...
  360. tasksel remove <task>...
  361. tasksel [options]
  362. -t, --test test mode; don't really do anything
  363. --new-install automatically install some tasks
  364. --list-tasks list tasks that would be displayed and exit
  365. --task-packages list available packages in a task
  366. --task-desc returns the description of a task
  367. });
  368. }
  369. # Process command line options and return them in a hash.
  370. sub getopts {
  371. my %ret;
  372. Getopt::Long::Configure ("bundling");
  373. if (! GetOptions(\%ret, "test|t", "new-install", "list-tasks",
  374. "task-packages=s@", "task-desc=s",
  375. "debconf-apt-progress=s")) {
  376. usage();
  377. exit(1);
  378. }
  379. # Special case apt-like syntax.
  380. if (@ARGV) {
  381. my $cmd = shift @ARGV;
  382. if ($cmd eq "install") {
  383. $ret{cmd_install} = \@ARGV;
  384. }
  385. elsif ($cmd eq "remove") {
  386. $ret{cmd_remove} = \@ARGV;
  387. }
  388. else {
  389. usage();
  390. exit 1;
  391. }
  392. }
  393. $testmode=1 if $ret{test}; # set global
  394. return %ret;
  395. }
  396. sub interactive {
  397. my $options = shift;
  398. my @tasks = @_;
  399. if (! $options->{"new-install"}) {
  400. # Don't install hidden tasks if this is not a new install.
  401. map { $_->{_install} = 0 } grep { $_->{_display} == 0 } @tasks;
  402. }
  403. my @list = order_for_display(grep { $_->{_display} == 1 } @tasks);
  404. if (@list) {
  405. if (! $options->{"new-install"}) {
  406. # Find tasks that are already installed.
  407. map { $_->{_installed} = task_installed($_) } @list;
  408. # Don't install new tasks unless manually selected.
  409. map { $_->{_install} = 0 } @list;
  410. }
  411. else {
  412. # Assume that no tasks are installed, to ensure
  413. # that complete tasks get installed on new
  414. # installs.
  415. map { $_->{_installed} = 0 } @list;
  416. }
  417. my $question="tasksel/tasks";
  418. if ($options->{"new-install"}) {
  419. $question="tasksel/first";
  420. }
  421. my @default = grep { $_->{_display} == 1 && ($_->{_install} == 1 || $_->{_installed} == 1) } @tasks;
  422. my $tmpfile=`tempfile`;
  423. chomp $tmpfile;
  424. my $ret=system($debconf_helper, $tmpfile,
  425. task_to_debconf_C(@list),
  426. task_to_debconf(@list),
  427. task_to_debconf_C(@default),
  428. $question) >> 8;
  429. if ($ret == 30) {
  430. exit 10; # back up
  431. }
  432. elsif ($ret != 0) {
  433. error "debconf failed to run";
  434. }
  435. open(IN, "<$tmpfile");
  436. $ret=<IN>;
  437. if (! defined $ret) {
  438. die "tasksel canceled\n";
  439. }
  440. chomp $ret;
  441. close IN;
  442. unlink $tmpfile;
  443. # Set _install flags based on user selection.
  444. map { $_->{_install} = 0 } @list;
  445. foreach my $task (list_to_tasks($ret, @tasks)) {
  446. if (! $task->{_installed}) {
  447. $task->{_install} = 1;
  448. }
  449. $task->{_selected} = 1;
  450. }
  451. foreach my $task (@list) {
  452. if (! $task->{_selected} && $task->{_installed}) {
  453. $task->{_remove} = 1;
  454. }
  455. }
  456. }
  457. # If an enhancing task is already marked for
  458. # install, probably by preseeding, mark the tasks
  459. # it enhances for install.
  460. foreach my $task (grep { $_->{_install} && exists $_->{enhances} &&
  461. length $_->{enhances} } @tasks) {
  462. map { $_->{_install}=1 } list_to_tasks($task->{enhances}, @tasks);
  463. }
  464. # Select enhancing tasks for install.
  465. # XXX FIXME ugly hack -- loop until enhances settle to handle
  466. # chained enhances. This is ugly and could loop forever if
  467. # there's a cycle.
  468. my $enhances_needswork=1;
  469. my %tested;
  470. while ($enhances_needswork) {
  471. $enhances_needswork=0;
  472. foreach my $task (grep { ! $_->{_install} && exists $_->{enhances} &&
  473. length $_->{enhances} } @tasks) {
  474. my %tasknames = map { $_->{task} => $_ } @tasks;
  475. my @deps=map { $tasknames{$_} } split ", ", $task->{enhances};
  476. if (grep { ! defined $_ } @deps) {
  477. # task enhances an unavailable or
  478. # uninstallable task
  479. next;
  480. }
  481. if (@deps) {
  482. my $orig_state=$task->{_install};
  483. # Mark enhancing tasks for install if their
  484. # dependencies are met and their test fields
  485. # mark them for install.
  486. if (! exists $tested{$task->{task}}) {
  487. $ENV{TESTING_ENHANCER}=1;
  488. task_test($task, $options->{"new-install"}, 0, 1);
  489. delete $ENV{TESTING_ENHANCER};
  490. $tested{$task->{task}}=$task->{_install};
  491. }
  492. else {
  493. $task->{_install}=$tested{$task->{task}};
  494. }
  495. foreach my $dep (@deps) {
  496. if (! $dep->{_install}) {
  497. $task->{_install} = 0;
  498. }
  499. }
  500. if ($task->{_install} != $orig_state) {
  501. $enhances_needswork=1;
  502. }
  503. }
  504. }
  505. }
  506. }
  507. sub main {
  508. my %options=getopts();
  509. my @tasks_remove;
  510. my @tasks_install;
  511. # Options that output stuff and don't need a full processed list of
  512. # tasks.
  513. if (exists $options{"task-packages"}) {
  514. my @tasks=all_tasks();
  515. foreach my $taskname (@{$options{"task-packages"}}) {
  516. my $task=name_to_task($taskname, @tasks);
  517. if ($task) {
  518. print "$_\n" foreach task_packages($task);
  519. }
  520. }
  521. exit(0);
  522. }
  523. elsif ($options{"task-desc"}) {
  524. my $task=name_to_task($options{"task-desc"}, all_tasks());
  525. if ($task) {
  526. my $extdesc=join(" ", @{$task->{description}}[1..$#{$task->{description}}]);
  527. print dgettext("debian-tasks", $extdesc)."\n";
  528. exit(0);
  529. }
  530. else {
  531. exit(1);
  532. }
  533. }
  534. # This is relatively expensive, get the full list of available tasks and
  535. # mark them.
  536. my @tasks=map { hide_enhancing_tasks($_) } map { task_test($_, $options{"new-install"}, 1, 0) }
  537. grep { task_avail($_) } all_tasks();
  538. if ($options{"list-tasks"}) {
  539. map { $_->{_installed} = task_installed($_) } @tasks;
  540. @tasks=getdescriptions(@tasks);
  541. print "".($_->{_installed} ? "i" : "u")." ".$_->{task}."\t".$_->{shortdesc}."\n"
  542. foreach order_for_display(grep { $_->{_display} } @tasks);
  543. exit(0);
  544. }
  545. if ($options{cmd_install}) {
  546. @tasks_install = map { name_to_task($_, @tasks) } @{$options{cmd_install}};
  547. }
  548. elsif ($options{cmd_remove}) {
  549. @tasks_remove = map { name_to_task($_, @tasks) } @{$options{cmd_remove}};
  550. }
  551. else {
  552. interactive(\%options, @tasks);
  553. # Add tasks to install
  554. @tasks_install = grep { $_->{_install} } @tasks;
  555. # Add tasks to remove
  556. @tasks_remove = grep { $_->{_remove} } @tasks;
  557. }
  558. my @cmd;
  559. if (-x "/usr/bin/debconf-apt-progress") {
  560. @cmd = "debconf-apt-progress";
  561. push @cmd, split(' ', $options{'debconf-apt-progress'})
  562. if exists $options{'debconf-apt-progress'};
  563. push @cmd, "--";
  564. }
  565. push @cmd, qw{apt-get -q -y -o APT::Install-Recommends=true -o APT::Get::AutomaticRemove=true install};
  566. # And finally, act on selected tasks.
  567. if (@tasks_install || @tasks_remove) {
  568. foreach my $task (@tasks_remove) {
  569. push @cmd, map { "$_-" } task_packages($task);
  570. task_script($task->{task}, "prerm");
  571. }
  572. foreach my $task (@tasks_install) {
  573. push @cmd, task_packages($task);
  574. task_script($task->{task}, "preinst");
  575. }
  576. my $ret=run(@cmd);
  577. if ($ret != 0) {
  578. error gettext("apt-get failed")." ($ret)";
  579. }
  580. foreach my $task (@tasks_remove) {
  581. task_script($task->{task}, "postrm");
  582. }
  583. foreach my $task (@tasks_install) {
  584. task_script($task->{task}, "postinst");
  585. }
  586. }
  587. }
  588. main();