OpenPKG Specs: openpkg/mirror.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 ##  mirror.pl -- OpenPKG Package Mirroring

     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 tools

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

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

    29 my $my_openssl = "$my_prefix/lib/openpkg/openssl";

    30 delete $ENV{'OPENPKG_PREFIX'};

    32 #   program identification

    33 my $progname  = "search";

    34 my $progvers  = "0.1.0";

    36 #   determine reasonable temporary directory

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

    39 #   use unbuffered stdout

    40 $|++;

    42 ##

    43 ##  COMMAND-LINE INTERFACE HANDLING

    44 ##

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

    47 sub getopts ($$@) {

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

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

    50     my (@argv, $optarg);

    52     foreach (@argv_orig) {

    53         if (@argv) {

    54             push @argv, $_;

    55         } elsif (defined $optarg) {

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

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

    58             } else {

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

    60             }

    61             $optarg = undef;

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

    63             push @argv, $_;

    64         } else {

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

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

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

    68                         if ($2 ne '') {

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

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

    71                             } else {

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

    73                             }

    74                         } else {

    75                             $optarg = $1;

    76                         }

    77                         last;

    78                     } else {

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

    80                     }

    81                 } else {

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

    83                 }

    84                 $_ = "-$2";

    85             }

    86         }

    87     }

    88     if (defined $optarg) {

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

    90     }

    91     foreach my $opt (keys %optf) {

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

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

    94         }

    95     }

    96     return @argv;

    97 }

    99 #   parse command line options

   100 my $opts = {};

   101 @ARGV = getopts("hfqr:p:C:", $opts, @ARGV);

   103 #   usage sanity check and usage help

   104 sub usage {

   105     my ($rc) = @_;

   106     my $usage = "openpkg:$prog_name:USAGE: openpkg mirror [-h] [-f] [-C <cache-file>] [-r <remote-url>] [-p <remote-url-prefix>] <local-prefix-dir>\n";

   107     if ($rc == 0) {

   108         print STDOUT $usage;

   109     }

   110     else {

   111         print STDERR $usage;

   112     }

   113     exit($rc);

   114 }

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

   116     usage(0);

   117 }

   118 if (@ARGV != 1) {

   119     usage(1);

   120 }

   122 #   determine arguments

   123 my ($localprefixdir) = @ARGV;

   124 if (not -d $localprefixdir) {

   125     print STDERR "openpkg:$prog_name:ERROR: local directory already has to exist: $localprefixdir\n";

   126     exit(1);

   127 }

   129 #   determine start URL

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

   131 if ($url eq "") {

   132     $url = `$my_prefix/bin/openpkg release --fmt='%u' 2>/dev/null`;

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

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

   135 }

   136 if ($url eq "") {

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

   138     exit(1);

   139 }

   141 #   determine URL prefix

   142 my $remoteprefixurl = $opts->{"p"};

   143 if (not defined $remoteprefixurl) {

   144     $remoteprefixurl = $url;

   145     $remoteprefixurl =~ s/\/([^\/]+)$//s;

   146 }

   148 ##

   149 ##  HELPER FUNCTIONS

   150 ##

   152 #   determine size and mtime of a file

   153 sub sizetime ($) {

   154     my ($file) = @_;

   155     my @stat = stat($file);

   156     return ($stat[7], $stat[9]);

   157 }

   159 #   determine MD5 of a file

   160 sub digest ($) {

   161     my ($file) = @_;

   162     my $digest = "";

   163     my $output = `($my_openssl md5 -hex "$file") 2>/dev/null || true`;

   164     if ($output =~ m/MD5\(.+?\)=\s*([0-9a-fA-F]+)/s) {

   165         $digest = uc($1);

   166     }

   167     return $digest;

   168 }

   170 #   print a byte size in human-readable form

   171 sub humansize ($) {

   172     my ($bytes) = @_;

   173     my $size = "";

   174     if    ($bytes > 1024*1024*1024) { $size = sprintf("%.1fGB", $bytes / (1024*1024*1024)); }

   175     elsif ($bytes > 1024*1024)      { $size = sprintf("%.1fMB", $bytes / (1024*1024)     ); }

   176     elsif ($bytes > 1024)           { $size = sprintf("%.1fKB", $bytes / (1024)          ); }

   177     else                            { $size = sprintf("%dB",    $bytes                   ); }

   178     return $size;

   179 }

   181 #   caching support: load cache

   182 sub cache_load () {

   183     my $cache = {};

   184     if ($opts->{"C"}) {

   185         if (-f $opts->{"C"}) {

   186             #   load cache file

   187             open(FP, "<" . $opts->{"C"})

   188                 or die "unable to load cache file: " . $opts->{"C"};

   189             my $txt = ""; $txt .= $_ while (<FP>);

   190             close(FP);

   192             #   parse cache file

   193             $txt =~ s/^\s*(\d+)\s+(\d+)\s+([\da-fA-F]+)\s+(.+)$/

   194                 $cache->{$4} = { size => $1, mtime => $2, md5 => $3 }, ''

   195             /mge;

   196         }

   197     }

   198     return $cache;

   199 }

   201 #   caching support: save cache

   202 sub cache_save ($) {

   203     my ($cache) = @_;

   204     if ($opts->{"C"}) {

   205         #   generate cache file

   206         my $txt = "";

   207         foreach my $url (sort { $a cmp $b } keys %{$cache}) {

   208             $txt .= sprintf("%10d %10d %s %s\n",

   209                 $cache->{$url}->{"size"},

   210                 $cache->{$url}->{"mtime"},

   211                 $cache->{$url}->{"md5"},

   212                 $url

   213             );

   214         }

   216         #   write cache file

   217         open(FP, ">" . $opts->{"C"})

   218             or die "unable to save cache file: " . $opts->{"C"};

   219         print FP $txt;

   220         close(FP);

   221     }

   222     return;

   223 }

   225 ##

   226 ##   DETERMINE LOCAL AND REMOTE FILES

   227 ##

   229 #   optionally load the cache

   230 my $cache = cache_load();

   232 #   determine local files

   233 print "++ determining local files\n";

   234 my @local_files = map {

   235     s/\r?\n$//s;

   236     s/\/$//s;

   237     $_;

   238 } `find $localprefixdir -depth -print`;

   239 print "-- local: " . @local_files . " files\n";

   241 #   determine remote files

   242 print "++ determining remote files\n";

   243 sub relurl ($$) {

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

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

   246         $url = $suburl;

   247     }

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

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

   250     }

   251     else {

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

   253     }

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

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

   256     return $url;

   257 }

   258 sub parse_attr ($) {

   259     my ($xml) = @_;

   260     my $info = { href => "", size => -1, mtime => -1, md5 => "-" };

   261     $info->{"href"}  = $1 if ($xml =~ m/\bhref="([^"]*)"/s);

   262     $info->{"size"}  = $1 if ($xml =~ m/\bsize="([^"]*)"/s);

   263     $info->{"mtime"} = $1 if ($xml =~ m/\bmtime="([^"]*)"/s);

   264     $info->{"md5"}   = $1 if ($xml =~ m/\bmd5="([^"]*)"/s);

   265     return $info;

   266 }

   267 sub get_urls ($) {

   268     my ($info) = @_;

   270     #   determine URL

   271     my $url = $info->{"href"};

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

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

   274     }

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

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

   277     }

   278     $info->{"href"} = $url;

   280     #   fetch URL content

   281     print "-- fetching XML/RDF index: $url\n";

   282     my $tmpfile = "$tmpdir/openpkg-mirror.tmp";

   283     unlink($tmpfile);

   284     my $cmd = "$my_prefix/bin/openpkg curl -k -s -R -o \"$tmpfile\" \"$url\"";

   285     system($cmd);

   286     my $xml;

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

   288         $xml = `$my_prefix/lib/openpkg/bzip2 -d -c <"$tmpfile"`;

   289     }

   290     else {

   291         $xml = `cat "$tmpfile"`;

   292     }

   294     #   provide information about this URL

   295     my @urls = ();

   296     if ($info->{"size"} == -1 or $info->{"mtime"} == -1) {

   297         my ($S, $T) = sizetime($tmpfile);

   298         $info->{"size"} = $S;

   299         $info->{"mtime"} = $T;

   300     }

   301     if ($info->{"md5"} eq "-") {

   302         $info->{"md5"} = digest($tmpfile);

   303     }

   304     push(@urls, $info);

   305     unlink($tmpfile);

   307     #   parse references

   308     my @ref1 = ();

   309     my @ref2 = ();

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

   311         push(@ref1, $1);

   312     }

   313     while ($xml =~ m/<rdf:Description\s+([^>]*href=[^>]*)>/gs) {

   314         push(@ref2, $1);

   315     }

   317     #   provide information about referenced leave URLs

   318     foreach my $ref2 (@ref2) {

   319         my $i = parse_attr($ref2);

   320         $i->{"href"} = relurl($url, $i->{"href"});

   321         push(@urls, $i);

   322     }

   324     #   provide information about referenced index URLs

   325     foreach my $ref1 (@ref1) {

   326         my $i = parse_attr($ref1);

   327         $i->{"href"} = relurl($url, $i->{"href"});

   328         push(@urls, get_urls($i)); # RECURSION

   329     }

   331     return @urls;

   332 }

   333 my @remote_urls = get_urls({ href => $url, size => -1, mtime => -1, md5 => "-" });

   334 my $size = 0;

   335 foreach my $url (@remote_urls) {

   336     $size += int($url->{"size"}) if ($url->{"size"} > 0);

   337 }

   338 print "-- remote: " . @remote_urls . " files (" . humansize($size) . ")\n";

   340 ##

   341 ##   DOWNLOAD NEW OR UPDATED REMOTE FILES

   342 ##

   344 #   fetching remote files

   345 print "++ fetching new/updated files\n";

   346 my $local_files_keep = {};

   347 sub keep ($) {

   348     my ($path) = @_;

   349     #   keep path and all its parent paths

   350     while ($path ne "") {

   351         $local_files_keep->{$path} = 1;

   352         $path =~ s/(?:^\/$|\/?[^\/]+$)//s;

   353     }

   354 }

   355 sub mkdir_for_file ($$) {

   356     my ($prefix, $path) = @_;

   357     $path =~ s/(?:^\/$|\/?[^\/]+$)//s;

   358     my @dirs = split("/", $path);

   359     $path = $prefix;

   360     $path =~ s/\/$//s;

   361     foreach my $dir (@dirs) {

   362         $path .= "/$dir";

   363         if (not -d $path) {

   364             print "-- creating: $path\n";

   365             system("mkdir \"$path\"");

   366         }

   367     }

   368 }

   369 foreach my $remote_url (@remote_urls) {

   370     my $href = $remote_url->{"href"};

   371     if ($href =~ m/^\Q$remoteprefixurl\E(.+)$/) {

   372         #   derive local path

   373         my $local_path = $1;

   374         my $local_file = $localprefixdir . $local_path;

   375         keep($local_file);

   377         #   determine information about local path

   378         my $download = 1;

   379         my $cache_update = 0;

   380         my ($size, $mtime, $md5);

   381         if (-f $local_file) {

   382             my $c = $cache->{$local_file};

   383             $size  = $c->{"size"}  if (defined $c and defined $c->{"size"});

   384             $mtime = $c->{"mtime"} if (defined $c and defined $c->{"mtime"});

   385             if (not defined $size or not defined $mtime) {

   386                 ($size, $mtime) = sizetime($local_file);

   387                 $cache_update = 1;

   388             }

   389             if (    $size  == $remote_url->{"size"}

   390                 and $mtime == $remote_url->{"mtime"}) {

   391                 $md5 = $c->{"md5"} if (defined $c and defined $c->{"md5"});

   392                 if (not defined $md5) {

   393                     $md5 = digest($local_file);

   394                     $cache_update = 1;

   395                 }

   396                 if ($md5 eq $remote_url->{"md5"}) {

   397                     $download = 0;

   398                 }

   399             }

   400         }

   402         #   optionally download remote file to local path

   403         if ($download) {

   404             print "-- fetching: $local_path\n";

   405             mkdir_for_file($localprefixdir, $local_path);

   406             my $cmd = "$my_prefix/bin/openpkg curl";

   407             $cmd .= " -s"     if (    $opts->{"q"});

   408             $cmd .= " \"-#\"" if (not $opts->{"q"});

   409             $cmd .= " -k -R -o \"$local_file\" \"$href\"";

   410             system($cmd);

   411             ($size, $mtime) = sizetime($local_file);

   412             $md5 = digest($local_file);

   413             $cache_update = 1;

   414         }

   416         #   optionally update the size/mtime/md5 cache

   417         if ($opts->{"C"} and $cache_update) {

   418             $cache->{$local_file} = { size => $size, mtime => $mtime, md5 => $md5 };

   419             cache_save($cache);

   420         }

   421     }

   422     else {

   423         print "** WARNING: URL \"$href\" not under prefix \"$remoteprefixurl\": " .

   424             "unable to derive local path -- skipping URL\n";

   425     }

   426 }

   428 ##

   429 ##   REMOVE OBSOLETE LOCAL FILES

   430 ##

   432 #   remove obsolete files

   433 print "++ removing obsolete files\n";

   434 my $lf  = @local_files;

   435 my $lfk = keys %{$local_files_keep};

   436 if (not $opts->{"f"} and ($lf - $lfk) > ($lf * 0.3)) {

   437     print "** WARNING: more than 30% of your existing local files would be removed (require option -f)\n";

   438 }

   439 else {

   440     foreach my $local_file (@local_files) {

   441         if (not exists $local_files_keep->{$local_file}) {

   442             if (-f $local_file) {

   443                 print "-- removing: $local_file (file)\n";

   444                 system("rm \"$local_file\" >/dev/null 2>&1 || true");

   445             }

   446             elsif (-d $local_file) {

   447                 print "-- removing: $local_file (dir)\n";

   448                 system("rmdir \"$local_file\" >/dev/null 2>&1 || true");

   449             }

   450         }

   451     }

   452 }

   454 ##

   455 ##   CLEANUP

   456 ##

   458 #   optionally flush the cache

   459 cache_save($cache);

   461 #   exit gracefully

   462 exit(0);

OpenPKG Specs / file revision

openpkg/mirror.pl@c10fb90893b9

openpkg/mirror.pl