#!/bin/sh -- # -*- perl -*-
eval 'exec perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;
##
##  mkproxyrpm -- Make OpenPKG Proxy RPM Package
##  Copyright (c) 2002 The OpenPKG Project <http://www.openpkg.org/>
##  Copyright (c) 2002 Ralf S. Engelschall <rse@engelschall.com>
##
##  Permission to use, copy, modify, and distribute this software for
##  any purpose with or without fee is hereby granted, provided that
##  the above copyright notice and this permission notice appear in all
##  copies.
##
##  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;
use strict;
use Getopt::Long;
use IO;

my $progname = "mkproxyrpm";
my $progvers = "0.9.2";

#   parameters (defaults)
my $version = 0;
my $verbose = 0;
my $debug   = 0;
my $help    = 0;
my $rpm     = 'rpm';
my $tmpdir  = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
my $output  = '.';
my $input   = '-';

#   cleanup support
my @cleanup = ();
sub cleanup_remember {
    my ($cmd) = @_;
    push(@cleanup, $cmd);
}
sub cleanup_perform {
    foreach my $cmd (@cleanup) {
        &runcmd($cmd);
    }
}

#   exception handling support 
$SIG{__DIE__} = sub {
    my ($err) = @_;
    $err =~ s|\s+at\s+.*||s if (not $verbose);
    print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
    &cleanup_perform() if (not $verbose);
    exit(1);
};

#   verbose message printing
sub verbose {
    my ($msg) = @_;
    print STDERR "$msg\n" if ($verbose);
}

#   execution of external commands
sub runcmd {
    my ($cmd) = @_;
    print STDERR "\$ $cmd\n" if ($debug);
    $cmd = "($cmd) >/dev/null 2>&1" if (not $debug);
    return (system($cmd) == 0);
}

#   expand into a full filesystem path
sub fullpath {
    my ($prog) = @_;
    my $fullprog = '';
    foreach my $path (split(/:/, $ENV{PATH})) {
        if (-x "$path/$prog") {
            $fullprog = "$path/$prog";
            last;
        }
    }
    return $fullprog;
}

#   convert a subdirectory (a/b/c/) 
#   into a corresponding reverse path (../../../)
sub sub2rev {
    my ($sub) = @_;
    my $rev = '';
    $sub =~ s|^/+||s;
    $sub =~ s|/+$||s;
    while ($sub =~ s|/[^/]+||) {
        $rev .= "../";
    }
    if ($sub ne '') {
        $rev .= "../";
    }
    $rev =~ s|/$||s;
    return $rev;
}

#   create a directory (plus its missing parent dirs)
sub mkdirp {
    my ($dir) = @_;
    my $pdir = $dir;
    $pdir =~ s|/[^/]*$||s;
    if (not -d $pdir) {
        &mkdirp($pdir);
    }
    if (not -d $dir) {
        &runcmd("mkdir $dir");
    }
}

#   command line parsing
Getopt::Long::Configure("bundling");
my $result = GetOptions(
    'V|version'     => \$version,
    'h|help'        => \$help,
    'd|debug'       => \$debug,
    'v|verbose'     => \$verbose,
    'r|rpm=s'       => \$rpm,
    't|tmpdir=s'    => \$tmpdir,
    'o|output=s'    => \$output
) || die "option parsing failed";
if ($help) {
    print "Usage: $progname [options] [FILE]\n" .
          "Available options:\n" .
          " -h,--help          print out this usage page\n" .
          " -v,--verbose       enable verbose run-time mode\n" .
          " -r,--rpm=FILE      filesystem path to RPM program\n" .
          " -t,--tmpdir=PATH   filesystem path to temporary directory\n" .
          " -o,--output=FILE   filesystem path to output RPM file\n";
    exit(0);
}
if ($version) {
    print "OpenPKG $progname $progvers\n";
    exit(0);
}
if ($#ARGV == 0) {
    $input = shift(@ARGV);
}
if ($#ARGV != -1) {
    die "invalid number of command line arguments";
}

#   prepare temporary location
&verbose("++ prepare temporary directory");
if (not -d $tmpdir) {
    &runcmd("mkdir $tmpdir && chmod 0700 $tmpdir")
        || die "cannot create temporary directory '$tmpdir'";
    &cleanup_remember("rmdir $tmpdir");
}
&verbose("-- $tmpdir"); 

#   determine RPM program
if (not -x $rpm) {
    $rpm = &fullpath($rpm);
}
my $rpmvers = `$rpm --version 2>/dev/null`; 
$rpmvers =~ s|^RPM version\s+([0-9.]+)\s*$|$1|s || die "program '$rpm' seems to be not RPM";
&verbose("++ determining RPM program");
&verbose("-- $rpm ($rpmvers)");

