#!/usr/bin/perl
# build an rpm package header with an arbitrary name
# 06/26/08 Stew Benedict <stewb@linux-foundation.org>
# released under GPLv2

#    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/>.

my $progversion = "1.4";

use Digest::MD5 qw(md5 md5_hex);
use Getopt::Long;
use Data::Dumper;
use Cwd;
use Sys::Hostname;
use File::Temp qw(tempfile tempdir);
use File::Basename;
use File::Spec;

# not part of base perl - we need to package these to be LSB compliant
# as well as XML::NamespaceSupport and XML::SAX (so XML::Simple works)
push @INC, "/opt/lsb/share/perl";
require "/opt/lsb/share/perl/XML/Simple.pm";
require "/opt/lsb/share/perl/Archive/Cpio.pm";

# set to 1 to get a dump of the file data hash, boundary offset rounding, cpio data, and usertags
our $debug = 0;
# set to 1 to get feedback while processing (useful for huge datasets)
our $verbose = 0;

# according to the spec these are not required, but 
# pkgchk complains if one or the other is not present
my $usepayloadsize = 1;
my $usearchivesize = 0;

if (!$ARGV[1]) {
    show_usage();
}

# xml file with user defined tags
my $tagfile = '';

# file to remap package files mode/uid/gid
my $permsfile = '';

# user configurable
my %usertags =    (
                    'version' => '1.0.0',
                    'release' => '1',
                    'summary' => 'This is a generated package',
                    'description' => 'LSB rpm package builder test package',
                    'vendor' => 'LSB',
                    'license' => 'GPL',
                    'packager' => 'LSB packaging team',
                    'group' => 'LSB',
                    'arch' => '',
                    'lsbversion' => '4.0',
                    'requires' => '',
                    'pre' => '',
                    'post' => '',
                    'preun' => '',
                    'postun' => '',
                  );

$result = GetOptions(  \%usertags,
                        "version=s",
                        "release=s",
                        "summary=s",
                        "description=s",
                        "vendor=s",
                        "license=s",
                        "packager=s",
                        "group=s",
                        "arch=s",
                        "lsbversion=s",
                        "pre=s",
                        "post=s",
                        "preun=s",
                        "postun=s",
                        "requires=s",
                        "tagfile=s" => \$tagfile,
                        "permsfile=s" => \$permsfile,
                        "debug" => \$debug,
                        "verbose" => \$verbose,
                        "help|?" => sub { show_usage() }
                    );
  
if ($usertags{arch} ne '' and $usertags{arch} ne 'noarch') {
    die "'noarch' is the only valid string for --arch"
}

# read the permsmap file if requested
if ($permsfile ne '') {
    if (-f $permsfile) {
        $xmltags = XML::Simple::XMLin($permsfile);
        print Dumper($xmltags) if $debug;
        while ( my ($key, $value) = each(%$xmltags) ) {
            $permstags{$key} = $xmltags->{$key};
        }
    } else {
        die "Cannot open perms file $permsfile...";
    }
}

print Dumper(\%permstags) if $debug;

# read the XML file if requested
if ($tagfile ne '') {
    if (-f $tagfile) {
        $xmltags = XML::Simple::XMLin($tagfile);
        print Dumper($xmltags) if $debug;
        while ( my ($key, $value) = each(%$xmltags) ) {
            $usertags{$key} = $xmltags->{$key};
        }
    } else {
        die "Cannot open tag file $tagfile...";
    }
}

print Dumper(\%usertags) if $debug;

my $packagename = $ARGV[0];
die "$0 requires a packagename..." if $packagename eq ''; 
my $lname = join("-", $packagename, $usertags{version}, $usertags{release});

# should this one be configurable?
my $src_rpm = "LSB rpm tool ver $progversion";
# FIXME for debugging to compare with "real" package
# $src_rpm = $lname . ".src.rpm";

# may change at some point
my $rpmversion = '4.0.1';

# always linux
my $os = 'linux';

# for pre/post, etc
my $shell = '/bin/sh';

# payload info
my $pformat = 'cpio';
my $pcompressor = 'gzip';
my $pflags = '9';

our $maxname = 65;
if (length($packagename) > $maxname) {
    print "package name too long, truncating to $maxname chars\n";
    $packagename = substr($packagename, 0, $maxname);
}

