OpenPKG Specs: openpkg/search.pl@c10fb90893b9

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.

     1 ##

     2 ##  search.pl -- OpenPKG Package Searching

     3 ##  Copyright (c) 2011-2012 OpenPKG GmbH <http://openpkg.com/>

     4 ##

     5 ##  This software is property of the OpenPKG GmbH, DE MUC HRB 160208.

     6 ##  All rights reserved. Licenses which grant limited permission to use,

     7 ##  copy, modify and distribute this software are available from the

     8 ##  OpenPKG GmbH.

     9 ##

    10 ##  THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED

    11 ##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

    12 ##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.

    13 ##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR

    14 ##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

    15 ##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

    16 ##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF

    17 ##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND

    18 ##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,

    19 ##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT

    20 ##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF

    21 ##  SUCH DAMAGE.

    22 ##

    24 require 5.003;

    26 #   OpenPKG instance prefix and RPM

    27 my $my_prefix = $ENV{'OPENPKG_PREFIX'};

    28 my $my_rpm = "$my_prefix/bin/openpkg rpm";

    29 delete $ENV{'OPENPKG_PREFIX'};

    31 #   program identification

    32 my $progname  = "search";

    33 my $progvers  = "0.1.0";

    35 #   home-brewn getopt(3) style option parser

    36 sub getopts ($$@) {

    37     my ($opt_spec, $opts, @argv_orig) = @_;

    38     my (%optf) = map { m/(\w)/; $1 => $_ } $opt_spec =~ m/(\w:|\w)/g;

    39     my (@argv, $optarg);

    41     foreach (@argv_orig) {

    42         if (@argv) {

    43             push @argv, $_;

    44         } elsif (defined $optarg) {

    45             if (exists $opts->{$optarg}) {

    46                 $opts->{$optarg} .= " $_";

    47             } else {

    48                 $opts->{$optarg} = $_;

    49             }

    50             $optarg = undef;

    51         } elsif (!/^[-]/) {

    52             push @argv, $_;

    53         } else {

    54             while (/^\-(\w)(.*)/) {

    55                 if (exists $optf{$1}) {

    56                     if (length($optf{$1}) > 1) {

    57                         if ($2 ne '') {

    58                             if (exists $opts->{$1}) {

    59                                 $opts->{$1} .= " $2";

    60                             } else {

    61                                 $opts->{$1} = $2;

    62                             }

    63                         } else {

    64                             $optarg = $1;

    65                         }

    66                         last;

    67                     } else {

    68                         $opts->{$1} = 1;

    69                     }

    70                 } else {

    71                     warn "openpkg:$prog_name:WARNING: unknown option $_\n";

    72                 }

    73                 $_ = "-$2";

    74             }

    75         }

    76     }

    77     if (defined $optarg) {

    78         warn "openpkg:$prog_name:WARNING: option $optarg requires an argument\n";

    79     }

    80     foreach my $opt (keys %optf) {

    81         if (not exists $opts->{$opt}) {

    82             $opts->{$opt} = (length($optf{$opt}) > 1 ? "" : 0);

    83         }

    84     }

    85     return @argv;

    86 }

    88 #   execute a command

    89 my $run_cache = {};

    90 sub run ($) {

    91     my ($cmd) = @_;

    92     my $out = $run_cache->{$cmd};

    93     if (not defined($out)) {

    94         my @out = `$cmd`;

    95         $out = [ @out ];

    96         $run_cache->{$cmd} = $out;

    97     }

    98     return (wantarray ? @{$out} : join(//, @{$out}));

    99 }

   101 #   determine reasonable temporary directory

   102 my $tmpdir = ($ENV{"TMPDIR"} || "/tmp");

   104 #   parse command line options

   105 my $opts = {};

   106 @ARGV = getopts("hvr:", $opts, @ARGV);

   108 #   usage sanity check and usage help

   109 sub usage {

   110     my ($rc) = @_;

   111     my $usage = "openpkg:$prog_name:USAGE: openpkg search <regex>\n";

   112     if ($rc == 0) {

   113         print STDOUT $usage;

   114     }

   115     else {

   116         print STDERR $usage;

   117     }

   118     exit($rc);

   119 }

   120 if ($opts->{"h"}) {

   121     usage(0);

   122 }

   123 if (@ARGV == 0) {

   124     usage(1);

   125 }

   127 #   take command line arguments

   128 my $keyword = $ARGV[0];

   130 #   determine start URL

   131 my $url = $opts->{"r"} || "";

   132 if ($url eq "") {

   133     $url = run("$my_prefix/bin/openpkg release --fmt='%u' 2>/dev/null");

   134     $url =~ s/^\s+//s;

   135     $url =~ s/\s+$//s;

   136 }

   137 if ($url eq "") {

   138     print STDERR "openpkg:$prog_name:ERROR: no repository URL known\n";

   139     exit(1);

   140 }

   142 #   recursively download XML/RDF index

   143 sub relurl ($$) {

   144     my ($url, $suburl) = @_;

   145     if ($suburl =~ m/^\w+:\/\//) {

   146         $url = $suburl;

   147     }

   148     elsif ($suburl =~ m/^\//) {

   149         $url = "file://$suburl";

   150     }

   151     else {

   152         $url =~ s/(\/)?\/*[^\/]*$/$1$suburl/;

   153     }

   154     1 while ($url =~ s/\/\.\//\//s);

   155     1 while ($url =~ s/\/[^\/]+\/\.\.\//\//s);

   156     return $url;

   157 }

   158 sub get_index ($) {

   159     my ($url) = @_;

   160     if ($url =~ m/^\//) {

   161         $url = "file://$url";

   162     }

   163     if ($url =~ m/\/$/) {

   164         $url .= "00INDEX.rdf";

   165     }

   166     my $cmd = "$my_prefix/bin/openpkg curl -s -o- \"$url\" 2>/dev/null";

   167     if ($url =~ m/\.bz2$/) {

   168         $cmd .= " | $my_prefix/lib/openpkg/bzip2 -d -c";

   169     }

   170     my $xml = run($cmd);

   171     my @includes = ();

   172     while ($xml =~ m/<Repository\s+[^>]*href="([^"]*)"/gs) {

   173         push(@includes, $1);

   174     }

   175     foreach my $include (@includes) {

   176         $xml .= get_index(relurl($url, $include));

   177     }

   178     return $xml;

   179 }

   180 my $xml = get_index($url);

   182 #   parse XML/RDF index

   183 my $x = $xml;

   184 $x =~ s/<rdf:Description\s+about="([^"]+)".*?>(.+?)<\/rdf:Description>/do1($1, $2), ''/sge;

   185 sub do1 {

   186     my ($nvr, $xml) = @_;

   187     my ($name) = ($xml =~ m|<Name>(.+?)</Name>|s);

   188     my ($vers) = ($xml =~ m|<Version>(.+?)</Version>|s);

   189     my ($rele) = ($xml =~ m|<Release>(.+?)</Release>|s);

   190     my ($summ) = ($xml =~ m|<Summary>(.+?)</Summary>|s);

   191     my ($desc) = ($xml =~ m|<Description>(.+?)</Description>|s);

   192     if (   $name =~ m|$keyword|si

   193         or $summ =~ m|$keyword|si

   194         or $desc =~ m|$keyword|si) {

   195         do2($nvr, $name, $vers, $rele, $summ, $desc, $xml);

   196     }

   197 }

   198 sub do2 {

   199     my ($nvr, $name, $vers, $rele, $summ, $desc, $xml) = @_;

   200     return if ($name eq "openpkg");

   201     if ($opts->{"v"}) {

   202         #   itemized verbose output

   203         my ($dist)     = ($xml =~ m|<Distribution>(.+?)</Distribution>|s);

   204         my ($class)    = ($xml =~ m|<Class>(.+?)</Class>|s);

   205         my ($group)    = ($xml =~ m|<Group>(.+?)</Group>|s);

   206         my ($license)  = ($xml =~ m|<License>(.+?)</License>|s);

   207         my ($packager) = ($xml =~ m|<Packager>(.+?)</Packager>|s);

   208         my ($url)      = ($xml =~ m|<URL>(.+?)</URL>|s);

   209         my ($vendor)   = ($xml =~ m|<Vendor>(.+?)</Vendor>|s);

   211         print "Name:     $name\n";

   212         print "Version:  $vers\n";

   213         print "Release:  $rele\n";

   214         print "Group:    $group\n";

   215         print "Class:    $class\n";

   216         print "Distrib:  $dist\n";

   217         print "License:  $license\n";

   218         print "Packager: $packager\n";

   219         print "Vendor:   $vendor\n";

   220         print "Summary:  $summ\n";

   221         print "URL:      $url\n";

   223         print "Description:\n";

   224         $desc =~ s/^\s+//mg;

   225         $desc =~ s/\s+$//mg;

   226         $desc =~ s/^/    /mg;

   227         print "$desc\n";

   229         my ($prov) = ($xml =~ m|<Provides>(.+?)</Provides>|s);

   230         if (($prov || "") ne "") {

   231             print "Provides:\n";

   232             $prov =~ s/<resource\s+equ="([^"]*)">(.+?)<\/resource>/do3($1, $2), ''/sge;

   233             sub do3 {

   234                 my ($val, $name) = @_;

   235                 print "    $name = $val\n";

   236             }

   237         }

   239         print "\n";

   240     }

   241     else {

   242         #   tabular brief output

   243         printf("%-20s %-10s %-9s %s\n", $name, $vers, $rele, $summ);

   244     }

   245 }

OpenPKG Specs / file revision

openpkg/search.pl@c10fb90893b9

openpkg/search.pl