~mailman-coders/mailman/2.1 : revision 1070

1

#!/usr/bin/perl

2

##

3

## Sendmail mailer for Mailman

4

##

5

## Simulates these aliases:

6

##

7

##testlist: "|/home/mailman/mail/mailman post testlist"

8

##testlist-admin: "|/home/mailman/mail/mailman admin testlist"

9

##testlist-bounces: "|/home/mailman/mail/mailman bounces testlist"

10

##testlist-confirm: "|/home/mailman/mail/mailman confirm testlist"

11

##testlist-join: "|/home/mailman/mail/mailman join testlist"

12

##testlist-leave: "|/home/mailman/mail/mailman leave testlist"

13

##testlist-owner: "|/home/mailman/mail/mailman owner testlist"

14

##testlist-request: "|/home/mailman/mail/mailman request testlist"

15

##testlist-subscribe: "|/home/mailman/mail/mailman subscribe testlist"

16

##testlist-unsubscribe: "|/home/mailman/mail/mailman unsubscribe testlist"

17

##owner-testlist: testlist-owner

18

19

#### Begin configuration here ####

20

21

$MMWRAPPER = "/usr/lib/mailman/mail/mailman";

22

$MMLISTDIR = "/var/lib/mailman/lists";

23

$SENDMAIL = "/usr/lib/sendmail -oem -oi";

24

$VERSION = '$Id: mm-handler 2.1.10 2008-04-14 00:00:00 $';

25

26

## Comment this if you offer local user addresses.

27

$NOUSERS = "\nPersonal e-mail addresses are not offered by this server.";

28

29

# set for debugging....

30

$DEBUG = 0;

31

32

# Define the set of actions you want to allow (that is, which aliases

33

# you want to emulate). This should be a subset of @ValidActions,

34

# defined below, plus the special "post" action.

35

#@ApprovedActions = qw(admin bounces confirm join leave

36

# owner request subscribe unsubscribe);

37

# aliases removed to suppress spam backscatter

38

@ApprovedActions = qw(bounces confirm owner request post);

39

40

# Allow backscatter for unapproved actions?

41

$BounceUnapproved = 0;

42

43

# Allow backscatter for undefined lists?

44

$BounceNonlist = 0;

45

46

#### End of configuration ####

47

48

49

use FileHandle;

50

use Sys::Hostname;

51

use Socket;

52

use Unix::Syslog qw(:macros);

53

use Unix::Syslog qw(:subs);

54

use File::Basename;

55

56

my $syslog_ident = basename $0;

57

my $syslog_options = LOG_PID;

58

my $syslog_facility = LOG_MAIL;

59

60

# These are the listname-action actions defined by the mailman wrapper

61

# program. Do not alter this unless a new Mailman version changes the

62

# set of supported actions.

63

@ValidActions = qw(admin bounces confirm join leave

64

owner request subscribe unsubscribe);

65

66

($VERS_STR = $VERSION) =~ s/^\$\S+\s+(\S+)(?:,v)?\s+(\S+\s+\S+\s+\S+).*/\1 \2/;

67

68

$BOUNDARY = sprintf("%08x-%d", time, time % $$);

69

70

## Informative, non-standard rejection letter

71