# various rpm tags - incomplete
my %tagdict = (
    'HEADERIMAGE', 61,
    'HEADERSIGNATURES', 62,
    'HEADERIMMUTABLE', 63,
    'HEADERI18NTABLE', 100,
    'NAME', 1000,
    'VERSION', 1001,
    'RELEASE', 1002,
    'SERIAL', 1003,
    'SUMMARY', 1004,
    'DESCRIPTION', 1005,
    'BUILDTIME', 1006,
    'BUILDHOST', 1007,
    'INSTALLTIME', 1008,
    'SIZE', 1009,
    'DISTRIBUTION', 1010,
    'VENDOR', 1011,
    'GIF', 1012,
    'XPM', 1013,
    'COPYRIGHT', 1014,
    'PACKAGER', 1015,
    'GROUP', 1016,
    'CHANGELOG', 1017,
    'SOURCE', 1018,
    'PATCH', 1019,
    'URL', 1020,
    'OS', 1021,
    'ARCH', 1022,
    'PREIN', 1023,
    'POSTIN', 1024,
    'PREUN', 1025,
    'POSTUN', 1026,
    'FILENAMES', 1027,
    'FILESIZES', 1028,
    'FILESTATES', 1029,
    'FILEMODES', 1030,
    'FILEUIDS', 1031,
    'FILEGIDS', 1032,
    'FILERDEVS', 1033,
    'FILEMTIMES', 1034,
    'FILEMD5S', 1035,
    'FILELINKTOS', 1036,
    'FILEFLAGS', 1037,
    'ROOT', 1038,
    'FILEUSERNAME', 1039,
    'FILEGROUPNAME', 1040,
    'ICON', 1043,
    'SOURCERPM', 1044,
    'FILEVERIFYFLAGS', 1045,
    'ARCHIVESIZE', 1046,
    'PROVIDENAME', 1047,
    'REQUIREFLAGS', 1048,
    'REQUIRENAME', 1049,
    'REQUIREVERSION', 1050,
    'NOSOURCE', 1051,
    'NOPATCH', 1052,
    'CONFLICTFLAGS', 1053,
    'CONFLICTNAME', 1054,
    'CONFLICTVERSION', 1055,
    'DEFAULTPREFIX', 1056,
    'BUILDROOT', 1057,
    'INSTALLPREFIX', 1058,
    'EXCLUDEARCH', 1059,
    'EXCLUDEOS', 1060,
    'EXCLUSIVEARCH', 1061,
    'EXCLUSIVEOS', 1062,
    'RPMVERSION', 1064,
    'PREINPROG', 1085,
    'POSTINPROG', 1086,
    'PREUNPROG', 1087,
    'POSTUNPROG', 1088,
    'FILEDEVICES', 1095,
    'FILEINODES', 1096,
    'FILELANGS', 1097,
    'PROVIDEFLAGS', 1112,
    'PROVIDEVERSION', 1113,
    'DIRINDEXES', 1116,
    'BASENAMES', 1117,
    'DIRNAMES', 1118,
    'PAYLOADFORMAT', 1124, 
    'PAYLOADCOMPRESSOR', 1125,
    'PAYLOADFLAGS', 1126
);

# FIXME - originally had 832 as 'none' for pre/post/preun/postun, 
# then I noticed real packages have seperate values here
my %flagdict = (
    'equals', 8,
    'greaterthanequals', 76,
    'pre', 832,
    'post', 1344,
    'preun', 2368,
    'postun', 4416,
    'lessthanequals', 16777290
);

sub show_usage() {
    print "$0 version $progversion - LSB Project RPM build tool\n\n";
    print "usage: $0 packagename [cpio file or source directory] (options)\n";
    print "       source directory structure should be something like:\n";
    print "                          opt/lanana-name/all-my-files-and-dirs\n";
    print "\n";
    print "user definable options (package tags, quote multiple words):\n";
    print "                             --version\n";
    print "                             --release\n";
    print "                             --summary\n";
    print "                             --description\n";
    print "                             --vendor\n";
    print "                             --license\n";
    print "                             --packager\n";
    print "                             --group\n";
    print "                             --arch (only noarch is valid)\n";
    print "                             --lsbversion\n";
    print "                             --requires\n";
    print "                             --pre\n";
    print "                             --post\n";
    print "                             --preun\n";
    print "                             --postun\n";
    print "                             --tagfile\n";
    print "                             --permsfile\n";
    print "\n";
    print "other options:\n";
    print "                             --debug\n";
    print "                             --help|-?\n";

    exit 1;
}

# utility functions

sub mode_to_decimal {
    # the cpio data is in decimal, like st_mode from fstat, which adds more info for file,dir,link...
    # we specify in octal, need to get the original value in octal and then pre-pend the first n-4 
    # to our value, then back to decimal 
    my ($orgdec, $newmode) = @_;
    $orgoct = sprintf "%lo", $orgdec;
    $newoct = substr($orgoct, 0, -4) . $newmode;
    $newdec = oct($newoct);
    print "old dec/oct: $orgdec, $orgoct - new dec/oct: $newdec, $newoct\n" if $debug;
    return $newdec;
}

sub file_or_dir_perms {
    my ($isdir, $type) = @_;
    if ($isdir) {
        $defmode = $permstags{defdirs}{$type};
    } else {
        $defmode = $permstags{deffiles}{$type};
    }
    return $defmode;
}

sub fill {
    # write filler data - count is bytes to write
    my ($count) = @_;
    my $filler;

    for ($i = 0; $i < $count; $i++) {
        $filler .= "\000";
    }
    return $filler;
}

sub pad {
    # convert a decimal to hex, pad it out, and return the binary value
    # probably a more elegant way to do this, but seems to work
    my ($value, $bits) = @_;
    my $pbuff;
    my $newvalue;
    my $format = "\%" . sprintf("%03d", $bits) . "X\%s";
    my $pad = sprintf($format, $value);
    for ($i = 0; $i < $bits; $i = $i + 2) {
        $newvalue = substr($pad,$i,2);
        if (substr($newvalue,0,1) eq '0' ) {
            $newvalue = substr($newvalue,1,1);
        }
        if (length($newvalue) > 1) {
            $pbuff .= pack("H2", $newvalue);
        } else {
            $pbuff .= pack("h", $newvalue);
        }
    }
    return $pbuff;
}

sub boundary_shift {
    # some data needs to be on a strict boundary
    my ($bbuff, $bytes) = @_;
    my $blen = length($bbuff);
    # bail if we're already on a boundary
    return $bbuff if $blen/$bytes == int($blen/$bytes);
    my $pad = $bytes * (int($blen/$bytes) + 1) - $blen;
    $bbuff .= fill($pad);
    if ($debug) {
        my $newblen = length($bbuff);
        printf("buff length: %d, shift requested: %d, new length: %d\n", $blen, $bytes, $newblen);
    }
    return $bbuff;
}

