注： 本文本来是一早要写的，可是程序写了有段时间了，最近一段时间又很忙，居然给忘了，现在补上。
正文
大部分IT人员都使用过邮件列表，或者类似的服务，但邮件列表的内部工作原理则不是简单的订阅，退订阅那么简单。最近根据自己的一些认识，用perl实现了一个非常简单的MLM程序，也顺便谈谈邮件列表的最基本工作原理。
邮件列表，简单的来说，就是任一列表成员向该列表发的邮件，其他所有人（可以包括他自己）都能收到，并且每个人能自由订阅、退订。更丰富的邮件列表还包括了摘要，精确权限管理，web archive功能等等。
著名的开源邮件列表软件如mailman, majodomo, ezmlm, sympa, ecartis等都是功能完备的邮件列表软件，但归根结底，最简单的邮件列表至少应该包含如下功能：
订阅功能，即用户发特定订阅信件到邮件列表 确认订阅功能，即用户必须给MLM发确认信才能正式订阅 退订功能，用户可自由退出订阅服务。 任一列表成员给邮件列表发的邮件，其他人都应收到。 要实现上述的功能，如果使用perl的话并不复杂，配合Postfix MTA可以非常方便的开发出简易的邮件列表软件。以下是自己开发的MMList(Mini Mailing List) 的基本结构：
配置基于Postfix，使用alias的方法，将邮件通过管道送到MMList： 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 # 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() { 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 close CMD;}sub user_exist { my $user = shift; if (! -r "$cfg{'listdir'}/$list/users.txt") { return 0; } open(FD, "or die "Can't open $list, $!\n"; while() { 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, "or syslog("can't open $user, $!") and die "Can't open $user, $!\n"; $_ = ; 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, "or die "Can't open users.txt for $list, $!\n"; while() { 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;}
