modules/og2list/mail-in.pl

#!/usr/bin/perl -w

# $Id: mail-in.pl,v 1.32 2006/11/15 20:31:21 killes Exp $

# THIS IS PROTOTYPE CODE AND SHOULD NOT BE USED IN PRODUCTION SYSTEMS!

# To quickly read the Perldoc below on a Unix system, use
#
# $ pod2man mail-in.pl | man -l -

=pod

=head1 NAME

mail-in.pl - incoming mail handler for og2list.module

=head1 Synopsis

C<mail-in.pl [-d] -f sender -t recipient>

=head1 Description

mail-in.pl expects a mail message conforming to RfC 2822 and possibly
containing one or more MIME parts conforming to RfC 2046ff. to be fed
to its standard input. In the default mode of operation, it is
intended to be run from a mail transfer agent.

Both sender and recipient parameters are mandatory.

If the -d ("debug") switch is set, the processed message body, along
with some pseudo headers, is printed to standard output, instead of
being queued. It is UTF-8 encoded, so non-ASCII will only show
correctly on terminals that have their character encoding set to
UTF-8.

=head1 TODO's, incorrectly/incompletely implemented issues

=over

=item Determining sender and recipient(s) from headers that might
have been inserted by MTA

=back

=head1 Integration into MTA setup (Exim 4.x)

=over

=item Global

The global section of Exim's configuration file is the place to define
variables and installation-specific parameters such as the SQL
location below.

See Section 9.21 of the Exim specification for details.

The user/group ID and the home directory need not match any other user
account on the system, in particular not the webserver's or the web
application's user. mail-in.pl only needs to access its configuration
file and the og2list_* tables in the SQL database for which the
credentials are stored in the configuration file.

  OG2LIST_HOME = /home/og2list
  OG2LIST_UID  = og2list
  OG2LIST_GID  = og2list

  hide mysql_servers = localhost/drupal/dbuser/dbpass

=item Router

Routers are rules that determine how a destination address should be
handled. The following piece of code assigns addresses to a transport
rule called og2list_transport which is defined below.

Note that the since Routers are evaluated one after anotehr, their
order in the configuration file will most likely affect overall
behavior.

See section 3.8 of the Exim specification for details.

  og2list:
    debug_print "R: og2list from $return_path \
      for $local_part@$domain"
    driver = accept
    transport = og2list_transport
    condition = ${lookup mysql{SELECT 1 FROM og2list_groups \
                               WHERE recipient \
                               LIKE '$local_part'} \
                         {$value} \
                         fail}

If Exim has been built without MySQL support, the following condition
statement should work:

    condition = ${run{/path/to/valid-recipient.pl $local_part@$domain}{1}{0}}

It is possible to use the "domains" statement to restrict the domains
for which the og2list is actually tried (see Exim specification,
chapter 15 for details).

"abuse"(RfC2142), "postmaster"(RfC2821) and other essential local
parts should be handled by a router which precedes the og2list router.
The system_aliases router that is part of Exim's default configuration
file is a good place for this.

=item Transport

Transports are the rules that determine by what means a message should
be delivered that has been assigned to this transport by a router.

  og2list_transport:
    debug_print "T: og2list_transport from \
      $return_path for $local_part@$domain"
    driver = pipe
    freeze_exec_fail
    log_output
    command = OG2LIST_HOME/mail-in.pl \
      -f $return_path -t $local_part@$domain
    current_directory = OG2LIST_HOME
    user = OG2LIST_UID
    group = OG2LIST_GID

=back

=head1 Integration into MTA setup (Postfix 2.x)

Integrating the mail-in.pl into Postfix is best done via a 'transport'.
You will need to dedicate a complete domain or subdomain for that purpose.
Think of it as a special purpose domain like lists.workaround.org where
all accounts have a special meaning. The domain might well be a subdomain
of another domain.

=item main.cf

The '/etc/postfix/main.cf' is Postfix' main configuration file. First you
need to define the domain (as mentioned above) here as a relay domain:

  relay_domains = drupal.workaround.org

If you already have relay domains configured here then just add the domain.

=item transport

As written initially the mail-in.pl will be used as a 'transport'. Transports
are defined in '/etc/postfix/transport'. Just add this line forwarding the
domain to the 'drupal:' service:

  drupal.workaround.org drupal:

