App-CPANtoRPM
view release on metacpan or search on metacpan
lib/App/CPANtoRPM.pm view on Meta::CPAN
$VERSION="1.15";
$| = 1;
use vars qw($COM $DIR $ARCH $VERS);
use Config;
$ARCH = $Config{'archname'};
$VERS = $Config{'version'};
###############################################################################
# GLOBAL VARIABLES
###############################################################################
our $TMPDIR = "/tmp/cpantorpm";
our %Macros = (0 => {
'_optimize' => '$RPM_OPT_FLAGS',
'_buildroot' => '$RPM_BUILD_ROOT',
},
1 => {
'_optimize' => '%{optimize}',
'_buildroot' => '%{buildroot}',
}
);
our ($OUTPUT,@OUTPUT,%package,$MAN);
$package{'VERSION'} = $VERSION;
my $old_locale = setlocale(LC_TIME);
setlocale(LC_TIME, "C");
$package{'date'} = POSIX::strftime("%a %b %d %Y",localtime());
setlocale(LC_TIME, $old_locale);
###############################################################################
###############################################################################
sub _new {
my($class) = @_;
my $self = {
'add_provide' => [],
'add_require' => [],
'author' => [],
'build' => [],
'build_input' => [],
'build_rec' => 0,
'build_type' => '',
'clean_macros' => 0,
'config' => [],
'config_input' => [],
'cpan' => 'cpanplus',
'cwd' => '',
'debug' => 0,
'description' => '',
'disttag' => '%{?dist}',
'env' => {},
'epoch' => '',
'extracted' => '',
'file_path' => '',
'gpg_name' => '',
'gpg_passfile' => '',
'gpg_passwd' => '',
'gpg_path' => '',
'group' => 'Development/Libraries',
'inst_base' => '',
'inst_type' => '',
'install' => '',
'macros' => 0,
'mainpod' => '',
'mandir' => '',
'name' => '',
'no_clean' => 0,
'no_deps' => 0,
'no_tests' => 0,
'package' => '',
'packager' => '',
'patch' => '',
'patch_dir' => '',
'prefix' => 'perl-',
'release' => 1,
'rem_provide' => [],
'rem_require' => [],
'repl_provide' => [],
'repl_require' => [],
'rpmbuild' => '',
'runtime_rec' => 0,
'script' => '',
'script_dir' => '',
'sign' => 0,
'spec_only' => 0,
'summary' => '',
'test_rec' => 0,
'version' => '',
'yum' => '',
};
my $cwd = `pwd`;
chomp($cwd);
$$self{'cwd'} = $cwd;
$COM = $0;
$COM =~ s/^.*\///;
$DIR = $0;
$DIR =~ s/\/?$COM$//;
$DIR = "." if (! $DIR);
chdir $DIR;
$DIR = `pwd`;
chomp($DIR);
bless $self, $class;
$package{'CMD'} = $COM;
$package{'command'} = $0;
$package{'args'} = $self->_args();
$package{'self'} = $self;
my $old_locale = setlocale(LC_TIME);
setlocale(LC_TIME, "C");
$package{'date'} = POSIX::strftime("%a %b %d %Y",localtime());
setlocale(LC_TIME, $old_locale);
return $self;
}
lib/App/CPANtoRPM.pm view on Meta::CPAN
-m/--macros : Use the macro form of common SPEC constructs
instead of the environment variable form.
--build-rec
--test-rec
--runtime-rec : By default, modules that are recommended for
configure/build, test, and runtime are optional.
These arguments make them required.
To actually create the module, we may need to pass special options
to the 'perl Build.PL' or 'perl Makefile.PL' commands. The
following options are used to do this:
--build-type TYPE: TYPE may be 'build' or 'make' and force the use of
the Build.PL and Makefile.PL files respectively.
If the file does not exist, an error is triggered.
an error will be triggered.
--config STRING : Pass STRING to the 'perl Build.PL' or 'perl Makefile.PL'
command. This can be passed in any number of times.
--build STRING : Pass STRING to the './Build' or 'make' command.
This can be passed in any number of times.
--config-input STRING
: A line to pass as STDIN to 'perl Build.PL' or
'perl Makefile.PL' command. This can be passed in any
number of times.
--build-input STRING
: A line to pass as STDIN to './Build' or 'make'
command. This can be passed in any number of times.
-i/--install-base DIR:
The base directory to install the module.
-T/--install-type TYPE:
The type of installation. TYPE must be one of:
perl (aka core), site, or vendor
It defaults to the version specified in the
module.
--mandir STRING : Used to specify the man directory (relative to a
prefix). e.g. share/man
--patch FILE
--patch-dir DIR
--script FILE
--script-dir DIR : In some cases, a distribution cannot be packaged
without some modifications. Modifications can
be supplied in the form of a patch or a script.
Options to control what steps are done:
--spec-only : Stop after building the SPEC file.
--no-clean : Do not remove the build tree after the RPM
is built.
-s/--sign : Add a GPG signature.
-I/--install : Install the RPM on this system (by default,
it will install a new RPM, or upgrade an
existing one if the version changed).
--install-new : This will install the RPM if it is new, but
will not upgrade an existing version.
--install-force : This will install the RPM even if it already
is installed.
-y/--yum DIR : Copy the RPM to a local yum repository
Misc. options:
--gpg-path PATH : The path to the GPG directory containing
the keyring.
--gpg-name NAME : The name of the user who's key should be
used to sign the package.
--gpg-passwd PASSWORD
: The passphrase for the GPG key.
--gpg-passfile FILE
: A file containing the passphrase for the GPG key.
--env VAR=VAL : Sets an environment variable before building
the package. This option can be used any number
of times.
This takes a perl modules and creates an RPM version of it.
";
}
sub _parse_args {
my($self) = @_;
my @a = @ARGV;
$self->_usage, exit unless @a;
# We have to get the package first or else --optfile will not work.
if ($a[$#a] !~ /^-/) {
$$self{'package'} = pop(@a);
}
while ($_ = shift(@a)) {
$self->_usage, exit if ($_ eq '-h' ||
$_ eq '--help');
(print "$VERSION\n"), exit if ($_ eq '-v' ||
$_ eq '--version');
$TMPDIR = shift(@a), next if ($_ eq '-t' ||
$_ eq '--tmpdir');
$$self{'debug'} = 1, next if ($_ eq '-D' ||
$_ eq '--debug');
unshift(@a,$self->_opt_file(shift(@a))), next if ($_ eq '-f' ||
$_ eq '--optfile');
$$self{'no_tests'} = 1, next if ($_ eq '-n' ||
$_ eq '--no-tests');
$$self{'no_tests'} = 2, next if ($_ eq '--NO-TESTS');
$$self{'no_deps'} = 1, next if ($_ eq '-d' ||
$_ eq '--no-deps');
$$self{'no_deps'} = 2, next if ($_ eq '--NO-DEPS');
$$self{'incl_compat'} = 0, next if ($_ eq '--no-compat');
$$self{'cpan'} = 'cpan', next if ($_ eq '-c' ||
$_ eq '--cpan');
$$self{'description'} = shift(@a), next if ($_ eq '--description');
$$self{'summary'} = shift(@a), next if ($_ eq '--summary');
$$self{'mainpod'} = shift(@a), next if ($_ eq '--mainpod');
push(@{ $$self{'author'} }, shift(@a)), next if ($_ eq '--author');
$$self{'name'} = shift(@a), next if ($_ eq '--name');
$$self{'version'} = shift(@a), next if ($_ eq '--vers');
$$self{'prefix'} = shift(@a), next if ($_ eq '--prefix');
$$self{'prefix'} = '', next if ($_ eq '--no-prefix');
$$self{'packager'} = shift(@a), next if ($_ eq '-p' ||
$_ eq '--packager');
$$self{'rpmbuild'} = shift(@a), next if ($_ eq '--rpmbuild');
$$self{'clean_macros'} = 1, next if ($_ eq '--clean-macros');
$$self{'build_type'} = shift(@a), next if ($_ eq '--build-type');
$$self{'group'} = shift(@a), next if ($_ eq '--group');
push(@{ $$self{'config'} }, shift(@a)), next if ($_ eq '--config');
push(@{ $$self{'build'} }, shift(@a)), next if ($_ eq '--build');
push(@{ $$self{'config_input'} }, shift(@a)),
next if ($_ eq '--config-input');
push(@{ $$self{'build_input'} }, shift(@a)),
next if ($_ eq '--build-input');
$$self{'release'} = shift(@a), next if ($_ eq '--release');
$$self{'disttag'} = shift(@a), next if ($_ eq '--disttag');
$$self{'epoch'} = shift(@a), next if ($_ eq '--epoch');
$$self{'macros'} = 1, next if ($_ eq '-m' ||
$_ eq '--macros');
$$self{'spec_only'} = 1, next if ($_ eq '--spec-only');
$$self{'inst_type'} = shift(@a), next if ($_ eq '-T' ||
$_ eq '--install-type');
$$self{'inst_base'} = shift(@a), next if ($_ eq '-i' ||
$_ eq '--install-base');
$$self{'mandir'} = shift(@a), next if ($_ eq '--mandir');
$$self{'no_clean'} = 1, next if ($_ eq '--no-clean');
$$self{'sign'} = 1, next if ($_ eq '-s' ||
$_ eq '--sign');
$$self{'gpg_path'} = shift(@a), next if ($_ eq '--gpg-path');
$$self{'gpg_name'} = shift(@a), next if ($_ eq '--gpg-name');
$$self{'gpg_passwd'} = shift(@a), next if ($_ eq '--gpg-passwd');
$$self{'gpg_passfile'} = shift(@a), next if ($_ eq '--gpg-passfile');
$$self{'install'} = 'upg', next if ($_ eq '-I' ||
$_ eq '--install');
$$self{'install'} = 'new', next if ($_ eq '--install-new');
$$self{'install'} = 'force', next if ($_ eq '--install-force');
$$self{'yum'} = shift(@a), next if ($_ eq '-y' ||
$_ eq '--yum');
$$self{'script'} = shift(@a), next if ($_ eq '--script');
$$self{'script_dir'} = shift(@a), next if ($_ eq '--script-dir');
$$self{'patch'} = shift(@a), next if ($_ eq '--patch');
$$self{'patch_dir'} = shift(@a), next if ($_ eq '--patch-dir');
$$self{'runtime_rec'} = 1, next if ($_ eq '--runtime-rec');
$$self{'build_rec'} = 1, next if ($_ eq '--build-rec');
$$self{'test_rec'} = 1, next if ($_ eq '--test-rec');
$$self{'extracted'} = shift(@a), next if ($_ eq '--extracted');
push(@{ $$self{'add_require'} }, shift(@a)),
next if ($_ eq '--add-require');
push(@{ $$self{'add_provide'} }, shift(@a)),
next if ($_ eq '--add-provide');
push(@{ $$self{'rem_require'} }, shift(@a)),
next if ($_ eq '--rem-require');
push(@{ $$self{'rem_provide'} }, shift(@a)),
next if ($_ eq '--rem-provide');
push(@{ $$self{'repl_require'} }, shift(@a)),
next if ($_ eq '--repl-require');
push(@{ $$self{'repl_provide'} }, shift(@a)),
next if ($_ eq '--repl-provide');
if ($_ eq '--env') {
my $tmp = shift(@a);
if ($tmp =~ /^(.+?)=(.+)$/) {
$$self{'env'}{$1} = $2;
} else {
$self->_log_message('ERR',"Invalid --env option: $tmp");
}
next;
}
$self->_log_message('ERR',"Unknown arguments: $_ @a") if (@a);
}
if (! $$self{'package'}) {
$self->_log_message('ERR','No package given.');
}
if ($$self{'build_type'} &&
$$self{'build_type'} ne 'build' &&
$$self{'build_type'} ne 'make') {
$self->_log_message('ERR',"Invalid --build-type option: $$self{build_type}");
}
$$self{'inst_type'} = 'perl' if ($$self{'inst_type'} eq 'core');
if ($$self{'inst_type'} &&
$$self{'inst_type'} ne 'perl' &&
$$self{'inst_type'} ne 'site' &&
$$self{'inst_type'} ne 'vendor') {
$self->_log_message('ERR',
"Invalid --install-type option: $$self{inst_type}");
}
lib/App/CPANtoRPM.pm view on Meta::CPAN
$dir = "$yum/RPMS/$package{arch_val}";
} else {
$dir = "$yum/RPMS";
}
$self->_backup_file($package{'rpmfile'},$dir,"copy");
# Copy in the source RPM
$self->_backup_file($package{'srpmfile'},"$yum/SRPMS","copy");
}
###############################################################################
###############################################################################
# This will install a newly created RPM on the current system. This will
# allow us to create other RPMs that depend on this one.
sub _install_rpm {
my($self) = @_;
$self->_log_message('HEAD',"Installing RPM: $package{name}");
my @args = qw(-U);
if ($$self{'install'} eq 'new') {
@args = qw(-i);
} elsif ($$self{'install'} eq 'force') {
@args = qw(-U --force);
}
my @cmd = ('rpm',@args,$package{rpmfile});
if ($<) {
my $sudo = $self->_find_exe('sudo');
if (! $sudo) {
$self->_log_message('ERR',
'sudo not found. The rpm will not be installed.');
}
unshift (@cmd,$sudo);
}
my $cmd = join(' ',@cmd);
$self->_log_message('INFO',"Attempting system command: $cmd");
if (system(@cmd) != 0) {
$self->_log_message('ERR','Installation failed.');
}
}
###############################################################################
###############################################################################
# This will sign a newly created RPM. It may use the perl expect module,
# the expect executable, or it can do it interactively.
sub _sign_rpm {
my($self) = @_;
$self->_log_message('HEAD',"Signing RPM: $package{name}");
my $gpg = $self->_find_exe('gpg');
if (! $gpg) {
$self->_log_message('ERR',"gpg program not found in path.");
}
#
# First, let's get the value of the GPG path
#
my $path = ''; # The gpg option to set the path to use (if not the default)
my $macro = ''; # The value of the rpm macro.
$macro = `rpm --eval '%_gpg_path'`;
chomp($macro);
$macro = '' if ($macro eq '%_gpg_path');
if ($$self{'gpg_path'}) {
if (! -d $$self{'gpg_path'}) {
$self->_log_message('ERR',
"GPG directory does not exist: $$self{gpg_path}");
}
if ($macro) {
if ($$self{'gpg_path'} ne $macro) {
# We're overriding a value set in the rpm macro file.
$self->_log_message('WARN',
'--gpg-path option overriding value in RPM macro file',
" --gpg-path = $$self{gpg_path}",
" \%_gpg_path = $macro");
$path = "--homedir $$self{'gpg_path'}";
# We have to add it to the macros file. We'll just tack
# it on the end since this will effectively override the
# value there.
my $macros = "$ENV{HOME}/.rpmmacros";
$$self->_add_macro($macros,'%_gpg_path',$$self{'gpg_path'});
}
}
} elsif ($macro) {
if (! -d $macro) {
$self->_log_message('ERR',
"GPG directory from rpmmacros does not exist: $macro");
}
}
$self->_log_message('INFO',"GPG path = $path");
#
# Next, let's get the value of the GPG user.
#
my $name = ''; # The gpg option to set the user to use.
$macro = ''; # The value of the rpm macro.
$macro = `rpm --eval '%_gpg_name'`;
chomp($macro);
$macro = '' if ($macro eq '%_gpg_name');
if ($$self{'gpg_name'}) {
if ($macro) {
if ($$self{'gpg_name'} ne $macro) {
# We're overriding a value set in the rpm macro file.
$self->_log_message('WARN',
'--gpg-name option overriding value in RPM macro file',
" --gpg-name = $$self{gpg_name}",
" \%_gpg_name = $macro");
$name = "'$$self{'gpg_name'}'";
# We have to add it to the macros file. We'll just tack
# it on the end since this will effectively override the
# value there.
my $macros = "$ENV{HOME}/.rpmmacros";
$$self->_add_macro($macros,'%_gpg_name',$$self{'gpg_name'});
}
}
}
$name = "'$macro'" if ($macro && ! $name);
$self->_log_message('INFO',"GPG name = $name");
#
# Now let's make sure that we actually have exactly one key.
#
my @out = `$gpg $path --list-keys $name | grep '^uid'`;
if (! @out) {
$self->_log_message('ERR',
'No keys found in this GPG keyring.',
'Use --gpg-path to specify an alternate GPG path',
'or create a key in this keyring.');
}
if (@out != 1) {
$self->_log_message('ERR',
'Multiple keys found in this keyring',
'Use --gpg-user to specify a single user.');
}
#
# Sign it.
#
SIGN:
{
if ($$self{'gpg_passwd'} || $$self{'gpg_passfile'}) {
my $err = $self->_load_module("Expect");
if (! $err) {
$err = $self->_sign_perlexpect();
if ($err) {
$self->_log_message('ERR','PGP passphrase incorrect');
}
last SIGN;
}
my $expect = $self->_find_exe('expect');
if ($expect) {
$err = $self->_sign_expect($expect);
if ($err) {
$self->_log_message('ERR','PGP passphrase incorrect');
}
last SIGN;
}
}
$self->_sign_interactive();
last SIGN;
}
}
sub _sign_expect {
my($self,$expect) = @_;
$self->_log_message('INFO',"Signing with non-interactive expect script");
my $pass;
if ($$self{'gpg_passwd'}) {
$pass = $$self{'gpg_passwd'};
} else {
$pass = `cat $$self{'gpg_passfile'}`;
chomp($pass);
}
my $out = new IO::File;
my $file = "$TMPDIR/cpantorpm-expect-sign-wrapper";
$out->open("> $file");
print $out <<"EOF";
#!$expect
spawn rpm --addsign $package{rpmfile} $package{srpmfile}
expect -exact "Enter pass phrase: "
send -- "$pass\\r"
expect {
"Pass phrase check failed" { puts "Failed" }
eof { puts "Success" }
}
EOF
$out->close();
chmod 0755,$file;
open(IN,"'$file' |");
my @out = <IN>;
close(IN);
unlink $file;
if ( grep /Failed/,@out ) {
return 1;
}
return 0;
}
{
my $flag;
sub _sign_perlexpect {
my($self) = @_;
$self->_log_message('INFO',"Signing with non-interactive perl Expect script");
my $pass;
if ($$self{'gpg_passwd'}) {
$pass = $$self{'gpg_passwd'};
} else {
$pass = `cat $$self{'gpg_passfile'}`;
chomp($pass);
}
my $exp = Expect->spawn('rpm','--addsign',
$package{rpmfile},$package{srpmfile});
$exp->expect(undef, "Enter pass phrase:");
$exp->send("$pass\n");
$exp->expect(undef,
[ "Pass phrase check failed" => sub { $flag = 1; } ],
[ "eof" => sub { $flag = 0; } ],
);
return $flag;
}
}
sub _sign_interactive {
my($self) = @_;
$self->_log_message('INFO',"Signing with interactive rpm command");
my @cmd = ('rpm','--addsign', $package{rpmfile}, $package{srpmfile});
my $cmd = join(' ',@cmd);
$self->_log_message('INFO',"Attempting system command: $cmd");
system(@cmd);
}
# This adds a macro to the rpmmacro file in such a way that at the end, it
# will be restored.
#
sub _add_macro {
my($self,$file,$macro,$val) = @_;
if (! -f $file) {
# If the macros file is new, we'll remove it once we're done.
$package{'remove'} = 1;
} elsif ($package{'remove'} || $package{'restore'}) {
# If we've already created a backup of the macros file
# which will be restore, or if we've already determined
# that the macros file will be removed, we don't have
# redetermine anything.
} else {
# This is the first time we're adding a macro to
# the macros file, so we want to save it so that it
# can be restored at the end.
$self->_backup_file($file,"$file.cpantorpm",1);
$package{'restore'} = 1;
}
my $out = new IO::File;
( run in 0.496 second using v1.01-cache-2.11-cpan-e1769b4cff6 )