VolgaCTF 2015 gostfuscator

@mrexcessive WHA

The problem

Try to solve a riddle...

The solution

OK so we have a perl script (res.pl), a perl module (G.pm)
also a binary file res.bin and a key file

Not sure if res.bin == res.pl, probably not

$ perl res.pl
Array found where operator expected at (eval 1) line 1, at end of line

OK... so... hmmm

Added print $ev;
before eval $ev;
This displays a binary mess.

Backed up res.pl and G.pm original versions

Haven't done much perl recently... sigh...
So re-learning some of this.

Went through both res.pl and G.pm and made a pretty-printed version to look at.

(see end of post for the pretty and commented code)

Note that, the code behaves differently if you edit res.pl, even adding a char.

There's a function yep() which returns a key, which is then used to split up res.bin

This might be a crlf sequence (0d0a) ?
Has a similar pattern of occurrence as crlf might have in a source file
yep() seems to return 0xdb4b when run with original res.pl
Messing with G.pm doesn't change this value, but res.pl does...

So... trace gets added to G.pm and res.pl is left alone

Added this trace... (send end of this post for whole of the G.pm code)

sub pon()
{
   $ols="res.bin";
   $nji=-s "$ols";                  # get length / size of res.bin
   open($wht,$ols);
   sysread $wht,$ker,$nji;          # read contents of res.bin (binary) to $ker
   close $wht;
   open($uwd,$0) || die "dead";
   my $vvr="";
   while ($rre = <$uwd>)
   {
      $vvr.=$rre;
   }
   close $uwd;                      
   print "VVR" .$vvr . "\n";                      # now we have res.pl contents in $vvr 
   my $gqe = yep($vvr,1);
   print "GQE" .length($gqe)." ".unpack ("H*",$gqe)  . "\n";     # $gqe has length two and binary a72d
   @yak=split($gqe,$ker);           # split the binary using db4b - which is not found ?
   print "\@YAK len=" .length(@yak)  . "\n";    # @YAK = 1
   open($owb, 'key');               # open 'key'
   while ($oot = <$owb>)            # read a line from file 'key'
   {
      push @sou,$oot;
   }                                # @sou
   close($owb);
   print "\@SOU len=" .length(@sou) . "\n";     # length 2
   print "\@SOU = [";
   print join('',@sou);
   print "]";
#   print "\@SOU[0] len=" .length(@sou[0])."\n";
}

And in sub g()

sub g()
{
   my $qmp=$_[1];
   #print "g()A \$QMP=[" . "aaaaaaaaa$qmp aaaaaaaaaa" . "]\n";
   %H = ('0' => ['c','6','b','c','7','5','8','1'],
         '1' => ['4','8','3','8','f','d','e','7'],
         '2' => ['6','2','5','2','5','f','2','e'],
         '3' => ['2','3','8','1','a','6','5','d'],
         '4' => ['a','9','2','d','8','9','6','0'],
         '5' => ['5','a','f','4','1','2','9','5'],
         '6' => ['b','5','a','f','6','c','1','8'],
         '7' => ['9','c','d','6','d','a','c','3'],
         '8' => ['e','1','e','7','0','b','f','4'],
         '9' => ['8','e','1','0','9','7','4','f'],
         'a' => ['d','4','7','a','3','8','b','a'],
         'b' => ['7','7','4','5','e','1','0','6'],
         'c' => ['0','b','c','3','b','4','d','9'],
         'd' => ['3','d','9','e','4','3','a','c'],
         'e' => ['f','0','6','9','2','e','3','b'],
         'f' => ['1','f','0','b','c','0','7','2']);
   #print "g()B \$yak[\$qmp]=[".$yak[$qmp]."]  \$sou[\$qmp]=[".$sou[$qmp]."]\n";
   my $orc=kdy($yak[$qmp],$sou[$qmp],"alx");
#   print "\g()returning \$orc=[" + "\$orc" + "]\n";
   print "g()C=cccccc$orc cccccccc\n";
   return $orc;
}

The g() trace is interesting
g() gets called 12 times... with values 0... 11

