1#! --PERL--
2# -*- indent-tabs-mode: nil; -*-
3# vim:ft=perl:et:sw=4
4# $Id$
5
6# Sympa - SYsteme de Multi-Postage Automatique
7#
8# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
9# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
10# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
11# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
12# Copyright 2017, 2019 The Sympa Community. See the AUTHORS.md file at
13# the top-level directory of this distribution and at
14# <https://github.com/sympa-community/sympa.git>.
15#
16# This program is free software; you can redistribute it and/or modify
17# it under the terms of the GNU General Public License as published by
18# the Free Software Foundation; either version 2 of the License, or
19# (at your option) any later version.
20#
21# This program is distributed in the hope that it will be useful,
22# but WITHOUT ANY WARRANTY; without even the implied warranty of
23# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24# GNU General Public License for more details.
25#
26# You should have received a copy of the GNU General Public License
27# along with this program.  If not, see <http://www.gnu.org/licenses/>.
28
29use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
30use strict;
31use warnings;
32use Digest::MD5;
33use English qw(-no_match_vars);
34use Getopt::Long;
35use Pod::Usage;
36
37use Sympa::Constants;
38use Conf;
39use Sympa::Log;
40use Sympa::Spool;
41use Sympa::Spool::Incoming;
42use Sympa::Spool::Outgoing;
43
44my %options;
45unless (GetOptions(\%options, 'help|h', 'dry_run', 'version|v')) {
46    pod2usage(-exitval => 1, -output => \*STDERR);
47}
48if ($options{'help'}) {
49    pod2usage(0);
50} elsif ($options{'version'}) {
51    printf "Sympa %s\n", Sympa::Constants::VERSION;
52    exit 0;
53}
54
55my $log = Sympa::Log->instance;
56
57unless (Conf::load(Conf::get_sympa_conf(), 'no_db')) {
58    die sprintf 'Configuration file %s has errors.\n', Conf::get_sympa_conf();
59}
60
61# Get obsoleted parameter.
62open my $fh, '<', Conf::get_sympa_conf() or die $ERRNO;
63my ($cookie) =
64    grep {defined} map { /\A\s*cookie\s+(\S+)/s ? $1 : undef } <$fh>;
65close $fh;
66
67# Set the User ID & Group ID for the process
68$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
69$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];
70# Required on FreeBSD to change ALL IDs (effective UID + real UID + saved UID)
71POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
72POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);
73# Check if the UID has correctly been set (useful on OS X)
74unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
75    && ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
76    die
77        "Failed to change process user ID and group ID. Note that on some OS Perl scripts can't change their real UID. In such circumstances Sympa should be run via sudo.";
78}
79# Sets the UMASK
80umask oct $Conf::Conf{'umask'};
81
82my $bulk      = Sympa::Spool::Outgoing->new;
83my $spool     = Sympa::Spool::Incoming->new;
84my $spool_dir = $spool->{directory};
85
86mkdir "$spool_dir/moved", 0755 unless -d "$spool_dir/moved";
87
88while (1) {
89    my ($message, $handle) = $spool->next(no_filter => 1);
90
91    if ($message and $handle) {
92        my $status = process($message);
93        unless (defined $status) {
94            $spool->quarantine($handle) unless $options{dry_run};
95        } elsif ($status) {
96            $handle->rename($spool_dir . '/moved/' . $handle->basename)
97                unless $options{dry_run};
98        } else {
99            next;
100        }
101    } elsif ($handle) {
102        next;
103    } else {
104        last;
105    }
106}
107
108sub process {
109    my $message = shift;
110
111    return 0 unless $message->{checksum};
112
113    ## valid X-Sympa-Checksum prove the message comes from web interface with
114    ## authenticated sender
115    unless ($message->{'checksum'} eq sympa_checksum($message->{'rcpt'})) {
116        $log->syslog('err', '%s: Incorrect X-Sympa-Checksum header',
117            $message);
118        return undef;
119    }
120
121    if (ref $message->{context} eq 'Sympa::List') {
122        $message->{'md5_check'} = 1;
123        delete $message->{checksum};
124
125        # Don't use method of incoming spool to preserve original PID.
126        Sympa::Spool::store_spool($spool_dir, $message, '%s@%s.%ld.%ld,%d',
127            [qw(localpart domainpart date pid RAND)])
128            unless $options{dry_run};
129        $log->syslog('info', '%s: Moved to msg spool', $message);
130    } else {
131        $bulk->store($message, [split /\s*,\s*/, $message->{rcpt}])
132            unless $options{dry_run};
133        $log->syslog('info', '%s: Moved to bulk spool', $message);
134    }
135    return 1;
136}
137
138sub sympa_checksum {
139    my $rcpt = shift;
140    return substr Digest::MD5::md5_hex(join '/', $cookie, $rcpt), -10;
141}
142
143__END__
144
145=encoding utf-8
146
147=head1 NAME
148
149upgrade_send_spool, upgrade_send_spool.pl - Upgrade messages in incoming spool
150
151=head1 SYNOPSIS
152
153  upgrade_send_spool.pl [ --dry_run ]
154
155=head1 DESCRIPTION
156
157On Sympa earlier than 6.2, messages sent from WWSympa were injected in
158msg spool with special checksum.
159Recent release of Sympa and WWSympa injects outbound messages in outgoing
160spool or sends them by Mailer directly.
161This program migrates messages with old format in appropriate spools.
162
163=head1 OPTIONS
164
165=over
166
167=item --dry_run
168
169Shows what will be done but won't really perform upgrade process.
170
171=back
172
173=head1 RETURN VALUE
174
175This program exits with status 0 if processing succeeded.
176Otherwise exits with non-zero status.
177
178=head1 CONFIGURATION OPTIONS
179
180Following site configuration parameters in F<--CONFIG--> are referred.
181
182=over
183
184=item cookie
185
186(obsoleted by Sympa 6.2.61b)
187
188=item queue
189
190=item umask
191
192=back
193
194=head1 SEE ALSO
195
196L<sympa.conf(5)>, L<Sympa::Message>.
197
198=head1 HISTORY
199
200upgrade_send_spool.pl appeared on Sympa 6.2.
201
202=cut
203