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