Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Self-extracting Perl archives

by bikeNomad (Priest)
on Aug 01, 2001 at 19:58 UTC ( #101426=sourcecode: print w/ replies, xml ) Need Help??

Category: Miscellaneous
Author/Contact Info bikeNomad, Ned Konz, perl@bike-nomad.com
Description: Creates a self-extracting, uncompressed, Perl archive from the (possibly binary) files specified on the command line. Does not require any library modules for extraction. Will make directories as needed.

Does not yet handle cross-platform filenames or allow for translating paths from absolute to relative (though you can of course edit its output with another Perl program).

Note that these files will actually be at least 37% bigger than the input files because of the extractor and the uuencoding. But you can send binary with them without worrying about someone trashing them in a mail or FTP program.

#!/usr/bin/perl -w
# Creates self-extracting archives that use Perl to extract.
# Will make directories on extraction, but parents of top-level
# directories must exist and be writable.
#
# Outputs self-extracting archive to stdout.
# Arguments that are directories will be recursed into.
#
# To make an archive:
#  perl separ.pl <fileOrDir> [...] > archive
#
# To unpack an archive:
#   perl archive
#
# Uses no external modules for decompression.
# File format is: extractor program (Perl) at top,
# __DATA__ tag,
# multiple files, uuencoded.
# There may be "mkdir" lines before files.
#
# By Ned Konz, perl@bike-nomad.com
# encode() derived from Tom Christensen's PPT version of uuencode
# decoder based on code by Nick Ing-Simmons and Tom Christiansen

use strict;
use File::Find;

sub encode {
    my ( $source, $destination, $mode ) = @_;

    if ( $source eq '-' && -t STDIN ) {
        warn "$0: WARNING: reading from standard input\n";
    }

    printf "begin %03o $destination\012", $mode || 0644;

    local *INPUT;
    open( INPUT, "< $source" ) || die "can't open $source: $!";
    binmode(INPUT);

    my $block;
    print pack( "u", $block ) while read( INPUT, $block, 45 );
    print "`\012";
    print "end\012";

    close(INPUT) || die "can't close $source: $!";
}

# copy the extractor
print $_ while (<DATA>);

# now encode the files with relative path names
$File::Find::dont_use_nlink = 1;
for my $arg (@ARGV) {
    my $ignoreLength = length($arg) + 1;
    File::Find::find(
        {
            no_chdir => 1,
            wanted   => sub {
                my $name = $File::Find::name;
                my $mode = $name eq '-' ? 0777 : ( stat($name) )[2];

                if ( -d _ ) {
                    $mode &= 0777;
                    printf( "mkdir %03o %s\012", $mode || 0777, $name 
+);
                    return;
                }
                encode( $name, $name, $mode & 0666 );
            },
        },
        $arg
    );
}

__DATA__
#!/usr/bin/perl
use strict;

# This is a self-extracting archive that requires Perl to extract.
BEGIN { $/ = "\012" }

while (<DATA>) {

  # attempt to be robust if someone edits this file in a different OS
  $_ =~ s/[\r\n]+$//s;
  next FILESPEC
    unless my ( $op, $mode, $file ) = /^(begin|mkdir)\s+(\d+)\s+(.*)/s
+;

  if ( $op eq 'mkdir' ) {
    if ( !-d $file ) {
      print STDERR "making directory $file\n";
      mkdir $file, 0777 or die "Can't make directory $file: $!\n";
    }
    next;    # filespec
  }
  my $foundEnd = 0;
  print STDERR "extracting file $file\n";
  open( OUT, ">$file" ) or die "Can't create $file: $!\n";
  binmode(OUT);

  while (<DATA>) {
    $_ =~ s/[\r\n]+$//s;
    if (/^end/) { $foundEnd++; last }
    next if /[a-z]/;
    next
      unless int( ( ( ( ord() - 32 ) & 077 ) + 2 ) / 3 ) == int( lengt
+h() / 4 );
    print OUT unpack( "u", $_ ) or die "can't write $file: $!";
  }
  close(OUT) or die "can't close $file: $!";
  chmod oct($mode), $file or die "can't chmod $file to $mode: $!\n";
  $foundEnd or die "Missing end: $file may be truncated.\n";
}
__DATA__

Comment on Self-extracting Perl archives
Download Code
Re: Self-extracting Perl archives
by Anonymous Monk on Dec 31, 2002 at 17:02 UTC
    Exactly the tool I looked for. But it doesn't work in that form: You haven't defined a LABEL "FILESPEC" in the decoder. Define it or remove it completely. Uli

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://101426]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (7)
As of 2014-12-28 13:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (181 votes), past polls