It's strongly recommended that you also add these two lines:

  abuse@drupal.workaround.org local:
  postmaster@drupal.workaround.org local:

These forward all mails to the given email addresses to the aliases
'abuse' and 'postmaster' that you probably already have set up in your
'/etc/aliases' file. Every domain needs to have a person reading those
two accounts to deal with technical mail problems or spamming attacks.

Then usually you "hash" these files. Try 'postconf transport_maps' and see
if the result looks like 'hash:/etc/postfix/transport'. After changing
the '/etc/postfix/transport' file run 'postmap /etc/postfix/transport'
and the file '/etc/postfix/transport.db' will be updated.

=item master.cf

Now that you told Postfix to send all mails for your special domain to
the 'drupal:' transport you finally need to define this transport.
Add the following lines to your '/etc/postfix/master.cf' file:

  drupal  unix  -       n       n       -       -       pipe
    flags=DRhu user=www-data argv=/path/modules/og/og2list/mail-in.pl \
		-f ${sender} -t ${recipient}

(Note: the first line needs to start at column 0 in your configuration file.
Indent the next line by whitespace.)

=item Restart Postfix

Finally restart the Postfix service ('postfix reload') and try a
'postfix check' to see whether you made any major mistakes. No output
means that everything is well.

=item Try it

After you created a group in drupal you should be able to send mail to the
alias you defined. Sending a mail to testgroup@drupal.workaround.org should
create a log entry like this in your /var/log/mail.log (or wherever your
syslog daemon writes the mail logs to):

Apr 21 22:12:51 torf postfix/pipe[17969]: 99462FFF2:
  to=<testgroup@drupal.workaround.org>, relay=drupal, delay=1,
	status=sent (drupal.workaround.org)

=head1 Unfinished work, TODO's

=item Distinguish between temporary and fatal error return codes

=item ...

=head1 License

mail-in.pl, mail handler that accepts one mail from STDIN and queues
it to be processed by the og2list Drupal module.

Copyright (C) 2006 Hilko Bengen

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA

=cut

use strict;

use FindBin;
use Mail::Verp;
use Email::Address;
use MIME::Parser;
use MIME::Words qw(decode_mimewords);
use DBI;
use Getopt::Std;
use Encode qw(decode);

use File::Basename 'basename';

use vars qw(
	    $dsn $dbh

	    $parser $entity

	    $add_content_stmt $add_content_handle
	    $add_group_stmt $add_group_handle
	    $add_threadinfo_stmt $add_threadinfo_handle
	    $add_dsn_stmt $add_dsn_handle

	    $add_attachment_stmt $add_attachment_handle

	    $dbtype $dbuser $dbauth $dbhost $dbase
	    $mail_domain
	    $sendmail_binary @sendmail_args

	    $envelope_from $envelope_to
	    $from_name $from_address
	    $to_name $to_address

	    $head
	    $subject $msgid $content_type $body

	    %opts
	    @references
	    %attachments
	   );

sub simplify_body($);

# ----------------------------------------------------------------------

# Default values
$mail_domain = "localhost";

Mail::Verp->separator('+');

$dbtype = "mysql";
$dbase  = "";
$dbhost = "localhost";
$dbuser = "";
$dbauth = "";

do "$FindBin::Bin/mail.conf";

# ----------------------------------------------------------------------

$add_content_stmt = <<EOF;
INSERT INTO og2list_incoming_content
(from_address,from_name,subject,msgid,content_type,body)
VALUES (?,?,?,?,?,?);
EOF

$add_group_stmt = <<EOF;
INSERT INTO og2list_incoming_groups
SET mid=(SELECT mid FROM og2list_incoming_content
         WHERE msgid=?), oid=(SELECT nid FROM og2list_groups
                              WHERE recipient=SUBSTRING_INDEX(?, '\@', 1));
EOF

$add_threadinfo_stmt = <<EOF;
INSERT INTO og2list_references
(msgid, reference)
VALUES (?,?);
EOF

$add_dsn_stmt = <<EOF;
UPDATE og2list_outgoing_recipients
SET status = 5
WHERE (mid = ?) AND (recipient_address = ?)
EOF

