#!/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";
|