#-*- perl -*-
#
# Copyright (C) 2003 Ken'ichi Fukamachi
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl itself.
#
# $FML: Post.pm,v 1.2 2003/03/09 03:52:12 fukachan Exp $
#
package FML::Restriction::Post;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Carp;
use FML::Log qw(Log LogWarn LogError);
=head1 NAME
FML::Restriction::Post - restricts who is allowed to post/use command mails.
=head1 SYNOPSIS
collection of utility functions used in Post routines.
=head1 DESCRIPTION
=head1 METHODS
=cut
# Descriptions: constructor.
# Arguments: OBJ($self) OBJ($curproc)
# Side Effects: none
# Return Value: OBJ
sub new
{
my ($self, $curproc) = @_;
my ($type) = ref($self) || $self;
my $me = { _curproc => $curproc };
return bless $me, $type;
}
# Descriptions: reject if $sender matches a system account.
# Arguments: OBJ($self) STR($rule) STR($sender)
# Side Effects: none
# Return Value: ARRAY(STR, STR)
sub reject_system_accounts
{
my ($self, $rule, $sender) = @_;
my $curproc = $self->{ _curproc };
my $cred = $curproc->{ credential };
my $match = $cred->match_system_accounts($sender);
my $pcb = $curproc->{ pcb };
if ($match) {
Log("${rule}: $match matches sender address");
$pcb->set("check_restrictions", "deny_reason", $rule);
return("matched", "deny");
}
return(0, undef);
}
# Descriptions: permit irrespective of $sender :)
# Arguments: OBJ($self) STR($rule) STR($sender)
# Side Effects: none
# Return Value: ARRAY(STR, STR)
sub permit_anyone
{
my ($self, $rule, $sender) = @_;
return("matched", "permit");
}
# Descriptions: permit if $sender is an ML member.
# Arguments: OBJ($self) STR($rule) STR($sender)
# Side Effects: none
# Return Value: ARRAY(STR, STR)
sub permit_member_maps
{
my ($self, $rule, $sender) = @_;
my $curproc = $self->{ _curproc };
my $cred = $curproc->{ credential };
my $pcb = $curproc->{ pcb };
# Q: the mail sender is a ML member?
if ($cred->is_member($sender)) {
# A: Yes, we permit to distribute this article.
return("matched", "permit");
}
else {
# A: No, deny distribution
LogError("$sender is not an ML member");
LogError( $cred->error() );
# reply this info in each FML::Process::* module.
# $curproc->reply_message_nl('error.not_member',
# "you are not a ML member." );
# $curproc->reply_message( " your address: $sender" );
# save reason for later use.
$pcb->set("check_restrictions", "deny_reason", $rule);
# XXX "deny ASAP if this method fails." ? NO, wrong!
# XXX permit_XXX() allows the trial match of another rules.
# return("matched", "deny");
}
return(0, undef);
}
# Descriptions: permit this command even if $sender is a stranger.
# Arguments: OBJ($self) STR($rule) STR($sender)
# Side Effects: none
# Return Value: ARRAY(STR, STR)
sub permit_commands_for_stranger
{
my ($self, $rule, $sender) = @_;
my $curproc = $self->{ _curproc };
my $pcb = $curproc->{ pcb };
use FML::Command::DataCheck;
my $check = new FML::Command::DataCheck;
if ($check->find_commands_for_stranger($curproc)) {
Log("$rule matched. accepted.");
return("matched", "permit");
}
return(0, undef);
}
# Descriptions: reject irrespective of $sender.
# Arguments: OBJ($self) STR($rule) STR($sender)
# Side Effects: none
# Return Value: ARRAY(STR, STR)
sub reject
{
my ($self, $rule, $sender) = @_;
my $curproc = $self->{ _curproc };
my $pcb = $curproc->{ pcb };
$pcb->set("check_restrictions", "deny_reason", $rule);
return("matched", "deny");
}
=head1 CODING STYLE
See C on fml coding style guide.
=head1 AUTHOR
Ken'ichi Fukamachi
=head1 COPYRIGHT
Copyright (C) 2003 Ken'ichi Fukamachi
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.
=head1 HISTORY
FML::Restriction::Post first appeared in fml8 mailing list driver package.
See C for more details.
=cut
1;