clean up Rules.pm and merge it to BodyCheck.pm

2 files changed, 121 insertions, 104 deletions

diff --git a/fml/lib/FML/Filter/BodyCheck.pm b/fml/lib/FML/Filter/BodyCheck.pm
index 6de5c1f1..81575ecb 100644
--- a/fml/lib/FML/Filter/BodyCheck.pm
+++ b/fml/lib/FML/Filter/BodyCheck.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself. 
 #
-# $FML: BodyCheck.pm,v 1.1.1.1 2001/03/28 15:13:31 fukachan Exp $
+# $FML: BodyCheck.pm,v 1.2 2001/03/30 09:18:43 fukachan Exp $
 #
 
 package FML::Filter::BodyCheck;
@@ -87,16 +87,124 @@ sub body_check
     $self->clean_up_buffer($m);
 
     ## 6. main fules
-    my $rules = '';
-    for $rules (
+    for my $rule (
 		'reject_not_iso2022jp_japanese_string',
 		'reject_null_mail_body',
 		) {
-	if ($self->can($method)) {
-	    $self->$method($curproc, $args, $m);
+	if ($self->can($rule)) {
+	    $self->$rule($curproc, $args, $m);
 	}
 	else {
-	    LogWarn("no such method $method");
+	    LogWarn("no such rule $rule");
+	}
+    }
+}
+
+
+sub reject_not_iso2022jp_japanese_string
+{
+    use FML::Language::ISO2022JP;
+    not is_iso2022jp_string();
+}
+
+
+sub reject_null_mail_body
+{
+    my $m;
+    $m->is_empty;
+}
+
+
+# Descriptions: virus check against some types of M$ products
+#               Even if Multipart, evaluate all blocks agasint virus checks.
+#    Arguments: $self $args
+# Side Effects: 
+# Return Value: none
+sub reject_virus_message
+{
+    # &use('viruschk');
+    # my ($xr);
+    # $xr = &VirusCheck(*e);
+}
+
+
+# Descriptions: e.g. "unsubscribe", "help", ("subscribe" in some case)
+#               XXX DO NOT INCLUDE ".", "?" (I think so ...)! 
+#               XXX but we need "." for mail address syntax 
+#               XXX e.g. "chaddr a@d1 b@d2".
+#               If we include them, 
+#               we cannot identify a command or an English phrase ;D
+# Arguments: $self $args
+# Side Effects: 
+# Return Value: none
+sub reject_one_line_message
+{
+    my $buf;
+
+    if ($buf =~ /^[\s\n]*[\s\w\d:,\@\-]+[\n\s]*$/) {
+	croak "one line mail body";
+    }
+}
+
+
+# Descriptions: 
+#              XXX fml 4.0: fml.pl (distribute) should not accpet commands 
+#              XXX: "# command" is internal represention
+#              XXX: but to reject the old compatible syntaxes.
+#    Arguments: $self $args
+# Side Effects: 
+# Return Value: none
+sub reject_old_fml_command_syntax
+{
+    my $buf;
+
+    if ($buf =~ /^[\s\n]*(\#\s*[\w\d\:\-\s]+)[\n\s]*$/) {
+	my $r = $1; 
+	$r =~ s/\n//g;
+	$r = "avoid to distribute commands [$r]";
+	croak $r;
+    }
+}
+
+
+sub reject_invalid_fml_command_syntax
+{
+    my $buf;
+
+    if ($buf =~ /^[\s\n]*\%\s*echo.*/i) {
+	croak "invalid command in the mail body";
+    }
+}
+
+
+# Descriptions: reject Japanese command syntax
+#                JIS: 2 byte A-Z => \043[\101-\132]
+#                JIS: 2 byte a-z => \043[\141-\172]
+#                EUC 2-bytes "A-Z" (243[301-332])+
+#                EUC 2-bytes "a-z" (243[341-372])+
+#                e.g. reject "SUBSCRIBE" : octal code follows:
+#                243 323 243 325 243 302 243 323 243 303 
+#                243 322 243 311 243 302 243 305
+#    Arguments: $self $args
+# Side Effects: 
+# Return Value: none
+sub reject_japanese_command_syntax
+{
+    my $buf;
+
+    if ($buf =~ /\033\044\102(\043[\101-\132\141-\172])/) {
+	# trap /JIS"2byte"[A-Za-z]+/
+
+	# EUC-fy for further investigation
+	my $s = &STR2EUC($buf);
+	$s    = (split(/\n/, $s))[0]; # check the first line only
+
+	my ($n_pat, $sp_pat);
+	$n_pat  = '\243[\301-\332\341-\372]';
+	$sp_pat = '\241\241'; # 2-byte spaces
+
+	if ($s =~ /^\s*(($n_pat){2,})\s+.*$|^\s*(($n_pat){2,})($sp_pat)+.*$|^\s*(($n_pat){2,})$/) {
+	    croak '2 byte command';
 	}
     }
 }
@@ -108,6 +216,13 @@ sub clean_up_buffer
 }
 
 
+sub is_empty
+{
+    my $m;
+    $m->is_empty();
+}
+
+
 # XXX fml 4.0: If it has @ or ://, it must be a paragraph 
 sub is_one_line_message
 {
diff --git a/fml/lib/FML/Filter/Rules.pm b/fml/lib/FML/Filter/Rules.pm
deleted file mode 100644
index d4af94aa..00000000
--- a/fml/lib/FML/Filter/Rules.pm
+++ /dev/null
@@ -1,98 +0,0 @@
-sub reject_null_mail_body
-{
-    $buf =~ /^[\s\n]*$/;
-}
-
-
-sub reject_not_iso2022jp_japanese_string
-{
-    use FML::Language::ISO2022JP;
-    not is_iso2022jp_string();
-}
-
-
-sub reject_one_line_message
-{
-
-    # e.g. "unsubscribe", "help", ("subscribe" in some case)
-    # XXX DO NOT INCLUDE ".", "?" (I think so ...)! 
-    # XXX but we need "." for mail address syntax e.g. "chaddr a@d1 b@d2".
-    # If we include them, 
-    # we cannot identify a command or an English phrase ;D
-    if ($fparbuf =~ /^[\s\n]*[\s\w\d:,\@\-]+[\n\s]*$/) {
-	$r = "one line mail body";
-    }
-}
-
-
-# XXX fml 4.0: fml.pl (distribute) should not accpet commands 
-# XXX: "# command" is internal represention
-# XXX: but to reject the old compatible syntaxes.
-sub reject_command_syntax
-{
-    if ($mode eq 'distribute' && $FILTER_ATTR_REJECT_COMMAND &&
-	$fparbuf =~ /^[\s\n]*(\#\s*[\w\d\:\-\s]+)[\n\s]*$/) {
-	$r = $1; $r =~ s/\n//g;
-	$r = "avoid to distribute commands [$r]";
-    }
-}
-
-
-sub reject_invalid_command_syntax
-{
-
-    elsif ($fparbuf =~ /^[\s\n]*\%\s*echo.*/i && 
-	   $FILTER_ATTR_REJECT_INVALID_COMMAND) {
-	$r = "invalid command in the mail body";
-}
-
-# Japanese command
-# JIS: 2 byte A-Z => \043[\101-\132]
-# JIS: 2 byte a-z => \043[\141-\172]
-# EUC 2-bytes "A-Z" (243[301-332])+
-# EUC 2-bytes "a-z" (243[341-372])+
-# e.g. reject "SUBSCRIBE" : octal code follows:
-# 243 323 243 325 243 302 243 323 243 303 243 322 243 311 243 302
-# 243 305
-sub reject_japanese_command_syntax
-{
-    elsif ($FILTER_ATTR_REJECT_2BYTES_COMMAND && 
-	   $fparbuf =~ /\033\044\102(\043[\101-\132\141-\172])/) {
-	# /JIS"2byte"[A-Za-z]+/
-	
-	$s = &STR2EUC($fparbuf);
-
-	my ($n_pat, $sp_pat);
-	$n_pat  = '\243[\301-\332\341-\372]';
-	$sp_pat = '\241\241'; # 2-byte space
-
-	$s = (split(/\n/, $s))[0]; # check the first line only
-	if ($s =~ /^\s*(($n_pat){2,})\s+.*$|^\s*(($n_pat){2,})($sp_pat)+.*$|^\s*(($n_pat){2,})$/) {
-	    &Log("2 byte <". &STR2JIS($s) . ">");
-	    $r = '2 byte command';
-	}
-    }
-}
-
-
-sub reject_invalid_message_id
-{
-
-
-}
-
-
-
-# [VIRUS CHECK against a class of M$ products]
-# Even if Multipart, evaluate all blocks agasint virus checks.
-sub reject_virus_message
-{
-
-	&use('viruschk');
-	my ($xr);
-	$xr = &VirusCheck(*e);
-
-}
-
-
-1;