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

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

Here's an example of a version that prints a newline after the message (I realized this was possible only after the post.)

getprotobyname y for sysopen warn unless getprotobyname study wait eof log getprotobyname join until xor symlink for getprotobyname print for jtmpougawhlnielnrihucdlny x getprotobyname icmp

Below I include the program that generated more of this kind.

The obfu generator creates obfus in an infinite loop, and logs them to the file a. I have then selected an obfu from them that looks nice, and did some postprocessing on it. This is how I've got the above obfu.

The code is not really maintainable, as it was supposed to be run only once. Also, this is not the original code, I did some fine-tuning and a bugfix since when I've posted the original thread.

Anyway, here are some spoilers about how it works.

BEWARE! SPOILERS FOLLOW!

The magic is in the back subroutine. It applies the inverse of a tr transformation to the message. Most of the times, this fails because some character in the message can not be generated. The code looks like this because this subroutine was a one-liner at once, then I found it's difficult to create a japh even with it. This is why I've written the rest of the code, which throws together keywords at randon, calls back on them, and logs the result on success. There are three constraints on the keywords though. The first is of course getprotobyname. The second is that there have to be three keywords with a letter f in each, the last one being for (why?). The third one is to always include join (the only keyword with j). I've added this third constraint so that the j in the long string would often be encoded (it's not in the above example, but it is in the original obfu).

#!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(lengt +h($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", "d +bmclose", "dbmopen", "defined", "delete", "die", "do", "dump", "each", #"endgrent", #"endhostent", "endnetent", "endprotoent", "endpwent", "endser +vent", "eof", "eval", "exec", "exists", "exit", "exp", "fcntl", "file +no", "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", "getservby +name", #"getservbyport", "getservent", "getsockname", "getsockopt", "glob", "gmtime", "goto", "grep", "hex", "import", "index", "int", "io +ctl", "join", "keys", "kill", "last", "lc", "lcfirst", "length", "li +nk", "listen", "local", "localtime", "log", "lstat", "map", "mkdir" +, "msgctl", "msgget", "msgrcv", "msgsnd", "my", "next", "no", "o +ct", "open", "opendir", "ord", "our", "pack", "package", "pipe", "pop", "po +s", "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", "sem +get", "semop", "send", #"setgrent", "sethostent", "setnetent", "setpgrp", #"setpriority", "setprotoent", "setpwent", "setservent", "sets +ockopt", "shift", #"shmctl", "shmget", "shmread", "shmwrite", "shutdown", "sin", "sleep", "socket", "socketpair", "sort", "splice", "split", "s +printf", "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__

Update: retitled.

Update 2006 Jun 27: should you need tons of obfus of this kind very fast, the thread The indisputable speed of tr/// contains hint on how to make this obfu generator faster.


In reply to Re (Obfu generator for): Ode for getprotobyname by ambrus
in thread Ode for getprotobyname by ambrus

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (3)
As of 2024-03-29 01:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found