sub get_magic() {
    # magic
    my $magic = "\216\255\350\001";

    # reserved
    $magic .= fill(4);

    return $magic;
}

# leader functions

sub build_leader {
    # leader section first
    my ($pname) = @_;
    my $lbuff;

    # magic
    $lbuff .= "\355\253\356\333";

    # rpm ver 3.0, binary format (0)
    $lbuff .= "\003\000\000";

    # arch code
    $lbuff .= fill(2);

    my $arch = `uname -m`;
    chomp $arch;

    my %archcodes = (
        'ia32', "\x01",
        'x86_64', "\x01",
        'ppc', "\x05",
        'ppc64', "\x10",
        's390', "\x0E",
        's390x', "\x0E",
        'ia64', "\x09",
    );

    if ($arch =~ /86$/) {
        $lbuff .= $archcodes{"ia32"};
    } else {
        $lbuff .= $archcodes{$arch};
    }

    # package name
    $lbuff .= $pname;
    $lbuff .= fill($maxname + 1 - length($pname));

    # osnum
    $lbuff .= "\000\001";

    # signature type
    $lbuff .= "\000\005";

    # reserved data
    $lbuff .= fill(16);

    return $lbuff;
}

# signature functions

sub build_signature {
    # now signature section
    my ($usepayloadsize) = @_;
    my $start = get_magic();
    my $sbuff;
    my $indexes = 2;
    my $storelength = 20;

    my %sigtagdict = (
        'RPMSIGTAG_DSA', 267,
        'RPMSIGTAG_RSA', 268,
        'RPMSIGTAG_SHA1', 269,
        'RPMSIGTAG_SIZE', 1000,
        'RPMSIGTAG_PGP', 1002,
        'RPMSIGTAG_MD5', 1004,
        'RPMSIGTAG_GPG', 1005,
        'RPMSIGTAG_PAYLOADSIZE', 1007,
    );

    $sbuff .= $start;    

    if ($usepayloadsize) {
        $indexes = 3;
        $storelength = 24;
    }

    # at least 2 indexes required (size and md5sum) (+1 for payloadsize)
    $sbuff .= pad($indexes,8);

    # 20 bytes long (the store size = 4(size) + 16(md5)) (+4 for payloadsize)
    $sbuff .= pad($storelength,8);

    # size tag
    $sbuff .= pad($sigtagdict{'RPMSIGTAG_SIZE'},8);

    # 32 bit value for size (code 4)
    $sbuff .= pad(4,8);

    # offset is zero
    $sbuff .= fill(4);

    # count - # of 32 byte integers
    $sbuff .= pad(1,8);

    # md5 tag
    $sbuff .= pad($sigtagdict{'RPMSIGTAG_MD5'},8);

    # BIN data type (code 7)
    $sbuff .= pad(7,8);

    # offset is 4
    $sbuff .= pad(4,8);

    # count - 128 bit
    $sbuff .= pad(16,8);

    if ($usepayloadsize) { # spec says it's optional, yet pkgchk complains
        $sbuff .= pad($sigtagdict{'RPMSIGTAG_PAYLOADSIZE'},8);

        # type 4 (INT32)
        $sbuff .= pad(4,8);

        # offset is 20
        $sbuff .= pad(20,8);

        # count is 1
        $sbuff .= pad(1,8);
    }

    return $sbuff;
}

sub build_sig_store {
    my ($header, $payload, $payloadsize, $usepayloadsize) = @_;
    my $store_buff;

    # size - FIXME - had -32 hack in here at one time, because rpm -Kvv shows off by 32
    # but then rpmpy complains, so drop it (still needs review)
    my $size = length($header) + length($payload);
    $store_buff .= pad($size,8);

    # md5sum
    $store_buff .= md5($header . $payload);

    if ($usepayloadsize) {
        # payload size
        $store_buff .= pad($payloadsize, 8);
    }

    # need to end on an 8 byte boundary
    $store_buff = boundary_shift($store_buff, 8);

    return $store_buff;
}

# header functions

sub header_start {
    my ($icount,$slength) = @_;
    my $hbuff;

    $hbuff .= get_magic();

    # and the index count
    $hbuff .= pad($icount, 8);
    
    # and the data store size
    $hbuff .= pad($slength, 8);

    return $hbuff;
}

sub header_index {
    # 16 bytes - code, type, offset, count
    my ($tagcode, $type, $offset, $count) = @_;
    my $ibuff;

    # tag code
    $ibuff .= pad($tagcode,8);

    # data type
    $ibuff .= pad($type,8);

    # add in the offset from the beginning of the header_store
    $ibuff .= pad($offset,8);

    # data count
    $ibuff .= pad($count,8);

    return $ibuff;
}

# payload functions

sub is_gzip {
    # is the payload already gzipped?
    my ($pfile) = @_;
    my $archive;
    die "$pfile is not a file" if !(-f $pfile);
    my $magic = `file $pfile`;
    if ($magic =~ /gzip/) {
        return 1;
    } else {
        return 0;
    }
}

