#!/usr/bin/perl

use strict;
use warnings;

# Copyright (C) 1997,1998,1999, Roger Espel Llima
 
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and any associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to permit
# persons to whom the Software is furnished to do so, subject to the
# following conditions:
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
# NO EVENT SHALL THE SOFTWARE'S COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT
# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
# THE USE OR OTHER DEALINGS IN THE SOFTWARE

# (whew, that's done!)

# why does the world need another rpm2cpio?  because the existing one won't
# build unless you have half a ton of things that aren't really required
# for it, since it uses the same library used to extract RPM's. in
# particular, it won't build on the HPsUX box i'm on.

# sw  2002-Mar-6 Don't slurp the whole file
# mvs 2005-Apr-7 Working with strict/warnings

# add a path if desired
my $gzip = 'gzip';
my($f,$rpm);

if($#ARGV == -1) {
    &printhelp if -t STDIN;
    $f = 'STDIN';
} elsif($#ARGV == 0) {
    die "Cannot read file $ARGV[0]\n" unless open F, "< $ARGV[0]";
    $f = 'F';
} else {
    &printhelp;
}

&printhelp if -t STDOUT;

read $f, $rpm, 96;
my($magic, $major, $minor, $crap) = unpack('NCC C90', $rpm);

die "Not an RPM\n" if $magic != 0xedabeedb;
die "Not a version 3 or 4 RPM\n" if $major != 3 && $major != 4;

while(!eof($f)) {
    my $pos = tell($f);
    read $f, $rpm, 16;
    my $smagic = unpack('n', $rpm);
    last if $smagic eq 0x1f8b;
    
    # Turns out that every header except the start of the gzip one is
    # padded to an 8 bytes boundary.
    if($pos & 0x7) {
        $pos += 7;
        $pos &= ~0x7;        # Round to 8 byte boundary
        seek $f, $pos, 0;
        read $f, $rpm, 16;
    }
    
    my($sections,$bytes);
    ($magic, $crap, $sections, $bytes) = unpack('N4', $rpm);
    die "Error: header not recognized\n" if $magic != 0x8eade801;
    $pos += 16;                # for header
    $pos += 16 * $sections;
    $pos += $bytes;
    seek $f, $pos, 0;
}

die "bogus RPM\n" if(eof($f));

die "Can't pipe to $gzip\n" unless open ZCAT, "| $gzip -cd";
print STDERR "CPIO archive found!\n";

print ZCAT $rpm;

while(read($f, ($_=''), 16384) > 0) {
    print ZCAT;
}

close ZCAT;
close F if($#ARGV==0);

## subs
sub printhelp {
    print "rpm2cpio, perl version by orabidoo <odar\@pobox.com> +sw
dumps the contents to stdout as a cpio archive\n
use: rpm2cpio [file.rpm] > file.cpio\n
Here's how to use cpio:
    list of contents:   cpio -t -i < /file/name
       extract files:   cpio -d -i < /file/name\n";
    exit 0;
}