1 #!/usr/bin/env perl
2 #
3 # pkg-get - A binary package management utility for CRUX Linux
4 # Copyright (C) 2004-2006 Simone Rota <sip@varlock.com>
5 # Copyright (c) 2006-2013 by CRUX team (http://crux.nu)
6 #
7 # This program is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 2 of the License, or
10 # (at your option) any later version.
11
12 use warnings;
13 use strict;
14 use Getopt::Long;
15
16 my $VERSION = "0.4.6";
17 my $CFGFILE = "/etc/pkg-get.conf";
18 my $LOCKFILE = "/var/lib/pkg/pkg-get.locker";
19 my $PKGDB = "/var/lib/pkg/db" ;
20
21 $SIG{HUP} = \&trap; $SIG{INT} = \&trap; $SIG{QUIT} = \&trap; $SIG{TERM} = \&trap;
22
23 # Global vars
24 my @repos = (); # package repositories
25 my @donetasks; my @failtasks; my @prevtasks; my %pptasks; my %readmetasks;
26 my $curraction = ""; my %installed; my %deps; my @dependencies; my %missingdeps;
27
28 # CL Options
29 my $download_only; my $pre_install; my $post_install;
30 my $install_scripts; my $filter = ""; my $all; my $unused;
31 my $aargs=""; my $ignore_md5sum; my $force; my $root;
32 GetOptions("do"=>\$download_only,
33 "pre-install"=>\$pre_install, "post-install"=>\$post_install,
34 "install-scripts"=>\$install_scripts, "all"=>\$all,
35 "filter=s"=>\$filter, "config=s"=>\$CFGFILE, "aargs=s"=>\$aargs,
36 "f"=>\$force, "im"=>\$ignore_md5sum, "margs=s"=>\$unused,
37 "rargs=s"=>\$unused, "r=s"=>\$root);
38
39 # use compression-mode defined in pkgmk.conf
40 our $compress = "gz";
41 open CONFIG, "/etc/pkgmk.conf" or die "Could not open /etc/pkgmk.conf";
42 while (<CONFIG>) {
43 $compress = $1 if m/^PKGMK_COMPRESSION_MODE="(.*)"\n/;
44 }
45 close CONFIG;
46
47 if ($root) {
48 $LOCKFILE = $root.$LOCKFILE ;
49 $PKGDB = $root.$PKGDB;
50 }
51
52 # Get command, verify it's valid
53 my $command = getcommand(@ARGV);
54 if (index($command,"Error: ") eq 0 ) {
55 $command =~ s/Error\: //;
56 exiterr($command);
57 }
58 readconfig();
59
60 SWITCH: {
61 if ($command eq "version") { version(); last SWITCH; }
62 if ($command eq "sync") { sync(); last SWITCH; }
63 if ($command eq "info") { info(); last SWITCH; }
64 if ($command eq "help") { help(); last SWITCH; }
65 if ($command eq "readme") { readme(); last SWITCH; }
66 if ($command eq "search") { search(); last SWITCH; }
67 if ($command eq "dsearch") { dsearch(); last SWITCH; }
68 if ($command eq "list") { list(); last SWITCH; }
69 if ($command eq "path") { path(); last SWITCH; }
70 if ($command eq "remove") { remove(); last SWITCH; }
71 if ($command eq "listinst") { listinst(); last SWITCH; }
72 if ($command eq "lock") { dolock(); last SWITCH; }
73 if ($command eq "unlock") { unlock(); last SWITCH; }
74 if ($command eq "listlocked") { listlocked(); last SWITCH; }
75 if ($command eq "printf") { doprintf(); last SWITCH; }
76 if ($command eq "isinst") { isinst(); last SWITCH; }
77 if ($command eq "diff") { diff(); last SWITCH; }
78 if ($command eq "quickdiff") { quickdiff(); last SWITCH; }
79 if ($command eq "dup") { dup(); last SWITCH; }
80 if ($command eq "depends") { depends(); last SWITCH; }
81 if ($command eq "quickdep") { quickdep(); last SWITCH; }
82 if ($command eq "install") { install(@ARGV); last SWITCH; }
83 if ($command eq "update") { update(@ARGV); last SWITCH; }
84 if ($command eq "sysup") { sysup(); last SWITCH; }
85 if ($command eq "dependent") { dependent(); last SWITCH; }
86 if ($command eq "depinst") { depinst(); last SWITCH; }
87 if ($command eq "current") { current(); last SWITCH; }
88 }
89
90
91 ############################################################################
92 # Support functions
93 ############################################################################
94
95 # Exit with error
96 sub exiterr {
97 my ($msg) = @_;
98 print "pkg-get: $msg\n";
99 exit 1;
100 }
101
102 sub trap {
103 printresults(1);
104 die("\npkg-get: interrupted\n");
105 }
106
107 # Get command, return an error if not in the list of allowed commands
108 sub getcommand {
109 my @args = @_;
110 my $givencmd = $args[0];
111 my $givenarg = $args[1];
112 if (not $givenarg){$givenarg = ""};
113 if (not $givencmd){$givencmd = ""};
114 my @allowed = ("depinst:", "install:", "sysup", "diff", "update:", "depends:", "info:", "sync",
115 "version", "help", "quickdep:", "dependent:", "list", "listinst", "isinst:",
116 "search:", "dsearch:", "lock:", "unlock:", "listlocked", "quickdiff", "printf:",
117 "remove:", "readme:", "dup", "path:", "current:");
118
119 foreach my $valid(@allowed) {
120 if ($givencmd eq ""){
121 return "Error: no command given. try pkg-get help for more information";
122 }
123 if ($givencmd eq $valid) {
124 return $givencmd;
125 } elsif ($givencmd.":" eq $valid) {
126 if ($givenarg ne "") {
127 return $givencmd;
128 } else {
129 return "Error: '$givencmd' requires an argument";
130 }
131 }
132 }
133 return "Error: unknown command '$givencmd'. try pkg-get help for more information";
134 }
135
136 # Parses the configuration file
137 sub readconfig {
138 open(CFG, $CFGFILE)
139 or exiterr("could not open $CFGFILE");
140 while (<CFG>) {
141 chomp;
142 if ( /^pkgdir\s+/ ) {
143 my $repo = $_;
144 $repo =~ s/^pkgdir\s+//;
145 $repo =~ s/#(.*)$//;
146 $repo =~ s/\s+$//;
147 push @repos, $repo;
148 } elsif (/^runscripts\s+/) {
149 my $rs = $_;
150 $rs =~ s/^runscripts\s+//;
151 $rs =~ s/#(.*)$//;
152 $rs =~ s/\s+$//;
153 if ($rs eq "yes") {$install_scripts = 1};
154 }
155 }
156 close(CFG);
157 }
158
159 # Parse a line describing a package
160 sub parsepackage {
161 my @p = split(/\:/, $_[0]);
162 if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
163 my %pkg;
164 my $name = $p[0];
165 $name =~ s/\#.*$//;
166 my $version = $p[0];
167 $version =~ s/^.*\#//;
168 $version =~ s/-\w*\.pkg\.tar\.[gbx]z*//;
169 my $release = $p[0];
170 $release =~ s/^.*-//;
171 $release =~ s/\.pkg\.tar\.[gbx]z*//;
172 if (not $_[2]) {$_[2] = $_[1]};
173 $pkg{'name'} = $name;
174 $pkg{'version'} = $version;
175 $pkg{'release'} = $release;
176 $pkg{'path'} = $_[1];
177 $pkg{'url'} = $_[2] . "/$p[0]";
178 $pkg{'size'} = $p[1];
179 $pkg{'md5sum'} = $p[2];
180 $pkg{'description'} = $p[3];
181 $pkg{'pre_install'} = $p[4];
182 $pkg{'post_install'} = $p[5];
183 $pkg{'readme'} = $p[6];
184 if ($_[3] == 1) {
185 getinstalled();
186 $pkg{'instversion'} = $installed{$name};
187 }
188 return %pkg;
189 }
190
191 # Parse a line describing a package (just the name)
192 sub parsepackagelight {
193 my @p = split(/\:/, $_[0]);
194 if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
195 my %pkg;
196 my $name = $p[0];
197 $name =~ s/\#.*$//;
198 $pkg{'name'} = $name;
199 return %pkg;
200 }
201
202 # Print info about the given package
203 sub printinfo {
204 my %pkg = @_;
205 print "Name : " . $pkg{'name'} . "\n";
206 print "Version : " . $pkg{'version'} . "\n";
207 print "Release : " . $pkg{'release'} . "\n";
208 print "Description : " . $pkg{'description'} . "\n";
209 print "URL : " . $pkg{'url'} . "\n";
210 print "Md5sum : " . $pkg{'md5sum'} . "\n";
211 print "Size : " . $pkg{'size'} . "\n";
212 my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'});
213 if ($deps ne "") { print "Depends on : $deps\n";};
214 my $files = "";
215 if ($pkg{'readme'} eq "yes") {$files .= "README,"};
216 if ($pkg{'pre_install'} eq "yes") {$files .= "pre-install,"};
217 if ($pkg{'post_install'} eq "yes") {$files .= "post-install,"};
218 $files =~ s/\,$//;
219 if ($files ne "") { print "Files : $files\n";};
220 }
221
222 # Get direct dependencies for package
223 sub getdirectdeps {
224 my $pkgname = $_[0];
225 my $dir = $_[1];
226 open(DEPS, "$dir/PKGDEPS")
227 or exiterr("could not open $dir/PKGDEPS");
228 while (<DEPS>) {
229 chomp;
230 if ( /^\Q$pkgname\E\s+/ ) {
231 my $dep = $_;
232 $dep =~ s/^.*\: //;
233 close(DEPS);
234 return $dep;
235 }
236 }
237 close(DEPS);
238 return "";
239 }
240
241 # Prints the README file to stdout
242 sub printreadme {
243 my %pkg = @_;
244 my $dir = $pkg{'path'};
245 my $pkgname = $pkg{'name'};
246 my $found = 0;
247 my $finished = 0;
248 open(READ, "$dir/PKGREAD")
249 or exiterr("could not open $dir/PKGREAD");
250 while (<READ>) {
251 if ($finished eq 1) {return;};
252 chomp;
253 if ($found eq 1) {
254 if ( /PKGREADME\:/ ) {
255 $finished = 1;
256 close(READ);
257 return;
258 } else {
259 print "$_\n";
260 }
261 }
262 if ($finished eq 0) {
263 if ( /PKGREADME: $pkgname$/ ) {
264 $found = 1;
265 }
266 }
267 }
268 close(READ);
269 }
270
271 # Print results for multiple package operations
272 sub printresults {
273 my $okaction = $curraction;
274 my $curr = "";
275 my $action;
276 my $pkg;
277 my @t;
278 my @readme;
279 my $goterror = 0;
280 if (@donetasks) {
281 print "\n-- Packages $okaction\n";
282 foreach my $task(@donetasks) {
283 if ($readmetasks{$task}) {push(@readme, $task)}
284 print "$task" . $pptasks{$task}."\n";
285 }
286 }
287 if (@prevtasks) {
288 if ($okaction eq "installed") {
289 print "\n-- Packages installed before this run (ignored)\n";
290 } else {
291 print "\n-- Packages not previously installed (ignored)\n";
292 }
293 foreach my $task(@prevtasks) {
294 print "$task\n";
295 }
296 }
297 if (@failtasks) {
298 @failtasks = sort(@failtasks);
299 foreach my $task(@failtasks) {
300 @t = split(/,/,$task);
301 $action = $t[0];
302 $pkg = $t[1];
303 if ($curr ne $action) {
304 print "\n-- Packages $action\n";
305 $curr = $action;
306 }
307 print "$pkg\n";
308 }
309 }
310 if (@readme) {
311 print "\n-- $okaction packgages with README file\n";
312 foreach my $task(@readme) {
313 print "$task" . $pptasks{$task}."\n";
314 }
315 }
316 if(@donetasks and not @failtasks and not $_[0]) {
317 print "\npkg-get: $okaction successfully\n"
318 }
319 }
320
321 # Get the list of installed packages
322 sub getinstalled {
323 if (%installed) {
324 return;
325 }
326 my $name;
327 my $version;
328 my $sec = 0;
329 open(DB, $PKGDB)
330 or exiterr("could not open ".$PKGDB);
331 while (<DB>) {
332 chomp;
333 if ($_ ne "") {
334 if ($sec == 0) {
335 $name = $_;
336 $sec = 1;
337 } elsif ($sec == 1) {
338 $version = $_;
339 $sec = 3;
340 }
341 }
342 if ($sec == 3) {
343 if ($_ eq "") {
344 $sec = 0;
345 $installed{$name} = $version;
346 }
347 }
348 }
349 close(DB);
350 }
351
352 # Lock the given pkgname
353 sub lockadd {
354 my $pkg = $_[0];
355 my @locked = ();
356 if (not -e $LOCKFILE) {
357 open(LCK, "+>> $LOCKFILE") or exiterr("could not write to lock file");
358 close(LCK);
359 }
360 open(LCK, $LOCKFILE);
361 while (<LCK>) {
362 chomp;
363 if ($_ eq $pkg) {
364 print "Already locked: $pkg\n";
365 close(LCK);
366 return;
367 } else {
368 push (@locked, $_);
369 }
370 }
371 close(LCK);
372 push(@locked, $pkg);
373 @locked = sort(@locked);
374 open(LCK, "> $LOCKFILE") or exiterr("could not write to lock file");
375 foreach my $lock(@locked) {
376 print LCK "$lock\n";
377 }
378 close(LCK);
379 }
380
381 # Rrint formatted info for given package
382 sub formattedprint {
383 my %pkg = @_;
384 my $fmt = $ARGV[1];
385 $fmt =~ s|%n|$pkg{'name'}|;
386 $fmt =~ s|%p|$pkg{'path'}|;
387 $fmt =~ s|%v|$pkg{'version'}|;
388 $fmt =~ s|%r|$pkg{'release'}|;
389 $fmt =~ s|%d|$pkg{'description'}|;
390 $fmt =~ s|%u|$pkg{'url'}|;
391 $fmt =~ s|%R|$pkg{'readme'}|;
392 $fmt =~ s|%E|$pkg{'pre_install'}|;
393 $fmt =~ s|%O|$pkg{'post_install'}|;
394 $fmt =~ s|%M|Nobody|; # for prt-get compatibility
395 $fmt =~ s|%P|Nobody|; # for prt-get compatibility
396 $fmt =~ s|\\n|\n|;
397 $fmt =~ s|\\t|\t|;
398 if (index($fmt,"%e") >=0) {
399 my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'});
400 $fmt =~ s|%e|$deps|;
401 }
402 if (index($fmt,"%l") >=0) {
403 my $locked = islocked($pkg{'name'});
404 $fmt =~ s|%l|$locked|;
405 }
406 if (index($fmt,"%i") >=0) {
407 my $inst = "no";
408 if ($pkg{'instversion'}) {
409 if ($pkg{'instversion'} eq $pkg{'version'}."-".$pkg{'release'}) {
410 $inst = "yes";
411 } else {
412 $inst = "diff";
413 }
414 }
415 $fmt =~ s|%i|$inst|;
416 }
417 print "$fmt";
418 }
419
420 # See if package is currently locked
421 sub islocked {
422 my $pkg = $_[0];
423 open(LCK, $LOCKFILE) or return "no";
424 while (<LCK>) {
425 chomp;
426 if ($_ eq $pkg) {
427 close(LCK);
428 return "yes";
429 }
430 }
431 close(LCK);
432 return "no";
433 }
434
435 # Get package from the repo(s)
436 sub getpackage {
437 my $pkgname = $_[0];
438 my $checkver = $_[1];
439 my %found;
440 my %res;
441 foreach my $repo(@repos) {
442 my @r = split(/\|/, $repo);
443 my $dir = $r[0];
444 my $url = $r[1];
445 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
446 while (<REPO>) {
447 chomp;
448 my %pkg = parsepackage($_, $dir, $url, $checkver);
449 if ($pkg{'name'} eq $pkgname) {
450 close (REPO);
451 return %pkg;
452 }
453 }
454 close (REPO);
455 }
456 return %res;
457 }
458
459 # Get short status for package, ie [i]
460 sub getshortstatus {
461 my %pkg = @_;
462 if ($pkg{'instversion'}) {
463 if ($pkg{'instversion'} eq $pkg{'version'}."-".$pkg{'release'}) {
464 return "[i]";
465 } else {
466 return "[u]";
467 }
468 }
469 return "[ ]";
470 }
471
472 # Get (recursive) dependencies for pkgname
473 sub getdependencies {
474 my $pkgname = $_[0];
475 my $checkver = $_[1];
476 my $pkgparent = $_[2];
477 my $depstring = "";
478 if ($pkgparent eq "") {
479 #%deps = ();
480 };
481 if (not $deps{$pkgname}) {
482 my %pkg = getpackage($pkgname, 1);
483 if (%pkg) {
484 my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
485 my @d = split(/,/, $ddeps);
486 foreach my $dep(@d) {
487 getdependencies($dep, $checkver, $pkgname);
488 }
489 if ($checkver) {
490 $depstring = getshortstatus(%pkg) . " $pkgname";
491 } else {
492 $depstring = $pkgname;
493 }
494 $deps{$pkgname} = $depstring;
495 push(@dependencies, $depstring);
496 } else {
497 if ($pkgparent eq "") {
498 return 0;
499 } else {
500 $missingdeps{$pkgname} = $pkgparent;
501 }
502 }
503 }
504 }
505
506 # Download given package (if needed), check md5sum
507 sub downloadpkg {
508 my %pkg = @_;
509 my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.$compress";
510 if (-f $fullpath) {
511 my $md5 = `md5sum $fullpath`; chomp;
512 $md5 =~ s/\s+.*$//;
513 $md5 =~ chop($md5);
514 if ($md5 ne $pkg{'md5sum'} and not $ignore_md5sum) {
515 print STDERR "=======> ERROR: md5sum mismatch for $pkg{'name'}:\n";
516 print STDERR "required : $pkg{'md5sum'}\n";
517 print STDERR "found : $md5\n";
518 return 0;
519 }
520 return 1;
521 } else {
522 if ($pkg{'url'} eq "") {return 1}; # repo is local and pkg does not exist.
523 my $url = $pkg{'url'};
524 $url =~ s/\#/\%23/;
525 system ("wget --no-directories --tries=3 --waitretry=3 --directory-prefix=$pkg{'path'} $url") == 0 or return 0;
526 my $md5 = `md5sum $fullpath`; chomp;
527 $md5 =~ s/\s+.*$//;
528 $md5 =~ chop($md5);
529 if ($md5 ne $pkg{'md5sum'} and not $ignore_md5sum) {
530 print STDERR "=======> ERROR: md5sum mismatch for $pkg{'name'}:\n";
531 print STDERR "required : $pkg{'md5sum'}\n";
532 print STDERR "found : $md5\n";
533 return 0;
534 }
535 }
536 return 1;
537 }
538
539 # Install given package
540 sub installpkg {
541 my $upgrade = shift(@_);
542 my %pkg = @_;
543 my $aa = $aargs." ";
544 if ($pkg{'readme'} eq "yes") {$readmetasks{$pkg{'name'}} = 1};
545 $pptasks{$pkg{'name'}} = "";
546 if ($download_only) {return 1};
547 if ($force){$aa = $aa."-f "};
548 if ($root) {$aa = $aa."-r ".$root." "};
549 if ($pkg{'pre_install'} eq "yes" and ($install_scripts or $pre_install)) {dopre(%pkg)};
550 my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.$compress";
551 print "pkg-get: /usr/bin/pkgadd $upgrade$aa$fullpath\n";
552 system ("/usr/bin/pkgadd $upgrade$aa$fullpath") == 0 or return 0;
553 if ($pkg{'post_install'} eq "yes" and ($install_scripts or $post_install)) {dopost(%pkg)};
554 return 1;
555 }
556
557 # Execute pre-install script
558 sub dopre {
559 my %pkg = @_;
560 my $cmd = "/bin/bash $pkg{'path'}/PKGINST $pkg{name}_pre_install";
561 if (system($cmd) == 0){
562 $pptasks{$pkg{'name'}} .= " [pre: ok]";
563 } else {
564 $pptasks{$pkg{'name'}} .= " [pre: failed]";
565 }
566 }
567
568 # Execute post-install script
569 sub dopost {
570 my %pkg = @_;
571 my $cmd = "/bin/bash $pkg{'path'}/PKGINST $pkg{name}_post_install";
572 if (system($cmd) == 0){
573 $pptasks{$pkg{'name'}} .= " [post: ok]";
574 } else {
575 $pptasks{$pkg{'name'}} .= " [post: failed]";
576 }
577 }
578
579 ############################################################################
580 # Main functions (commands)
581 ############################################################################
582
583 # No pun intended ##########################################################
584 sub version {
585 print "pkg-get $VERSION ";
586 print "by Simone Rota <sip\@varlock.com>\n";
587 }
588
589 # Show brief help ##########################################################
590 sub help {
591 print "Usage: pkg-get command <package1> [package2 ... packageN] [options]
592
593 Some command:
594 sync synchronize with the repository
595 depinst install package and its dependencies;
596 info info about package
597 sysup updates all outdated packages
598 diff list all outdated packages
599
600 Some option:
601 -do download only
602 --install-scripts use install scripts
603 -r <root> use <root> for pkgadd
604
605 Example:
606 pkg-get install sqlite pysqlite
607
608 For other commands and samples, see the pkg-get(8) man page\n";
609 }
610
611 # Sync with the remote server(s) ###########################################
612 sub sync {
613 my @r;
614 my $dir;
615 my $url;
616 my $dlerror = 0;
617 foreach my $repo(@repos) {
618 @r = split(/\|/, $repo);
619 $dir = $r[0];
620 $url = $r[1];
621 if (not $url){$url = ""};
622 print "Updating collection $dir\n";
623 if (not -d $dir) {
624 mkdir($dir) or exiterr("cannot create $dir");
625 }
626 if ($url ne "") {
627 for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
628 if (-f "$dir/$f") {rename("$dir/$f", "$dir/$f.old") or exiterr("cannot write to $dir")};
629 if (system("wget -q -P $dir $url/$f") != 0) {
630 print " cannot retrieve $f\n";
631 $dlerror=1;
632 }
633 }
634 if ($dlerror) { # restore backup repo
635 for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
636 if (-f "$dir/$f.old") {rename("$dir/$f.old", "$dir/$f") or exiterr("cannot write to $dir")};};
637 } else { # remove backup repo
638 for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
639 if (-f "$dir/$f.old") {unlink("$dir/$f.old") or exiterr("cannot write to $dir")};};
640 }
641 }
642 }
643 }
644
645 # Show info about the package ##############################################
646 sub info {
647 my $arg = $ARGV[1];
648 foreach my $repo(@repos) {
649 my @r = split(/\|/, $repo);
650 my $dir = $r[0];
651 my $url = $r[1];
652 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
653 while (<REPO>) {
654 chomp;
655 my %pkg = parsepackage($_, $dir, $url, 0);
656 if ($pkg{'name'} eq $arg) {
657 printinfo(%pkg);
658 close(REPO);
659 return;
660 }
661 }
662 close(REPO);
663 }
664 print "Package '$arg' not found\n";
665 }
666
667 # List packages containing given string in their name ######################
668 sub search {
669 my $arg = $ARGV[1];
670 my %found;
671 foreach my $repo(@repos) {
672 my @r = split(/\|/, $repo);
673 my $dir = $r[0];
674 my $url = $r[1];
675 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
676 while (<REPO>) {
677 chomp;
678 my %pkg = parsepackage($_, $dir, $url, 0);
679 if (index($pkg{'name'}, $arg) > -1 and not $found{$pkg{'name'}}) {
680 $found{$pkg{'name'}} = 1;
681 }
682 }
683 close(REPO);
684 }
685 foreach my $key (sort keys %found) {
686 print "$key\n";
687 }
688 if (not %found) {print "No matching packages found\n"};
689 }
690
691 # List packages containing given string (name / description) ###############
692 sub dsearch {
693 my $arg = $ARGV[1];
694 my %found;
695 foreach my $repo(@repos) {
696 my @r = split(/\|/, $repo);
697 my $dir = $r[0];
698 my $url = $r[1];
699 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
700 while (<REPO>) {
701 chomp;
702 my %pkg = parsepackage($_, $dir, $url, 0);
703 if ((index($pkg{'name'}, $arg) > -1 or index($pkg{'description'}, $arg) > -1)
704 and not $found{$pkg{'name'}}) {
705 $found{$pkg{'name'}} = 1;
706 }
707 }
708 close(REPO);
709 }
710 foreach my $key (sort keys %found) {
711 print "$key\n";
712 }
713 if (not %found) {print "No matching packages found\n";};
714 }
715
716 # List all available packages ##############################################
717 sub list {
718 my $arg = $ARGV[1];
719 my %found;
720 foreach my $repo(@repos) {
721 my @r = split(/\|/, $repo);
722 my $dir = $r[0];
723 my $url = $r[1];
724 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
725 while (<REPO>) {
726 chomp;
727 my %pkg = parsepackage($_, $dir, $url, 0);
728 $found{$pkg{'name'}} = 1;
729 }
730 close(REPO);
731 }
732 foreach my $key (sort keys %found) {
733 print "$key\n";
734 }
735 }
736
737 # Show path for a package ##################################################
738 sub path {
739 my $arg = $ARGV[1];
740 foreach my $repo(@repos) {
741 my @r = split(/\|/, $repo);
742 my $dir = $r[0];
743 my $url = $r[1];
744 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
745 while (<REPO>) {
746 chomp;
747 my %pkg = parsepackage($_, $dir, $url, 0);
748 if ($pkg{'name'} eq $arg) {
749 print $pkg{'path'} . "\n";
750 close(REPO);
751 return;
752 }
753 }
754 close(REPO);
755 }
756 print "Package '$arg' not found\n";
757 }
758
759 # Show current installed version of a package ##############################
760 sub current {
761 my $pkgname = $ARGV[1];
762 getinstalled();
763 if ($installed{$pkgname}) {
764 print "$installed{$pkgname}\n";
765 } else {
766 print "Package $pkgname not installed\n";
767 }
768 }
769
770 # Print the README file for a package ######################################
771 sub readme {
772 my $arg = $ARGV[1];
773 foreach my $repo(@repos) {
774 my @r = split(/\|/, $repo);
775 my $dir = $r[0];
776 my $url = $r[1];
777 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
778 while (<REPO>) {
779 chomp;
780 my %pkg = parsepackage($_, $dir, $url, 0);
781 if ($pkg{'name'} eq $arg) {
782 printreadme(%pkg);
783 close(REPO);
784 return;
785 }
786 }
787 close(REPO);
788 }
789 print "Package '$arg' not found\n";
790 }
791
792 # Remove given packages ####################################################
793 sub remove {
794 $curraction = "removed";
795 shift(@ARGV);
796 foreach my $pkg(@ARGV) {
797 $pptasks{$pkg} = "";
798 if (system("/usr/bin/pkgrm $pkg") ==0) {
799 push(@donetasks, $pkg);
800 } else {
801 push(@failtasks, "where removal failed,$pkg");
802 }
803 }
804 printresults();
805 }
806
807 # List installed packages ##################################################
808 sub listinst {
809 getinstalled();
810 foreach my $key (sort keys %installed) {
811 print "$key\n";
812 }
813 }
814
815 # Print if package is installed ###########################################
816 sub isinst {
817 getinstalled();
818 shift(@ARGV);
819 foreach my $pkg(@ARGV) {
820 if ($installed{$pkg}) {
821 print "package $pkg is installed\n";
822 } else {
823 print "package $pkg is not installed\n";
824 }
825 }
826 }
827
828
829 # Lock given packages ######################################################
830 sub dolock {
831 shift(@ARGV);
832 foreach my $arg(@ARGV) {
833 my $found = 0;
834 foreach my $repo(@repos) {
835 if ($found == 0) {
836 my @r = split(/\|/, $repo);
837 my $dir = $r[0];
838 my $url = $r[1];
839 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
840 while (<REPO>) {
841 chomp;
842 my %pkg = parsepackagelight($_);
843 if ($pkg{'name'} eq $arg) {
844 $found = 1;
845 lockadd($arg);
846 }
847 }
848 close(REPO);
849 }
850 }
851 if ($found == 0) {print "Package '$arg' not found\n"};
852 }
853 }
854
855 # Unlock given packages ####################################################
856 sub unlock {
857 shift(@ARGV);
858 my @locked;
859 my $found;
860 foreach my $arg(@ARGV) {
861 $found = 0;
862 @locked = ();
863 open(LCK, $LOCKFILE) or exiterr("could not open lock file");
864 while (<LCK>) {
865 chomp;
866 if ($_ eq $arg) {
867 push (@locked, "-");
868 $found = 1;
869 } else {
870 push (@locked, $_);
871 }
872 }
873 close(LCK);
874 if ($found == 1) {
875 @locked = sort(@locked);
876 open(LCK, ">$LOCKFILE") or exiterr("could not write to lock file");
877 foreach my $lock(@locked) {
878 if ($lock ne "-") {print LCK "$lock\n"};
879 }
880 close(LCK);
881 } else {
882 print "Not locked previously: $arg\n";
883 }
884 }
885 }
886
887 # List locked packages #####################################################
888 sub listlocked {
889 open(LCK, $LOCKFILE)
890 or exit;
891 while (<LCK>) {
892 chomp;
893 print "$_\n";
894 }
895 close(LCK);
896 }
897
898 # Print formatted info #####################################################
899 sub doprintf {
900 my %found;
901 foreach my $repo(@repos) {
902 my @r = split(/\|/, $repo);
903 my $dir = $r[0];
904 my $url = $r[1];
905 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
906 while (<REPO>) {
907 chomp;
908 my %pkg;
909 if (index($ARGV[1], "%i") >=0 ) {
910 %pkg = parsepackage($_, $dir, $url, 1);
911 } else {
912 %pkg = parsepackage($_, $dir, $url, 0);
913 }
914 if (not $found{$pkg{'name'}}) {
915 if ($filter ne "") {
916 my $match = $pkg{'name'};
917 my $cfilter = $filter;
918 $cfilter =~ s/\*/\.\*/;
919 if ($match =~ /^$cfilter$/) {
920 formattedprint(%pkg);
921 $found{$pkg{'name'}} = 1;
922 }
923 } else {
924 formattedprint(%pkg);
925 $found{$pkg{'name'}} = 1;
926 }
927 }
928 }
929 close(REPO);
930 }
931 }
932
933 # Show differences between installed and available packages ################
934 sub diff {
935 my %found;
936 my $gotdiff = 0;
937 foreach my $repo(@repos) {
938 my @r = split(/\|/, $repo);
939 my $dir = $r[0];
940 my $url = $r[1];
941 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
942 while (<REPO>) {
943 chomp;
944 my %pkg;
945 %pkg = parsepackage($_, $dir, $url, 1);
946 if (not $found{$pkg{'name'}}) {
947 if ($pkg{'instversion'}) {
948 if ($pkg{'instversion'} ne $pkg{'version'}."-".$pkg{'release'}) {
949 if (islocked($pkg{'name'}) eq "no") {
950 if ($gotdiff == 0){
951 print "Differences between installed packages and packages repo:\n\n";
952 printf("%-19s %-19s %-19s\n\n","Package","Installed","Available in the repositories");
953 $gotdiff = 1;
954 }
955 printf("%-19s %-19s %-19s\n", $pkg{'name'}, $pkg{'instversion'}, $pkg{'version'}."-".$pkg{'release'});
956 } elsif ($all) { # yeah, it blows, at least avoid to read the locked state twice.
957 if ($gotdiff == 0){
958 print "Differences between installed packages and packages repo:\n\n";
959 printf("%-19s %-19s %-19s\n\n","Package","Installed","Available in the repositories");
960 $gotdiff = 1;
961 }
962 printf("%-19s %-19s %-19s %-19s\n", $pkg{'name'}, $pkg{'instversion'}, $pkg{'version'}."-".$pkg{'release'}, "locked");
963 }
964 }
965 }
966 $found{$pkg{'name'}} = 1;
967 }
968 }
969 close(REPO);
970 }
971 if ($gotdiff ==0) {print "No differences found\n"};
972 }
973
974 # Show differences between installed and available packages ################
975 sub quickdiff {
976 my %found;
977 my $gotdiff = 0;
978 foreach my $repo(@repos) {
979 my @r = split(/\|/, $repo);
980 my $dir = $r[0];
981 my $url = $r[1];
982 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
983 while (<REPO>) {
984 chomp;
985 my %pkg;
986 %pkg = parsepackage($_, $dir, $url, 1);
987 if (not $found{$pkg{'name'}}) {
988 if ($pkg{'instversion'}) {
989 if ($pkg{'instversion'} ne $pkg{'version'}."-".$pkg{'release'} and islocked($pkg{'name'}) eq "no") {
990 if ($gotdiff == 0){
991 print $pkg{'name'};
992 $gotdiff = 1;
993 } else {
994 print " " . $pkg{'name'};
995 }
996 }
997 }
998 $found{$pkg{'name'}} = 1;
999 }
1000 }
1001 close(REPO);
1002 }
1003 if ($gotdiff != 0) {print "\n"};
1004 }
1005
1006 # Display duplicate packages (found in more than one repo) #################
1007 sub dup {
1008 my %found;
1009 foreach my $repo(@repos) {
1010 my @r = split(/\|/, $repo);
1011 my $dir = $r[0];
1012 my $url = $r[1];
1013 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
1014 while (<REPO>) {
1015 chomp;
1016 my %pkg;
1017 %pkg = parsepackage($_, $dir, $url, 0);
1018 $found{$pkg{'name'}} .= "###" . $pkg{'path'}."/". $pkg{'name'}.$pkg{'version'}."-".$pkg{'release'};
1019 }
1020 close(REPO);
1021 }
1022 my $curr = "";
1023 foreach my $key (sort keys %found) {
1024 my $value = $found{$key};
1025 $value =~ s/^\#\#\#//;
1026 if (rindex($value, "###") >=0){
1027 print "* $key\n";
1028 my @d = split(/\#\#\#/, $value);
1029 foreach my $dup(@d){
1030 print " $dup\n";
1031 }
1032 }
1033 }
1034 }
1035
1036 # Show list of dependencies for package ####################################
1037 sub depends {
1038 getdependencies($ARGV[1], 1, "") or exiterr("package '$ARGV[1]' not found");
1039 if (@dependencies) {print "-- dependencies ([i] = installed, [u] = updatable)\n"}
1040 foreach my $dep(@dependencies) {
1041 print "$dep\n";
1042 }
1043 if (%missingdeps) {
1044 print "\n-- missing packages\n";
1045 foreach my $dep(sort keys %missingdeps) {
1046 print "$dep from $missingdeps{$dep}\n";
1047 }
1048 }
1049 }
1050
1051 # Show compact list of dependencies for package ############################
1052 sub quickdep {
1053 getdependencies($ARGV[1], 0, "") or exiterr("package '$ARGV[1]' not found");
1054 foreach my $dep(@dependencies) {
1055 print "$dep ";
1056 }
1057 print "\n";
1058 }
1059
1060 # Show packages directly depending from given package ######################
1061 sub dependent {
1062 my $arg = $ARGV[1];
1063 my %dp;
1064 if (not $all) { getinstalled(); }
1065 foreach my $repo(@repos) {
1066 my @r = split(/\|/, $repo);
1067 my $dir = $r[0];
1068 my $url = $r[1];
1069 open(DEPS, "$dir/PKGDEPS")
1070 or exiterr("could not open $dir/PKGDEPS");
1071 while (<DEPS>) {
1072 chomp;
1073 my $dep = $_;
1074 $dep =~ s/\s+\:.*$//;
1075 s/^.*\: /\,/;
1076 s/$/\,\$/;
1077 if ( /\,\Q$arg\E\,/ ) {
1078 if (not $all) {
1079 if ($installed{$dep}) {
1080 $dp{$dep} = 1;
1081 }
1082 } else {
1083 $dp{$dep} = 1;
1084 }
1085 }
1086 }
1087 close(DEPS);
1088 }
1089 foreach my $res(keys %dp) {
1090 print "$res\n";
1091 }
1092 }
1093
1094 # Install given package ####################################################
1095 sub install {
1096 $curraction = "installed";
1097 my @args = @_; shift(@args);
1098 getinstalled();
1099 foreach my $pkgname(@args) {
1100 my %pkg = getpackage($pkgname, 1);
1101 if (not %pkg) {
1102 push(@failtasks, "not found,$pkgname");
1103 } elsif (getshortstatus(%pkg) ne "[ ]") {
1104 push(@prevtasks, "$pkgname");
1105 } elsif (downloadpkg(%pkg) and installpkg("", %pkg)) {
1106 push(@donetasks, $pkgname);
1107 } else {
1108 push(@failtasks, "where install failed,$pkgname");
1109 }
1110 }
1111 printresults();
1112 }
1113
1114 # Update given package #####################################################
1115 sub update {
1116 $curraction = "updated";
1117 my @args = @_; shift(@args);
1118 getinstalled();
1119 foreach my $pkgname(@args) {
1120 my %pkg = getpackage($pkgname, 1);
1121 if (not %pkg) {
1122 push(@failtasks, "not found,$pkgname");
1123 } elsif (getshortstatus(%pkg) eq "[ ]") {
1124 push(@prevtasks, "$pkgname");
1125 } elsif (downloadpkg(%pkg) and installpkg("-u ", %pkg)) {
1126 push(@donetasks, $pkgname);
1127 } else {
1128 push(@failtasks, "where update failed,$pkgname");
1129 }
1130 }
1131 printresults();
1132 }
1133
1134 # Update out of date packages ##############################################
1135 sub sysup {
1136 my %found;
1137 my @diff;
1138 foreach my $repo(@repos) {
1139 my @r = split(/\|/, $repo);
1140 my $dir = $r[0];
1141 my $url = $r[1];
1142 open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
1143 while (<REPO>) {
1144 chomp;
1145 my %pkg;
1146 %pkg = parsepackage($_, $dir, $url, 1);
1147 if (not $found{$pkg{'name'}}) {
1148 if ($pkg{'instversion'}) {
1149 if ($pkg{'instversion'} ne $pkg{'version'}."-".$pkg{'release'} and islocked($pkg{'name'}) eq "no") {
1150 push(@diff, $pkg{'name'});
1151 }
1152 }
1153 $found{$pkg{'name'}} = 1;
1154 }
1155 }
1156 close(REPO);
1157 }
1158 if (@diff) {
1159 unshift(@diff, "dummy"); # is shifted later in update sub;
1160 update(@diff);
1161 }
1162 }
1163
1164 sub depinst {
1165 my @toinst; my %seen;
1166 $curraction = "installed";
1167 my @args = @ARGV; shift(@args);
1168 getinstalled();
1169 foreach my $pkgname(@args) {
1170 getdependencies($pkgname, 0, "");
1171 foreach my $dep(@dependencies) {
1172 if (not $seen{$dep}) {
1173 my %pkg = getpackage($dep, 1);
1174 if (%pkg) {
1175 if (getshortstatus(%pkg) eq "[ ]"){
1176 push(@toinst, $pkg{'name'});
1177 }
1178 }
1179 $seen{$dep} = 1;
1180 }
1181 }
1182 }
1183 if (@toinst) {
1184 unshift(@toinst, "dummy"); # is shifted later in install sub;
1185 install(@toinst);
1186 }
1187 }
|
