# $Id: Chaffe.pm,v 1.5 1998-04-13 14:37:31-05 annis Exp annis $

=head1 NAME

Chaffe - Chaffing and Winnowing.

=head1 VERSION

    $Revision: 1.5 $

=head1 SYNOPSIS

    my $ch = new Chaffe;

    $ch->noise(16);
    $noise = $ch->noise;

    $ch->secret($mac_value)
    $mac = $ch->secret;

    $chaffed_text = $ch->chaffe($text)
    $ch->chaffe($text, \*FILEHANDLE);

    $text = $ch->winnow($text);
    $text = $ch->winnow(\*FILEHANDLE);

=head1 DESCRIPTION

This module is based in interesting ideas which can be found in the
following paper:

    L<http://theory.lcs.mit.edu/~rivest/chaffing.txt>

Please see that document for the theoretical basis for what I am
trying to do in this module.

Please be warned that this is a tremendously alpha implementation of
this concept.  There are a number of upsetting things I do.  Random
number generation, for example, uses whatever perl (and thus, your C
library) provides.

=head1 METHODS

=head2 C<new>

    my $ch = new Chaffe;

This creates a new chaffing object.  It initializes a number of
things, including a default random function which is seeded (see srand
and rand in your perl documentation).

=head2 C<random_function>

    $ch->random_function(\&some_function);
    $rand_function_ref = $ch->random_function;

You may insert your own random function into the chaffing code, which
is used to randmonzie MACs and bits (chaffe production) and to
determine how much chaffe to produce per bit.

The function must take a single argument, C<$r>, and should return a
real value between 0 and C<$r>.

The default function simply uses the C<rand> function which comes
with perl.

=head2 C<noise>

    $ch->noise(16);
    $noise = $ch->noise;

This sets the noise value: how many chaffe tuples to add per packet.
This value actually sets the upper limit of a random selection between
2 and your noise value.  Defaults value is 8.

=head2 C<secret>

    $ch->secret($mac_value)
    $mac = $ch->secret;

This sets (or gets) the "shared secret" or "message authentication
code" for the chaffing or winnowing.  This value, a string of any
length, should be treated with the same respect you give a passphrase.

In this implementation, the shared secret is simply tacked onto the
end of the bit via string concatenation.

=head2 C<chaffe>

    $chaffed_text = $ch->chaffe($text)
    $ch->chaffe($text, \*FILEHANDLE);
    $ch->chaffe($text, \*FILEHANDLE, $filter_ref);

This does all the exciting work.  It will either return a string of
chaffed text or spew the text into the opened file specified in the
second form.

The third for is for making it easy to compress chaffed text.  Alpha
version of this feature, so you might want to avoid using it just now.

Don't expect this to be fast.  And the size of the output should
astound you nicely, too.

The format of the tuples is simple, but adds additional fluff to the
chaffed text size, since I'm hoping to keep this as portable as
possible (yes, this is a string).

    "serial-bumber bit md5-checksum\n"

The md5 checksum is output in hex.  You can save chaffed information
in a file, or email it without further groveling over your results,
although any but the shortest messages may be a bit ridiculous to send
by email.

=head2 C<winnow>

    $text = $ch->winnow($text);
    $text = $ch->winnow_from_fh(\*FILEHANDLE);

Winnow the text (or text in the specified file), returning the wheat.
Currently, you cannot winnow B<into> a file.

=head1 AUTHOR

William S. Annis, Biomedical Computing Group, F<annis@biostat.wisc.edu>

Copyright (c) 1998 William S. Annis.  All rights reserved.  This
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself (the Artistic Licence).

=head1 BUGS and COMMENTS

Slow.  I would not want to chaffe a huge document with this.

Explodes the text chaffed.  I would not want to chaffe a huge document
with this.

=cut

package Chaffe;
use MD5;
use strict;
use vars qw($VERSION);

$VERSION = 0.01;

sub new {
    my($class, %args) = @_;
    my $self = {};
    my $t1 = time();

    $self->{'random_function'} = sub {
        my $r = shift;
        rand $r;
    };

    $self->{'noise'} = 8;

    # From the camel book.
    srand(time() ^ ($$ + ($$ << 15)));

    bless $self, $class;    
}

sub random_function {
    my($self, $random_function) = @_;

    if (defined $random_function) {
        $self->{'random_function'} = $random_function;
    } else {
        $self->{'random_function'};
    }
}

sub noise {
    my($self, $noise) = @_;

    if (defined $noise) {
        $self->{'noise'} = $noise - 1;
    } else {
        $self->{'noise'};
    }
}

# Set the shared secret (MAC - message authentication code).
sub secret {
    my($self, $secret) = @_;

    if (defined $secret) {
        $self->{'secret'} = $secret;
    } else {
        $self->{'secret'};
    }
}


# All the exciting work.
sub chaffe {
    my($self, $text, $fh, $filter) = @_;

    # Loop over every character.  Chaffing is happening by character,
    # rather than full text for those insane people who might want to
    # chaffe an entire Linux kernel.
    my $length = length $text;
    my $chaffed = "";
    my $serial_number = 0;
    for (my $i = 0; $i < $length; $i++) {
        my $char = substr $text, $i, 1;
        # print STDERR "Chaffing char: $char\n";
        $chaffed .= $self->_chaffe_char($char, \$serial_number);

        if (defined $fh) {
            if (defined $filter) {
                # I use the indirection syntax here since Perl chokes
                # on 'print FH ...' with a sub ref: syntax error.
                print $fh $filter->($chaffed);
            } else {
                print $fh $chaffed;
            }

            $chaffed = "";
        }
    }
   
    if (defined $fh) {
        return 1;
    } else {
        return $chaffed;
    }
}

# Take a character, chaffe it.  Returns a string.
sub _chaffe_char {
    my($self, $char, $serial_number_ref) = @_;

    my $bits = unpack("B*", $char);
    my $length = length $bits;
    my $chaffed = "";
    for (my $i = 0; $i < $length; $i++) {
        my $bit = substr $bits, $i, 1;
        $chaffed .= $self->_chaffe_bit($bit, $$serial_number_ref++);
    }
    
    return $chaffed;
}

# Most involving munge: chaffe a bit.  Determines how much chaffe to
# add, and where in the serial number sequence.
sub _chaffe_bit {
    my($self, $bit, $serial_number) = @_;

    my $how_much_chaffe = 2 + int &{$self->{'random_function'}}($self->{'noise'});
    my $wheat_where = int &{$self->{'random_function'}}($how_much_chaffe);

    # Now, generate the chaffe/wheat mix.
    my $md5 = new MD5;
    my $chaffed = "";
    my $wheat = 0;
    for (my $i = 0; $i < $how_much_chaffe; $i++) {
        if ($i != $wheat_where) {
            # No 'round' function.  Generate a bit.
            my $rbit = int(&{$self->{'random_function'}}(1) + .5);
            $md5->reset;
            # Random secret (real from 0 - 10), as a string.
            $md5->add($rbit, &{$self->{'random_function'}}(10) . "");
            $chaffed .= "$serial_number $rbit " . 
                unpack("H*", $md5->digest) . "\n";
        } else {
            # Put in the wheat.
            $md5->reset;
            $md5->add($bit, $self->{'secret'});
            $chaffed .= "$serial_number $bit " .
                unpack("H*", $md5->digest) . "\n";
            $wheat =1;
        }
    }

    return $chaffed;
}

sub winnow {
    my($self, $text) = @_;

    my ($start, $end, $length, $line);
    $start = 0;
    $length = length $text;

    $self->_winnow(sub {
        $end = index $text, "\n", $start;
        $line = substr $text, $start, $end - $start + 1;
        if ($line =~ /^---/ || $line eq "") {
            return undef;
        } else {
            $start = $end + 1;

            chop $line;
            return $line;
        }
    } );
}

sub winnow_from_fh {
    my($self, $fh) = @_;

    $self->_winnow(sub {
        my $line = <$fh>;
        if (! defined $line || $line =~ /^---/) {
            return undef;
        } else {
            chop $line;
            return $line;
        }
    } );        
}

# Wrapped, generic winnower.  The second argument must be a reference
# to a function which will return a new line, or undef on EOF.
sub _winnow {
    my($self, $get_next_line) = @_;

    my @rest;
    my $winnowed = "";          # The final product.
    my @bit;                    # Bit stack (collect by serial #);
    my $char;                   # For assembling a character bitstring.
    my $line;
    my $serial_no;

    @bit = ();
    MAIN: while ($line = &{$get_next_line}) {
        # First bit...
        $bit[$#bit + 1] = $line;
        ($serial_no, @rest) = split(/ /, $line);
        my $char ="";
        while (length $char != 8) {
            $line = &{$get_next_line};
            if (! defined $line) {
                $char .= $self->_winnow_bit(@bit);
                last;
            }
            if ($line =~ /^$serial_no /) {
                $bit[$#bit + 1] = $line;
            } else {
                # We're on to the bit.
                $char .= $self->_winnow_bit(@bit);
                # Reset bit bucket.
                @bit = ();
                ($serial_no, @rest) = split(/ /, $line);
                $bit[$#bit + 1] = $line;
            }
        }

        # Ok, now we have a complete bit-string to form a character!
        $winnowed .= pack("B*", $char);
    }

    $winnowed;
}

# Feed this a list of (text) tuples... the tuples must be chopped!
# Returns the correct bit.  Returns undef if it cannot find wheat.
sub _winnow_bit {
    my($self, @bits) = @_;

    my($bit, $md5);

    $md5 = new MD5;
    foreach my $bit_string (@bits) {
        my ($bit, $mac);
        (undef, $bit, $mac) = split " ", $bit_string;
        $md5->reset;
        $md5->add($bit, $self->{'secret'});
        if (unpack("H*", $md5->digest) eq $mac) {
            return $bit;
        }
    }

    print "WHOA -- Cannot find wheat!\n@bits\n";
    return undef;
}


1;

# EOF