$add_attachment_stmt = <<EOF;
INSERT INTO og2list_attachment
(mid, filename, content_type, payload, disposition)
VALUES ((SELECT mid FROM og2list_incoming_content
         WHERE msgid=?), ?, ?, ?, ?);
EOF

# ----------------------------------------------------------------------

getopts('dt:f:', \%opts);

$envelope_from = ($opts{'f'} or '');
$envelope_to = ($opts{'t'} or '');

# --------------------
# Try to parse message

$parser = new MIME::Parser;
$parser->output_to_core(1);
$entity = $parser->parse(\*STDIN) or die;
$head = $entity->head;
$head->unfold;

# Pick the first name and address of the first From and To headers, respectively
($from_name, $from_address) = do {
  my @address =
    Email::Address->parse($head->get("From",0));
  ($address[0]->name, $address[0]->address);
};
($to_name, $to_address) = do {
  my @address =
    Email::Address->parse($head->get("To",0));
  ($address[0]->name, $address[0]->address);
};

# Decode subject according to RfC1522/2045, using MIME::Words
foreach (decode_mimewords($head->get("Subject",0))) {
  $subject.=($$_[1]?decode($$_[1], $$_[0]) : $$_[0]);
}

# We make up our own Message-ID header if we don't find one.
$msgid = ( $head->get("Message-ID",0) or
	  ('<'. time() .'.'. int(rand(1000000)) .'@'. $mail_domain .'>'));

chomp $subject; utf8::upgrade($subject);
chomp $msgid;

# -------------------------------------------
# Simplify structure returned by MIME::Parser

($content_type,$body)=simplify_body($entity);

unless (defined $content_type && $content_type =~ /^text\/(plain|html)/) {
  $content_type = 'text/plain';
  $body = "Failed to convert the message $msgid to a meaningful format";
}

@references = split(/\s+/, ( $head->get('References') or
			     $head->get('In-Reply-To') or
			     '' ));

# Setup connection to database if not in debugging mode
unless ($opts{'d'}) {
  $dsn = "DBI:$dbtype:$dbase:$dbhost";
  $dbh = DBI->connect($dsn, $dbuser, $dbauth) or die;
  
  # Work around charset encoding confusion.
  if ($dbtype eq 'mysql') { $dbh->do('SET NAMES utf8'); }
}

if ($envelope_from eq '') {
  # VERP handling
  if ($opts{'d'}) {
    print "Handling bounce for (possible) member ".
      Mail::Verp->decode($envelope_to)."\n";
  } else {
    # Set up queries
    $add_dsn_handle = $dbh->prepare($add_dsn_stmt) or die;

    (my $failed_rcpt,undef) = Mail::Verp->decode($envelope_to);

    $add_dsn_handle->execute($msgid, $failed_rcpt);
  }
  exit 0;
} else {
  if ($opts{'d'}) {
    binmode(STDOUT, ':utf8');
    print <<EOF;
X-Envelope-From: $envelope_from
X-Envelope-To: $envelope_to
From: \"$from_name\" <$from_address>
To: \"$to_name\" <$to_address>
Subject: $subject
Message-Id: $msgid
Content-Type: $content_type
EOF
    print "References: ".join(', ', @references)."\n";
    print "\n$body";
  } else {
    # Set up queries
    $add_content_handle = $dbh->prepare($add_content_stmt) or die;
    $add_threadinfo_handle = $dbh->prepare($add_threadinfo_stmt) or die;
    $add_group_handle = $dbh->prepare($add_group_stmt) or die;

    $add_attachment_handle = $dbh->prepare($add_attachment_stmt) or die;

    $add_content_handle->execute($from_address,
				 $from_name,
				 $subject,
				 $msgid,
				 $content_type,
				 $body);
    $add_group_handle->execute($msgid, $envelope_to);

    foreach (keys %attachments) {
       my %attch = %{$attachments{$_}};

       $add_attachment_handle->execute($msgid,
                                       $attch{'name'},
                                       $attch{'type'},
                                       $attch{'content'},
                                       $attch{'disp'});
    }

    foreach (@references) {
      $add_threadinfo_handle->execute($msgid, $_);
    }
  }
}

