Beefy Boxes and Bandwidth Generously Provided by pair Networks Frank
P is for Practical
 
PerlMonks  

Re: Pattern matching

by ambrus (Abbot)
on Aug 12, 2005 at 11:01 UTC ( #483243=note: print w/ replies, xml ) Need Help??


in reply to Pattern matching

#!perl use warnings; use strict; use integer; for(my@a=( 0,42,0,0,0,0,0,0,-198,0,0,0,1,-1,-10,-14,64,-64,6,6,6,7,5,5,5,6,32,32, +5,17,32, 2,0,188,5,5,5,8,9,9,9,5,49,49,49,8,7,7,7,0,8,12,58,58,7,11,58,2,0,189, +1,190, 10,10,10,15,5,5,5,7,5,7,7,7,7,5,7,5,10,12,5,5,88,88,5,10,88,2,0,197,96 +,96,7, 11,96,2,0,191,5,5,106,106,5,7,106,2,0,192,115,115,115,9,7,7,7,0,4,4,4, +7,3,12, 3,3,9,12,6,6,6,8,5,5,5,9,140,140,5,6,140,2,0,194,149,149,149,8,7,7,7,0 +,6,6,6, 7,5,5,5,17,164,164,5,6,164,2,0,195,4,4,4,14,3,12,3,3,1,193,4,4,4,7,3,1 +2,3,3,8, 12,1,196,-28,42,62,56,66,134,34,-10,46,24, unpack"U*",`cat part3.txt`.v0); $a[1];){$a[2]=-(($a[$a[$a[1]++]]-=$a[$a[$a[1]++]])<0);$a[3]&&print chr +$a[4]}

Update: This would have been better written as

#!perl use warnings; use strict; use integer; for(my@a=( 0,42,0,0,0,0,0,0,-198,0,0,0,1,-1,-10,-14,64,-64,6,6,6,7,5,5,5,6,32,32, +5,17,32, 2,0,188,5,5,5,8,9,9,9,5,49,49,49,8,7,7,7,0,8,12,58,58,7,11,58,2,0,189, +1,190, 10,10,10,15,5,5,5,7,5,7,7,7,7,5,7,5,10,12,5,5,88,88,5,10,88,2,0,197,96 +,96,7, 11,96,2,0,191,5,5,106,106,5,7,106,2,0,192,115,115,115,9,7,7,7,0,4,4,4, +7,3,12, 3,3,9,12,6,6,6,8,5,5,5,9,140,140,5,6,140,2,0,194,149,149,149,8,7,7,7,0 +,6,6,6, 7,5,5,5,17,164,164,5,6,164,2,0,195,4,4,4,14,3,12,3,3,1,193,4,4,4,7,3,1 +2,3,3,8, 12,1,196,-28,42,62,56,66,134,34,-10,46,24, unpack"U*",`cat part3.txt`.v0); $a[1];$a[3]&&print chr$a[4]){$a[2]=-(($a[$a[$a[1]++]]-=$a[$a[$a[1]++]] +)<0)}


Comment on Re: Pattern matching
Select or Download Code
Re^2: Pattern matching
by ambrus (Abbot) on Mar 28, 2007 at 21:09 UTC

    Here's the code I used to generate this obfu.

    First, I've written the algorithm in perl:

    #!perl use warnings; use strict; my @a = unpack "U*", `cat part3.txt` . pack "x"; my($b, $k, $c, $s); use integer; $k = 0; goto F; J: #print "[J]"; 64 < $c and goto W; $b = $k; F: #print "[F"; $c = $a[$k]; #print chr($c) . "]"; $k += 1; 0 < $c and goto J; #print "[0]\n"; exit; W: #print "[W]"; $s = 14; S: $c *= 4; $s -= 1; 0 < $s and goto S; 0 < $c and goto F; $c < 0 and goto F; P: #print "[P]"; $c = $a[$b]; print chr($c); $b += 1; $b < $k and goto P; T: #print "[T]"; $c = $a[$k]; 64 < $c and goto C; print chr(10); goto F; C: #print "[C]"; print chr($c); $k += 1; goto T; __END__

    Then I transcoded that to an assembly language for the virtual machine the obfu interprets. This code, when ran with ruby, will assemble the obfu and write it to the file named "pie".

    #!/home/ambrus/local/devel/bin/ruby -w src = %{ ? ip: F lt: ? !_ print: ? buf: ? t: ? u: ? _c: ? _k: -Input _b: ? s: ? $0: 0 $1: 1 $_1: -1 $_10: -10 $_14: -14 $64: 64 $_64: -64 J: !buf buf buf $_lbrace print $1 print print buf buf buf $_karJ pr +int $1 print print buf buf buf $_rbrace print $1 print print u u u _c t t t u 1> 1> t $_64 1> lt 1: ? W1$W W1: t t t _k _b _b _b t F: !buf buf buf $_lbrace print $1 print print buf buf buf $_karF pr +int $1 print print 1> 1> 1> _k _c _c _c 1: ? !buf buf buf _c print $1 print print buf buf buf $_rbrace print +$1 print print _k $1 1> 1> _c $0 1> lt 1: ? J1$J J1: !buf buf buf $_lbrace print $1 print print buf buf buf $_kar0 pr +int $1 print print buf buf buf $_rbrace print $1 print print bu +f buf buf $_10 print $1 print print ip Ex1$0 Ex1: W: !buf buf buf $_lbrace print $1 print print buf buf buf $_karW pr +int $1 print print buf buf buf $_rbrace print $1 print print s s s $_14 S: t t t _c t _c _c _c _c t _c t s $1 t t 1> 1> t s 1> lt 1: ? S1$S S1: 1> 1> _c $0 1> lt 1: ? F1$F F1: t t 1> 1> t _c 1> lt 1: ? F2$F F2: P: !buf buf buf $_lbrace print $1 print print buf buf buf $_karP pr +int $1 print print buf buf buf $_rbrace print $1 print print 1> 1> 1> _b _c _c _c 1: ? buf buf buf _c print $1 print print _b $1 u u u _k t t t _b 1> 1> t u 1> lt 1: ? P1$P P1: T: !buf buf buf $_lbrace print $1 print print buf buf buf $_karT pr +int $1 print print buf buf buf $_rbrace print $1 print print 1> 1> 1> _k _c _c _c 1: ? u u u _c t t t $_64 1> 1> t u 1> lt 1: ? C1$C C1: buf buf buf $_10 print $1 print print ip F3$F F3: C: !buf buf buf $_lbrace print $1 print print buf buf buf $_karC pr +int $1 print print buf buf buf $_rbrace print $1 print print buf buf buf _c print $1 print print _k $1 ip T1$T T1: W1$W: W1-W J1$J: J1-J Ex1$0: Ex1-0 F1$F: F1-F F2$F: F2-F F3$F: F3-F P1$P: P1-P C1$C: C1-C T1$T: T1-T S1$S: S1-S !$_lbrace: -'[' $_rbrace: -']' !$_karJ: -'J' $_karF: -'F' $_karW: -'W' !$_karP: -'P' $_karT: -'T' $_karC: -'C' $_kar0: -'0' Input: }; def val e, sgn, adr = @code.size; case e; when /^(-?\d+)$/; $1.to_i; when /^'(.)'$/; $1[0]; when /^\?$/; 0; when /^([\w@%$.]+)<$/; @labels[$1] or fail "back reference not found: #{$1}"; when /^([\w@%$.]+)>$/; (@forward[$1] ||= []).push [adr, sgn]; 0; when /^([\w@%$.]+)$/; @labels[$1] or ( (@forward[$1] ||= []).push [adr, sgn]; 0; ); else fail %Q'expr error: "#{e}"'; end; end; @code = []; @labels = Hash[]; @forward = Hash[]; @literal = Hash[]; src.gsub!(/[#!].*/) {""}; src.scan(/(\S+)/) { tok = $1; if tok =~ /^([\w@%$.]+):$/; @labels[$1] = @code.size; (f = @forward[$1]) and f.each {|fr| (a, sgn) = fr; @code[a] = sgn * @code.size; }; @forward.delete($1); else r = 0; tok.scan(/\G(?:(?:(-)|\+|)([^+\-]+)|(.))/) { $3 and fail "toke error 2"; sgn = (if $1; -1 else 1 end); r += sgn * val($2, sgn); }; @code.push r; end; }; @forward.empty? or fail "forward reference not found: #{@forward.keys[0]}"; fh = File.open("pie", "w"); fh.print(%{#!perl use warnings; use strict; use integer; for(my@a=( }); @code.each {|n| Integer === n or fail "internal error: invalid code"; fh.print n, "," }; fh.print(%{ unpack"U*",`cat part3.txt`.v0); $a[1];$a[3]&&print chr$a[4]){$a[2]=-(($a[$a[$a[1]++]]-=$a[$a[$a[1]++]] +)<0)} }); fh.close; warn "" + @code.size.to_s + " words"; __END__

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (8)
As of 2014-04-18 08:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (464 votes), past polls