pkg-get/scripts/pkg-get.pl

1170 lines
29 KiB
Perl
Executable File

#!/usr/bin/env perl
#
# pkg-get - A binary package management utility for CRUX Linux
# Copyright (C) 2004-05 Simone Rota <sip@varlock.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
use warnings;
use strict;
use Getopt::Long;
my $VERSION = "0.4.4";
my $CFGFILE = "/etc/pkg-get.conf";
my $LOCKFILE = "/var/lib/pkg/pkg-get.locker";
my $PKGDB = "/var/lib/pkg/db" ;
$SIG{HUP} = \&trap; $SIG{INT} = \&trap; $SIG{QUIT} = \&trap; $SIG{TERM} = \&trap;
# Global vars
my @repos = (); # package repositories
my @donetasks; my @failtasks; my @prevtasks; my %pptasks; my %readmetasks;
my $curraction = ""; my %installed; my %deps; my @dependencies; my %missingdeps;
# CL Options
my $download_only; my $pre_install; my $post_install;
my $install_scripts; my $filter = ""; my $all; my $unused;
my $aargs=""; my $ignore_md5sum; my $force; my $root;
GetOptions("do"=>\$download_only,
"pre-install"=>\$pre_install, "post-install"=>\$post_install,
"install-scripts"=>\$install_scripts, "all"=>\$all,
"filter=s"=>\$filter, "config=s"=>\$CFGFILE, "aargs=s"=>\$aargs,
"f"=>\$force, "im"=>\$ignore_md5sum, "margs=s"=>\$unused,
"rargs=s"=>\$unused, "r=s"=>\$root);
if ($root) {
$LOCKFILE = $root.$LOCKFILE ;
$PKGDB = $root.$PKGDB;
}
# Get command, verify it's valid
my $command = getcommand(@ARGV);
if (index($command,"Error: ") eq 0 ) {
$command =~ s/Error\: //;
exiterr($command);
}
readconfig();
SWITCH: {
if ($command eq "version") { version(); last SWITCH; }
if ($command eq "sync") { sync(); last SWITCH; }
if ($command eq "info") { info(); last SWITCH; }
if ($command eq "help") { help(); last SWITCH; }
if ($command eq "readme") { readme(); last SWITCH; }
if ($command eq "search") { search(); last SWITCH; }
if ($command eq "dsearch") { dsearch(); last SWITCH; }
if ($command eq "list") { list(); last SWITCH; }
if ($command eq "path") { path(); last SWITCH; }
if ($command eq "remove") { remove(); last SWITCH; }
if ($command eq "listinst") { listinst(); last SWITCH; }
if ($command eq "lock") { dolock(); last SWITCH; }
if ($command eq "unlock") { unlock(); last SWITCH; }
if ($command eq "listlocked") { listlocked(); last SWITCH; }
if ($command eq "printf") { doprintf(); last SWITCH; }
if ($command eq "isinst") { isinst(); last SWITCH; }
if ($command eq "diff") { diff(); last SWITCH; }
if ($command eq "quickdiff") { quickdiff(); last SWITCH; }
if ($command eq "dup") { dup(); last SWITCH; }
if ($command eq "depends") { depends(); last SWITCH; }
if ($command eq "quickdep") { quickdep(); last SWITCH; }
if ($command eq "install") { install(@ARGV); last SWITCH; }
if ($command eq "update") { update(@ARGV); last SWITCH; }
if ($command eq "sysup") { sysup(); last SWITCH; }
if ($command eq "dependent") { dependent(); last SWITCH; }
if ($command eq "depinst") { depinst(); last SWITCH; }
if ($command eq "current") { current(); last SWITCH; }
}
############################################################################
# Support functions
############################################################################
# Exit with error
sub exiterr {
my ($msg) = @_;
print "pkg-get: $msg\n";
exit 1;
}
sub trap {
printresults(1);
die("\npkg-get: interrupted\n");
}
# Get command, return an error if not in the list of allowed commands
sub getcommand {
my @args = @_;
my $givencmd = $args[0];
my $givenarg = $args[1];
if (not $givenarg){$givenarg = ""};
if (not $givencmd){$givencmd = ""};
my @allowed = ("depinst:", "install:", "sysup", "diff", "update:", "depends:", "info:", "sync",
"version", "help", "quickdep:", "dependent:", "list", "listinst", "isinst:",
"search:", "dsearch:", "lock:", "unlock:", "listlocked", "quickdiff", "printf:",
"remove:", "readme:", "dup", "path:", "current:");
foreach my $valid(@allowed) {
if ($givencmd eq ""){
return "Error: no command given. try pkg-get help for more information";
}
if ($givencmd eq $valid) {
return $givencmd;
} elsif ($givencmd.":" eq $valid) {
if ($givenarg ne "") {
return $givencmd;
} else {
return "Error: '$givencmd' requires an argument";
}
}
}
return "Error: unknown command '$givencmd'. try pkg-get help for more information";
}
# Parses the configuration file
sub readconfig {
open(CFG, $CFGFILE)
or exiterr("could not open $CFGFILE");
while (<CFG>) {
chomp;
if ( /^pkgdir\s+/ ) {
my $repo = $_;
$repo =~ s/^pkgdir\s+//;
$repo =~ s/#(.*)$//;
$repo =~ s/\s+$//;
push @repos, $repo;
} elsif (/^runscripts\s+/) {
my $rs = $_;
$rs =~ s/^runscripts\s+//;
$rs =~ s/#(.*)$//;
$rs =~ s/\s+$//;
if ($rs eq "yes") {$install_scripts = 1};
}
}
close(CFG);
}
# Parse a line describing a package
sub parsepackage {
my @p = split(/\:/, $_[0]);
if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
my %pkg;
my $name = $p[0];
$name =~ s/\#.*$//;
my $version = $p[0];
$version =~ s/^.*\#//;
$version =~ s/-\w*\.pkg\.tar\.gz//;
my $release = $p[0];
$release =~ s/^.*-//;
$release =~ s/\.pkg\.tar\.gz//;
if (not $_[2]) {$_[2] = $_[1]};
$pkg{'name'} = $name;
$pkg{'version'} = $version;
$pkg{'release'} = $release;
$pkg{'path'} = $_[1];
$pkg{'url'} = $_[2] . "/$p[0]";
$pkg{'size'} = $p[1];
$pkg{'md5sum'} = $p[2];
$pkg{'description'} = $p[3];
$pkg{'pre_install'} = $p[4];
$pkg{'post_install'} = $p[5];
$pkg{'readme'} = $p[6];
if ($_[3] == 1) {
getinstalled();
$pkg{'instversion'} = $installed{$name};
}
return %pkg;
}
# Parse a line describing a package (just the name)
sub parsepackagelight {
my @p = split(/\:/, $_[0]);
if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
my %pkg;
my $name = $p[0];
$name =~ s/\#.*$//;
$pkg{'name'} = $name;
return %pkg;
}
# Print info about the given package
sub printinfo {
my %pkg = @_;
print "Name : " . $pkg{'name'} . "\n";
print "Version : " . $pkg{'version'} . "\n";
print "Release : " . $pkg{'release'} . "\n";
print "Description : " . $pkg{'description'} . "\n";
print "URL : " . $pkg{'url'} . "\n";
print "Md5sum : " . $pkg{'md5sum'} . "\n";
print "Size : " . $pkg{'size'} . "\n";
my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'});
if ($deps ne "") { print "Depends on : $deps\n";};
my $files = "";
if ($pkg{'readme'} eq "yes") {$files .= "README,"};
if ($pkg{'pre_install'} eq "yes") {$files .= "pre-install,"};
if ($pkg{'post_install'} eq "yes") {$files .= "post-install,"};
$files =~ s/\,$//;
if ($files ne "") { print "Files : $files\n";};
}
# Get direct dependencies for package
sub getdirectdeps {
my $pkgname = $_[0];
my $dir = $_[1];
open(DEPS, "$dir/PKGDEPS")
or exiterr("could not open $dir/PKGDEPS");
while (<DEPS>) {
chomp;
if ( /^\Q$pkgname\E\s+/ ) {
my $dep = $_;
$dep =~ s/^.*\: //;
close(DEPS);
return $dep;
}
}
close(DEPS);
return "";
}
# Prints the README file to stdout
sub printreadme {
my %pkg = @_;
my $dir = $pkg{'path'};
my $pkgname = $pkg{'name'};
my $found = 0;
my $finished = 0;
open(READ, "$dir/PKGREAD")
or exiterr("could not open $dir/PKGREAD");
while (<READ>) {
if ($finished eq 1) {return;};
chomp;
if ($found eq 1) {
if ( /PKGREADME\:/ ) {
$finished = 1;
close(READ);
return;
} else {
print "$_\n";
}
}
if ($finished eq 0) {
if ( /PKGREADME: $pkgname$/ ) {
$found = 1;
}
}
}
close(READ);
}
# Print results for multiple package operations
sub printresults {
my $okaction = $curraction;
my $curr = "";
my $action;
my $pkg;
my @t;
my @readme;
my $goterror = 0;
if (@donetasks) {
print "\n-- Packages $okaction\n";
foreach my $task(@donetasks) {
if ($readmetasks{$task}) {push(@readme, $task)}
print "$task" . $pptasks{$task}."\n";
}
}
if (@prevtasks) {
if ($okaction eq "installed") {
print "\n-- Packages installed before this run (ignored)\n";
} else {
print "\n-- Packages not previously installed (ignored)\n";
}
foreach my $task(@prevtasks) {
print "$task\n";
}
}
if (@failtasks) {
@failtasks = sort(@failtasks);
foreach my $task(@failtasks) {
@t = split(/,/,$task);
$action = $t[0];
$pkg = $t[1];
if ($curr ne $action) {
print "\n-- Packages $action\n";
$curr = $action;
}
print "$pkg\n";
}
}
if (@readme) {
print "\n-- $okaction packgages with README file\n";
foreach my $task(@readme) {
print "$task" . $pptasks{$task}."\n";
}
}
if(@donetasks and not @failtasks and not $_[0]) {
print "\npkg-get: $okaction successfully\n"
}
}
# Get the list of installed packages
sub getinstalled {
if (%installed) {
return;
}
my $name;
my $version;
my $sec = 0;
open(DB, $PKGDB)
or exiterr("could not open ".$PKGDB);
while (<DB>) {
chomp;
if ($_ ne "") {
if ($sec == 0) {
$name = $_;
$sec = 1;
} elsif ($sec == 1) {
$version = $_;
$sec = 3;
}
}
if ($sec == 3) {
if ($_ eq "") {
$sec = 0;
$installed{$name} = $version;
}
}
}
close(DB);
}
# Lock the given pkgname
sub lockadd {
my $pkg = $_[0];
my @locked = ();
if (not -e $LOCKFILE) {
open(LCK, "+>> $LOCKFILE") or exiterr("could not write to lock file");
close(LCK);
}
open(LCK, $LOCKFILE);
while (<LCK>) {
chomp;
if ($_ eq $pkg) {
print "Already locked: $pkg\n";
close(LCK);
return;
} else {
push (@locked, $_);
}
}
close(LCK);
push(@locked, $pkg);
@locked = sort(@locked);
open(LCK, "> $LOCKFILE") or exiterr("could not write to lock file");
foreach my $lock(@locked) {
print LCK "$lock\n";
}
close(LCK);
}
# Rrint formatted info for given package
sub formattedprint {
my %pkg = @_;
my $fmt = $ARGV[1];
$fmt =~ s|%n|$pkg{'name'}|;
$fmt =~ s|%p|$pkg{'path'}|;
$fmt =~ s|%v|$pkg{'version'}|;
$fmt =~ s|%r|$pkg{'release'}|;
$fmt =~ s|%d|$pkg{'description'}|;
$fmt =~ s|%u|$pkg{'url'}|;
$fmt =~ s|%R|$pkg{'readme'}|;
$fmt =~ s|%E|$pkg{'pre_install'}|;
$fmt =~ s|%O|$pkg{'post_install'}|;
$fmt =~ s|%M|Nobody|; # for prt-get compatibility
$fmt =~ s|%P|Nobody|; # for prt-get compatibility
$fmt =~ s|\\n|\n|;
$fmt =~ s|\\t|\t|;
if (index($fmt,"%e") >=0) {
my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'});
$fmt =~ s|%e|$deps|;
}
if (index($fmt,"%l") >=0) {
my $locked = islocked($pkg{'name'});
$fmt =~ s|%l|$locked|;
}
if (index($fmt,"%i") >=0) {
my $inst = "no";
if ($pkg{'instversion'}) {
if ($pkg{'instversion'} eq $pkg{'version'}."-".$pkg{'release'}) {
$inst = "yes";
} else {
$inst = "diff";
}
}
$fmt =~ s|%i|$inst|;
}
print "$fmt";
}
# See if package is currently locked
sub islocked {
my $pkg = $_[0];
open(LCK, $LOCKFILE) or return "no";
while (<LCK>) {
chomp;
if ($_ eq $pkg) {
close(LCK);
return "yes";
}
}
close(LCK);
return "no";
}
# Get package from the repo(s)
sub getpackage {
my $pkgname = $_[0];
my $checkver = $_[1];
my %found;
my %res;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url, $checkver);
if ($pkg{'name'} eq $pkgname) {
close (REPO);
return %pkg;
}
}
close (REPO);
}
return %res;
}
# Get short status for package, ie [i]
sub getshortstatus {
my %pkg = @_;
if ($pkg{'instversion'}) {
if ($pkg{'instversion'} eq $pkg{'version'}."-".$pkg{'release'}) {
return "[i]";
} else {
return "[u]";
}
}
return "[ ]";
}
# Get (recursive) dependencies for pkgname
sub getdependencies {
my $pkgname = $_[0];
my $checkver = $_[1];
my $pkgparent = $_[2];
my $depstring = "";
if ($pkgparent eq "") {
#%deps = ();
};
if (not $deps{$pkgname}) {
my %pkg = getpackage($pkgname, 1);
if (%pkg) {
my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
my @d = split(/,/, $ddeps);
foreach my $dep(@d) {
getdependencies($dep, $checkver, $pkgname);
}
if ($checkver) {
$depstring = getshortstatus(%pkg) . " $pkgname";
} else {
$depstring = $pkgname;
}
$deps{$pkgname} = $depstring;
push(@dependencies, $depstring);
} else {
if ($pkgparent eq "") {
return 0;
} else {
$missingdeps{$pkgname} = $pkgparent;
}
}
}
}
# Download given package (if needed), check md5sum
sub downloadpkg {
my %pkg = @_;
my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.gz";
if (-f $fullpath) {
my $md5 = `md5sum $fullpath`; chomp;
$md5 =~ s/\s+.*$//;
$md5 =~ chop($md5);
if ($md5 ne $pkg{'md5sum'} and not $ignore_md5sum) {
print STDERR "=======> ERROR: md5sum mismatch for $pkg{'name'}:\n";
print STDERR "required : $pkg{'md5sum'}\n";
print STDERR "found : $md5\n";
return 0;
}
return 1;
} else {
if ($pkg{'url'} eq "") {return 1}; # repo is local and pkg does not exist.
my $url = $pkg{'url'};
$url =~ s/\#/\%23/;
system ("wget --no-directories --tries=3 --waitretry=3 --directory-prefix=$pkg{'path'} $url") == 0 or return 0;
my $md5 = `md5sum $fullpath`; chomp;
$md5 =~ s/\s+.*$//;
$md5 =~ chop($md5);
if ($md5 ne $pkg{'md5sum'} and not $ignore_md5sum) {
print STDERR "=======> ERROR: md5sum mismatch for $pkg{'name'}:\n";
print STDERR "required : $pkg{'md5sum'}\n";
print STDERR "found : $md5\n";
return 0;
}
}
return 1;
}
# Install given package
sub installpkg {
my $upgrade = shift(@_);
my %pkg = @_;
my $aa = $aargs." ";
if ($pkg{'readme'} eq "yes") {$readmetasks{$pkg{'name'}} = 1};
$pptasks{$pkg{'name'}} = "";
if ($download_only) {return 1};
if ($force){$aa = $aa."-f "};
if ($root) {$aa = $aa."-r ".$root." "};
if ($pkg{'pre_install'} eq "yes" and ($install_scripts or $pre_install)) {dopre(%pkg)};
my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.gz";
print "pkg-get: /usr/bin/pkgadd $upgrade$aa$fullpath\n";
system ("/usr/bin/pkgadd $upgrade$aa$fullpath") == 0 or return 0;
if ($pkg{'post_install'} eq "yes" and ($install_scripts or $post_install)) {dopost(%pkg)};
return 1;
}
# Execute pre-install script
sub dopre {
my %pkg = @_;
my $cmd = "/bin/bash $pkg{'path'}/PKGINST $pkg{name}_pre_install";
if (system($cmd) == 0){
$pptasks{$pkg{'name'}} .= " [pre: ok]";
} else {
$pptasks{$pkg{'name'}} .= " [pre: failed]";
}
}
# Execute post-install script
sub dopost {
my %pkg = @_;
my $cmd = "/bin/bash $pkg{'path'}/PKGINST $pkg{name}_post_install";
if (system($cmd) == 0){
$pptasks{$pkg{'name'}} .= " [post: ok]";
} else {
$pptasks{$pkg{'name'}} .= " [post: failed]";
}
}
############################################################################
# Main functions (commands)
############################################################################
# No pun intended ##########################################################
sub version {
print "pkg-get $VERSION ";
print "by Simone Rota <sip\@varlock.com>\n";
}
# Show brief help ##########################################################
sub help {
print "Usage: pkg-get command <package1> [package2 ... packageN] [options]
Some command:
sync synchronize with the repository
depinst install package and its dependencies;
info info about package
sysup updates all outdated packages
diff list all outdated packages
Some option:
-do download only
--install-scripts use install scripts
-r <root> use <root> for pkgadd
Example:
pkg-get install sqlite pysqlite
For other commands and samples, see the pkg-get(8) man page\n";
}
# Sync with the remote server(s) ###########################################
sub sync {
my @r;
my $dir;
my $url;
my $dlerror = 0;
foreach my $repo(@repos) {
@r = split(/\|/, $repo);
$dir = $r[0];
$url = $r[1];
if (not $url){$url = ""};
print "Updating collection $dir\n";
if (not -d $dir) {
mkdir($dir) or exiterr("cannot create $dir");
}
if ($url ne "") {
for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
if (-f "$dir/$f") {rename("$dir/$f", "$dir/$f.old") or exiterr("cannot write to $dir")};
if (system("wget -q -P $dir $url/$f") != 0) {
print " cannot retrieve $f\n";
$dlerror=1;
}
}
if ($dlerror) { # restore backup repo
for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
if (-f "$dir/$f.old") {rename("$dir/$f.old", "$dir/$f") or exiterr("cannot write to $dir")};};
} else { # remove backup repo
for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
if (-f "$dir/$f.old") {unlink("$dir/$f.old") or exiterr("cannot write to $dir")};};
}
}
}
}
# Show info about the package ##############################################
sub info {
my $arg = $ARGV[1];
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url, 0);
if ($pkg{'name'} eq $arg) {
printinfo(%pkg);
close(REPO);
return;
}
}
close(REPO);
}
print "Package '$arg' not found\n";
}
# List packages containing given string in their name ######################
sub search {
my $arg = $ARGV[1];
my %found;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url, 0);
if (index($pkg{'name'}, $arg) > -1 and not $found{$pkg{'name'}}) {
$found{$pkg{'name'}} = 1;
}
}
close(REPO);
}
foreach my $key (sort keys %found) {
print "$key\n";
}
if (not %found) {print "No matching packages found\n"};
}
# List packages containing given string (name / description) ###############
sub dsearch {
my $arg = $ARGV[1];
my %found;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url, 0);
if ((index($pkg{'name'}, $arg) > -1 or index($pkg{'description'}, $arg) > -1)
and not $found{$pkg{'name'}}) {
$found{$pkg{'name'}} = 1;
}
}
close(REPO);
}
foreach my $key (sort keys %found) {
print "$key\n";
}
if (not %found) {print "No matching packages found\n";};
}
# List all available packages ##############################################
sub list {
my $arg = $ARGV[1];
my %found;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url, 0);
$found{$pkg{'name'}} = 1;
}
close(REPO);
}
foreach my $key (sort keys %found) {
print "$key\n";
}
}
# Show path for a package ##################################################
sub path {
my $arg = $ARGV[1];
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url, 0);
if ($pkg{'name'} eq $arg) {
print $pkg{'path'} . "\n";
close(REPO);
return;
}
}
close(REPO);
}
print "Package '$arg' not found\n";
}
# Show current installed version of a package ##############################
sub current {
my $pkgname = $ARGV[1];
getinstalled();
if ($installed{$pkgname}) {
print "$installed{$pkgname}\n";
} else {
print "Package $pkgname not installed\n";
}
}
# Print the README file for a package ######################################
sub readme {
my $arg = $ARGV[1];
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url, 0);
if ($pkg{'name'} eq $arg) {
printreadme(%pkg);
close(REPO);
return;
}
}
close(REPO);
}
print "Package '$arg' not found\n";
}
# Remove given packages ####################################################
sub remove {
$curraction = "removed";
shift(@ARGV);
foreach my $pkg(@ARGV) {
$pptasks{$pkg} = "";
if (system("/usr/bin/pkgrm $pkg") ==0) {
push(@donetasks, $pkg);
} else {
push(@failtasks, "where removal failed,$pkg");
}
}
printresults();
}
# List installed packages ##################################################
sub listinst {
getinstalled();
foreach my $key (sort keys %installed) {
print "$key\n";
}
}
# Print if package is installed ###########################################
sub isinst {
getinstalled();
shift(@ARGV);
foreach my $pkg(@ARGV) {
if ($installed{$pkg}) {
print "package $pkg is installed\n";
} else {
print "package $pkg is not installed\n";
}
}
}
# Lock given packages ######################################################
sub dolock {
shift(@ARGV);
foreach my $arg(@ARGV) {
my $found = 0;
foreach my $repo(@repos) {
if ($found == 0) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackagelight($_);
if ($pkg{'name'} eq $arg) {
$found = 1;
lockadd($arg);
}
}
close(REPO);
}
}
if ($found == 0) {print "Package '$arg' not found\n"};
}
}
# Unlock given packages ####################################################
sub unlock {
shift(@ARGV);
my @locked;
my $found;
foreach my $arg(@ARGV) {
$found = 0;
@locked = ();
open(LCK, $LOCKFILE) or exiterr("could not open lock file");
while (<LCK>) {
chomp;
if ($_ eq $arg) {
push (@locked, "-");
$found = 1;
} else {
push (@locked, $_);
}
}
close(LCK);
if ($found == 1) {
@locked = sort(@locked);
open(LCK, ">$LOCKFILE") or exiterr("could not write to lock file");
foreach my $lock(@locked) {
if ($lock ne "-") {print LCK "$lock\n"};
}
close(LCK);
} else {
print "Not locked previously: $arg\n";
}
}
}
# List locked packages #####################################################
sub listlocked {
open(LCK, $LOCKFILE)
or exit;
while (<LCK>) {
chomp;
print "$_\n";
}
close(LCK);
}
# Print formatted info #####################################################
sub doprintf {
my %found;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg;
if (index($ARGV[1], "%i") >=0 ) {
%pkg = parsepackage($_, $dir, $url, 1);
} else {
%pkg = parsepackage($_, $dir, $url, 0);
}
if (not $found{$pkg{'name'}}) {
if ($filter ne "") {
my $match = $pkg{'name'};
my $cfilter = $filter;
$cfilter =~ s/\*/\.\*/;
if ($match =~ /^$cfilter$/) {
formattedprint(%pkg);
$found{$pkg{'name'}} = 1;
}
} else {
formattedprint(%pkg);
$found{$pkg{'name'}} = 1;
}
}
}
close(REPO);
}
}
# Show differences between installed and available packages ################
sub diff {
my %found;
my $gotdiff = 0;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg;
%pkg = parsepackage($_, $dir, $url, 1);
if (not $found{$pkg{'name'}}) {
if ($pkg{'instversion'}) {
if ($pkg{'instversion'} ne $pkg{'version'}."-".$pkg{'release'} and (islocked($pkg{'name'}) eq "no")) {
if ($gotdiff == 0){
print "Differences between installed packages and packages repo:\n\n";
printf("%-19s %-19s %-19s\n\n","Package","Installed","Available in the repositories");
$gotdiff = 1;
}
printf("%-19s %-19s %-19s\n", $pkg{'name'}, $pkg{'instversion'}, $pkg{'version'}."-".$pkg{'release'});
}
}
$found{$pkg{'name'}} = 1;
}
}
close(REPO);
}
if ($gotdiff ==0) {print "No differences found\n"};
}
# Show differences between installed and available packages ################
sub quickdiff {
my %found;
my $gotdiff = 0;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg;
%pkg = parsepackage($_, $dir, $url, 1);
if (not $found{$pkg{'name'}}) {
if ($pkg{'instversion'}) {
if ($pkg{'instversion'} ne $pkg{'version'}."-".$pkg{'release'} and islocked($pkg{'name'}) eq "no") {
if ($gotdiff == 0){
print $pkg{'name'};
$gotdiff = 1;
} else {
print " " . $pkg{'name'};
}
}
}
$found{$pkg{'name'}} = 1;
}
}
close(REPO);
}
if ($gotdiff != 0) {print "\n"};
}
# Display duplicate packages (found in more than one repo) #################
sub dup {
my %found;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg;
%pkg = parsepackage($_, $dir, $url, 0);
$found{$pkg{'name'}} .= "###" . $pkg{'path'}."/". $pkg{'name'}.$pkg{'version'}."-".$pkg{'release'};
}
close(REPO);
}
my $curr = "";
foreach my $key (sort keys %found) {
my $value = $found{$key};
$value =~ s/^\#\#\#//;
if (rindex($value, "###") >=0){
print "* $key\n";
my @d = split(/\#\#\#/, $value);
foreach my $dup(@d){
print " $dup\n";
}
}
}
}
# Show list of dependencies for package ####################################
sub depends {
getdependencies($ARGV[1], 1, "") or exiterr("package '$ARGV[1]' not found");
if (@dependencies) {print "-- dependencies ([i] = installed, [u] = updatable)\n"}
foreach my $dep(@dependencies) {
print "$dep\n";
}
if (%missingdeps) {
print "\n-- missing packages\n";
foreach my $dep(sort keys %missingdeps) {
print "$dep from $missingdeps{$dep}\n";
}
}
}
# Show compact list of dependencies for package ############################
sub quickdep {
getdependencies($ARGV[1], 0, "") or exiterr("package '$ARGV[1]' not found");
foreach my $dep(@dependencies) {
print "$dep ";
}
print "\n";
}
# Show packages directly depending from given package ######################
sub dependent {
my $arg = $ARGV[1];
my %dp;
if (not $all) { getinstalled(); }
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(DEPS, "$dir/PKGDEPS")
or exiterr("could not open $dir/PKGDEPS");
while (<DEPS>) {
chomp;
my $dep = $_;
$dep =~ s/\s+\:.*$//;
s/^.*\: /\,/;
s/$/\,\$/;
if ( /\,\Q$arg\E\,/ ) {
if (not $all) {
if ($installed{$dep}) {
$dp{$dep} = 1;
}
} else {
$dp{$dep} = 1;
}
}
}
close(DEPS);
}
foreach my $res(keys %dp) {
print "$res\n";
}
}
# Install given package ####################################################
sub install {
$curraction = "installed";
my @args = @_; shift(@args);
getinstalled();
foreach my $pkgname(@args) {
my %pkg = getpackage($pkgname, 1);
if (not %pkg) {
push(@failtasks, "not found,$pkgname");
} elsif (getshortstatus(%pkg) ne "[ ]") {
push(@prevtasks, "$pkgname");
} elsif (downloadpkg(%pkg) and installpkg("", %pkg)) {
push(@donetasks, $pkgname);
} else {
push(@failtasks, "where install failed,$pkgname");
}
}
printresults();
}
# Update given package #####################################################
sub update {
$curraction = "updated";
my @args = @_; shift(@args);
getinstalled();
foreach my $pkgname(@args) {
my %pkg = getpackage($pkgname, 1);
if (not %pkg) {
push(@failtasks, "not found,$pkgname");
} elsif (getshortstatus(%pkg) eq "[ ]") {
push(@prevtasks, "$pkgname");
} elsif (downloadpkg(%pkg) and installpkg("-u ", %pkg)) {
push(@donetasks, $pkgname);
} else {
push(@failtasks, "where update failed,$pkgname");
}
}
printresults();
}
# Update out of date packages ##############################################
sub sysup {
my %found;
my @diff;
foreach my $repo(@repos) {
my @r = split(/\|/, $repo);
my $dir = $r[0];
my $url = $r[1];
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg;
%pkg = parsepackage($_, $dir, $url, 1);
if (not $found{$pkg{'name'}}) {
if ($pkg{'instversion'}) {
if ($pkg{'instversion'} ne $pkg{'version'}."-".$pkg{'release'} and islocked($pkg{'name'}) eq "no") {
push(@diff, $pkg{'name'});
}
}
$found{$pkg{'name'}} = 1;
}
}
close(REPO);
}
if (@diff) {
unshift(@diff, "dummy"); # is shifted later in update sub;
update(@diff);
}
}
sub depinst {
my @toinst; my %seen;
$curraction = "installed";
my @args = @ARGV; shift(@args);
getinstalled();
foreach my $pkgname(@args) {
getdependencies($pkgname, 0, "");
foreach my $dep(@dependencies) {
if (not $seen{$dep}) {
my %pkg = getpackage($dep, 1);
if (%pkg) {
if (getshortstatus(%pkg) eq "[ ]"){
push(@toinst, $pkg{'name'});
}
}
$seen{$dep} = 1;
}
}
}
if (@toinst) {
unshift(@toinst, "dummy"); # is shifted later in install sub;
install(@toinst);
}
}