#!/usr/bin/perl -w

use strict;
use constant VARIANT1 => "marika";
use constant VARIANT2 => "chitoge";

# Load quoted script contents from specially formatted files
sub LoadInput($)
{
   my ($filename) = @_;

   open my $file, "<$filename" or die "Can not open $filename: $!\n";
   my $text = join '', <$file>;
   close $file;

   $text =~ m{^\S+\/perl -w\s+\$c = '(.*)';\s+'code' =~.*}s or die $!;
   return " = '$1';\n";
}

# Encrypt/decrypt text
sub Encode($$)
{
   my ($plaintext, $key) = @_;

   my @offset;
   if( $key eq uc $key )
   {
      @offset = map {$_ - ord('A')} unpack 'C*', $key;
   }
   elsif( $key eq lc $key )
   {
      @offset = map {(26 - ($_ - ord('a'))) % 26} unpack 'C*', $key;
   }
   else
   {
      die "Nonuniform case for key $key\n";
   }

   my $ciphertext = "";
   my $index = 0;
   foreach my $i (unpack 'C*', $plaintext)
   {
      my $c = chr($i);
      if( $c =~ /[a-z]/ )
      {
         $c = chr(($i - ord('a') + 26 - $offset[$index++]) % 26 + ord('a'));
      }
      elsif( $c =~ /[A-Z]/ )
      {
         $c = chr(($i - ord('A') + 26 - $offset[$index++]) % 26 + ord('A'));
      }
      $ciphertext .= $c;
      $index %= scalar @offset;
   }
   return $ciphertext;
}

# Assemble parts
sub Assemble($$$$$$$$$)
{
   my ($code0, $code1, $code2, $var0, $var1, $var2, $key0, $key1, $key2) = @_;

   my $offset1 = length('$X' . $code0);
   my $offset2 = $offset1 + length('$X' . $code1);
   my $offset3 = $offset2 + length('$X' . $code2);

   # 'X' =~ /X(?{eval$x})|X(?{eval$x})|X(?{eval$x})/;
   my $offset4 = $offset3 + length('"X" =~ ');
   my $offset5 = $offset4 + length('/X(?{eval$X})');
   my $offset6 = $offset5 + length('|X(?{eval$X})');

   my $version0 =
      '$' . $var0 . $code0 .
      '$' . $var1 . $code1 .
      '$' . $var2 . $code2 .
      "'$key0' =~ " .
      "/$key2(?{eval\$$var2})" .
      "|$key1(?{eval\$$var1})" .
      "|$key0(?{eval\$$var0})/;\n";
   my $version1 = Encode($version0, uc VARIANT1);
   my $version2 = Encode($version0, uc VARIANT2);

   return 
      # Code
      substr($version0, 0, $offset1) .
      substr($version1, $offset1, $offset2 - $offset1) .
      substr($version2, $offset2, $offset3 - $offset2) .
      # Selector
      substr($version0, $offset3, $offset4 - $offset3) .
      # Branches
      substr($version2, $offset4, $offset5 - $offset4) .
      substr($version1, $offset5, $offset6 - $offset5) .
      substr($version0, $offset6);
}

# Find variable combination that would make code segments accessible
sub FindCombination($$$)
{
   my ($code0, $code1, $code2) = @_;

   my $offset1 = length('$X' . $code0);
   my $offset2 = $offset1 + length('$X' . $code1);

   my $offset3 = $offset2 + length('$X' . $code2 . '"');
   my $offset4 = $offset3 + length('X" =~ /');
   my $offset5 = $offset4 + length('X(?{eval$X})|');
   my $offset6 = $offset5 + length('X(?{eval$X})|');

   # Choose code variables for each segment.  These are variables that
   # all decrypt to different values when different keys are used.
   my $assembled = undef;
   my ($t0, $t1, $t2);
   foreach my $var0 ('a' .. 'z')
   {
      foreach my $var1 ('a' .. 'z')
      {
         next if $var0 eq $var1;
         foreach my $var2 ('a' .. 'z')
         {
            next if $var0 eq $var2;

            # Assemble segments
            $t0 = Assemble($code0, $code1, $code2,
                           $var0, $var1, $var2,
                           'a', 'a', 'a');

            # Verify that code segments are not overwritten.
            #
            # The var{0,1,2} equality checks already accounted for $code0.
            #
            # $code2 is encoded in the last variable, so it's
            # guaranteed not to be overwritten.
            #
            # We only need to account for $code1.
            $t1 = Encode($t0, VARIANT1);
            if( substr($t1, $offset1 + 1, 1) eq substr($t1, $offset2 + 1, 1) )
            {
               next;
            }

            # Find key combinations that would make code segments accessible.
            $t2 = Encode($t0, VARIANT2);
            substr($t0, $offset3, 1) eq 'a' or die "Bad offset3\n";
            substr($t2, $offset4, 1) eq 'a' or die "Bad offset4\n";
            substr($t1, $offset5, 1) eq 'a' or die "Bad offset5\n";
            substr($t0, $offset6, 1) eq 'a' or die "Bad offset6\n";

            print STDERR "vars = $var0, $var1, $var2\n";
            foreach my $key0 ('a' .. 'z')
            {
               print STDERR "key0 = $key0\n";
               foreach my $key1 ('a' .. 'z')
               {
                  foreach my $key2 ('a' .. 'z')
                  {
                     $t0 = Assemble($code0, $code1, $code2,
                                    $var0, $var1, $var2,
                                    $key0, $key1, $key2);
                     if( substr($t0, $offset6, 1) eq substr($t0, $offset4, 1) ||
                         substr($t0, $offset6, 1) eq substr($t0, $offset5, 1) )
                     {
                        next;
                     }

                     $t1 = Encode($t0, VARIANT1);
                     if( substr($t1, $offset5, 1) eq substr($t1, $offset4, 1) ||
                         substr($t1, $offset5, 1) ne substr($t1, $offset3, 1) )
                     {
                        next;
                     }

                     $t2 = Encode($t0, VARIANT2);
                     if( substr($t2, $offset4, 1) ne substr($t2, $offset3, 1) )
                     {
                        next;
                     }

                     return $t0;
                  }
               }
            }
         }
      }
   }
   die "No variable combination found\n";
}

my $assembled = FindCombination(
   LoadInput("encode14.pl"),
   LoadInput("strip3.pl"),
   LoadInput("crack23.pl"));
print $assembled;