9Password:g()A $QMP=[10]
10g()A $QMP=[11]
110123456789ab
g()A $QMP=[12]
12g()A $QMP=[54]
54$CCM=[use G;G->pon();$ev=G->g(-1);eval $ev;for($e=0;$e<=$#a;$e++){$ev=G->g($a[$e]);eval $ev;}]
$CDM=[011101010111001101100101001000000100011100111011010001110010110100111110011100000110111101101110001010000010100100111011001001000110010101110110001111010100011100101101001111100110011100101000001011010011000100101001001110110110010101110110011000010110110000100000001001000110010101110110001110110110011001101111011100100010100000100100011001010011110100110000001110110010010001100101001111000011110100100100001000110110000100111011001001000110010100101011001010110010100101111011001001000110010101110110001111010100011100101101001111100110011100101000001001000110000101011011001001000110010101011101001010010011101101100101011101100110000101101100001000000010010001100101011101100011101101111101]
length @ZAZ = 3
@ZAZ=[696]
g()A $QMP=[53]
53$CCM=[use G;G->pon();$ev=G->g(-1);eval $ev;for($e=0;$e<=$#a;$e++){$ev=G->g($a[$e]);eval $ev;}]
$CDM=[011101010111001101100101001000000100011100111011010001110010110100111110011100000110111101101110001010000010100100111011001001000110010101110110001111010100011100101101001111100110011100101000001011010011000100101001001110110110010101110110011000010110110000100000001001000110010101110110001110110110011001101111011100100010100000100100011001010011110100110000001110110010010001100101001111000011110100100100001000110110000100111011001001000110010100101011001010110010100101111011001001000110010101110110001111010100011100101101001111100110011100101000001001000110000101011011001001000110010101011101001010010011101101100101011101100110000101101100001000000010010001100101011101100011101101111101]
length @ZAZ = 3
@ZAZ=[696]
g()A $QMP=[51]
51$CCM=[use G;G->pon();$ev=G->g(-1);eval $ev;for($e=0;$e<=$#a;$e++){$ev=G->g($a[$e]);eval $ev;}]
$CDM=[011101010111001101100101001000000100011100111011010001110010110100111110011100000110111101101110001010000010100100111011001001000110010101110110001111010100011100101101001111100110011100101000001011010011000100101001001110110110010101110110011000010110110000100000001001000110010101110110001110110110011001101111011100100010100000100100011001010011110100110000001110110010010001100101001111000011110100100100001000110110000100111011001001000110010100101011001010110010100101111011001001000110010101110110001111010100011100101101001111100110011100101000001001000110000101011011001001000110010101011101001010010011101101100101011101100110000101101100001000000010010001100101011101100011101101111101]
length @ZAZ = 3
@ZAZ=[696]
g()A $QMP=[52]
52

It looks like it will get called 12 times... but... stops after 4 calls.

WHY ??

It might be looking for input of

>>> print chr(54), chr(53), chr(51), chr(52)
"6 5 3 4"
>>> # yes I was using Python to take apart Perl...

So...
Put that in... "653465346534"

?? It is calling yep repeatedly... 
g()A $QMP=[aaaaaaaaa0 aaaaaaaaaa]
g()C=ccccccuse Win32::MediaPlayer;# cccccccc
g()A $QMP=[aaaaaaaaa1 aaaaaaaaaa]
g()C=ccccccuse locale;##### cccccccc
g()A $QMP=[aaaaaaaaa2 aaaaaaaaaa]
g()C=cccccc$winmm = 'Win32::MediaPlayer'->new;##### cccccccc
g()A $QMP=[aaaaaaaaa3 aaaaaaaaaa]
g()C=cccccc$winmm->load('https://translate.google.ru/translate_tts?ie=UTF-8&q=enter%20password%20to%20get%20a%20puzzle&tl=en&total=1&idx=0&textlen=30&client=t&prev=input');####### cccccccc
g()A $QMP=[aaaaaaaaa4 aaaaaaaaaa]
g()C=cccccc$winmm->play;### cccccccc
g()A $QMP=[aaaaaaaaa5 aaaaaaaaaa]
g()C=cccccc$winmm->volume(100);#### cccccccc
g()A $QMP=[aaaaaaaaa6 aaaaaaaaaa]
g()C=cccccc$total_length = $winmm->length(1), $/;## cccccccc
g()A $QMP=[aaaaaaaaa7 aaaaaaaaaa]
g()C=cccccc$total_length =~ s/\d\d:\d//l;## cccccccc
g()A $QMP=[aaaaaaaaa8 aaaaaaaaaa]
g()C=cccccc@b = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z'); cccccccc
g()A $QMP=[aaaaaaaaa9 aaaaaaaaaa]
g()C=ccccccprint 'Password:';###### cccccccc
Password:g()A $QMP=[aaaaaaaaa10 aaaaaaaaaa]
g()C=ccccccsleep $total_length + 1; cccccccc
g()A $QMP=[aaaaaaaaa11 aaaaaaaaaa]
g()C=cccccc$c = ;### cccccccc

Haha... It is sending us to a sound file generated by Google Translate.ru
https://translate.google.ru/translate_tts?ie=UTF-8&q=enter%20password%20to%20get%20a%20puzzle&tl=en&total=1&idx=0&textlen=30&client=t&prev=input
Interesting...

Listen to that... just says look for password.

So...
Now we get a bunch more trace in this vein...
Oh what the actual !!!

g()C=ccccccchomp $c;####### cccccccc
g()C=ccccccif (length $c > 7) {$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56192-$ds+$r0o);eval $ev;} cccccccc
$CCM=[use G;G->pon();$ev=G->g(-1);eval $ev;for($e=0;$e<=$#a;$e++){$ev=G->g($a[$e]);eval $ev;}]
$CDM=[011101010111001101100101001000000100011100111011010001110010110100111110011100000110111101101110001010000010100100111011001001000110010101110110001111010100011100101101001111100110011100101000001011010011000100101001001110110110010101110110011000010110110000100000001001000110010101110110001110110110011001101111011100100010100000100100011001010011110100110000001110110010010001100101001111000011110100100100001000110110000100111011001001000110010100101011001010110010100101111011001001000110010101110110001111010100011100101101001111100110011100101000001001000110000101011011001001000110010101011101001010010011101101100101011101100110000101101100001000000010010001100101011101100011101101111101]
length @ZAZ = 3
@ZAZ=[696]
g()C=ccccccdo {$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56190-$ds+$r0o);eval $ev;$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56191-$ds+$r0o);eval $ev;};#### cccccccc
$CCM=[use G;G->pon();$ev=G->g(-1);eval $ev;for($e=0;$e<=$#a;$e++){$ev=G->g($a[$e]);eval $ev;}]
$CDM=[011101010111001101100101001000000100011100111011010001110010110100111110011100000110111101101110001010000010100100111011001001000110010101110110001111010100011100101101001111100110011100101000001011010011000100101001001110110110010101110110011000010110110000100000001001000110010101110110001110110110011001101111011100100010100000100100011001010011110100110000001110110010010001100101001111000011110100100100001000110110000100111011001001000110010100101011001010110010100101111011001001000110010101110110001111010100011100101101001111100110011100101000001001000110000101011011001001000110010101011101001010010011101101100101011101100110000101101100001000000010010001100101011101100011101101111101]
length @ZAZ = 3
@ZAZ=[696]
g()C=ccccccif ($c eq 'Simpl3P@$$w0rd') {$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56152-$ds+$r0o);eval $ev;$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56153-$ds+$r0o);eval $ev;$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56154-$ds+$r0o);eval $ev;$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56155-$ds+$r0o);eval $ev;$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56156-$ds+$r0o);eval $ev;$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = 

From which we extract these two passwords:
Simpl3P@$$w0rd C0mpl3xP@$$w0rd

Feed in them and get

$str eq 'WTURLWNDOFMRYWC' or $str eq 'RLWNDOFMRYWC' or $str eq 'LWNDOFMRYWC' or $str eq 'WTWURLWNDOFMRYWC') {$flag = $b[19] . $b[7] . $b[4] . $b[18] . $b[7] . $b[14] . $b[22] . $b[12] . $b[20] . $b[18] . $b[19] . $b[6] . $b[14] . $b[14] . $b[13];$flag =~ s/s/\$/gl;$flag =~ s/o/0/gl;print STDOUT $flag;sleep 1;$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56186-$ds+$r0o);eval $ev;}## cccccccc

Looks like this might be getting close to flag-land...

Put in the first str "WTURLWNDOFMRYWC"
and get

g()C=ccccccif ($str eq 'WTURLWNDOFMRYWC' or $str eq 'RLWNDOFMRYWC' or $str eq 'LWNDOFMRYWC' or $str eq 'WTWURLWNDOFMRYWC') {$flag = $b[19] . $b[7] . $b[4] . $b[18] . $b[7] . $b[14] . $b[22] . $b[12] . $b[20] . $b[18] . $b[19] . $b[6] . $b[14] . $b[14] . $b[13];$flag =~ s/s/\$/gl;$flag =~ s/o/0/gl;print STDOUT $flag;sleep 1;$dt=time;$dt=$dt-time;$r0o= int(rand(100)) ;$crceval='$ro0=$0;$r0o='.$r0o.';';$ds=G->c($crceval);for ($it=0;$it>$dt;$it--){@G::key = @G::key[1..$#G::key,0];}$ev=G->g($dt+56186-$ds+$r0o);eval $ev;}## cccccccc
the$h0wmu$tg00n$CCM=[use G;G->pon();$ev=G->g(-1);eval $ev;for($e=0;$e<=$#a;$e++){$ev=G->g($a[$e]);eval $ev;}]

Spot the flag !
th$sh0wmu$tg00n

Nice one @VolgaCTF !


And here is the pretty-printed and commented G.pm

package G;
sub pon()
{
   $ols="res.bin";
   $nji=-s "$ols";                  # get length / size of res.bin
   open($wht,$ols);
   sysread $wht,$ker,$nji;          # read contents of res.bin (binary) to $ker
   close $wht;
   open($uwd,$0) || die "dead";
   my $vvr="";
   while ($rre = <$uwd>)
   {
      $vvr.=$rre;
   }
   close $uwd;                      
   print "VVR" .$vvr . "\n";                      # now we have res.pl contents in $vvr 
   my $gqe = yep($vvr,1);
   print "GQE" .length($gqe)." ".unpack ("H*",$gqe)  . "\n";     # $gqe has length two and binary a72d
   @yak=split($gqe,$ker);           # split the binary using db4b - which is not found ?
   print "\@YAK len=" .length(@yak)  . "\n";    # @YAK = 1
   open($owb, 'key');               # open 'key'
   while ($oot = <$owb>)            # read a line from file 'key'
   {
      push @sou,$oot;
   }                                # @sou
   close($owb);
   print "\@SOU len=" .length(@sou) . "\n";     # length 2
   print "\@SOU = [";
   print join('',@sou);
   print "]";
#   print "\@SOU[0] len=" .length(@sou[0])."\n";
}

sub g()
{
   my $qmp=$_[1];
   #print "g()A \$QMP=[" . "aaaaaaaaa$qmp aaaaaaaaaa" . "]\n";
   %H = ('0' => ['c','6','b','c','7','5','8','1'],
         '1' => ['4','8','3','8','f','d','e','7'],
         '2' => ['6','2','5','2','5','f','2','e'],
         '3' => ['2','3','8','1','a','6','5','d'],
         '4' => ['a','9','2','d','8','9','6','0'],
         '5' => ['5','a','f','4','1','2','9','5'],
         '6' => ['b','5','a','f','6','c','1','8'],
         '7' => ['9','c','d','6','d','a','c','3'],
         '8' => ['e','1','e','7','0','b','f','4'],
         '9' => ['8','e','1','0','9','7','4','f'],
         'a' => ['d','4','7','a','3','8','b','a'],
         'b' => ['7','7','4','5','e','1','0','6'],
         'c' => ['0','b','c','3','b','4','d','9'],
         'd' => ['3','d','9','e','4','3','a','c'],
         'e' => ['f','0','6','9','2','e','3','b'],
         'f' => ['1','f','0','b','c','0','7','2']);
   #print "g()B \$yak[\$qmp]=[".$yak[$qmp]."]  \$sou[\$qmp]=[".$sou[$qmp]."]\n";
   my $orc=kdy($yak[$qmp],$sou[$qmp],"alx");
#   print "\g()returning \$orc=[" + "\$orc" + "]\n";
   print "g()C=cccccc$orc cccccccc\n";
   return $orc;
}

sub kdy()
{
   my ($uir,$sou,$ksd) = (shift,shift,shift);
   if ($ksd eq "alx")
   {
      my @tre=kcn($sou);
   } else {
      my @tre=bvd($sou);
   }
   @wnj = unpack("a8"x(length($uir)/8),$uir);
   my $ise="";
   for ($abp=0;$abp<=$#wnj;$abp++)
   {
      $rlr= vec($wnj[$abp],0,32);
      $rIr= vec($wnj[$abp],1,32);
      for ($yza=0;$yza<=31;$yza++)
      {
         $rlL=vec($tre[$yza],0,32);
         $jlr=($rIr+$rlL)%2**32;
         $jIr=jir($jlr);
         $j1r=$jIr >> 21;
         $jJlr=$jIr << 11;
         $liJ=$jJlr+$j1r;
         $rJr=$liJ ^ $rlr;
         $rlr=$rIr;
         $rIr=$rJr;
      }
      $r1r=$rlr;
      $rlr=$rIr;
      $rIr=$r1r;
      $ise.= pack "N2", $rlr, $rIr;
   }
   return $ise;
}

sub bvd
{
   my $qol = $_[0];
   @wcz = $qol=~/.{4}/g;
   @tre=();
   push @tre,@wcz;
   push @tre,@wcz;
   push @tre,@wcz;
   push @tre,reverse @wcz;
   return @tre;
}

sub kcn
{
   my $qol = $_[0];
   @wcz = $qol=~/.{4}/g;
   @tre=();
   push @tre,@wcz;
   push @tre,reverse @wcz;
   push @tre,reverse @wcz;
   push @tre,reverse @wcz;
   return @tre;
}

sub jir
{
   my @ssz = split(//,sprintf("%x", $_[0]));
   my @szs;
   my $zzs=0;
   my $zsz=0;
   for ($zzs=$#ssz;$zzs>=0;$zzs--)
   {
      unshift @szs,$H{$ssz[$zzs]}[$zsz];
      $zsz++;
   }
   return hex join ("", @szs);
}

sub c()
{
   my $r0o=100;
   my $ro0=$0;
   my $xxd = 0;
   $crceval=$_[1];
   eval($crceval);
   open($uwd, $ro0) || die "dead";
   my $vvr="";
   while ($rre = <$uwd>)
   {
      $vvr.=$rre;
   }
   close($uwd);
   my $gqe = yep($vvr,$xxd);
   return $gqe+$r0o;
}

# I think yep and ass just verify the res.pl code, getting the decode code for res.bin in the process
sub yep
{
   my $ccm = shift;           # $ccm is the contents of res.pl
   my $xxd = shift;
   print "\$CCM=[" .$ccm . "]\n";
   my $cdm = unpack('B*', $ccm);    # get a bitstring version of $ccm
   print "\$CDM=[" .$cdm . "]\n";
   my @gaz=('1','0','0','0','0','0','0','0','0','0','0','0','0','1','0','1');
   my @zag=('1','1','1','1','1','1','1','1','1','1','1','1','1','1','1','1');
   my @zaz = split (//, $cdm);            # split into individual bits ?
   print "length \@ZAZ = " . length(@zaz) . "\n";     # this reports 3, but not sure why ?
   print "\@ZAZ=[" . @zaz . "]\n";     #this is bits
   while (scalar(@zaz) > 0)
   {
      my $gag = shift(@zaz);
      next unless($gag eq "0" or $gag eq "1");
      if($gag eq shift(@zag))
      {
         push(@zag, '0');
      } else {
         push(@zag, '0');
         @zag = ass(@zag, @gaz);
      }
   }
   my $gza='';
   foreach my $zga (@zag)
   {
      if ($zga eq "1")
      {
         $gza .= '0';
      } else {
         $gza .= '1';
      }
   }
   my $gga = pack('B*', $gza);
   if($xxd == 1)
   {
      return $gga
   } else {
      my $zza=vec($gga,0,16);
      return $zza;
   }
}

sub ass
{
   my @ssa=@_[0..15];
   my @sas = @_[16..31];
   my @sss;
   for my $j (0..15)
   {
      if (shift(@ssa) eq shift(@sas))
      {
         push(@sss, '0');
      } else {
         push(@sss, '1');
      }
   }
   return(@sss[0..15]);
}

1;

Finally pretty-printed (for reference only, this breaks code if you use it...) res.pl

use G;
G->pon();
$ev=G->g(-1);
#print $ev;
eval $ev;
for($e=0;$e<=$#a;$e++)
{
   $ev=G->g($a[$e]);
   eval $ev
}