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.
 
 
 

329 lines
7.8 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 $descdir="/usr/share/tasksel";
  13. sub warning {
  14. print STDERR "tasksel: @_\n";
  15. }
  16. sub error {
  17. print STDERR "tasksel: @_\n";
  18. exit 1;
  19. }
  20. # A list of all available task desc files.
  21. sub list_task_descs {
  22. return glob "$descdir/*.desc";
  23. }
  24. # Returns a list of hashes; hash values are arrays for multi-line fields.
  25. sub read_task_desc {
  26. my $desc=shift;
  27. my @ret;
  28. open (DESC, "<$desc") || die "read $desc\: $!";
  29. local $/="\n\n";
  30. while (<DESC>) {
  31. my %data;
  32. my @lines=split("\n");
  33. while (@lines) {
  34. my $line=shift(@lines);
  35. if ($line=~/^([^ ]+): (.*)/) {
  36. my ($key, $value)=($1, $2);
  37. $key=lc($key);
  38. if (@lines && $lines[0] =~ /^\s+/) {
  39. # multi-line field
  40. my @values;
  41. if (length $value) {
  42. push @values, $value;
  43. }
  44. while (@lines && $lines[0] =~ /^\s+(.*)/) {
  45. push @values, $1;
  46. shift @lines;
  47. }
  48. $data{$key}=[@values];
  49. }
  50. else {
  51. $data{$key}=$value;
  52. }
  53. }
  54. else {
  55. print STDERR "parse error on line $.\n";
  56. }
  57. }
  58. if (%data) {
  59. $data{relevance}=5 unless exists $data{relevance};
  60. $data{shortdesc}=dgettext("debian-tasks", $data{description}->[0]);
  61. push @ret, \%data;
  62. }
  63. }
  64. close DESC;
  65. return @ret;
  66. }
  67. # Given a task name, returns a list of all available packages in the task.
  68. sub task_packages {
  69. my $task=shift;
  70. my @list;
  71. local $/="\n\n";
  72. open (AVAIL, "apt-cache dumpavail|");
  73. while (<AVAIL>) {
  74. if (/^Task: (.*)/m) {
  75. my @tasks=split(", ", $1);
  76. if (grep { $_ eq $task } @tasks) {
  77. push @list, $1 if /^Package: (.*)/m;
  78. }
  79. }
  80. }
  81. close AVAIL;
  82. return @list;
  83. }
  84. # Returns a list of all available packages.
  85. sub list_avail {
  86. my @list;
  87. # Might be better to use the perl apt bindings, but they are not
  88. # currently in base.
  89. open (AVAIL, "apt-cache dumpavail|");
  90. while (<AVAIL>) {
  91. chomp;
  92. if (/^Package: (.*)/) {
  93. push @list, $1;
  94. }
  95. }
  96. close AVAIL;
  97. return @list;
  98. }
  99. # Given a task hash, checks if its key packages are available.
  100. my %avail_pkgs;
  101. sub task_avail {
  102. local $_;
  103. my $task=shift;
  104. if (! ref $task->{key}) {
  105. return 1;
  106. }
  107. else {
  108. if (! %avail_pkgs) {
  109. foreach my $pkg (list_avail()) {
  110. $avail_pkgs{$pkg} = 1;
  111. }
  112. }
  113. foreach my $pkg (@{$task->{key}}) {
  114. if (! $avail_pkgs{$pkg}) {
  115. return 0;
  116. }
  117. }
  118. return 1;
  119. }
  120. }
  121. # Given a task hash, runs any test program specified in its data, and sets
  122. # the _display and _install fields to 1 or 0 depending on its result.
  123. sub task_test {
  124. my $task=shift;
  125. $task->{_display} = 1;
  126. $task->{_install} = 0;
  127. foreach my $test (grep /^test-.*/, keys %$task) {
  128. $test=~s/^test-//;
  129. if (-x "$testdir/$test") {
  130. my $ret=system("$testdir/$test", $task->{task}, split " ", $task->{"test-$test"}) >> 8;
  131. if ($ret == 0) {
  132. $task->{_display} = 0;
  133. $task->{_install} = 1;
  134. }
  135. elsif ($ret == 1) {
  136. $task->{_display} = 0;
  137. $task->{_install} = 0;
  138. }
  139. elsif ($ret == 2) {
  140. $task->{_display} = 1;
  141. $task->{_install} = 1;
  142. }
  143. elsif ($ret == 3) {
  144. $task->{_display} = 1;
  145. $task->{_install} = 0;
  146. }
  147. }
  148. }
  149. return $task;
  150. }
  151. # Hides a task and marks it not to be installed if it depends on other
  152. # tasks.
  153. sub hide_dependent_tasks {
  154. my $task=shift;
  155. if (exists $task->{depends} && length $task->{depends}) {
  156. $task->{_display} = 0;
  157. $task->{_install} = 0;
  158. }
  159. return $task;
  160. }
  161. # Converts a list of tasks into a debconf list of their short descriptions.
  162. sub task_to_debconf {
  163. join ", ", map {
  164. my $desc=$_->{shortdesc};
  165. if ($desc=~/, /) {
  166. warning("task ".$_->{task}." contains a comma in its short description: \"$desc\"");
  167. }
  168. $desc;
  169. } @_;
  170. }
  171. # Given a first parameter that is a debconf list of short descriptions of
  172. # tasks, and then a list of task hashes, returns a list of hashes for all
  173. # the tasks in the debconf list.
  174. sub debconf_to_task {
  175. my $list=shift;
  176. my %desc_to_task = map { $_->{shortdesc} => $_ } @_;
  177. return grep { defined } map { $desc_to_task{$_} } split ", ", $list;
  178. }
  179. # Orders a list of tasks for display.
  180. sub order_for_display {
  181. sort {
  182. $b->{relevance} <=> $a->{relevance}
  183. || 0 ||
  184. $a->{section} cmp $b->{section}
  185. || 0 ||
  186. $a->{shortdesc} cmp $b->{shortdesc}
  187. } @_;
  188. }
  189. # Process command line options.
  190. sub getopts {
  191. my %ret;
  192. Getopt::Long::Configure ("bundling");
  193. if (! GetOptions(\%ret, "test|t", "required|r", "important|i",
  194. "standard|s", "no-ui|n", "new-install", "list-tasks",
  195. "task-packages=s")) {
  196. usage();
  197. exit(1);
  198. }
  199. return %ret;
  200. }
  201. sub usage {
  202. print STDERR gettext(q{Usage:
  203. tasksel install <task>
  204. tasksel [options]; where options is any combination of:
  205. -t, --test test mode; don't really do anything
  206. -r, --required install all required-priority packages
  207. -i, --important install all important-priority packages
  208. -s, --standard install all standard-priority packages
  209. -n, --no-ui don't show UI; use with -r or -i usually
  210. --new-install atomatically install some tasks
  211. --list-tasks list tasks that would be displayed and exit
  212. --task-packages list available packages in a task
  213. });
  214. }
  215. my @aptitude_install;
  216. my @tasks_to_install;
  217. my %options=getopts();
  218. if (exists $options{"task-packages"}) {
  219. print "$_\n" foreach task_packages($options{"task-packages"});
  220. exit(0);
  221. }
  222. if (@ARGV) {
  223. if ($ARGV[0] eq "install") {
  224. shift;
  225. push @aptitude_install, map { "~t$_" } @ARGV;
  226. }
  227. else {
  228. usage();
  229. exit 1;
  230. }
  231. }
  232. my @tasks=map { hide_dependent_tasks($_) } map { task_test($_) }
  233. grep { task_avail($_) } map { read_task_desc($_) }
  234. list_task_descs();
  235. if ($options{"list-tasks"}) {
  236. print $_->{task}."\t".$_->{shortdesc}."\n"
  237. foreach grep { $_->{_display} } @tasks;
  238. exit(0);
  239. }
  240. if (! $options{"new-install"}) {
  241. # Don't install hidden tasks if this is not a new install.
  242. map { $_->{_install} = 0 } grep { $_->{_display} == 0 } @tasks;
  243. }
  244. if ($options{"required"}) {
  245. push @aptitude_install, "~prequired";
  246. }
  247. if ($options{"important"}) {
  248. push @aptitude_install, "~pimportant";
  249. }
  250. if ($options{"standard"}) {
  251. push @aptitude_install, "~pstandard";
  252. }
  253. my @list = order_for_display(grep { $_->{_display} == 1 } @tasks);
  254. map { $_->{_install} = 0 } @list; # don't install displayed tasks unless selected
  255. if (@list && ! $options{"no-ui"}) {
  256. my $question="tasksel/tasks";
  257. if ($options{"new-install"}) {
  258. $question="tasksel/first";
  259. }
  260. my @default = grep { $_->{_display} == 1 && $_->{_install} == 1 } @tasks;
  261. my $tmpfile=`tempfile`;
  262. chomp $tmpfile;
  263. system($debconf_helper, $tmpfile, task_to_debconf(@list),
  264. task_to_debconf(@default), $question);
  265. open(IN, "<$tmpfile");
  266. my $ret=<IN>;
  267. chomp $ret;
  268. close IN;
  269. unlink $tmpfile;
  270. map { $_->{_install} = 1 } debconf_to_task($ret, @tasks);
  271. if (! $options{test} && $ret=~/manual package selection/) {
  272. # Doing better than this calls for a way to queue stuff for
  273. # install in aptitude and then enter interactive mode.
  274. my $ret=system("aptitude") >> 8;
  275. if ($ret != 0) {
  276. error gettext("aptitude failed");
  277. }
  278. }
  279. }
  280. # Mark dependnent packages for install if their dependencies are met.
  281. foreach my $task (@tasks) {
  282. if (! $task->{_install} && exists $task->{depends} && length $task->{depends} ) {
  283. $task->{_install} = 1;
  284. foreach my $dep (split(', ', $task->{depends})) {
  285. if (! grep { $_->{task} eq $dep && $_->{_install} } @tasks) {
  286. $task->{_install} = 0;
  287. }
  288. }
  289. }
  290. }
  291. push @aptitude_install, map { "~t".$_->{task} } grep { $_->{_install} } @tasks;
  292. if (@aptitude_install) {
  293. if ($options{test}) {
  294. print "aptitude --without-recommends -y install ".join(" ", @aptitude_install)."\n";
  295. }
  296. else {
  297. my $ret=system("aptitude", "--without-recommends", "-y", "install", @aptitude_install) >> 8;
  298. if ($ret != 0) {
  299. error gettext("aptitude failed");
  300. }
  301. }
  302. }