sub build_payload {
    # use the payload file specified on the command line
    my ($pfile) = @_;
    die "$0 requires a source archive or directory.." if $pfile eq '';
    die "$pfile is not a file or directory..." unless (-d $pfile or -f $pfile);
    my $archive;
    my $zarchive;
    my $archivesize;
    if (-d $pfile) {
        # directory, make our own archive
        my $cwd = cwd;
        chdir($pfile);
        my $dir = tempdir( CLEANUP => 1 );
        my ($fh, $cpiofile) = tempfile( DIR => $dir );
        # sigh, we need the uncompressed size too, have to process in 2 steps
        # skipping the toplevel directory (mindepth 1), need to think about this
        #$makearchive = `find * -mindepth 1 | cpio -H newc -o --quiet > $cpiofile`;
        # cannot convince cpio to make an archive with leading ./, but pax will
        # we do not want to own /opt though (mindepth 2)
        # nor /etc/opt or /var/opt (! -name opt)
        $makearchive = `find . -mindepth 2 ! -name opt | pax -wd -x sv4cpio > $cpiofile`;
        die "failed to make cpio archive" if $makearchive;
        $archive = `cat $cpiofile`;
        $zarchive = `gzip -9 -c -n $cpiofile`;
        die "failed to compress cpio archive" if $zarchive == 1;
        chdir($cwd);
    } elsif (is_gzip($pfile)) {
        $archive = `zcat $pfile`;        
        $zarchive = `cat $pfile`;
    } else {
        $archive = `cat $pfile`;        
        $zarchive = `gzip -9 -c -n $pfile`;
    }
    # we can't depend on the actual filesize, we just want the data up thru 'TRAILER!!!' 
    # for the  archivesize - apparently there can be more than one too! - search from the end
    $archivesize = rindex($archive, 'TRAILER!!!') + 14;
    undef $archive; # only needed this for the size

    # setup the payload header
    # gzip magic
    my $magic = "\x1f\x8b";
    my $pbuff .= $magic;

    # gzip tag
    $pbuff .= pad(8,1);    

    # reserved
    $pbuff .= fill(2);

    # compression type, 2 = MAX
    $pbuff .= pad(0,4);

    # UNIX compression indicator
    $pbuff .= pad(3,1);

    # and the data
    # seems setting up the payload header actually breaks things
    # just use the raw archive (or the one we gzipped)
    #$pbuff = $archive; # was .=

    return $archivesize, $zarchive;
}

sub get_payload_files {
    my ($pfile) = @_;
    my %filelist;
    my $packagesize;
    my $getfiles;
    my $cwd = cwd;
    my $cpio;
    my $cpiodata;
    my $usecpio = 0;
    my $uname;
    my $gname;

    if (-d $pfile) {
        # preferred case - we can just get the file data directly
        chdir($pfile);
    } else {
        # make a tmp dir, unpack the cpio and process the files
        my $workdir = tempdir( CLEANUP => 1 );
        $pfile = File::Spec->rel2abs($pfile);
        chdir($workdir);
        # now the inodes and times don't jive with the orginal archive - use the archive data for most of it
        if (is_gzip($pfile)) {
            $getfiles = `zcat $pfile | cpio -i -d --preserve-modification-time 2> /dev/null`;
            $cpiofile = 'temp.cpio';
            $getfiles = `zcat $pfile > $cpiofile`;
        } else {
            $getfiles = `cpio -i -d --preserve-modification-time < $pfile 2> /dev/null`;
            $cpiofile = $pfile;
        }
        die "unable to process payload.." if $getfiles; 
        $cpio = Archive::Cpio->new;
        $cpio->read($cpiofile);
        $usecpio=1;
        unlink $cpiofile unless $cpiofile eq $pfile; 
    }

    # again, we want to omit /opt, /etc/opt, /var/opt
    @files = `find * -mindepth 1 ! -name opt`;
    my $index = 0;
    my $paths;
    # seems we get confused installing without the sort    
    foreach $file (sort(@files)) {
        print "." if $verbose;
        chomp $file;
        my $fname = basename($file);
        chomp $fname;
        my $dname = dirname($file);
        # toss this (.)
        next if (substr($dname,0,1) eq '.') and length($dname) == 1;
        chomp $dname; 
        if (substr($dname,0,1) ne '/') {
            # FIXME - newer rpm has leading "/" (and cpio archive has "./")
            # not adding the leaded "/" makes pkgcheck happy, but then things install relative to `pwd`
            # alternately we use pax to make a 4.0 style archive with "./"
            $dname = "/" . $dname . "/";
            #$dname .= "/";
        }
        $filelist{$index}{fname} = $fname;
        $filelist{$index}{fpath} = $dname;
        # we do not want to double list the directories
        push @dirnames, $dname unless grep(/^$dname$/, @dirnames);
        # use lstat rather than stat to get symlinks right
        my @fstat = lstat($file);
        if ($usecpio) {
            my $cpiofname = "./" . $file;
            $cpiodata = $cpio->get_file($cpiofname);
            print Dumper($cpiodata) if $debug;
            $filelist{$index}{device} = $cpiodata->{devMajor}*256 + $cpiodata->{devMinor};
            $filelist{$index}{inode} = $cpiodata->{inode};
            $filelist{$index}{mode} = $cpiodata->{mode};
            $filelist{$index}{links} = $cpiodata->{data} if -l $file;
            ($uname) = getpwuid($cpiodata->{uid});
            ($gname) = getgrgid($cpiodata->{gid});            
            $filelist{$index}{size} = length($cpiodata->{data});
            $filelist{$index}{mtime} = $cpiodata->{mtime};
            $filelist{$index}{md5} = md5_hex($cpiodata->{data});
        } else {
            $filelist{$index}{device} = $fstat[0];
            $filelist{$index}{inode} = $fstat[1];
            $filelist{$index}{mode} = $fstat[2];
            $filelist{$index}{links} = readlink($file);
            # FIXME - we use the filesystem uid/gid - does this need to be configurable?
            ($uname) = getpwuid($fstat[4]);
            ($gname) = getgrgid($fstat[5]);
            $filelist{$index}{size} = $fstat[7];
            $filelist{$index}{mtime} = $fstat[9];
            if (-f $file) {
                open(MD5FILE, $file) or die "Can't open '$file': $!";
                binmode(MD5FILE);
                $filelist{$index}{md5} = Digest::MD5->new->addfile(*MD5FILE)->hexdigest;
                close(MD5FILE);
            }    
        }
        $filelist{$index}{uname} = $uname;
        $filelist{$index}{gname} = $gname;
        $filelist{$index}{isdir} = 1 if -d $file;        
        $packagesize = $packagesize + $fstat[7] unless (-l $file or -d $file);            
        $index++       
    }
    chdir($cwd);
    # now figure out which directory (DIRINDEX) each file belongs in
    my $dindex = 0;
    for my $dir (@dirnames) {
        $filelist{$dindex}{dname} = $dir;
        $dindex++;
    }    
    for ($findex = 0;$findex < $index;$findex++) {
        for ($ddindex = 0;$ddindex < $dindex;$ddindex++) {
            if ($filelist{$findex}{fpath} eq $dirnames[$ddindex]) {
                $filelist{$findex}{dindex} = $ddindex;
            }
        }       
    }
    print "\n" if $verbose;
    return $index, $dindex, $packagesize, %filelist;
}

