Developers of Sympa

[doome <address@concealed>]

Hi!

I have a bugfix/feature here, made by Szabolcs Hock. I send You a little
description here, maybe it would be good to put it in the official
release. It was made for Sympa 3.2.1, but I think it will work in the
nowaday releses with a little modifying. (Sorry for my English :-))) )

So now, the archived.pl works that it calls mhonarc for a file, waits
till mhonarc ends his job, and it moves the file from queueotgoing to
expl/listname/arctxt/yyyy-mm/number file, and deletes the file from the
queue.

There are few problems with the parsing this way:

- The messages can only be parsed syncronous, because mhonarc gets the
filename in the queue, so the archived.pl could put it in the list
directory after mhonarc finished
- Mhonarc is a perl program, so when it starts, it takes a lot of time
to load its modules, and to compile it to byte code.

Recommendations to solve this problem:

- Call mhonarc after the file was moved to the arctxt directory, so it
could work in the background, and the archived pl could handle the queue
comfortable.

- the mhonarc should be run as a daemon, so it can archive more message
with one run, so the mhonarc loading overhead could be eliminated.


Implementation ( mailconv.pl )

It loads all the moduls of mhonarc. It waits the converting request in
its STDIN. It runs till it can read the STDIN. There is a little fun in
it, because mhonarc redefines the STDIN stream, so the original must be
saved. Format of the input:
The elements of the command line are seperated by semicolon, so the
parameters containing space could be given as one element.

Archived opens |mailconv.pl as a file, and prints the jobs to it. In
this implementation it converts 100 mails with one run, after it
refreshes the pipe. The mailcon.pl logs /var/log/mailconv.log as user
sympa.

I attach the mailconv.pl and the modified archived.pl ( v 3.2.1)

It could be the best if it would be a config-file parameter to use this
way of parsing...

Thank You!
-- 
doome

#!/usr/bin/perl

## Worl Wide Sympa is a front-end to Sympa Mailing Lists Manager
## Copyright Comite Reseau des Universites


## Options :  F         -> do not detach TTY
##         :  d		-> debug -d is equiv to -dF

## Change this to point to your Sympa bin directory
use lib '/usr/lib/sympa/bin';

use List;
use Conf;
use Log;
use Getopt::Std;

use wwslib;

getopts('dF');

$Version = '0.1';

$wwsympa_conf = "/etc/sympa/wwsympa.conf";
$sympa_conf_file = '/etc/sympa/sympa.conf';

$wwsconf = {};
$adrlist = {};

# Load WWSympa configuration
unless ($wwsconf = &wwslib::load_config($wwsympa_conf)) {
    print STDERR 'unable to load config file';
    exit;
}

# Load sympa.conf
unless (Conf::load($sympa_conf_file)) {
    do_log  ('notice',"Unable to load sympa configuration, file $sympa_conf_file has errors.");
   exit(1);
}

## Check databse connectivity
$List::use_db = &List::probe_db();

## Set the UserID & GroupID for the process
$< = $> = (getpwnam('root'))[2];
$( = $) = (getpwnam('root'))[2];

## Put ourselves in background if not in debug mode. 
unless ($opt_d || $opt_F) {
   open(STDERR, ">> /dev/null");
   open(STDOUT, ">> /dev/null");
   if (open(TTY, "/dev/tty")) {
      ioctl(TTY, $TIOCNOTTY, 0);
      close(TTY);
   }
   setpgrp(0, 0);
   if (($_ = fork) != 0) {
      do_log('debug', "Starting archive daemon, pid $_");
      exit(0);
   }
   $wwsconf->{'log_facility'}||= $Conf{'syslog'};
   do_openlog($wwsconf->{'log_facility'}, $Conf{'log_socket_type'}, 'archived');
}

## Sets the UMASK
umask($Conf{'umask'});

## Change to list root
unless (chdir($Conf{'home'})) {
    &message('chdir_error');
    &do_log('info','unable to change directory');
    exit (-1);
}

my $pinfo = &List::_apply_defaults();

## Create and write the pidfile
unless (open(LOCK, "+>> $wwsconf->{'archived_pidfile'}")) {
   fatal_err("Could not open %s, exiting", $wwsconf->{'archived_pidfile'});
}
unless (flock(LOCK, 6)) {
   printf STDERR "Could not lock %s: archived is probably already running",$wwsconf->{'archived_pidfile'} ;
   fatal_err("Could not lock %s: archived is probably already running.", $wwsconf->{'archived_pidfile'});
}
unless (open(LCK, "> $wwsconf->{'archived_pidfile'}")) {
   fatal_err("Could not open %s, exiting", $wwsconf->{'archived_pidfile'});
}
unless (truncate(LCK, 0)) {
   fatal_err("Could not truncate %s, exiting.", $wwsconf->{'archived_pidfile'});
}