sub mail_error {

72

my ($in, $to, $list, $server, $reason) = @_;

73

my $sendmail;

74

75

if ($server && $server ne "") {

76

$servname = $server;

77

} else {

78

$servname = "This server";

79

$server = &get_ip_addr;

80

}

81

82

#$sendmail = new FileHandle ">/tmp/mm-$$";

83

$sendmail = new FileHandle "|$SENDMAIL $to";

84

if (!defined($sendmail)) {

85

syslog LOG_ERR, "cannot exec \"$SENDMAIL\"";

86

exit (-1);

87

}

88

89

$sendmail->print ("From: MAILER-DAEMON\@$server

90

To: $to

91

Subject: Returned mail: List unknown

92

Mime-Version: 1.0

93

Content-type: multipart/mixed; boundary=\"$BOUNDARY\"

94

Content-Disposition: inline

95

96

--$BOUNDARY

97

Content-Type: text/plain; charset=us-ascii

98

Content-Description: Error processing your mail

99

Content-Disposition: inline

100

101

Your mail for $list could not be sent:

102

$reason

103

104

For a list of publicly-advertised mailing lists hosted on this server,

105

visit this URL:

106

http://$server/

107

108

If this does not resolve your problem, you may write to:

109

postmaster\@$server

110

or

111

mailman-owner\@$server

112

113

114

$servname delivers e-mail to registered mailing lists

115

and to the administrative addresses defined and required by IETF

116

Request for Comments (RFC) 2142 [1].

117

$NOUSERS

118

119

The Internet Engineering Task Force [2] (IETF) oversees the development

120

of open standards for the Internet community, including the protocols

121

and formats employed by Internet mail systems.

122

123

For your convenience, your original mail is attached.

124

125

126

[1] Crocker, D. \"Mailbox Names for Common Services, Roles and

127

Functions\". http://www.ietf.org/rfc/rfc2142.txt

128

129

[2] http://www.ietf.org/

130

131

--$BOUNDARY

132

Content-Type: message/rfc822

133

Content-Description: Your undelivered mail

134

Content-Disposition: attachment

135

136

");

137

138

while ($_ = <$in>) {

139

$sendmail->print ($_);

140

}

141

142

$sendmail->print ("\n");

143

$sendmail->print ("--$BOUNDARY--\n");

144

145

close($sendmail);

146

}

147

148

## Get my IP address, in case my sendmail doesn't tell me my name.

149

sub get_ip_addr {

150

my $host = hostname;

151

my $ip = gethostbyname($host);

152

return inet_ntoa($ip);

153

}

154

155

## Split an address into its base list name and the appropriate command

156

## for the relevant function.

157

sub split_addr {

158

my ($addr) = @_;

159

my ($list, $cmd);

160

161

if ($addr =~ /(.*)-([^-]+)\+.*$/) {

162

$list = $1;

163

$cmd = "$2";

164

} elsif ($addr =~ /(.*)-([^-]+)$/) {

165

$list = $1;

166

$cmd = $2;

167

}

168

else {

169

return ($addr, "post");

170

}

171

if ($list eq "owner") {

172

# Allow owner-listname to work as listname-owner

173

$list = $cmd;

174

$cmd = "owner";

175

} elsif (! grep /^$cmd$/, @ValidActions) {

176

# If an undefined action, restore list name

177

$list = $addr;

178

$cmd = "post";

179

}

180

## Otherwise use $list and $cmd as already assigned

181

182

return ($list, $cmd);

183

}

184

185

## Determine whether a list is defined in Mailman.

186

sub list_exists {

187

my ($name) = @_;

188

189

return 1 if (-f "$MMLISTDIR/$list/config.pck");

190

return 1 if (-f "$MMLISTDIR/$list/config.db");

191

return 0;

192

}

193

194

## The time, formatted as for an mbox's "From_" line.

195

sub mboxdate {

196

my ($time) = @_;

197

my @days = qw(Sun Mon Tue Wed Thu Fri Sat);

198

my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

199

my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =

200

localtime($time);

201

202

## Two-digit year handling complies with RFC 2822 (section 4.3),

203

## with the addition that three-digit years are accommodated.

204

if ($year < 50) {

205

$year += 2000;

206

} elsif ($year < 1900) {

207

$year += 1900;

208

}

209

210

return sprintf ("%s %s %2d %02d:%02d:%02d %d",

211

$days[$wday], $months[$mon], $mday,

212

$hour, $min, $sec, $year);

213

}

214

215

BEGIN: {

216

openlog $syslog_ident, $syslog_options, $syslog_facility;

217

$sender = undef;

218

$server = undef;

219

@to = ();

220

while ($#ARGV >= 0) {

221

if ($ARGV[0] eq "-r") {

222

$sender = $ARGV[1];

223

shift @ARGV;

224

} elsif (!defined($server)) {

225

$server = $ARGV[0];

226

} else {

227

push(@to, $ARGV[0]);

228

}

229

shift @ARGV;

230

}

231

232

if ($DEBUG) {

233

my $to = join(',', @to);

234

syslog LOG_INFO, "to: $to; sender: $sender; server: $server";

235

}

236

237

ADDR: for $addr (@to) {

238

$prev = undef;

239

$list = $addr;

240

241

$was_to = $addr;

242

$was_to .= "\@$server" if ("$server" ne "");

243

244

$cmd= "post";

245

($list, $cmd) = &split_addr($list);

246

if ($DEBUG) {

247

syslog LOG_INFO, "list: $list; cmd: $cmd";

248

}

249

if (! &list_exists($list)) {

250

syslog LOG_INFO, "no list named \"$list\" is known by $server";

251

if ($BounceNonlist) {

252

mail_error(\*STDIN, $sender, $was_to, $server,

253

"no list named \"$list\" is known by $server");

254

}

255

next ADDR;

256

}

257

258

if (! grep /^$cmd$/, @ApprovedActions) {

259

syslog LOG_INFO, "$cmd is not a recognized action for $list";

260

if ($BounceUnapproved) {

261

mail_error(\*STDIN, $sender, $was_to, $server,

262

"$cmd is not a recognized action for $list");

263

}

264

next ADDR;

265

}

266

267

if ($DEBUG) {

268

syslog LOG_INFO, "invoking $MMWRAPPER";

269

}

270

$wrapper = new FileHandle "|$MMWRAPPER $cmd $list";

271

if (!defined($wrapper)) {

272

## Defer?

273

syslog LOG_ERR, "cannot exec ",

274

"\"$MMWRAPPER $cmd $list\": deferring";

275

exit (-1);

276

}

277

278

# Don't need these without the "n" flag on the mailer def....

279

#$date = &mboxdate(time);

280

#$wrapper->print ("From $sender $date\n");

281

282

# ...because we use these instead.

283

$from_ = <STDIN>;

284

$wrapper->print ($from_);

285

286

$wrapper->print ("X-Mailman-Handler: $VERSION\n");

287

while (<STDIN>) {

288

$wrapper->print ($_);

289

}

290

close($wrapper);

291

if ($DEBUG) {

292

syslog LOG_INFO, "message processed";

293

}

294

}

295

}