#!/usr/bin/perl
#
# sepa.pl
#
# Self-Extracting Perl Archive
#
# Usage:
# sepa.pl file,file,...
#
# Creates a Perl script that contains
# a number of files;  when the script
# is executed, the files are extracted
# and written to the current directory
#
# File integrity is now checked, using
# Digest::MDS.  This is the ONLY requirement
# for the output script.  This comes with
# the base Perl installation, so it should not
# be a problem
#
use strict;
use File::Basename;
use Digest::MD5;

my $APPNAME = "sepa.pl";

my $VERSION = "0.2";

if ( $#ARGV >= 0 ) {
    my $script = MakeArchiveScript(@ARGV);
    print $script;
}
else {
    print "Self-Extracting Perl Archive $VERSION\n";
    print "Usage: $0 file,file,...\n";
    exit;
}

sub MakeArchiveScript {
    my (@file_list) = @_;
    my @stub=<DATA>;
    my $retval = join('',@stub);
    $retval=~s/!APPNAME/$APPNAME/g;
    $retval=~s/!VERSION/$VERSION/g;
    $retval .= MakePerlArchive(@file_list);
    return $retval;
}

# MakePerlArchive(@file_list)
#
# Takes an array of
# files as an argument, and returns
# a Perl script that will extract
# those files into the current
# directory
#
sub MakePerlArchive {
    my (@archive_list) = @_;
    my $packsubs       = "";
    my $retval         = "";
    my $hash           = "";
    foreach my $file (@archive_list) {
        my $original_filename = $file;
    $hash = HashFile($original_filename);
        my $outputfilename    = basename($file);
        my $subname = random_string(10);
        my $packedbin = PackBinaryFile( $original_filename, $subname )
+;
        $packsubs .= "$packedbin\n";
        $retval   .= '$file="' . $outputfilename . '";' . "\n";
    $retval   .= '$hash="' . $hash . '";' . "\n";
        $retval   .= '$packed_data=' . $subname . '();' . "\n";
        $retval   .=
          'open(FILE,">$file") || die "Error writing file - $!\n";' . 
+"\n";
        $retval .= 'binmode FILE;' . "\n";
        $retval .= 'print FILE $packed_data;' . "\n";
        $retval .= 'close FILE;' . "\n";
    $retval .= 'if(VerifyFile($hash,$file)==0) { print "$file is damag
+ed. Not extracted.\n"; unlink $file; } else { print "Extracted $file\
+n"; } ' . "\n";
    }
    $retval .= 'print "\n";' . "\n";
    $retval .= "$packsubs\n";
    return $retval;
}

#
# PackBinaryFile($filename,$subroutine_name)
#
# Loads a file, packs it, and makes a Perl
# subroutine to unpack it.
#
# Found on comp.lang.perl.misc in a post by
# Jonathan Stowe (gellyfish@gellyfish.com)
#
sub PackBinaryFile {
    my $file    = shift || die "$0: No file specified\n";
    my $subname = shift || die "$0: No subname specified\n";
    open( FILE, $file ) || die "Couldnt open $file - $!\n";
    binmode FILE;
    my $imgdata = do { local $/; <FILE> };
    my $uustring = pack "u", $imgdata;
    return <<EOSUB;
sub $subname
{
  return unpack "u", <<'EOIMG';
$uustring
EOIMG
}
EOSUB
}

#
# random_string($length)
#
# Creates a "random" string
# of the specified length
#
sub random_string {
    my $length = shift || 2;
    my @chars = ( 'a' .. 'z', 'A' .. 'Z' );
    join( '', map { $chars[ rand() * @chars ] } ( 1 .. $length ) );
}

sub HashFile
{
    my($filename)=@_;
    open( FILE, $filename ) || die "Couldnt open $filename - $!\n";
    binmode FILE;
    my $fdata = do { local $/; <FILE> };
    close FILE;
    my $md5 = Digest::MD5->new;
    $md5->add($fdata);
    return $md5->hexdigest;

}

__DATA__
#!/usr/bin/perl
use strict;
use Digest::MD5;

my $file;
my $packed_data;
my $hash;

sub VerifyFile
{
    my($ohash,$filename)=@_;
    if($ohash==HashFile($filename)) { return 1; }
    return 0;
}

sub HashFile
{
    my($filename)=@_;
    open( FILE, $filename ) || die "Couldnt open $filename - $!\n";
    binmode FILE;
    my $fdata = do { local $/; <FILE> };
    close FILE;
    my $md5 = Digest::MD5->new;
    $md5->add($fdata);
    return $md5->hexdigest;

}

print "\n********************************\n";
print "* Self Extracting Perl Archive *\n";
print "********************************\n\n";
print "Created with !APPNAME !VERSION\n\n";