#! /usr/bin/perl -w
# vim:syntax=perl

use strict;

use DB_File;

(my $program = $0) =~ s%.*/%%;

my $stem = shift or die "$program: give dumpfilestem as arg\n";

my $max = 99999;   # max number of objects

my $maxemail = $max;    # max number of email addresses of form
			# john.doe.#@example.com to generate.
my $maxdomain = $max;
my $maxmaildomain = $max;

my $inaddr = '1.0.0.10.in-addr.arpa';
my $mailuser = 'john.doe.1';
my $maildomain = '1.mail.example.com';
my $domain = '1.example.com';
my $ip = '10.0.0.1';

my %h; # hash to store dump in

my @dbs = ('inaddr', 'maildomain', 'email', 'ip', 'domain');

my $tmpdir = defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp';
my $uniq = "$program.$$";

for my $name (@dbs) {
    my $dbfile = "$tmpdir/$uniq.$name";
    -e $dbfile and (
	unlink $dbfile or die "$program: cannot unlink $dbfile\n"
    );
    tie %{ $h{$name} }, "DB_File", "$dbfile" or
    	die "$program: cannot tie to $dbfile\n";
}

sub up
{
    my $type = shift;
    my $what = shift;

    if ($type eq 'inaddr') {
	my ($a, $b, $c, $r) = split /\./, $what;
      	if ($a < 254) {
    	    $a++;
      	} elsif ($b < 254) {
    	    $b++;
    	    $a = 1;
      	} elsif ($c < 254) {
    	    $c++;
    	    $b = 0;
    	    $a = 1;
      	} else {
    	    warn "$program: up: cannot up inaddr $what. out of ip addresses.\n";
    	    return 0;
       	}
	return "$a.$b.$c.10.in-addr.arpa";
    } elsif ($type eq 'mailuser') {
	# john.doe.#@example.com
	my ($n, $t);
	($t, $t, $n) = split /\./, $what;
	if ($n < $maxemail) {
	    $n++;
	} else {
	    warn "$program: up: cannot up mailuser '$what'. used $maxemail " .
		"emailaddresses\n";
	    return 0;
	}
	return 'john.doe.' . "$n"; 
    } elsif ($type eq 'maildomain') {
	my ($n, $d) = split /\./, $what;
	if ($n < $maxmaildomain) {
	    $n++;
        } else {
            warn "$program: up: cannot up maildomain '$what'. used " .
		"$maxmaildomain maildomains\n";
	    return 0;
        }
	return "$n.mail.example.com";
    } elsif ($type eq 'ip') {
	my ($r, $a, $b, $c) = split /\./, $what;
	if ($c < 254) {
	    $c++;
	} elsif ($b < 254) {
	    $b++;
	    $c = 1;
	} elsif ($a < 254) {
	    $a++;
	    $b = 0;
	    $c = 1;
	} else {
    	    warn "$program: up: cannot up ip $what. out of ip addresses.\n";
	    return 0;
	}
	return "10.$a.$b.$c";
    } elsif ($type eq 'domain') {
	# #.example.com
	my ($n, $r) = split /\./, $what;
	if ($n < $maxdomain) {
	    $n++;
	} else {
            warn "$program: up: cannot up domain '$what'. used $maxdomain " .
                "domains\n";
        }
        return "$n" . '.example.com';
    } else {
	warn "$program: up: unsupported type '$type'\n";
	return 0;
    }
}

