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