OpenPKG Specs: openpkg/search.pl@c10fb90893b9 (annotated)

openpkg/search.pl@c10fb90893b9 (annotated)

openpkg/search.pl

Thu, 04 Oct 2012 20:30:05 +0200

author: Michael Schloh von Bennewitz <michael@schloh.com>
date: Thu, 04 Oct 2012 20:30:05 +0200
changeset 715: c10fb90893b9
permissions: -rw-r--r--

Correct out of date build configuration, porting to Solaris 11 network
link infrastructure and new libpcap logic. This additionally allows for
device drivers in subdirectories of /dev. Correct packaged nmap
personalities and signatures to work out of the box. Finally, hack
arpd logic to properly close sockets and quit on TERM by repeating
signaling in the run command script. Sadly, all this fails to correct
the run time behaviour of honeyd which fails to bind to the IP layer.

 ##
 ##  search.pl -- OpenPKG Package Searching
 ##  Copyright (c) 2011-2012 OpenPKG GmbH <http://openpkg.com/>
 ##
 ##  This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
 ##  All rights reserved. Licenses which grant limited permission to use,
 ##  copy, modify and distribute this software are available from the
 ##  OpenPKG GmbH.
 ##
 ##  THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
 ##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 ##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 ##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
 ##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 ##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 ##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
 ##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 ##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 ##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
 ##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ##  SUCH DAMAGE.
 ##
 require 5.003;
 #   OpenPKG instance prefix and RPM
 my $my_prefix = $ENV{'OPENPKG_PREFIX'};
 my $my_rpm = "$my_prefix/bin/openpkg rpm";
 delete $ENV{'OPENPKG_PREFIX'};
 #   program identification
 my $progname  = "search";
 my $progvers  = "0.1.0";
 #   home-brewn getopt(3) style option parser
 sub getopts ($$@) {
     my ($opt_spec, $opts, @argv_orig) = @_;
     my (%optf) = map { m/(\w)/; $1 => $_ } $opt_spec =~ m/(\w:|\w)/g;
     my (@argv, $optarg);
     foreach (@argv_orig) {
         if (@argv) {
             push @argv, $_;
         } elsif (defined $optarg) {
             if (exists $opts->{$optarg}) {
                 $opts->{$optarg} .= " $_";
             } else {
                 $opts->{$optarg} = $_;
             }
             $optarg = undef;
         } elsif (!/^[-]/) {
             push @argv, $_;
         } else {
             while (/^\-(\w)(.*)/) {
                 if (exists $optf{$1}) {
                     if (length($optf{$1}) > 1) {
                         if ($2 ne '') {
                             if (exists $opts->{$1}) {
                                 $opts->{$1} .= " $2";
                             } else {
                                 $opts->{$1} = $2;
                             }
                         } else {
                             $optarg = $1;
                         }
                         last;
                     } else {
                         $opts->{$1} = 1;
                     }
                 } else {
                     warn "openpkg:$prog_name:WARNING: unknown option $_\n";
                 }
                 $_ = "-$2";
             }
         }
     }
     if (defined $optarg) {
         warn "openpkg:$prog_name:WARNING: option $optarg requires an argument\n";
     }
     foreach my $opt (keys %optf) {
         if (not exists $opts->{$opt}) {
             $opts->{$opt} = (length($optf{$opt}) > 1 ? "" : 0);
         }
     }
     return @argv;
 }
 #   execute a command
 my $run_cache = {};
 sub run ($) {
     my ($cmd) = @_;
     my $out = $run_cache->{$cmd};
     if (not defined($out)) {
         my @out = `$cmd`;
         $out = [ @out ];
         $run_cache->{$cmd} = $out;
     }
     return (wantarray ? @{$out} : join(//, @{$out}));
 }
 #   determine reasonable temporary directory
 my $tmpdir = ($ENV{"TMPDIR"} || "/tmp");
 #   parse command line options
 my $opts = {};
 @ARGV = getopts("hvr:", $opts, @ARGV);
 #   usage sanity check and usage help
 sub usage {
     my ($rc) = @_;
     my $usage = "openpkg:$prog_name:USAGE: openpkg search <regex>\n";
     if ($rc == 0) {
         print STDOUT $usage;
     }
     else {
         print STDERR $usage;
     }
     exit($rc);
 }
 if ($opts->{"h"}) {
     usage(0);
 }
 if (@ARGV == 0) {
     usage(1);
 }
 #   take command line arguments
 my $keyword = $ARGV[0];
 #   determine start URL
 my $url = $opts->{"r"} || "";
 if ($url eq "") {
     $url = run("$my_prefix/bin/openpkg release --fmt='%u' 2>/dev/null");
     $url =~ s/^\s+//s;
     $url =~ s/\s+$//s;
 }
 if ($url eq "") {
     print STDERR "openpkg:$prog_name:ERROR: no repository URL known\n";
     exit(1);
 }
 #   recursively download XML/RDF index
 sub relurl ($$) {
     my ($url, $suburl) = @_;
     if ($suburl =~ m/^\w+:\/\//) {
         $url = $suburl;
     }
     elsif ($suburl =~ m/^\//) {
         $url = "file://$suburl";
     }
     else {
         $url =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
     }
 while ($url =~ s/\/\.\//\//s);
 while ($url =~ s/\/[^\/]+\/\.\.\//\//s);
     return $url;
 }
 sub get_index ($) {
     my ($url) = @_;
     if ($url =~ m/^\//) {
         $url = "file://$url";
     }
     if ($url =~ m/\/$/) {
         $url .= "00INDEX.rdf";
     }
     my $cmd = "$my_prefix/bin/openpkg curl -s -o- \"$url\" 2>/dev/null";
     if ($url =~ m/\.bz2$/) {
         $cmd .= " | $my_prefix/lib/openpkg/bzip2 -d -c";
     }
     my $xml = run($cmd);
     my @includes = ();
     while ($xml =~ m/<Repository\s+[^>]*href="([^"]*)"/gs) {
         push(@includes, $1);
     }
     foreach my $include (@includes) {
         $xml .= get_index(relurl($url, $include));
     }
     return $xml;
 }
 my $xml = get_index($url);
 #   parse XML/RDF index
 my $x = $xml;
 $x =~ s/<rdf:Description\s+about="([^"]+)".*?>(.+?)<\/rdf:Description>/do1($1, $2), ''/sge;
 sub do1 {
     my ($nvr, $xml) = @_;
     my ($name) = ($xml =~ m|<Name>(.+?)</Name>|s);
     my ($vers) = ($xml =~ m|<Version>(.+?)</Version>|s);
     my ($rele) = ($xml =~ m|<Release>(.+?)</Release>|s);
     my ($summ) = ($xml =~ m|<Summary>(.+?)</Summary>|s);
     my ($desc) = ($xml =~ m|<Description>(.+?)</Description>|s);
     if (   $name =~ m|$keyword|si
         or $summ =~ m|$keyword|si
         or $desc =~ m|$keyword|si) {
         do2($nvr, $name, $vers, $rele, $summ, $desc, $xml);
     }
 }
 sub do2 {
     my ($nvr, $name, $vers, $rele, $summ, $desc, $xml) = @_;
     return if ($name eq "openpkg");
     if ($opts->{"v"}) {
         #   itemized verbose output
         my ($dist)     = ($xml =~ m|<Distribution>(.+?)</Distribution>|s);
         my ($class)    = ($xml =~ m|<Class>(.+?)</Class>|s);
         my ($group)    = ($xml =~ m|<Group>(.+?)</Group>|s);
         my ($license)  = ($xml =~ m|<License>(.+?)</License>|s);
         my ($packager) = ($xml =~ m|<Packager>(.+?)</Packager>|s);
         my ($url)      = ($xml =~ m|<URL>(.+?)</URL>|s);
         my ($vendor)   = ($xml =~ m|<Vendor>(.+?)</Vendor>|s);
         print "Name:     $name\n";
         print "Version:  $vers\n";
         print "Release:  $rele\n";
         print "Group:    $group\n";
         print "Class:    $class\n";
         print "Distrib:  $dist\n";
         print "License:  $license\n";
         print "Packager: $packager\n";
         print "Vendor:   $vendor\n";
         print "Summary:  $summ\n";
         print "URL:      $url\n";
         print "Description:\n";
         $desc =~ s/^\s+//mg;
         $desc =~ s/\s+$//mg;
         $desc =~ s/^/    /mg;
         print "$desc\n";
         my ($prov) = ($xml =~ m|<Provides>(.+?)</Provides>|s);
         if (($prov || "") ne "") {
             print "Provides:\n";
             $prov =~ s/<resource\s+equ="([^"]*)">(.+?)<\/resource>/do3($1, $2), ''/sge;
             sub do3 {
                 my ($val, $name) = @_;
                 print "    $name = $val\n";
             }
         }
         print "\n";
     }
     else {
         #   tabular brief output
         printf("%-20s %-10s %-9s %s\n", $name, $vers, $rele, $summ);
     }
 }

OpenPKG Specs / annotate

openpkg/search.pl@c10fb90893b9 (annotated)

openpkg/search.pl