# main program
print "building leader...\n" if $verbose;
my $leader = build_leader($lname);
print "building signature...\n" if $verbose;
my $signature = build_signature($usepayloadsize);
print "building header...\n" if $verbose;
my $hstore_buff = '';
my $hindex_buff = '';
my $hindex = 0;

# we need header and payload to get the size/md5sum
# and the header needs the number of indexes before we can write it
# index entries are code, type, offset, count

# i18ntable, type is 8 (string array), offset is 0, count is 1
$hindex++;
$hindex_buff .= header_index($tagdict{'HEADERI18NTABLE'}, 8, 0, 1);
$hstore_buff .= 'C' . fill(1);

# package name, type is 6 (string), count is 1
$hindex++;
$hindex_buff .= header_index($tagdict{'NAME'}, 6, length($hstore_buff), 1);
$hstore_buff .= $packagename . fill(1);

# version
$hindex++;
# offset based on length of previous data_store
$hindex_buff .= header_index($tagdict{'VERSION'}, 6, length($hstore_buff), 1);
$hstore_buff .= $usertags{version} . fill(1);

# release
$hindex++;
$hindex_buff .= header_index($tagdict{'RELEASE'}, 6, length($hstore_buff), 1);
$hstore_buff .= $usertags{release} . fill(1);

# summary - data type 9 is I18NSTRING
$hindex++;
$hindex_buff .= header_index($tagdict{'SUMMARY'}, 9, length($hstore_buff), 1);
$hstore_buff .= $usertags{summary} . fill(1);

# description
$hindex++;
$hindex_buff .= header_index($tagdict{'DESCRIPTION'}, 9, length($hstore_buff), 1);
$hstore_buff .= $usertags{description} . fill(1);

# this set of tags we set based on current environment
# build date - data type 4 this time (INT32)
$hindex++;
my $bdate = time;
# need to make sure we're on a 4 byte boundary
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'BUILDTIME'}, 4, length($hstore_buff), 1);
$hstore_buff .= pad($bdate,8);

# buildhost
$hindex++;
my $host = hostname;
$hindex_buff .= header_index($tagdict{'BUILDHOST'}, 6, length($hstore_buff), 1);
$hstore_buff .= $host . fill(1);

# need payload first for size
print "building (or processing) payload...\n" if $verbose;
my ($archivesize, $payload) = build_payload($ARGV[1]);
# now that we have the payload, we can get the file list
print "processing payload files...\n" if $verbose;
my ($llength, $dlength, $packagesize, %fileslist) = get_payload_files($ARGV[1]);

if ($debug) {
    print Dumper(\%fileslist);
    print "$llength\n";
}

print "resuming header...\n" if $verbose;
# size - calculated when we built up the payload
$hindex++;
# need to make sure we're on a 4 byte boundary
# things seem very fragile when I add/remove header store pieces
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'SIZE'}, 4, length($hstore_buff), 1);
$hstore_buff .= pad($packagesize,8);

# vendor
$hindex++;
$hindex_buff .= header_index($tagdict{'VENDOR'}, 6, length($hstore_buff), 1);
$hstore_buff .= $usertags{vendor} . fill(1);

# License
$hindex++;
$hindex_buff .= header_index($tagdict{'COPYRIGHT'}, 6, length($hstore_buff), 1);
$hstore_buff .= $usertags{license} . fill(1);

# packager
$hindex++;
$hindex_buff .= header_index($tagdict{'PACKAGER'}, 6, length($hstore_buff), 1);
$hstore_buff .= $usertags{packager} . fill(1);

# group 
$hindex++;
$hindex_buff .= header_index($tagdict{'GROUP'}, 9, length($hstore_buff), 1);
$hstore_buff .= $usertags{group} . fill(1);

# os
$hindex++;
$hindex_buff .= header_index($tagdict{'OS'}, 6, length($hstore_buff), 1);
$hstore_buff .= $os . fill(1);

