Mailing List （邮件列表）原理简述及我的perl实现

注： 本文本来是一早要写的，可是程序写了有段时间了，最近一段时间又很忙，居然给忘了，现在补上。

正文

大部分IT人员都使用过邮件列表，或者类似的服务，但邮件列表的内部工作原理则不是简单的订阅，退订阅那么简单。最近根据自己的一些认识，用perl实现了一个非常简单的MLM程序，也顺便谈谈邮件列表的最基本工作原理。

邮件列表，简单的来说，就是任一列表成员向该列表发的邮件，其他所有人（可以包括他自己）都能收到，并且每个人能自由订阅、退订。更丰富的邮件列表还包括了摘要，精确权限管理，web archive功能等等。

著名的开源邮件列表软件如mailman, majodomo, ezmlm, sympa, ecartis等都是功能完备的邮件列表软件，但归根结底，最简单的邮件列表至少应该包含如下功能：

• 订阅功能，即用户发特定订阅信件到邮件列表
• 确认订阅功能，即用户必须给MLM发确认信才能正式订阅
• 退订功能，用户可自由退出订阅服务。
• 任一列表成员给邮件列表发的邮件，其他人都应收到。

要实现上述的功能，如果使用perl的话并不复杂，配合Postfix MTA可以非常方便的开发出简易的邮件列表软件。以下是自己开发的MMList(Mini Mailing List) 的基本结构：

配置

main.cf里需要配置的内容：

alias_maps = hash:/etc/postfix/aliases hash:/etc/postfix/mml.aliases
virtual_alias_maps = hash:/etc/postfix/mml.virtual_alias_maps

mml.aliases的内容：

# alias file
test-subscribe-hzqbbc.com:   "|/usr/bin/mml -cmd=subscribe -list=test@hzqbbc.com"
test-confirm-hzqbbc.com:     "|/usr/bin/mml -cmd=confirm -list=test@hzqbbc.com"
test-unsubscribe-hzqbbc.com: "|/usr/bin/mml -cmd=unsubscribe -list=test@hzqbbc.com"

mml.virtual_alias_maps的内容：

test-subscribe@hzqbbc.com        test-subscribe-hzqbbc.com
test-confirm@hzqbbc.com          test-confirm-hzqbbc.com
test-unsubscribe@hzqbbc.com      test-unsubscribe-hzqbbc.com

MMList 的perl实现

#!/usr/bin/perl -w
# vim: set cindent expandtab ts=4 sw=4:
# MMList - a very lightweight MLM software
#
# Author: He zhiqiang <hzqbbc@hzqbbc.com>
# CopyRight (c) 1998-2005 hzqbbc.com
#
# License: GPL v2
use strict;
use Getopt::Long;
use vars qw(%cfg $cmd $list @KEY_MAP);
use vars qw($user $subj $SLOG);
$user = $subj = "";

@KEY_MAP = (
    0,1,2,3,4,5,6,7,8,9,'A','B','C','D','E',
    'F','G','H','I','J','K','L','M','N','O',
    'P','Q','R','S','T','U','V','W','X','Y',
    'Z','a','b','c','d','e','f','g','h','i',
    'j','k','l','m','n','o','p','q','r','s',
    't','u','v','w','x','y','z'
);

# proto-type:
# cmd ==> indicate the 'subscribe' or 'unsubscribe'
# list ==> indicate the list name

my $res = GetOptions(
	"cmd=s" => \$cmd,
        "list=s" => \$list
);

$cfg{'basedir'} = "/var/lib/mmlist";
$cfg{'listdir'} = $cfg{'basedir'}."/lists";
$cfg{'hostname'} = "list.hzqbbc.com";

open (MLOG, ">> $cfg{'basedir'}/mail.log");
open ($SLOG, ">> $cfg{'basedir'}/base.log");
# read from STDIN
while(<STDIN>) {
     print MLOG $_;
 
     if(/^From: (.*)$/) {
          chomp;
          m/([a-zA-Z0-9-_=\.]+\@[a-zA-Z0-9-_=\.]+)/;
          if($1) {
               $user = lc $1;
           }
      }elsif(/^Subject: (.*)$/) {
          chomp;
          $subj = $1;
          $subj =~ s/\s//g;
      }
}

syslog("cmd = $cmd");