#   determine input and output RPM
&verbose("++ determining RPM package files");
&verbose("-- input/original RPM: $input");
&verbose("-- output/proxy RPM: $output");
if ($input eq '-') {
    $input = "$tmpdir/input.rpm";
    &runcmd("cat >$input");
}
if (not -f $input) {
    die "input RPM does not exist: '$input'";
}

#   helper function for parsing the query outputs
sub parseresponse {
    my ($r, $o) = @_;
    $o =~ s|([SM])-([^:]+):<(.*?)>\n|&parseline($r, $1, $2, $3, '')|egs;
    sub parseline {
        my ($r, $t, $k, $v) = @_;
        $v =~ s|^\s+||s;
        $v =~ s|\s+$||s;
        if ($t eq 'S') {     # single-value results
            $r->{$k} = $v;
        }
        elsif ($t eq 'M') {  # multi-value results
            $r->{$k} = [] if (not defined($r->{$k}));
            push(@{$r->{$k}}, $v);
        }
    }
    return $r;
}

#   query input RPM package
&verbose("++ query information from input RPM");
my $q = '';
foreach my $t (qw(
    NAME SUMMARY URL VENDOR PACKAGER DISTRIBUTION GROUP LICENSE VERSION RELEASE
    DESCRIPTION 
)) {
    $q .= "S-$t:<%{$t}>\n";
}
$q .= "[M-PREREQ:<%{REQUIRENAME} %|REQUIREFLAGS?{%{REQUIREFLAGS:depflags} %{REQUIREVERSION}}:{}|>\n]";
$q .= "[M-PREFIXES:<%{PREFIXES}>\n]";
my $o = `$rpm -qp --qf "$q" $input`;
$o =~ s|M-PREREQ:<rpmlib\(.*?\).*?>\n||gs;
my $r = {};
$r = &parseresponse($r, $o);
my $BD = '';
my $ID = '';
foreach my $d (@{$r->{PREREQ}}) {
    if ($d =~ m|^OpenPKG|i) {
        $BD .= ", " if ($BD ne '');
        $BD .= $d;
    }
    $ID .= ", " if ($ID ne '');
    $ID .= $d;
}
my $rprefix = ${$r->{PREFIXES}}[0];
$rprefix =~ s|/+$||s;
&verbose("-- remote OpenPKG prefix: $rprefix");
&verbose("++ query information from target OpenPKG");
$q = '';
foreach my $t (qw(
    l_prefix
)) {
    $q .= "S-$t:<%{$t}>\n";
}
$o = `$rpm --eval "$q"`;
$r = &parseresponse($r, $o);
my $lprefix = $r->{l_prefix};
$lprefix =~ s|/+$||s;
&verbose("-- local OpenPKG prefix: $lprefix");

#   prepare build environment
&verbose("++ establishing temporary RPM environment");
&runcmd("rm -rf $tmpdir/src; mkdir $tmpdir/src");
&runcmd("rm -rf $tmpdir/tmp; mkdir $tmpdir/tmp");
&runcmd("rm -rf $tmpdir/bld; mkdir $tmpdir/bld");
&runcmd("rm -rf $tmpdir/pkg; mkdir $tmpdir/pkg");
&cleanup_remember("rm -rf $tmpdir/src");
&cleanup_remember("rm -rf $tmpdir/tmp");
&cleanup_remember("rm -rf $tmpdir/bld");
&cleanup_remember("rm -rf $tmpdir/pkg");
my $macro = new IO::File (">$tmpdir/.rpmmacros");
$macro->print("%_sourcedir $tmpdir/src\n" .
              "%_specdir   $tmpdir/src\n" .
              "%_builddir  $tmpdir/tmp\n" .
              "%_tmppath   $tmpdir/tmp\n" .
              "%_rpmdir    $tmpdir/pkg\n" .
              "%_srcrpmdir $tmpdir/pkg\n");
$macro->close;
$ENV{HOME} = $tmpdir;
&verbose("-- temporary sourcedir/specdir: $tmpdir/src");
&verbose("-- temporary builddir/tmppath:  $tmpdir/tmp");
&verbose("-- temporary rpmdir/srcrpmdir:  $tmpdir/pkg");