# architecture - use host arch but force i486 for ia32
# user could define noarch too
$hindex++;
if ($usertags{arch} eq '') {
    $usertags{arch} = `uname -m`;
    chomp $usertags{arch};
}
if ($usertags{arch} =~ /86$/) {
    $usertags{arch} = 'i486';
}
$hindex_buff .= header_index($tagdict{'ARCH'}, 6, length($hstore_buff), 1);
$hstore_buff .= $usertags{arch} . fill(1);

# prein script
if ($usertags{pre} ne '') {
    $hindex++;
    $hindex_buff .= header_index($tagdict{'PREIN'}, 6, length($hstore_buff), 1);
    $hstore_buff .= $usertags{pre} . fill(1);
}

# postin script
if ($usertags{post} ne '') {
    $hindex++;
    $hindex_buff .= header_index($tagdict{'POSTIN'}, 6, length($hstore_buff), 1);
    $hstore_buff .= $usertags{post} . fill(1);
}

# preun script
if ($usertags{preun} ne '') {
    $hindex++;
    $hindex_buff .= header_index($tagdict{'PREUN'}, 6, length($hstore_buff), 1);
    $hstore_buff .= $usertags{preun} . fill(1);
}

# postun script
if ($usertags{postun} ne '') {
    $hindex++;
    $hindex_buff .= header_index($tagdict{'POSTUN'}, 6, length($hstore_buff), 1);
    $hstore_buff .= $usertags{postun} . fill(1);
}

# note: in a "real" rpm, the indexes are all in numeric order
# things seem to work better when I follow this model

$hindex++;
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'FILESIZES'}, 4, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $hstore_buff .= pad($fileslist{$findex}{size},8);
}

$hindex++;
$hindex_buff .= header_index($tagdict{'FILEMODES'}, 3, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    # is this a file or a directory?
    $defmode = file_or_dir_perms($fileslist{$findex}{isdir}, 'mode');
    $permfilename = $fileslist{$findex}{fpath} . $fileslist{$findex}{fname};
    # handle an override from the permsfile if present
    if ($permstags{file}{$permfilename}{mode}) {
        $newdec = mode_to_decimal($fileslist{$findex}{mode}, $permstags{file}{$permfilename}{mode});
        print "overriding file mode (specified) to $permstags{file}{$permfilename}{mode} for $permfilename...\n" if $verbose;
        $hstore_buff .= pad($newdec,4);
    } elsif ($defmode !~ /HASH/ && $defmode != NULL && $defmode != '') {
        $newdec = mode_to_decimal($fileslist{$findex}{mode}, $defmode);
        print "overriding file mode (default) to $defmode for $permfilename...\n" if $verbose;
        $hstore_buff .= pad($newdec,4);
    } else {
        $hstore_buff .= pad($fileslist{$findex}{mode},4);
    }
}

$hindex++;
$hindex_buff .= header_index($tagdict{'FILERDEVS'}, 3, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $hstore_buff .= pad($fileslist{$findex}{dev},4);
}

$hindex++;
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'FILEMTIMES'}, 4, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $hstore_buff .= pad($fileslist{$findex}{mtime},8);
}

$hindex++;
$hindex_buff .= header_index($tagdict{'FILEMD5S'}, 8, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $hstore_buff .= $fileslist{$findex}{md5} . fill(1);
}

$hindex++;
$hindex_buff .= header_index($tagdict{'FILELINKTOS'}, 8, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $hstore_buff .= $fileslist{$findex}{links} . fill(1);
}

# FIXME - just stuff with 0 for now
$hindex++;
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'FILEFLAGS'}, 4, length($hstore_buff), $llength);
for ($dindex=0; $dindex < $llength; $dindex++) {
    $hstore_buff .= pad(0,8);
}

$hindex++;
$hindex_buff .= header_index($tagdict{'FILEUSERNAME'}, 8, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $defuser = file_or_dir_perms($fileslist{$findex}{isdir}, 'user');
    $permfilename = $fileslist{$findex}{fpath} . $fileslist{$findex}{fname};
    if ($permstags{file}{$permfilename}{user}) {
        print "overriding user (specified) to $permstags{file}{$permfilename}{user} for $permfilename...\n" if $verbose;
        $hstore_buff .= $permstags{file}{$permfilename}{user} . fill(1);
    } elsif ($defuser) {
        print "overriding user (default) to $defuser for $permfilename...\n" if $verbose;
        $hstore_buff .= $defuser . fill(1);
    } else {
        $hstore_buff .= $fileslist{$findex}{uname} . fill(1);
    }
}

$hindex++;
$hindex_buff .= header_index($tagdict{'FILEGROUPNAME'}, 8, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $defgroup = file_or_dir_perms($fileslist{$findex}{isdir}, 'group');
    $permfilename = $fileslist{$findex}{fpath} . $fileslist{$findex}{fname};
    if ($permstags{file}{$permfilename}{group}) {
        print "overriding group (specified) to $permstags{file}{$permfilename}{group} for $permfilename...\n" if $verbose;
        $hstore_buff .= $permstags{file}{$permfilename}{group} . fill(1);
    } elsif ($defgroup) {
        print "overriding group (default) to $defgroup for $permfilename...\n" if $verbose;
        $hstore_buff .= $defgroup . fill(1);
    } else {
        $hstore_buff .= $fileslist{$findex}{gname} . fill(1);
    }
}

