#-*- 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;