File: vixie.pl

package info (click to toggle)
newsgate 1.6-9
  • links: PTS
  • area: non-free
  • in suites: hamm
  • size: 332 kB
  • ctags: 310
  • sloc: ansic: 2,683; yacc: 499; sh: 278; lex: 183; perl: 151; makefile: 113
file content (218 lines) | stat: -rw-r--r-- 5,123 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
From vixie@pa.dec.com Thu Jul 23 18:17:39 1992
Received: from relay2.UU.NET by rodan.UU.NET with SMTP 
	(5.61/UUNET-mail-drop) id AA14854; Thu, 23 Jul 92 18:17:30 -0400
Received: from inet-gw-2.pa.dec.com by relay2.UU.NET with SMTP 
	(5.61/UUNET-internet-primary) id AA06917; Thu, 23 Jul 92 18:17:37 -0400
Received: by inet-gw-2.pa.dec.com; id AA25454; Thu, 23 Jul 92 15:17:29 -0700
Received: by usenet.pa.dec.com; id AA02987; Thu, 23 Jul 92 15:17:28 -0700
Date: Thu, 23 Jul 92 15:17:28 -0700
From: vixie@pa.dec.com (Paul Vixie)
Message-Id: <9207232217.AA02987@usenet.pa.dec.com>
To: rsalz@uunet.UU.NET
Subject: well then here's my code - use it, abuse it, or lose it; whatever
Status: RO

#! /usr/bin/perl

# mailpost - yet another mail-to-news filter
# vixie 30jun92 [added -a and -d]
# vixie 17jun92 [attempt simple-minded fixup to $path]
# vixie 14jun92 [original]

#
# $Submit is a program which takes no arguments and whose stdin is supposed
# to be a news article (without the #!rnews header but with the news hdr).
#

$Submit = '/usr/lib/newsbin/input/rnews';

#
# the name we qualify sender addresses with is either the "mailname" from
# the news transport, or the /bin/hostname.
#
if (-r '/usr/lib/news/mailname') {
	chop($Mailname = `cat /usr/lib/news/mailname`);
} else {
	chop($Mailname = `/bin/hostname`);
}

#
# our command-line argument(s) are the list of newsgroups to post to.
#
# there may be a "-r sender" or "-f sender" which becomes the $path
# (which is in turn overridden below by various optional headers.)
#
# -d (distribution) and -a (approved) are also supported to supply
# or override the mail headers by those names.
#

$path = 'nobody';
$newsgroups = undef;
$approved = undef;
$distribution = undef;
while ($#ARGV != -1) {
	$_ = shift(@ARGV);
	if (/^\-[rf]$/) {
		$path = shift(@ARGV);
		print STDERR "((path: $path))\n";
		next;
	}
	if (/^\-a$/) {
		$approved = &fix_sender_addr(shift(@ARGV));
		print STDERR "((approved: $approved))\n";
		next;
	}
	if (/^\-d$/) {
		$distribution = shift(@ARGV);
		print STDERR "((distribution: $distribution))\n";
		next;
	}
	$newsgroups .= ',' if $newsgroups;
	$newsgroups .= $_;
}
die "usage:  $0 newsgroup [newsgroup]\n" unless $newsgroups;

#
# do the header.  our input is a mail message, with or without the From_
#

$real_news_hdrs = '';
$weird_mail_hdrs = '';
$from = undef;
$date = undef;

$_ = <STDIN>;
die "empty input" unless $_;
chop $_;
$prefetch = undef;
if (/^From\s+([^\s]+)\s+/) {
	$path = $1;
	print STDERR "((path: $path))\n";
	$_ = $';
	if (/ remote from /) {
		$path = $'.'!'.$path;
		$_ = $`;
	}
	$date = $_;
} else {
	$prefetch = $_;
}

for (;;) {
	# XXX - ick.  we should be dealing with multiline headers here.
	if ($prefetch) {
		$_ = $prefetch;
		$prefetch = undef;
	} else {
		$_ = <STDIN>;
		last unless $_;			# EOF?  (no chop yet)
		chop $_;
	}
	print STDERR "($_)\n";
	last unless $_;			# end-of-header (already chopped)

	next if (/^Approved:\s/io     && defined($approved));
	next if (/^Distribution:\s/io && defined($distribution));

	if (/^(Message-Id|Subject|Organization|Distribution):\s*/io) {
		$real_news_hdrs .= "$_\n";
		next;
	}
	if (/^(Sender|Reply-To|Approved):\s*/io) {
		$real_news_hdrs .= "$`$&".&fix_sender_addr($')."\n";
		next;
	}
	if (/^Return-Path:\s*/io) {
		$path = $';
		$path = $1 if ($path =~ /\<([^\>]*)\>/);
		print "((path: $path))\n";
		next;
	}
	if (/^Date:\s*/io) {
		$date = $';
		next;
	}
	if (/^From:\s*/io) {
		$from = &fix_sender_addr($');
		next;
	}
	# random unknown header.  prepend 'X-' if it's not already there.
	$_ = "X-$_" unless (/^X-/io);
	$weird_mail_hdrs .= "$_\n";
}

die "no From: found" unless $from;
die "no Date: found" unless $date;
if ($path !~ /\!/) {
	$path = "$'!$`" if ($path =~ /\@/);
}

$real_news_hdrs .= "Approved: ${approved}\n"         if defined($approved);
$real_news_hdrs .= "Distribution: ${distribution}\n" if defined($distribution);

open(STDOUT, "|$Submit") || die "$Submit: $!";

print <<"EOF";
Newsgroups: ${newsgroups}
Path: ${path}
From: ${from}
${real_news_hdrs}Date: ${date}
${weird_mail_hdrs}
EOF

#
# do the body.  we already wrote the blank line.
#

print <STDIN>;

#
# that's all, folks.
#

close(STDOUT);
exit 0;

#
# take 822-format name (either "comment <addr> comment" or "addr (comment)")
# and return in always-qualified 974-format ("addr (comment)").
#
sub fix_sender_addr {
	local($_) = @_;
	local($lcomment, $addr, $rcomment);

	if (/\<([^\>]*)\>/) {
		($lcomment, $addr, $rcomment) =
			(&dltb($`), &dltb($1), &dltb($'));
	} elsif (/\(([^\)]*)\)/) {
		($lcomment, $addr, $rcomment) =
			('', &dltb($`.$'), &dltb($1));
	} else {
		($lcomment, $addr, $rcomment) =
			('', &dltb($_), '');
	}
	print STDERR "fix_sender_addr($_) == ($lcomment, $addr, $rcomment)\n";
	$addr .= "@$Mailname" unless ($addr =~ /\@/);
	if ($lcomment && $rcomment) {
		$comment = $lcomment.' '.$rcomment;
	} else {
		$comment = $lcomment.$rcomment;
	}
	$_ = $addr;
	$_ .= " ($comment)" if length($comment);
	print STDERR "\t-> $_\n";
	return $_;
}

#
# delete leading and trailing blanks
#

sub dltb {
	local($_) = @_;

	s/^\s+//;
	s/\s+$//;
	return $_;
}