# source rpm - we don't really have one
$hindex++;
$hindex_buff .= header_index($tagdict{'SOURCERPM'}, 6, length($hstore_buff), 1);
$hstore_buff .= $src_rpm . fill(1);

# FIXME - fileverifyflags - seen in real rpms, not in spec
$hindex++;
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'FILEVERIFYFLAGS'}, 4, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $hstore_buff .= pad(-1,8);
}

# real rpms do not seem to have this, but pkgchk complains about
# having either SIGTAG_PAYLOADSIZE or RPMTAG_ARCHIVESIZE
if ($usearchivesize) {
    # archivesize
    $hindex++;
    $hindex_buff .= header_index($tagdict{'ARCHIVESIZE'}, 4, length($hstore_buff), 1);
    $hstore_buff .= pad($archivesize,8);
}

# provides
$hindex++;
$hindex_buff .= header_index($tagdict{'PROVIDENAME'}, 8, length($hstore_buff), 1);
$hstore_buff .= $packagename . fill(1);

# requires
# default count is 4 (lsb, rpmlib(CompressedFileNames), rpmlib(PayloadFilesHavePrefix), /bin/sh)
my $requires = 4;
foreach $opt ($usertags{post}, $usertags{preun}, $usertags{postun}) {
    if ($opt ne '') {
        $requires++;
    }
}

# bug 2667 - let the user define requires from their own package base
# we're expecting a comma seperated list of "foo, bar = x.x, baz >= x.x, ..."
our %usr_requires;
our $add_reqs = 0;
if ( $usertags{requires} ne '' ) {
    my @tmpreq;
    my $tmpflag;
    my @reqlist = split(",", $usertags{requires});
    # bump the number of requires
    $requires += @reqlist;
    # qty of user requested requires
    $add_reqs = @reqlist;
    print "User requested requires: $add_reqs\n" if $debug;
    # break them down into name, flag, version
    my $index = 0;
    foreach my $req (@reqlist) {
        if ($req =~ />=/) {
            @tmpreq = split('>=', $req);
            $tmpflag =  $flagdict{'greaterthanequals'};   
        } elsif ($req =~ /<=/) {
            @tmpreq = split('<=', $req);
            $tmpflag = $flagdict{'lessthanequals'};
        } elsif ($req =~ /=/) {
            @tmpreq = split('=', $req);
            $tmpflag = $flagdict{'equals'};
        } else {
            @tmpreq = $req;
            $tmpflag = NULL;
        }
        foreach $reqitem (@tmpreq) {
            $reqitem =~ s/^\s+//; #remove leading spaces
            $reqitem =~ s/\s+$//; #remove trailing spaces            
        }
        $user_requires{$index}{name} = @tmpreq[0];
        $user_requires{$index}{flag} = $tmpflag;
        $user_requires{$index}{version} = @tmpreq[1];
        $index++;            
    }        
    print "Requires:\n" if $debug;
    print Dumper(\%user_requires) if $debug;
}

# require flags
$hindex++;
$hstore_buff = boundary_shift($hstore_buff, 4);
my @rflags = ($flagdict{'greaterthanequals'}, $flagdict{'lessthanequals'}, $flagdict{'greaterthanequals'}, $flagdict{'pre'});
$hindex_buff .= header_index($tagdict{'REQUIREFLAGS'}, 4, length($hstore_buff), $requires);
foreach $r (@rflags) {
    $hstore_buff .= pad($r, 8);
}
if ($usertags{post} ne '' ) {
    $hstore_buff .= pad($flagdict{'post'},8);
}
if ($usertags{preun} ne '' ) {
    $hstore_buff .= pad($flagdict{'preun'},8);
}
if ($usertags{postun} ne '' ) {
    $hstore_buff .= pad($flagdict{'postun'},8);
}

# user defined requires flags
if ($add_reqs) {
    for (my $i = 0; $i < $add_reqs; $i++) {
        $hstore_buff .= pad($user_requires{$i}{flag},8);
    }       
}

# requires lsb, rpmlib(CompressedFileNames), /bin/sh, rpmlib(PayloadFilesHavePrefix)
$hindex++;
my @requires = ('lsb', 'rpmlib(CompressedFileNames)', 'rpmlib(PayloadFilesHavePrefix)', $shell);
$hindex_buff .= header_index($tagdict{'REQUIRENAME'}, 8, length($hstore_buff), $requires);
foreach $r (@requires) {
    $hstore_buff .= $r . fill(1);
}
foreach $opt ($usertags{post}, $usertags{preun}, $usertags{postun}) {
    if ($opt ne '') {
        $hstore_buff .= $shell . fill(1);
    }
}

# user defined requires names
if ($add_reqs) {
    for (my $i = 0; $i < $add_reqs; $i++) {
        $hstore_buff .= $user_requires{$i}{name} . fill(1);
    }       
}

# version 4.0, 3.0.4-1, 4.0.1, ''
$hindex++;
@requires = ($usertags{lsbversion}, '3.0.4-1', '4.0-1', '');
$hindex_buff .= header_index($tagdict{'REQUIREVERSION'}, 8, length($hstore_buff), $requires);
foreach $r (@requires) {
    $hstore_buff .= $r . fill(1);
}
foreach $opt ($usertags{post}, $usertags{preun}, $usertags{postun}) {
    if ($opt ne '') {
        $hstore_buff .= '' . fill(1);
    }
}

# user defined requires versions
if ($add_reqs) {
    for (my $i = 0; $i < $add_reqs; $i++) {
        $hstore_buff .= $user_requires{$i}{version} . fill(1);
    }       
}

