#

# Address Munging module for Apache web server
# Copyright 1999 M-J. Dominus (mjd-perl-addrmunge@plover.com)
# You may distribute this file under the terms of the GNU 
# General Public License, version 1, or, at your option,
# any later version.
#

package Apache::AddrMunge;

use strict;
use Apache::Constants ':common', 'MOVED', 'REDIRECT';
use Apache::File;
use Errno;
use File::CounterFile;
use Socket 'inet_ntoa', 'sockaddr_in';

my $logf;
my $SECS_PER_DAY;
my @chars;
my %IDS;
my $LOG = 1;

sub open_logfile {
  my $fh = do { local *LOGFH };
  my $file = Apache->server_root_relative('logs/AddrMung.log');
  unless (open $fh, ">> $file") {
    Apache->log_error("Couldn't open log file $file: $!");
    return DECLINED;
  }
  my $ofh = select $fh;
  $|++;
  select $ofh;
  $fh;
}

BEGIN {
  $logf = open_logfile();
  $SECS_PER_DAY = 60*60*24;
  @chars = ('a' .. 'z', 0 .. 9);
}

sub id {
  my $r = '';
  while (@_) {
    my $w;
    $_ = shift;
    while ($_) {
      $w .= $chars[$_ % @chars];
      $_ = int ($_/@chars);
    }
    $r .= reverse $w;
    $r .= '+' if @_;
  }
  $r;
}

sub handler {
  my ($r) = @_;
  my $c;
  my $ct = $r->content_type();
  return DECLINED if defined($ct) &&  $ct !~ m{^text\/};
  return DECLINED if $r->method eq 'HEAD';
  
#  unless (defined $c) {
#    $c = new File::CounterFile 
#      Apache->server_root_relative('lib/counters/AddrMung');
#    unless (defined $c) {
#      $r->log_error("Could not allocate counterfile: $!");
#      return DECLINED;
#    }
#  }

#  my $ua = $r->header_in('User-agent');
#  if ($ua =~ /Extractor/) {
#    $r->content_type('text/html');    
#    $r->header_out('http://www.plover.com/cgi-bin/mjd/ad/');    
#    return MOVED;
#  } elsif ($ua =~ /Teleport/) {
#    $r->content_type('text/html');    
#    $r->header_out('http://www.plover.com/~mjd/NoTeleport.html');    
#    return REDIRECT;
#  }

  $logf = open_logfile() unless $logf && defined fileno $logf;

  my $file = $r->filename;
  return DECLINED if $file =~ /\.cgi$/;
  my $fh = Apache::File->new($file);
  unless ($fh) {
    my $err = $!;
    $r->log_error("Could not open file $file: $!");
    $! = $err;
    if ($!{ENOENT}) {
      return NOT_FOUND;
    } elsif ($!{EACCES}) {
      return FORBIDDEN;
    } else {
      return SERVER_ERROR;
    }
  }


  $r->send_http_header;
#  my $id = $c->inc;
  my $id;
  {
    my ($port, $iaddr) = sockaddr_in($r->connection->remote_addr());
    my ($dayno) = int(time/$SECS_PER_DAY);
    $id = id($dayno, unpack("N", $iaddr));
    if (defined fileno $logf && !$IDS{$id}++ && $LOG) {
      my $ip = inet_ntoa($iaddr);
      my $rh = $r->get_remote_host();
      print $logf "$id: $ip $rh\n";
    }
  }

  while (<$fh>) {
    s{\b(mjd[-\w]*)
       (?<!-subscribe)
       (?<!-unsubscribe)
       (?<!-request)
       @
       (
	(?:\w+\.)?
	plover\.com
       \b)
      }
     {$1-id-$id+\@$2}gx;
    $r->print($_);
  }
  return OK;
}


1;

#     s{\b(mjd[-\w]*)
#        @
#        (
# 	(?:\w+\.)?
# 	plover\.com
#        \b)
#       }
#      {($a,$b) = ($1,$2);
#        $a =~ m{-subscribe$} ? "$a\@$b" : "$a-id-$id\@$b"
#      }gex;
#     $r->print($_);