package MailBot::Profile;

=head1 NAME

MailBot::Profile - User-specific or group-specific parameters

=head1 SYNOPSIS

 use MailBot::UI;

 my $profile = MailBot::UI -> current -> getProfile;
 my $max_wicket = $profile -> getProfileVal("user_specific_wicket_limit");
 $wicket > $max_wicket and die "ACCESS_DENIED: too many wickets";

=head1 DESCRIPTION

Profiles can be based on domains, hostnames, or individual user names.

=head1 METHODS

=cut


use MailBot::Config;

use Carp;
use strict;

my @gaphGroup = ();

# jfj add database support
# jfj add table support

sub new
{
    my $type = shift;
    my $address = shift;
    chomp($address);

    my $self = {ADDRESS => $address};
    bless($self,$type);

    $self -> setGroupFromAddress($address);
    $self;
}

sub getQuota
{
    my $self = shift;
    my $multiplier = shift;

    my $address = $$self{ADDRESS};
    new MailBot::Quota($address,$multiplier);
}

# jfj add blocking capability

sub tryGroupFromID
{
    my $self = shift;
    my $id = shift;

    my $config = MailBot::Config::current;
    my $group = $config -> getIniVal('map.group',$id);
    
    # sanity check, make sure group is defined in ini-file
    if (defined $group)
    {
	my @aSection = $config -> getIni -> Sections;
	grep($_ eq "profile.$group",@aSection)
	    or die "not found in config file: profile.$group";
    }
    $group;
}

sub setGroupFromAddress
{
    my $self = shift;
    my $address = shift;

    my $group = $self -> addressToGroup($address);
    $$self{GROUP} = $group;
}

sub addressToGroup
{
    my $self = shift;
    my $address = shift;

    my $host = $address;
    $host =~ s/.+\@//;
    $host =~ s/\!.+//;

    my @aTry = ($address, $host);

    my $domain = $host;
    while ($domain =~ s/^[^.]+\.//)
    {
	push(@aTry,$domain);
    }

    my $try;
    while (@aTry)
    {
	$try = shift @aTry;
	my $group = $self -> tryGroupFromID($try);
	return $group if defined $group;
    }
    return "normal";
}

=head2 getProfileVal($key[,$default])

Gets a value from a key-string, with an optional default.

=cut

sub getProfileVal
{
    my $self = shift;
    my ($param,$default) = @_;

    my $group = $$self{GROUP};

    my $config = MailBot::Config::current;

    my $val = $config -> getIniVal("profile.$group",$param);
    return $val if defined $val;
    
    $config -> getIniVal('profile',$param,$default);
}

# isContentTypeDenied: based on the MIME content-type of the Web
# document and the size, returns "" if OK, or else a nonzero-length
# string explaining why it was denied

sub isContentTypeDenied
{
    my ($self,$contentType,$size) = @_;

    my $deny = $self -> _getContentTypeParam($contentType,'deny',0);
    $deny and
	return "not allowed to fetch files of content-type '$contentType'";

    my $maxSize = $self -> _getContentTypeParam($contentType,'max_size');
    if (defined $maxSize and $size > $maxSize)
    {
	return "not allowed to fetch $contentType files of length over $maxSize";
    }

    "";  # if not specifically forbidden, then is allowed
}

sub _getContentTypeParam
{
    my ($self,$contentType,$key,$default) = @_;

    my $contentTypeBase = $contentType;
    $contentTypeBase =~ s^/.+^^;

    foreach (".$contentType", ".$contentTypeBase", "")
    {
	my $ret = $self -> getProfileVal("content.$key$_");
	return $ret if defined $ret;
    }

    $default;
}

sub dDie
{
    my $self = shift;
    my $failedAction = shift;

    my $group = $$self{GROUP};

    die "ACCESS DENIED: members of group $group may not $failedAction\n";
}

sub allowRedirect
{
    shift -> getProfileVal('allow_redirect');
}

1;

=head1 SEE ALSO

L<MIME::Entity>, L<MailBot::Envelope>, L<MailBot::UI>, L<MailBot::Quota>

=head1 COPYRIGHT

Copyright (c) 1997 SatelLife.  All rights reserved.

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

Rolf Nelson <rolf@usa.healthnet.org>

=cut