print LCK "$$\n";
close(LCK);

do_log('notice', "archived $Version Started");


## Catch SIGTERM, in order to exit cleanly, whenever possible.
$SIG{'TERM'} = 'sigterm';
$end = 0;


$queue = $Conf{'queueoutgoing'};
print "queue : $queue\n";

#if (!chdir($queue)) {
#   fatal_err("Can't chdir to %s: %m", $queue);
#   ## Function never returns.
#}

## infinite loop scanning the queue (unless a sig TERM is received
while (!$end) {

    &List::init_list_cache();
    
   unless (opendir(DIR, $queue)) {
       fatal_err("Can't open dir %s: %m", $queue); ## No return.
   }

   my @files =  (sort grep(!/^\.{1,2}$/, readdir DIR ));
   closedir DIR;

   ## this sleep is important to be raisonably sure that sympa is not currently
   ## writting the file this deamon is openning. 
   sleep 2;

   foreach my $file (@files) {

       last if $end;

       if ($file  =~ /^\.remove\.(.*)\.\d+$/ ) {
	   do_log('debug',"remove found : $file for list $1");

	   unless (open REMOVE, "$queue/$file") {
	        do_log ('notice',"Ignoring file $queue/$file because couldn't read it, archived.pl must use the same uid as sympa");
		   next;
	       }
	   my $msgid = <REMOVE> ;
	   close REMOVE;
	   &remove($1,$msgid);
	   unless (unlink("$queue/$file")) {
	       do_log ('notice',"Ignoring file $queue/$file because couldn't remove it, archived.pl must use the same uid as sympa");
	       next;
	   }
	   
       }elsif ($file  =~ /^\.rebuild\.(.*)$/ ) {
	   do_log('debug',"rebuild found : $file for list $1");
	   &rebuild($1);	
	   unless (unlink("$queue/$file")) {
	       do_log ('notice',"Ignoring file $queue/$file because couldn't remove it, archived.pl must use the same uid as sympa");
	       next;
	   }
       }else{
	   my ($yyyy, $mm, $dd, $min, $ss, $adrlist);
	   
	   if ($file =~ /^(\d{4})-(\d{2})-(\d{2})-(\d{2})-(\d{2})-(\d{2})-(.*)$/) {
	       ($yyyy, $mm, $dd, $hh, $min, $ss, $adrlist) = ($1, $2, $3, $4, $5, $6, $7);
	   }elsif ($file =~ /^(.*)\.(\d+)\.(\d+)$/) {
	       $adrlist = $1;
	       my $date = $2;

	       my @now = localtime($date);
	       $yyyy = sprintf '%04d', 1900+$now[5];
	       $mm = sprintf '%02d', $now[4]+1;
	       $dd = sprintf '%02d', $now[3];
	       $hh = sprintf '%02d', $now[2];
	       $min = sprintf '%02d', $now[1];
	       $ss = sprintf '%02d', $now[0];
	       
	   }else {
	       do_log ('notice',"Ignoring file $queue/$file because not to be rebuild or liste archive");
               unlink("$queue/$file");
	       next;
	   }
	   
	   $adrlist =~ /^(.*)\@(.*)$/;
	   my $listname = $1;
	   my $hostname = $2;

	   do_log('debug',"Archiving $file for list $adrlist");      
	   mail2arc ($file, $listname, $hostname, $yyyy, $mm, $dd, $hh, $min, $ss);
	   unless (unlink("$queue/$file")) {
	       do_log ('notice',"Ignoring file $queue/$file because couldn't remove it, archived.pl must use the same uid as sympa");
	       do_log ('notice',"exiting because I don't want to loop until file system is full");
	       last;
	   }
       }
   }
}
do_log('notice', 'archived exited normally due to signal');
unlink("$wwsconf->{'archived_pidfile'}");

exit(0);


## When we catch SIGTERM, just change the value of the loop
## variable.
sub sigterm {
    $end = 1;
}

sub remove {
    my $adrlist = shift;
    my $msgid = shift;

    my $arc ;

    if ($adrlist =~ /^(.*)\.(\d{4}-\d{2})$/) {
	$adrlist = $1;
        $arc = $2;
    }

    do_log('debug',"Removing $msgid in list $adrlist section $2");
  
    $arc =~ /^(\d{4})-(\d{2})$/ ;
    my $yyyy = $1 ;
    my $mm = $2 ;
    
    $msgid =~ s/\$/\\\$/g;
    system "$wwsconf->{'mhonarc'}  -outdir $wwsconf->{'arc_path'}/$adrlist/$yyyy-$mm -rmm $msgid";

}