#   generate .spec file for proxy RPM package
&verbose("++ generating RPM specification for proxy RPM");
my $S = '';
$S .= "Name:         ".$r->{NAME}."\n";
$S .= "Summary:      ".$r->{SUMMARY}."\n";
$S .= "URL:          ".$r->{URL}."\n";
$S .= "Vendor:       ".$r->{VENDOR}."\n";
$S .= "Packager:     ".$r->{PACKAGER}."\n";
$S .= "Distribution: ".$r->{DISTRIBUTION}."\n";
$S .= "Group:        ".$r->{GROUP}."\n";
$S .= "License:      ".$r->{LICENSE}."\n";
$S .= "Version:      ".$r->{VERSION}."\n";
$S .= "Release:      ".$r->{RELEASE}."+PROXY\n";
$S .= "\n";
$S .= "Prefix:       %{l_prefix}\n";
$S .= "BuildRoot:    $tmpdir/bld\n";
$S .= "BuildPreReq:  $BD\n";
$S .= "PreReq:       $ID\n";
$S .= "AutoReq:      no\n";
$S .= "AutoReqProv:  no\n";
#$S .= "Provides:     ".$r->{NAME}.", ".$r->{NAME}."-".$r->{VERSION}."-".$r->{RELEASE}."\n";
$S .= "\n";
$S .= "%description\n";
$S .= "    ".$r->{DESCRIPTION}."\n";
$S .= "\n";
$S .= "%install\n";
$S .= "    %{l_rpmtool} files -v -ofiles -r\$RPM_BUILD_ROOT %{l_files_std}\n";
$S .= "\n";
$S .= "%files -f files\n";
$S .= "\n";
my $spec = new IO::File (">$tmpdir/src/".$r->{NAME}.".spec");
$spec->print($S);
$spec->close;
&verbose("-- $tmpdir/src/".$r->{NAME}.".spec");

#   creating shadow tree of original contents
&verbose("++ creating shadow tree from original contents");
my @FL = `$rpm -qp --qf '[%{FILEMODES:perms} %{FILENAMES}\n]' $input`;
my $FD = [];
my $FR = [];
foreach my $fl (@FL) {
    $fl =~ s|\n$||s;
    if ($fl =~ m|^(d\S+)\s+$rprefix(.*)$|) {
        &mkdirp("$tmpdir/bld$lprefix$2");
        &verbose("-- | PHYS $1 $lprefix$2");
    }
    elsif ($fl =~ m|^(\S+)\s+$rprefix(.*?)([^/\s]+)$|) {
        my ($subdir, $file) = ($2, $3);
        my $target = sub2rev($subdir)."/.prefix-".$r->{NAME}.$subdir.$file;
        &mkdirp("$tmpdir/bld$lprefix$subdir");
        &runcmd("ln -s $target $tmpdir/bld$lprefix$subdir$file");
        &verbose("-- | VIRT $1 $lprefix$subdir$file");
    }
}
&runcmd("ln -s $rprefix $tmpdir/bld$lprefix/.prefix-".$r->{NAME});

#   rolling output proxy RPM package
&verbose("++ rolling output proxy RPM package");
&runcmd("cd $tmpdir/src && $rpm -bb --nodeps ".$r->{NAME}.".spec");

#   providing output
&verbose("++ providing output");
if ($output eq '-') {
    &runcmd("cat $tmpdir/pkg/*.rpm");
}
else {
    &runcmd("cp $tmpdir/pkg/*.rpm $output");
}

#   die gracefully...
&verbose("++ cleaning up environment");
&cleanup_perform();
exit(0);

__END__

=pod

=head1 NAME

B<mkproxyrpm> -- Make OpenPKG Proxy RPM Package

=head1 SYNOPSIS

B<mkproxyrpm>
[B<--verbose>]
[B<--debug>]
[B<--help>]
[B<--rpm>=I<FILE>]
[B<--tmpdir>=I<DIR>]
[B<--output>=I<DIR>|I<FILE>|C<->]
[I<FILE>|C<->]

=head1 DESCRIPTION

B<mkproxyrpm> creates an B<OpenPKG> proxy package by translating a
binary RPM file into a proxy binary RPM file. A proxy package contains
(virtually) the same contents as the original package in the form
of a shadow tree. Such a shadow tree consists of the same physical
directories as the original tree but with all other files replaced by
symbolic links pointing to the original files in the remote B<OpenPKG>
instance.

A proxy package is useful if multiple B<OpenPKG> instances are installed on
the same system. In this case lots of dependent (and this way required,
although not explicitly wanted) packages have to be installed in every
instance. Think about packages like B<openssl>, B<perl>, B<gcc>, etc. This can
be both very time-consuming and can become a maintainance nightmare.
Instead, you can select a master (or remote) B<OpenPKG> instance,
install those packages physically there only and install a simple proxy
packages for them in all other (local) B<OpenPKG> instances.