while (<>) {
    chomp;
    my $r = '';

    while (length) {
	if (/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\.in-addr\.arpa)/i) {
	    unless (defined $h{'inaddr'}{$1}) {
		$h{'inaddr'}{$1} = $inaddr;
		$inaddr = &up('inaddr', $inaddr) or
		    die "$program: cannot up $inaddr\n";
	    }
	    $r .= $h{'inaddr'}{$1};
	    $_ =~ s/^$1//;
	} elsif (/^([^ =\(\)<>@,;:\\"\[\]]+@([-a-z\d\.]+))/i) {
            # we match an emailaddress. we do not support user@[ipaddress].
	    # NOTE: we do not allow '=' in username part, since = is used
	    # as a separator in sendmail logs.

	    # we store lowercase only
	    my $d = lc $2;
	    my $e = lc $1;

	    if (defined $h{'maildomain'}{$d}) {
		unless (defined $h{'email'}{$e}) {
		    $h{'email'}{$e} = $mailuser . "@" . $h{'maildomain'}{$d};
		    $mailuser = &up('mailuser', $mailuser) or
			die "$program: cannot up mailuser '$mailuser'\n";
		}
	    } else {
		$h{'email'}{$e} = $mailuser . "@" . $maildomain;
                $mailuser = &up('mailuser', $mailuser) or
                      die "$program: cannot up mailuser '$mailuser'\n";
		$h{'maildomain'}{$d} = $maildomain;
                $maildomain = &up('maildomain', $maildomain) or
                      die "$program: cannot up maildomain '$maildomain'\n";
	    }
	    $r .= $h{'email'}{$e};
	    $_ =~ s/^\Q$1//;
	} elsif (/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})([^\d]|$)/) {
	    # we match an ip adress
	    unless (defined $h{'ip'}{$1}) {
		$h{'ip'}{$1} = $ip;
		$ip = &up('ip', $ip) or
		    die "$program: cannot up ip '$ip'\n";
	    }
	    $r .= $h{'ip'}{$1};
	    $_ =~ s/^$1//;
	} elsif (/^\/(([-_a-z\d]+\.)+[-_a-z\d]+[a-z]{2})/i) {
            # this is a workaround to make sure file names are no
            # recognized as domain names. File names differ in that
            # that they start with a "/", domain names do not
	    $r .= "/$1";
	    $_ =~ s/^\/$1//;
	} elsif (/^(([-_a-z\d]+\.)+[-_a-z\d]+[a-z]{2})/i) {
            # one or more non-dot's dot, some non-dot's, two letters
	    # note: we accept _'s in domainnames, since this is a very
	    # often made error. we are especially interested in these in bind
	    # logs.
	    my $d = lc $1;
	    unless (defined $h{'domain'}{$d}) {
		$h{'domain'}{$d} = $domain;
		$domain = &up('domain', $domain) or
		    die "$program: cannot up domain '$domain'\n";
	    }
	    $r .= $h{'domain'}{$d};
	    $_ =~ s/^\Q$1//;
	} else {
	    $r .= substr($_, 0, 1);
	    $_ =~ s/^.//;
	}
    }
    print "$r\n" or die "$program: cannot print\n";
}

# now build inverse dumps

# tied hashes to store inverse-d %h{$name}'s in
my %inv;

for my $name (@dbs) {
    my $dbfile = "$stem.$name";
    -e $dbfile and (
	unlink $dbfile or die "$program: cannot unlink $dbfile\n"
    );
    tie %{ $inv{$name} }, "DB_File", "$dbfile" or
    	die "$program: cannot tie to $dbfile\n";

    while (my ($k, $v) = each %{ $h{$name} }) {
	$inv{$name}{$v} = $k;
    }

    untie %{ $inv{$name} } or
        die "$program: cannot untie inverse hash key $name from file " .
	    "$dbfile\n";

    $dbfile = "$tmpdir/$uniq.$name";
    untie %{ $h{$name} } or 
    	die "$program: cannot untie hash key $name from file $dbfile\n";
    unlink $dbfile or die "$program: cannot unlink $dbfile\n";
}


__END__

=pod

=head1 NAME

lr_anonymize - anonymize a logfile

=head1 SYNOPSIS

B<lr_anonymize> I<dumpfilestem>

=head1 DESCRIPTION

B<lr_anonymize> is typically used when sending logs to a responder.  See the
section on "Sending Anonymized Log Files To A Responder" in the chapter on
"Using A Responder" in the Lire User Manual for usage examples.

B<lr_anonymize> reads a file containing emailaddresses, ipnumbers, and
hostnames (typically a logfile from an internet service) from stdin, and prints
an "anonymized" version of this file to stdout. It dumps the information to
"deanonymize" the file, using lr_deanonymize(1), to 5 Berkeley DB databases;
the names of the files holding these databases is contructed by concatenating
the strings 'inaddr', 'maildomain', 'email', 'ip' and 'domain' to
I<dumpfilestem>. I<dumpfilestem> can be e.g. /tmp/dump, ../../var/dump or dump.
The db files created silently overwrite stale ones, if found.

The script builds temporary files. By default, these are created in /tmp.
One can override this by setting the TMPDIR environment variable.

=head1 CONNECTION WITH lr_deanonymize

When running

 $ lr_anonymize dump < log > log.anon
 $ lr_deanonymize dump < log.anon > log.new

then log and log.new have the same content (except for case, check it with 
B<diff -i>).

=head1 NOTES

We tried to optimize this script for memoryusage. This has the drawback
the script will run for quite some time when anonymizing a big logfile.

We've run the script on a 25 M sendmail logfile.

Typical values in such a case are 2500 K for total amount of physical memory 
used, and 15m real, 8m user and 22s systime spent on a 64 MB system with
a 300 MHz Pentium II processor. de_anonymizing this file took 11m real, 8m 
user and 17s system time.

We store maildomains in the dumpfile. These are used by lr_deanonymize(1), 
in case email addresses in our input file reoccur in the file read
by lr_deanonymize(1) in split form, i.e. joe.user@example.com occurs
as both joe.user@example.com and example.com in the to be deanonymized file.

All dumped objects are casted to lowercase.

=head1 BACKGROUND

