Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on Apr 28th, 2012  |  syntax: None  |  size: 3.25 KB  |  hits: 17  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. deobfuscating Perl code
  2. #!/usr/bin/perl
  3. (my$d=q[AA                GTCAGTTCCT
  4.   CGCTATGTA                 ACACACACCA
  5.     TTTGTGAGT                ATGTAACATA
  6.       CTCGCTGGC              TATGTCAGAC
  7.         AGATTGATC          GATCGATAGA
  8.           ATGATAGATC     GAACGAGTGA
  9.             TAGATAGAGT GATAGATAGA
  10.               GAGAGA GATAGAACGA
  11.                 TC GATAGAGAGA
  12.                  TAGATAGACA G
  13.                ATCGAGAGAC AGATA
  14.              GAACGACAGA TAGATAGAT
  15.            TGAGTGATAG    ACTGAGAGAT
  16.          AGATAGATTG        ATAGATAGAT
  17.        AGATAGATAG           ACTGATAGAT
  18.      AGAGTGATAG             ATAGAATGAG
  19.    AGATAGACAG               ACAGACAGAT
  20.   AGATAGACAG               AGAGACAGAT
  21.   TGATAGATAG             ATAGATAGAT
  22.   TGATAGATAG           AATGATAGAT
  23.    AGATTGAGTG        ACAGATCGAT
  24.      AGAACCTTTCT   CAGTAACAGT
  25.        CTTTCTCGC TGGCTTGCTT
  26.          TCTAA CAACCTTACT
  27.            G ACTGCCTTTC
  28.            TGAGATAGAT CGA
  29.          TAGATAGATA GACAGAC
  30.        AGATAGATAG  ATAGAATGAC
  31.      AGACAGAGAG      ACAGAATGAT
  32.    CGAGAGACAG          ATAGATAGAT
  33.   AGAATGATAG             ACAGATAGAC
  34.   AGATAGATAG               ACAGACAGAT
  35.   AGACAGACTG                 ATAGATAGAT
  36.    AGATAGATAG                 AATGACAGAT
  37.      CGATTGAATG               ACAGATAGAT
  38.        CGACAGATAG             ATAGACAGAT
  39.          AGAGTGATAG          ATTGATCGAC
  40.            TGATTGATAG      ACTGATTGAT
  41.              AGACAGATAG  AGTGACAGAT
  42.                CGACAGA TAGATAGATA
  43.                  GATA GATAGATAG
  44.                     ATAGACAGA G
  45.                   AGATAGATAG ACA
  46.                 GTCGCAAGTTC GCTCACA
  47. ])=~s/s+//g;%a=map{chr $_=>$i++}65,84,67,
  48. 71;$p=join$;,keys%a;while($d=~/([$p]{4})/g
  49. ){next if$j++%96>=16;$c=0;for$d(0..3){$c+=
  50. $a{substr($1,$d,1)}*(4**$d)}$perl.=chr $c}
  51.              eval $perl;
  52.        
  53. ( my $d =
  54. "AA...GCTCACAn" # snipped double helix part
  55. ) =~ s/s+//g;
  56. (%a) = map( { chr $_, $i++; } 65, 84, 67, 71 );
  57. $p = join( $;, keys %a );
  58. while ( $d =~ /([$p]{4})/g ) {
  59.     next if $j++ % 96 >= 16;
  60.     $c = 0;
  61.     foreach $d ( 0 .. 3 ) {
  62.         $c += $a{ substr $1, $d, 1 } * 4**$d;
  63.     }
  64.     $perl .= chr $c;
  65. }
  66.        
  67. ( my $d =
  68. "AA...GCTCACAn" # snipped double helix part
  69. ) =~ s/s+//g;
  70.        
  71. (%a) = map( { chr $_, $i++; } 65, 84, 67, 71 );
  72.        
  73. $p = join( $;, keys %a );
  74.        
  75. my @ascii = unpack("C*", $p);
  76. print @ascii[1];
  77.        
  78. while ( $d =~ /([$p]{4})/g ) {
  79.        
  80. next if $j++ % 96 >= 16;
  81.        
  82. $c = 0;
  83. foreach $d ( 0 .. 3 ) {
  84.     $c += $a{ substr $1, $d, 1 } * 4**$d;
  85. }
  86.        
  87. while ( $d =~ /([ATCG]{4})/g ) { ... }
  88.        
  89. foreach $d ( 0 .. 3 ) {
  90.     $c += $a{ substr $1, $d, 1 } * 4**$d;
  91. }
  92.        
  93. A   00
  94. T   01
  95. C   10
  96. G   11
  97.        
  98. A A A A
  99. AAAA -> 00000000
  100.  
  101.          T A A T
  102. TAAT -> 01000001 -> capital A in ascii
  103.  
  104.          T A A C
  105. CAAT -> 01000010 -> capital B in ascii
  106.  
  107. CAATTCCTGGCTGTATTTCTTTCTGCCT -> BioGeek
  108.        
  109. next if $j++ % 96 >= 16;
  110.        
  111. use strict;
  112. use warnings;
  113. my $in = shift;
  114.  
  115. my %conv = ( 0 => 'A', 1 => 'T', 2 => 'C', 3 => 'G');
  116.  
  117. for (my $i=0; $i<length($in); $i++) {
  118.     my $chr = substr($in, $i, 1);
  119.     my $chv = ord($chr);
  120.     my $encoded ="";
  121.     $encoded .= $conv{($chv >> 0) & 0x3};
  122.     $encoded .= $conv{($chv >> 2) & 0x3};
  123.     $encoded .= $conv{($chv >> 4) & 0x3};
  124.     $encoded .= $conv{($chv >> 6) & 0x3};
  125.     print $encoded;
  126. }
  127. print "n";
  128.        
  129. $ perl q.pl 'print "BioGeekn";'
  130. AAGTCAGTTCCTCGCTATGTAACACACACAATTCCTGGCTGTATTTCTTTCTGCCTAGTTCGCTCACAGCGA