# ----------------------------------------------------------------------
sub save_attachment(@) {
  my $entity = shift;
  my $name = $entity->head()->recommended_filename;
  my $type = $entity->effective_type;
  my $disp = $entity->head()->get('Content-Disposition');

  my $filename = basename $name;

  my $maxLen = 16777216; # size of MEDIUMBLOB

  ${$attachments{$filename}}{'name'} = $filename;
  ${$attachments{$filename}}{'type'} = $type;
  ${$attachments{$filename}}{'disp'} = $disp;

  if(my $bh = $entity->bodyhandle) {
    my $io = $bh->open("r");

    ${$attachments{$filename}}{'length'} =
        $io->read(${$attachments{$filename}}{'content'}, $maxLen);

    $io->close;
  }

  if ($opts{'d'}) {
    my $attachment = File::Spec->catfile('/tmp', $filename);

    unless( -f $attachment ) {
        open( FH, ">$attachment");
        print FH ${$attachments{$filename}}{'content'};
        close(FH);
    }
  }
}

# ----------------------------------------------------------------------

sub simplify_body($) {
  my $entity = shift;
  my $body;

  foreach ($entity->mime_type) {
    chomp;

    # Simple text/plain or tex/html messge
    m/^text\/(plain|html)$/ && do {
      my $charset = ($entity->head()->mime_attr('content-type.charset') or
		     'US-ASCII');
      $body = decode($charset, $entity->bodyhandle()->as_string);
      utf8::upgrade($body);
      return $entity->mime_type(), $body;
    };

    # Typical case: alternative encodings
    m/^multipart\/alternative$/ && do {
      my $type;
      my %alternative;
      # Collect only the first of each type.
      foreach my $part ($entity->parts) {
	($type, $body) = simplify_body($part);
	if ($type =~ /^text/) {
	  next if (exists $alternative{$type});
	  $alternative{$type}=$body;
        }
      }
      if ($alternative{'text/html'}) {
	return 'text/html', $alternative{'text/html'};
      } elsif ($alternative{'text/plain'}) {
	return 'text/plain', $alternative{'text/plain'};
      } else {
	return undef;
      }
    };

    # Mail with attachment(s) (e.g. OE HTML mail with embedded image...)
    # OR
    # S/MIME signed mail
    m/^multipart\/(related|mixed|parallel|signed)$/ && do {
      my $type;
      my %alternative;
      # Concatenate parts of same type
      foreach my $part ($entity->parts) {
	($type, $body) = simplify_body($part);
	if ($type =~ /^text/) {
	  $alternative{$type}.=$body;
	}
        else {
            # For all non-text based components
            # store the attachments for use by
            # mail-out
            save_attachment( $part );
        }
      }
      if ($alternative{'text/html'}) {
	return 'text/html', $alternative{'text/html'};
      } elsif ($alternative{'text/plain'}) {
	return 'text/plain', $alternative{'text/plain'};
      } else {
	return undef;
      }
    };

    # RfC 2046, Section 5.1.5
    m/^multipart\/digest$/ && do {
    };

    # RfC 2046, Section 5.1.7
    m/^multipart\/(.*)$/ && do {
    };
  }
  return undef;
}