For your convenience, we quote a bit of rfc822:

 SPACE       =  <ASCII SP, space>            ; (     40,      32.)
 CTL         =  <any ASCII control           ; (  0- 37,  0.- 31.)
                 character and DEL>          ; (    177,     127.)
 specials    =  "(" / ")" / "<" / ">" / "@"  ; Must be in quoted-
             /  "," / ";" / ":" / "\" / <">  ;  string, to use
             /  "." / "[" / "]"              ;  within a word.
 atom        =  1*<any CHAR except specials, SPACE and CTLs>
 quoted-string = <"> *(qtext/quoted-pair) <">; Regular qtext or
                                             ;   quoted chars.
 word        =  atom / quoted-string
 domain-ref  =  atom                         ; symbolic reference
 domain-literal =  "[" *(dtext / quoted-pair) "]"
 sub-domain  =  domain-ref / domain-literal
 domain      =  sub-domain *("." sub-domain)
 local-part  =  word *("." word)             ; uninterpreted
                                             ; case-preserved
 addr-spec   =  local-part "@" domain        ; global address


and of rfc 2181

 The DNS itself places only one restriction on the particular labels
 that can be used to identify resource records.  That one restriction
 relates to the length of the label and the full name.  The length of
 any one label is limited to between 1 and 63 octets.  A full domain
 name is limited to 255 octets (including the separators). 


rfc1123

 However, a valid host name can never
 have the dotted-decimal form #.#.#.#, since at least the
 highest-level component label will be alphabetic.

rfc819

 <domain> ::= <naming-domain> | <naming-domain> "." <domain>
 <naming-domain> ::=  <simple-name> | <address>
 <simple-name> ::= <a> <ldh-str> <let-dig>
 <ldh-str> ::= <let-dig-hyp> | <let-dig-hyp> <ldh-str>
 <let-dig> ::= <a> | <d>
 <let-dig-hyp> ::= <a> | <d> | "-"
 <a> ::= any one of the 52 alphabetic characters A through Z in upper
 case and a through z in lower case
 <d> ::= any one of the ten digits 0 through 9



=head1 EXAMPLE

A 'logfile' like e.g.


 blaat fkrf 1.2.3.4.in-addr.arpa] pietje@bigcompany.com bla 1 2 3 lj;agas;gag
 blaat 1.2.3.4 fkrf 3.2.3.4.in-addr.arpa] bla 1 www.hotsex.com 2 3 lj;agas;gag 
 jan@blaat.frut.com agagag
 blaat fkrf 4.2.3.4.in-addr.arpa] bla pietje@bigcompany.com www.hotsex.com 
 234.34.2.0 jan@blaat.frut.com 4.2.3.4.in-addr.arpa1 2 3 lj;agas;gag
 blaat fkrf tweede 3.2.3.4.in-addr.arpa] bla 1.2.3.4 1 blablabla.com 
 2 mdcc.cx 
 3 lj;agas;gag

wil get anonymized to

 blaat fkrf 1.0.0.10.in-addr.arpa] john.doe.1@example.com bla 1 2 3 lj;agas;gag
 blaat 10.0.0.1 fkrf 2.0.0.10.in-addr.arpa] bla 1 1.example.com 2 3 lj;agas;gag 
 john.doe.2@example.com agagag
 blaat fkrf 3.0.0.10.in-addr.arpa] bla john.doe.1@example.com 1.example.com 
 10.0.0.2 john.doe.2@example.com 3.0.0.10.in-addr.arpa1 2 3 lj;agas;gag
 blaat fkrf tweede 2.0.0.10.in-addr.arpa] bla 10.0.0.1 1 2.example.com 
 2 3.example.com 
 3 lj;agas;gag

The dumps will represent something like

 ip 234.34.2.0 10.0.0.2
 ip 1.2.3.4 10.0.0.1
 inaddr 3.2.3.4.in-addr.arpa 2.0.0.10.in-addr.arpa
 inaddr 1.2.3.4.in-addr.arpa 1.0.0.10.in-addr.arpa
 inaddr 4.2.3.4.in-addr.arpa 3.0.0.10.in-addr.arpa
 domain mdcc.cx 3.example.com
 domain blablabla.com 2.example.com
 domain www.hotsex.com 1.example.com
 email jan@blaat.frut.com john.doe.2@example.com
 email pietje@bigcompany.com john.doe.1@example.com


=head1 BUGS

We can't handle files containing hostnames or email addresses in the 
example.com domain, usernames of the form john.doe.<someletters> or ipnumbers 
in the rfc 1918 private network 10.0.0.0 - 10.255.255.255 (10/8 prefix).

We don't handle quoted-string's in email addresses. We don't handle 
domain-literals in email addresses' domain.

We regard 999.999.999.999 as an IP address: we don't mind the 255 limit.

We don't treat network ipaddresses like 100.10.3 as ipaddresses. These
will I<not> get anonymized.

=head1 SEE ALSO

lr_deanonymize(1), the README.lire-client file in the Lire distribution.

=head1 VERSION

$Id: lr_anonymize.in,v 1.5 2006/07/23 13:16:32 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2000-2001 Stichting LogReport Foundation LogReport@LogReport.org

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html. 

=head1 AUTHOR

Joost van Baal <joostvb@logreport.org>

=cut

# Local Variables:
# mode: cperl
# End:
