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.
 
 
 

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