Libc6 malloc bites?

[jeremy at itassist.net.au]

On  1 Sep, Tomasz Ciolek wrote:
>  Can you post the proggy or is it too complicated?

Sure can.  Apologies for style, it's a first draft.  Incidentally, I
haven't been able to reduce it to a nice small test case. I also haven't
had time to pull out electric fence and try it out.

Feed the program a large text file (like a book) and a word.  The
program will search through the text to find the word, where the letters
are 'spaced out' by a number of letters.  This involves some brutal
regexp work which appears to crash a nearby string extension.

Bonus points for identifying the book in the example.

an example:

perl hidden.pl "thing"  book.txt

---This is the original text----------------------------------------
s face went white.

It just wasnt all sunshine, he whispered, shaking his head. Not all sunshine, thats all Im saying.

What does he mean? said Gurder, brightly. He d
---Secret  message in text is in capitals---------------------

s f a c e w e n t w h i t e  i t j u 
s T w a s n  t a l l s u n s h i n e 
. H e w h i s p e r e d s h a k i n g 
h I s h e a d  n o t a l l s u n s h 
i N e t h a t  s a l l i  m s a y i 
n G  w h a t d o e s h e m e a n  s 
a i d g u r d e r b r i g h t l y  h 
e d 

-- 
I/O, I/O,
It's off to disk I go,
A bit or byte to read or write,
I/O, I/O, I/O...

-------------- next part --------------

#!/usr/bin/perl

use strict;
use warnings;
#use diagnostics;
my $letter_separation = 80;
my $word = shift @ARGV;
my $file = shift @ARGV;
my $text;

#Read in the contents of the file
open FH, "<$file" or die "couldn't open $file for input";
{
 local $/;
 $text = <FH>;
}
close FH;
my $origtext = $text;
my @words = split /[[:space:][:punct:]]/, $text;
my @wordlist = grep {length $_ > 3} @words;
{local $, = "!";
#print "\nCompiled this wordlist:", @wordlist,"\n";
}
my %words;
$words{$_}=1 foreach @wordlist;
@wordlist = keys %words;
$text =~ s/\n|\r/ /g;
$text =~ s/[[:punct:][:space:]]//g;
$text = lc($text);



foreach my $sep ( 1..$letter_separation) {
 print "Searching for words with a letter separation of $sep\n";
 my @letters = split //, $word;
 my @regexp = ("(.{0,20}", join(".{$sep}", @letters), ".{0,".($sep+20)."})");
 my $regexp = join "", @regexp;
 #print $regexp, "\n\n";
 while ( $text =~/$regexp/ig ) {
  my $block = highlight_block ( $1, $sep, $word );
  foreach my $s ( 1..$sep) {
   my $i;
   my $charlength;
foreach ( @wordlist ) {
  print "Word number: ", $i++, "\n";
  $charlength += length($_);
  print "Total length sent: $charlength\n";
  $block = highlight_block ( $block, $s, $_ ) ; 
}
  }
  print "---This is the original text----------------------------------------\n";
  print find_orig($origtext, $block), "\n";
  print "---Secret message in text is in capitals---------------------\n\n";
  print format_block($block, $sep), "\n";
 }

}

sub format_block {
 my ( $block, $sep) = @_;
 return $block if $sep < 10;
 my $regexp = "(.{".($sep+1)."})";
 $block =~ s/$regexp/$1\n/ig;
 $block =~ s/(.)/$1 /g;
 return $block;
}

sub highlight_block {
 my ($block, $sep, $word)=@_;

  #print "Before $word, $sep\n";
  my @let = split //, $word;
  my $rep = '';
  my $i=1;

   foreach my $l (@let) {$l = "(".$l.")(.{$sep})"; $rep.='\u$'.$i++.'$'.$i++.'';};

  my $regexp2 = join "", @let;

  #print "Now scanning substring with $regexp2 and replacement target $rep\n";
  my $ev = '$block =~ '."s/$regexp2/$rep/i";

  eval $ev;
  print $block, "\n\n";
  #print "block after\n";
  return $block;
}


sub find_orig {
 my ($orig, $block)=@_;
 my @search = split //, $block;

 my $search = join("","(", join( "[[:space:][:punct:]]*", @search), ")"); 

 $orig =~ /$search/gi;
 return $1;