#!/usr/bin/perl
=begin metadata
Name: unshar
Description: extract files from a shell archive
Author: Larry Wall, larry@wall.org
License: perl
=end metadata
=cut
#
# unshar - extract files from a shell archive
#
# v 1.1 by Larry Wall
# v 1.2 by Fuzzy - uudecode, chmod, touch, $variables, `backticks`, if/else/fi
while (@ARGV && $ARGV[0] =~ s/^-//) {
local $_ = shift;
while (/([cdfq])/g) {
if ($1 eq 'd') {
$opts{'d'} = /\G(.*)/g && $1 ? $1 : shift;
} else {
$opts{$1}++;
}
}
}
local $SIG{__WARN__} = $opts{'q'} ? sub {} : sub { print @_ };
$ENV{1} = $opts{'c'} || $opts{'f'} ? '-c' : '';
while (<>) {
last if /^[#:]/;
}
die "No script found.\n" unless $_;
if ($opts{'d'}) {
chdir $opts{'d'} || die "Can't chdir '$opts{'d'}': $!";
}
%test = (
'eq', '==',
'ne', '!=',
'gt', '>',
'ge', '>=',
'lt', '<',
'le', '<=',
'=', 'eq',
'!=', 'ne',
'<', 'lt',
'>', 'gt',
);
while (<>) {
next if /^[#:]/;
s/^\s+//;
s/\$(\w+)/$ENV{$1}/g;
for (/`([^`]+)`/g) {
if (/wc -c < (\S+)/) {
$filename = $1;
$filename =~ s/^'(.*)'$/$1/ ||
$filename =~ s/^"(.*)"$/$1/ ||
$filename =~ s/\\(.)/$1/;
$ENV{$_} = -s $filename;
}
else {
$ENV{$_} = `$_`;
}
}
s/`([^`]+)`/$ENV{$1}/g;
if ($if) {
if (/^fi/) {
$if--;
pop @expr;
next;
}
if (/^else/ && defined $expr[$#expr]) {
$expr[$#expr] = $expr[$#expr] ? 0 : 1;
next;
}
next unless $expr[$#expr];
}
$endmark = $1 if s/<<\s*(\S+)//;
if ($endmark) {
$endmark =~ s/^'(.*)'$/$1/ ||
$endmark =~ s/^"(.*)"$/$1/ ||
$endmark =~ s/\\(.)/$1/;
$endmark .= "\n";
}
if (s/^echo //) {
s/["']//g;
warn $_;
}
elsif (/^export\s+PATH|^PATH\s*=/) {
next;
}
elsif (s/^mkdir\s*//) {
die "Reference to parent directory" if m|\.\./|;
die "Reference to absolute directory" if m|\s[/~]|;
if (s/;(.*)//) {
$rem = $1;
}
else {
$rem = '';
}
s/\s+$//;
s/^'(.*)'$/$1/ || s/^"(.*)"$/$1/ || s/\\(.)/$1/;
mkdir($_, 0777) || die "Couldn't mkdir '$_': $!";
$_ = $rem;
redo if $rem;
}
elsif (/^cat\s+(>+)\s*(\S+)\s*$/) {
$redir = $1;
$filename = $2;
$filename =~ s/^'(.*)'$/$1/ ||
$filename =~ s/^"(.*)"$/$1/ ||
$filename =~ s/\\(.)/$1/;
die "Reference to parent directory" if $filename =~ m|\.\./|;
die "Reference to absolute directory" if $filename =~ m|^[/~]|;
open(FILE, '<', "$redir$filename") || die "Can't create $filename";
while (<>) {
last if $_ eq $endmark;
print FILE $_;
}
close FILE;
}
elsif (/^sed\s+(.*\S)\s+(>+|\|)\s*(\S+)\s*$/ ||
/^sed\s+(>+|\|)\s*(\S+)\s+(.*\S)\s*$/) {
if (substr($1,0,1) eq '>') {
$redir = $1;
$filename = $2;
$sedcmd = $3;
}
else {
$sedcmd = $1;
$redir = $2;
$filename = $3;
}
$filename =~ s/^'(.*)'$/$1/ ||
$filename =~ s/^"(.*)"$/$1/ ||
$filename =~ s/\\(.)/$1/;
die "Reference to parent directory" if $filename =~ m|\.\./|;
die "Reference to absolute directory" if $filename =~ m|^\s*[/~]|;
die "Illegal sed command" if $sedcmd =~ /[|;`<\$]/;
$sedcmd =~ s/^-e\s*//;
$sedcmd =~ s/^'(.*)'$/$1/ ||
$sedcmd =~ s/^"(.*)"$/$1/ ||
$sedcmd =~ s/\\(.)/$1/;
die "Can only do s command in sed" unless $sedcmd =~ /^s/;
die "Can't do multiple commands" if $sedcmd =~ /;/;
warn "$redir$filename\n";
if ($filename eq 'uudecode') {
$_ = <ARGV>;
/^begin\s+(\d+)\s+(\S+)/ || die 'Missing uuencode header';
open(FILE, '>', $2) || die "Can't create '$2'";
binmode FILE;
eval sprintf '
while (<>) {
warn $_;
last if /^end$/;
%s;
$_ = unpack("u", $_);
print FILE;
}
', $sedcmd;
while ($_ = <>) {
last if $_ eq $endmark;
}
} else {
open(FILE, '>', $filename) || die "Can't create $filename: $!";
binmode FILE;
eval sprintf '
while (<>) {
warn $_;
last if $_ eq $endmark;
%s;
print FILE;
}
', $sedcmd;
}
close FILE;
}
elsif (/^exit/) {
$_ = <> until $_ eq '' || /^[#:]/;
exit unless $_;
}
elsif (/^chmod\s+(0\d{3})\s+(\S+)\s*$/) {
($mode, $filename) = ($1, $2);
$filename =~ s/^'(.*)'$/$1/ ||
$filename =~ s/^"(.*)"$/$1/ ||
$filename =~ s/\\(.)/$1/;
$mode = oct($mode);
chmod($mode, $filename);
}
elsif (/^touch\s+-([am]+t)\s+(\d{8})(\.\d\d)?\s+(\S+)\s*$/) {
($type, $date, $sec, $filename) = ($1, $2, $3, $4);
eval('use Time::Local');
next if $@;
$filename =~ s/^'(.*)'$/$1/ ||
$filename =~ s/^"(.*)"$/$1/ ||
$filename =~ s/\\(.)/$1/;
($mon, $mday, $hour, $min) = $date =~ /(..)/g;
$sec ||= 0;
$sec =~ tr/.//d;
$time = timelocal($sec, $min, $hour, $mday, $mon - 1, (localtime)[5]);
$atime = $type =~ /a/ ? $time : (stat $filename)[8];
$mtime = $type =~ /m/ ? $time : (stat $filename)[9];
utime($atime, $mtime, $filename);
}
elsif (/^(\w+)=(\S*)/) {
($name, $value) = ($1, $2);
$value =~ s/^'(.*)'$/$1/ ||
$value =~ s/^"(.*)"$/$1/ ||
$value =~ s/\\(.)/$1/;
$ENV{$name} = $value;
}
elsif (s/^if\s+//) {
$if++;
$a = 'test\s+';
$z = '\s*(;|&&|\|\|)';
s/$a(-[df])\s+(\S+)$z/$1 $2 $3/go;
s/$a(\d+)\s+-(eq|ne|gt|ge|lt|le)\s+(\d+)$z/$1 $test{$2} $3 $4/go;
s/$a([^']+)\s+(!?=|>|<)\s+([^']+)$z/'$1' $test{$2} '$3' $4/go;
s/$a([^"]+)\s+(!?=|>|<)\s+([^"]+)$z/"$1" $test{$2} "$3" $4/go;
s/$a(\w+)$z/length $1 $2/go;
s/;\s*then\s*$/\n/;
push @expr,
/test/ ? undef :
eval($_) ? 1 : 0;
}
else {
$r = $_;
$lines = 1;
while (<>) {
++$lines;
$r .= $_;
last if /^exit/;
}
if ($_) {
$_ = <> until $_ eq '' || /^[#:]/;
}
open(REM, '>', ".r") || die "Can't create .r";
print REM $r;
close REM;
chmod 0700, '.r';
if ($lines > 21 || !open(TTY, '<', '/dev/tty')) {
print "Could not run remainder of kit. Inspect .r and run it\n";
exit;
}
else {
print "Could not run remainder of kit. Inspect this.\n$r";
print "Run it? [y] ";
$ans = <TTY>;
system '.r' if $ans =~ /^y/i;
}
exit unless $_;
}
}
__END__
=head1 NAME
unshar - extract files from a shell archive
=head1 SYNOPSIS
B<unshar> [-d dir] [-cfq] file [files...]
=head1 DESCRIPTION
B<unshar> scans files for shell archives and extracts the files contained in
those archives. B<unshar> attempts to decode a B<shar> file in a secure fashion.
If it can't do so, it will instruct you to inspect something first.
=head1 OPTIONS
=over
=item -c
Overwrite existing files.
=item -d dir
Change directory to I<dir> before extracting files.
=item -f
Same as B<-c>.
=item -q
Shhh!
=back
=head1 ENVIRONMENT
No environment variables are used.
=head1 FILES
None.
=head1 BUGS
There are too many existent shar formats for it to handle.
=head1 SEE ALSO
B<shar>, B<uudecode>
=head1 AUTHOR
Larry Wall | larry@wall.org
=head1 COPYRIGHT
Copyright (c) 1999 Larry Wall. All rights reserved.
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut