【perl】perlコードを実行可能なままで圧縮し、元コードを隠す

zippack.pl

use strict;
use autodie;
use IO::Compress::Gzip qw(gzip $GzipError);
use File::Slurp;
use File::Basename;

#Ref: How to use Gzip/Gunzip
#http://blog.livedoor.jp/moya_pro/archives/21566288.html

unless ($ARGV[0]) {
	die "usage:". basename($0) ." inputfilename [>outputfilename]";
}

my $targetCode = read_file( $ARGV[0], { binmode => ':raw' } ) ;
my $buf;
gzip \$targetCode => \$buf or die "$GzipError";

print "#This file is generated by ". basename($0) . ".\n";
print "#Do not modify this file with a text editor.(or _DATA_ part will be broken.)\n";
print <<'EOD';
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
my $code;
my $zipcode = join('',map{$_}<DATA>);
gunzip \$zipcode => \$code or die "$GunzipError";
eval $code;
if ($@) {die $@, "\n";}
__DATA__
EOD
binmode(STDOUT);
print $buf;

use strict;

use autodie;

use IO::Compress::Gzip qw(gzip $GzipError);

use File::Slurp;

use File::Basename;

#Ref: How to use Gzip/Gunzip

#http://blog.livedoor.jp/moya_pro/archives/21566288.html

unless ($ARGV[0]) {

die "usage:". basename($0) ." inputfilename [>outputfilename]";

}

my $targetCode = read_file( $ARGV[0], { binmode => ':raw' } ) ;

my $buf;

gzip \$targetCode => \$buf or die "$GzipError";

print "#This file is generated by ". basename($0) . ".\n";

print "#Do not modify this file with a text editor.(or _DATA_ part will be broken.)\n";

print <<'EOD';

use IO::Uncompress::Gunzip qw(gunzip $GunzipError);

my $code;

my $zipcode = join('',map{$_}<DATA>);

gunzip \$zipcode => \$code or die "$GunzipError";

eval $code;

if ($@) {die $@, "\n";}

__DATA__

EOD

binmode(STDOUT);

print $buf;

圧縮後のスクリプトのスクショ

圧縮後スクリプトの実行結果

※|moreは、くっつけると実行結果をページ送りで見れるようになるコマンド

zippack.plの使い方

この場合、gatcha.plが圧縮前のスクリプトで、gatcha3.plが出力された圧縮後のスクリプト。

gatcha.plの中身

特に目的のないコード。
ネットで拾った名前リストから名前をランダムで選び、LvとHpをランダムでつけて出力する。

名前リストは長すぎるので途中省略。

use strict;

our $REPEAT = 100;
our @PEOPLE = ();
our @NAMES = ();
{
	my @names_raw = split("\n",nameData());
	chomp(@names_raw);
	for (@names_raw) {
		if (/^([A-Z]+)/) {
			push(@NAMES,$1);
		}
	}
}


for (1 .. $REPEAT) {
	my $person = Person->new();
	$person->{name} = &getRandName();
	$person->{lv} = int rand(100);
	$person->{hp} = $person->{lv} * (1 + int rand(100)) + 50;
	push(@PEOPLE,$person);
}

for (@PEOPLE) {
	printf("%-12sLv:%2d HP:%5d\n",$_->{name},$_->{lv},$_->{hp});
}

sub getRandName {
	return $NAMES[int rand @NAMES];
}

package Person;
    use strict;
    sub new {
        my $self  = {};
        $self->{name} = "";
        $self->{lv}    = 1;
        $self->{hp}  = 0;
        bless($self);
        return $self;
    }

package main;
sub nameData {
#got from http://deron.meranda.us/data/census-dist-female-first.txt
return <<EOD;
MARY           2.629  2.629      1
PATRICIA       1.073  3.702      2
LINDA          1.035  4.736      3
BARBARA        0.980  5.716      4
ELIZABETH      0.937  6.653      5
JENNIFER       0.932  7.586      6
MARIA          0.828  8.414      7
SUSAN          0.794  9.209      8
MARGARET       0.768  9.976      9
DOROTHY        0.727 10.703     10
LISA           0.704 11.407     11
NANCY          0.669 12.075     12
KAREN          0.667 12.742     13
BETTY          0.666 13.408     14
HELEN          0.663 14.071     15
中略
EOD

}

use strict;

our $REPEAT = 100;

our @PEOPLE = ();

our @NAMES = ();

{

my @names_raw = split("\n",nameData());

chomp(@names_raw);

for (@names_raw) {

if (/^([A-Z]+)/) {

push(@NAMES,$1);

}

for (1 .. $REPEAT) {

my $person = Person->new();

$person->{name} = &getRandName();

$person->{lv} = int rand(100);

$person->{hp} = $person->{lv} * (1 + int rand(100)) + 50;

push(@PEOPLE,$person);

}

for (@PEOPLE) {

printf("%-12sLv:%2d HP:%5d\n",$_->{name},$_->{lv},$_->{hp});

}

sub getRandName {

return $NAMES[int rand @NAMES];

}

package Person;

use strict;

sub new {

my $self = {};

$self->{name} = "";

$self->{lv} = 1;

$self->{hp} = 0;

bless($self);

return $self;

}

package main;

sub nameData {

#got from http://deron.meranda.us/data/census-dist-female-first.txt

return <<EOD;

MARY 2.629 2.629 1

PATRICIA 1.073 3.702 2

LINDA 1.035 4.736 3

BARBARA 0.980 5.716 4

ELIZABETH 0.937 6.653 5

JENNIFER 0.932 7.586 6

MARIA 0.828 8.414 7

SUSAN 0.794 9.209 8

MARGARET 0.768 9.976 9

DOROTHY 0.727 10.703 10

LISA 0.704 11.407 11

NANCY 0.669 12.075 12

KAREN 0.667 12.742 13

BETTY 0.666 13.408 14

HELEN 0.663 14.071 15

中略

EOD

}

動作

perlスクリプトをgzipで圧縮
圧縮後データを__DATA__ブロックとして出力
__DATA__の前に展開ルーチンを出力
実行するときはgzip展開した__DATA__をeval

問題、欠点

圧縮される側のスクリプトに__DATA__ブロックが含まれていると動かない
変数の衝突の可能性

実用的ではないです。面白いからやっただけ。

【perl】perlコードを実行可能なままで圧縮し、元コードを隠す

圧縮後のスクリプトのスクショ

圧縮後スクリプトの実行結果

zippack.plの使い方

gatcha.plの中身

動作

問題、欠点

関連記事