if($cmd eq "subscribe") {
     if(user_exist($user)) {
          syslog("$user subscribed");
          my $body = q(Hey guy, you have already subscribed!);
          sendmail($user, "Subscribe failure", $body);
      }else {
          my $sid = gen_sid();
          open(FD, "> $cfg{'listdir'}/$list/queue/$user") or
              syslog("$!") and die "Can't write to $user, $!\n";
          printf FD "%s\:%s\n", time, $sid;
          close FD;
  
          syslog("confirm $user");
          my $body = "Hey guy, reply to me with the code $sid \n"
                    ."in the subject section\n";
          $list =~ m/([^:]+)\@(.*)/;
          my $from = "$1-confirm\@$2";
          sendmail($user, "Confirm subscribe", $body, $from);
      }
}elsif($cmd eq "confirm") {
     if(not user_exist($user)) {
          syslog("$user not exist");
          if(valid_sid($user, $subj)) {
               syslog("added $user");
               add_user($user);
               my $body = "Welcome to $list :-)\n";
               sendmail($user, "Added to the list", $body);
           }else {
               syslog("fail to confirm $user");
               my $body = "Hey guy, your confirm fail, please try again\n";
               sendmail($user, "Confirm failure", $body);
           }
      }else {
          my $body = "Hey guy, you step into a wrong situation!\n";
          sendmail($user, "Wrong action", $body);
      }
}elsif($cmd eq "unsubscribe") {
     if(user_exist($user)) {
          syslog("$user removed");
          del_user($user);
          my $body = "Hey guy, you have been removed from the $list\n";
          sendmail($user, "Goodbye - from $list", $body);
      }else {
          my $body = "Hey guy, you step into a wrong situation!\n";
          sendmail($user, "Wrong action", $body);
      }
}else {
     print STDERR "m3 error cmd!\n";
     exit(13);
}

exit(0);

## funcs to handle mail list
sub sendmail {
     my($to, $subj, $body, $from) = @_;
     if(not defined $from) {
          $from = "m3\@$cfg{'hostname'}";
      }
 
     open(CMD, "| /usr/sbin/sendmail -oi -t -f \"$from\" $to") or 
         die "Can't exec /usr/sbin/sendmail, $!\n";
     print CMD <<EOF
 Return-Path: $from
 From: $from
 To: $to
 Subject: $subj
 
 $body
 EOF
 ;
     close CMD;
}

sub user_exist {
     my $user = shift;
     if (! -r "$cfg{'listdir'}/$list/users.txt") {
          return 0;
      }
 
     open(FD, "< $cfg{'listdir'}/$list/users.txt") or die "Can't open $list, $!\n";
     while(<FD>) {
          chomp;
          if(/^$user$/i) {
               return 1;
           }
      }
     close FD;
     0;
}

# gen_sid - to generate unique Session id
sub gen_sid {
     my ($sid, $len) = ("", $_[0] ? $_[0]-1 : 23);
     srand(time());
     foreach(0...$len) {
          $sid .= $KEY_MAP[int rand(61)]; # total of $#KEY_MAP -1
      }
     $sid;
}

sub valid_sid {
     my ($user, $sid) = @_;
     open(FD, "< $cfg{'listdir'}/$list/queue/$user") or
         syslog("can't open $user, $!") and die "Can't open $user, $!\n";
     $_ = <FD>;
     chomp;
     ($_) = m/[^:]+:(.*)/;
     if($sid eq $_) {
          syslog("auth ok for $user");
          return 1;
      }
     close FD;
     return 0;
}

sub add_user {
     my ($user) = @_;
     unlink "$cfg{'listdir'}/$list/queue/$user"; # clean up user cookie/queue
     open(FD, ">> $cfg{'listdir'}/$list/users.txt") or
         die "Can't append to users.txt for $list, $!\n";
     print FD $user, "\n";
     close FD;
}

sub del_user {
     my ($user) = @_;
     my $buf = undef;
 
     open(FD, "< $cfg{'listdir'}/$list/users.txt") or
         die "Can't open users.txt for $list, $!\n";
     while(<FD>) {
          chomp;
          if(!/^$user$/) {
               $buf.="$_\n";
           }
      }
     close FD;
 
     open(FD, "> $cfg{'listdir'}/$list/users.txt") or
         die "Can't write to users.txt for $list, $!\n";
     print FD $buf;
     close FD;
}

sub syslog {
     my ($msg) = @_;
     chomp $msg;
     printf $SLOG "%s $msg\n", time;
}