sympa-6.2.24/ 0000755 0001750 0001750 00000000000 13216651447 011703 5 ustar racke racke sympa-6.2.24/src/ 0000755 0001750 0001750 00000000000 13216651447 012472 5 ustar racke racke sympa-6.2.24/src/Sympa/ 0000755 0001750 0001750 00000000000 13216651447 013563 5 ustar racke racke sympa-6.2.24/src/Sympa/Extractor.pm 0000644 0001750 0001750 00000002210 13216651447 016067 0 ustar racke racke package Sympa::Extractor;
use strict;
use base qw(Locale::Maketext::Extract::Plugin::Base);
our $VERSION = '0.1';
=head1 NAME
Sympa::Extractor - Sympa plugin for Locale::Maketext::Extract
=head1 SYNOPSIS
$plugin = Sympa::Extractor->new(
$lexicon # A Locale::Maketext::Extract object
@file_types # Optionally specify a list of recognised file types
)
$plugin->extract($filename,$filecontents);
=head1 DESCRIPTION
Extracts strings to localise from List.pm and scenarios files
=head1 VALID FORMATS
gettext_id entries from List.pm, and title.gettext entries from scenarios are
extracted.
=head1 KNOWN FILE TYPES
=over 4
=item All file types
=back
=cut
sub file_types {
return qw( * );
}
sub extract {
my $self = shift;
local $_ = shift;
my $count = 1;
foreach my $line (split(/\n/, $_)) {
# scenarios
if ($line =~ /^title.gettext\s+(.+)$/) {
$self->add_entry($1, $count, '');
}
# List.pm
if ($line =~ /'gettext_id'\s+=>\s+(["'])(.+)\1/) {
$self->add_entry($2, $count, '');
}
$count++;
}
}
1;
sympa-6.2.24/src/smtpc/ 0000755 0001750 0001750 00000000000 13216651447 013620 5 ustar racke racke sympa-6.2.24/src/smtpc/utf8.c 0000644 0001750 0001750 00000011036 13216651447 014653 0 ustar racke racke /* $Id$ */
/*
* Sympa - SYsteme de Multi-Postage Automatique
*
* Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
* Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
* 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
* Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
*
* 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, see .
*/
/*
* utf8_check was originally taken from UTF8.xs in Unicode-UTF8 module by
* Christian Hansen distributed under Perl 5 License:
* .
*
* Copyright 2011-2012 by Christian Hansen.
*/
#include "config.h"
#include
#include
#if SIZEOF_UNSIGNED_INT >= 4
typedef unsigned int unichar_t;
#elif SIZEOF_UNSIGNED_LONG >= 4
typedef unsigned long unichar_t;
#else
#error "Integral types on your system are too short"
#endif
static const unsigned char utf8_sequence_len[0x100] = {
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x00-0x0F */
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x10-0x1F */
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x20-0x2F */
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x30-0x3F */
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x40-0x4F */
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x50-0x5F */
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x60-0x6F */
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x70-0x7F */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x80-0x8F */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x90-0x9F */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xA0-0xAF */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xB0-0xBF */
0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /* 0xC0-0xCF */
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /* 0xD0-0xDF */
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, /* 0xE0-0xEF */
4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xF0-0xFF */
};
/** Check string
* Check if the string consists of valid UTF-8 sequence.
* @param[in] s Buffer.
* @param[in] len Length of buffer.
* @returns If the buffer contains only ASCII characters, -1.
* Else if the buffer contains non-ASCII sequence not forming valid UTF-8,
* index of the first position such sequence appears.
* Otherwise, length of the buffer.
*/
ssize_t utf8_check(const unsigned char *s, const size_t len)
{
const unsigned char *p = s;
const unsigned char *e = s + len;
const unsigned char *e4 = e - 4;
unichar_t v;
int is_asciionly = 1; /* Added to check if non-ASCII is included. */
while (p < e4) {
while (p < e4 && *p < 0x80)
p++;
check:
switch (utf8_sequence_len[*p]) {
case 0:
goto done;
case 1:
p += 1;
break;
case 2:
/* 110xxxxx 10xxxxxx */
if ((p[1] & 0xC0) != 0x80)
goto done;
p += 2;
is_asciionly = 0;
break;
case 3:
v = ((unichar_t) p[0] << 16)
| ((unichar_t) p[1] << 8)
| ((unichar_t) p[2]);
/* 1110xxxx 10xxxxxx 10xxxxxx */
if ((v & 0x00F0C0C0) != 0x00E08080 ||
/* Non-shortest form */
v < 0x00E0A080 ||
/* Surrogates U+D800..U+DFFF */
(v & 0x00EFA080) == 0x00EDA080 ||
/* Non-characters U+FDD0..U+FDEF, U+FFFE..U+FFFF */
(v >= 0x00EFB790 && (v <= 0x00EFB7AF || v >= 0x00EFBFBE)))
goto done;
p += 3;
is_asciionly = 0;
break;
case 4:
v = ((unichar_t) p[0] << 24)
| ((unichar_t) p[1] << 16)
| ((unichar_t) p[2] << 8)
| ((unichar_t) p[3]);
/* 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx */
if ((v & 0xF8C0C0C0) != 0xF0808080 ||
/* Non-shortest form */
v < 0xF0908080 ||
/* Greater than U+10FFFF */
v > 0xF48FBFBF ||
/* Non-characters U+nFFFE..U+nFFFF on plane 1-16 */
(v & 0x000FBFBE) == 0x000FBFBE)
goto done;
p += 4;
is_asciionly = 0;
break;
}
}
if (p < e && p + utf8_sequence_len[*p] <= e)
goto check;
done:
if (p == e && is_asciionly)
return -1;
else
return p - s;
}
sympa-6.2.24/src/smtpc/sockstr.c 0000644 0001750 0001750 00000036034 13216651447 015462 0 ustar racke racke /* $Id$ */
/*
* Sympa - SYsteme de Multi-Postage Automatique
*
* Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
* Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
* 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
* Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
*
* 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, see .
*/
/*
* sockstr.c was originally written by IKEDA Soji
* as a part of smtpc utility for Sympa project.
*
* 2015-05-17 IKEDA Soji: Initial checkin to source repository.
*/
#include "config.h"
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include "sockstr.h"
/** Constructor
* Creats new instance of sockstr object.
* @param[in] nodename Hostname of the server. Default is "localhost".
* @param[in] servname Port number or service name. Default is "smtp".
* @returns New instance.
* If error occurred, sets errno and returns NULL.
*/
sockstr_t *sockstr_new(char *nodename, char *servname, char *path)
{
sockstr_t *self;
self = (sockstr_t *) malloc(sizeof(sockstr_t));
if (self == NULL)
return NULL;
self->_errstr[0] = '\0';
self->_sock = -1;
self->_bufcnt = 0;
self->_bufptr = self->_buf;
self->timeout = 300;
if (path != NULL && *path) {
self->path = strdup(path);
if (self->path == NULL) {
free(self);
return NULL;
}
self->nodename = NULL;
self->servname = NULL;
} else {
self->path = NULL;
if (!nodename || !*nodename)
nodename = "localhost";
if (!servname || !*servname)
servname = "25";
self->nodename = strdup(nodename);
self->servname = strdup(servname);
if (self->nodename == NULL || self->servname == NULL) {
if (self->nodename != NULL)
free(self->nodename);
if (self->servname != NULL)
free(self->servname);
free(self);
return NULL;
}
}
return self;
}
/** Destructor
* Unallocate memory for the instance.
* @retuns None.
*/
void sockstr_destroy(sockstr_t * self)
{
if (self == NULL)
return;
if (0 <= self->_sock) {
shutdown(self->_sock, SHUT_RDWR);
close(self->_sock);
}
if (self->nodename != NULL)
free(self->nodename);
if (self->servname != NULL)
free(self->servname);
if (self->path != NULL)
free(self->path);
free(self);
}
static void sockstr_set_error(sockstr_t * self, int errnum,
const char *errstr)
{
self->_errnum = errnum;
if (errstr == NULL) {
char *buf;
buf = strerror(errnum);
if (buf == NULL)
snprintf(self->_errstr, SOCKSTR_ERRSIZE, "(%d) Error", errnum);
else
snprintf(self->_errstr, SOCKSTR_ERRSIZE, "(%d) %s", errnum,
buf);
} else
snprintf(self->_errstr, SOCKSTR_ERRSIZE, "(%d) %s", errnum,
errstr);
}
/** Last error
* Gets error by the last operation.
* @returns String, or if the last operation was success, NULL.
*/
char *sockstr_errstr(sockstr_t * self)
{
return self->_errstr;
}
static int _connect_socket(sockstr_t * self, int sock,
struct sockaddr *ai_addr, socklen_t ai_addrlen,
int blocking)
{
long flags;
flags = fcntl(sock, F_GETFL, NULL);
if (flags < 0 || fcntl(sock, F_SETFL, flags | O_NONBLOCK) < 0) {
sockstr_set_error(self, errno, NULL);
return -1;
}
if (connect(sock, ai_addr, ai_addrlen) < 0) {
if (errno == EINPROGRESS) {
struct timeval tv;
fd_set rfd, wfd;
int rc, errnum;
socklen_t errlen;
do {
tv.tv_sec = self->timeout;
tv.tv_usec = 0;
FD_ZERO(&rfd);
FD_SET(sock, &rfd);
wfd = rfd;
rc = select(sock + 1, &rfd, &wfd, NULL, &tv);
} while (rc < 0 && errno == EINTR);
if (rc == 0) {
sockstr_set_error(self, ETIMEDOUT, NULL);
return -1;
} else if (FD_ISSET(sock, &rfd) || FD_ISSET(sock, &wfd)) {
errlen = sizeof(errnum);
getsockopt(sock, SOL_SOCKET, SO_ERROR,
(void *) &errnum, &errlen);
if (errnum) {
sockstr_set_error(self, errnum, NULL);
return -1;
}
} else {
sockstr_set_error(self, errno, NULL);
return -1;
}
} else {
sockstr_set_error(self, errno, NULL);
return -1;
}
}
if (blocking) {
if (fcntl(sock, F_SETFL, flags) < 0) {
sockstr_set_error(self, errno, NULL);
return -1;
}
}
return 0;
}
int socktcp_connect(sockstr_t * self)
{
struct addrinfo hints, *ai0, *ai;
int errnum;
int sock = -1;
if (0 <= self->_sock) {
sockstr_set_error(self, EISCONN, NULL);
return -1;
}
memset(&hints, 0, sizeof(hints));
hints.ai_family = PF_UNSPEC;
hints.ai_socktype = SOCK_STREAM;
errnum = getaddrinfo(self->nodename, self->servname, &hints, &ai0);
if (errnum) {
sockstr_set_error(self, errnum, gai_strerror(errnum));
return -1;
}
for (ai = ai0; ai != NULL; ai = ai->ai_next) {
sock = socket(ai->ai_family, ai->ai_socktype, ai->ai_protocol);
if (sock < 0) {
sockstr_set_error(self, errno, NULL);
continue;
}
if (_connect_socket(self, sock, ai->ai_addr, ai->ai_addrlen, 0) ==
0)
break;
close(sock);
sock = -1;
}
freeaddrinfo(ai0);
if (sock < 0)
return -1;
self->_sock = sock;
return 0;
}
int sockunix_connect(sockstr_t * self)
{
struct sockaddr_un sa_un; /* The name "sun" messes Solaris. */
size_t sunlen;
int sock = -1;
if (0 <= self->_sock) {
sockstr_set_error(self, EISCONN, NULL);
return -1;
}
if (self->path == NULL || self->path[0] == '\0') {
sockstr_set_error(self, EINVAL, NULL);
return -1;
}
sunlen = strlen(self->path);
if (sizeof(sa_un.sun_path) < sunlen + 1) {
sockstr_set_error(self, ENAMETOOLONG, NULL);
return -1;
}
memset(&sa_un, 0, sizeof(sa_un));
sa_un.sun_family = PF_UNIX;
memcpy(sa_un.sun_path, self->path, sunlen + 1);
/* I don't know any platforms need to set .sun_len member. */
sock = socket(AF_UNIX, SOCK_STREAM, 0);
if (sock < 0) {
sockstr_set_error(self, errno, NULL);
return -1;
}
if (_connect_socket
(self, sock, (struct sockaddr *) &sa_un, sizeof(sa_un), 0) < 0) {
close(sock);
return -1;
}
self->_sock = sock;
return 0;
}
/** Connect
* Connects to the host.
* @returns 1 if success, otherwise 0.
* Description of error can be got by sockstr_errstr().
*/
int sockstr_client_connect(sockstr_t * self)
{
if (self->path != NULL)
return sockunix_connect(self);
else
return socktcp_connect(self);
}
static ssize_t sockstr_read(sockstr_t * self, char *buf, size_t count)
{
int cnt;
while (self->_bufcnt <= 0) {
self->_bufcnt = read(self->_sock, self->_buf, sizeof(self->_buf));
if (self->_bufcnt < 0) {
if (errno == EAGAIN || errno == EWOULDBLOCK) {
int rc;
struct timeval tv;
fd_set wfd;
do {
tv.tv_sec = self->timeout;
tv.tv_usec = 0;
FD_ZERO(&wfd);
FD_SET(self->_sock, &wfd);
rc = select(self->_sock + 1, NULL, &wfd, NULL, &tv);
} while (rc < 0 && errno == EINTR);
if (rc < 0)
return -1;
else if (rc == 0) {
errno = ETIMEDOUT;
return -1;
}
} else if (errno != EINTR)
return -1;
} else if (self->_bufcnt == 0)
return 0;
else
self->_bufptr = self->_buf;
}
cnt = count;
if (self->_bufcnt < count)
cnt = self->_bufcnt;
memcpy(buf, self->_bufptr, cnt);
self->_bufptr += cnt;
self->_bufcnt -= cnt;
return cnt;
}
#define SOCKSTR_MIN_BUFSIZ (4)
#define SOCKSTR_DEFAULT_BUFSIZ (128)
/** Read one line
* Read one line termined by a newline (LF) from peer.
* @param[in,out] lineptr Pointer to buffer provided by user.
* @param[in,out] n Pointer to allocated size of buffer.
* @param[in] omitnul If true value is specified, ignores NUL octets (\0) in
* input.
* @returns Size of read data, 0 if socket is no longer readalbe
* or -1 on failure.
* lineptr and n may be changed.
*/
ssize_t sockstr_getline(sockstr_t * self, char **lineptr, size_t * n,
int omitnul)
{
ssize_t rs;
char chr, *p, *newbuf;
size_t len, newsiz;
if (self->_sock < 0 || lineptr == NULL || n == NULL) {
sockstr_set_error(self, EINVAL, NULL);
return -1;
}
p = *lineptr;
while (1) {
rs = sockstr_read(self, &chr, 1);
if (rs == 1) {
len = p - *lineptr;
if (*lineptr == NULL || *n < len + 2) {
if (*lineptr == NULL || *n < SOCKSTR_MIN_BUFSIZ)
newsiz = SOCKSTR_DEFAULT_BUFSIZ;
else
newsiz = *n << 1;
if (*lineptr == NULL)
newbuf = malloc(newsiz);
else
newbuf = realloc(*lineptr, newsiz);
if (newbuf == NULL) {
sockstr_set_error(self, errno, NULL);
return -1;
}
*lineptr = newbuf;
*n = newsiz;
p = *lineptr + len;
}
if (!omitnul || chr != '\0')
*p++ = chr;
if (chr == '\n')
break;
} else if (rs == 0) { /* Disconnected. */
if (p == *lineptr) { /* EOF */
sockstr_set_error(self, ECONNRESET, NULL);
return 0;
}
break;
} else {
sockstr_set_error(self, errno, NULL);
return -1;
}
}
*p = '\0';
return p - *lineptr;
}
/* Get status line(s)
* Read (one or more) status line(s) from peer.
* @param[in,out] lineptr Pointer to buffer provided by user.
* @oaram[in,out] n Pointer to allocated size of buffer.
* @returns Size of read data, 0 if socket is no longer readalbe
* or -1 on failure.
* lineptr and n may be changed.
* NUL octets (\0) in input are ignored.
*/
ssize_t sockstr_getstatus(sockstr_t * self, char **lineptr, size_t * n)
{
ssize_t rs;
char *buf = NULL, *newbuf;
size_t bufsiz = 0, newsiz, len = 0;
if (self->_sock < 0 || lineptr == NULL || n == NULL) {
sockstr_set_error(self, EINVAL, NULL);
return -1;
}
while (1) {
rs = sockstr_getline(self, &buf, &bufsiz, 1);
if (rs < 0) {
if (buf != NULL)
free(buf);
return -1;
} else if (rs == 0) { /* Disconnected. */
if (len == 0) { /* EOF */
sockstr_set_error(self, ECONNRESET, NULL);
if (buf != NULL)
free(buf);
return 0;
}
break;
} else {
if (*lineptr == NULL || *n < len + rs + 1) {
if (*lineptr == NULL || *n < SOCKSTR_DEFAULT_BUFSIZ)
newsiz = SOCKSTR_DEFAULT_BUFSIZ;
else
newsiz = *n;
while (newsiz < len + rs + 1)
newsiz <<= 1;
if (*lineptr == NULL)
newbuf = malloc(newsiz);
else
newbuf = realloc(*lineptr, newsiz);
if (newbuf == NULL) {
sockstr_set_error(self, errno, NULL);
if (buf != NULL)
free(buf);
return -1;
}
*n = newsiz;
*lineptr = newbuf;
}
memcpy(*lineptr + len, buf, rs + 1);
len += rs;
if (3 <= rs &&
'2' <= buf[0] && buf[0] <= '5' &&
'0' <= buf[1] && buf[1] <= '9' &&
'0' <= buf[2] && buf[2] <= '9') {
if (buf[3] != '-')
break;
} else {
sockstr_set_error(self, EINVAL, NULL);
if (buf != NULL)
free(buf);
return -1;
}
}
}
if (buf != NULL)
free(buf);
return len;
}
static ssize_t sockstr_write(sockstr_t * self, void *buf, size_t count)
{
size_t leftlen = count;
ssize_t rs;
char *p = buf;
while (leftlen > 0) {
rs = write(self->_sock, p, leftlen);
if (rs < 0) {
if (errno == EAGAIN || errno == EWOULDBLOCK) {
int rc;
struct timeval tv;
fd_set rfd;
do {
tv.tv_sec = self->timeout;
tv.tv_usec = 0;
FD_ZERO(&rfd);
FD_SET(self->_sock, &rfd);
rc = select(self->_sock + 1, &rfd, NULL, NULL, &tv);
} while (rc < 0 && errno == EINTR);
if (rc < 0)
return -1;
else if (rc == 0) {
errno = ETIMEDOUT;
return -1;
}
} else if (errno != EINTR)
return -1;
} else {
leftlen -= rs;
p += rs;
}
}
return count;
}
/** Write formatted string
* Formats string according to format and write to peer.
* @param[in] format Format.
* @param[in] ap Arguments fed to vsnprintf(3).
* @returns Number of octets written.
*/
ssize_t sockstr_vprintf(sockstr_t * self, const char *format, va_list ap)
{
int rc;
ssize_t rs;
char *buf, *newbuf;
va_list ap_again;
buf = malloc(SOCKSTR_DEFAULT_BUFSIZ);
if (buf == NULL) {
sockstr_set_error(self, errno, NULL);
return -1;
}
va_copy(ap_again, ap);
rc = vsnprintf(buf, SOCKSTR_DEFAULT_BUFSIZ, format, ap);
if (rc < 0) {
sockstr_set_error(self, errno, NULL);
va_end(ap_again);
free(buf);
return -1;
} else if (SOCKSTR_DEFAULT_BUFSIZ < rc + 1) {
newbuf = realloc(buf, rc + 1);
if (newbuf == NULL) {
sockstr_set_error(self, errno, NULL);
va_end(ap_again);
free(buf);
return -1;
}
buf = newbuf;
rc = vsnprintf(buf, rc + 1, format, ap_again);
if (rc < 0) {
sockstr_set_error(self, errno, NULL);
va_end(ap_again);
free(buf);
return -1;
}
}
va_end(ap_again);
rs = sockstr_write(self, buf, rc);
if (rs < 0)
sockstr_set_error(self, errno, NULL);
free(buf);
return rs;
}
/** @todo doc
*
*/
ssize_t sockstr_printf(sockstr_t * self, const char *format, ...)
{
va_list ap;
ssize_t rs;
va_start(ap, format);
rs = sockstr_vprintf(self, format, ap);
va_end(ap);
return rs;
}
/** Write data to peer
* Writes data to peer.
* @param[in] buf Buffer including data.
* @param[in] count Size of data.
* @param[in] delim Delimiter appended to output.
* @param[in] fixnewline Whether newlines will be canonicalized or not.
* @param[in] fixdot Fix lines beginning with dot (.).
* @returns Number of octets written.
*/
ssize_t sockstr_putdata(sockstr_t * self, void *buf, size_t count,
char *delim, int fixnewline, int fixdot)
{
char *p, *q, *end;
ssize_t rs, len, linelen;
p = q = buf;
end = buf + count;
len = 0;
while (p < end) {
if (fixdot && *p == '.') {
rs = sockstr_write(self, ".", 1);
if (rs < 0) {
sockstr_set_error(self, errno, NULL);
return -1;
} else
len += rs;
}
while (q < end)
if (*(q++) == '\n')
break;
if (fixnewline) {
if ((p + 1 == q && q[-1] == '\n') ||
q[-1] == '\r' ||
(p + 1 < q && q[-2] != '\r' && q[-1] == '\n'))
linelen = q - p - 1;
else if (q[-1] != '\n')
linelen = q - p;
else
linelen = q - p - 2;
} else
linelen = q - p;
rs = sockstr_write(self, p, linelen);
if (rs < 0) {
sockstr_set_error(self, errno, NULL);
return -1;
} else
len += rs;
if (fixnewline) {
rs = sockstr_write(self, "\r\n", 2);
if (rs < 0) {
sockstr_set_error(self, errno, NULL);
return -1;
} else
len += rs;
}
p = q;
}
if (delim != NULL && *delim != '\0') {
rs = sockstr_write(self, delim, strlen(delim));
if (rs < 0) {
sockstr_set_error(self, errno, NULL);
return -1;
} else
len += rs;
}
return len;
}
sympa-6.2.24/src/smtpc/configure.ac 0000644 0001750 0001750 00000002255 13216651447 016112 0 ustar racke racke # -*- Autoconf -*-
# $Id$
AC_PREREQ([2.59])
AC_INIT([smtpc], [0.3], [sympa-developpers@listes.renater.fr])
AM_INIT_AUTOMAKE([foreign -Wall -Werror 1.9 tar-pax])
m4_ifdef([AM_SILENT_RULES], [AM_SILENT_RULES([yes])])
AC_CONFIG_HEADERS([config.h])
# Check options
# If you bundle me in other package, use --disable-smtpc not to build me.
AC_ARG_ENABLE(
smtpc, [],
[case "$enableval" in
yes) smtpc=true;;
no) smtpc=false;;
*) smtpc=true;;
esac],
[smtpc=true]
)
# Checks for programs.
AC_PROG_CC
if test x$smtpc = xtrue; then
# Checks for libraries.
# Checks for header files.
AC_CHECK_HEADERS([fcntl.h netdb.h stdlib.h string.h sys/socket.h unistd.h])
# Checks for typedefs, structures, and compiler characteristics.
AC_TYPE_SIZE_T
AC_TYPE_SSIZE_T
AC_CHECK_SIZEOF([unsigned int])
AC_CHECK_SIZEOF([unsigned long])
# Checks for library functions.
AC_FUNC_MALLOC
AC_FUNC_REALLOC
AC_CHECK_FUNCS([memset select socket strdup strerror])
AC_FUNC_SNPRINTF
AC_CHECK_FUNC([getaddrinfo], [],
[AC_CHECK_LIB([socket], [getaddrinfo], [LIBS="-lsocket -lnsl $LIBS"], [],
[-lnsl])])
fi
AC_CONFIG_FILES([Makefile])
AC_OUTPUT
sympa-6.2.24/src/smtpc/sockstr.h 0000644 0001750 0001750 00000003572 13216651447 015470 0 ustar racke racke /* $Id$ */
/*
* Sympa - SYsteme de Multi-Postage Automatique
*
* Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
* Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
* 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
* Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
*
* 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, see .
*/
#include
#include
#include
#define SOCKSTR_ERRSIZE (128)
#define SOCKSTR_BUFSIZE (8192)
typedef struct {
char *nodename;
char *servname;
char *path;
int timeout;
int _sock;
int _errnum;
char _errstr[SOCKSTR_ERRSIZE];
ssize_t _bufcnt;
char *_bufptr;
char _buf[SOCKSTR_BUFSIZE];
} sockstr_t;
extern sockstr_t *sockstr_new(char *, char *, char *);
extern void sockstr_destroy(sockstr_t *);
extern char *sockstr_errstr(sockstr_t *);
extern int sockstr_client_connect(sockstr_t *);
extern ssize_t sockstr_getline(sockstr_t *, char **, size_t *, int);
extern ssize_t sockstr_getstatus(sockstr_t *, char **, size_t *);
extern ssize_t sockstr_vprintf(sockstr_t *, const char *, va_list);
extern ssize_t sockstr_printf(sockstr_t *, const char *, ...);
extern ssize_t sockstr_putdata(sockstr_t *, void *, size_t, char *, int,
int);
sympa-6.2.24/src/smtpc/smtpc.c 0000644 0001750 0001750 00000051012 13216651447 015111 0 ustar racke racke /* $Id$ */
/*
* Sympa - SYsteme de Multi-Postage Automatique
*
* Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
* Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
* 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
* Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
* Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
* directory of this distribution and at
* .
*
* 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, see .
*/
/*
* smtpc was originally written by IKEDA Soji
* for Sympa project.
*
* 2015-05-17 IKEDA Soji: Initial checkin to source repository.
*/
#include "config.h"
#include
#include
#include
#include
#include
#include
#include "sockstr.h"
#include "utf8.h"
#define SMTPC_BUFSIZ (8192)
#define SMTPC_ERR_SOCKET (255)
#define SMTPC_ERR_PROTOCOL (254)
#define SMTPC_ERR_SUBMISSION (253)
#define SMTPC_ERR_UNKNOWN (252)
#define SMTPC_7BIT (0)
#define SMTPC_8BIT (1)
#define SMTPC_UTF8 (2)
#define SMTPC_PROTO_TCP (1)
#define SMTPC_PROTO_UNIX (1 << 1)
#define SMTPC_PROTO_ESMTP (1 << 2)
#define SMTPC_PROTO_LMTP (1 << 3)
#define SMTPC_EXT_8BITMIME (1)
#define SMTPC_EXT_AUTH (1 << 1)
#define SMTPC_EXT_DSN (1 << 2)
#define SMTPC_EXT_PIPELINING (1 << 3)
#define SMTPC_EXT_SIZE (1 << 4)
#define SMTPC_EXT_SMTPUTF8 (1 << 5)
#define SMTPC_EXT_STARTTLS (1 << 6)
#define SMTPC_NOTIFY_NEVER (1)
#define SMTPC_NOTIFY_SUCCESS (1 << 1)
#define SMTPC_NOTIFY_FAILURE (1 << 2)
#define SMTPC_NOTIFY_DELAY (1 << 3)
static char buf[SMTPC_BUFSIZ];
static sockstr_t *sockstr;
static struct {
int dump;
int verbose;
unsigned int protocol;
char *myname;
char *nodename;
char *servname;
char *path;
char *sender;
unsigned int notify;
char *envid;
int smtputf8;
} options = {
0, 0, 0, NULL, NULL, NULL, NULL, NULL, 0, NULL, 0};
static struct {
char **recips;
int recipnum;
char *buf;
size_t buflen;
size_t size;
int envfeature;
int headfeature;
int bodyfeature;
} message = {
NULL, 0, NULL, 0, 0, 0, 0};
static struct {
char *buf;
size_t buflen;
unsigned long extensions;
} server = {
NULL, 0, 0};
static char *encode_xtext(unsigned char *str)
{
unsigned char *p;
char *encbuf, *q;
size_t enclen = 0;
p = str;
while (*p != '\0') {
if (*p == '+' || *p == '=')
enclen += 3;
else if (33 <= *p && *p <= 126)
enclen++;
else
enclen += 3;
p++;
}
encbuf = malloc(enclen + 1);
if (encbuf == NULL)
return NULL;
p = str;
q = encbuf;
while (*p != '\0') {
if (*p == '+' || *p == '=')
q += sprintf(q, "+%02X", (unsigned int) *p);
else if (33 <= *p && *p <= 126)
*q++ = *p;
else
q += sprintf(q, "+%02X", (unsigned int) *p);
p++;
}
*q = '\0';
return encbuf;
}
static char *encode_unitext(unsigned char *str)
{
unsigned char *p;
char *encbuf, *q;
size_t enclen = 0;
p = str;
while (*p != '\0') {
if (*p == '\\' || *p == '+' || *p == '=')
enclen += 6;
else if ((33 <= *p && *p <= 126) || 128 <= *p)
enclen++;
else
enclen += 6;
p++;
}
encbuf = malloc(enclen + 1);
if (encbuf == NULL)
return NULL;
p = str;
q = encbuf;
while (*p != '\0') {
if (*p == '\\' || *p == '+' || *p == '=')
q += sprintf(q, "\\x{%02X}", (unsigned int) *p);
else if ((33 <= *p && *p <= 126) || 128 <= *p)
*q++ = *p;
else
q += sprintf(q, "\\x{%02X}", (unsigned int) *p);
p++;
}
*q = '\0';
return encbuf;
}
static int parse_options(int *argcptr, char ***argvptr)
{
int argc = *argcptr;
char **argv = *argvptr;
size_t i;
char *arg, *p;
options.dump = 0;
options.verbose = 0;
options.protocol = 0;
options.myname = "localhost";
options.nodename = NULL;
options.servname = NULL;
options.sender = NULL;
options.notify = 0;
options.envid = NULL;
options.smtputf8 = 0;
for (i = 1; i < argc && argv[i] != NULL; i++) {
arg = argv[i];
if (arg[0] != '-')
break;
else if (arg[0] == '-' && arg[1] == '-') {
if (arg[2] == '\0') {
i++;
break;
} else if (strcmp(arg, "--dump") == 0)
options.dump++;
else if (strcmp(arg, "--esmtp") == 0 && i + 1 < argc) {
if (options.protocol != 0) {
fprintf(stderr, "Multiple servers are specified\n");
return -1;
}
options.protocol = SMTPC_PROTO_TCP | SMTPC_PROTO_ESMTP;
arg = argv[++i];
if (arg[0] == '[') {
p = options.nodename = arg + 1;
while (*p != '\0' && *p != ']')
p++;
if (*p == ']' && options.nodename < p)
*p++ = '\0';
else {
fprintf(stderr, "Malformed host \"%s\"\n", arg);
return -1;
}
if (*p == ':' && *(++p) != '\0')
options.servname = p;
else if (*p != '\0') {
fprintf(stderr, "Malformed port \"%s\"\n", p);
return -1;
} else
options.servname = "25";
} else {
p = options.nodename = arg;
while (*p != '\0' && *p != ':')
p++;
if (*p == ':' && options.nodename < p)
*p++ = '\0';
if (*p != '\0')
options.servname = p;
else
options.servname = "25";
}
} else if (strcmp(arg, "--iam") == 0 && i + 1 < argc)
options.myname = argv[++i];
else if (strcmp(arg, "--lmtp") == 0 && i + 1 < argc) {
if (options.protocol != 0) {
fprintf(stderr, "Multiple servers are specified\n");
return -1;
}
options.protocol = SMTPC_PROTO_LMTP;
arg = argv[++i];
if (arg[0] == '/') {
options.protocol |= SMTPC_PROTO_UNIX;
options.path = arg;
} else if (arg[0] == '[') {
options.protocol |= SMTPC_PROTO_TCP;
p = options.nodename = arg + 1;
while (*p != '\0' && *p != ']')
p++;
if (*p == ']' && options.nodename < p)
*p++ = '\0';
else {
fprintf(stderr, "Malformed host \"%s\"\n", arg);
return -1;
}
if (*p == ':' && *(++p) != '\0')
options.servname = p;
else if (*p != '\0') {
fprintf(stderr, "Malformed port \"%s\"\n", p);
return -1;
} else
options.servname = "24";
} else {
options.protocol |= SMTPC_PROTO_TCP;
p = options.nodename = arg;
while (*p != '\0' && *p != ':')
p++;
if (*p == ':' && options.nodename < p)
*p++ = '\0';
if (*p != '\0')
options.servname = p;
else
options.servname = "24";
}
} else if (strcmp(arg, "--smtputf8") == 0)
options.smtputf8 = 1;
else if (strcmp(arg, "--verbose") == 0)
options.verbose++;
}
switch (arg[1]) {
case 'f':
if (options.sender != NULL) {
fprintf(stderr, "Multiple senders are specified\n");
return -1;
}
if (arg[2] == '\0' && i + 1 < argc)
options.sender = argv[++i];
else if (arg[2] != '\0')
options.sender = arg + 2;
else
goto parse_options_novalue;
if (strcmp(options.sender, "<>") == 0)
options.sender += 2;
break;
case 'N':
if (arg[2] == '\0' && i + 1 < argc)
p = argv[++i];
else if (arg[2] != '\0')
p = arg + 2;
else
goto parse_options_novalue;
while (*p != '\0') {
char word[29], *wp;
wp = word;
while (*p == '\t' || *p == ' ' || *p == ',')
p++;
if (*p == '\0')
break;
while (*p != '\0' && *p != '\t' && *p != ' ' && *p != ','
&& wp - word + 1 < sizeof(word))
if ('a' <= *p && *p <= 'z')
*wp++ = *p++ + ('A' - 'a');
else
*wp++ = *p++;
*wp = '\0';
if (strcmp(word, "NEVER") == 0) {
options.notify |= SMTPC_NOTIFY_NEVER;
} else if (strcmp(word, "SUCCESS") == 0)
options.notify |= SMTPC_NOTIFY_SUCCESS;
else if (strcmp(word, "FAILURE") == 0)
options.notify |= SMTPC_NOTIFY_FAILURE;
else if (strcmp(word, "DELAY") == 0)
options.notify |= SMTPC_NOTIFY_DELAY;
else {
fprintf(stderr, "Unknown NOTIFY keyword \"%s\"\n",
word);
return -1;
}
if (options.notify & SMTPC_NOTIFY_NEVER &&
options.notify & ~SMTPC_NOTIFY_NEVER) {
fprintf(stderr,
"NEVER keyword must not appear with other keywords\n");
return -1;
}
}
break;
case 'V':
if (arg[2] == '\0' && i + 1 < argc)
options.envid = argv[++i];
else if (arg[2] != '\0')
options.envid = arg + 2;
else
goto parse_options_novalue;
p = options.envid;
while (*p != '\0')
if (32 <= *p && *p <= 126)
p++;
else {
fprintf(stderr,
"ENVID contains illegal character \\x%02X\n",
*p);
return -1;
}
break;
default:
break;
parse_options_novalue:
fprintf(stderr, "No value for option \"%s\"\n", arg);
return -1;
}
}
if ((options.protocol & (SMTPC_PROTO_ESMTP | SMTPC_PROTO_LMTP)) == 0) {
fprintf(stderr, "Either --esmtp or --lmtp option must be given\n");
return -1;
}
if ((options.protocol & SMTPC_PROTO_TCP && options.nodename == NULL)
|| (options.protocol & SMTPC_PROTO_UNIX && options.path == NULL)) {
fprintf(stderr, "Nodename nor path is not specified\n");
return -1;
}
if (options.sender == NULL) {
fprintf(stderr, "Envelope sender is not specified\n");
return -1;
}
*argcptr -= i;
*argvptr += i;
return 0;
}
static int check_utf8_address(char *addrbuf)
{
size_t len;
ssize_t rs;
len = strlen(addrbuf);
if (len == 0)
return SMTPC_7BIT;
rs = utf8_check((unsigned char *) addrbuf, len);
if (rs < 0)
return SMTPC_7BIT;
else if (rs < len)
return SMTPC_8BIT;
else
return SMTPC_UTF8;
}
static int read_envelope(char *sender, size_t recipnum, char **recips)
{
char **pp, **end;
if (recipnum <= 0) {
fprintf(stderr, "No recipients are specified\n");
return -1;
}
message.recipnum = recipnum;
message.recips = recips;
/*
* Check feature of sender.
*/
message.envfeature = check_utf8_address(sender);
/*
* Check feature of recipients.
*/
end = recips + recipnum;
for (pp = recips;
message.envfeature != SMTPC_8BIT && pp < end && *pp != NULL; pp++)
switch (check_utf8_address(*pp)) {
case SMTPC_8BIT:
message.envfeature = SMTPC_8BIT;
break;
case SMTPC_UTF8:
message.envfeature = SMTPC_UTF8;
break;
default:
break;
}
return 0;
}
static ssize_t read_message(void)
{
size_t cr;
ssize_t rs;
char *newbuf, *p, *end;
while (1) {
rs = fread(buf, 1, SMTPC_BUFSIZ, stdin);
if (rs == 0)
break;
if (message.buf == NULL) {
message.buf = malloc(rs + 1);
if (message.buf == NULL)
return -1;
} else {
newbuf = realloc(message.buf, message.buflen + rs + 1);
if (newbuf == NULL)
return -1;
message.buf = newbuf;
}
memcpy(message.buf + message.buflen, buf, rs);
message.buflen += rs;
message.buf[message.buflen] = '\0';
if (rs < SMTPC_BUFSIZ)
break;
}
if (feof(stdin)) {
if (fclose(stdin) != 0)
return -1;
} else {
fclose(stdin);
return -1;
}
/*
* Check message features:
* - Feature of message header.
* - Feature of message body.
* - Estimated size of the message considering newlines.
*/
cr = 0;
message.headfeature = SMTPC_7BIT;
message.bodyfeature = SMTPC_7BIT;
if (0 < message.buflen) {
end = message.buf + message.buflen;
for (p = message.buf; p < end; p++)
if (*p == '\n') {
if (p == message.buf || p[-1] != '\r')
cr++;
if (p[1] == '\n' || (p[1] == '\r' && p[2] == '\n')) {
p++;
break;
}
}
rs = utf8_check((unsigned char *) message.buf, p - message.buf);
if (rs < 0)
message.headfeature = SMTPC_7BIT;
else if (rs < p - message.buf)
message.headfeature = SMTPC_8BIT;
else
message.headfeature = SMTPC_UTF8;
for (; p < end; p++)
if (*p & 0x80) {
message.bodyfeature = SMTPC_8BIT;
p++;
break;
} else if (*p == '\n' && p[-1] != '\r')
cr++;
for (; p < end; p++)
if (*p == '\n' && p[-1] != '\r')
cr++;
if (end[-1] == '\r')
cr++;
else if (end[-1] != '\n')
cr += 2;
} else
cr = 2;
message.size = message.buflen + cr;
return message.buflen;
}
static int dialog(int timeout, const char *format, ...)
{
va_list ap;
ssize_t rs;
sockstr->timeout = timeout;
if (format != NULL && *format != '\0') {
if (options.dump) {
fprintf(stderr, "C: ");
va_start(ap, format);
vfprintf(stderr, format, ap);
va_end(ap);
}
va_start(ap, format);
rs = sockstr_vprintf(sockstr, format, ap);
va_end(ap);
if (rs < 0)
return -1;
}
rs = sockstr_getstatus(sockstr, &server.buf, &server.buflen);
if (rs <= 0)
return -1;
if (options.dump)
fprintf(stderr, "%s", server.buf);
return server.buf[0];
}
static int datasend(int timeout)
{
ssize_t rs;
sockstr->timeout = timeout;
if (options.dump)
fprintf(stderr, "C: (MESSAGE)\r\nC: .\r\n");
if (sockstr_putdata
(sockstr, message.buf, message.buflen, ".\r\n", 1, 1) < 0)
return -1;
rs = sockstr_getstatus(sockstr, &server.buf, &server.buflen);
if (rs <= 0)
return -1;
if (options.dump)
fprintf(stderr, "%s", server.buf);
return server.buf[0];
}
static void parse_extensions(void)
{
char *p = server.buf;
unsigned long extensions = 0L;
char word[512], *wp;
while (*p != '\n' && *p != '\0')
p++;
if (*p == '\n')
p++;
while (*p != '\0') {
if (p[0] && p[1] && p[2] && p[3]) {
p += 4;
while (*p == '\t' || *p == ' ' || *p == '-')
p++;
if (*p == '\0')
break;
wp = word;
while (wp - word + 1 < sizeof(word) &&
(*p == '-' || ('0' <= *p && *p <= '9') ||
('A' <= *p && *p <= 'Z') || ('a' <= *p && *p <= 'z')))
if ('a' <= *p && *p <= 'z')
*wp++ = *p++ + ('A' - 'a');
else
*wp++ = *p++;
*wp = '\0';
if (strcmp(word, "8BITMIME") == 0)
extensions |= SMTPC_EXT_8BITMIME;
else if (strcmp(word, "AUTH") == 0)
extensions |= SMTPC_EXT_AUTH;
else if (strcmp(word, "DSN") == 0)
extensions |= SMTPC_EXT_DSN;
else if (strcmp(word, "PIPELINING") == 0)
extensions |= SMTPC_EXT_PIPELINING;
else if (strcmp(word, "SIZE") == 0)
extensions |= SMTPC_EXT_SIZE;
else if (strcmp(word, "SMTPUTF8") == 0)
extensions |= SMTPC_EXT_SMTPUTF8;
else if (strcmp(word, "STARTTLS") == 0)
extensions |= SMTPC_EXT_STARTTLS;
}
while (*p != '\n' && *p != '\0')
p++;
if (*p == '\n')
p++;
}
server.extensions = extensions;
}
static ssize_t transaction(void)
{
ssize_t sent = 0;
char *hello;
char *ext_8bitmime, ext_envid[108], ext_notify[37], ext_orcpt[508],
ext_size[27], *ext_smtputf8;
int i;
ext_8bitmime = "";
*ext_envid = '\0';
*ext_notify = '\0';
*ext_orcpt = '\0';
*ext_size = '\0';
ext_smtputf8 = "";
if (options.protocol & SMTPC_PROTO_ESMTP)
hello = "EHLO";
else if (options.protocol & SMTPC_PROTO_LMTP)
hello = "LHLO";
else
return SMTPC_ERR_UNKNOWN;
switch (dialog(300, "%s %s\r\n", hello, options.myname)) {
case '2':
break;
case '4':
case '5':
return 0;
case -1:
return SMTPC_ERR_SOCKET;
default:
return SMTPC_ERR_PROTOCOL;
}
parse_extensions();
if (server.extensions & SMTPC_EXT_8BITMIME &&
(message.headfeature != SMTPC_7BIT
|| message.bodyfeature != SMTPC_7BIT))
ext_8bitmime = " BODY=8BITMIME";
if (server.extensions & SMTPC_EXT_DSN) {
if (options.envid != NULL && options.envid[0] != '\0') {
char *encbuf;
encbuf = encode_xtext((unsigned char *) options.envid);
if (encbuf == NULL) {
perror("transaction");
return SMTPC_ERR_UNKNOWN;
}
snprintf(ext_envid, sizeof(ext_envid), " ENVID=%s", encbuf);
free(encbuf);
}
if (options.notify) {
unsigned int mask;
for (mask = 1; mask < (1 << 4); mask <<= 1) {
if (options.notify & mask) {
if (*ext_notify == '\0')
strcat(ext_notify, " NOTIFY=");
else
strcat(ext_notify, ",");
switch (mask) {
case SMTPC_NOTIFY_NEVER:
strcat(ext_notify, "NEVER");
break;
case SMTPC_NOTIFY_SUCCESS:
strcat(ext_notify, "SUCCESS");
break;
case SMTPC_NOTIFY_FAILURE:
strcat(ext_notify, "FAILURE");
break;
case SMTPC_NOTIFY_DELAY:
strcat(ext_notify, "DELAY");
break;
}
}
} /* for (mask ...) */
} /* if (options.notify & mask) */
}
if (server.extensions & SMTPC_EXT_SIZE)
snprintf(ext_size, sizeof(ext_size), " SIZE=%lu",
(unsigned long) message.size);
if (server.extensions & SMTPC_EXT_SMTPUTF8 &&
options.smtputf8 &&
((message.envfeature == SMTPC_UTF8
&& message.headfeature != SMTPC_8BIT)
|| (message.envfeature != SMTPC_8BIT
&& message.headfeature == SMTPC_UTF8)))
ext_smtputf8 = " SMTPUTF8";
switch (dialog(300, "MAIL FROM:<%s>%s%s%s%s\r\n", options.sender,
ext_8bitmime, ext_envid, ext_size, ext_smtputf8)) {
case '2':
break;
case '4':
case '5':
return 0;
case -1:
return SMTPC_ERR_SOCKET;
default:
return SMTPC_ERR_PROTOCOL;
}
for (i = 0; i < message.recipnum; i++) {
if (server.extensions & SMTPC_EXT_DSN) {
char *encbuf;
if (*ext_smtputf8) {
encbuf =
encode_unitext((unsigned char *) message.recips[i]);
if (encbuf == NULL) {
perror("transaction");
return SMTPC_ERR_UNKNOWN;
}
snprintf(ext_orcpt, sizeof(ext_orcpt), " ORCPT=utf-8;%s",
encbuf);
} else {
encbuf = encode_xtext((unsigned char *) message.recips[i]);
if (encbuf == NULL) {
perror("transaction");
return SMTPC_ERR_UNKNOWN;
}
snprintf(ext_orcpt, sizeof(ext_orcpt), " ORCPT=rfc822;%s",
encbuf);
}
free(encbuf);
}
switch (dialog
(300, "RCPT TO:<%s>%s%s\r\n", message.recips[i],
ext_notify, ext_orcpt)) {
case '2':
sent++;
break;
case '4':
case '5':
return 0;
case -1:
return SMTPC_ERR_SOCKET;
default:
return SMTPC_ERR_PROTOCOL;
}
} /* for (i ...) */
switch (dialog(120, "DATA\r\n")) {
case '3':
break;
case '4':
case '5':
return 0;
case -1:
return SMTPC_ERR_SOCKET;
default:
return SMTPC_ERR_PROTOCOL;
}
switch (datasend(600)) {
case '2':
return sent;
case '5':
return 0;
case -1:
return SMTPC_ERR_SOCKET;
default:
return SMTPC_ERR_PROTOCOL;
}
}
static ssize_t session()
{
ssize_t rs;
switch (dialog(300, NULL)) {
case '2':
break;
case '4':
case '5':
return SMTPC_ERR_SUBMISSION;
case -1:
return SMTPC_ERR_SOCKET;
default:
return SMTPC_ERR_PROTOCOL;
}
rs = transaction();
if (rs == 0)
return SMTPC_ERR_SUBMISSION;
return rs;
}
int main(int argc, char *argv[])
{
ssize_t rs;
if (parse_options(&argc, &argv) < 0)
exit(EX_USAGE);
if (read_envelope(options.sender, argc, argv) < 0)
exit(EX_USAGE);
if (read_message() < 0) {
perror("read_message");
if (message.buf != NULL)
free(message.buf);
exit(EX_OSERR);
}
if (options.protocol & SMTPC_PROTO_TCP)
sockstr = sockstr_new(options.nodename, options.servname, NULL);
else if (options.protocol & SMTPC_PROTO_UNIX)
sockstr = sockstr_new(NULL, NULL, options.path);
else
sockstr = NULL;
if (sockstr == NULL) {
perror("sockstr_new");
if (message.buf != NULL)
free(message.buf);
exit(EX_OSERR);
}
sockstr->timeout = 300;
signal(SIGPIPE, SIG_IGN);
if (sockstr_client_connect(sockstr) < 0) {
fprintf(stderr, "error: %s\n", sockstr_errstr(sockstr));
sockstr_destroy(sockstr);
if (message.buf != NULL)
free(message.buf);
exit(EX_IOERR);
}
rs = session();
if (message.buf != NULL)
free(message.buf);
if (options.verbose && server.buf != NULL && 0 < server.buflen)
fputs(server.buf, stdout);
if (rs < 0) {
switch (rs) {
case SMTPC_ERR_SOCKET:
fprintf(stderr, "Socket error: %s\n", sockstr_errstr(sockstr));
break;
case SMTPC_ERR_PROTOCOL:
fprintf(stderr, "Unexpected response: %s", server.buf);
break;
case SMTPC_ERR_SUBMISSION:
dialog(10, "QUIT\r\n");
break;
default:
fprintf(stderr, "Unknown error %ld\n", (long) rs);
break;
}
sockstr_destroy(sockstr);
if (server.buf != NULL)
free(server.buf);
exit(rs);
}
/* entirely or partially sent */
dialog(10, "QUIT\r\n");
sockstr_destroy(sockstr);
free(server.buf);
exit(EX_OK);
}
sympa-6.2.24/src/smtpc/Makefile.am 0000644 0001750 0001750 00000000377 13216651447 015663 0 ustar racke racke # $Id$
ACLOCAL_AMFLAGS = -I m4
bin_PROGRAMS = smtpc
smtpc_SOURCES = \
smtpc.c \
sockstr.c \
sockstr.h \
utf8.c \
utf8.h
dist_doc_DATA = smtpc.1.md
EXTRA_DIST = configure.gnu
CLEANFILES = $(bin_PROGRAMS) *~ *.bak core.*
smtpc.o: sockstr.h utf8.h
sympa-6.2.24/src/smtpc/m4/ 0000755 0001750 0001750 00000000000 13216651447 014140 5 ustar racke racke sympa-6.2.24/src/smtpc/m4/ac_func_snprintf.m4 0000644 0001750 0001750 00000004626 13216651447 017733 0 ustar racke racke dnl @synopsis AC_FUNC_SNPRINTF
dnl
dnl Checks for a fully C99 compliant snprintf, in particular checks
dnl whether it does bounds checking and returns the correct string
dnl length; does the same check for vsnprintf. If no working snprintf
dnl or vsnprintf is found, request a replacement and warn the user
dnl about it. Note: the mentioned replacement is freely available and
dnl may be used in any project regardless of it's licence (just like
dnl the autoconf special exemption).
dnl
dnl @category C
dnl @author RĂ¼diger Kuhlmann
dnl @version 2002-09-26
dnl @license AllPermissive
AC_DEFUN([AC_FUNC_SNPRINTF],
[AC_CHECK_FUNCS(snprintf vsnprintf)
AC_MSG_CHECKING(for working snprintf)
AC_CACHE_VAL(ac_cv_have_working_snprintf,
[AC_TRY_RUN(
[#include
int main(void)
{
char bufs[5] = { 'x', 'x', 'x', '\0', '\0' };
char bufd[5] = { 'x', 'x', 'x', '\0', '\0' };
int i;
i = snprintf (bufs, 2, "%s", "111");
if (strcmp (bufs, "1")) exit (1);
if (i != 3) exit (1);
i = snprintf (bufd, 2, "%d", 111);
if (strcmp (bufd, "1")) exit (1);
if (i != 3) exit (1);
exit(0);
}], ac_cv_have_working_snprintf=yes, ac_cv_have_working_snprintf=no, ac_cv_have_working_snprintf=cross)])
AC_MSG_RESULT([$ac_cv_have_working_snprintf])
AC_MSG_CHECKING(for working vsnprintf)
AC_CACHE_VAL(ac_cv_have_working_vsnprintf,
[AC_TRY_RUN(
[#include
#include
int my_vsnprintf (char *buf, const char *tmpl, ...)
{
int i;
va_list args;
va_start (args, tmpl);
i = vsnprintf (buf, 2, tmpl, args);
va_end (args);
return i;
}
int main(void)
{
char bufs[5] = { 'x', 'x', 'x', '\0', '\0' };
char bufd[5] = { 'x', 'x', 'x', '\0', '\0' };
int i;
i = my_vsnprintf (bufs, "%s", "111");
if (strcmp (bufs, "1")) exit (1);
if (i != 3) exit (1);
i = my_vsnprintf (bufd, "%d", 111);
if (strcmp (bufd, "1")) exit (1);
if (i != 3) exit (1);
exit(0);
}], ac_cv_have_working_vsnprintf=yes, ac_cv_have_working_vsnprintf=no, ac_cv_have_working_vsnprintf=cross)])
AC_MSG_RESULT([$ac_cv_have_working_vsnprintf])
if test x$ac_cv_have_working_snprintf$ac_cv_have_working_vsnprintf != "xyesyes"; then
AC_LIBOBJ(snprintf)
AC_MSG_WARN([Replacing missing/broken (v)snprintf() with version from http://www.ijs.si/software/snprintf/.])
AC_DEFINE(PREFER_PORTABLE_SNPRINTF, 1, "enable replacement (v)snprintf if system (v)snprintf is broken")
fi])
sympa-6.2.24/src/smtpc/smtpc.1.md 0000644 0001750 0001750 00000007230 13216651447 015431 0 ustar racke racke %SMTPC(1)
# NAME
smtpc - SMTP / LMTP client
# SYNOPSIS
`smtpc` `--esmtp` _host_`:`_port_ `-f` _envelope_@_sen.der_
[ _options_... ] [ `--` ] _recipient_@_add.ress_ ...
`smtpc` `--lmtp` _host_`:`_port_ `-f` _envelope_@_sen.der_
[ _options_... ] [ `--` ] _recipient_@_add.ress_ ...
`smtpc` `--lmtp` _path_ `-f` _envelope_@_sen.der_
[ _options_... ] [ `--` ] _recipient_@_add.ress_ ...
# DESCRIPTION
**smtpc** is an email client.
It reads a message from standard input and submits it to email server through
socket.
## Options
Any options not listed here are silently ignored.
* `--dump`
Show dialog in the session.
* `--esmtp` _host_[:_port_]
Uses TCP socket and ESMTP protocol to submit message.
Either this option or `--lmtp` option is required.
If _host_ is the IPv6 address, it must be enclosed in [...]
to avoid confusion with colon separating _host_ and _port_,
e.g. "`[::1]`", "`[::1]:587`".
If _port_ is omitted, "25" is used.
* `-f` _envelope_@_sen.der_, `-f`_envelope_@_sen.der_
Specifys envelope sender.
This option is required.
To specify "null envelope sender", use a separate empty argument or "`<>`".
* `--iam` _host.name_
Specifys host name or IP address literal used in EHLO or LHLO request.
Default is "`localhost`".
* `--lmtp` _host_[:_port_], `--lmtp` _path_
Uses TCP or Unix domain socket and LMTP protocol to submit message.
Either this option or `--esmtp` option is required.
If _port_ is omitted, "24" is used.
_path_ must be full path to socket file.
* `-N` _dsn_, `-N`_dsn_
Controls delivery status notification.
_dsn_ may be single word "`NEVER`" or one or more of words "`SUCCESS`",
"`FAILURE`" and "`DELAY`" separated by comma.
If this option is not given, delivery status notification will be controlled
by server.
* `--smtputf8`
Enables support for SMTPUTF8 extension.
**smtpc** detects valid UTF-8 sequence in envelope and message header,
then requests this extension as neccessity.
* `-V` _envid_, `-V`_envid_
Specifys envelope ID.
* `--verbose`
Output the last response from the server to standard output.
* `--`
Terminates options.
Remainder of command line arguments are considered to be recipient
addresses, even if any of them begin with "`-`".
* _recipent_@_add.ress_ ...
Recipients to whom the message would be delivered.
At least one recipient is required.
## Exit status
* `0`
Message was successfully submitted.
* `253`
Message was rejected by server.
* `254`
The server returns malformed or illegal response.
* `255`
Network error occurred.
## SMTP extensions
**smtpc** supports following extensions.
* **8-bit MIME Transport** (RFC 6152)
**smtpc** requests this extension if message contains octets with high bit.
* **Delivery Status Notification** (RFC 3461)
**smtpc** issues ORCPT parameters.
See also `-N` and `-V` options.
* **Internationalized Email** (RFC 6531)
Experimentally supported.
See `--smtputf8` option.
* **Message Size Declaration** (RFC 1870)
Estimated size of the message is informed to the server.
# LIMITATIONS
**smtpc** provides the feature of SMTP / LMTP client submitting messages
to particular server.
It will never provide extensive features such as message queuing, retry after
temporary failure, routing using MX DNS record and so on.
Once the server rejects delivery, **smtpc** exits and message is discarded.
# KNOWN BUGS
* If NUL octets (\\0) are included in messages, they are transmitted to the
server.
# SEE ALSO
sendmail(1)
# HISTORY
**smtpc** was initially written for Sympa project by
IKEDA Soji .
sympa-6.2.24/src/smtpc/configure.gnu 0000644 0001750 0001750 00000000465 13216651447 016321 0 ustar racke racke # $Id$
args=
for arg; do
case "$arg" in
*\'*)
arg=`cat <.
*/
#include
#include
extern size_t utf8_check(const unsigned char *, const size_t);
sympa-6.2.24/src/sbin/ 0000755 0001750 0001750 00000000000 13216651447 013425 5 ustar racke racke sympa-6.2.24/src/sbin/sympa_wizard.pl.in 0000644 0001750 0001750 00000055047 13216651447 017113 0 ustar racke racke #!--PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
#
# 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, see .
use lib '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use Sys::Hostname qw();
use Sympa::ConfDef;
use Sympa::Constants;
use Sympa::ModDef;
my $with_CPAN; # check if module "CPAN" installed.
my $modfail; # any of required modules are not installed.
BEGIN {
$with_CPAN = eval { require CPAN; };
$modfail = !eval {
require Conf;
require Sympa::Language;
require Sympa::Tools::Text;
};
}
# Detect console encoding.
if (-t) {
no warnings;
eval { require Encode::Locale; };
unless ($EVAL_ERROR
or Encode::resolve_alias($Encode::Locale::ENCODING_CONSOLE_IN) eq
'ascii'
or Encode::resolve_alias($Encode::Locale::ENCODING_CONSOLE_OUT) eq
'ascii') {
binmode(STDIN, ':encoding(console_in):bytes');
binmode(STDOUT, ':encoding(console_out):bytes');
binmode(STDERR, ':encoding(console_out):bytes');
}
}
# Set language context if possible.
if ($modfail) {
no warnings;
*gettext = sub { $_[1] ? sprintf('%*s', $_[1], $_[0]) : $_[0] };
eval { require Text::Wrap; };
if ($EVAL_ERROR) {
*Sympa::Tools::Text::wrap_text = sub {"$_[1]$_[0]\n"};
} else {
$Text::Wrap::columns = 78;
*Sympa::Tools::Text::wrap_text =
sub { Text::Wrap::wrap($_[1], $_[2], $_[0]) . "\n"; };
}
} else {
no warnings;
my $language = Sympa::Language->instance;
*gettext = sub {
$_[1]
? Sympa::Tools::Text::pad($language->gettext($_[0]), $_[1])
: $language->gettext($_[0]);
};
*gettext_strftime = sub { $language->gettext_strftime(@_) };
my $lang = $ENV{'LANGUAGE'} || $ENV{'LC_ALL'} || $ENV{'LANG'};
$lang =~ s/\..*// if $lang;
$language->set_lang($lang, 'en-US', 'en');
}
## sympa configuration file
my $sympa_conf = Sympa::Constants::CONFIG;
my %options;
GetOptions(
\%options,
'target=s',
'create:s', # parameter is optional and only "sympa.conf" is allowed.
'batch',
'display',
'check',
'help|h',
'version|v',
);
if ($options{help}) {
pod2usage();
} elsif ($options{'version'}) {
printf "Sympa %s\n", Sympa::Constants::VERSION;
exit 0;
} elsif (defined $options{create}) {
create_configuration();
} elsif ($options{display}) {
display_configuration();
} elsif ($options{check}) {
check_cpan();
} else {
my %user_param;
foreach my $arg (@ARGV) {
# check for key/values settings
if ($arg =~ /\A(\w+)=(.+)/) {
$user_param{$1} = $2;
} else {
die "$0: Invalid commandline argument: $arg\n";
}
}
edit_configuration(%user_param);
}
exit 0;
sub create_configuration {
my $conf;
if ($options{create} eq '' or $options{create} eq 'sympa.conf') {
$conf = $options{target} ? $options{target} : $sympa_conf;
} else {
pod2usage("$options{create} is not a valid argument");
exit 1;
}
if (-f $conf) {
print STDERR "$conf file already exists, exiting\n";
exit 1;
}
my $umask = umask 037;
unless (open NEWF, '>', $conf) {
umask $umask;
die "$0: "
. sprintf(gettext("Unable to open %s : %s"), $conf, $ERRNO)
. "\n";
}
umask $umask;
if ($options{create} eq 'sympa.conf') {
# print NEWF <{'name'}) {
$title = gettext($param->{'gettext_id'})
if $param->{'gettext_id'};
next;
}
next unless $param->{'file'};
##next unless defined $param->{'default'} or defined $param->{'sample'};
if ($title) {
printf NEWF "###\\\\\\\\ %s ////###\n\n", $title;
undef $title;
}
printf NEWF "## %s\n", $param->{'name'};
if ($param->{'gettext_id'}) {
print NEWF Sympa::Tools::Text::wrap_text(
gettext($param->{'gettext_id'}),
'## ', '## ');
}
print NEWF Sympa::Tools::Text::wrap_text(
gettext($param->{'gettext_comment'}),
'## ', '## ')
if $param->{'gettext_comment'};
if (defined $param->{'sample'}) {
printf NEWF '## ' . gettext('Example: ') . "%s\t%s\n",
$param->{'name'}, $param->{'sample'};
}
if (defined $param->{'default'}) {
printf NEWF "#%s\t%s\n", $param->{'name'}, $param->{'default'};
} elsif ($param->{'optional'}) {
printf NEWF "#%s\t\n", $param->{'name'};
} else {
printf NEWF "#%s\t%s\n", $param->{'name'},
gettext("(You must define this parameter)");
}
print NEWF "\n";
}
close NEWF;
print STDERR "$conf file has been created\n";
}
sub display_configuration {
die "$0: You must run as superuser.\n"
if $UID;
die "$0: Installation of Sympa has not been completed.\n"
. "Run sympa_wizard.pl --check\n"
if $modfail;
# Load sympa config (but not using database)
unless (defined Conf::load($sympa_conf, 1)) {
printf STDERR
"$0: Unable to load sympa configuration, file %s or one of the virtual host robot.conf files contain errors. Exiting.\n",
$sympa_conf;
exit 1;
}
my ($var, $disp);
print "[SYMPA]\n";
foreach my $key (sort keys %Conf::Conf) {
next
if grep { $key eq $_ }
qw(auth_services blacklist cas_number crawlers_detection
generic_sso_number ldap ldap_number listmasters
locale2charset nrcpt_by_domain robot_by_http_host request
robot_name robots source_file sympa trusted_applications
use_passwd);
$var = $Conf::Conf{$key};
if ($key eq 'automatic_list_families') {
$disp = join ';', map {
my $name = $_;
join ':', map { sprintf '%s=%s', $_, $var->{$name}{$_} }
grep { !/\Aescaped_/ }
sort keys %{$var->{$name} || {}};
} sort keys %{$var || {}};
} elsif (ref $var eq 'ARRAY') {
$disp = join(',', map { defined $_ ? $_ : '' } @$var);
} else {
$disp = defined $var ? $var : '';
}
printf "%s=\"%s\"\n", $key, $disp;
}
}
sub edit_configuration {
my %user_param = @_;
die "$0: You must run as superuser.\n"
if $UID;
die "$0: Installation of Sympa has not been completed.\n"
. "Run sympa_wizard.pl --check\n"
if $modfail;
# complement required fields.
foreach my $param (@Sympa::ConfDef::params) {
next unless $param->{'name'};
if ($param->{'name'} eq 'domain') {
$param->{'default'} = Sys::Hostname::hostname();
} elsif ($param->{'name'} eq 'wwsympa_url') {
$param->{'default'} = sprintf 'http://%s/sympa',
Sys::Hostname::hostname();
} elsif ($param->{'name'} eq 'listmaster') {
$param->{'default'} = sprintf 'your_email_address@%s',
Sys::Hostname::hostname();
}
}
## Load sympa config (but not using database)
unless (defined Conf::load($sympa_conf, 1)) {
printf STDERR
"$0: Unable to load sympa configuration, file %s or one of the virtual host robot.conf files contain errors. Exiting.\n",
$sympa_conf;
exit 1;
}
my $somechange = 0;
my @new_sympa_conf;
my $title = undef;
# dynamic defaults
my $domain = Sys::Hostname::hostname();
my $http_host = "http://$domain";
## Edition mode
foreach my $param (@Sympa::ConfDef::params) {
unless ($param->{'name'}) {
$title = gettext($param->{'gettext_id'})
if $param->{'gettext_id'};
next;
}
my $file = $param->{'file'};
my $name = $param->{'name'};
my $query = $param->{'gettext_id'} || '';
$query = gettext($query) if $query;
my $advice = $param->{'gettext_comment'};
$advice = gettext($advice) if $advice;
my $sample = $param->{'sample'};
my $current_value;
next unless $file;
if ($file eq 'sympa.conf' or $file eq 'wwsympa.conf') {
$current_value = $Conf::Conf{$name};
$current_value = '' unless defined $current_value;
} else {
next;
}
if ($title) {
## write to conf file
push @new_sympa_conf,
sprintf "###\\\\\\\\ %s ////###\n\n", $title;
}
my $new_value = '';
if ($options{batch}) {
if (exists $user_param{$name}) {
$new_value = $user_param{$name};
}
} elsif ($param->{'edit'} and $param->{'edit'} eq '1') {
print "\n\n** $title **\n" if $title;
print "\n";
print Sympa::Tools::Text::wrap_text($query || '', '* ', ' ');
print Sympa::Tools::Text::wrap_text($advice, ' ... ', ' ')
if $advice;
printf(gettext('%s [%s] : '), $name, $current_value);
$new_value = ;
chomp $new_value;
}
if ($new_value eq '') {
$new_value = $current_value;
}
undef $title;
## Skip empty parameters
next if $new_value eq '' and !$sample;
## param is an ARRAY
if (ref($new_value) eq 'ARRAY') {
$new_value = join ',', @{$new_value};
}
unless ($file eq 'sympa.conf' or $file eq 'wwsympa.conf') {
printf STDERR gettext("Incorrect parameter definition: %s\n"),
$file;
}
if ($new_value eq '') {
next unless $sample;
push @new_sympa_conf,
Sympa::Tools::Text::wrap_text($query, '## ', '## ');
if (defined $advice and length $advice) {
push @new_sympa_conf,
Sympa::Tools::Text::wrap_text($advice, '## ', '## ');
}
push @new_sympa_conf, "# $name\t$sample\n\n";
} else {
push @new_sympa_conf,
Sympa::Tools::Text::wrap_text($query, '## ', '## ');
if (defined $advice and length $advice) {
push @new_sympa_conf,
Sympa::Tools::Text::wrap_text($advice, '## ', '## ');
}
if ($current_value ne $new_value) {
push @new_sympa_conf, "# was $name $current_value\n";
$somechange = 1;
}
push @new_sympa_conf, "$name\t$new_value\n\n";
}
}
if ($somechange) {
my $date = gettext_strftime("%d.%b.%Y-%H.%M.%S", localtime(time));
## Keep old config file
unless (rename $sympa_conf, $sympa_conf . '.' . $date) {
warn sprintf(gettext("Unable to rename %s : %s"),
$sympa_conf, $ERRNO);
}
## Write new config file
my $umask = umask 037;
unless (open(SYMPA, "> $sympa_conf")) {
umask $umask;
die "$0: "
. sprintf(gettext("Unable to open %s : %s"),
$sympa_conf, $ERRNO)
. "\n";
}
umask $umask;
chown [getpwnam(Sympa::Constants::USER)]->[2],
[getgrnam(Sympa::Constants::GROUP)]->[2], $sympa_conf;
print SYMPA @new_sympa_conf;
close SYMPA;
printf gettext(
"%s have been updated.\nPrevious versions have been saved as %s.\n"
), $sympa_conf, "$sympa_conf.$date";
}
}
sub check_cpan {
print gettext(
"##############################################################################
# This process will help you install all Perl (CPAN) modules required by Sympa
# software.
# Sympa requires from 50 to 65 additional Perl modules to run properly.
# The whole installation process should take around 15 minutes.
# You'll first have to configure the CPAN shell itself and select your
# favourite CPAN server.
# Note that you might prefer to install the required Perl modules using your
# favourite DEB/RPM mechanism.
# Feel free to interrupt the process if needed ; you can restart it safely
# afterward.
##############################################################################
Press the Enter key to continue..."
) . "\n";
my $rep = ;
print "\n";
# Choose default DBD module if it has not been defined.
my $db_type;
if (open my $fh, '<', $sympa_conf) {
foreach my $line (<$fh>) {
if ($line =~ /\Adb_type\s+(\S*)/) {
$db_type = $1;
}
}
close $fh;
}
if ($db_type
and exists $Sympa::ModDef::cpan_modules{'DBD::' . $db_type}) {
$Sympa::ModDef::cpan_modules{'DBD::' . $db_type}->{mandatory} = 1;
} else {
my @dbd = (
'MySQL/MariaDB' => 'DBD::mysql',
'PostgreSQL' => 'DBD::Pg',
'SQLite' => 'DBD::SQLite',
'Oracle' => 'DBD::Oracle',
'Sybase' => 'DBD::Sybase',
);
my $selected;
while (1) {
print "\n"
. gettext('Which RDBMS will you use for core database:')
. "\n";
for (my $i = 0; $i < scalar @dbd; $i += 2) {
printf "%d: %s\n", $i / 2 + 1, $dbd[$i];
}
printf gettext('-> Select RDBMS [1-%d] '), scalar @dbd / 2;
$selected = ;
chomp $selected;
last
if $selected =~ /\A\d+\z/
and 0 < $selected
and $selected * 2 <= scalar @dbd;
}
$Sympa::ModDef::cpan_modules{$dbd[$selected * 2 - 1]}->{mandatory} =
1;
}
### REQ perl version
print "\n" . gettext('Checking for PERL version:') . "\n\n";
my $rpv = $Sympa::ModDef::cpan_modules{"perl"}{'required_version'};
if ($] >= $Sympa::ModDef::cpan_modules{"perl"}{'required_version'}) {
printf gettext('Your version of perl is OK (%s >= %s)') . "\n", $],
$rpv;
} else {
printf gettext(
"Your version of perl is TOO OLD (%s < %s)\nPlease INSTALL a new one !"
) . "\n", $], $rpv;
}
print "\n" . gettext('Checking for REQUIRED modules:') . "\n\n";
check_modules('y', \%Sympa::ModDef::cpan_modules, 'mandatory');
print "\n" . gettext('Checking for OPTIONAL modules:') . "\n\n";
check_modules('n', \%Sympa::ModDef::cpan_modules, 'optional');
print gettext(
"******* NOTE *******
You can retrieve all theses modules from any CPAN server
(for example ftp://ftp.pasteur.fr/pub/computing/CPAN/CPAN.html)"
) . "\n";
###--------------------------
# reports modules status
# $cpan_modules is the cpan_modules structure
# $type is the type of modules (mandatory | optional) that should be installed
###--------------------------
}
sub check_modules {
# my($default, $todo, $versions, $opt_features) = @_;
my ($default, $cpan_modules, $type) = @_;
printf "%s%s%s\n", gettext('perl module', -24), gettext('from CPAN', -24),
gettext('STATUS');
printf "%-24s%-24s%s\n", gettext('-----------'), gettext('---------'),
gettext('------');
foreach my $mod (sort keys %$cpan_modules) {
## Only check modules of the expected type
if ($type eq 'mandatory') {
next unless ($cpan_modules->{$mod}{mandatory});
} elsif ($type eq 'optional') {
next if ($cpan_modules->{$mod}{mandatory});
}
## Skip perl itself to prevent a huge upgrade
next if ($mod eq 'perl');
printf("%-24s%-24s", $mod, $cpan_modules->{$mod}{package_name});
eval "require $mod";
if ($EVAL_ERROR) {
### not installed
print gettext('was not found on this system.') . "\n";
install_module($mod, {'default' => $default}, $cpan_modules);
} else {
my ($vs, $v);
## MHonArc module does not provide its version the standard way
if ($mod =~ /^MHonArc/i) {
require "mhamain.pl";
$v = $mhonarc::VERSION;
} else {
$vs = "$mod" . "::VERSION";
{
no strict 'refs';
$v = $$vs;
}
}
my $rv = $cpan_modules->{$mod}{required_version} || "1.0";
### OK: check version
if ($v ge $rv) {
printf gettext('OK (%-6s >= %s)') . "\n", $v, $rv;
next;
} else {
printf gettext('version is too old (%s < %s)') . "\n", $v,
$rv;
printf gettext(
'>>>>>>> You must update "%s" to version "%s" <<<<<<.')
. "\n", $cpan_modules->{$mod}{package_name},
$cpan_modules->{$mod}{required_version};
install_module($mod, {'default' => $default}, $cpan_modules);
}
}
}
}
##----------------------
# Install a CPAN module
##----------------------
sub install_module {
return unless $with_CPAN;
my ($module, $options, $cpan_modules) = @_;
my $default = $options->{'default'};
unless ($ENV{'FTP_PASSIVE'} and $ENV{'FTP_PASSIVE'} eq 1) {
$ENV{'FTP_PASSIVE'} = 1;
print "Setting FTP Passive mode\n";
}
# This is required on RedHat 9 for DBD::mysql installation
my $lang;
if ($ENV{'LANG'} and $ENV{'LANG'} =~ /UTF-8/) {
$lang = $ENV{'LANG'};
$ENV{'LANG'} = 'C';
}
unless ($EUID == 0) {
printf gettext('## You need root privileges to install %s module. ##')
. "\n", $module;
print gettext(
'## Press the Enter key to continue checking modules. ##')
. "\n";
my $t = ;
return undef;
}
unless ($options->{'force'}) {
print Sympa::Tools::Text::wrap_text(
sprintf(
gettext('-> Usage of this module: %s') . "\n",
gettext($cpan_modules->{$module}{'gettext_id'})
),
'', ' '
) if ($cpan_modules->{$module}{'gettext_id'});
print Sympa::Tools::Text::wrap_text(
sprintf(
gettext('-> Prerequisites: %s') . "\n",
gettext($cpan_modules->{$module}{'gettext_comment'})
),
'', ' '
) if ($cpan_modules->{$module}{'gettext_comment'});
printf gettext('-> Install module %s ? [%s] '), $module, $default;
my $answer = ;
chomp $answer;
$answer ||= $default;
return unless ($answer =~ /^y$/i);
}
$CPAN::Config->{'inactivity_timeout'} =
0; ## disable timeout to prevent timeout during modules installation
$CPAN::Config->{'colorize_output'} = 1;
$CPAN::Config->{'build_requires_install_policy'} =
'yes'; ## automatically installed prerequisites without asking
$CPAN::Config->{'prerequisites_policy'} =
'follow'; ## build prerequisites automatically
$CPAN::Config->{'load_module_verbosity'} =
'none'; ## minimum verbosity during module loading
$CPAN::Config->{'tar_verbosity'} =
'none'; ## minimum verbosity with tar command
# CPAN::Shell->clean($module) if ($options->{'force'});
# CPAN::Shell->make($module);
# if ($options->{'force'}) {
# CPAN::Shell->force('test', $module);
# } else {
# CPAN::Shell->test($module);
# }
# # Could use CPAN::Shell->force('install') if make test failed
CPAN::Shell->install($module);
## Check if module has been successfuly installed
unless (eval "require $module") {
## Prevent recusive calls if already in force mode
if ($options->{'force'}) {
printf gettext(
"Installation of %s still FAILED. You should download the tar.gz from http://search.cpan.org and install it manually."
), $module;
my $answer = ;
} else {
printf gettext(
'Installation of %s FAILED. Do you want to force the installation of this module? (y/N) '
), $module;
my $answer = ;
chomp $answer;
if ($answer =~ /^y/i) {
install_module($module, {'force' => 1}, $cpan_modules);
}
}
}
# Restore lang
$ENV{'LANG'} = $lang if $lang;
}
__END__
=encoding utf-8
=head1 NAME
sympa_wizard, sympa_wizard.pl - Help Performing Sympa Initial Setup
=head1 SYNOPSIS
C
S<[ C<--batch> [ I=I ... ] ]>
S<[ C<--check> ]>
S<[ C<--create> [ C<--target=>I ] ]>
S<[ C<--display> ]>
S<[ C<-h, --help> ]>
S<[ C<-v, --version> ]>
=head1 OPTIONS
=over 4
=item C
Edit current Sympa configuration.
=item C C<--batch> I=I ...
Edit in batch mode.
Arguments would include pairs of parameter name and value.
=item C C<--check>
Check CPAN modules needed for running Sympa.
=item C C<--create> [ C<--target> I ]
Creates a new F configuration file.
=item C C<--display>
Outputs all configuration parameters.
=item C C<--help>
Display usage instructions.
=item C C<--version>
Print version number.
=back
=head1 HISTORY
This program was originally written by:
=over 4
=item Serge Aumont
=item Olivier SalaE<252>n
=back
C<--batch> and C<--display> options are added on Sympa 6.1.25 and 6.2.15.
=cut
sympa-6.2.24/src/sbin/sympa.pl.in 0000644 0001750 0001750 00000116037 13216651447 015530 0 ustar racke racke #!--PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
# directory of this distribution and at
# .
#
# 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, see .
use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use Digest::MD5;
use English qw(-no_match_vars);
use Fcntl qw();
use File::Basename qw();
use File::Copy qw();
use File::Path qw();
use Getopt::Long;
use Pod::Usage;
use POSIX qw();
use Conf;
use Sympa::Config_XML;
use Sympa::Constants;
use Sympa::DatabaseManager;
use Sympa::Family;
use Sympa::Language;
use Sympa::List;
use Sympa::Log;
use Sympa::Mailer;
use Sympa::Spindle::ProcessDigest;
use Sympa::Spindle::ProcessRequest;
use Sympa::Tools::Data;
use Sympa::Upgrade;
## Init random engine
srand(time());
# Check options.
my %options;
unless (
GetOptions(
\%main::options, 'dump=s',
'debug|d', 'log_level=s',
'config|f=s', 'lang|l=s',
'mail|m', 'help|h',
'version|v', 'import=s',
'make_alias_file', 'lowercase',
'sync_list_db', 'md5_encode_password',
'close_list=s', 'rename_list=s',
'new_listname=s', 'new_listrobot=s',
'purge_list=s', 'create_list',
'instantiate_family=s', 'robot=s',
'add_list=s', 'modify_list=s',
'close_family=s', 'md5_digest=s',
'change_user_email', 'current_email=s',
'new_email=s', 'input_file=s',
'sync_include=s', 'upgrade',
'upgrade_shared', 'from=s',
'to=s', 'reload_list_config',
'list=s', 'quiet',
'close_unknown', 'test_database_message_buffer',
'conf_2_db', 'export_list',
'health_check', 'send_digest',
'keep_digest', 'upgrade_config_location',
)
) {
pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($main::options{'help'}) {
pod2usage(0);
} elsif ($main::options{'version'}) {
printf "Sympa %s\n", Sympa::Constants::VERSION;
exit 0;
}
$Conf::sympa_config = $main::options{config};
if ($main::options{'debug'}) {
$main::options{'log_level'} = 2 unless $main::options{'log_level'};
}
my $log = Sympa::Log->instance;
$log->{log_to_stderr} = 'notice,err'
if $main::options{'upgrade'}
|| $main::options{'reload_list_config'}
|| $main::options{'test_database_message_buffer'}
|| $main::options{'conf_2_db'};
if ($main::options{'upgrade_config_location'}) {
my $config_file = Conf::get_sympa_conf();
if (-f $config_file) {
printf "Sympa configuration already located at %s\n", $config_file;
exit 0;
}
my ($file, $dir, $suffix) = File::Basename::fileparse($config_file);
my $old_dir = $dir;
$old_dir =~ s/sympa\///;
# Try to create config path if it does not exist
unless (-d $dir) {
my $error;
File::Path::make_path(
$dir,
{ mode => 0755,
owner => 'sympa',
group => 'sympa',
error => \$error
}
);
if (@$error) {
my $diag = pop @$error;
my ($target, $error) = %$diag;
die "Unable to create $target: $error";
}
}
# Check ownership of config folder
my @stat = stat($dir);
my $user = (getpwuid $stat[4])[0];
if ($user ne 'sympa') {
die
"Config dir $dir exists but is not owned by sympa (owned by $user)";
}
# Check permissions on config folder
if (($stat[2] & Fcntl::S_IRWXU()) != Fcntl::S_IRWXU()) {
die
"Config dir $dir exists, but sympa does not have rwx permissions on it";
}
# Move files from old location to new one
opendir(my $dh, $old_dir) or die("Could not open $dir for reading");
my @files = grep(/^(ww)?sympa\.conf.*$/, readdir($dh));
closedir($dh);
foreach my $file (@files) {
unless (File::Copy::move("$old_dir/$file", "$dir/$file")) {
die sprintf 'Could not move %s/%s to %s/%s: %s', $old_dir, $file,
$dir, $file, $ERRNO;
}
}
printf "Sympa configuration moved to $dir\n";
exit 0;
} elsif ($main::options{'health_check'}) {
## Health check
## Load configuration file. Ignoring database config for now: it avoids
## trying to load a database that could not exist yet.
unless (Conf::load(Conf::get_sympa_conf(), 'no_db')) {
#FIXME: force reload
die sprintf
"Configuration file %s has errors.\n",
Conf::get_sympa_conf();
}
## Open the syslog and say we're read out stuff.
$log->openlog(
$Conf::Conf{'syslog'},
$Conf::Conf{'log_socket_type'},
service => 'sympa/health_check'
);
## Setting log_level using conf unless it is set by calling option
if ($main::options{'log_level'}) {
$log->{level} = $main::options{'log_level'};
$log->syslog(
'info',
'Configuration file read, log level set using options: %s',
$main::options{'log_level'}
);
} else {
$log->{level} = $Conf::Conf{'log_level'};
$log->syslog(
'info',
'Configuration file read, default log level %s',
$Conf::Conf{'log_level'}
);
}
if (Conf::cookie_changed()) {
die sprintf
'sympa.conf/cookie parameter has changed. You may have severe inconsitencies into password storage. Restore previous cookie or write some tool to re-encrypt password in database and check spools contents (look at %s/cookies.history file).',
$Conf::Conf{'etc'};
}
## Check database connectivity and probe database
unless (Sympa::DatabaseManager::probe_db()) {
die sprintf
"Database %s defined in sympa.conf has not the right structure or is unreachable. verify db_xxx parameters in sympa.conf\n",
$Conf::Conf{'db_name'};
}
## Now trying to load full config (including database)
unless (Conf::load()) { #FIXME: load Site, then robot cache
die sprintf
"Unable to load Sympa configuration, file %s or any of the virtual host robot.conf files contain errors. Exiting.\n",
Conf::get_sympa_conf();
}
## Change working directory.
if (!chdir($Conf::Conf{'home'})) {
printf STDERR "Can't chdir to %s: %s\n", $Conf::Conf{'home'}, $ERRNO;
exit 1;
}
## Check for several files.
unless (Conf::checkfiles_as_root()) {
printf STDERR "Missing files.\n";
exit 1;
}
## Check that the data structure is uptodate
unless (Conf::data_structure_uptodate()) {
printf STDOUT
"Data structure was not updated; you should run sympa.pl --upgrade to run the upgrade process.\n";
}
exit 0;
}
my $default_lang;
my $language = Sympa::Language->instance;
my $mailer = Sympa::Mailer->instance;
_load();
$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});
# Set the User ID & Group ID for the process
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];
## Required on FreeBSD to change ALL IDs
## (effective UID + real UID + saved UID)
POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);
## Check if the UID has correctly been set (useful on OS X)
unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
&& ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
die
"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.\n";
}
# Sets the UMASK
umask(oct($Conf::Conf{'umask'}));
## Most initializations have now been done.
$log->syslog('notice', 'Sympa %s Started', Sympa::Constants::VERSION());
# Check for several files.
#FIXME: This would be done in --health_check mode.
unless (Conf::checkfiles()) {
die "Missing files.\n";
## No return.
}
# Daemon called for dumping subscribers list
if ($main::options{'dump'}) {
my ($all_lists, $list);
if ($main::options{'dump'} eq 'ALL') {
$all_lists = Sympa::List::get_lists('*');
} else {
## The parameter can be a list address
unless ($main::options{'dump'} =~ /\@/) {
$log->syslog('err', 'Incorrect list address %s',
$main::options{'dump'});
exit;
}
my $list = Sympa::List->new($main::options{'dump'});
unless (defined $list) {
$log->syslog('err', 'Unknown list %s', $main::options{'dump'});
exit;
}
push @$all_lists, $list;
}
foreach my $list (@$all_lists) {
unless ($list->dump()) {
print STDERR "Could not dump list(s)\n";
}
}
exit 0;
} elsif ($main::options{'make_alias_file'}) {
my $robots = $main::options{'robot'} || '*';
my @robots;
if ($robots eq '*') {
@robots = Sympa::List::get_robots();
} else {
@robots = grep { length $_ } split(/[\s,]+/, $robots);
}
exit 0 unless @robots;
# There may be multiple aliases files. Give each of them suffixed
# name.
my ($basename, %robots_of, %sympa_aliases);
$basename = sprintf '%s/sympa_aliases.%s', $Conf::Conf{'tmpdir'}, $PID;
foreach my $robot (@robots) {
my $file = Conf::get_robot_conf($robot, 'sendmail_aliases');
$robots_of{$file} ||= [];
push @{$robots_of{$file}}, $robot;
}
if (1 < scalar(keys %robots_of)) {
my $i = 0;
%sympa_aliases = map {
$i++;
map { $_ => sprintf('%s.%03d', $basename, $i) } @{$robots_of{$_}}
} sort keys %robots_of;
} else {
%sympa_aliases = map { $_ => $basename } @robots;
}
# Create files.
foreach my $sympa_aliases (values %sympa_aliases) {
my $fh;
unless (open $fh, '>', $sympa_aliases) { # truncate if exists
printf STDERR "Unable to create %s: %s\n", $sympa_aliases, $ERRNO;
exit 1;
}
close $fh;
}
# Write files.
foreach my $robot (sort @robots) {
my $all_lists = Sympa::List::get_lists($robot);
my $alias_manager = Conf::get_robot_conf($robot, 'alias_manager');
my $sympa_aliases = $sympa_aliases{$robot};
my $fh;
unless (open $fh, '>>', $sympa_aliases) { # append
printf STDERR "Unable to create %s: %s\n", $sympa_aliases, $ERRNO;
exit 1;
}
printf $fh "#\n#\tAliases for all Sympa lists open on %s\n#\n",
$robot;
close $fh;
foreach my $list (@{$all_lists || []}) {
next unless $list->{'admin'}{'status'} eq 'open';
system($alias_manager, 'add', $list->{'name'}, $list->{'domain'},
$sympa_aliases);
}
}
if (1 < scalar(keys %robots_of)) {
printf
"Sympa aliases files %s.??? were made. You probably need to install them in your SMTP engine.\n",
$basename;
} else {
printf
"Sympa aliases file %s was made. You probably need to install it in your SMTP engine.\n",
$basename;
}
exit 0;
} elsif ($main::options{'md5_digest'}) {
my $md5 = Digest::MD5::md5_hex($main::options{'md5_digest'});
printf "md5 digest : $md5 \n";
exit 0;
} elsif ($main::options{'import'}) {
#FIXME The parameter should be a list address.
unless ($main::options{'import'} =~ /\@/) {
printf STDERR "Incorrect list address %s\n", $main::options{'import'};
exit 1;
}
my $list;
unless ($list = Sympa::List->new($main::options{'import'})) {
printf STDERR "Unknown list name %s\n", $main::options{'import'};
exit 1;
}
my $dump = do { local $RS; };
my $spindle = Sympa::Spindle::ProcessRequest->new(
context => $list,
action => 'import',
dump => $dump,
force => 1,
sender => Sympa::get_address($list, 'listmaster'),
scenario_context => {skip => 1},
);
unless ($spindle and $spindle->spin) {
printf STDERR "Failed to add email addresses to %s\n", $list;
exit 1;
}
my $status = _report($spindle);
printf STDERR "Total imported subscribers: %d\n",
scalar(grep { $_->[1] eq 'notice' and $_->[2] eq 'now_subscriber' }
@{$spindle->{stash} || []});
exit($status ? 0 : 1);
} elsif ($main::options{'md5_encode_password'}) {
printf STDERR "Obsoleted. Use upgrade_sympa_password.pl.\n";
exit 0;
} elsif ($main::options{'lowercase'}) {
print STDERR "Working on user_table...\n";
my $total = _lowercase_field('user_table', 'email_user');
if (defined $total) {
print STDERR "Working on subscriber_table...\n";
my $total_sub =
_lowercase_field('subscriber_table', 'user_subscriber');
if (defined $total_sub) {
$total += $total_sub;
}
}
unless (defined $total) {
print STDERR "Could not work on dabatase.\n";
exit 1;
}
printf STDERR "Total lowercased rows: %d\n", $total;
exit 0;
} elsif ($main::options{'close_list'}) {
my ($listname, $robot_id) = split /\@/, $main::options{'close_list'}, 2;
my $current_list = Sympa::List->new($listname, $robot_id);
unless ($current_list) {
printf STDERR "Incorrect list name %s.\n",
$main::options{'close_list'};
exit 1;
}
my $spindle = Sympa::Spindle::ProcessRequest->new(
context => $robot_id,
action => 'close_list',
current_list => $current_list,
sender => Sympa::get_address($robot_id, 'listmaster'),
scenario_context => {skip => 1},
);
unless ($spindle and $spindle->spin and _report($spindle)) {
printf STDERR "Could not close list %s\n", $current_list->get_id;
exit 1;
}
exit 0;
} elsif ($main::options{'change_user_email'}) {
unless ($main::options{'current_email'} and $main::options{'new_email'}) {
print STDERR "Missing current_email or new_email parameter\n";
exit 1;
}
my $spindle = Sympa::Spindle::ProcessRequest->new(
context => [Sympa::List::get_robots()],
action => 'move_user',
current_email => $main::options{'current_email'},
email => $main::options{'new_email'},
sender => Sympa::get_address('*', 'listmaster'),
scenario_context => {skip => 1},
);
unless ($spindle and $spindle->spin and _report($spindle)) {
printf STDERR "Failed to change user email address %s to %s\n",
$main::options{'current_email'}, $main::options{'new_email'};
exit 1;
}
exit 0;
} elsif ($main::options{'purge_list'}) {
my ($listname, $robot_id) = split /\@/, $main::options{'purge_list'}, 2;
my $current_list = Sympa::List->new($listname, $robot_id);
unless ($current_list) {
print STDERR "Incorrect list name $main::options{'purge_list'}\n";
exit 1;
}
my $spindle = Sympa::Spindle::ProcessRequest->new(
context => $robot_id,
action => 'close_list',
current_list => $current_list,
mode => 'purge',
scenario_context => {skip => 1},
);
unless ($spindle and $spindle->spin and _report($spindle)) {
printf STDERR "Could not purge list %s\n", $current_list->get_id;
exit 1;
}
exit 0;
} elsif ($main::options{'rename_list'}) {
my $current_list =
Sympa::List->new(split(/\@/, $main::options{'rename_list'}, 2),
{just_try => 1});
unless ($current_list) {
printf STDERR "Incorrect list name %s\n",
$main::options{'rename_list'};
exit 1;
}
my $listname = $main::options{'new_listname'};
unless (defined $listname and length $listname) {
print STDERR "Missing parameter new_listname\n";
exit 1;
}
my $robot_id = $main::options{'new_listrobot'};
unless (defined $robot_id) {
$robot_id = $current_list->{'domain'};
} else {
unless (length $robot_id and Conf::valid_robot($robot_id)) {
print STDERR "Unknown robot \"%s\"\n";
exit 1;
}
}
my $spindle = Sympa::Spindle::ProcessRequest->new(
context => $robot_id,
action => 'move_list',
current_list => $current_list,
listname => $listname,
sender => Sympa::get_address($robot_id, 'listmaster'),
scenario_context => {skip => 1},
);
unless ($spindle and $spindle->spin and _report($spindle)) {
printf STDERR "Could not rename list %s to %s%s\n",
$current_list->get_id, $listname, $robot_id;
exit 1;
}
exit 0;
} elsif ($main::options{'test_database_message_buffer'}) {
printf
"Deprecated. Size of messages no longer limited by database packet size.\n";
exit 1;
} elsif ($main::options{'conf_2_db'}) {
printf
"Sympa is going to store %s in database conf_table. This operation do NOT remove original files\n",
Conf::get_sympa_conf();
if (Conf::conf_2_db()) {
printf "Done";
} else {
printf "an error occur";
}
exit 1;
} elsif ($main::options{'create_list'}) {
my $robot = $main::options{'robot'} || $Conf::Conf{'host'};
unless ($main::options{'input_file'}) {
print STDERR "Error : missing 'input_file' parameter\n";
exit 1;
}
my $fh;
unless (open $fh, '<', $main::options{'input_file'}) {
print STDERR "Unable to open %s: %s\n", $main::options{'input_file'},
$ERRNO;
exit 1;
}
my $config = Sympa::Config_XML->new($fh);
close $fh;
unless (defined $config->createHash()) {
print STDERR "Error in representation data with these XML data\n";
exit 1;
}
my $hash = $config->getHash();
my $spindle = Sympa::Spindle::ProcessRequest->new(
context => $robot,
action => 'create_list',
listname => $hash->{config}{listname},
parameters => {%{$hash->{config} || {}}, template => $hash->{type}},
sender => Sympa::get_address($robot, 'listmaster'),
scenario_context => {skip => 1}
);
unless ($spindle and $spindle->spin and _report($spindle)) {
printf STDERR "Could not create list %s\n", $hash->{config}{listname};
exit 1;
}
exit 0;
} elsif ($main::options{'instantiate_family'}) {
my $robot = $main::options{'robot'} || $Conf::Conf{'host'};
my $family_name;
unless ($family_name = $main::options{'instantiate_family'}) {
print STDERR "Error : missing family parameter\n";
exit 1;
}
my $family;
unless ($family = Sympa::Family->new($family_name, $robot)) {
print STDERR
"The family $family_name does not exist, impossible instantiation\n";
exit 1;
}
unless ($main::options{'input_file'}) {
print STDERR "Error : missing input_file parameter\n";
exit 1;
}
unless (-r $main::options{'input_file'}) {
print STDERR "Unable to read $main::options{'input_file'} file";
exit 1;
}
unless (
$family->instantiate(
$main::options{'input_file'},
close_unknown => $main::options{'close_unknown'},
quiet => $main::options{quiet},
)
) {
print STDERR "\nImpossible family instantiation : action stopped \n";
exit 1;
}
my %result;
my $err = $family->get_instantiation_results(\%result);
close INFILE;
unless ($main::options{'quiet'}) {
print STDOUT "@{$result{'info'}}";
print STDOUT "@{$result{'warn'}}";
}
if ($err) {
print STDERR "@{$result{'errors'}}";
}
exit 0;
} elsif ($main::options{'add_list'}) {
my $robot = $main::options{'robot'} || $Conf::Conf{'host'};
my $family_name;
unless ($family_name = $main::options{'add_list'}) {
print STDERR "Error : missing family parameter\n";
exit 1;
}
my $family;
unless ($family = Sympa::Family->new($family_name, $robot)) {
print STDERR
"The family %s does not exist, impossible to add a list\n",
$family_name;
exit 1;
}
unless ($main::options{'input_file'}) {
print STDERR "Error : missing 'input_file' parameter\n";
exit 1;
}
my $fh;
unless (open $fh, '<', $main::options{'input_file'}) {
printf STDERR "\n Impossible to open input file : %s\n", $ERRNO;
exit 1;
}
# get list data
my $config = Sympa::Config_XML->new($fh);
close $fh;
unless (defined $config->createHash()) {
print STDERR "Error in representation data with these XML data\n";
exit 1;
}
my $hash = $config->getHash();
my $spindle = Sympa::Spindle::ProcessRequest->new(
context => $family,
action => 'create_automatic_list',
listname => $hash->{config}{listname},
parameters => $hash->{config},
sender => Sympa::get_address($family, 'listmaster'),
scenario_context => {skip => 1},
);
unless ($spindle and $spindle->spin and _report($spindle)) {
print STDERR "Impossible to add a list %s to the family %s\n",
$hash->{config}{listname}, $family_name;
exit 1;
}
my $list = Sympa::List->new($hash->{config}{listname}, $family->{'robot'});
unless (File::Copy::copy($main::options{'input_file'},
$list->{'dir'} . '/instance.xml')) {
$list->set_status_error_config('error_copy_file', $family->{'name'});
print STDERR "Impossible to copy the XML file in the list directory, the list is set in status error_config.\n";
}
exit 0;
} elsif ($main::options{'sync_include'}) {
my $list = Sympa::List->new($main::options{'sync_include'});
unless (defined $list) {
print STDERR "Incorrect list name $main::options{'sync_include'}\n";
exit 1;
}
unless (defined $list->sync_include()) {
print STDERR "Failed to synchronize list members\n";
exit 1;
}
printf "Members of list %s have been successfully update.\n",
$list->get_id;
exit 0;
## Migration from one version to another
} elsif ($main::options{'upgrade'}) {
$log->syslog('notice', "Upgrade process...");
$main::options{'from'} ||= Sympa::Upgrade::get_previous_version();
$main::options{'to'} ||= Sympa::Constants::VERSION;
if ($main::options{'from'} eq $main::options{'to'}) {
$log->syslog('notice', 'Current version: %s; no upgrade is required',
$main::options{'to'});
exit 0;
} else {
$log->syslog('notice', "Upgrading from %s to %s...",
$main::options{'from'}, $main::options{'to'});
}
unless (
Sympa::Upgrade::upgrade($main::options{'from'}, $main::options{'to'}))
{
$log->syslog('err', "Migration from %s to %s failed",
$main::options{'from'}, $main::options{'to'});
exit 1;
}
$log->syslog('notice', 'Upgrade process finished');
Sympa::Upgrade::update_version();
exit 0;
} elsif ($main::options{'upgrade_shared'}) {
printf STDERR "Obsoleted. Use upgrade_shared_repository.pl.\n";
exit 0;
} elsif ($main::options{'reload_list_config'}) {
if ($main::options{'list'}) {
$log->syslog('notice', 'Loading list %s...', $main::options{'list'});
my $list =
Sympa::List->new($main::options{'list'}, '',
{'reload_config' => 1, 'force_sync_admin' => 1});
unless (defined $list) {
print STDERR
"Error : incorrect list name '$main::options{'list'}'\n";
exit 1;
}
} else {
$log->syslog('notice', "Loading ALL lists...");
my $all_lists = Sympa::List::get_lists('*', 'reload_config' => 1, 'force_sync_admin' => 1);
}
$log->syslog('notice', '...Done.');
exit 0;
}
##########################################
elsif ($main::options{'modify_list'}) {
my $robot = $main::options{'robot'} || $Conf::Conf{'host'};
my $family_name;
unless ($family_name = $main::options{'modify_list'}) {
print STDERR "Error : missing family parameter\n";
exit 1;
}
print STDOUT
"\n************************************************************\n";
my $family;
unless ($family = Sympa::Family->new($family_name, $robot)) {
print STDERR
"The family $family_name does not exist, impossible to modify the list.\n";
exit 1;
}
unless ($main::options{'input_file'}) {
print STDERR "Error : missing input_file parameter\n";
exit 1;
}
unless (open INFILE, $main::options{'input_file'}) {
print STDERR "Unable to open $main::options{'input_file'}) file";
exit 1;
}
my $result;
unless ($result = $family->modify_list(\*INFILE)) {
print STDERR
"\nImpossible to modify the family list : action stopped. \n";
exit 1;
}
print STDOUT
"\n************************************************************\n";
unless (defined $result->{'ok'}) {
printf STDERR "\n%s\n", join("\n", @{$result->{'string_info'}});
print STDERR "\nThe action has been stopped because of error :\n";
printf STDERR "\n%s\n", join("\n", @{$result->{'string_error'}});
exit 1;
}
close INFILE;
printf STDOUT "\n%s\n", join("\n", @{$result->{'string_info'}});
exit 0;
}
##########################################
elsif ($main::options{'close_family'}) {
my $robot = $main::options{'robot'} || $Conf::Conf{'host'};
my $family_name;
unless ($family_name = $main::options{'close_family'}) {
pod2usage(-exitval => 1, -output => \*STDERR);
}
my $family;
unless ($family = Sympa::Family->new($family_name, $robot)) {
print STDERR
"The family $family_name does not exist, impossible family closure\n";
exit 1;
}
my $string;
unless ($string = $family->close_family()) {
print STDERR "\nImpossible family closure : action stopped \n";
exit 1;
}
print STDOUT $string;
exit 0;
}
##########################################
elsif ($main::options{'sync_list_db'}) {
my $listname = $main::options{'list'} || '';
if (length($listname) > 1) {
my $list = Sympa::List->new($listname);
unless (defined $list) {
print STDOUT "\nList '$listname' does not exist. \n";
exit 1;
}
$list->_update_list_db;
} else {
Sympa::List::_flush_list_db();
my $all_lists = Sympa::List::get_lists('*', 'reload_config' => 1);
foreach my $list (@$all_lists) {
$list->_update_list_db;
}
}
exit 0;
} elsif ($main::options{'export_list'}) {
my $robot_id = $main::options{'robot'} || '*';
my $all_lists = Sympa::List::get_lists($robot_id);
exit 1 unless defined $all_lists;
foreach my $list (@$all_lists) {
printf "%s\n", $list->{'name'};
}
exit 0;
} elsif ($main::options{'send_digest'}) {
Sympa::Spindle::ProcessDigest->new(
send_now => 1,
keep_digest => $main::options{'keep_digest'},
)->spin;
exit 0;
}
die 'Unknown option';
exit(0);
# Load configuration.
sub _load {
## Load sympa.conf.
unless (Conf::load(Conf::get_sympa_conf(), 'no_db')) { #Site and Robot
die sprintf
"Unable to load sympa configuration, file %s or one of the vhost robot.conf files contain errors. Exiting.\n",
Conf::get_sympa_conf();
}
## Open the syslog and say we're read out stuff.
$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});
# Enable SMTP logging if required
$mailer->{log_smtp} = $main::options{'mail'}
|| Sympa::Tools::Data::smart_eq($Conf::Conf{'log_smtp'}, 'on');
# setting log_level using conf unless it is set by calling option
if (defined $main::options{'log_level'}) {
$log->{level} = $main::options{'log_level'};
$log->syslog(
'info',
'Configuration file read, log level set using options: %s',
$main::options{'log_level'}
);
} else {
$log->{level} = $Conf::Conf{'log_level'};
$log->syslog(
'info',
'Configuration file read, default log level %s',
$Conf::Conf{'log_level'}
);
}
if (Conf::cookie_changed()) {
die sprintf
'sympa.conf/cookie parameter has changed. You may have severe inconsitencies into password storage. Restore previous cookie or write some tool to re-encrypt password in database and check spools contents (look at %s/cookies.history file).',
$Conf::Conf{'etc'};
}
# Check database connectivity.
unless (Sympa::DatabaseManager->instance) {
die sprintf
"Database %s defined in sympa.conf is unreachable. verify db_xxx parameters in sympa.conf\n",
$Conf::Conf{'db_name'};
}
# Now trying to load full config (including database)
unless (Conf::load()) { #FIXME: load Site, then robot cache
die sprintf
"Unable to load Sympa configuration, file %s or any of the virtual host robot.conf files contain errors. Exiting.\n",
Conf::get_sympa_conf();
}
## Set locale configuration
## Compatibility with version < 2.3.3
$main::options{'lang'} =~ s/\.cat$//
if defined $main::options{'lang'};
$default_lang =
$language->set_lang($main::options{'lang'}, $Conf::Conf{'lang'},
'en');
## Main program
if (!chdir($Conf::Conf{'home'})) {
die sprintf 'Can\'t chdir to %s: %s', $Conf::Conf{'home'}, $ERRNO;
## Function never returns.
}
## Check for several files.
unless (Conf::checkfiles_as_root()) {
die "Missing files\n";
}
}
sub _report {
my $spindle = shift;
my @reports = @{$spindle->{stash} || []};
@reports = ([undef, 'notice', 'performed']) unless @reports;
my $template = Sympa::Template->new('*', subdir => 'mail_tt2');
foreach my $report (@reports) {
my ($request, $report_type, $report_entry, $report_param) = @$report;
my $action = $request ? $request->{action} : 'sympa';
my $message = '';
$template->parse(
{ report_type => $report_type,
report_entry => $report_entry,
report_param => ($report_param || {}),
},
'report.tt2',
\$message
);
$message ||= $report_entry;
$message =~ s/\n/ /g;
printf STDERR "%s [%s] %s\n", $action, $report_type, $message;
}
return $spindle->success ? 1 : undef;
}
# DEPRECATED. Use Sympa::Spindle::ProcessDigest class.
#sub SendDigest;
# Lowercase field from database.
# Old names: List::lowercase_field(), Sympa::List::lowercase_field().
sub _lowercase_field {
my ($table, $field) = @_;
my $sth;
my $sdm = Sympa::DatabaseManager->instance;
my $total = 0;
unless ($sdm
and $sth = $sdm->do_query(q{SELECT %s FROM %s}, $field, $table)) {
$log->syslog('err', 'Unable to get values of field %s for table %s',
$field, $table);
return undef;
}
while (my $user = $sth->fetchrow_hashref('NAME_lc')) {
my $lower_cased = lc($user->{$field});
next if $lower_cased eq $user->{$field};
$total++;
## Updating database.
unless (
$sth = $sdm->do_prepared_query(
sprintf(
q{UPDATE %s SET %s = ? WHERE %s = ?},
$table, $field, $field
),
$lower_cased,
$user->{$field}
)
) {
$log->syslog('err',
'Unable to set field % from table %s to value %s',
$field, $lower_cased, $table);
next;
}
}
$sth->finish();
return $total;
}
__END__
=encoding utf-8
=head1 NAME
sympa, sympa.pl - Command line utility to manage Sympa
=head1 SYNOPSIS
C S<[ C<-d, --debug> ]> S<[ C<-f, --file>=I ]>
S<[ C<-l, --lang>=I ]> S<[ C<-m, --mail> ]>
S<[ C<-h, --help> ]> S<[ C<-v, --version> ]>
S<>
S<[ C<--import>=I ]>
S<[ C<--close_list>=I[I<@robot>] ]>
S<[ C<--purge_list>=I[I<@robot>] ]>
S<[ C<--lowercase> ]> S<[ C<--make_alias_file> ]>
S<[ C<--dump>=I | ALL ]>
=head1 DESCRIPTION
NOTE:
On overview of Sympa documentation see L.
Sympa.pl is invoked from command line then performs various administration
tasks.
=head1 OPTIONS
F may run with following options in general.
=over 4
=item C<-d>, C<--debug>
Enable debug mode.
=item C<-f>, C<--config=>I
Force Sympa to use an alternative configuration file instead
of F<--CONFIG-->.
=item C<-l>, C<--lang=>I
Set this option to use a language for Sympa. The corresponding
gettext catalog file must be located in F<$LOCALEDIR>
directory.
=item C<--log_level=>I
Sets Sympa log level.
=back
With the following options F will run in batch mode:
=over 4
=item C<--add_list=>I C<--robot=>I
C<--input_file=>I
Add the list described by the file.xml under robot_name, to the family
family_name.
=item C<--change_user_email> C<--current_email=>I C<--new_email=>I
Changes a user email address in all Sympa databases (subscriber_table,
list config, etc) for all virtual robots.
=item C<--close_family=>I C<--robot=>I
Close lists of family_name family under robot_name.
=item C<--close_list=>I[I<@robot>]
Close the list (changing its status to closed), remove aliases and remove
subscribers from DB (a dump is created in the list directory to allow
restoring the list)
=item C<--conf_2_db>
Load sympa.conf and each robot.conf into database.
=item C<--create_list> C<--robot=>I
C<--input_file=>I
Create a list with the XML file under robot robot_name.
=item C<--dump=>I@I|C
Dumps subscribers of for `listname' list or all lists. Subscribers are
dumped in subscribers.db.dump.
=begin comment
=item C<--export_list> [ C<--robot=>I ]
B.
=end comment
=item C<--health_check>
Check if F, F of virtual robots and database structure
are correct. If any errors occur, exits with non-zero status.
=item C<--import=>I@I
Import subscribers in the list. Data are read from standard input.
The imported data should contain one entry per line : the first field
is an email address, the second (optional) field is the free form name.
Fields are spaces-separated.
Sample:
## Data to be imported
## email gecos
john.steward@some.company.com John - accountant
mary.blacksmith@another.company.com Mary - secretary
=item C<--instantiate_family=>I C<--robot=>I
C<--input_file=>I [ C<--close_unknown> ] [ C<--quiet> ]
Instantiate family_name lists described in the file.xml under robot_name.
The family directory must exist; automatically close undefined lists in a
new instantiation if --close_unknown is specified; do not print report if
C<--quiet> is specified.
=item C<--lowercase>
Lowercases email addresses in database.
=item C<--make_alias_file> [ C<--robot> robot ]
Create an aliases file in /tmp/ with all list aliases. It uses the
F template (useful when list_aliases.tt2 was changed).
=item C<--md5_encode_password>
Rewrite password in C of database using MD5 fingerprint.
YOU CAN'T UNDO unless you save this table first.
B that this option was obsoleted.
Use L.
=item C<--modify_list=>I C<--robot=>I
C<--input_file=>I
Modify the existing list installed under the robot robot_name and that
belongs to the family family_name. The new description is in the C.
=item C<--purge_list>=I[@I]
Remove the list (remove archive, configuration files, users and owners in admin table. Restore is not possible after this operation.
=item C<--reload_list_config>
[ C<--list=>I@I ] [ C<--robot=>I ]
Recreates all F files or cache in C.
You should run this command if you edit authorization scenarios.
The list and robot parameters are optional.
=item C<--rename_list=>I@I
C<--new_listname=>I C<--new_listrobot=>I
Renames a list or move it to another virtual robot.
=item C<--send_digest> [ C<--keep_digest> ]
Send digest right now.
If C<--keep_digest> is specified, stocked digest will not be removed.
=item C<--sync_include=>I@I
Trigger the list members update.
=item C<--sync_list_db> [ C<--list=>I@I ]
Syncs filesystem list configs to the database cache of list configs,
optionally syncs an individual list if specified.
=item C<--test_database_message_buffer>
B:
This option was deprecated.
Test the database message buffer size.
=item C<--upgrade> [ C<--from=>I ] [ C<--to=>I ]
Runs Sympa maintenance script to upgrade from version I to version I.
=item C<--upgrade_shared> [ C<--list=>I ] [ C<--robot=>I ]
B:
This option was deprecated.
See upgrade_shared_repository(1).
Rename files in shared.
=back
With following options F will print some information and exit.
=over 4
=item C<-h>, C<--help>
Print this help message.
=item C<--md5_digest=>I
Output a MD5 digest of a password (useful for SOAP client trusted
application).
=item C<-v>, C<--version>
Print the version number.
=back
=head1 FILES
F<--CONFIG--> main configuration file.
=head1 SEE ALSO
L.
=head1 HISTORY
This program was originally written by:
=over 4
=item Serge Aumont
ComitE<233> RE<233>seau des UniversitE<233>s
=item Olivier SalaE<252>n
ComitE<233> RE<233>seau des UniversitE<233>s
=back
As of Sympa 6.2b.4, it was split into three programs:
F command line utility, F daemon and
F daemon.
=cut
sympa-6.2.24/src/sbin/sympa_newaliases.pl.in 0000644 0001750 0001750 00000016646 13216651447 017750 0 ustar racke racke #! --PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
# directory of this distribution and at
# .
#
# 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, see .
use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use Conf;
use Sympa::Crash; # Show traceback.
use Sympa::Log;
# If this program was invoked by the other, throw standard output away so
# that parent's output (e.g. via CGI) won't be stained.
unless (-t) {
open STDOUT, '>&STDERR';
}
my %options;
unless (
GetOptions(
\%options, 'config|f=s', 'debug|d', 'domain=s',
'help|h', 'log_level=s', 'version|v'
)
) {
pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($options{'help'}) {
pod2usage(0);
} elsif ($options{'version'}) {
printf "Sympa %s\n", Sympa::Constants::VERSION;
exit 0;
}
$Conf::sympa_config = $main::options{config};
if ($main::options{'debug'}) {
$main::options{'log_level'} = 2 unless $main::options{'log_level'};
}
my $log = Sympa::Log->instance;
$log->{log_to_stderr} = 'all' if $main::options{'debug'} or -t;
my $robot_id = $options{'domain'};
# Load configuration
unless (Conf::load()) {
$log->syslog('err', 'The configuration file %s contains error',
Conf::get_sympa_conf());
exit 1;
}
$log->openlog(
$Conf::Conf{'syslog'},
$Conf::Conf{'log_socket_type'},
database_backend => undef
);
# setting log_level using conf unless it is set by calling option
if (defined $main::options{'log_level'}) {
$log->{level} = $main::options{'log_level'};
} else {
$log->{level} = $Conf::Conf{'log_level'};
}
my ($aliases_file, $aliases_program, $aliases_db_type);
if ($robot_id) {
unless (Conf::valid_robot($robot_id)) {
$log->syslog('err', 'Robot %s does not exist', $robot_id);
exit 1;
}
$aliases_file = Conf::get_robot_conf($robot_id, 'sendmail_aliases');
$aliases_program = Conf::get_robot_conf($robot_id, 'aliases_program');
$aliases_db_type = Conf::get_robot_conf($robot_id, 'aliases_db_type');
} else {
$aliases_file = $Conf::Conf{'sendmail_aliases'};
$aliases_program = $Conf::Conf{'aliases_program'};
$aliases_db_type = $Conf::Conf{'aliases_db_type'};
}
if ($aliases_file eq 'none') {
exit 0; # do nothing
} elsif (!-e $aliases_file) {
$log->syslog('err', 'The aliases file %s does not exist', $aliases_file);
exit 1;
}
unless ($aliases_db_type =~ /\A\w+\z/) {
$log->syslog('err', 'Invalid aliases_db_type "%s"', $aliases_db_type);
exit 1;
}
if ($aliases_program =~ m{\A/}) {
$log->syslog('debug2', 'Executing "%s %s"',
$aliases_program, $aliases_file);
exec $aliases_program, $aliases_file;
} elsif ($aliases_program eq 'makemap') {
$log->syslog('debug2', 'Executing "%s %s %s < %s"',
q{--MAKEMAP--}, $aliases_db_type, $aliases_file, $aliases_file);
unless (open STDIN, '<', $aliases_file) {
$log->syslog('err', 'Canot open %s', $aliases_file);
exit 1;
}
exec q{--MAKEMAP--}, $aliases_db_type, $aliases_file;
} elsif ($aliases_program eq 'newaliases') {
$log->syslog(
'debug2',
'Executing "%s"',
q{--NEWALIASES-- --NEWALIASES_ARG--}
);
# Some newaliases utilities e.g. with Postfix cannot take arguments.
# OTOH if it may take arg, exec() must take separate one to avoid shell
# metacharacters.
if (q{--NEWALIASES_ARG--}) {
exec q{--NEWALIASES--}, q{--NEWALIASES_ARG--};
} else {
exec q{--NEWALIASES--};
}
} elsif ($aliases_program eq 'postalias') {
$log->syslog('debug2', 'Executing "%s %s:%s"',
q{--POSTALIAS--}, $aliases_db_type, $aliases_file);
exec q{--POSTALIAS--}, "$aliases_db_type:$aliases_file";
} elsif ($aliases_program eq 'postmap') {
$log->syslog('debug2', 'Executing "%s %s:%s"',
q{--POSTMAP--}, $aliases_db_type, $aliases_file);
exec q{--POSTMAP--}, "$aliases_db_type:$aliases_file";
} else {
$log->syslog('err', 'Invalid aliases_program "%s"', $aliases_program);
exit 1;
}
my $errno = $ERRNO;
$log->syslog('err', 'Cannot execute aliases_program "%s": %m',
$aliases_program);
exit($errno || 1);
__END__
=encoding utf-8
=head1 NAME
sympa_newaliases, sympa_newaliases.pl - Alias database maintenance
=head1 SYNOPSIS
sympa_newaliases.pl --domain=dom.ain
=head1 DESCRIPTION
F is a program to maintain alias database.
It is typically invoked from
L module via sympa_newaliases-wrapper,
then updates alias database.
=head1 OPTIONS
F may run with following options.
=over
=item C<--domain=>I
Name of virtual robot on which aliases will be updated.
=item C<-f>, C<--config=>I
Force sympa_newaliases to use an alternative configuration file instead
of F<--CONFIG-->.
=item C<-h>, C<--help>
Print this help message.
=back
=head1 CONFIGURATION PARAMETERS
Following site configuration parameters in F<--CONFIG--> will be referred.
They may be overridden by robot.conf of each virtual robot.
=over
=item sendmail_aliases
Source text of alias database.
Default value is F<$SENDMAIL_ALIASES>.
=item aliases_program
System command to update alias database.
Possible values are:
=over
=item C
Sendmail makemap utility.
=item C
L or compatible utility.
=item C
Postfix L utility.
=item C
Postfix L utility.
=item Full path
Full path to executable file.
File will be invoked with the value of C as an argument.
=back
Default value is C.
=item aliases_db_type
Type of alias database.
This is meaningful when value of C parameter is
C, C or C.
Possible values will be vary by system commands.
For example, C and C can support any of
C, C, C, C and C.
Default value is C.
=back
=head1 RETURN VALUE
Returns with exit code 0.
If invoked system command failed, returns with its exit code.
On other failures, returns with 1.
=head1 FILES
=over
=item F<--CONFIG-->
Sympa site configuration.
=item F<$LIBEXECDIR/sympa_newaliases-wrapper>
Set UID wrapper for sympa_newaliases.pl.
=back
=head1 HISTORY
sympa_newaliases.pl appeared on Sympa 6.1.18.
It was initially written by
IKEDA Soji .
=head1 SEE ALSO
L.
=cut
sympa-6.2.24/src/sbin/archived.pl.in 0000644 0001750 0001750 00000022460 13216651447 016160 0 ustar racke racke #!--PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
# directory of this distribution and at
# .
#
# 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, see .
use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use POSIX qw();
use Sympa::Alarm;
use Conf;
use Sympa::Constants;
use Sympa::Crash; # Show traceback.
use Sympa::DatabaseManager;
use Sympa::Language;
use Sympa::Log;
use Sympa::Process;
use Sympa::Spindle::ProcessArchive;
my $process = Sympa::Process->instance;
$process->init(pidname => 'archived');
# Check options
my %options;
unless (
GetOptions(
\%main::options, 'config|f=s', 'debug|d', 'help|h',
'foreground|F', 'log_level=s', 'version|v'
)
) {
pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($main::options{'help'}) {
pod2usage(0);
} elsif ($main::options{'version'}) {
printf "Sympa %s\n", Sympa::Constants::VERSION;
exit 0;
}
$Conf::sympa_config = $main::options{config};
if ($main::options{'debug'}) {
$main::options{'log_level'} = 2 unless $main::options{'log_level'};
$main::options{'foreground'} = 1;
}
my $log = Sympa::Log->instance;
$log->{'log_to_stderr'} = 'all' if $main::options{'foreground'};
# Load sympa.conf
unless (Conf::load()) {
die sprintf
"Unable to load sympa configuration, file %s has errors.\n",
Conf::get_sympa_conf();
}
# Check database connectivity
unless (Sympa::DatabaseManager->instance) {
die sprintf
"Database %s defined in sympa.conf has not the right structure or is unreachable.\n",
$Conf::Conf{'db_name'};
}
# Put ourselves in background if not in debug mode.
unless ($main::options{'foreground'}) {
$process->daemonize;
}
# Create and write the PID file.
$process->write_pid(initial => 1);
# If process is running in foreground, don't write STDERR to a dedicated file.
unless ($main::options{foreground}) {
$process->direct_stderr_to_file;
}
# setting log_level using conf unless it is set by calling option
if ($main::options{'log_level'}) {
$log->{level} = $main::options{'log_level'};
$log->syslog('info',
"Configuration file read, log level set using options : $main::options{'log_level'}"
);
} else {
$log->{level} = $Conf::Conf{'log_level'};
$log->syslog('info',
"Configuration file read, default log level $Conf::Conf{'log_level'}"
);
}
my $log_facility = $Conf::Conf{'log_facility'} || $Conf::Conf{'syslog'};
$log->openlog($log_facility, $Conf::Conf{'log_socket_type'});
## Set the User ID & Group ID for the process
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];
## Required on FreeBSD to change ALL IDs(effective UID + real UID + saved UID)
POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);
## Check if the UID has correctly been set (useful on OS X)
unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
&& ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
die
"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.\n";
}
## Sets the UMASK
umask(oct($Conf::Conf{'umask'}));
foreach my $robot (@{Conf::get_robots_list()}) {
my $arc_dir = Conf::get_robot_conf($robot, 'arc_path');
unless ($arc_dir) {
die sprintf
'Robot %s has no archives directory. Check arc_path parameter in this robot.conf and in sympa.conf',
$robot;
}
}
## Change to list root
unless (chdir($Conf::Conf{'home'})) {
die sprintf 'Unable to change directory to %s: %s', $Conf::Conf{'home'},
$!;
}
Sympa::Language->instance->set_lang($Conf::Conf{'lang'}, 'en');
$log->syslog('notice', 'Archived %s Started', Sympa::Constants::VERSION);
my $spindle = Sympa::Spindle::ProcessArchive->new;
# Catch signals, in order to exit cleanly, whenever possible.
$SIG{'TERM'} = 'sigterm';
$SIG{'INT'} = 'sigterm';
while (not $spindle->{finish}) {
$spindle->spin;
last if $spindle->{finish};
# Sleep for a while if archive spool is empty.
sleep $Conf::Conf{'sleep'};
}
# Purge grouped notifications.
Sympa::Alarm->instance->flush(purge => 1);
## Free zombie sendmail processes.
#Sympa::Process->instance->reap_child;
$log->syslog('notice', 'Archived exited normally due to signal');
$process->remove_pid(final => 1);
exit 0;
# When we catch signal, just change the value of the loop variable.
sub sigterm {
my $sig = shift;
$log->syslog('notice',
'Signal %s received, still processing current task', $sig);
$spindle->{finish} = $sig;
}
# Moved to Sympa::Spindle::ProcessArchive::_twist().
#sub process_message;
# Moved to Sympa::Spindle::ProcessArchive::_do_command().
#sub do_command;
# Moved to Sympa::Archive::html_remove(). Use do_remove_arc() instead.
#sub remove;
# Moved to Sympa::Spindle::ProcessArchive::_do_remove_arc().
#sub do_remove_arc;
# Moved to Sympa::Archive::html_rebuild(). Use do_rebuildarc() instead.
#sub rebuild;
# Moved to Sympa::Spindle::ProcessArchive::_do_rebuildarc().
#sub do_rebuildarc;
# Moved to Sympa::Spindle::ProcessArchive::_mail2arc().
#sub mail2arc;
# Moved to Sympa::Archive::_set_hidden_mode().
#sub set_hidden_mode;
# Moved to Sympa::Archive::_unset_hidden_mode().
#sub unset_hidden_mode;
# Moved to Sympa::Archive::_save_idx().
#sub save_idx;
# Moved to Sympa::Archive::_create_idx().
#sub create_idx;
# DEPRECATED.
# Use Sympa::Archive::_get_tag().
#sub get_tag;
# Checks if directory exists and we have write and read accec to it.
# DEPRECATED. No longer used.
#sub directory_check;
__END__
=encoding utf-8
=head1 NAME
archived, archived.pl - Mailing List Archiving Daemon for Sympa
=head1 SYNOPSIS
C S<[ C<--foreground> ]> S<[ C<--debug> ]>
=head1 DESCRIPTION
B is a program which scan permanently the archive spool
and feeds the web archives, converting messages to the HTML format and
linking them. Original mails are also kept (in I directory> for
later rebuilding of archives.
The HTML conversion is achieved by the means of the B program.
Archives are accessed via B and B,
which proposes access control;
therefore archives should not be located in a public web directory.
=head1 OPTIONS
These programs follow the usual GNU command line syntax,
with long options starting with two dashes (C<-->). A summary of
options is included below.
=over 5
=item C<-F>, C<--foreground>
Do not detach TTY.
=item C<-f>, C<--config=>I
Force archived to use an alternative configuration file instead
of F<--CONFIG-->.
=item C<-d>, C<--debug>
Run the program in a debug mode.
=item C<-h>, C<--help>
Print this help message.
=back
=head1 FILES
F<$SPOOLDIR/outgoing/> outgoing Sympa directory.
F<$DEFAULTDIR/mhonarc-ressources.tt2> template of MHonArc resource file.
F<--CONFIG--> Sympa configuration file.
F<$PIDDIR/archived.pid> this file contains the process ID
of F.
=head1 MORE DOCUMENTATION
The full documentation in HTML and PDF formats can be found in
L.
The mailing lists (with web archives) can be accessed at
L.
=head1 HISTORY
This program was originally written by:
=over 4
=item Serge Aumont
ComitE<233> RE<233>seau des UniversitE<233>s
=item Olivier SalaE<252>n
ComitE<233> RE<233>seau des UniversitE<233>s
=back
This manual page was initially written by
JE<233>rE<244>me Marant
for the Debian GNU/Linux system.
=head1 LICENSE
You may distribute this software under the terms of the GNU General
Public License Version 2. For more details see F file.
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
any later version published by the Free Software Foundation; with no
Invariant Sections, no Front-Cover Texts and no Back-Cover Texts. A
copy of the license can be found under
L.
=head1 BUGS
Report bugs to Sympa bug tracker.
See L.
=head1 SEE ALSO
L, L, L, L.
L.
=cut
sympa-6.2.24/src/sbin/Makefile.am 0000644 0001750 0001750 00000007001 13216651447 015457 0 ustar racke racke # $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
#
# 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, see .
sbin_SCRIPTS = archived.pl \
bounced.pl \
bulk.pl \
sympa.pl \
sympa_automatic.pl \
sympa_msg.pl \
sympa_newaliases.pl \
sympa_wizard.pl \
task_manager.pl
man1_MANS = \
sympa.1 \
sympa_newaliases.1 \
sympa_wizard.1
man8_MANS = \
archived.8 \
bounced.8 \
bulk.8 \
sympa_automatic.8 \
sympa_msg.8 \
task_manager.8
EXTRA_DIST = \
archived.pl.in \
bounced.pl.in \
bulk.pl.in \
sympa.pl.in \
sympa_automatic.pl.in \
sympa_msg.pl.in \
sympa_newaliases.pl.in \
sympa_wizard.pl.in \
task_manager.pl.in
CLEANFILES = $(sbin_SCRIPTS) $(man1_MANS) $(man8_MANS)
archived.pl bounced.pl bulk.pl sympa.pl sympa_automatic.pl sympa_msg.pl task_manager.pl: Makefile
@rm -f $@
$(AM_V_GEN)$(SED) \
-e 's|--PERL--|$(PERL)|' \
-e 's|--defaultdir--|$(defaultdir)|' \
-e 's|--docdir--|$(docdir)|' \
-e 's|--libexecdir--|$(libexecdir)|' \
-e 's|--localedir--|$(localedir)|' \
-e 's|--modulesdir--|$(modulesdir)|' \
-e 's|--piddir--|$(piddir)|' \
-e 's|--sbindir--|$(sbindir)|' \
-e 's|--spooldir--|$(spooldir)|' \
-e 's|--CONFIG--|$(CONFIG)|' \
< $(srcdir)/$@.in > $@
@chmod +x $@
archived.pl: $(srcdir)/archived.pl.in
bounced.pl: $(srcdir)/bounced.pl.in
bulk.pl: $(srcdir)/bulk.pl.in
sympa.pl: $(srcdir)/sympa.pl.in
sympa_automatic.pl: $(srcdir)/sympa_automatic.pl.in
sympa_msg.pl: $(srcdir)/sympa_msg.pl.in
task_manager.pl: $(srcdir)/task_manager.pl.in
sympa_newaliases.pl sympa_wizard.pl: Makefile
@rm -f $@
$(AM_V_GEN)$(SED) \
-e 's|--PERL--|$(PERL)|' \
-e 's|--defaultdir--|$(defaultdir)|' \
-e 's|--docdir--|$(docdir)|' \
-e 's|--libexecdir--|$(libexecdir)|' \
-e 's|--localedir--|$(localedir)|' \
-e 's|--modulesdir--|$(modulesdir)|' \
-e 's|--piddir--|$(piddir)|' \
-e 's|--spooldir--|$(spooldir)|' \
-e 's|--sysconfdir--|$(sysconfdir)|' \
-e 's|--CONFIG--|$(CONFIG)|' \
-e 's|--SENDMAIL_ALIASES--|$(SENDMAIL_ALIASES)|' \
-e 's|--MAKEMAP--|$(MAKEMAP)|' \
-e 's|--NEWALIASES--|$(NEWALIASES)|' \
-e 's|--NEWALIASES_ARG--|$(NEWALIASES_ARG)|' \
-e 's|--POSTALIAS--|$(POSTALIAS)|' \
-e 's|--POSTMAP--|$(POSTMAP)|' \
< $(srcdir)/$@.in > $@
@chmod +x $@
sympa_newaliases.pl: $(srcdir)/sympa_newaliases.pl.in
sympa_wizard.pl: $(srcdir)/sympa_wizard.pl.in
.pl.1:
@rm -f $@
$(AM_V_GEN)$(POD2MAN) --section=1 --center="sympa $(VERSION)" \
--lax --release="$(VERSION)" $< $@
.pl.8:
@rm -f $@
$(AM_V_GEN)$(POD2MAN) --section=8 --center="sympa $(VERSION)" \
--lax --release="$(VERSION)" $*.pl $@
# Remove old sympa.8 manpage.
install-data-hook:
@rm -f $(DESTDIR)$(man8dir)/sympa.8
sympa-6.2.24/src/sbin/sympa_automatic.pl.in 0000644 0001750 0001750 00000027413 13216651447 017575 0 ustar racke racke #!--PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
# directory of this distribution and at
# .
#
# 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, see .
use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use POSIX qw();
use Sympa::Alarm;
use Conf;
use Sympa::Constants;
use Sympa::Crash; # Show traceback.
use Sympa::DatabaseManager;
use Sympa::Log;
use Sympa::Mailer;
use Sympa::Process;
use Sympa::Spindle::ProcessAutomatic;
use Sympa::Tools::Data;
my $process = Sympa::Process->instance;
$process->init(pidname => 'sympa_automatic', name => 'sympa/automatic');
## Init random engine
srand(time());
# Check options.
my %options;
unless (
GetOptions(
\%main::options, 'debug|d', 'log_level=s', 'foreground',
'config|f=s', 'mail|m', 'keepcopy|k=s', 'help|h',
'version|v',
)
) {
pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($main::options{'help'}) {
pod2usage(0);
} elsif ($main::options{'version'}) {
printf "Sympa %s\n", Sympa::Constants::VERSION;
exit 0;
}
$Conf::sympa_config = $main::options{config};
if ($main::options{'debug'}) {
$main::options{'log_level'} = 2 unless $main::options{'log_level'};
$main::options{'foreground'} = 1;
}
my $log = Sympa::Log->instance;
$log->{log_to_stderr} = 'all' if $main::options{'foreground'};
my $mailer = Sympa::Mailer->instance;
_load();
# Put ourselves in background if we're not in debug mode.
unless ($main::options{'foreground'}) {
$process->daemonize;
}
$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});
# Create and write the PID file.
$process->write_pid(initial => 1);
# If process is running in foreground, don't write STDERR to a dedicated file.
unless ($main::options{foreground}) {
$process->direct_stderr_to_file;
}
# Set the User ID & Group ID for the process
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];
## Required on FreeBSD to change ALL IDs
## (effective UID + real UID + saved UID)
POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);
## Check if the UID has correctly been set (useful on OS X)
unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
&& ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
die
"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.\n";
}
# Sets the UMASK
umask(oct($Conf::Conf{'umask'}));
## Most initializations have now been done.
$log->syslog(
'notice',
'Sympa/automatic %s Started',
Sympa::Constants::VERSION()
);
sleep 1; ## wait until main process has created required directories
## Do we have right access in the directory
if ($main::options{'keepcopy'}) {
if (!-d $main::options{'keepcopy'}) {
$log->syslog(
'notice',
'Cannot keep a copy of incoming messages: %s is not a directory',
$main::options{'keepcopy'}
);
delete $main::options{'keepcopy'};
} elsif (!-w $main::options{'keepcopy'}) {
$log->syslog(
'notice',
'Cannot keep a copy of incoming messages: no write access to %s',
$main::options{'keepcopy'}
);
delete $main::options{'keepcopy'};
}
}
my $spindle = Sympa::Spindle::ProcessAutomatic->new(
keepcopy => $main::options{keepcopy},
log_level => $main::options{log_level},
log_smtp => $main::options{mail}
);
# Catch signals, in order to exit cleanly, whenever possible.
$SIG{'TERM'} = 'sigterm';
$SIG{'INT'} = 'sigterm'; # Interrupt from terminal.
$SIG{'HUP'} = 'sighup';
$SIG{'PIPE'} = 'IGNORE'; # Ignore SIGPIPE ; prevents process from dying
# Main loop.
# This loop is run foreach HUP signal received.
# This is the main loop : look for files in the directory, handles
# them, sleeps a while and continues the good job.
while (not $spindle->{finish} or $spindle->{finish} ne 'term') {
$spindle->spin;
if ($spindle->{finish} and $spindle->{finish} eq 'hup') {
# Disconnect from Database
Sympa::DatabaseManager->disconnect;
$log->syslog('notice', "Reloading sympa/automatic daemon");
_load();
$spindle = Sympa::Spindle::ProcessAutomatic->new(
keepcopy => $main::options{keepcopy},
log_level => $main::options{log_level},
log_smtp => $main::options{mail}
);
next;
} elsif ($spindle->{finish}) {
last;
}
# If the spool was empty, sleep for a while.
sleep $Conf::Conf{'sleep'};
}
# Purge grouped notifications
Sympa::Alarm->instance->flush(purge => 1);
## Free zombie sendmail processes.
#Sympa::Process->instance->reap_child;
$log->syslog('notice', 'Sympa/automatic exited normally due to signal');
$process->remove_pid(final => 1);
exit(0);
# Load configuration.
sub _load {
## Load sympa.conf.
unless (Conf::load(Conf::get_sympa_conf(), 'no_db')) { #Site and Robot
die sprintf
"Unable to load sympa configuration, file %s or one of the vhost robot.conf files contain errors. Exiting.\n",
Conf::get_sympa_conf();
}
## Open the syslog and say we're read out stuff.
$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});
# Enable SMTP logging if required
$mailer->{log_smtp} = $main::options{'mail'}
|| Sympa::Tools::Data::smart_eq($Conf::Conf{'log_smtp'}, 'on');
# setting log_level using conf unless it is set by calling option
if (defined $main::options{'log_level'}) {
$log->{level} = $main::options{'log_level'};
$log->syslog(
'info',
'Configuration file read, log level set using options: %s',
$main::options{'log_level'}
);
} else {
$log->{level} = $Conf::Conf{'log_level'};
$log->syslog(
'info',
'Configuration file read, default log level %s',
$Conf::Conf{'log_level'}
);
}
if (Conf::cookie_changed()) {
die sprintf
'sympa.conf/cookie parameter has changed. You may have severe inconsitencies into password storage. Restore previous cookie or write some tool to re-encrypt password in database and check spools contents (look at %s/cookies.history file).',
$Conf::Conf{'etc'};
}
# Check database connectivity.
unless (Sympa::DatabaseManager->instance) {
die sprintf
"Database %s defined in sympa.conf is unreachable. verify db_xxx parameters in sympa.conf\n",
$Conf::Conf{'db_name'};
}
# Now trying to load full config (including database)
unless (Conf::load()) { #FIXME: load Site, then robot cache
die sprintf
"Unable to load Sympa configuration, file %s or any of the virtual host robot.conf files contain errors. Exiting.\n",
Conf::get_sympa_conf();
}
## Main program
if (!chdir($Conf::Conf{'home'})) {
die sprintf 'Can\'t chdir to %s: %s', $Conf::Conf{'home'}, $ERRNO;
## Function never returns.
}
## Check for several files.
unless (Conf::checkfiles_as_root()) {
die "Missing files\n";
}
}
############################################################
# sigterm
############################################################
# When we catch signal, just changes the $spindle->{finish}.
#
# IN : -
#
# OUT : -
#
############################################################
sub sigterm {
my $sig = shift;
$log->syslog('notice',
'Signal %s received, still processing current task', $sig);
$spindle->{finish} = 'term';
}
############################################################
# sighup
############################################################
# When we catch SIGHUP, changes the value of $spindle->{finish}
# and puts the "-mail" logging option
#
# IN : -
#
# OUT : -
#
###########################################################
sub sighup {
if ($mailer->{log_smtp}) {
$log->syslog('notice',
'signal HUP received, switch of the "-mail" logging option and continue current task'
);
$mailer->{log_smtp} = undef;
} else {
$log->syslog('notice',
'signal HUP received, switch on the "-mail" logging option and continue current task'
);
$mailer->{log_smtp} = 1;
}
$spindle->{finish} = 'hup';
}
# Moved to Sympa::Spindle::ProcessAutomatic::_twist().
#sub process_message;
__END__
=encoding utf-8
=head1 NAME
sympa_automatic, sympa_automatic.pl - Automatic list creation daemon
=head1 SYNOPSIS
C S<[ C<-d, --debug> ]>
S<[ C<-f, --file>=I ]>
S<[ C<-k, --keepcopy>=I ]>
S<[ [ C<-m, --mail> ]>
S<[ C<-h, --help> ]> S<[ C<-v, --version> ]>
=head1 DESCRIPTION
Sympa_automatic.pl is a program which scans permanently the automatic creation
spool and processes each message.
If the list a message is bound for has not been there and list creation is
authorized, it will be created. Then the message is stored into incoming
message spool again and wait for processing by F.
=head1 OPTIONS
F may run with following options in general.
=over 4
=item C<-d>, C<--debug>
Enable debug mode.
=item C<-f>, C<--config=>I
Force Sympa to use an alternative configuration file instead
of F<--CONFIG-->.
=item C<--log_level=>I
Sets Sympa log level.
=back
F may run in daemon mode with following options.
=over 4
=item C<--foreground>
The process remains attached to the TTY.
=item C<-k>, C<--keepcopy=>I
This option tells Sympa to keep a copy of every incoming message,
instead of deleting them. `directory' is the directory to
store messages.
=item C<-m>, C<--mail>
Sympa will log calls to sendmail, including recipients. This option is
useful for keeping track of each mail sent (log files may grow faster
though).
=back
With following options F will print some information and exit.
=over 4
=item C<-h>, C<--help>
Print this help message.
=item C<-v>, C<--version>
Print the version number.
=back
=head1 FILES
F<--CONFIG--> main configuration file.
F<$PIDDIR/sympa_automatic.pid> this file contains the process ID
of F.
=head1 SEE ALSO
L, L.
L.
=head1 HISTORY
F was originally written by:
=over 4
=item Serge Aumont
ComitE<233> RE<233>seau des UniversitE<233>s
=item Olivier SalaE<252>n
ComitE<233> RE<233>seau des UniversitE<233>s
=back
As of Sympa 6.2b.4, it was split into three programs:
F command line utility, F daemon and
F daemon.
=cut
sympa-6.2.24/src/sbin/task_manager.pl.in 0000644 0001750 0001750 00000177364 13216651447 017045 0 ustar racke racke #! --PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
# directory of this distribution and at
# .
#
# 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, see .
use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use POSIX qw();
use Template;
use Sympa;
use Sympa::Alarm;
use Conf;
use Sympa::Constants;
use Sympa::Crash; # Show traceback.
use Sympa::DatabaseManager;
use Sympa::List;
use Sympa::Log;
use Sympa::Process;
use Sympa::Scenario;
use Sympa::Session;
use Sympa::Spool;
use Sympa::Task;
use Sympa::Ticket;
use Sympa::Tools::File;
use Sympa::Tools::Time;
use Sympa::Tools::Text;
use Sympa::Tracking;
use Sympa::User;
my $process = Sympa::Process->instance;
$process->init(pidname => 'task_manager');
my %options;
unless (
GetOptions(
\%main::options, 'config|f=s', 'debug|d', 'help|h',
'version|v', 'log_level=s', 'foreground|F'
)
) {
pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($main::options{'help'}) {
pod2usage(0);
} elsif ($main::options{'version'}) {
printf "Sympa %s\n", Sympa::Constants::VERSION;
exit 0;
}
$Conf::sympa_config = $main::options{config};
if ($main::options{'debug'}) {
$main::options{'log_level'} = 2 unless $main::options{'log_level'};
$main::options{'foreground'} = 1;
}
my $log = Sympa::Log->instance;
$log->{log_to_stderr} = 'all' if $main::options{'foreground'};
my $adrlist = {};
# Load sympa.conf
unless (Conf::load()) {
die sprintf
"Unable to load Sympa configuration, file %s or one of the virtual host robot.conf files contain errors. Exiting.\n",
Conf::get_sympa_conf();
}
$log->openlog($Conf::Conf{'log_facility'}, $Conf::Conf{'log_socket_type'});
# setting log_level using conf unless it is set by calling option
if ($main::options{'log_level'}) {
$log->{level} = $main::options{'log_level'};
$log->syslog(
'info',
'Configuration file read, log level set using options: %s',
$main::options{'log_level'}
);
} else {
$log->{level} = $Conf::Conf{'log_level'};
$log->syslog(
'info',
'Configuration file read, default log level %s',
$Conf::Conf{'log_level'}
);
}
# Put ourselves in background if not in debug mode.
unless ($main::options{'foreground'}) {
$process->daemonize;
}
# Create and write the PID file.
$process->write_pid(initial => 1);
# If process is running in foreground, don't write STDERR to a dedicated file.
unless ($main::options{foreground}) {
$process->direct_stderr_to_file;
}
## Set the UserID & GroupID for the process
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];
## Required on FreeBSD to change ALL IDs(effective UID + real UID + saved UID)
POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);
# Check if the UID has correctly been set (useful on OS X)
unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
&& ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
die
"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.\n";
}
## Sets the UMASK
umask(oct($Conf::Conf{'umask'}));
## Change to list root
unless (chdir($Conf::Conf{'home'})) {
die sprintf 'Unable to change to directory %s', $Conf::Conf{'home'};
}
## Catch signals, in order to exit cleanly, whenever possible.
$SIG{'TERM'} = \&sigterm;
$SIG{'INT'} = \&sigterm;
my $end = 0;
# Most initializations have now been done.
$log->syslog('notice', 'Task_Manager %s Started',
Sympa::Constants::VERSION());
###### VARIABLES DECLARATION ######
my $spool_task = $Conf::Conf{'queuetask'};
my @tasks; # list of tasks in the spool
# won't execute send_msg and delete_subs commands if true, only log
undef my $log_only;
#$log_only = 1;
## list of list task models
#my @list_models = ('expire', 'remind', 'sync_include');
my @list_models = ('sync_include', 'remind');
## hash of the global task models
my %global_models = (
'expire_bounce_task' => 'expire_bounce',
'purge_user_table_task' => 'purge_user_table',
'purge_logs_table_task' => 'purge_logs_table',
'purge_session_table_task' => 'purge_session_table',
'purge_spools_task' => 'purge_spools',
'purge_tables_task' => 'purge_tables',
'purge_one_time_ticket_table_task' => 'purge_one_time_ticket_table',
'purge_orphan_bounces_task' => 'purge_orphan_bounces',
'eval_bouncers_task' => 'eval_bouncers',
'process_bouncers_task' => 'process_bouncers',
);
## month hash used by epoch conversion routines
my %months = (
'Jan', 0, 'Feb', 1, 'Mar', 2, 'Apr', 3, 'May', 4, 'Jun', 5,
'Jul', 6, 'Aug', 7, 'Sep', 8, 'Oct', 9, 'Nov', 10, 'Dec', 11
);
###### DEFINITION OF AVAILABLE COMMANDS FOR TASKS ######
my $date_arg_regexp1 = '\d+|execution_date';
my $date_arg_regexp2 = '(\d\d\d\dy)(\d+m)?(\d+d)?(\d+h)?(\d+min)?(\d+sec)?';
my $date_arg_regexp3 =
'(\d+|execution_date)(\+|\-)(\d+y)?(\d+m)?(\d+w)?(\d+d)?(\d+h)?(\d+min)?(\d+sec)?';
my $delay_regexp = '(\d+y)?(\d+m)?(\d+w)?(\d+d)?(\d+h)?(\d+min)?(\d+sec)?';
my $var_regexp = '@\w+';
my $subarg_regexp =
'(\w+)(|\((.*)\))'; # for argument with sub argument (ie arg(sub_arg))
# regular commands
my %commands = (
'next' => ['date', '\w*'],
# date label
'stop' => [],
'create' => ['subarg', '\w+', '\w+'],
#object model model choice
'exec' => ['.+'],
#file #delay
'expire_bounce' => ['\d+'],
#template date
'sync_include' => [],
'purge_user_table' => [],
'purge_logs_table' => [],
'purge_session_table' => [],
'purge_spools' => [],
'purge_tables' => [],
'purge_one_time_ticket_table' => [],
'purge_orphan_bounces' => [],
'eval_bouncers' => [],
'process_bouncers' => []
);
# commands which use a variable. If you add such a command, the first
# parameter must be the variable
my %var_commands = (
'delete_subs' => ['var'],
# variable
'send_msg' => ['var', '\w+'],
#variable template
'rm_file' => ['var'],
# variable
);
foreach (keys %var_commands) {
$commands{$_} = $var_commands{$_};
}
# commands which are used for assignments
my %asgn_commands = (
'select_subs' => ['subarg'],
# condition
'delete_subs' => ['var'],
# variable
);
foreach (keys %asgn_commands) {
$commands{$_} = $asgn_commands{$_};
}
###### INFINITE LOOP SCANING THE QUEUE (unless a sig TERM is received) ######
while (!$end) {
my $current_date = time; # current epoch date
# Process grouped notifications.
Sympa::Alarm->instance->flush;
## List all tasks
unless (Sympa::Task::list_tasks($spool_task)) {
Sympa::send_notify_to_listmaster('*', 'intern_error',
{'error' => "Failed to list task files in $spool_task"});
$log->syslog('err', "Failed to list task files in %s", $spool_task);
exit -1;
}
my %used_models; # models for which a task exists
foreach my $model (Sympa::Task::get_used_models()) {
$used_models{$model} = 1;
}
### creation of required tasks
my %default_data = (
'creation_date' =>
$current_date, # hash of datas necessary to the creation of tasks
'execution_date' => 'execution_date'
);
## global tasks
foreach my $key (keys %global_models) {
unless ($used_models{$global_models{$key}}) {
if ($Conf::Conf{$key}) {
# hash of datas necessary to the creation of tasks
my %data = %default_data;
create($current_date, '', $global_models{$key},
$Conf::Conf{$key}, \%data);
$used_models{$1} = 1; #!!!FIXME FIXME FIXME!!!
}
}
}
# list tasks
foreach my $robot (Sympa::List::get_robots()) {
my $all_lists = Sympa::List::get_lists($robot);
last if $end;
foreach my $list (@{$all_lists || []}) {
my %data = %default_data;
$data{'list'} = {
'name' => $list->{'name'},
'robot' => $list->{'domain'}
};
my %used_list_models; # stores which models already have a task
foreach (@list_models) { $used_list_models{$_} = undef; }
foreach my $model (Sympa::Task::get_used_models($list->get_id)) {
$used_list_models{$model} = 1;
}
foreach my $model (@list_models) {
unless ($used_list_models{$model}) {
my $model_task_parameter = "$model" . '_task';
if ($model eq 'sync_include') {
next
unless ($list->has_include_data_sources()
&& ($list->{'admin'}{'status'} eq 'open'));
create($current_date, 'INIT', $model, 'ttl', \%data);
} elsif (defined $list->{'admin'}{$model_task_parameter}
&& defined $list->{'admin'}{$model_task_parameter}
{'name'}
&& ($list->{'admin'}{'status'} eq 'open')) {
create($current_date, '', $model,
$list->{'admin'}{$model_task_parameter}{'name'},
\%data);
}
}
}
}
}
last if $end;
## Execute existing tasks
## List all tasks
unless (Sympa::Task::list_tasks($spool_task)) {
Sympa::send_notify_to_listmaster('*', 'intern_error',
{'error' => "Failed to list task files in $spool_task"});
$log->syslog('err', "Failed to list task files in %s", $spool_task);
exit -1;
}
## processing of tasks anterior to the current date
$log->syslog('debug3',
'Processing of tasks anterior to the current date');
foreach my $task (Sympa::Task::get_task_list()) {
last if $end;
my $task_file = $task->{'filepath'};
$log->syslog('debug3', 'Procesing %s', $task_file);
last unless ($task->{'date'} < $current_date);
if ($task->{'object'} ne '_global') { # list task
my $list = $task->{'list_object'};
## Skip closed lists
unless (defined $list && ($list->{'admin'}{'status'} eq 'open')) {
$log->syslog('notice',
'Removing task file %s because the list is not opened',
$task_file);
unless (unlink $task_file) {
$log->syslog('err', 'Unable to remove task file %s: %m',
$task_file);
next;
}
next;
}
## Skip if parameter is not defined
if ($task->{'model'} eq 'sync_include') {
unless ($list->{'admin'}{'status'} eq 'open') {
$log->syslog('notice', 'Removing task file %s',
$task_file);
unless (unlink $task_file) {
$log->syslog('err',
'Unable to remove task file %s: %m', $task_file);
next;
}
next;
}
} else {
unless (defined $list->{'admin'}{$task->{'model'}}
&& defined $list->{'admin'}{$task->{'model'}}{'name'}) {
$log->syslog('notice', 'Removing task file %s',
$task_file);
unless (unlink $task_file) {
$log->syslog('err',
'Unable to remove task file %s: %m', $task_file);
next;
}
next;
}
}
}
execute($task);
}
sleep 60;
}
# Purge grouped notifications
Sympa::Alarm->instance->flush(purge => 1);
$log->syslog('notice', 'Task_Manager exited normally due to signal');
$process->remove_pid(final => 1);
exit(0);
####### SUBROUTINES #######
## task creations
sub create {
my $date = shift;
my $label = shift;
my $model = shift;
my $model_choice = shift;
my $Rdata = shift;
$log->syslog('debug2',
"create date : $date label : $label model $model : $model_choice Rdata :$Rdata"
);
my $task_file;
my $list_name;
my $robot;
my $object;
if (defined $Rdata->{'list'}) {
$list_name = $Rdata->{'list'}{'name'};
$robot = $Rdata->{'list'}{'robot'};
$task_file = "$spool_task/$date.$label.$model.$list_name\@$robot";
$object = 'list';
} else {
$object = '_global';
$task_file =
$spool_task . '/'
. $date . '.'
. $label . '.'
. $model . '.'
. $object;
}
## model recovery
my $model_file;
my $model_name = $model . '.' . $model_choice . '.' . 'task';
$log->syslog('notice', 'Creation of %s', $task_file);
# for global model
if ($object eq '_global') {
unless (
$model_file = Sympa::search_fullpath(
'*', $model_name, subdir => 'global_task_models'
)
) {
$log->syslog('err', 'Unable to find %s, creation aborted',
$model_name);
return undef;
}
}
# for a list
if ($object eq 'list') {
my $list = Sympa::List->new($list_name, $robot);
$Rdata->{'list'}{'ttl'} = $list->{'admin'}{'ttl'};
unless (
$model_file = Sympa::search_fullpath(
$list, $model_name, subdir => 'list_task_models'
)
) {
$log->syslog('err',
"error : unable to find $model_name, for list $list_name creation aborted"
);
return undef;
}
}
$log->syslog('notice', 'With model %s', $model_file);
## creation
open(TASK, ">$task_file");
my $tt2 = Template->new(
{ 'START_TAG' => quotemeta('['),
'END_TAG' => quotemeta(']'),
'ABSOLUTE' => 1
}
);
unless (defined $tt2 && $tt2->process($model_file, $Rdata, \*TASK)) {
$log->syslog('err', 'Failed to parse task template "%s": %s',
$model_file, $tt2->error());
}
#&parser::parse_tpl($Rdata, $model_file, \*TASK);
close(TASK);
if (!check($task_file)) {
$log->syslog('err',
"error : syntax error in $task_file, you should check $model_file"
);
unlink($task_file)
? $log->syslog('notice', '%s deleted', $task_file)
: $log->syslog('err', 'Unable to delete %s', $task_file);
return undef;
}
return 1;
}
### SYNTAX CHECKING SUBROUTINES ###
## check the syntax of a task
sub check {
my $task_file = shift; # the task to check
$log->syslog('debug2', '(%s)', $task_file);
my %result; # stores the result of the chk_line subroutine
my $lnb = 0; # line number
my %used_labels; # list of labels used as parameter in commands
my %labels; # list of declared labels
my %used_vars; # list of vars used as parameter in commands
my %vars; # list of declared vars
unless (open(TASK, $task_file)) {
$log->syslog('err', 'Unable to read %s, checking is impossible',
$task_file);
return undef;
}
while () {
chomp;
$lnb++;
next if ($_ =~ /^\s*\#/);
unless (chk_line($_, \%result)) {
$log->syslog('err', 'Error at line %s: %s', $lnb, $_);
$log->syslog('err', '%s', $result{'error'});
return undef;
}
if ($result{'nature'} eq 'assignment') {
if (chk_cmd(
$result{'command'}, $lnb,
$result{'Rarguments'}, \%used_labels,
\%used_vars
)
) {
$vars{$result{'var'}} = 1;
} else {
return undef;
}
}
if ($result{'nature'} eq 'command') {
return undef
unless (
chk_cmd(
$result{'command'}, $lnb,
$result{'Rarguments'}, \%used_labels,
\%used_vars
)
);
}
$labels{$result{'label'}} = 1 if ($result{'nature'} eq 'label');
}
# are all labels used ?
foreach my $label (keys %labels) {
$log->syslog('debug3', 'Warning: Label %s exists but is not used',
$label)
unless ($used_labels{$label});
}
# do all used labels exist ?
foreach my $label (keys %used_labels) {
unless ($labels{$label}) {
$log->syslog('err', 'Label %s is used but does not exist',
$label);
return undef;
}
}
# are all variables used ?
foreach my $var (keys %vars) {
$log->syslog('notice', 'Warning: Var %s exists but is not used', $var)
unless ($used_vars{$var});
}
# do all used variables exist ?
foreach my $var (keys %used_vars) {
unless ($vars{$var}) {
$log->syslog('err', 'Var %s is used but does not exist', $var);
return undef;
}
}
return 1;
}
## check a task line
sub chk_line {
my $line = $_[0];
my $Rhash =
$_[1]; # will contain nature of line (label, command, error...)
## just in case...
chomp $line;
$log->syslog('debug2', '(%s, %s)', $line, $Rhash->{'nature'});
$Rhash->{'nature'} = undef;
# empty line
if (!$line) {
$Rhash->{'nature'} = 'empty line';
return 1;
}
# comment
if ($line =~ /^\s*\#.*/) {
$Rhash->{'nature'} = 'comment';
return 1;
}
# title
if ($line =~ /^\s*title\...\s*(.*)\s*/i) {
$Rhash->{'nature'} = 'title';
$Rhash->{'title'} = $1;
return 1;
}
# label
if ($line =~ /^\s*\/\s*(.*)/) {
$Rhash->{'nature'} = 'label';
$Rhash->{'label'} = $1;
return 1;
}
# command
if ($line =~ /^\s*(\w+)\s*\((.*)\)\s*/i) {
my $command = lc($1);
my @args = split(/,/, $2);
foreach (@args) { s/\s//g; }
unless ($commands{$command}) {
$Rhash->{'nature'} = 'error';
$Rhash->{'error'} = "unknown command $command";
return 0;
}
$Rhash->{'nature'} = 'command';
$Rhash->{'command'} = $command;
# arguments recovery. no checking of their syntax !!!
$Rhash->{'Rarguments'} = \@args;
return 1;
}
# assignment
if ($line =~ /^\s*(@\w+)\s*=\s*(.+)/) {
my %hash2;
chk_line($2, \%hash2);
unless ($asgn_commands{$hash2{'command'}}) {
$Rhash->{'nature'} = 'error';
$Rhash->{'error'} = "non valid assignment $2";
return 0;
}
$Rhash->{'nature'} = 'assignment';
$Rhash->{'var'} = $1;
$Rhash->{'command'} = $hash2{'command'};
$Rhash->{'Rarguments'} = $hash2{'Rarguments'};
return 1;
}
$Rhash->{'nature'} = 'error';
$Rhash->{'error'} = 'syntax error';
return 0;
}
## check the arguments of a command
sub chk_cmd {
my $cmd = $_[0]; # command name
my $lnb = $_[1]; # line number
my $Rargs = $_[2]; # argument list
my $Rused_labels = $_[3];
my $Rused_vars = $_[4];
$log->syslog('debug2', '(%s, %d, %s)', $cmd, $lnb, join(',', @{$Rargs}));
if (defined $commands{$cmd}) {
my @expected_args = @{$commands{$cmd}};
my @args = @{$Rargs};
unless ($#expected_args == $#args) {
$log->syslog('err',
'Error at line %s: wrong number of arguments for %s',
$lnb, $cmd);
$log->syslog('err',
'Args = @args; expected_args = @expected_args');
return undef;
}
foreach (@args) {
undef my $error;
my $regexp = $expected_args[0];
shift(@expected_args);
if ($regexp eq 'date') {
$error = 1
unless ((/^$date_arg_regexp1$/i)
or (/^$date_arg_regexp2$/i)
or (/^$date_arg_regexp3$/i));
} elsif ($regexp eq 'delay') {
$error = 1 unless (/^$delay_regexp$/i);
} elsif ($regexp eq 'var') {
$error = 1 unless (/^$var_regexp$/i);
} elsif ($regexp eq 'subarg') {
$error = 1 unless (/^$subarg_regexp$/i);
} else {
$error = 1 unless (/^$regexp$/i);
}
if ($error) {
$log->syslog('err',
'Error at line %s: argument %s is not valid',
$lnb, $_);
return undef;
}
$Rused_labels->{$args[1]} = 1 if ($cmd eq 'next' && ($args[1]));
$Rused_vars->{$args[0]} = 1 if ($var_commands{$cmd});
}
}
return 1;
}
### TASK EXECUTION SUBROUTINES ###
sub execute {
my $task = shift;
my $task_file = $task->{'filepath'}; # task to execute
my %result; # stores the result of the chk_line subroutine
my %vars; # list of task vars
my $lnb = 0; # line number
$log->syslog('notice', 'Running task %s, line %d with vars %s)',
$task_file, $lnb, join('/', %vars));
unless (open(TASK, $task_file)) {
$log->syslog('err', 'Can\'t read the task %s', $task_file);
return undef;
}
my $label = $task->{'label'};
return undef if ($label eq 'ERROR');
$log->syslog('debug2', '* execution of the task %s', $task_file);
if (length $label) {
while () {
chomp;
$lnb++;
chk_line($_, \%result);
next unless defined $result{'label'};
last if $result{'label'} eq $label;
}
}
# execution
my $status;
while () {
chomp;
$lnb++;
unless (chk_line($_, \%result)) {
$log->syslog('err', '%s', $result{'error'});
return undef;
}
# processing of the assignments
if ($result{'nature'} eq 'assignment') {
$status = $vars{$result{'var'}} =
cmd_process($result{'command'}, $result{'Rarguments'}, $task,
\%vars, $lnb);
last unless defined($status);
}
# processing of the commands
if ($result{'nature'} eq 'command') {
$status =
cmd_process($result{'command'}, $result{'Rarguments'}, $task,
\%vars, $lnb);
last unless (defined($status) && $status >= 0);
}
}
close(TASK);
unless (defined $status) {
$log->syslog('err', 'Error while processing task, removing %s',
$task_file);
unless (unlink($task_file)) {
$log->syslog('err', 'Unable to remove task file %s: %m',
$task_file);
return undef;
}
return undef;
}
unless ($status >= 0) {
$log->syslog('notice', 'The task %s is now useless. Removing it',
$task_file);
unless (unlink($task_file)) {
$log->syslog('err', 'Unable to remove task file %s: %m',
$task_file);
return undef;
}
}
return 1;
}
sub cmd_process {
my $command = $_[0]; # command name
my $Rarguments = $_[1]; # command arguments
my $task = $_[2]; # task
my $Rvars = $_[3]; # variable list of the task
my $lnb = $_[4]; # line number
my $task_file = $task->{'filepath'};
$log->syslog('debug2', '(%s, %s, %d)', $command, $task_file, $lnb);
# building of %context
my %context = ('line_number' => $lnb);
$log->syslog(
'debug2',
'Current task: %s',
join(':', map { (defined $_) ? $_ : '' } (%$task))
);
# regular commands
return stop($task, \%context) if ($command eq 'stop');
return next_cmd($task, $Rarguments, \%context) if ($command eq 'next');
return create_cmd($task, $Rarguments, \%context)
if ($command eq 'create');
return exec_cmd($task, $Rarguments) if ($command eq 'exec');
return expire_bounce($task, $Rarguments, \%context)
if ($command eq 'expire_bounce');
return purge_user_table($task, \%context)
if ($command eq 'purge_user_table');
return purge_logs_table($task, \%context)
if ($command eq 'purge_logs_table');
return purge_session_table($task, \%context)
if ($command eq 'purge_session_table');
return purge_spools($task, \%context) if $command eq 'purge_spools';
return purge_tables($task, \%context) if ($command eq 'purge_tables');
return purge_one_time_ticket_table($task, \%context)
if ($command eq 'purge_one_time_ticket_table');
return sync_include($task, \%context) if ($command eq 'sync_include');
return purge_orphan_bounces($task, \%context)
if ($command eq 'purge_orphan_bounces');
return eval_bouncers($task, \%context) if ($command eq 'eval_bouncers');
return process_bouncers($task, \%context)
if ($command eq 'process_bouncers');
# commands which use a variable
return send_msg($task, $Rarguments, $Rvars, \%context)
if ($command eq 'send_msg');
return rm_file($task, $Rarguments, $Rvars, \%context)
if ($command eq 'rm_file');
# commands which return a variable
return select_subs($task, $Rarguments, \%context)
if ($command eq 'select_subs');
# commands which return and use a variable
return delete_subs_cmd($task, $Rarguments, $Rvars, \%context)
if ($command eq 'delete_subs');
}
### command subroutines ###
# remove files whose name is given in the key 'file' of the hash
sub rm_file {
my ($task, $Rarguments, $Rvars, $context) = @_;
my @tab = @{$Rarguments};
my $var = $tab[0];
foreach my $key (keys %{$Rvars->{$var}}) {
my $file = $Rvars->{$var}{$key}{'file'};
next unless ($file);
unless (unlink($file)) {
error($task->{'filepath'},
"error in rm_file command : unable to remove $file");
return undef;
}
}
return 1;
}
sub stop {
my ($task, $context) = @_;
my $task_file = $spool_task . '/' . $task->{'filename'};
$log->syslog('notice', '%s: stop %s', $context->{'line_number'},
$task_file);
unlink($task_file)
? $log->syslog('notice', '--> %s deleted', $task_file)
: error($task_file,
"error in stop command : unable to delete task file");
return 0;
}
sub send_msg {
my ($task, $Rarguments, $Rvars, $context) = @_;
my @tab = @{$Rarguments};
my $template = $tab[1];
my $var = $tab[0];
$log->syslog(
'notice',
'Line %s: send_msg (@{%s})',
$context->{'line_number'}, $Rarguments
);
if ($task->{'object'} eq '_global') {
foreach my $email (keys %{$Rvars->{$var}}) {
$log->syslog('notice', '--> message sent to %s', $email);
unless ($log_only) {
unless (
Sympa::send_file(
'*', $template, $email, $Rvars->{$var}{$email}
)
) {
$log->syslog('notice', 'Unable to send template %s to %s',
$template, $email);
}
}
}
} else {
my $list = $task->{'list_object'};
foreach my $email (keys %{$Rvars->{$var}}) {
$log->syslog('notice', '--> message sent to %s', $email);
unless ($log_only) {
unless (
Sympa::send_file(
$list, $template, $email, $Rvars->{$var}{$email}
)
) {
$log->syslog('notice', 'Unable to send template %s to %s',
$template, $email);
}
}
}
}
return 1;
}
sub next_cmd {
my ($task, $Rarguments, $context) = @_;
my @tab = @{$Rarguments};
# conversion of the date argument into epoch format
my $date = Sympa::Tools::Time::epoch_conv($tab[0], $task->{'date'});
my $label = $tab[1];
$log->syslog('notice',
"line $context->{'line_number'} of $task->{'model'} : next ($date, $label)"
);
my $listname = $task->{'object'};
my $model = $task->{'model'};
my $filename = $task->{'filepath'};
## Determine type
my ($type, $model_choice);
my %data = (
'creation_date' => $task->{'date'},
'execution_date' => 'execution_date'
);
if ($listname eq '_global') {
$type = '_global';
foreach my $key (keys %global_models) {
if ($global_models{$key} eq $model) {
$model_choice = $Conf::Conf{$key};
last;
}
}
} else {
$type = 'list';
my $list = $task->{'list_object'};
$data{'list'}{'name'} = $list->{'name'};
$data{'list'}{'robot'} = $list->{'domain'};
if ($model eq 'sync_include') {
$data{'list'}{'ttl'} = $list->{'admin'}{'ttl'};
$model_choice = 'ttl';
} else {
unless (defined $list->{'admin'}{"$model\_task"}) {
error($filename,
"List $list->{'name'} no more require $model task");
return undef;
}
$model_choice = $list->{'admin'}{"$model\_task"}{'name'};
}
}
unless (create($date, $tab[1], $model, $model_choice, \%data)) {
error($filename,
"error in create command : creation subroutine failure");
return undef;
}
# my $new_task = "$date.$label.$name[2].$name[3]";
my $human_date = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime $date);
# my $new_task_file = "$spool_task/$new_task";
# unless (rename ($filename, $new_task_file)) {
# error ($filename,
# "error in next command : unable to rename task file into $new_task");
# return undef;
# }
unless (unlink($filename)) {
error($filename,
"error in next command : unable to remove task file $filename");
return undef;
}
$log->syslog('notice', '--> new task %s (%s)', $model, $human_date);
return 0;
}
sub select_subs {
my ($task, $Rarguments, $context) = @_;
my @tab = @{$Rarguments};
my $condition = $tab[0];
$log->syslog(
'debug2',
'Line %s: select_subs (%s)',
$context->{'line_number'}, $condition
);
$condition =~ /(\w+)\(([^\)]*)\)/;
if ($2) { # conversion of the date argument into epoch format
my $date = Sympa::Tools::Time::epoch_conv($2, $task->{'date'});
$condition = "$1($date)";
}
my @users; # the subscribers of the list
my %selection; # hash of subscribers who match the condition
my $list = $task->{'list_object'};
for (
my $user = $list->get_first_list_member();
$user;
$user = $list->get_next_list_member()
) {
push(@users, $user);
}
# parameter of subroutine Sympa::Scenario::verify
my $verify_context = {
'sender' => 'nobody',
'email' => 'nobody',
'remote_host' => 'unknown_host',
'listname' => $task->{'object'}
};
my $new_condition =
$condition; # necessary to the older & newer condition rewriting
# loop on the subscribers of $list_name
foreach my $user (@users) {
# AF : voir 'update' $log->syslog ('notice', "date $user->{'date'} & update $user->{'update'}");
# condition rewriting for older and newer
$new_condition = "$1($user->{'update_date'}, $2)"
if ($condition =~ /(older|newer)\((\d+)\)/);
if (Sympa::Scenario::verify($verify_context, $new_condition) == 1) {
$selection{$user->{'email'}} = undef;
$log->syslog('notice', '--> user %s has been selected',
$user->{'email'});
}
}
return \%selection;
}
sub delete_subs_cmd {
my ($task, $Rarguments, $Rvars, $context) = @_;
my @tab = @{$Rarguments};
my $var = $tab[0];
$log->syslog(
'notice',
'Line %s: delete_subs (%s)',
$context->{'line_number'}, $var
);
my $list = $task->{'list_object'};
my %selection; # hash of subscriber emails who are successfully deleted
foreach my $email (keys %{$Rvars->{$var}}) {
$log->syslog('notice', '%s', $email);
my $result = Sympa::Scenario::request_action(
$list, 'del', 'smime',
{ 'sender' => $Conf::Conf{'listmaster'}, #FIXME
'email' => $email,
}
);
my $action;
$action = $result->{'action'} if (ref($result) eq 'HASH');
if ($action =~ /reject/i) {
error($task->{'filepath'},
"error in delete_subs command : deletion of $email not allowed"
);
} else {
my $u = $list->delete_list_member(
users => [$email],
operation => 'auto_del'
) unless $log_only;
$log->syslog('notice', '--> %s deleted', $email);
$selection{$email} = {};
}
}
return \%selection;
}
sub create_cmd {
my ($task, $Rarguments, $context) = @_;
my @tab = @{$Rarguments};
my $arg = $tab[0];
my $model = $tab[1];
my $model_choice = $tab[2];
$log->syslog('notice',
"line $context->{'line_number'} : create ($arg, $model, $model_choice)"
);
# recovery of the object type and object
my $type;
my $object;
if ($arg =~ /$subarg_regexp/) {
$type = $1;
$object = $3;
} else {
error($task->{'filepath'},
"error in create command : don't know how to create $arg");
return undef;
}
# building of the data hash necessary to the create subroutine
my %data = (
'creation_date' => $task->{'date'},
'execution_date' => 'execution_date'
);
if ($type eq 'list') {
my $list = Sympa::List->new($object);
$data{'list'}{'name'} = $list->{'name'};
}
$type = '_global';
unless (create($task->{'date'}, '', $model, $model_choice, \%data)) {
error($task->{'filepath'},
"error in create command : creation subroutine failure");
return undef;
}
return 1;
}
sub exec_cmd {
my ($task, $Rarguments, $context) = @_;
my @tab = @{$Rarguments};
my $file = $tab[0];
$log->syslog(
'notice',
'Line %s: exec (%s)',
$context->{'line_number'}, $file
);
system($file);
return 1;
}
sub purge_logs_table {
$log->syslog('debug2', '(%s, %s)', @_);
my ($task, $context) = @_;
#my $execution_date = $task->{'date'};
unless (_db_log_del()) {
$log->syslog('err', 'Failed to delete logs');
return undef;
}
$log->syslog('notice', 'Logs purged');
if ($log->aggregate_stat) {
$log->syslog('notice', 'Stats aggregated');
}
return 1;
}
# Deletes logs in RDBMS.
# If a log is older than $list->get_latest_distribution_date() - $delay
# expire the log.
sub _db_log_del {
my ($exp, $date);
my $sdm = Sympa::DatabaseManager->instance;
$exp = Conf::get_robot_conf('*', 'logs_expiration_period');
$date = time - ($exp * 31 * 24 * 60 * 60);
unless (
$sdm
and $sdm->do_prepared_query(
q{DELETE FROM logs_table
WHERE date_logs <= ?},
$date
)
) {
$log->syslog('err',
'Unable to delete db_log entry from the database');
return undef;
}
$exp = Conf::get_robot_conf('*', 'stats_expiration_period');
$date = time - ($exp * 31 * 24 * 60 * 60);
unless (
$sdm->do_prepared_query(
q{DELETE FROM stat_table
WHERE date_stat <= ?},
$date
)
) {
$log->syslog('err',
'Unable to delete db_log entry from the database');
return undef;
}
unless (
$sdm->do_prepared_query(
q{DELETE FROM stat_counter_table
WHERE end_date_counter <= ?},
$date
)
) {
$log->syslog('err',
'Unable to delete db_log entry from the database');
return undef;
}
return 1;
}
## remove sessions from session_table if older than $Conf::Conf{'session_table_ttl'}
sub purge_session_table {
$log->syslog('info', '');
my $removed = Sympa::Session::purge_old_sessions('*');
unless (defined $removed) {
$log->syslog('err', 'Failed to remove old sessions');
return undef;
}
$log->syslog('notice', '%s row removed in session_table', $removed);
return 1;
}
# Remove messages from spools if older than duration given by configuration.
sub purge_spools {
# Expiring bad messages in incoming spools and archive spool.
foreach my $queue (qw(queue queueautomatic queuebounce queueoutgoing)) {
my $directory = $Conf::Conf{$queue} . '/bad';
my $clean_delay = $Conf::Conf{'clean_delay_' . $queue};
if (-e $directory) {
_clean_spool($directory, $clean_delay);
}
}
# Expiring bad messages in digest spool.
if (opendir my $dh, $Conf::Conf{'queuedigest'}) {
my $base_dir = $Conf::Conf{'queuedigest'};
my @dirs = grep { !/\A\./ and -d $base_dir . '/' . $_ } readdir $dh;
closedir $dh;
foreach my $subdir (@dirs) {
my $directory = $base_dir . '/' . $subdir . '/bad';
my $clean_delay = $Conf::Conf{'clean_delay_queuedigest'};
if (-e $directory) {
_clean_spool($directory, $clean_delay);
}
}
}
# Expiring bad packets and messages in bulk spool.
foreach my $subdir (qw(pct msg)) {
my $directory = $Conf::Conf{'queuebulk'} . '/bad/' . $subdir;
my $clean_delay = $Conf::Conf{'clean_delay_queuebulk'};
if (-e $directory) {
_clean_spool($directory, $clean_delay);
}
}
# Expiring moderation spools except mod, topic spool and temporary files.
foreach my $queue (
qw(queueauth queueautomatic queuesubscribe queuetopic tmpdir)) {
my $directory = $Conf::Conf{$queue};
my $clean_delay = $Conf::Conf{'clean_delay_' . $queue};
if (-e $directory) {
_clean_spool($directory, $clean_delay);
}
}
# Expiring mod spool.
my $modqueue = $Conf::Conf{'queuemod'};
if (opendir my $dh, $modqueue) {
my @qfiles = sort readdir $dh;
closedir $dh;
foreach my $i (@qfiles) {
next if $i =~ /\A[.]/;
next unless -f $modqueue . '/' . $i;
$i =~ /\A(.+)_[.\w]+\z/;
my $list = Sympa::List->new($1, '*', {just_try => 1}) if $1;
my $moddelay;
if (ref $list eq 'Sympa::List') {
$moddelay = $list->{'admin'}{'clean_delay_queuemod'};
} else {
$moddelay = $Conf::Conf{'clean_delay_queuemod'};
}
if ($moddelay) {
my $mtime =
Sympa::Tools::File::get_mtime($modqueue . '/' . $i);
if ($mtime < time - $moddelay * 86400) {
unlink($modqueue . '/' . $i);
$log->syslog('notice',
'Deleting unmoderated message %s, too old', $i);
}
}
}
}
# Expiring formatted held messages.
if (opendir my $dh, $Conf::Conf{'viewmail_dir'} . '/mod') {
my $base_dir = $Conf::Conf{'viewmail_dir'} . '/mod';
my @dirs = grep { !/\A\./ and -d $base_dir . '/' . $_ } readdir $dh;
closedir $dh;
foreach my $list_id (@dirs) {
my $clean_delay;
my $list = Sympa::List->new($list_id, '*', {just_try => 1});
if (ref $list eq 'Sympa::List') {
$clean_delay = $list->{'admin'}{'clean_delay_queuemod'};
} else {
$clean_delay = $Conf::Conf{'clean_delay_queuemod'};
}
my $directory = $base_dir . '/' . $list_id;
if ($clean_delay and -e $directory) {
_clean_spool($directory, $clean_delay);
}
}
}
# Removing messages in bulk spool with no more packet.
my $pct_directory = $Conf::Conf{'queuebulk'} . '/pct';
my $msg_directory = $Conf::Conf{'queuebulk'} . '/msg';
if (opendir my $dh, $pct_directory) {
my $msgpath;
while ($msgpath = readdir $dh) {
next if $msgpath =~ /\A\./;
next unless -d $pct_directory . '/' . $msgpath;
next
if time - 3600 < Sympa::Tools::File::get_mtime(
$pct_directory . '/' . $msgpath);
# If packet directory is empty, remove message also.
unlink($msg_directory . '/' . $msgpath)
if rmdir($pct_directory . '/' . $msgpath);
}
closedir $dh;
}
return 1;
}
# Old name: tools::CleanSpool(), Sympa::Tools::File::CleanDir().
sub _clean_spool {
$log->syslog('debug2', '(%s, %s)', @_);
my ($directory, $clean_delay) = @_;
return 1 unless $clean_delay;
my $dh;
unless (opendir $dh, $directory) {
$log->syslog('err', 'Unable to open "%s" spool: %m', $directory);
return undef;
}
my @qfile = sort grep { !/\A\.+\z/ and !/\Abad\z/ } readdir $dh;
closedir $dh;
my ($curlist, $moddelay);
foreach my $f (@qfile) {
if (Sympa::Tools::File::get_mtime("$directory/$f") <
time - $clean_delay * 60 * 60 * 24) {
if (-f "$directory/$f") {
unlink("$directory/$f");
$log->syslog('notice', 'Deleting old file %s',
"$directory/$f");
} elsif (-d "$directory/$f") {
unless (Sympa::Tools::File::remove_dir("$directory/$f")) {
$log->syslog('err', 'Cannot remove old directory %s: %m',
"$directory/$f");
next;
}
$log->syslog('notice', 'Deleting old directory %s',
"$directory/$f");
}
}
}
return 1;
}
## remove messages from bulkspool table when no more packet have any pointer
## to this message
sub purge_tables {
$log->syslog('info', '');
my $removed;
$removed = 0;
foreach my $robot (Sympa::List::get_robots()) {
my $all_lists = Sympa::List::get_lists($robot);
return 1 if $end;
foreach my $list (@{$all_lists || []}) {
my $tracking = Sympa::Tracking->new(context => $list);
$removed +=
$tracking->remove_message_by_period(
$list->{'admin'}{'tracking'}{'retention_period'});
}
}
$log->syslog('notice', "%s rows removed in tracking table", $removed);
return 1;
}
## remove one time ticket table if older than $Conf::Conf{'one_time_ticket_table_ttl'}
sub purge_one_time_ticket_table {
$log->syslog('info', '');
my $removed = Sympa::Ticket::purge_old_tickets('*');
unless (defined $removed) {
$log->syslog('err', 'Failed to remove old tickets');
return undef;
}
$log->syslog('notice', '%s row removed in one_time_ticket_table',
$removed);
return 1;
}
sub purge_user_table {
my ($task, $Rarguments, $context) = @_;
$log->syslog('debug2', '');
my $sdm = Sympa::DatabaseManager->instance;
my $time = time;
# Marking super listmasters
foreach my $l (Sympa::get_listmasters_email('*')) {
unless (
$sdm
and $sdm->do_prepared_query(
q{UPDATE user_table
SET last_active_date_user = ?
WHERE email_user = ?},
$time, lc $l
)
) {
$log->syslog('err', 'Failed to check activity of users');
return undef;
}
}
# Marking per-robot listmasters.
foreach my $robot_id (Sympa::List::get_robots()) {
foreach my $l (Sympa::get_listmasters_email($robot_id)) {
unless (
$sdm->do_prepared_query(
q{UPDATE user_table
SET last_active_date_user = ?
WHERE email_user = ?},
$time, lc $l
)
) {
$log->syslog('err', 'Failed to check activity of users');
return undef;
}
}
}
# Marking new users, owners/editors and subscribers.
unless (
$sdm->do_prepared_query(
q{UPDATE user_table
SET last_active_date_user = ?
WHERE last_active_date_user IS NULL
OR EXISTS (
SELECT 1
FROM admin_table
WHERE admin_table.user_admin = user_table.email_user
)
OR EXISTS (
SELECT 1
FROM subscriber_table
WHERE subscriber_table.user_subscriber = user_table.email_user
)},
$time
)
) {
$log->syslog('err', 'Failed to check activity of users');
return undef;
}
# Look for unused entries.
my @purged_users;
my $sth;
unless (
$sth = $sdm->do_prepared_query(
q{SELECT email_user
FROM user_table
WHERE last_active_date_user IS NOT NULL AND
last_active_date_user < ?},
$time
)
) {
$log->syslog('err', 'Failed to get inactive users');
return undef;
}
@purged_users =
grep {$_} map { $_->[0] } @{$sth->fetchall_arrayref || []};
$sth->finish;
# Purge unused entries.
foreach my $email (@purged_users) {
my $user = Sympa::User->new($email);
next unless $user;
unless ($user->expire) {
$log->syslog('err', 'Failed to purge inactive user %s', $user);
return undef;
} else {
$log->syslog('info', 'User %s was expired', $user);
}
}
return scalar @purged_users;
}
## Subroutine which remove bounced message of no-more known users
sub purge_orphan_bounces {
my ($task, $context) = @_;
$log->syslog('info', '');
my $all_lists = Sympa::List::get_lists('*');
foreach my $list (@{$all_lists || []}) {
# First time: loading DB entries into %bounced_users,
# hash {'bounced address' => 1}
my %bounced_users;
for (
my $user_ref = $list->get_first_bouncing_list_member();
$user_ref;
$user_ref = $list->get_next_bouncing_list_member()
) {
my $user_id = $user_ref->{'email'};
$bounced_users{Sympa::Tools::Text::escape_chars($user_id)} = 1;
}
my $bounce_dir = $list->get_bounce_dir();
unless (-d $bounce_dir) {
$log->syslog('notice', 'No bouncing subscribers in list %s',
$list);
next;
}
# Then reading Bounce directory & compare with %bounced_users
my $dh;
unless (opendir $dh, $bounce_dir) {
$log->syslog('err', 'Error while opening bounce directory %s',
$bounce_dir);
return undef;
}
# Finally removing orphan files
my $marshalled;
while ($marshalled = readdir $dh) {
my $metadata =
Sympa::Spool::unmarshal_metadata($bounce_dir, $marshalled,
qr/\A([^\s\@]+\@[\w\.\-*]+?)(?:_(\w+))?\z/,
[qw(recipient envid)]);
next unless $metadata;
# Skip _ which is used by tracking feature.
next if defined $metadata->{envid};
unless ($bounced_users{$marshalled}) {
$log->syslog('info',
'Removing orphan Bounce for user %s in list %s',
$marshalled, $list);
unless (unlink($bounce_dir . '/' . $marshalled)) {
$log->syslog('err', 'Error while removing file %s/%s',
$bounce_dir, $marshalled);
}
}
}
closedir $dh;
}
return 1;
}
# If a bounce is older than $list->get_latest_distribution_date() - $delay
# expire the bounce.
sub expire_bounce {
$log->syslog('debug2', '(%s, %s, %s)', @_);
#FXIME: May this variable be set in to task model ?
my ($task, $Rarguments, $context) = @_;
my @tab = @{$Rarguments};
my $delay = $tab[0];
my $all_lists = Sympa::List::get_lists('*');
foreach my $list (@{$all_lists || []}) {
my $listname = $list->{'name'};
# the reference date is the date until which we expire bounces in
# second
# the latest_distribution_date is the date of last distribution #days
# from 01 01 1970
unless ($list->get_latest_distribution_date()) {
$log->syslog(
'debug2',
'Bounce expiration: skipping list %s because could not get latest distribution date',
$listname
);
next;
}
my $refdate =
(($list->get_latest_distribution_date() - $delay) * 3600 * 24);
for (
my $u = $list->get_first_bouncing_list_member();
$u;
$u = $list->get_next_bouncing_list_member()
) {
$u->{'bounce'} =~ /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/;
$u->{'last_bounce'} = $2;
if ($u->{'last_bounce'} < $refdate) {
my $email = $u->{'email'};
unless ($list->is_list_member($email)) {
$log->syslog('info', '%s not subscribed', $email);
next;
}
unless (
$list->update_list_member(
$email,
bounce => undef,
bounce_address => undef
)
) {
$log->syslog('info', 'Failed update database for %s',
$email);
next;
}
my $escaped_email = Sympa::Tools::Text::escape_chars($email);
my $bounce_dir = $list->get_bounce_dir();
unless (unlink $bounce_dir . '/' . $escaped_email) {
$log->syslog(
'info',
'Failed deleting %s',
$bounce_dir . '/' . $escaped_email
);
next;
}
$log->syslog(
'info',
'Expire bounces for subscriber %s of list %s (last distribution %s, last bounce %s)',
$email,
$listname,
POSIX::strftime(
"%Y-%m-%d",
localtime(
$list->get_latest_distribution_date() * 3600 * 24
)
),
POSIX::strftime(
"%Y-%m-%d", localtime($u->{'last_bounce'})
)
);
}
}
}
# Expiring formatted bounce messages.
if (opendir my $dh, $Conf::Conf{'viewmail_dir'} . '/bounce') {
my $base_dir = $Conf::Conf{'viewmail_dir'} . '/bounce';
my @dirs = grep { !/\A\./ and -d $base_dir . '/' . $_ } readdir $dh;
closedir $dh;
foreach my $list_id (@dirs) {
my $directory = $base_dir . '/' . $list_id;
if (-e $directory) {
_clean_spool($directory, $delay);
}
}
}
return 1;
}
# Removed because not yet fully implemented. See r11771.
#sub chk_cert_expiration;
# Removed becuase not yet fully implemented. See r11771.
#sub update_crl;
## Subroutine for bouncers evaluation:
# give a score for each bouncing user
sub eval_bouncers {
#################
my ($task, $context) = @_;
my $all_lists = Sympa::List::get_lists('*');
foreach my $list (@{$all_lists || []}) {
my $listname = $list->{'name'};
my $list_traffic = {};
$log->syslog('info', '(%s)', $listname);
## Analizing file Msg-count and fill %$list_traffic
unless (open(COUNT, $list->{'dir'} . '/msg_count')) {
$log->syslog('debug',
'** Could not open msg_count FILE for list %s', $listname);
next;
}
while () {
if (/^(\w+)\s+(\d+)/) {
my ($a, $b) = ($1, $2);
$list_traffic->{$a} = $b;
}
}
close(COUNT);
#for each bouncing user
for (
my $user_ref = $list->get_first_bouncing_list_member();
$user_ref;
$user_ref = $list->get_next_bouncing_list_member()
) {
my $score = get_score($user_ref, $list_traffic) || 0;
# Copying score into database.
unless (
$list->update_list_member(
$user_ref->{'email'}, bounce_score => $score
)
) {
$log->syslog('err', 'Error while updating DB for user %s',
$user_ref->{'email'});
next;
}
}
}
return 1;
}
sub none {
1;
}
# Routine for automatic bouncing users management
#
# This sub apply a treatment foreach category of bouncing-users
#
# The relation between possible actions and correponding subroutines
# is indicated by the following hash (%actions).
# It's possible to add actions by completing this hash and the one in list
# config (file List.pm, in sections "bouncers_levelX"). Then you must write
# the code for your action:
# The action subroutines have two parameter :
# - the name of the current list
# - a reference on users email list:
# Look at the "remove_bouncers" sub in List.pm for an example
sub process_bouncers {
my ($task, $context) = @_;
$log->syslog('info', 'Processing automatic actions on bouncing users');
## possible actions
my %actions = (
'remove_bouncers' => \&Sympa::List::remove_bouncers,
'notify_bouncers' => \&Sympa::List::notify_bouncers,
'none' => \&none
);
my $all_lists = Sympa::List::get_lists('*');
foreach my $list (@{$all_lists || []}) {
my $listname = $list->{'name'};
my @bouncers;
# @bouncers = (
# ['email1', 'email2', 'email3',....,], There is one line
# ['email1', 'email2', 'email3',....,], foreach bounce
# ['email1', 'email2', 'email3',....,], level.
# );
my $max_level;
for (
my $level = 1;
defined($list->{'admin'}{'bouncers_level' . $level});
$level++
) {
$max_level = $level;
}
## first, bouncing email are sorted in @bouncer
for (
my $user_ref = $list->get_first_bouncing_list_member();
$user_ref;
$user_ref = $list->get_next_bouncing_list_member()
) {
# Skip included users (cannot be removed)
next if $user_ref->{'included'};
for (my $level = $max_level; ($level >= 1); $level--) {
if ($user_ref->{'bounce_score'} >=
$list->{'admin'}{'bouncers_level' . $level}{'rate'}) {
push(@{$bouncers[$level]}, $user_ref->{'email'});
$level = ($level - $max_level);
}
}
}
## then, calling action foreach level
for (my $level = $max_level; ($level >= 1); $level--) {
my $action =
$list->{'admin'}{'bouncers_level' . $level}{'action'};
my $notification =
$list->{'admin'}{'bouncers_level' . $level}{'notification'};
my $robot_id = $list->{'domain'};
if (@{$bouncers[$level] || []}) {
## calling action subroutine with (list,email list) in
## parameter
unless ($actions{$action}->($list, $bouncers[$level])) {
$log->syslog(
'err',
'Error while calling action sub for bouncing users in list %s',
$listname
);
return undef;
}
# Notify owner or listmaster with list, action, email list.
my $param = {
#'listname' => $listname, # No longer used (<=6.1)
'action' => $action,
'user_list' => \@{$bouncers[$level]},
'total' => scalar(@{$bouncers[$level]}),
};
if ($notification eq 'owner') {
$list->send_notify_to_owner('automatic_bounce_management',
$param);
} elsif ($notification eq 'listmaster') {
Sympa::send_notify_to_listmaster($list,
'automatic_bounce_management', $param);
}
}
}
}
return 1;
}
sub get_score {
my $user_ref = shift;
my $list_traffic = shift;
$log->syslog('debug', '(%s)', $user_ref->{'email'});
my $min_period = $Conf::Conf{'minimum_bouncing_period'};
my $min_msg_count = $Conf::Conf{'minimum_bouncing_count'};
# Analizing bounce_subscriber_field and keep useful infos for notation
$user_ref->{'bounce'} =~ /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/;
my $BO_period = int($1 / 86400) - $Conf::Conf{'bounce_delay'};
my $EO_period = int($2 / 86400) - $Conf::Conf{'bounce_delay'};
my $bounce_count = $3;
my $bounce_type = $4;
my $msg_count = 0;
my $min_day = $EO_period;
unless ($bounce_count >= $min_msg_count) {
#not enough messages distributed to keep score
$log->syslog('debug', 'Not enough messages for evaluation of user %s',
$user_ref->{'email'});
return undef;
}
unless (($EO_period - $BO_period) >= $min_period) {
#too short bounce period to keep score
$log->syslog('debug', 'Too short period for evaluate %s',
$user_ref->{'email'});
return undef;
}
# calculate number of messages distributed in list while user was bouncing
foreach my $date (sort { $b <=> $a } keys(%$list_traffic)) {
if (($date >= $BO_period) && ($date <= $EO_period)) {
$min_day = $date;
$msg_count += $list_traffic->{$date};
}
}
# Adjust bounce_count when msg_count file is too recent, compared to the
# bouncing period
my $tmp_bounce_count = $bounce_count;
unless ($EO_period == $BO_period) {
my $ratio = (($EO_period - $min_day) / ($EO_period - $BO_period));
$tmp_bounce_count *= $ratio;
}
## Regularity rate tells how much user has bounced compared to list
## traffic
$msg_count ||= 1; ## Prevents "Illegal division by zero" error
my $regularity_rate = $tmp_bounce_count / $msg_count;
## type rate depends on bounce type (5 = permanent ; 4 =tewmporary)
my $type_rate = 1;
$bounce_type =~ /(\d)\.(\d)\.(\d)/;
if ($1 == 4) { # if its a temporary Error: score = score/2
$type_rate = .5;
}
my $note = $bounce_count * $regularity_rate * $type_rate;
## Note should be an integer
$note = int($note + 0.5);
# $note = 100 if ($note > 100); # shift between message ditrib & bounces =>
# note > 100
return $note;
}
### MISCELLANEOUS SUBROUTINES ###
## when we catch signal, just change the value of the loop variable.
sub sigterm {
my ($sig) = @_;
$log->syslog('notice',
'Signal %s received, still processing current task', $sig);
$end = 1;
}
## sort task name by their epoch date
sub epoch_sort {
$a =~ /(\d+)\..+/;
my $date1 = $1;
$b =~ /(\d+)\..+/;
my $date2 = $1;
$date1 <=> $date2;
}
## change the label of a task file
sub change_label {
my $task_file = $_[0];
my $new_label = $_[1];
my $new_task_file = $task_file;
$new_task_file =~ s/(.+\.)(\w*)(\.\w+\.\w+$)/$1$new_label$3/;
if (rename($task_file, $new_task_file)) {
$log->syslog('notice', '%s renamed in %s', $task_file,
$new_task_file);
} else {
$log->syslog('err', 'Error; can\'t rename %s in %s',
$task_file, $new_task_file);
}
}
## send a error message to list-master, log it, and change the label task into
## 'ERROR'
sub error {
my $task_file = $_[0];
my $message = $_[1];
my @param;
$param[0] =
"An error has occurred during the execution of the task $task_file :
$message";
$log->syslog('err', '%s', $message);
change_label($task_file, 'ERROR') unless $task_file eq '';
#FIXME: Coresponding mail template would be added.
Sympa::send_notify_to_listmaster('*', 'error_in_task', \@param);
}
sub sync_include {
my ($task, $context) = @_;
$log->syslog('debug2', '(%s)', $task->{'id'});
my $list = $task->{'list_object'};
$list->sync_include;
$list->sync_include_admin
if @{$list->{'admin'}{'editor_include'} || []}
or @{$list->{'admin'}{'owner_include'} || []};
if (not $list->has_include_data_sources
and (not -e $list->{'dir'} . '/.last_sync.member'
or [stat $list->{'dir'} . '/.last_sync.member']->[9] >
[stat $list->{'dir'} . '/config']->[9])
) {
$log->syslog('debug', 'List %s no more require sync_include task',
$list);
return -1;
}
}
__END__
=encoding utf-8
=head1 NAME
task_manager, task_manager.pl - Daemon to Process Periodical Sympa Tasks
=head1 SYNOPSIS
C S<[ C<--foreground> ]> S<[ C<--debug> ]>
=head1 DESCRIPTION
XXX @todo doc
=head1 OPTIONS
=over 4
=item C<-d>, C<--debug>
Sets the debug mode
=item C<-f>, C<--config=>I
Force task_manager to use an alternative configuration file instead
of F<--CONFIG-->.
=item C<-F>, C<--foreground>
Prevents the script from being daemonized
=item C<-h>, C<--help>
Prints this help message.
=item C<--log_level=>I
Set log level.
=back
=head1 FILES
F<$SPOOLDIR/task/> directory for task spool.
F<$PIDDIR/task_manager.pid> this file contains the process ID
of F.
=head1 MORE DOCUMENTATION
The full documentation in HTML and PDF formats can be
found in L.
The mailing lists (with web archives) can be accessed at
L.
=head1 BUGS
Report bugs to Sympa bug tracker.
See L.
=head1 SEE ALSO
L, L
=cut
sympa-6.2.24/src/sbin/bounced.pl.in 0000644 0001750 0001750 00000022077 13216651447 016016 0 ustar racke racke #!--PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
# directory of this distribution and at
# .
#
# 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, see .
## Worl Wide Sympa is a front-end to Sympa Mailing Lists Manager
## Copyright Comite Reseau des Universites
## Patch 2001.07.24 by nablaphi
## Change the Getopt::Std to Getopt::Long
use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use POSIX qw();
use Sympa::Alarm;
use Conf;
use Sympa::Constants;
use Sympa::Crash; # Show traceback.
use Sympa::DatabaseManager;
use Sympa::Log;
use Sympa::Process;
use Sympa::Spindle::ProcessBounce;
my $process = Sympa::Process->instance;
$process->init(pidname => 'bounced');
## Check options
my %options;
unless (
GetOptions(
\%main::options, 'config|f=s', 'debug|d', 'help|h',
'log_level=s', 'foreground|F', 'version|v',
)
) {
pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($main::options{'help'}) {
pod2usage(0);
} elsif ($main::options{'version'}) {
printf "Sympa %s\n", Sympa::Constants::VERSION;
exit 0;
}
$Conf::sympa_config = $main::options{config};
if ($main::options{'debug'}) {
$main::options{'log_level'} = 2 unless $main::options{'log_level'};
$main::options{'foreground'} = 1;
}
my $log = Sympa::Log->instance;
$log->{log_to_stderr} = 'all' if $main::options{'foreground'};
# Load sympa.conf
unless (Conf::load()) {
die sprintf
"Unable to load sympa configuration, file %s has errors.\n",
Conf::get_sympa_conf();
}
# Check database connectivity
unless (Sympa::DatabaseManager->instance) {
die sprintf
"Database %s defined in sympa.conf has not the right structure or is unreachable.\n",
$Conf::Conf{'db_name'};
}
# Put ourselves in background if not in debug mode.
unless ($main::options{'foreground'}) {
$process->daemonize;
}
# Create and write the PID file.
$process->write_pid(initial => 1);
# If process is running in foreground, don't write STDERR to a dedicated file.
unless ($main::options{foreground}) {
$process->direct_stderr_to_file;
}
if ($main::options{'log_level'}) {
$log->{level} = $main::options{'log_level'};
$log->syslog(
'info',
'Configuration file read, log level set using options: %s',
$main::options{'log_level'}
);
} else {
$log->{level} = $Conf::Conf{'log_level'};
$log->syslog(
'info',
'Configuration file read, default log level %s',
$Conf::Conf{'log_level'}
);
}
my $log_facility = $Conf::Conf{'log_facility'} || $Conf::Conf{'syslog'};
$log->openlog($log_facility, $Conf::Conf{'log_socket_type'});
## Set the User ID & Group ID for the process
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];
## Required on FreeBSD to change ALL IDs
## (effective UID + real UID + saved UID)
POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);
## Check if the UID has correctly been set (useful on OS X)
unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
&& ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
die
"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.\n";
}
## Sets the UMASK
umask(oct($Conf::Conf{'umask'}));
## Change to list root
unless (chdir($Conf::Conf{'home'})) {
die sprintf "Unable to change directory to %s: %s", $Conf::Conf{'home'},
$!;
}
$log->syslog('notice', 'Bounced %s Started', Sympa::Constants::VERSION());
my $spindle = Sympa::Spindle::ProcessBounce->new;
## Catch signals, in order to exit cleanly, whenever possible.
$SIG{'TERM'} = 'sigterm';
$SIG{'INT'} = 'sigterm';
while (not $spindle->{finish}) {
$spindle->spin;
last if $spindle->{finish};
# If the spool was empty, sleep for a while.
sleep $Conf::Conf{'sleep'};
}
# Purge grouped notifications
Sympa::Alarm->instance->flush(purge => 1);
$log->syslog('notice', 'Bounced exited normally due to signal');
$process->remove_pid(final => 1);
exit(0);
# When we catch signal, just change the value of the loop variable.
sub sigterm {
my ($sig) = @_;
$log->syslog('notice',
'Signal %s received, still processing current task', $sig);
$spindle->{finish} = $sig;
}
## copy the bounce to the appropriate filename
# Moved: Use Sympa::Tracking::store().
#sub store_bounce;
# Moved to Sympa::Spindle::ProcessBounce::_twist().
#sub process_message;
# Old name: Bounce::rfc1891().
# Moved to Sympa::Spindle::ProcessBounce::_parse_dsn().
#sub _parse_dsn;
# Moved to Sympa::Spindle::ProcessBounce::_parse_multipart_report().
#sub _parse_multipart_report;
# Moved to Sympa::Spindle::ProcessBounce::_decode_utf_8_addr_xtext().
#sub _decode_utf_8_addr_xtext;
# Moved to %Sympa::Spindle::ProcessBounce::equiv.
#my %equiv;
# Old name: Bounce::corrige().
# Moved to Sympa::Spindle::ProcessBounce::_corrige().
#sub _corrige;
# Old name: Bounce::anabounce().
# Moved to Sympa::Spindle::ProcessBounce::_anabounce().
#sub _anabounce;
# Moved to Sympa::Spindle::ProcessBounce::_canonicalize_status().
#sub _canonicalize_status;
# Moved: Now a subroutine of Sympa::Tracking::store().
#sub _update_subscriber_bounce_history;
# If bounce can't be handled correctly, saves it to the "bad" subdirectory of
# the bounce spool.
#DEPRECATED. Use Sympa::Spool::Bounce::quarantine().
# sub quarantine;
#DEPRECATED. Use Sympa::Spool::Bounce::remove().
# sub remove;
__END__
=encoding utf-8
=head1 NAME
bounced, bounced.pl - Mailing List Bounce Processing Daemon for Sympa
=head1 SYNOPSIS
C S<[ C<--foreground> ]> S<[ C<--debug> ]>
=head1 DESCRIPTION
Bounced is a program which scans permanently the bounce spool and
processes bounces (non-delivery messages), looking or bad addresses.
Bouncing addresses are tagged in database ; last bounce is kept for
each bouncing address.
List owners will latter access bounces information via WWSympa.
=head1 OPTIONS
These programs follow the usual GNU command line syntax,
with long options starting with two dashes (C<-->). A summary of
options is included below.
=over 5
=item C<-F>, C<--foreground>
Do not detach TTY.
=item C<-f>, C<--config=>I
Force bounced to use an alternative configuration file instead
of F<--CONFIG-->.
=item C<-d>, C<--debug>
Run the program in a debug mode.
=item C<-h>, C<--help>
Print this help message.
=item C<--log_level=>I
Sets daemon log level.
=back
=head1 FILES
F<--CONFIG--> Sympa configuration file.
F<$LIBEXECDIR/bouncequeue> bounce spooler, referenced from sendmail alias file
F<$SPOOLDIR/bounce> incoming bounces directory
F<$PIDDIR/bounced.pid> this file contains the process ID
of F.
=head1 MORE DOCUMENTATION
The full documentation can be
found in L.
The mailing lists (with web archives) can be accessed at
L.
=head1 HISTORY
This program was originally written by:
=over 4
=item Serge Aumont
ComitE<233> RE<233>seau des UniversitE<233>s
=item Olivier SalaE<252>n
ComitE<233> RE<233>seau des UniversitE<233>s
=back
This manual page was initially written by
JE<233>rE<244>me Marant
for the Debian GNU/Linux system.
=head1 LICENSE
You may distribute this software under the terms of the GNU General
Public License Version 2. For more details see F file.
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
any later version published by the Free Software Foundation; with no
Invariant Sections, no Front-Cover Texts and no Back-Cover Texts. A
copy of the license can be found under
L.
=head1 BUGS
Report bugs to Sympa bug tracker.
See L.
=head1 SEE ALSO
L, L, L, L.
L.
=cut
sympa-6.2.24/src/sbin/sympa_msg.pl.in 0000644 0001750 0001750 00000040277 13216651447 016400 0 ustar racke racke #!--PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
# directory of this distribution and at
# .
#
# 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, see .
use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use POSIX qw();
use Sympa::Alarm;
use Conf;
use Sympa::Constants;
use Sympa::Crash; # Show traceback.
use Sympa::DatabaseManager;
use Sympa::Language;
use Sympa::Log;
use Sympa::Mailer;
use Sympa::Process;
use Sympa::Spindle::ProcessDigest;
use Sympa::Spindle::ProcessIncoming;
use Sympa::Tools::Data;
my $process = Sympa::Process->instance;
$process->init(pidname => 'sympa_msg', name => 'sympa/msg');
## Internal tuning
# delay between each read of the digestqueue
my $digestsleep = 5;
## Init random engine
srand(time());
# Check options.
my %options;
unless (
GetOptions(
\%main::options, 'debug|d', 'log_level=s', 'foreground',
'config|f=s', 'lang|l=s', 'mail|m', 'keepcopy|k=s',
'help|h', 'version|v',
)
) {
pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($main::options{'help'}) {
pod2usage(0);
} elsif ($main::options{'version'}) {
printf "Sympa %s\n", Sympa::Constants::VERSION;
exit 0;
}
$Conf::sympa_config = $main::options{config};
if ($main::options{'debug'}) {
$main::options{'log_level'} = 2 unless $main::options{'log_level'};
$main::options{'foreground'} = 1;
}
my $log = Sympa::Log->instance;
$log->{log_to_stderr} = 'all' if $main::options{'foreground'};
my $language = Sympa::Language->instance;
my $mailer = Sympa::Mailer->instance;
_load();
# Put ourselves in background if we're not in debug mode.
unless ($main::options{'foreground'}) {
$process->daemonize;
# Fork a new process dedicated to automatic list creation, if required.
if ($Conf::Conf{'automatic_list_feature'} eq 'on') {
my $child_pid = fork;
if ($child_pid) {
waitpid $child_pid, 0;
$CHILD_ERROR and die;
} elsif (not defined $child_pid) {
die sprintf 'Cannot fork: %s', $ERRNO;
} else {
# We're in the specialized child process:
# automatic lists creation.
exec q{--sbindir--/sympa_automatic.pl}, map {
defined $main::options{$_}
? ("--$_", $main::options{$_})
: ()
} qw(config log_level mail);
die sprintf 'Cannot exec: %s', $ERRNO;
}
}
}
$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});
# Create and write the PID file.
$process->write_pid(initial => 1);
# If process is running in foreground, don't write STDERR to a dedicated file.
unless ($main::options{foreground}) {
$process->direct_stderr_to_file;
}
# Start multiple processes if required.
unless ($main::options{'foreground'}) {
if (0 == $process->{generation}
and ($Conf::Conf{'incoming_max_count'} || 0) > 1) {
# Disconnect from database before fork to prevent DB handles
# to be shared by different processes. Sharing database
# handles may crash sympa_msg.pl.
Sympa::DatabaseManager->disconnect;
for my $process_count (2 .. $Conf::Conf{'incoming_max_count'}) {
my $child_pid = $process->fork;
if ($child_pid) {
$log->syslog('info', 'Starting child daemon, PID %s',
$child_pid);
# Saves the PID number
$process->write_pid(pid => $child_pid);
#$created_children{$child_pid} = 1;
sleep 1;
} elsif (not defined $child_pid) {
$log->syslog('err', 'Cannot fork: %m');
last;
} else {
# We're in a child process
close STDERR;
$process->direct_stderr_to_file;
$log->openlog($Conf::Conf{'syslog'},
$Conf::Conf{'log_socket_type'});
$log->syslog('info', 'Slave daemon started with PID %s',
$PID);
last;
}
}
# Restore persistent connection.
Sympa::DatabaseManager->instance
or die 'Reconnecting database failed';
}
}
# Set the User ID & Group ID for the process
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];
## Required on FreeBSD to change ALL IDs
## (effective UID + real UID + saved UID)
POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);
## Check if the UID has correctly been set (useful on OS X)
unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
&& ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
die
"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.\n";
}
# Sets the UMASK
umask(oct($Conf::Conf{'umask'}));
## Most initializations have now been done.
$log->syslog('notice', 'Sympa/msg %s Started', Sympa::Constants::VERSION());
# Check for several files.
# Prevent that 2 processes perform checks at the same time...
#FIXME: This would be done in --health_check mode.
unless (Conf::checkfiles()) {
die "Missing files.\n";
## No return.
}
## Do we have right access in the directory
if ($main::options{'keepcopy'}) {
if (!-d $main::options{'keepcopy'}) {
$log->syslog(
'notice',
'Cannot keep a copy of incoming messages: %s is not a directory',
$main::options{'keepcopy'}
);
delete $main::options{'keepcopy'};
} elsif (!-w $main::options{'keepcopy'}) {
$log->syslog(
'notice',
'Cannot keep a copy of incoming messages: no write access to %s',
$main::options{'keepcopy'}
);
delete $main::options{'keepcopy'};
}
}
my $spindle = Sympa::Spindle::ProcessIncoming->new(
keepcopy => $main::options{keepcopy},
lang => $main::options{lang},
log_level => $main::options{log_level},
log_smtp => $main::options{mail},
#FIXME: Is it required?
debug_virus_check => $main::options{debug},
);
# Catch signals, in order to exit cleanly, whenever possible.
$SIG{'TERM'} = 'sigterm';
$SIG{'INT'} = 'sigterm'; # Interrupt from terminal.
$SIG{'HUP'} = 'sighup';
$SIG{'PIPE'} = 'IGNORE'; # Ignore SIGPIPE ; prevents process from dying
# Main loop.
# This loop is run foreach HUP signal received.
my $index_queuedigest = 0; # verify the digest queue
while (not $spindle->{finish} or $spindle->{finish} ne 'term') {
# Process digest only in master process ({generation} is 0).
# Scan queuedigest.
if (0 == $process->{generation}
and $index_queuedigest++ >= $digestsleep) {
$index_queuedigest = 0;
Sympa::Spindle::ProcessDigest->new->spin;
}
$spindle->spin;
if ($spindle->{finish} and $spindle->{finish} eq 'hup') {
# Disconnect from Database
Sympa::DatabaseManager->disconnect;
$log->syslog('notice', 'Sympa %s reload config',
Sympa::Constants::VERSION);
_load();
$spindle = Sympa::Spindle::ProcessIncoming->new(
keepcopy => $main::options{keepcopy},
lang => $main::options{lang},
log_level => $main::options{log_level},
log_smtp => $main::options{mail},
#FIXME: Is it required?
debug_virus_check => $main::options{debug},
);
next;
} elsif ($spindle->{finish}) {
last;
}
# Sleep for a while if spool is empty.
sleep $Conf::Conf{'sleep'};
}
# Purge grouped notifications
Sympa::Alarm->instance->flush(purge => 1);
$log->syslog('notice', 'Sympa/msg exited normally due to signal');
$process->remove_pid;
exit(0);
# Load configuration.
sub _load {
## Load sympa.conf.
unless (Conf::load(Conf::get_sympa_conf(), 'no_db')) { #Site and Robot
die sprintf
"Unable to load sympa configuration, file %s or one of the vhost robot.conf files contain errors. Exiting.\n",
Conf::get_sympa_conf();
}
## Open the syslog and say we're read out stuff.
$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});
# Enable SMTP logging if required
$mailer->{log_smtp} = $main::options{'mail'}
|| Sympa::Tools::Data::smart_eq($Conf::Conf{'log_smtp'}, 'on');
# setting log_level using conf unless it is set by calling option
if (defined $main::options{'log_level'}) {
$log->{level} = $main::options{'log_level'};
$log->syslog(
'info',
'Configuration file read, log level set using options: %s',
$main::options{'log_level'}
);
} else {
$log->{level} = $Conf::Conf{'log_level'};
$log->syslog(
'info',
'Configuration file read, default log level %s',
$Conf::Conf{'log_level'}
);
}
if (Conf::cookie_changed()) {
die sprintf
'sympa.conf/cookie parameter has changed. You may have severe inconsitencies into password storage. Restore previous cookie or write some tool to re-encrypt password in database and check spools contents (look at %s/cookies.history file).',
$Conf::Conf{'etc'};
}
# Check database connectivity.
unless (Sympa::DatabaseManager->instance) {
die sprintf
"Database %s defined in sympa.conf is unreachable. verify db_xxx parameters in sympa.conf\n",
$Conf::Conf{'db_name'};
}
# Now trying to load full config (including database)
unless (Conf::load()) { #FIXME: load Site, then robot cache
die sprintf
"Unable to load Sympa configuration, file %s or any of the virtual host robot.conf files contain errors. Exiting.\n",
Conf::get_sympa_conf();
}
## Set locale configuration
## Compatibility with version < 2.3.3
$main::options{'lang'} =~ s/\.cat$//
if defined $main::options{'lang'};
$language->set_lang($main::options{'lang'}, $Conf::Conf{'lang'}, 'en');
## Main program
if (!chdir($Conf::Conf{'home'})) {
die sprintf 'Can\'t chdir to %s: %s', $Conf::Conf{'home'}, $ERRNO;
## Function never returns.
}
## Check for several files.
unless (Conf::checkfiles_as_root()) {
die "Missing files\n";
}
}
############################################################
# sigterm
############################################################
# When we catch signal, just changes the value of the $signal
# loop variable.
#
# IN : -
#
# OUT : -
#
############################################################
sub sigterm {
my ($sig) = @_;
$log->syslog('notice',
'Signal %s received, still processing current task', $sig);
$spindle->{finish} = 'term';
}
############################################################
# sighup
############################################################
# When we catch SIGHUP, changes the value of the $signal
# loop variable and puts the "-mail" logging option
#
# IN : -
#
# OUT : -
#
###########################################################
sub sighup {
if ($mailer->{log_smtp}) {
$log->syslog('notice',
'signal HUP received, switch of the "-mail" logging option and continue current task'
);
$mailer->{log_smtp} = undef;
} else {
$log->syslog('notice',
'signal HUP received, switch on the "-mail" logging option and continue current task'
);
$mailer->{log_smtp} = 1;
}
$spindle->{finish} = 'hup';
}
# Moved to Sympa::Spindle::ProcessIncoming::_twist().
#sub process_message;
#sub DoSendMessage($message);
#DEPRECATED: Run upgrade_send_spool.pl to migrate message with old format.
# Moved to Sympa::Spindle::DoForward::_twist().
#sub DoForward;
# Moved (divided) to Sympa::Spindle::DoMessage::_twist() &
# Sympa::Spindle::AuthorizeMessage::_twist().
#sub DoMessage;
# Old name: tools::checkcommand().
# Moved to Sympa::Spindle::DoMessage::_check_command().
#sub _check_command;
# Moved to Sympa::Spindle::DoCommand::_twist().
#sub DoCommand;
# DEPRECATED. Use Sympa::Spindle::ProcessDigest class.
#sub SendDigest;
# Moved to Sympa::Spindle::ProcessIncoming::_clean_msgid_table().
#sub clean_msgid_table;
__END__
=encoding utf-8
=head1 NAME
sympa_msg, sympa_msg.pl - Daemon to handle incoming messages
=head1 SYNOPSIS
C S<[ C<-d>, C<--debug> ]>
S<[ C<-f>, C<--file>=I ]>
S<[ C<-k>, C<--keepcopy>=I ]>
S<[ C<-l>, C<--lang>=I ]> S<[ C<-m>, C<--mail> ]>
S<[ C<-h>, C<--help> ]> S<[ C<-v>, C<--version> ]>
=head1 DESCRIPTION
Sympa_msg.pl is a program which scans permanently the incoming message spool
and processes each message.
Messages bound for the lists and authorized sending are modified as neccesity
and at last stored into digest spool, archive spool and outgoing spool.
Those bound for command addresses are interpreted and appropriate actions are
taken.
Those bound for listmasters or list admins are forwarded to them.
=head1 OPTIONS
Sympa_msg.pl follows the usual GNU command line syntax,
with long options starting with two dashes (C<-->). A summary of
options is included below.
=over 4
=item C<-d>, C<--debug>
Enable debug mode.
=item C<-f>, C<--config=>I
Force Sympa to use an alternative configuration file instead
of F<--CONFIG-->.
=item C<-l>, C<--lang=>I
Set this option to use a language for Sympa. The corresponding
gettext catalog file must be located in F<$LOCALEDIR>
directory.
=item C<--log_level=>I
Sets Sympa log level.
=back
F may run in daemon mode with following options.
=over 4
=item C<--foreground>
The process remains attached to the TTY.
=item C<-k>, C<--keepcopy=>F
This option tells Sympa to keep a copy of every incoming message,
instead of deleting them. `directory' is the directory to
store messages.
=item C<-m>, C<--mail>
Sympa will log calls to sendmail, including recipients. This option is
useful for keeping track of each mail sent (log files may grow faster
though).
=item C<--service=>I
B:
This option was deprecated.
Process is dedicated to messages distribution (C),
commands (C) or to automatic lists
creation (C, default three of them).
=back
With following options F will print some information and exit.
=over 4
=item C<-h>, C<--help>
Print this help message.
=item C<-v>, C<--version>
Print the version number.
=back
=head1 FILES
F<--CONFIG--> main configuration file.
F<$PIDDIR/sympa_msg.pid> this file contains the process ID
of F.
=head1 SEE ALSO
L, L.
L, L, L, L,
L.
L,
L.
=head1 HISTORY
F was originally written by:
=over 4
=item Serge Aumont
ComitE<233> RE<233>seau des UniversitE<233>s
=item Olivier SalaE<252>n
ComitE<233> RE<233>seau des UniversitE<233>s
=back
As of Sympa 6.2b.4, it was split into three programs:
F command line utility, F