michael@428: ##
michael@428: ##  makeproxy.pl -- OpenPKG Tool Chain
michael@428: ##  Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
michael@428: ##
michael@428: ##  This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
michael@428: ##  All rights reserved. Licenses which grant limited permission to use,
michael@428: ##  copy, modify and distribute this software are available from the
michael@428: ##  OpenPKG GmbH.
michael@428: ##
michael@428: ##  THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
michael@428: ##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
michael@428: ##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
michael@428: ##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
michael@428: ##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
michael@428: ##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
michael@428: ##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
michael@428: ##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
michael@428: ##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
michael@428: ##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
michael@428: ##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
michael@428: ##  SUCH DAMAGE.
michael@428: ##
michael@428: 
michael@428: require 5.003;
michael@428: 
michael@428: #   OpenPKG instance prefix and RPM
michael@428: my $my_prefix = $ENV{'OPENPKG_PREFIX'};
michael@428: my $my_rpm    = "$my_prefix/bin/openpkg rpm";
michael@428: delete $ENV{'OPENPKG_PREFIX'};
michael@428: 
michael@428: #   program identification
michael@428: my $progname  = "makeproxy";
michael@428: my $progvers  = "2.1.0";
michael@428: 
michael@428: #   parameters (defaults)
michael@428: my $help          = 0;
michael@428: my $version       = 0;
michael@428: my $verbose       = 0;
michael@428: my $debug         = 0;
michael@428: my $slave_prefix  = $my_prefix;
michael@428: my $master_prefix = '';
michael@428: my $tmpdir        = ($ENV{TMPDIR} || "/tmp");
michael@428: my $output        = '.';
michael@428: my $input         = '-';
michael@428: 
michael@428: #   cleanup support
michael@428: my @cleanup = ();
michael@428: sub cleanup_remember {
michael@428:     my ($cmd) = @_;
michael@428:     push(@cleanup, $cmd);
michael@428: }
michael@428: sub cleanup_perform {
michael@428:     foreach my $cmd (reverse @cleanup) {
michael@428:         runcmd($cmd);
michael@428:     }
michael@428: }
michael@428: 
michael@428: #   exception handling support
michael@428: $SIG{__DIE__} = sub {
michael@428:     my ($err) = @_;
michael@428:     $err =~ s|\s+at\s+.*||s if (not $verbose);
michael@428:     $err =~ s/\n+$//s;
michael@428:     print STDERR "openpkg:$progname:ERROR: $err\n";
michael@428:     cleanup_perform() if (not $verbose);
michael@428:     exit(1);
michael@428: };
michael@428: 
michael@428: #   verbose message printing
michael@428: sub verbose {
michael@428:     my ($msg) = @_;
michael@428:     print STDERR "$msg\n" if ($verbose);
michael@428: }
michael@428: 
michael@428: #   execution of external commands
michael@428: sub runcmd {
michael@428:     my ($cmd) = @_;
michael@428:     if ($cmd =~ m/^(.+)\|$/s) {
michael@428:         print STDERR "\$ $1\n" if ($debug);
michael@428:         return `$1`;
michael@428:     }
michael@428:     else {
michael@428:         print STDERR "\$ $cmd\n" if ($debug);
michael@428:         $cmd = "($cmd) >/dev/null 2>&1" if (not $debug);
michael@428:         return (system($cmd) == 0);
michael@428:     }
michael@428: }
michael@428: 
michael@428: #   expand into a full filesystem path
michael@428: sub fullpath {
michael@428:     my ($prog) = @_;
michael@428:     my $fullprog = '';
michael@428:     foreach my $path (split(/:/, $ENV{PATH})) {
michael@428:         if (-x "$path/$prog") {
michael@428:             $fullprog = "$path/$prog";
michael@428:             last;
michael@428:         }
michael@428:     }
michael@428:     return $fullprog;
michael@428: }
michael@428: 
michael@428: #   convert a subdirectory (a/b/c/)
michael@428: #   into a corresponding reverse path (../../../)
michael@428: sub sub2rev {
michael@428:     my ($sub) = @_;
michael@428:     my $rev = '';
michael@428:     $sub =~ s|^/+||s;
michael@428:     $sub =~ s|/+$||s;
michael@428:     while ($sub =~ s|/[^/]+||) {
michael@428:         $rev .= "../";
michael@428:     }
michael@428:     if ($sub ne '') {
michael@428:         $rev .= "../";
michael@428:     }
michael@428:     $rev =~ s|/$||s;
michael@428:     return $rev;
michael@428: }
michael@428: 
michael@428: #   create a directory (plus its missing parent dirs)
michael@428: sub mkdirp {
michael@428:     my ($dir) = @_;
michael@428:     my $pdir = $dir;
michael@428:     $pdir =~ s|/[^/]*$||s;
michael@428:     if (not -d $pdir) {
michael@428:         mkdirp($pdir);
michael@428:     }
michael@428:     if (not -d $dir) {
michael@428:         runcmd("mkdir $dir");
michael@428:     }
michael@428: }
michael@428: 
michael@428: #   home-brewn getopt(3) style option parser
michael@428: sub getopts ($) {
michael@428:     my ($opts) = @_;
michael@428:     my (%optf) = map { m/(\w)/; $1 => $_ } $opts =~ m/(\w:|\w)/g;
michael@428:     my (%opts, @argv, $optarg);
michael@428: 
michael@428:     foreach (@ARGV) {
michael@428:         if (@argv) {
michael@428:             push @argv, $_;
michael@428:         } elsif (defined $optarg) {
michael@428:             if (exists $opts{$optarg}) {
michael@428:                 $opts{$optarg} .= " $_";
michael@428:             } else {
michael@428:                 $opts{$optarg} = $_;
michael@428:             }
michael@428:             $optarg = undef;
michael@428:         } elsif (!/^[-]/) {
michael@428:             push @argv, $_;
michael@428:         } else {
michael@428:             while (/^\-(\w)(.*)/) {
michael@428:                 if (exists $optf{$1}) {
michael@428:                     if (length($optf{$1}) > 1) {
michael@428:                         if ($2 ne '') {
michael@428:                             if (exists $opts{$1}) {
michael@428:                                 $opts{$1} .= " $2";
michael@428:                             } else {
michael@428:                                 $opts{$1} = $2;
michael@428:                             }
michael@428:                         } else {
michael@428:                             $optarg = $1;
michael@428:                         }
michael@428:                         last;
michael@428:                     } else {
michael@428:                         $opts{$1} = 1;
michael@428:                     }
michael@428:                 } else {
michael@428:                     warn "openpkg:makeproxy:WARNING: unknown option $_\n";
michael@428:                 }
michael@428:                 $_ = "-$2";
michael@428:             }
michael@428:         }
michael@428:     }
michael@428:     if (defined $optarg) {
michael@428:         warn "openpkg:makeproxy:WARNING: option $optarg requires an argument\n";
michael@428:     }
michael@428:     foreach (keys %opts) {
michael@428:         eval '$opt_'.$_.' = "'.quotemeta($opts{$_}).'";';
michael@428:     }
michael@428:     @ARGV = @argv;
michael@428: }
michael@428: 
michael@428: #   command line parsing
michael@428: getopts("Vhdvm:s:t:o:");
michael@428: $version       = $opt_V if (defined $opt_V);
michael@428: $help          = $opt_h if (defined $opt_h);
michael@428: $debug         = $opt_d if (defined $opt_d);
michael@428: $verbose       = $opt_v if (defined $opt_v);
michael@428: $master_prefix = $opt_m if (defined $opt_m);
michael@428: $slave_prefix  = $opt_s if (defined $opt_s);
michael@428: $tmpdir        = $opt_t if (defined $opt_t);
michael@428: $output        = $opt_o if (defined $opt_o);
michael@428: if ($help) {
michael@428:     print "Usage: openpkg $progname [options] master-package\n" .
michael@428:           " -h,--help          print this usage page\n" .
michael@428:           " -V,--version       print version\n" .
michael@428:           " -v,--verbose       print verbose run-time information\n" .
michael@428:           " -d,--debug         print debug information\n" .
michael@428:           " -m,--master=DIR    filesystem path to master OpenPKG instance\n" .
michael@428:           " -s,--slave=DIR     filesystem path to slave OpenPKG instance\n" .
michael@428:           " -t,--tmpdir=DIR    filesystem path to temporary directory\n" .
michael@428:           " -o,--output=FILE   filesystem path to output proxy OpenPKG RPM package\n";
michael@428:     exit(0);
michael@428: }
michael@428: if ($version) {
michael@428:     print "OpenPKG $progname $progvers\n";
michael@428:     exit(0);
michael@428: }
michael@428: if ($#ARGV == 0) {
michael@428:     $input = shift(@ARGV);
michael@428: }
michael@428: if ($#ARGV != -1) {
michael@428:     die "invalid number of command line arguments";
michael@428: }
michael@428: 
michael@428: #   prepare temporary location
michael@428: verbose("++ prepare temporary directory");
michael@428: $tmpdir = "$tmpdir/$progname.$$";
michael@428: if (not -d $tmpdir) {
michael@428:     runcmd("umask 077 && mkdir $tmpdir")
michael@428:         or die "cannot create temporary directory \"$tmpdir\"";
michael@428:     cleanup_remember("rm -rf $tmpdir");
michael@428: }
michael@428: verbose("-- temporary directory: $tmpdir");
michael@428: 
michael@428: #   determine input and output RPM
michael@428: verbose("++ determining OpenPKG RPM package files");
michael@428: verbose("-- input/master/regular RPM package: $input");
michael@428: verbose("-- output/slave/proxy   RPM package: $output");
michael@428: 
michael@428: #   ensure input RPM package is available on the filesystem
michael@428: if ($input eq '-') {
michael@428:     $input = "$tmpdir/input.rpm";
michael@428:     runcmd("cat >$input");
michael@428: }
michael@428: 
michael@428: #   determine master and slave OpenPKG instance and RPM commands
michael@428: if ($master_prefix eq '') {
michael@428:     if (not -f $input) {
michael@428:         die "input/master/regular RPM package does not exist: \"$input\"";
michael@428:     }
michael@428:     $master_prefix = runcmd("($my_rpm -qp --qf '%{PREFIXES}' $input 2>/dev/null || true) |");
michael@428:     $master_prefix =~ s/\r?\n$//s;
michael@428:     if ($master_prefix eq '') {
michael@428:         die "unable to determine master OpenPKG instance";
michael@428:     }
michael@428: }
michael@428: if ($master_prefix eq $slave_prefix) {
michael@428:     die "master and slave OpenPKG instances have to be different";
michael@428: }
michael@428: my $slave_rpm  = (-f "$slave_prefix/bin/openpkg"  ? "$slave_prefix/bin/openpkg rpm"  : $my_rpm);
michael@428: my $master_rpm = (-f "$master_prefix/bin/openpkg" ? "$master_prefix/bin/openpkg rpm" : $my_rpm);
michael@428: verbose("-- tool   OpenPKG instance:    $my_prefix");
michael@428: verbose("-- tool   OpenPKG RPM command: $my_rpm");
michael@428: verbose("-- master OpenPKG instance:    $master_prefix");
michael@428: verbose("-- master OpenPKG RPM command: $master_rpm");
michael@428: verbose("-- slave  OpenPKG instance:    $slave_prefix");
michael@428: verbose("-- slave  OpenPKG RPM command: $slave_rpm");
michael@428: 
michael@428: #   helper function for parsing RPM query outputs
michael@428: sub parseresponse {
michael@428:     my ($r, $o) = @_;
michael@428:     sub parseline {
michael@428:         my ($r, $t, $k, $v) = @_;
michael@428:         $v =~ s|^\s+||s;
michael@428:         $v =~ s|\s+$||s;
michael@428:         if ($t eq 'S') {     # single-value results
michael@428:             $r->{$k} = $v;
michael@428:         }
michael@428:         elsif ($t eq 'M') {  # multi-value results
michael@428:             $r->{$k} = [] if (not defined($r->{$k}));
michael@428:             push(@{$r->{$k}}, $v);
michael@428:         }
michael@428:     }
michael@428:     $o =~ s|([SM])-([^:]+):<(.*?)>\n|parseline($r, $1, $2, $3, '')|egs;
michael@428:     return $r;
michael@428: }
michael@428: 
michael@428: #   query master OpenPKG RPM package
michael@428: verbose("++ query information from master OpenPKG RPM package");
michael@428: my $q = '';
michael@428: foreach my $t (qw(
michael@428:     NAME SUMMARY URL VENDOR PACKAGER DISTRIBUTION CLASS GROUP LICENSE VERSION RELEASE
michael@428:     DESCRIPTION
michael@428: )) {
michael@428:     $q .= "S-$t:<%{$t}>\\n";
michael@428: }
michael@428: $q .= '[M-PREREQ:<%{REQUIRENAME} %|REQUIREFLAGS?{%{REQUIREFLAGS:depflags} %{REQUIREVERSION}}:{}|>\n]';
michael@428: $q .= '[M-PROVIDES:<%{PROVIDENAME} %|PROVIDEFLAGS?{%{PROVIDEFLAGS:depflags} %{PROVIDEVERSION}}:{}|>\n]';
michael@428: $q .= '[M-PREFIXES:<%{PREFIXES}>\n]';
michael@428: my $cmd = sprintf("%s -q %s --qf '$q' %s", $master_rpm, (-f $input ? "-p" : ""), $input);
michael@428: my $o = runcmd("$cmd|");
michael@428: if ($o =~ m/package .* is not installed/s) {
michael@428:     die "master package \"$input\" not installed in master OpenPKG instance \"$master_prefix\"";
michael@428: }
michael@428: $o =~ s|M-PREREQ:<rpmlib\(.*?\).*?>\n||gs;
michael@428: my $r = {};
michael@428: $r = parseresponse($r, $o);
michael@428: my $BD = '';
michael@428: my $ID = '';
michael@428: my $PR = '';
michael@428: foreach my $d (@{$r->{PREREQ}}) {
michael@428:     if ($d =~ m|^OpenPKG|i) {
michael@428:         $BD .= ", " if ($BD ne '');
michael@428:         $BD .= $d;
michael@428:     }
michael@428:     $ID .= ", " if ($ID ne '');
michael@428:     $ID .= $d;
michael@428: }
michael@428: foreach my $d (@{$r->{PROVIDES}}) {
michael@428:     $PR .= ", " if ($PR ne '');
michael@428:     $PR .= $d;
michael@428: }
michael@428: 
michael@428: #   prepare build environment
michael@428: verbose("++ establishing temporary OpenPKG RPM environment");
michael@428: verbose("-- directory: $tmpdir");
michael@428: runcmd("rm -rf $tmpdir/src; mkdir $tmpdir/src");
michael@428: runcmd("rm -rf $tmpdir/bld; mkdir $tmpdir/bld");
michael@428: cleanup_remember("rm -rf $tmpdir/src");
michael@428: cleanup_remember("rm -rf $tmpdir/tmp");
michael@428: cleanup_remember("rm -rf $tmpdir/bld");
michael@428: cleanup_remember("rm -rf $tmpdir/pkg");
michael@428: runcmd("mkdir $tmpdir/src/.openpkg");
michael@428: open(MACRO, ">$tmpdir/src/.openpkg/rpmmacros")
michael@428:     or die "unable to write file \"$tmpdir/src/.openpkg/rpmmacros\": $!";
michael@428: print MACRO "\%openpkg_layout macrosfile=\%{macrosfile} layout=local shared=no\n";
michael@428: close(MACRO);
michael@428: $ENV{HOME} = $tmpdir;
michael@428: 
michael@428: #   generate OpenPKG RPM .spec file for proxy OpenPKG RPM package
michael@428: verbose("++ generating OpenPKG RPM package specification for proxy package");
michael@428: verbose("-- file: $tmpdir/src/".$r->{NAME}.".spec");
michael@428: my $S = '';
michael@428: $S .= "Name:         ".$r->{NAME}."\n";
michael@428: $S .= "Summary:      ".$r->{SUMMARY}."\n";
michael@428: $S .= "URL:          ".$r->{URL}."\n";
michael@428: $S .= "Vendor:       ".$r->{VENDOR}."\n";
michael@428: $S .= "Packager:     ".$r->{PACKAGER}."\n";
michael@428: $S .= "Distribution: ".$r->{DISTRIBUTION}."\n";
michael@428: $S .= "Class:        ".$r->{CLASS}."\n";
michael@428: $S .= "Group:        ".$r->{GROUP}."\n";
michael@428: $S .= "License:      ".$r->{LICENSE}."\n";
michael@428: $S .= "Version:      ".$r->{VERSION}."\n";
michael@428: $S .= "Release:      ".$r->{RELEASE}."+PROXY\n";
michael@428: $S .= "\n";
michael@428: $S .= "BuildPreReq:  $BD\n" if ($BD ne '');
michael@428: $S .= "PreReq:       $ID\n" if ($ID ne '');
michael@428: $S .= "Provides:     $PR\n" if ($PR ne '');
michael@428: $S .= "\n";
michael@428: $S .= "\%description\n";
michael@428: $S .= "    ".$r->{DESCRIPTION}."\n";
michael@428: $S .= "\n";
michael@428: $S .= "\%install\n";
michael@428: $S .= "    \%{l_rpmtool} files -v -ofiles -r\$RPM_BUILD_ROOT \%{l_files_std}\n";
michael@428: $S .= "\n";
michael@428: $S .= "\%files -f files\n";
michael@428: $S .= "\n";
michael@428: open(SPEC, ">$tmpdir/src/".$r->{NAME}.".spec")
michael@428:    or die "unable to write file \"$tmpdir/src/".$r->{NAME}."\": $!";
michael@428: print SPEC $S;
michael@428: close(SPEC);
michael@428: 
michael@428: #   creating shadow tree of original contents
michael@428: verbose("++ creating shadow tree from original package contents");
michael@428: $q = '[%{FILEMODES:perms} %{FILENAMES}\n]';
michael@428: $cmd = sprintf("%s -q %s --qf '$q' '%s'", $master_rpm, (-f $input ? "-p" : ""), $input);
michael@428: my @FL = runcmd("$cmd|");
michael@428: my $FD = [];
michael@428: my $FR = [];
michael@428: foreach my $fl (@FL) {
michael@428:     $fl =~ s|\n$||s;
michael@428:     if ($fl =~ m|^(d\S+)\s+$master_prefix(.*)$|) {
michael@428:         mkdirp("$tmpdir/bld$slave_prefix$2");
michael@428:         verbose("-- | PHYS $1 $slave_prefix$2");
michael@428:     }
michael@428:     elsif ($fl =~ m|^(\S+)\s+$master_prefix(.*?)([^/\s]+)$|) {
michael@428:         my ($subdir, $file) = ($2, $3);
michael@428:         my $target = sub2rev($subdir)."/.prefix-".$r->{NAME}.$subdir.$file;
michael@428:         mkdirp("$tmpdir/bld$slave_prefix$subdir");
michael@428:         runcmd("ln -s $target $tmpdir/bld$slave_prefix$subdir$file");
michael@428:         verbose("-- | VIRT $1 $slave_prefix$subdir$file");
michael@428:     }
michael@428: }
michael@428: 
michael@428: #   create master-reference symbolic link
michael@428: runcmd("ln -s $master_prefix $tmpdir/bld$slave_prefix/.prefix-".$r->{NAME});
michael@428: 
michael@428: #   rolling output proxy RPM package
michael@428: verbose("++ rolling output proxy RPM package");
michael@428: runcmd(
michael@428:     "cd $tmpdir/src && " .
michael@428:     "$slave_rpm -bb " .
michael@428:     "--define 'buildroot $tmpdir/bld' " .
michael@428:     "--define '__spec_install_pre \%{___build_pre}' " .
michael@428:     "--nodeps ".$r->{NAME}.".spec"
michael@428: );
michael@428: 
michael@428: #   providing output
michael@428: verbose("++ providing output: $output");
michael@428: if ($output eq '-') {
michael@428:     runcmd("cat $tmpdir/src/*.rpm");
michael@428: }
michael@428: else {
michael@428:     runcmd("cp $tmpdir/src/*.rpm $output");
michael@428: }
michael@428: 
michael@428: #   die gracefully...
michael@428: verbose("++ cleaning up environment");
michael@428: cleanup_perform();
michael@428: exit(0);
michael@428: