getprotobyname y for sysopen warn unless getprotobyname study wait eof log getprotobyname join until xor symlink for getprotobyname print for jtmpougawhlnielnrihucdlny x getprotobyname icmp #### #!perl use strict; use warnings; #use Data::Dumper; use IO::Handle; sub back { my(%h, %r, $f, $t, $i, $v, $o, $b, $r, $x, $y, $c, $m, $a); $m = "just another perl hacker\n"; ($a) = @_; $a =~ /^y\s+(\S)(.*?)\1(.*?)\1/s or die "error y: <$a>"; $f = $2; $t = $3; $t .= substr($t, -1) x 100; for $i (0 .. length($f) - 1) { $x = substr($f, $i, 1); $y = substr($t, $i, 1); defined($h{$x}) or $h{$x} = $y; } for $x ($m =~ /./gs) { defined($h{$x}) or $h{$x} = $x } while (($x, $y) = each(%h)) { $x =~ /\S/ or next; ($v = ($r{$y} .= $x)) =~ s/$y//; $v =~ /\S/ and $r{$y} = $v; } for $c ($m =~ /./sg) { defined($b = $r{$c}) or return (); $o .= substr($b, rand(length($b)), 1); } return $o; } my @funcs = ( "abs", "accept", "alarm", "atan2", "bind", "binmode", "bless", "caller", "chdir", "chmod", "chomp", "chop", "chown", "chr", "chroot", "close", "closedir", "connect", "continue", "cos", "crypt", "dbmclose", "dbmopen", "defined", "delete", "die", "do", "dump", "each", #"endgrent", #"endhostent", "endnetent", "endprotoent", "endpwent", "endservent", "eof", "eval", "exec", "exists", "exit", "exp", "fcntl", "fileno", "flock", "fork", "format", "formline", "getc", #"getgrent", "getgrgid", #"getgrnam", "gethostbyaddr", "gethostbyname", "gethostent", "getlogin", #"getnetbyaddr", "getnetbyname", "getnetent", "getpeername", "getpgrp", "getppid", #"getpriority", "getprotobyname", "getprotobynumber", #"getprotoent", "getpwent", "getpwnam", "getpwuid", "getservbyname", #"getservbyport", "getservent", "getsockname", "getsockopt", "glob", "gmtime", "goto", "grep", "hex", "import", "index", "int", "ioctl", "join", "keys", "kill", "last", "lc", "lcfirst", "length", "link", "listen", "local", "localtime", "log", "lstat", "map", "mkdir", "msgctl", "msgget", "msgrcv", "msgsnd", "my", "next", "no", "oct", "open", "opendir", "ord", "our", "pack", "package", "pipe", "pop", "pos", "print", "printf", "prototype", "push", "quotemeta", "rand", "read", "readdir", "readline", "readlink", "readpipe", "recv", "redo", "ref", "rename", "require", "reset", "return", "reverse", "rewinddir", "rindex", "rmdir", "scalar", "seek", "seekdir", "select", "semctl", "semget", "semop", "send", #"setgrent", "sethostent", "setnetent", "setpgrp", #"setpriority", "setprotoent", "setpwent", "setservent", "setsockopt", "shift", #"shmctl", "shmget", "shmread", "shmwrite", "shutdown", "sin", "sleep", "socket", "socketpair", "sort", "splice", "split", "sprintf", "sqrt", "srand", "stat", "study", "sub", "substr", "symlink", "syscall", "sysopen", "sysread", "sysseek", "system", "syswrite", "tell", "telldir", "tie", "tied", "time", "times", "truncate", "uc", "ucfirst", "umask", "undef", "unlink", "unpack", "unshift", "untie", "use", "utime", "values", "vec", "wait", "waitpid", "wantarray", "warn", "write", "q", "qx", "qr", "qq", "m", "s", "y", "tr", "if", "while", "for", "unless", "until", "foreach", "and", "or", "xor", "not", "x", ); my(@fun_norm, @fun_bgn, @fun_mid); for my $f (@funcs) { if ($f =~ /^f/) { push @fun_bgn, $f; } if ($f =~ /f/) { push @fun_mid, $f; } else { push @fun_norm, $f; } } sub randof { ${$_[0]}[rand(@{$_[0]})]; } sub randov { $_[rand(@_)]; } sub blab { my $s = "y"; $s .= " " . randof(\@fun_bgn); for (0 .. rand(3)) { $s .= " " . randof(\@fun_norm); } $s .= "\ngetprotobyname"; for (0 .. rand(2)) { $s .= " " . randof(\@fun_norm); } $s .= " " . randof(\@fun_mid); if (rand(2) < 1) { my $m = int rand(2); my $j = int rand($m); for my $i (0 .. $m) { $s .= " " . ($i == $j ? "join" : randof(\@fun_norm)); } $s .= "\ngetprotobyname"; for (0 .. rand(4)) { $s .= " " . randof(\@fun_norm); } } else { for (0 .. rand(2)) { $s .= " " . randof(\@fun_norm); } $s .= "\ngetprotobyname"; my $m = int rand(4); my $j = int rand($m); for my $i (0 .. $m) { $s .= " " . ($i == $j ? "join" : randof(\@fun_norm)); } } $s .= " for"; $s; } autoflush STDOUT; open my $log, ">>", "a"; autoflush $log; print $log "\n"; for (my $n = 0;; $n++) { 0 == $n % 32 and print ":"; my $s = blab(); my $r = back($s); defined($r) or next; my $o = "getprotobyname " . $s . "\ngetprotobyname print for " . $r . " x\ngetprotobyname icmp\n\n"; print "\n", $o; print $log $o; } __END__