From owner-svn-ports-head@FreeBSD.ORG Thu Nov 28 01:09:11 2013 Return-Path: Delivered-To: svn-ports-head@freebsd.org Received: from mx1.freebsd.org (mx1.freebsd.org [8.8.178.115]) (using TLSv1 with cipher ADH-AES256-SHA (256/256 bits)) (No client certificate requested) by hub.freebsd.org (Postfix) with ESMTPS id 0C49BE28; Thu, 28 Nov 2013 01:09:11 +0000 (UTC) Received: from svn.freebsd.org (svn.freebsd.org [IPv6:2001:1900:2254:2068::e6a:0]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by mx1.freebsd.org (Postfix) with ESMTPS id EB78CA45; Thu, 28 Nov 2013 01:09:10 +0000 (UTC) Received: from svn.freebsd.org ([127.0.1.70]) by svn.freebsd.org (8.14.7/8.14.7) with ESMTP id rAS19A5f096186; Thu, 28 Nov 2013 01:09:10 GMT (envelope-from mandree@svn.freebsd.org) Received: (from mandree@localhost) by svn.freebsd.org (8.14.7/8.14.5/Submit) id rAS19AMn096181; Thu, 28 Nov 2013 01:09:10 GMT (envelope-from mandree@svn.freebsd.org) Message-Id: <201311280109.rAS19AMn096181@svn.freebsd.org> From: Matthias Andree Date: Thu, 28 Nov 2013 01:09:10 +0000 (UTC) To: ports-committers@freebsd.org, svn-ports-all@freebsd.org, svn-ports-head@freebsd.org Subject: svn commit: r335075 - in head/ports-mgmt/pkgs_which: . files X-SVN-Group: ports-head MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: svn-ports-head@freebsd.org X-Mailman-Version: 2.1.16 Precedence: list List-Id: SVN commit messages for the ports tree for head List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 28 Nov 2013 01:09:11 -0000 Author: mandree Date: Thu Nov 28 01:09:09 2013 New Revision: 335075 URL: http://svnweb.freebsd.org/changeset/ports/335075 Log: New version 0.4.0 - Support pkgNG. Known issue is that pkg which returns bogus exit codes, spamming your screen. pkgs_which works nonetheless. https://github.com/freebsd/pkg/issues/657 Note that pkgNG always uses --nocache implictly for speed: https://github.com/freebsd/pkg/issues/658 Known issue: the pkgNG detection is a hack. It just looks for the executable and the database in default locations, but does not attempt to run "pkg -N". Modified: head/ports-mgmt/pkgs_which/Makefile head/ports-mgmt/pkgs_which/files/pkgs_which Modified: head/ports-mgmt/pkgs_which/Makefile ============================================================================== --- head/ports-mgmt/pkgs_which/Makefile Wed Nov 27 23:57:23 2013 (r335074) +++ head/ports-mgmt/pkgs_which/Makefile Thu Nov 28 01:09:09 2013 (r335075) @@ -2,7 +2,7 @@ # $FreeBSD$ PORTNAME= pkgs_which -PORTVERSION= 0.3.0 +PORTVERSION= 0.4.0 CATEGORIES= ports-mgmt perl5 MASTER_SITES= # none DISTFILES= # none Modified: head/ports-mgmt/pkgs_which/files/pkgs_which ============================================================================== --- head/ports-mgmt/pkgs_which/files/pkgs_which Wed Nov 27 23:57:23 2013 (r335074) +++ head/ports-mgmt/pkgs_which/files/pkgs_which Thu Nov 28 01:09:09 2013 (r335075) @@ -112,6 +112,8 @@ $ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr # Where pkg_info lives my $PKG_INFO = '/usr/sbin/pkg_info'; +my $PKGNG = '/usr/local/sbin/pkg'; +my $PKGNGDB = '/var/db/pkg/local.sqlite'; # Which regexp to use for laundering tainted file # and package names - note that this must not be let @@ -125,6 +127,9 @@ my $cacheall = 1; my $rc = 0; +my $PKGNG_MODE = 0; +if (-e $PKGNG and -e $PKGNGDB) { $PKGNG_MODE = 1; } + # Clean environment a bit delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; @@ -157,7 +162,10 @@ unless (@ARGV) { -message => "You must give a file or directory on the command line."); } -# declare subroutines +# listing all files from pkgNG is quite slow, so avoid +if ($PKGNG_MODE and $cacheall) { $cacheall = 0; } + +# declare subroutines sub wanted; sub debug; @@ -165,6 +173,30 @@ sub safebacktick(@); sub readcache(); sub readorigins(); +my $pf2p; +my $pfiles; +my $pogn; +my $pall; +my $pallomap; +my $pfilesmulti; + +if ($PKGNG_MODE) { + $pf2p = sub ($) { return safebacktick($PKGNG, 'which', '-q', $_[0]); }; + $pfiles = sub ($) { return safebacktick($PKGNG, 'info', '-ql', $_[0]); }; + $pogn = sub ($) { return safebacktick($PKGNG, 'info', '-qo', $_[0]); }; + $pall = sub () { return safebacktick($PKGNG, 'info', '-q'); }; + $pallomap = sub () { return map { s/\s+/:/; $_; } + safebacktick($PKGNG, 'info', '-o', '-a'); }; + $pfilesmulti = sub (@) { return safebacktick($PKGNG, 'info', '-l', @_); }; +} else { + $pf2p = sub ($) { return safebacktick($PKG_INFO, '-qGW', $_[0]); }; + $pfiles = sub ($) { return safebacktick($PKG_INFO, '-qGL', $_[0]); }; + $pogn = sub ($) { return safebacktick($PKG_INFO, '-qGo', $_[0]); }; + $pall = sub () { return safebacktick($PKG_INFO, '-EG', '-a'); }; + $pallomap = sub () { return safebacktick($PKG_INFO, '-QGoa'); }; + $pfilesmulti = sub (@) { return safebacktick($PKG_INFO, '-QGL', @_); }; +} + # define variables my %ufiles = (); @@ -215,7 +247,7 @@ my $f; while ($f = each %ufiles) { # Find package for file $f and store in $p: debug "matching $f\n"; - my $p = $cacheall ? $$f2p{$f} : safebacktick($PKG_INFO, '-qGW', $f); + my $p = $cacheall ? $$f2p{$f} : &$pf2p($f); if (!$p) { debug "file $f not in packages\n"; push @notfound, $f; @@ -233,7 +265,7 @@ while ($f = each %ufiles) { # Obtain file list for package and purge from %ufiles: push @pkgs, $p; - my @pf = $cacheall ? @{$$pfl{$p}} : safebacktick($PKG_INFO, '-qGL', $p); + my @pf = $cacheall ? @{$$pfl{$p}} : &$pfiles($p); chomp @pf; debug "deleting files @pf\n"; delete @ufiles{@pf}; @@ -243,9 +275,9 @@ while ($f = each %ufiles) { # If desired, map package names to package origins: if ($origins) { if ($cacheall) { - @pkgs = map { $p2o{$_}; } @pkgs; + @pkgs = map { $_ = $p2o{$_}; } @pkgs; } else { - @pkgs = map { $_ = safebacktick($PKG_INFO, '-qGo', $_); chomp $_; $_; } @pkgs; + @pkgs = map { $_ = &$pogn($_); chomp $_; $_; } @pkgs; } } @@ -293,7 +325,7 @@ sub safebacktick(@) { @data = ; close KID or warn $! ? "Error reading from kid: $!" - : "Exit status $? from kid."; + : "Exit status $? from kid"; } else { debug "running '", join("' '", @args), "'\n"; exec { $args[0] } @args; @@ -307,7 +339,7 @@ sub safebacktick(@) { sub readcache() { my %f2p = (); # file-to-package hash (string, string) my %pfl = (); # package-files hash (string, array) - my @pkgs = map { $_ =~ $UNTAINT; $1; } safebacktick($PKG_INFO, '-EG', '-a'); + my @pkgs = map { $_ =~ $UNTAINT; $1; } &$pall(); my $n = scalar @pkgs; debug "subreadcache: got $n packages.\n"; # Request file lists of so many packages at once, to save the @@ -315,7 +347,7 @@ sub readcache() { # This speeds up things by an order of magnitude or so. my $chunksize = 100; while (my @p = splice(@pkgs, 0, $chunksize)) { - my @fl = safebacktick($PKG_INFO, '-QGL', @p); + my @fl = &$pfilesmulti(@p); chomp @fl; my $pkg; map { @@ -324,10 +356,11 @@ sub readcache() { $pkg = $1; $pkg =~ s/:$//; # strip trailing colon } + s/^\s+//o; if ($_) { # file name if ($pkg) { $f2p{$_} = $pkg; push @{$pfl{$pkg}}, $_;} else { warn "pkg_info fault, missed package prefix before line $_."; } - } else { + } elsif ($_ ne '') { warn "tainted file name in $pkg: $_"; } } @fl; @@ -339,7 +372,7 @@ sub readcache() { # build a hash of package-to-origin and return it sub readorigins() { my %p2o = (); - my @ol = safebacktick($PKG_INFO, '-QGoa'); + my @ol = &$pallomap(); chomp @ol; my ($k, $v); map { $_ =~ $UNTAINT; @@ -373,6 +406,18 @@ L(8), L(8), L