view release on metacpan or  search on metacpan

lib/App/CPANtoRPM.pm  view on Meta::CPAN

   }
   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;
   $out->open(">> $file")  ||
     $self->_log_message('ERR',"Unable to write to .rpmmacros file: $!");
   print $out "\n$macro $val\n";
   $out->close();
}

############################################################################
############################################################################

# This will build an RPM/SRPM.

sub _build_rpm {
   my($self) = @_;
   $self->_log_message('HEAD',"Creating RPM: $package{name}");

   #
   # Move the source into the SOURCES directory (as a .tar.gz file)
   #

   my $arch = "$package{topdir}/SOURCES/$package{dir}.tar.gz";
   my $succ = $self->_multiple_methods
     ( [ sub { -f $arch } ],