#!/usr/bin/perl

# rpm2script: extract install scripts from RPM files
# Copyright (C) 2010  Martin von Gagern

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;

sub myread($$) {
  my ($fh, $len) = @_;
  my $rem = $len;
  my $res = '';
  while ($rem) {
    my $count = read $fh, $res, $rem, $len-$rem;
    die "Error reading $len bytes" unless $count;
    $rem -= $count;
  }
  return $res;
}

my %tags = ( 1023 => 'PREIN', 1024 => 'POSTIN' );

sub doheader($) {
  my ($fh) = @_;
  my ($magic, $version, $reserved, $nindex, $sheader) =
    unpack('Z[3]CZ[4]L>L>', myread($fh, 16));
  die "Bad header magic" unless $magic eq "\x8e\xad\xe8";
  my @index = ();
  for (1..$nindex) {
    push @index, [unpack('L>L>L>L>', myread($fh, 16))];
  }
  $sheader = $sheader - $sheader%8 + 8 if $sheader%8;
  my $store = myread($fh, $sheader);
  my %res = ();
  for my $item (@index) {
    my ($tag, $type, $offset, $count) = @$item;
    #printf "tag $tag, type $type, offset $offset, count $count\n";
    next if $type != 6;
    my $data = unpack('Z*', substr($store, $offset));
    $res{$tags{$tag}} = $data if defined $tags{$tag};
  }
  return %res;
}

sub dofile($) {
  my ($file) = @_;
  print STDERR "$file\n";
  my $fh;
  open $fh, "<", $file or die "Error opening '$file'";
  my @lead = unpack('Z[4]CCs>s>Z[66]s>s>Z[16]', myread($fh, 96));
  die "Bad lead magic" unless $lead[0] eq "\xed\xab\xee\xdb";
  doheader($fh);
  my %header = doheader($fh);
  close $fh or die "Error closing '$file'";
  for my $tag (sort values(%tags)) {
    if (defined $header{$tag}) {
      my $out = "$file.$tag.sh";
      open $fh, ">", $out or die "Error opening '$out'";
      print $fh $header{$tag};
      close $fh or die "Error closing '$out'";
      print "$file\t$tag\n";
    }
  }
}

my $dashdash = 0;
for (@ARGV) {
  if ($dashdash || !/^-/) {
    dofile($_);
  }
  elsif (/^(--help|-h|-\?)$/) {
    print <<EOF;
Usage: $0 RPM...
EOF
    exit 0;
  }
  else {
    die "Unknown argument: $_"
  }
}