# Local Variables:
# mode:cperl
# End:
1	#!/usr/bin/perl -w
2
3	# $Id: mail-in.pl,v 1.32 2006/11/15 20:31:21 killes Exp $
4
5	# THIS IS PROTOTYPE CODE AND SHOULD NOT BE USED IN PRODUCTION SYSTEMS!
6
7	# To quickly read the Perldoc below on a Unix system, use
8	#
9	# $ pod2man mail-in.pl \| man -l -
10
11	=pod
12
13	=head1 NAME
14
15	mail-in.pl - incoming mail handler for og2list.module
16
17	=head1 Synopsis
18
19	C<mail-in.pl [-d] -f sender -t recipient>
20
21	=head1 Description
22
23	mail-in.pl expects a mail message conforming to RfC 2822 and possibly
24	containing one or more MIME parts conforming to RfC 2046ff. to be fed
25	to its standard input. In the default mode of operation, it is
26	intended to be run from a mail transfer agent.
27
28	Both sender and recipient parameters are mandatory.
29
30	If the -d ("debug") switch is set, the processed message body, along
31	with some pseudo headers, is printed to standard output, instead of
32	being queued. It is UTF-8 encoded, so non-ASCII will only show
33	correctly on terminals that have their character encoding set to
34	UTF-8.
35
36	=head1 TODO's, incorrectly/incompletely implemented issues
37
38	=over
39
40	=item Determining sender and recipient(s) from headers that might
41	have been inserted by MTA
42
43	=back
44
45	=head1 Integration into MTA setup (Exim 4.x)
46
47	=over
48
49	=item Global
50
51	The global section of Exim's configuration file is the place to define
52	variables and installation-specific parameters such as the SQL
53	location below.
54
55	See Section 9.21 of the Exim specification for details.
56
57	The user/group ID and the home directory need not match any other user
58	account on the system, in particular not the webserver's or the web
59	application's user. mail-in.pl only needs to access its configuration
60	file and the og2list_* tables in the SQL database for which the
61	credentials are stored in the configuration file.
62
63	OG2LIST_HOME = /home/og2list
64	OG2LIST_UID = og2list
65	OG2LIST_GID = og2list
66
67	hide mysql_servers = localhost/drupal/dbuser/dbpass
68
69	=item Router
70
71	Routers are rules that determine how a destination address should be
72	handled. The following piece of code assigns addresses to a transport
73	rule called og2list_transport which is defined below.
74
75	Note that the since Routers are evaluated one after anotehr, their
76	order in the configuration file will most likely affect overall
77	behavior.
78
79	See section 3.8 of the Exim specification for details.
80
81	og2list:
82	debug_print "R: og2list from $return_path \
83	for $local_part@$domain"
84	driver = accept
85	transport = og2list_transport
86	condition = ${lookup mysql{SELECT 1 FROM og2list_groups \
87	WHERE recipient \
88	LIKE '$local_part'} \
89	{$value} \
90	fail}
91
92	If Exim has been built without MySQL support, the following condition
93	statement should work:
94
95	condition = ${run{/path/to/valid-recipient.pl $local_part@$domain}{1}{0}}
96
97	It is possible to use the "domains" statement to restrict the domains
98	for which the og2list is actually tried (see Exim specification,
99	chapter 15 for details).
100
101	"abuse"(RfC2142), "postmaster"(RfC2821) and other essential local
102	parts should be handled by a router which precedes the og2list router.
103	The system_aliases router that is part of Exim's default configuration
104	file is a good place for this.
105
106	=item Transport
107
108	Transports are the rules that determine by what means a message should
109	be delivered that has been assigned to this transport by a router.
110
111	og2list_transport:
112	debug_print "T: og2list_transport from \
113	$return_path for $local_part@$domain"
114	driver = pipe
115	freeze_exec_fail
116	log_output
117	command = OG2LIST_HOME/mail-in.pl \
118	-f $return_path -t $local_part@$domain
119	current_directory = OG2LIST_HOME
120	user = OG2LIST_UID
121	group = OG2LIST_GID
122
123	=back
124
125	=head1 Integration into MTA setup (Postfix 2.x)
126
127	Integrating the mail-in.pl into Postfix is best done via a 'transport'.
128	You will need to dedicate a complete domain or subdomain for that purpose.
129	Think of it as a special purpose domain like lists.workaround.org where
130	all accounts have a special meaning. The domain might well be a subdomain
131	of another domain.
132
133	=item main.cf
134
135	The '/etc/postfix/main.cf' is Postfix' main configuration file. First you
136	need to define the domain (as mentioned above) here as a relay domain:
137
138	relay_domains = drupal.workaround.org
139
140	If you already have relay domains configured here then just add the domain.
141
142	=item transport
143
144	As written initially the mail-in.pl will be used as a 'transport'. Transports
145	are defined in '/etc/postfix/transport'. Just add this line forwarding the
146	domain to the 'drupal:' service:
147
148	drupal.workaround.org drupal:
149
150	It's strongly recommended that you also add these two lines:
151
152	abuse@drupal.workaround.org local:
153	postmaster@drupal.workaround.org local:
154
155	These forward all mails to the given email addresses to the aliases
156	'abuse' and 'postmaster' that you probably already have set up in your
157	'/etc/aliases' file. Every domain needs to have a person reading those
158	two accounts to deal with technical mail problems or spamming attacks.
159
160	Then usually you "hash" these files. Try 'postconf transport_maps' and see
161	if the result looks like 'hash:/etc/postfix/transport'. After changing
162	the '/etc/postfix/transport' file run 'postmap /etc/postfix/transport'
163	and the file '/etc/postfix/transport.db' will be updated.
164
165	=item master.cf
166
167	Now that you told Postfix to send all mails for your special domain to
168	the 'drupal:' transport you finally need to define this transport.
169	Add the following lines to your '/etc/postfix/master.cf' file:
170
171	drupal unix - n n - - pipe
172	flags=DRhu user=www-data argv=/path/modules/og/og2list/mail-in.pl \
173	-f ${sender} -t ${recipient}
174
175	(Note: the first line needs to start at column 0 in your configuration file.
176	Indent the next line by whitespace.)
177
178	=item Restart Postfix
179
180	Finally restart the Postfix service ('postfix reload') and try a
181	'postfix check' to see whether you made any major mistakes. No output
182	means that everything is well.
183
184	=item Try it
185
186	After you created a group in drupal you should be able to send mail to the
187	alias you defined. Sending a mail to testgroup@drupal.workaround.org should
188	create a log entry like this in your /var/log/mail.log (or wherever your
189	syslog daemon writes the mail logs to):
190
191	Apr 21 22:12:51 torf postfix/pipe[17969]: 99462FFF2:
192	to=<testgroup@drupal.workaround.org>, relay=drupal, delay=1,
193	status=sent (drupal.workaround.org)
194
195	=head1 Unfinished work, TODO's
196
197	=item Distinguish between temporary and fatal error return codes
198
199	=item ...
200
201	=head1 License
202
203	mail-in.pl, mail handler that accepts one mail from STDIN and queues
204	it to be processed by the og2list Drupal module.
205
206	Copyright (C) 2006 Hilko Bengen
207
208	This program is free software; you can redistribute it and/or modify
209	it under the terms of the GNU General Public License as published by
210	the Free Software Foundation; either version 2 of the License, or
211	(at your option) any later version.
212
213	This program is distributed in the hope that it will be useful,
214	but WITHOUT ANY WARRANTY; without even the implied warranty of
215	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
216	GNU General Public License for more details.
217
218	You should have received a copy of the GNU General Public License
219	along with this program; if not, write to the Free Software
220	Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
221
222	=cut
223
224	use strict;
225
226	use FindBin;
227	use Mail::Verp;
228	use Email::Address;
229	use MIME::Parser;
230	use MIME::Words qw(decode_mimewords);
231	use DBI;
232	use Getopt::Std;
233	use Encode qw(decode);
234
235	use File::Basename 'basename';
236
237	use vars qw(
238	$dsn $dbh
239
240	$parser $entity
241
242	$add_content_stmt $add_content_handle
243	$add_group_stmt $add_group_handle
244	$add_threadinfo_stmt $add_threadinfo_handle
245	$add_dsn_stmt $add_dsn_handle
246
247	$add_attachment_stmt $add_attachment_handle
248
249	$dbtype $dbuser $dbauth $dbhost $dbase
250	$mail_domain
251	$sendmail_binary @sendmail_args
252
253	$envelope_from $envelope_to
254	$from_name $from_address
255	$to_name $to_address
256
257	$head
258	$subject $msgid $content_type $body
259
260	%opts
261	@references
262	%attachments
263	);
264
265	sub simplify_body($);
266
267	# ----------------------------------------------------------------------
268
269	# Default values
270	$mail_domain = "localhost";
271
272	Mail::Verp->separator('+');
273
274	$dbtype = "mysql";
275	$dbase = "";
276	$dbhost = "localhost";
277	$dbuser = "";
278	$dbauth = "";
279
280	do "$FindBin::Bin/mail.conf";
281
282	# ----------------------------------------------------------------------
283
284	$add_content_stmt = <<EOF;
285	INSERT INTO og2list_incoming_content
286	(from_address,from_name,subject,msgid,content_type,body)
287	VALUES (?,?,?,?,?,?);
288	EOF
289
290	$add_group_stmt = <<EOF;
291	INSERT INTO og2list_incoming_groups
292	SET mid=(SELECT mid FROM og2list_incoming_content
293	WHERE msgid=?), oid=(SELECT nid FROM og2list_groups
294	WHERE recipient=SUBSTRING_INDEX(?, '\@', 1));
295	EOF
296
297	$add_threadinfo_stmt = <<EOF;
298	INSERT INTO og2list_references
299	(msgid, reference)
300	VALUES (?,?);
301	EOF
302
303	$add_dsn_stmt = <<EOF;
304	UPDATE og2list_outgoing_recipients
305	SET status = 5
306	WHERE (mid = ?) AND (recipient_address = ?)
307	EOF
308
309	$add_attachment_stmt = <<EOF;
310	INSERT INTO og2list_attachment
311	(mid, filename, content_type, payload, disposition)
312	VALUES ((SELECT mid FROM og2list_incoming_content
313	WHERE msgid=?), ?, ?, ?, ?);
314	EOF
315
316	# ----------------------------------------------------------------------
317
318	getopts('dt:f:', \%opts);
319
320	$envelope_from = ($opts{'f'} or '');
321	$envelope_to = ($opts{'t'} or '');
322
323	# --------------------
324	# Try to parse message
325
326	$parser = new MIME::Parser;
327	$parser->output_to_core(1);
328	$entity = $parser->parse(\*STDIN) or die;
329	$head = $entity->head;
330	$head->unfold;
331
332	# Pick the first name and address of the first From and To headers, respectively
333	($from_name, $from_address) = do {
334	my @address =
335	Email::Address->parse($head->get("From",0));
336	($address[0]->name, $address[0]->address);
337	};
338	($to_name, $to_address) = do {
339	my @address =
340	Email::Address->parse($head->get("To",0));
341	($address[0]->name, $address[0]->address);
342	};
343
344	# Decode subject according to RfC1522/2045, using MIME::Words
345	foreach (decode_mimewords($head->get("Subject",0))) {
346	$subject.=($$_[1]?decode($$_[1], $$_[0]) : $$_[0]);
347	}
348
349	# We make up our own Message-ID header if we don't find one.
350	$msgid = ( $head->get("Message-ID",0) or
351	('<'. time() .'.'. int(rand(1000000)) .'@'. $mail_domain .'>'));
352
353	chomp $subject; utf8::upgrade($subject);
354	chomp $msgid;
355
356	# -------------------------------------------
357	# Simplify structure returned by MIME::Parser
358
359	($content_type,$body)=simplify_body($entity);
360
361	unless (defined $content_type && $content_type =~ /^text\/(plain\|html)/) {
362	$content_type = 'text/plain';
363	$body = "Failed to convert the message $msgid to a meaningful format";
364	}
365
366	@references = split(/\s+/, ( $head->get('References') or
367	$head->get('In-Reply-To') or
368	'' ));
369
370	# Setup connection to database if not in debugging mode
371	unless ($opts{'d'}) {
372	$dsn = "DBI:$dbtype:$dbase:$dbhost";
373	$dbh = DBI->connect($dsn, $dbuser, $dbauth) or die;
374
375	# Work around charset encoding confusion.
376	if ($dbtype eq 'mysql') { $dbh->do('SET NAMES utf8'); }
377	}
378
379	if ($envelope_from eq '') {
380	# VERP handling
381	if ($opts{'d'}) {
382	print "Handling bounce for (possible) member ".
383	Mail::Verp->decode($envelope_to)."\n";
384	} else {
385	# Set up queries
386	$add_dsn_handle = $dbh->prepare($add_dsn_stmt) or die;
387
388	(my $failed_rcpt,undef) = Mail::Verp->decode($envelope_to);
389
390	$add_dsn_handle->execute($msgid, $failed_rcpt);
391	}
392	exit 0;
393	} else {
394	if ($opts{'d'}) {
395	binmode(STDOUT, ':utf8');
396	print <<EOF;
397	X-Envelope-From: $envelope_from
398	X-Envelope-To: $envelope_to
399	From: \"$from_name\" <$from_address>
400	To: \"$to_name\" <$to_address>
401	Subject: $subject
402	Message-Id: $msgid
403	Content-Type: $content_type
404	EOF
405	print "References: ".join(', ', @references)."\n";
406	print "\n$body";
407	} else {
408	# Set up queries
409	$add_content_handle = $dbh->prepare($add_content_stmt) or die;
410	$add_threadinfo_handle = $dbh->prepare($add_threadinfo_stmt) or die;
411	$add_group_handle = $dbh->prepare($add_group_stmt) or die;
412
413	$add_attachment_handle = $dbh->prepare($add_attachment_stmt) or die;
414
415	$add_content_handle->execute($from_address,
416	$from_name,
417	$subject,
418	$msgid,
419	$content_type,
420	$body);
421	$add_group_handle->execute($msgid, $envelope_to);
422
423	foreach (keys %attachments) {
424	my %attch = %{$attachments{$_}};
425
426	$add_attachment_handle->execute($msgid,
427	$attch{'name'},
428	$attch{'type'},
429	$attch{'content'},
430	$attch{'disp'});
431	}
432
433	foreach (@references) {
434	$add_threadinfo_handle->execute($msgid, $_);
435	}
436	}
437	}
438
439	# ----------------------------------------------------------------------
440	sub save_attachment(@) {
441	my $entity = shift;
442	my $name = $entity->head()->recommended_filename;
443	my $type = $entity->effective_type;
444	my $disp = $entity->head()->get('Content-Disposition');
445
446	my $filename = basename $name;
447
448	my $maxLen = 16777216; # size of MEDIUMBLOB
449
450	${$attachments{$filename}}{'name'} = $filename;
451	${$attachments{$filename}}{'type'} = $type;
452	${$attachments{$filename}}{'disp'} = $disp;
453
454	if(my $bh = $entity->bodyhandle) {
455	my $io = $bh->open("r");
456
457	${$attachments{$filename}}{'length'} =
458	$io->read(${$attachments{$filename}}{'content'}, $maxLen);
459
460	$io->close;
461	}
462
463	if ($opts{'d'}) {
464	my $attachment = File::Spec->catfile('/tmp', $filename);
465
466	unless( -f $attachment ) {
467	open( FH, ">$attachment");
468	print FH ${$attachments{$filename}}{'content'};
469	close(FH);
470	}
471	}
472	}
473
474	# ----------------------------------------------------------------------
475
476	sub simplify_body($) {
477	my $entity = shift;
478	my $body;
479
480	foreach ($entity->mime_type) {
481	chomp;
482
483	# Simple text/plain or tex/html messge
484	m/^text\/(plain\|html)$/ && do {
485	my $charset = ($entity->head()->mime_attr('content-type.charset') or
486	'US-ASCII');
487	$body = decode($charset, $entity->bodyhandle()->as_string);
488	utf8::upgrade($body);
489	return $entity->mime_type(), $body;
490	};
491
492	# Typical case: alternative encodings
493	m/^multipart\/alternative$/ && do {
494	my $type;
495	my %alternative;
496	# Collect only the first of each type.
497	foreach my $part ($entity->parts) {
498	($type, $body) = simplify_body($part);
499	if ($type =~ /^text/) {
500	next if (exists $alternative{$type});
501	$alternative{$type}=$body;
502	}
503	}
504	if ($alternative{'text/html'}) {
505	return 'text/html', $alternative{'text/html'};
506	} elsif ($alternative{'text/plain'}) {
507	return 'text/plain', $alternative{'text/plain'};
508	} else {
509	return undef;
510	}
511	};
512
513	# Mail with attachment(s) (e.g. OE HTML mail with embedded image...)
514	# OR
515	# S/MIME signed mail
516	m/^multipart\/(related\|mixed\|parallel\|signed)$/ && do {
517	my $type;
518	my %alternative;
519	# Concatenate parts of same type
520	foreach my $part ($entity->parts) {
521	($type, $body) = simplify_body($part);
522	if ($type =~ /^text/) {
523	$alternative{$type}.=$body;
524	}
525	else {
526	# For all non-text based components
527	# store the attachments for use by
528	# mail-out
529	save_attachment( $part );
530	}
531	}
532	if ($alternative{'text/html'}) {
533	return 'text/html', $alternative{'text/html'};
534	} elsif ($alternative{'text/plain'}) {
535	return 'text/plain', $alternative{'text/plain'};
536	} else {
537	return undef;
538	}
539	};
540
541	# RfC 2046, Section 5.1.5
542	m/^multipart\/digest$/ && do {
543	};
544
545	# RfC 2046, Section 5.1.7
546	m/^multipart\/(.*)$/ && do {
547	};
548	}
549	return undef;
550	}
551
552	# Local Variables:
553	# mode:cperl
554	# End: