define the detail of address masking against spammers.

$use_html_archive_address_mask	=	yes
$html_archive_address_mask_type	=	all

2 files changed, 51 insertions, 20 deletions

diff --git a/fml/lib/FML/Process/Utils.pm b/fml/lib/FML/Process/Utils.pm
index f6dce1a2..3a5c50b3 100644
--- a/fml/lib/FML/Process/Utils.pm
+++ b/fml/lib/FML/Process/Utils.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: Utils.pm,v 1.69 2003/07/20 06:51:03 fukachan Exp $
+# $FML: Utils.pm,v 1.70 2003/08/14 13:43:08 tmu Exp $
 #
 
 package FML::Process::Utils;
@@ -1258,23 +1258,33 @@ sub thread_db_args
     my $html_dir     = $config->{ html_archive_dir };
     my $udb_dir      = $config->{ udb_base_dir };
     my $index_order  = $config->{ html_archive_index_order_type };
-    my $address_mask = $config->{ html_archive_address_mask };
     my $cur_lang     = $curproc->language_of_html_file();
 
+    # whether we should mask address?
+    my $use_address_mask  = 'yes';
+    my $address_mask_type = 'all';
+    if ($config->yes('use_html_archive_address_mask')) {
+	$use_address_mask = 'yes';
+	$address_mask_type
+	    = $config->{ html_archive_address_mask_type } || 'all';
+    }
+
     unless (-d $udb_dir) { $curproc->mkdir($udb_dir);}
 
     # XXX-TODO: care for non Japanese.
     return {
 
-	charset     => $cur_lang,
+	charset      => $cur_lang,
 
-	output_dir  => $html_dir,    # ~fml/public_html/mlarchive/$domain/$ml/
-	db_base_dir => $udb_dir,     # /var/spool/ml/@udb@
-	db_name     => $ml_name,     # elena
+	output_dir   => $html_dir, # ~fml/public_html/mlarchive/$domain/$ml/
+	db_base_dir  => $udb_dir,  # /var/spool/ml/@udb@
+	db_name      => $ml_name,  # elena
 
-	index_order => $index_order, # normal/reverse
-	address_mask => $address_mask, # normal/reverse
+	index_order  => $index_order,  # normal/reverse
 
+	# address mask = yes/no, _type = all
+	use_address_mask  => $use_address_mask,
+	address_mask_type => $address_mask_type,
     };
 }
 
diff --git a/fml/lib/Mail/Message/ToHTML.pm b/fml/lib/Mail/Message/ToHTML.pm
index c8793135..f047155d 100644
--- a/fml/lib/Mail/Message/ToHTML.pm
+++ b/fml/lib/Mail/Message/ToHTML.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: ToHTML.pm,v 1.50 2003/08/08 03:52:55 fukachan Exp $
+# $FML: ToHTML.pm,v 1.51 2003/08/14 13:43:09 tmu Exp $
 #
 
 package Mail::Message::ToHTML;
@@ -17,7 +17,7 @@ my $debug = 0;
 my $URL   =
     "<A HREF=\"http://www.fml.org/software/\">Mail::Message::ToHTML</A>";
 
-my $version = q$FML: ToHTML.pm,v 1.50 2003/08/08 03:52:55 fukachan Exp $;
+my $version = q$FML: ToHTML.pm,v 1.51 2003/08/14 13:43:09 tmu Exp $;
 if ($version =~ /,v\s+([\d\.]+)\s+/) {
     $version = "$URL $1";
 }
@@ -105,8 +105,9 @@ sub new
     $me->{ _num_attachment }      = 0; # for child process
     $me->{ _use_subdir }          = 'yes';
     $me->{ _subdir_style }        = 'yyyymm';
-    $me->{ _html_id_order }       = $args->{ index_order } || 'normal';
-    $me->{ _address_mask }        = $args->{ address_mask } || 'mask';
+    $me->{ _html_id_order }       = $args->{ index_order }  || 'normal';
+    $me->{ _use_address_mask }    = $args->{ use_address_mask }  || 'yes';
+    $me->{ _address_mask_type }   = $args->{ address_mask_type } || 'all';
 
     use Mail::Message::Thread;
     my $t = new Mail::Message::Thread $args;
@@ -741,9 +742,11 @@ sub _format_safe_header
 
 	    my $xbuf = $hdr->get($field);
 
-	    # mask the raw address.
-	    if ($field =~ /^(From|To|Cc)$/ && $self->{ _address_mask } ne 'nomask') {
-		$xbuf = $self->_who_of_address($xbuf);
+	    # mask the raw address against address collector (e.g. spammer).
+	    if ($self->{ _use_address_mask } eq 'yes') {
+		if ($self->_is_mask_address($field)) {
+		    $xbuf = $self->_who_of_address($xbuf);
+		}
 	    }
 
 	    $xbuf = $self->_decode_mime_string($xbuf) if $xbuf =~ /=\?iso/i;
@@ -1981,11 +1984,6 @@ sub _print_li_filename
 }
 
 
-=head2 misc
-
-=cut
-
-
 # Descriptions: extrace gecos field in $address
 #    Arguments: OBJ($self) STR($address)
 # Side Effects: none
@@ -1999,6 +1997,29 @@ sub _who_of_address
 }
 
 
+# Descriptions: mask the detail of address
+#    Arguments: OBJ($self) STR($field)
+# Side Effects: none
+# Return Value: NUM
+sub _is_mask_address
+{
+    my ($self, $field) = @_;
+    my $type = $self->{ _address_mask_type } || 'all';
+
+    if ($type eq 'all') {
+	if ($field =~ /^(From|To|Cc)$/i) {
+	    return 1;
+	}
+	else {
+	    return 0;
+	}
+    }
+    else {
+	return 0;
+    }
+}
+
+
 # Descriptions: decode MIME-encoded $str
 #    Arguments: OBJ($self) STR($str) HASH_REF($options)
 # Side Effects: none