sub rebuild {

    my $adrlist = shift;
    my $arc ;

    if ($adrlist =~ /^(.*)\.(\d{4}-\d{2})$/) {
	$adrlist = $1;
        $arc = $2;
    }

    $adrlist =~ /^(.*)\@(.*)$/;
    my $listname = $1;
    my $hostname = $2;

    do_log('debug',"Rebuilding $adrlist archive ($2)");

    my $mhonarc_ressources = &get_ressources ($adrlist) ; 

    if ($arc) {
        do_log('debug',"Rebuilding  $arc of $adrlist archive");
	$arc =~ /^(\d{4})-(\d{2})$/ ;
	my $yyyy = $1 ;
	my $mm = $2 ;

	my $cmd = "$wwsconf->{'mhonarc'} -rcfile $mhonarc_ressources -outdir $wwsconf->{'arc_path'}/$adrlist/$yyyy-$mm  -definevars \"listname='$listname' hostname=$hostname yyyy=$yyyy mois=$mm yyyymm=$yyyy-$mm wdir=$wwsconf->{'arc_path'} base=$Conf{'wwsympa_url'}/arc \" -umask $Conf{'umask'} $wwsconf->{'arc_path'}/$adrlist/$arc/arctxt";
	my $exitcode = system($cmd);
	if ($exitcode) {
	    do_log('debug',"Command $cmd failed with exit code $exitcode");
	}
    }else{
        do_log('debug',"Rebuilding $adrlist archive completely");

	if (!opendir(DIR, "$wwsconf->{'arc_path'}/$adrlist" )) {
	    do_log('notice',"unable to open $wwsconf->{'arc_path'}/$adrlist to rebuild archive");
	    return ;
	}
	my @archives = (grep (/^\d{4}-\d{2}/, readdir(DIR)));
	close DIR ; 

	foreach my $arc (@archives) {
	    $arc =~ /^(\d{4})-(\d{2})$/ ;
	    my $yyyy = $1 ;
	    my $mm = $2 ;
	    
	    system "$wwsconf->{'mhonarc'}  -rcfile $mhonarc_ressources -outdir $wwsconf->{'arc_path'}/$adrlist/$yyyy-$mm  -definevars \"listname=$listname hostname=$hostname yyyy=$yyyy mois=$mm yyyymm=$yyyy-$mm wdir=$wwsconf->{'arc_path'} base=$Conf{'wwsympa_url'}/arc \" -umask $Conf{'umask'} $wwsconf->{'arc_path'}/$adrlist/$arc/arctxt";
	}
    }
}


