namespace eval o {
proc -) {k s} {
foreach c [split $s ""] {
scan $c %c c
incr c $k
append buf [format %c $c]
}
return $buf
}
proc obfuscate {s} {
set k [expr {int(rand()*255+1)}]
return "package require obf;o::-) -$k [list [-) $k $s]]"
}
}
package provide obf 1.0If you want to run this, save it in a file called "obf" along with pkgIndex.tcl:package ifneeded obf 1.0 [list source [file join $dir obf]]Put both files in a directory called "obf1.0" and make sure it is somewhere in your $tcl_pkgPath.Use the o::obfuscate proc to obfuscate. The resulting string can be eval'd to get the unobfuscated form.
% set x [o::obfuscate "hello world"] % eval $xFor more amusement, see Braintwisters and Quines.
Adapting the above code to be more obscure...
namespace eval o {
proc -) {k s {f {}}} {
binary s $s c* s; foreach {{
#}} $s {lappend f [incr {
#} $k] ;^P}
binary f c* $f
}
proc ^P {} {upvar k x;set x [expr {($x>0?1:-1)*(abs($x)%255+1)}]}
proc obfuscate {s} {
set k [expr {int(rand()*255+1)}]
format "package r obf;o::-) -$k %s" [list [-) $k $s]]
}
}
package pro obf 1.0Suggestions for making things even worse: try introducing a [map] operation in there so as to get rid of the blindingly obvious [foreach] and [lappend] operations. An obscurer obscurer must be our ultimate goal... DKF( I changed "package p" to "package pro" as "p" is ambiguous in tcl8.3. Perhaps the use of short form arguments is dangerous practice for forward compatibility? -JCE)KBK (7 November 2000) All right, Donal, here's a version of the 'obf' script with [string map]. Note that the leading spaces were not just added for the formatter: they're significant. Cut and paste it exactly verbatim! namespace eval o [string map {{ } { } ! et {"} nc # \]\} {$} { #}
% { c} & { $} ' ex ( fo ) \}\ * -1 + {;s} , { f} - \{u . {h } / (a
0 oc 1 { k} 2 {($} 3 ac 4 { -} 5 P\} 6 \{\{ 7 {{}} 8 { p} 9 {) }
: 55 {;} { s} < { x} = {* } > )* ? ar @ \ \{ A bi B {c } C {[i}
D \{\n E ^P F pp G k\] H x) I \}\} J pr K {r } L {
} M {d } N bs O c* P pv Q re R {$f} S {s } T la U )\} V 0? W \}\n
X {;^} Y ro Z 1: {[} {; } \\ +1 \] x> ^ {f } _ {$s} ` #\} a {
} b { [} c ry d en e \{k f %2 g na {
} {}} {a J049e;@^7I@a Agc;&SO;[(Q3.6a `) _@TFdM^C"KD $
) &G X5a Agc,%=Ra W 8YBE@)-P?1<+!<b'J@2]VZ*>/N2Hf:\U#L}]
namespace eval o [string map {{ } { } ! %s {"} \}\] # { "} {$} { $}
% fo & s\} ' 5+ ( ob ) oc * {]
} + { o} , us - ag . pa / {f;} 0 {) } 1 nt 2 {" } 3 an 4 bf 5 {[e}
6 (r 7 \ \{ 8 )* 9 ca : \ \} {;} at < {[l} = {[-} > o: ? pr @ {r }
A 1) B {k } C {
} D is E ck F s\] G xp H d( I {e } J rm K {$k} L se M {t } N 25
O :- P te Q {-$} R {
} S \{i {
} {}} {R ?)+4,9P7&7R LMB5G@S163H8N'A"R %J;#.E-I@(/>O0QB!2<DM
=0K$F* :C}]
eval [string map {{ } { } ! { p} {"} ro # { 1} {$} ka % ge & {
} ' bf ( {
} ) ac * .0 + { o} {
} {}} {( !)$%!"+'#*&}]In article <[email protected]>, [Phil Ehrens] writes >You have a secret agenda here, don't you? >It's the obfuscated Tcl contest isn't it!? Damn! Rumbled! foreach ?? [ set ?! 102 ; set !? -280 ; set !! 272 split Perl {} ] { scan [ set ??] %c ??; puts -nonewline [ binary format c [ incr ?? [ incr ?! [ incr !? [ incr !! -90 ]]]]]}Donal Fellows (this posting brought here by RS)Or even...
foreach ?? [set ?! 102; set !?\
-280; set !!\
272; split Perl\
{}] {scan [set\
??] %c ??;
puts -nonewline [binary format\
c [incr ?? [incr ?! [incr !? [incr !! -90]]]]]}LES Wow. This is really impressive indeed. Except that I can't seem to run much more than one-liners. Bigger scripts fail - and debugging them is impossible.DKF Debugging?! This stuff is art! It doesn't need to be associated with stuff as mundane as mere bugs! That it reboots your cat and puts the development machine out for the night is an amusing feature!
DKF - A short word on the basic principle behind the previous piece of code.It works by computing valuations of a polynomial by the method of differences. These values are then added to the numeric value of each character in a string to produce a new string. The number of terms you need in the polynomial is proportional to the number of characters you wish to transform. Luckily, I've got some code to calculate these coefficients (using the method of differences.) It is very hard to calculate these by hand...
proc calculateCoefficients {fromString toString} {
if {[string length $fromString] != [string length $toString]} {
return -code error "input strings must be same length"
}
binary scan $fromString c* from
binary scan $toString c* to
puts "fill (nearly all) top line of array"
for {set i 0} {$i<[llength $from]} {incr i} {
set x(0,[expr $i+1]) [expr [lindex $to $i]-[lindex $from $i]]
}
puts "fill top right of array"
for {set j 1} {$j<[llength $from]} {incr j} {
for {set i [llength $from]} {$i>=$j+1} {incr i -1} {
set x($j,$i) [expr $x([expr $j-1],$i)-$x([expr $j-1],[expr $i-1])]
}
}
puts "fill bottom row of array"
incr j -1
set v $x($j,[llength $from])
for {set i 0} {$i<[llength $from]} {incr i} {set x($j,$i) $v}
puts "fill rest of array"
for {incr j -1} {$j>=0} {incr j -1} {
for {set i [llength $from]} {$i>=0} {incr i -1} {
if {[info exist x($j,$i)]} {continue}
set x($j,$i) [expr $x($j,[expr $i+1])-$x([expr $j+1],[expr $i+1])]
}
}
puts "extract coefficients"
set result {}
for {set j 0} {$j<[llength $from]} {incr j} {
lappend result $x($j,0)
}
return $result
}For example, suppose we wish to convert Python to Tcl/Tk (chosen because they are the same length of string; that makes things much easier.) We just feed these in to the above code, and it spits out what the polynomial initialisers are.% calculateCoefficients "Python" "Tcl/Tk" fill (nearly all) top line of array fill top right of array fill bottom row of array fill rest of array extract coefficients 890 -3755 6539 -5803 2605 -472Now we can easily write the Tcl code to perform the transformation.
set a 890
set b -3755
set c 6539
set d -5803
set e 2605
set f -472
binary scan Python c* chars
set result {}
foreach x $chars {
append result [format %c [incr x [incr a [incr b [incr c \
[incr d [incr e $f]]]]]]]
}
puts $resultI leave actually obfuscating this as an exercise to the reader.DKF: A more general mechanism of applying these polynomials to strings is:
proc applyCoefficients {coeffs string} {
set idx [binary scan $string c* vals]
foreach coeff $coeffs {set x([incr idx]) $coeff}
foreach v $vals {
for {set i $idx} {$i>2} {incr i -1} {incr x([expr $i-1]) $x($i)}
lappend result [incr v $x(2)]
}
return [binary format c* $result]
}Example use: set cs [calculateCoefficients "Python" "Tcl/Tk"]
puts [format "p(%s)(\"%s\") = \"%s\"" [join $cs ,] "Python" \
[applyCoefficients $cs "Python"]]Try applying the polynomial {-5334 33545 -91431 139782 -129083 71902 -22352 2990} to the string "VBScript"... :^) eval [string map {+ " " - ;} puts+hello-puts+world] ;# RSDKF in the Tcl chatroom on 2002-12-05:
[set for ever; set $for for] "set $ever$for $for$ever" "$$ever$for ne {now}" "vwait $ever$for" {}See also Super Code for a different way of making the language unnecessarily (or is it really necessarily? ;^)) obscure...
MJ - Was shown on the Tcl-chat by MS
set set set; [$set $set] $set $setOf course because now every set or $set can be replaced by [set set] the following is valid:
[[[[set set] [set set]] [[set set] [set set]]] [[[set set] [set set]] [[set set] [set set]]]]\ [[[[set set] [set set]] [[set set] [set set]]] [[[set set] [set set]] [[set set] [set set]]]]\ [[[[set set] [set set]] [[set set] [set set]]] [[[set set] [set set]] [[set set] [set set]]]]Repeat until noxious.
APW - Was (mostly complete) shown on the Tcl-chat by MJ
interp alias {} || {} set
set | set
set ? 42
puts [[[[|| |] [|| |] [|| |]] [[|| |] [|| |] [|| |]] [[|| |] [|| |] [|| |]]] ?]
% 42Lars H: Why not do away with ||, by doing instead interp alias {} {} {} set
puts [[[[[] |] [[] |] [[] |]] [[[] |] [[] |] [[] |]] [[[] |] [[] |] [[] |]]] ?]? Alternating between [] and {} for the empty string seems useful for confusing people trying to understand an obfuscated Tcl script.MJ - That's evil :-), note that with [set {} set] this can even be written as a lot of nothing:
% set {} set
% set ? 42
% interp alias {} {} {} set
% [[[[] []] [[] []] [[] []]] [[[] []] [[] []] [[] []]] [[[] []] [[] []] [[] []]]] ?
42DKF: This gem by KBK is both clear and very obscure in how it goes about it. tailcall and apply let you do some evil tricks.
proc fib {x} {
tailcall fibcps $x {{x} {return $x}}
}
proc fibcps {x cont} {
if {$x <= 1} {
tailcall apply $cont 1
} else {
tailcall fibcps [expr {$x-1}] \
[list [list y [list x $x] [list cont $cont]] {
tailcall fibcps [expr {$x-2}] \
[list [list z [list y $y] [list cont $cont]] {
tailcall apply $cont [expr {$y+$z}]
}]
}]
}
}
for {set i 0} {$i < 10} {incr i} {
puts [fib $i]
}RLE (2014-02-03): Correct me here if I'm wrong, but this above looks like Tcl written in Continuation Passing Style (http://en.wikipedia.org/wiki/Continuation-passing_style
).For functional obfuscation, see mktclapp, tbcload, procomp, source protection, ...See also playing with obfuscation, commenting and obfuscating, Code Golf Saving Time