# rpm version
$hindex++;
$hindex_buff .= header_index($tagdict{'RPMVERSION'}, 6, length($hstore_buff), 1);
$hstore_buff .= $rpmversion . fill(1);

# prein program - always present?
$hindex++;
$hindex_buff .= header_index($tagdict{'PREINPROG'}, 6, length($hstore_buff), 1);
$hstore_buff .= $shell . fill(1);

if ($usertags{post} ne '') {
    # post program
    $hindex++;
    $hindex_buff .= header_index($tagdict{'POSTINPROG'}, 6, length($hstore_buff), 1);
    $hstore_buff .= $shell . fill(1);
}

if ($usertags{preun} ne '') {
    # preun program
    $hindex++;
    $hindex_buff .= header_index($tagdict{'PREUNPROG'}, 6, length($hstore_buff), 1);
    $hstore_buff .= $shell . fill(1);
}

if ($usertags{postun} ne '') {
    # postun program
    $hindex++;
    $hindex_buff .= header_index($tagdict{'POSTUNPROG'}, 6, length($hstore_buff), 1);
    $hstore_buff .= $shell . fill(1);
}

# file devices
$hindex++;
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'FILEDEVICES'}, 4, length($hstore_buff), $llength);
for ($dindex=0; $dindex < $llength; $dindex++) {
    $hstore_buff .= pad($fileslist{$dindex}{device},8);
}

# file inodes
$hindex++;
$hindex_buff .= header_index($tagdict{'FILEINODES'}, 4, length($hstore_buff), $llength);
for ($dindex=0; $dindex < $llength; $dindex++) {
    $hstore_buff .= pad($fileslist{$dindex}{inode},8);
}

# FIXME - file languages - null for now
$hindex++;
$hindex_buff .= header_index($tagdict{'FILELANGS'}, 8, length($hstore_buff), $llength);
for ($dindex=0; $dindex < $llength; $dindex++) {
    $hstore_buff .= '' . fill(1);
}

$hindex++;
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'PROVIDEFLAGS'}, 4, length($hstore_buff), 1);
$hstore_buff .= pad($flagdict{'equals'}, 8);

$hindex++;
$hindex_buff .= header_index($tagdict{'PROVIDEVERSION'}, 8, length($hstore_buff), 1);
$hstore_buff .= $usertags{version} . "-" . $usertags{release} . fill(1);

$hindex++;
$hstore_buff = boundary_shift($hstore_buff, 4);
$hindex_buff .= header_index($tagdict{'DIRINDEXES'}, 4, length($hstore_buff), $llength);
for ($dindex=0; $dindex < $llength; $dindex++) {
    $hstore_buff .= pad($fileslist{$dindex}{dindex},8);
}

$hindex++;
$hindex_buff .= header_index($tagdict{'BASENAMES'}, 8, length($hstore_buff), $llength);
for ($findex=0; $findex < $llength; $findex++) {
    $hstore_buff .= $fileslist{$findex}{fname} . fill(1);
}

$hindex++;
$hindex_buff .= header_index($tagdict{'DIRNAMES'}, 8, length($hstore_buff), $dlength);
for ($dindex=0; $dindex < $dlength; $dindex++) {
    $hstore_buff .= $fileslist{$dindex}{dname} . fill(1);
}

# done with files
# payload format
$hindex++;
$hindex_buff .= header_index($tagdict{'PAYLOADFORMAT'}, 6, length($hstore_buff), 1);
$hstore_buff .= $pformat . fill(1);

# payload compressor
$hindex++;
$hindex_buff .= header_index($tagdict{'PAYLOADCOMPRESSOR'}, 6, length($hstore_buff), 1);
$hstore_buff .= $pcompressor . fill(1);

# payload flags
$hindex++;
$hindex_buff .= header_index($tagdict{'PAYLOADFLAGS'}, 6, length($hstore_buff), 1);
$hstore_buff .= $pflags . fill(1);

if(0) { #just leave this out for now
$immutable=0;
# either HEADERIMAGE or HEADERIMMUTABLE
# is first in a "real" rpm, but needs the size
if ($immutable) {
    $hindex++;
    $hindex_buff = header_index($tagdict{'HEADERIMMUTABLE'}, 7, length($hstore_buff), 16) . $hindex_buff;
    # FIXME - what goes here?
    $hstore_buff .= fill(16);
} else {
    $hindex++;
    $hindex_buff = header_index($tagdict{'HEADERIMAGE'}, 7, length($hstore_buff), 16) . $hindex_buff;
    # FIXME - what goes here?
    $hstore_buff .= fill(16);
}
}

# then we need to go back and write the header, based on the number of 
# indexes, and the data store size
print "finishing header index...\n" if $verbose;
my $header = header_start($hindex, length($hstore_buff));
$header .= $hindex_buff . $hstore_buff;

# now we can finally finish the signature
print "building signature data store...\n" if $verbose;
my $sigstore = build_sig_store($header, $payload, $archivesize, $usepayloadsize);

# and write the file
print "writing to package file...\n" if $verbose;
my $packagefile = $lname . "." . $usertags{arch} . ".rpm";
open(RPMHEAD,"> $packagefile");
binmode(RPMHEAD);

print RPMHEAD $leader;
print RPMHEAD $signature;
print RPMHEAD $sigstore;
print RPMHEAD $header;
print RPMHEAD $payload;

# all done
close(RPMHEAD);
print "wrote $packagefile\n" if $verbose;
