#$Id: MD5.pm,v 0.01 2001/08/24 21:10:00 george@xorgate.com Exp $
package Apache::OpenIndex;
use strict;
use Digest::MD5;
use Apache::Util qw(escape_uri);
my $ofh;

# The following two directives can be used in httpd.conf file for adding the MD5 menu command.
#   OpenIndexOptions Import MD5 MD5 before=>MD5before after=>MD5after min=>1 max=>0 back=>MD5back
#   OpenIndexOptions Menu +MD5
#
# Copyright (c) 2001 George Sanderson All rights reserved. This
# program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself. 
#
sub MD5 {
    my ($r,$args,$cfg,$root,$src,$dst) = @_;
    my $file="$root$src";
    return 1 if -d $file;
    my $lang = new Apache::Language($r) if $cfg->{language};
    my $msg;
    my $cmdname=$lang->{MD5} || 'MD5';
    my $fh;
    unless(open($fh, $file)) {
	print STDERR "MD5() open: $file\n" if $debug;
	my $msg=$lang->{FileOpen} || 'File open';
	errmsg("${cmdname}: $msg");
	$args->{error}=1;
	return 0;
    }
    binmode($fh);
    my $md5=Digest::MD5->new;
    $md5->addfile($fh);
    my $digest=$md5->hexdigest;
    $r->log->notice(__PACKAGE__." $args->{user}: MD5: $file=$digest");
    ($file=$src)=~s:.*/::;	# strip off directory
    print {$ofh} "$file=$digest\n";
    close $fh;
    1;
}

sub MD5before {
    my ($r,$args,$cfg,$root,$items,$dst) = @_;
    my $file=$dst;
       $file.=".md5.txt" unless $args->{dst}; # Default file to contain the MD5s
    $args->{md5file}=$file;
    $file="$root$file";
    my $uri = $r->uri;
    my $lang = new Apache::Language($r) if $cfg->{language};
    my $msg;
    my $cmdname=$lang->{MD5} || 'MD5';
    unless(open($ofh, "+>$file")) {
	print STDERR "MD5before() open: $file\n" if $debug;
	$msg=$lang->{FileOpen} || 'File open';
	errmsg("${cmdname}: $msg");
	$args->{error}=1;
	return 0;
    }
    1;
}

sub MD5after {
    my ($r,$args,$cfg,$root,$dst) = @_;
    my $uri = $r->uri;
    $uri.="?proc=MD5";
    $uri.="&frame=main" if $cfg->{frames};
    $uri.='&md5file=';
    $uri.=escape_uri($args->{md5file});
    if($args->{dst}) {
	$uri.='&dst=';
	$uri.=escape_uri($args->{dst});
    }
    print STDERR "MD5after() REDIRECT to $uri\n" if $debug;
    $r->header_out(Location=>$uri);
    close $ofh;
    REDIRECT;
}

sub MD5back {
    my ($r,$args,$cfg,$root) = @_;
    my $uri = $r->uri;
    my $lang = new Apache::Language($r) if $cfg->{language};
    my $cmdname=$lang->{MD5} || 'MD5';
    my $file="$root$args->{md5file}";
    unless(open(FILE, $file)) {
	print STDERR "MD5back() call back open: $file\n" if $debug;
	my $msg=$lang->{FileOpen} || 'File open';
	errmsg("${cmdname}: $msg");
	$args->{error}=1;
	return 0;
    }
    return SKIP_INDEX unless httphead($r,"$cmdname results");
    header($r,$cfg) unless $cfg->{frames}; 
    tagout('h3',$cfg,'',qq~$cmdname results</h3>~);
    if($args->{error}) {
	if($cfg->{font}) {
	    tagout('font',$cfg,'',"ERROR: $errmsg</font></h3>");
	} else {
	    print qq~<font color=#FF0000> ERROR: $errmsg</font></h3>~;
	}
    }
    if($cfg->{table}) {
	tagout('table',$cfg,qq~col="2"~);
    } else {
	print qq~<table col="2" border>~;
    }
    tagout('tr',$cfg);
    tagout('th',$cfg,'',qq~ Filename </th>~);
    tagout('th',$cfg,'',qq~ MD5 Hash </th></tr>~);
    while(<FILE>) {
	my($file,$digest)=split /=/;
	tagout('tr',$cfg);
	tagout('td',$cfg,'',qq~$file</td>~);
	tagout('td',$cfg,'',qq~$digest</td></tr>~);
    }
    $uri.="?frame=main" if $cfg->{frames};
    if($args->{dst}) {
	if($cfg->{frames}) {
	    $uri.='&dst=';
	} else {
	    $uri.='?dst=';
	}
	$uri.=escape_uri($args->{dst});
    }
    print '</table>';
    tagout('p',$cfg,'',qq~<a href="$uri">Back to Index</a>~);
    print "</body>" unless $cfg->{frames};
    print "</html>\n";
    close FILE;
    SKIP_INDEX;
}
1;