#-*- perl -*- # # Copyright (C) 2006 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: CreateOnPost.pm,v 1.2 2006/02/05 02:44:25 fukachan Exp $ # package FML::Restriction::CreateOnPost; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); use Carp; push(@ISA, qw(FML::Restriction::Post)); =head1 NAME FML::Restriction::CreateOnPost - restrictions on craete-on-post. =head1 SYNOPSIS =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: # Arguments: OBJ($self) STR($rule) STR($sender) # Side Effects: none # Return Value: ARRAY(STR, STR) sub reject_errormail { my ($self, $rule, $sender) = @_; if ($sender eq '<>') { return("matched", "deny"); } return(0, undef); } # Descriptions: # Arguments: OBJ($self) STR($rule) STR($sender) # Side Effects: none # Return Value: ARRAY(STR, STR) sub reject_fml8_managed_address { my ($self, $rule, $sender) = @_; my $curproc = $self->{ _curproc }; if ($curproc->is_fml8_managed_address($sender)) { return("matched", "deny"); } return(0, undef); } # Descriptions: # Arguments: OBJ($self) STR($rule) STR($sender) # Side Effects: none # Return Value: ARRAY(STR, STR) sub reject_createonpost_domain { my ($self, $rule, $sender) = @_; my $curproc = $self->{ _curproc }; my $ml_domain = $curproc->ml_domain(); if ($sender =~ /\@$ml_domain$/i) { return("matched", "deny"); } return(0, undef); } # Descriptions: # Arguments: OBJ($self) STR($rule) STR($sender) # Side Effects: none # Return Value: ARRAY(STR, STR) sub reject_list_header_field { my ($self, $rule, $sender) = @_; my $curproc = $self->{ _curproc }; my $header = $curproc->incoming_message_header(); my $list_help = $header->get("List-Help") || ''; if ($list_help) { return("matched", "deny"); } return(0, undef); } =head1 CODING STYLE See C on fml coding style guide. =head1 AUTHOR Ken'ichi Fukamachi =head1 COPYRIGHT Copyright (C) 2006 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::CreateOnPost first appeared in fml8 mailing list driver package. See C for more details. =cut 1;