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.aliasesvirtual_alias_maps = hash:/etc/postfix/mml.virtual_alias_maps

mml.aliases的内容：

# alias filetest-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.comtest-confirm@hzqbbc.com          test-confirm-hzqbbc.comtest-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 v2use 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 namemy $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 STDINwhile(<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 listsub 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 idsub 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;}