sub mail2arc {

    my ($file, $listname, $hostname, $yyyy, $mm, $dd, $hh, $min, $ss) = @_;
    my $arcpath = $wwsconf->{'arc_path'};
    
    do_log('debug',"mail2arc $file for $listname\@$hostname yyyy:$yyyy, mm:$mm dd:$dd hh:$hh min$min ss:$ss");
    #    chdir($wwsconf->{'arc_path'});
    
    if (! -d "$arcpath/$listname\@$hostname") {
	unless (mkdir ("$arcpath/$listname\@$hostname", 0775)) {
	    &do_log('notice', 'Cannot create directory %s', "$arcpath/$listname\@$hostname");
	    return undef;
	}
	do_log('debug',"mkdir $arcpath/$listname\@$hostname");
    }
    if (! -d "$arcpath/$listname\@$hostname/$yyyy-$mm") {
	unless (mkdir ("$arcpath/$listname\@$hostname/$yyyy-$mm", 0775)) {
	    &do_log('notice', 'Cannot create directory %s', "$arcpath/$listname\@$hostname/$yyyy-$mm");
	    return undef;
	}
	do_log('debug',"mkdir $arcpath/$listname\@$hostname/$yyyy-$mm");
    }
    if (! -d "$arcpath/$listname\@$hostname/$yyyy-$mm/arctxt") {
	unless (mkdir ("$arcpath/$listname\@$hostname/$yyyy-$mm/arctxt", 0775)) {
	    &do_log('notice', 'Cannot create directory %s', "$arcpath/$listname\@$hostname/$yyyy-$mm/arctxt");
	    return undef;
	}
	do_log('debug',"mkdir $arcpath/$listname\@$hostname/$yyyy-$mm/arctxt");
    }
    
    ## copy the file in the arctxt and in "mhonarc -add"
    opendir (DIR, "$arcpath/$listname\@$hostname/$yyyy-$mm/arctxt");
    my @files = (sort { $a <=> $b;}  readdir(DIR)) ;
    $files[$#files]+=1;
    my $newfile = $files[$#files];
#    my $newfile = $files[$#files]+=1;
    
    my $mhonarc_ressources = &get_ressources ($listname . '@' . $hostname) ; 
    #$psztms=time();
    do_log ('notice',"calling mailconv.pl for list $listname\@$hostname") ;
    
    if ($run_mailconv>0) {
       if ($run_mailconv>100) {
	 close MCF;
	 sleep 1;
       	 open MCF,"|/usr/bin/mailconv.pl";
	 MCF->autoflush(1);
	 $run_mailconv=1;
    	 do_log ('notice',"Pipe refreshed.") ;
       }
       $run_mailconv++;
    } else {
       open MCF,"|/usr/bin/mailconv.pl";
	MCF->autoflush(1);
	$run_mailconv=1;
    	do_log ('notice',"New pipe opened.") ;
    }

    
    open (ORIG, "$queue/$file") || fatal_err("couldn't open file $queue/$file");
    open (DEST, ">$arcpath/$listname\@$hostname/$yyyy-$mm/arctxt/$newfile") || fatal_err("couldn't open file $newfile");
    while (<ORIG>) {
        print DEST $_ ;
    }
    
    close ORIG;  
    close DEST;
    my $cmd = "-add;-rcfile;$mhonarc_ressources;-stdin;$arcpath/$listname\@$hostname/$yyyy-$mm/arctxt/$newfile;-outdir;$arcpath/$listname\@$hostname/$yyyy-$mm;-definevars;listname='$listname' hostname=$hostname yyyy=$yyyy mois=$mm yyyymm=$yyyy-$mm wdir=$wwsconf->{'arc_path'} base=$Conf{'wwsympa_url'}/arc;-umask;$Conf{'umask'}\n";
    print MCF $cmd;
}

sub get_ressources {
    my $adrlist = shift;
    my ($mhonarc_ressources, $list);  

    if ($adrlist =~ /^([^@]*)\@[^@]*$/) {
	$adrlist = $1;
    }
    unless ($list = new List ($adrlist)) {
	do_log('notice',"get_ressources : unable to load list $1, continue anyway");
    }  
    
    if (-r "$Conf{'home'}/$list->{'name'}/mhonarc-ressources") {
	$mhonarc_ressources =  "$Conf{'home'}/$list->{'name'}/mhonarc-ressources" ;
    }elsif (-r "$Conf{'etc'}/mhonarc-ressources"){
        $mhonarc_ressources =  "$Conf{'etc'}/mhonarc-ressources" ;
    }elsif (-r "/usr/share/sympa/mhonarc-ressources"){
        $mhonarc_ressources =  "/usr/share/sympa/mhonarc-ressources" ;
    }else {
	do_log('notice',"Cannot find any MhOnArc ressource file");
	return undef;
    }
    return  $mhonarc_ressources;
}





#!/usr/bin/perl
use lib "/usr/share/mhonarc";
use Getopt::Long;
use Time::Local;
use POSIX;
use IO::Handle;

require 'mhamain.pl' || die qq/ERROR: Unable to require "mhamain.pl"\n/;
require 'mhtime.pl';
require 'mhfile.pl';
require 'mhinit.pl';
require 'mhutil.pl';
require 'base64.pl';
require 'mhindex.pl';
require 'mhthread.pl';
require 'mhrcfile.pl';
require 'mhrcvars.pl';
require 'mhmimetypes.pl';
require 'mhtxthtml.pl';
require 'mhexternal.pl';
#require 'mhdb.pl';
require 'rfc822.pl';
require 'iso8859.pl';
require 'readmail.pl';
require 'ewhutil.pl';
require 'mhidxrc.pl';
require 'mhdysub.pl';
require 'iso2022jp.pl';

require 'mhtxtplain.pl';
require 'mhtxtsetext.pl';
require 'mhtxttsv.pl';
require 'mhtxtenrich.pl';
require 'mhmsgextbody.pl';
require 'mhmsgfile.pl';
require 'mhnote.pl';
require 'mhnull.pl';
$sz_other=0;
mhonarc::initialize();
open IH,"<&STDIN";
open OH,">>/var/log/mailconv.log";
open STDERR,">/dev/null";
open STDOUT,">/dev/null";
print OH "Program started!\n";
OH->autoflush(1);
while ($sor=<IH>) {
   chomp($sor);
	@args=split(/;/,$sor);
	print OH "Input: $args[4]\n";
	if ($sz_other>0) {
		$pid=fork();
		if ($pid == 0) {
	  	  $ptm=mhonarc::process_input(@args);
		  print OH "Processing time: $ptm\n";
		  exit(0);
		} else {
		  $st=waitpid($pid,0);
		}
	} else {	
	 	  $ptm=mhonarc::process_input(@args);
		  print OH "Processing time: $ptm\n";
		  $sz_other++;
	}
}
print OH "Program finished!\n";