Keep in mind that this obviously works correctly for packages which do not
have hard-coded dependencies to their B<OpenPKG> instance (like configuration
files, etc.). For other packages it might also work, but be at least warned
about side-effects. Additionally, make sure you always keep (local) proxy
packages in sync with the (remote) master package.

=head1 SHADOW TREE

The symbolic links in the shadow tree of the proxy package B<foo> are of
the form:

I<lprefix>[/I<dir>]/I<file> -> I<revdir>C</.prefix->B<foo>[/I<dir>]/I<file>

And to make them working, there is the following additional symbolic
link installed:

I<lprefix>C</.prefix->B<foo> -> I<rprefix>

Here I<lprefix> is the prefix of the local B<OpenPKG> instance and
I<rprefix> is the prefix of the remote B<OpenPKG> instance. This allows
one to redirect a whole package to a different B<OpenPKG> instance by
just changing the I<lprefix>C</.prefix->B<foo> symbolic link. The idea
is that later this link even could be automatically controlled by a
higher-level facility.

=head1 OPTIONS

The following command line options and arguments are supported:

=over 4

=item B<--verbose>

Enable verbose messages on F<stderr> summarizing the internal processing.

=item B<--debug>

Enable debugging messages on F<stderr> showing the executed shell commands.

=item B<--help>

Print the usage message and immediately exit.

=item B<--rpm>=I<FILE>

Set a particular B<RPM> program to use. The default is the program
"C<rpm>" in C<$PATH>. This has to be the C<rpm> of the target B<OpenPKG>
instance where the proxy package will be installed later.

=item B<--tmpdir>=I<DIR>

Set a particular temporary directory. The default is determined from
C<$TMPDIR>, C<$TEMPDIR> or C</tmp> (in that order).

=item B<--output>=I<DIR>|I<FILE>|C<->

Set the location where to write the output
proxy RPM package. If the input RPM is named
"I<name>C<->I<version>C<->I<release>C<.>I<arch>C<->I<os>C<->I<id1>C<.rpm
>" the output RPM is named
"I<name>C<->I<version>C<->I<release>C<+PROXY>C<.>I<arch>C<->I<os>C<->I<i
d2>C<.rpm>" (I<id1> is the identification of the master B<OpenPKG>
instance, I<id2> is the identification of the B<OpenPKG> instance for
which the proxy package is built). The special argument "C<->" indicates
that the output RPM is written to F<stdout>. The default is "C<.>" (the
current working directory).

=item I<FILE>|C<->

Set the location where to read the input RPM package. The special
argument "C<->" indicates that the input RPM is read from F<stdin> (the
default).

=back

=head1 EXAMPLE

Assume you have three B<OpenPKG> instances on a system: C</usr/opkg>
(the master instance), C</e/foo/sw> (a project instance), and C</e/bar/sw>
(another project instance). Now let us install the C<bash> package in
all three locations, but only once physically.

 # build and install binary RPM for /usr/opkg instance
 $ /usr/opkg/bin/rpm --rebuild \
   ftp://ftp.openpkg.org/release/1.0/SRC/bash-2.05a-1.0.0.src.rpm
 $ /usr/opkg/bin/rpm -Uvh \
   /usr/opkg/RPM/PKG/bash-2.05a-1.0.0.*.rpm

 # build and install proxy RPM for /e/foo/sw instance
 $ mkproxyrpm --rpm=/e/foo/sw/bin/rpm --output=/e/foo/RPM/PKG/ \
   /usr/opkg/RPM/PKG/bash-2.05a-1.0.0.*.rpm
 $ /e/foo/sw/bin/rpm -Uvh \
   /e/foo/RPM/PKG/bash-2.05a-1.0.0+PROXY.*.rpm

 # build and install proxy RPM for /e/bar/sw instance
 $ mkproxyrpm --rpm=/e/bar/sw/bin/rpm --output=/e/bar/RPM/PKG/ \
   /usr/opkg/RPM/PKG/bash-2.05a-1.0.0.*.rpm
 $ /e/bar/sw/bin/rpm -Uvh \
   /e/bar/RPM/PKG/bash-2.05a-1.0.0+PROXY.*.rpm

=head1 SEE ALSO

B<OpenPKG> http://www.openpkg.org/,
rpm(3), ln(1).

=head1 HISTORY

B<mkproxyrpm> was developed in February 2002 by Ralf S.
Engelschall E<lt>rse@engelschall.comE<gt> for the B<OpenPKG>
project after an idea for virtual packages by Thomas Lotterer
E<lt>thomas.lotterer@cw.comE<gt>.

=head1 AUTHOR

 Ralf S. Engelschall
 rse@engelschall.com
 www.engelschall.com

=cut

