Mailmanの「親子リスト(Umbrella List)」でSubject,フッターの修飾がたくさん付くのを回避。（ついでにfmlでの親子リスト）

# 動機
`fml`で運用しているMLを`Mailman`に移行することにした。移行前のMLは、いくつかのサブグループのML(サブML)と、それらを包含するグループ全体のML(上位ML)で構成していた。`fml`では、上位MLの設定ファイル`config.ph`の最後で、配信先の行列にサブMLのメンバーファイルを読み込むようにしていた。

`Mailman`では上位MLの配信先にサブMLを加えるというのが[標準的な方法](https://wiki.list.org/DOC/How%20do%20I%20set%20up%20an%20umbrella%20list%3F)らしい。ただ、この場合上位MLに送った場合の配信メールでは、サブジェクト修飾 ([mlname:index]...)や本文のフッタ修飾に、上位MLとサブMLの両方のものが着いてしまって大変煩わしい。ML階層が増えた日には目も当てられない。なにより、サブジェクト修飾では、**サブMLの修飾が頭に付くので、MUAでは(時に短縮表示されることもあるので)ぱっと見ただけでは上位のMLから配信されたメールであることがわからない**、というのが非常に困る。

[同じ悩みをもつ人](https://mail.python.org/pipermail/mailman-users/2007-September/058494.html)もいたようなので,この人の対処を参考に対応することにした。

# Tweak

テスト環境は`SL7`。`Mailman`(mailman-2.1.15-26.el7_4.1.x86_64.rpm)は、`/usr/lib/mailman`以下に置かれている。`Python`スクリプト2箇所に手をいれた。

```python:CookHeaders.py
*** /usr/lib/mailman/Mailman/Handlers/CookHeaders.py.orig	2018-03-14 02:02:51.000000000 +0900
--- /usr/lib/mailman/Mailman/Handlers/CookHeaders.py	2019-11-09 18:13:32.206066683 +0900
***************
*** 279,284 ****
--- 279,292 ----
      # Add the subject prefix unless the message is a digest or is being fast
      # tracked (e.g. internally crafted, delivered to a single user such as the
      # list admin).
+     xbt=msg.get_all('x-beenthere', '')
+     rp=str(mlist.internal_name()) + '@' + str(mlist.host_name)
+     # syslog('debug', 'x-beenthere %s %s for %s', type(xbt), str(xbt), rp)
+     if isinstance(xbt, list):
+         if len(xbt)>1 or (len(xbt)==1 and len(xbt[0])>0 and xbt[0]!=rp):
+             return
+     elif isinstance(xbt, basestring) and len(xbt)>0 and xbt!=rp:
+         return
      prefix = mlist.subject_prefix.strip()
      if not prefix:
          return
```

```python:Decorate.py
*** /usr/lib/mailman/Mailman/Handlers/Decorate.py.orig	2019-11-09 17:58:47.663058419 +0900
--- /usr/lib/mailman/Mailman/Handlers/Decorate.py	2019-11-09 18:13:45.415066806 +0900
***************
*** 42,47 ****
--- 42,58 ----
      # Digests and Mailman-craft messages should not get additional headers
      if msgdata.get('isdigest') or msgdata.get('nodecorate'):
          return
+ 
+     # Do not decrate for sublist
+     xbt=msg.get_all('x-beenthere', '')
+     rp=str(mlist.internal_name()) + '@' + str(mlist.host_name)
+     # syslog('debug', 'x-beenthere %s %s for %s', type(xbt), str(xbt), rp)
+     if isinstance(xbt, list):
+         if len(xbt)>1 or (len(xbt)==1 and len(xbt[0])>0 and xbt[0]!=rp):
+             return
+     elif isinstance(xbt, basestring) and len(xbt)>0 and xbt!=rp:
+         return
+ 
      d = {}
      if msgdata.get('personalize'):
          # Calculate the extra personalization dictionary.  Note that the
```

追加した部分に関して**`get_all()`の第二引数を空リストにすれば後のコードの型判定などいらないではないか**、というツッコミはごもっともだとおもいます。それで問題なく動いたら教えてほしい。コメントアウトされている`syslog(...)`のところを活かせば、`/var/log/mailman/debug`というファイルにログを残せるようだ。

これを反映させるためには、下記のコマンドを叩く。

```tcsh:mailmanのリロード
% (cd /usr/lib/mailman/Mailman/ ; python -m compileall . )
% systemctl reload mailman
```

# fmlではどうしていたか？

`fml`では上位MLのディレクトリ(`/var/spool/ml/[ml-name]/`)以下に、`subml`という名のサブML名を列挙したテキストファイルと、`posts.allow`という名の発信許可アドレスを列挙したテキストファイルを用意し、設定ファイル`config.ph`の末尾に下記のようなコードを追加することで親子MLを実現していた。

```perl:config.ph(追記部分)
### Enable ML hierarchy
#
$START_HOOK = q#
my @ADDITIONAL_ALLOW_POST_LIST = ();
if ( -f "$DIR/posts.allow" ) {
    push(@ADDITIONAL_ALLOW_POST_LIST, "$DIR/posts.allow" );
}
foreach my $subml (split(/,/,`/usr/local/depot/fml-4.0.3/scripts/subml_recursive.pl ML-NAME`)){
    push(@ACTIVE_LIST, "$DIR/../${subml}/actives");
    push(@MEMBER_LIST, "$DIR/../${subml}/members");
    if ( -f "$DIR/../${subml}/posts.allow" ) {
	push(@ADDITIONAL_ALLOW_POST_LIST, "$DIR/../${subml}/posts.allow" );
    }
};
foreach my $allow_post_list ( @ADDITIONAL_ALLOW_POST_LIST ){
    if ( &CheckMember($From_address, $allow_post_list) ){
	$PERMIT_POST_FROM = "anyone";
    }
};
#;
```
`ML-NAME`のところは上位MLの名前。`/usr/local/depot/fml-4.0.3/scripts/subml_recursive.pl`の中身は下記。

```perl:subml_recursive.pl
#!/usr/local/bin/perl
use strict;

my $MLTOP = "/var/spool/ml";

if ( $#ARGV < 0 ) {
    exit;
}

my $nsublist = 0;
my $delimiter = "";
for ( my $i=0;$i<=$#ARGV;$i++){
    my $topml = $ARGV[$i];
    my @sublist = sort(&get_subml_list($topml,0));
    my $priv = "";
    foreach my $j ( @sublist ){
        if ( $j ne $priv ){
            printf("%s%s", $delimiter, $j);
            $nsublist++;
            $delimiter = ",";
        }
        $priv = $j;

    }
}


sub get_subml_list{
    my ($mlname,$depth) = @_;
    my @submls = ();
    if ( $depth > 10 ){
        return @submls;
    }
    my $submlname = "${MLTOP}/${mlname}/subml";
    if (  -f $submlname  ) {
        open(FIN, "$submlname");
        my @subml = ();
        while(<FIN>){
            chomp;
            s/#.*$//g;
            s/[\s\t]+/ /g;
            s/^[\s\t]//g;
            s/[\s\t];$//g;
            push(@subml,split(/\s+/, $_));
            
        }
        close(FIN);
        for(my $i=0;$i<=$#subml;$i++){
            if(length($subml[$i])>0){
                push(@submls, $subml[$i]);
                my @subsubml = &get_subml_list($subml[$i],$depth+1);
                push(@submls, @subsubml);
            }
        }
    }
    return @submls;
}
```

`perl`のpath, MLのスプールディレクトリは環境に合わせて適宜変更が必要なのは言うまでもない。（何年も前に書いた`perl`スクリプトだが、もはや`perl`の書き方を忘れてしまっている気がする。）