List.pm

# This module is part of ML and does all list processing functions

package List;

use strict;
require Exporter;
require 'tools.pl';
my @ISA = qw(Exporter);
my @EXPORT = qw(%list_of_lists);

=head1 CONSTRUCTOR

=item new( [PHRASE] )

 List->new();

Creates a new object which will be used for a list and
eventually loads the list if a name is given. Returns
a List object.

=back

=head1 METHODS

=over 4

=item load ( LIST )

Loads the indicated list into the object.

=item save ( LIST )

Saves the indicated list object to the disk files.

=item savestats ()

Saves updates the statistics file on disk.

=item update_stats( BYTES )

Updates the stats, argument is number of bytes, returns the next
sequence number. Does nothing if no stats.

=item send_sub_to_owner ( WHO, COMMENT )
Send a message to the list owners telling that someone
wanted to subscribe to the list.

=item send_to_editor ( MSG )

Send a Mail::Internet type object to the editor (for approval).

=item send_msg ( MSG )

Sends the Mail::Internet message to the list.

=item send_file ( FILE, USER, GECOS )

Sends the file to the USER. FILE may only be welcome for now.

=item delete_user ( ARRAY )

Delete the indicated users from the list.
 
=item get_cookie ()

Returns the cookie for a list, if available.

=item get_max_size ()

Returns the maximum allowed size for a message.

=item get_reply_to ()

Returns an array with the Reply-To values.

=item get_default_user_options ()

Returns a default option of the list for subscription.

=item get_total ()

Returns the number of subscribers to the list.

=item get_user ( USER )

Returns a hash with the informations regarding the indicated
user.

=item get_first_user ()

Returns a hash to the first user on the list.

=item get_next_user ()

Returns a hash to the next users, until we reach the end of
the list.

=item update_user ( USER, HASHPTR )

Sets the new values given in the hash for the user.

=item add_user ( USER, HASHPTR )

Adds a new user to the list. May overwrite existing
entries.

=item is_user ( USER )

Returns true if the indicated user is member of the list.
 
=item am_i ( FUNCTION, USER )

Returns true is USER has FUNCTION (owner, editor) on the
list.

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

Chcks is USER may do the ACTION for the list. ACTION can be
one of following : send, review, index, getm add, del,
reconfirm, purge.

=item is_moderated ()

Returns true if the list is moderated.

=item archive_exist ( FILE )

Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

Send the indicated archive file to the user, if it exists.

=item archive_ls ()

Returns the list of available files, if any.

=item archive_msg ( MSG )

Archives the Mail::Internet message given as argument.

=item is_archived ()

Returns true is the list is configured to keep archives of
its messages.

=item get_stats ( OPTION )

Returns either a formatted printable strings or an array whith
the statistics. OPTION can be 'text' or 'array'.

=item print_info ( FDNAME )

Print the list informations to the given file descriptor, or the
currently selected descriptor.

=cut

use Carp;

use Mail::Header;
use Mail::Internet;
use Archive;
use Language;
use Log;
use Conf;
use mail;
use Time::Local;
use MIME::Entity;
use MIME::Words;
use MIME::Parser;

## Database and SQL statement handlers
my ($dbh, $sth, @sth_stack, $use_db);

my %list_cache;
my %persistent_cache;

my %date_format = (
		   'read' => {
		       'Pg' => 'date_part(\'epoch\',%s)',
		       'mysql' => 'UNIX_TIMESTAMP(%s)',
		       'Oracle' => '((to_number(to_char(%s,\'J\')) - to_number(to_char(to_date(\'01/01/1970\',\'dd/mm/yyyy\'), \'J\'))) * 86400) +to_number(to_char(%s,\'SSSSS\'))',
		       'Sybase' => 'datediff(second, "01/01/1970",%s)'
		       },
		   'write' => {
		       'Pg' => '\'epoch\'::datetime + \'%d sec\'',
		       'mysql' => 'FROM_UNIXTIME(%d)',
		       'Oracle' => 'to_date(to_char(round(%s/86400) + to_number(to_char(to_date(\'01/01/1970\',\'dd/mm/yyyy\'), \'J\'))) || \':\' ||to_char(mod(%s,86400)), \'J:SSSSS\')',
		       'Sybase' => 'dateadd(second,%s,"01/01/1970")'
		       }
	       );

## Regexps for list params
my %regexp = ('email' => '(\S+|\".*\")(@\S+)',
	      'host' => '[\w\.\-]+',
	      'listname' => '[a-z0-9][a-z0-9\-\._]+',
	      'sql_query' => 'SELECT.*',
	      'scenario' => '[\w,\.\-]+',
	      'task' => '\w+'
	      );

## List parameters defaults
my %default = ('occurrence' => '0-1',
	       'length' => 25
	       );

my @param_order = qw (subject visibility info subscribe add unsubscribe del owner send editor 
		      account topics 
		      host lang web_archive archive digest available_user_options 
		      default_user_options reply_to_header reply_to forced_reply_to * 
		      welcome_return_path remind_return_path user_data_source include_file 
		      include_list include_ldap_query include_ldap_2level_query include_sql_query ttl creation update 
		      status serial);

## List parameters aliases
my %alias = ('reply-to' => 'reply_to',
	     'replyto' => 'reply_to',
	     'forced_replyto' => 'forced_reply_to',
	     'forced_reply-to' => 'forced_reply_to',
	     'custom-subject' => 'custom_subject',
	     'custom-header' => 'custom_header',
	     'subscription' => 'subscribe',
	     'unsubscription' => 'unsubscribe',
	     'max-size' => 'max_size');

##############################################################
## This hash COMPLETELY defines ALL list parameters     
## It is then used to load, save, view, edit list config files
##############################################################
## List parameters format accepts the following keywords :
## format :      Regexp aplied to the configuration file entry; 
##               some common regexps are defined in %regexp
## file_format : Config file format of the parameter might not be
##               the same in memory
## split_char:   Character used to separate multiple parameters 
## length :      Length of a scalar variable ; used in web forms
## scenario :    tells that the parameter is a scenario, providing its name
## default :     Default value for the param ; may be a configuration parameter (conf)
## synonym :     Defines synonyms for parameter values (for compatibility reasons)
## unit :        Unit of the parameter ; this is used in web forms
## occurrence :  Occurerence of the parameter in the config file
##               possible values: 0-1 | 1 | 0-n | 1-n
##               example : a list may have multiple owner 
## title_id :    Title reference in NLS catalogues
## group :       Group of parameters
## obsolete :    Obsolete parameter ; should not be displayed 
##               nor saved
## order :       Order of parameters within paragraph
###############################################################
%::pinfo = ('account' => {'format' => '\S+',
			  'length' => 10,
			  'title_id' => 1,
			  'group' => 'other'
			  },
	    'add' => {'scenario' => 'add',
		      'title_id' => 2,
		      'group' => 'command'
		      },
	    'anonymous_sender' => {'format' => '.+',
				   'title_id' => 3,
				   'group' => 'tuning'
				   },
	    'archive' => {'format' => {'period' => {'format' => ['day','week','month','quarter','year'],
						    'synonym' => {'weekly' => 'week'},
						    'title_id' => 5,
						    'order' => 1
						},
				       'access' => {'format' => ['open','private','public','owner','closed'],
						    'synonym' => {'open' => 'public'},
						    'title_id' => 6,
						    'order' => 2
						}
				   },
			  'title_id' => 4,
			  'group' => 'archives'
		      },
	    'available_user_options' => {'format' => {'reception' => {'format' => ['mail','notice','digest','summary','nomail','txt','html','urlize','not_me'],
								      'occurrence' => '1-n',
								      'split_char' => ',',
								      'default' => 'mail,notice,digest,summary,nomail,txt,html,urlize,not_me',
								      'title_id' => 89
								      }
						  },
					 'title_id' => 88
				     },

	    'bounce' => {'format' => {'warn_rate' => {'format' => '\d+',
						      'length' => 3,
						      'unit' => '%',
						      'default' => {'conf' => 'bounce_warn_rate'},
						      'title_id' => 8,
						      'order' => 1
						  },
				      'halt_rate' => {'format' => '\d+',
						      'length' => 3,
						      'unit' => '%',
						      'default' => {'conf' => 'bounce_halt_rate'},
						      'title_id' => 9,
						      'order' => 2
						  }
				  },
			 'title_id' => 7,
			 'group' => 'bounces'
		     },
	    'clean_delay_queuemod' => {'format' => '\d+',
				       'length' => 3,
				       'unit' => 'days',
				       'default' => {'conf' => 'clean_delay_queuemod'},
				       'title_id' => 10,
				       'group' => 'other'
				       },
	    'cookie' => {'format' => '\S+',
			 'length' => 15,
			 'default' => {'conf' => 'cookie'},
			 'title_id' => 11,
			 'group' => 'other'
		     },
	    'creation' => {'format' => {'date_epoch' => {'format' => '\d+',
							 'occurrence' => '1',
							 'title_id' => 13,
							 'order' => 3
						     },
					'date' => {'format' => '.+',
						   'title_id' => 14,
						   'order' => 2
						   },
					'email' => {'format' => $regexp{'email'},
						    'occurrence' => '1',
						    'title_id' => 15,
						    'order' => 1
						    }
				    },
			   'title_id' => 12,
			   'group' => 'other'

		       },
	    'custom_header' => {'format' => '\S+:\s+.*',
				'length' => 30,
				'occurrence' => '0-n',
				'title_id' => 16,
				'group' => 'tuning'
				},
	    'custom_subject' => {'format' => '.*',
				 'length' => 15,
				 'title_id' => 17,
				 'group' => 'tuning'
				 },
	    'default_user_options' => {'format' => {'reception' => {'format' => ['digest','mail','nomail','summary','notice','txt','html','urlize','not_me'],
								    'default' => 'mail',
								    'title_id' => 19,
								    'order' => 1
								    },
						    'visibility' => {'format' => ['conceal','noconceal'],
								     'default' => 'noconceal',
								     'title_id' => 20,
								     'order' => 2
								     }
						},
				       'title_id' => 18,
				       'group' => 'other'
				   },
	    'del' => {'scenario' => 'del',
		      'title_id' => 21,
		      'group' => 'command'
		      },
	    'digest' => {'file_format' => '\d+(\s*,\s*\d+)*\s+\d+:\d+',
			 'format' => {'days' => {'format' => [1..7],
						 'file_format' => '1|2|3|4|5|6|7',
						 'occurrence' => '1-n',
						 'title_id' => 23,
						 'order' => 1
						 },
				      'hour' => {'format' => '\d+',
						 'length' => 2,
						 'occurrence' => '1',
						 'title_id' => 24,
						 'order' => 2
						 },
				      'minute' => {'format' => '\d+',
						   'length' => 2,
						   'occurrence' => '1',
						   'title_id' => 25,
						   'order' => 3
						   }
				  },
			 'title_id' => 22,
			 'group' => 'tuning'
		     },

	    'editor' => {'format' => {'email' => {'format' => $regexp{'email'},
						  'length' => 30,
						  'occurrence' => '1',
						  'title_id' => 27,
						  'order' => 1
						  },
				      'reception' => {'format' => ['mail','nomail'],
						      'default' => 'mail',
						      'title_id' => 28,
						      'order' => 4
						      },
				      'gecos' => {'format' => '.+',
						  'length' => 30,
						  'title_id' => 29,
						  'order' => 2
						  },
				      'info' => {'format' => '.+',
						 'length' => 30,
						 'title_id' => 30,
						 'order' => 3
						 }
				  },
			 'occurrence' => '0-n',
			 'title_id' => 26,
			 'group' => 'description'
			 },
	    'expire_task' => {'task' => 'expire',
			      'title_id' => 95
			 },
	    'footer_type' => {'format' => ['mime','append'],
			      'default' => 'mime',
			      'title_id' => 31,
			      'group' => 'tuning'
			      },
	    'forced_reply_to' => {'format' => '\S+',
				  'title_id' => 32,
				  'group' => 'tuning',
				  'obsolete' => 1
			 },
	    'host' => {'format' => $regexp{'host'},
		       'length' => 20,
		       'title_id' => 33,
		       'group' => 'description'
		   },
	    'include_file' => {'format' => '\S+',
			       'length' => 20,
			       'occurrence' => '0-n',
			       'title_id' => 34,
			       'group' => 'data_source'
			       },

#	    'include_admin' => {'format' => ['owners','editors','privileged_owners'],
#				 'occurrence' => '0-n'
#				 },

	    'include_ldap_query' => {'format' => {'host' => {'format' => $regexp{'host'},
							     'occurrence' => '1',
							     'title_id' => 36,
							     'order' => 1
							     },
						  'port' => {'format' => '\d+',
							     'default' => 389,
							     'length' => 4,
							     'title_id' => 37,
							     'order' => 2
							     },
						  'user' => {'format' => '.*',
							     'title_id' => 38,
							     'order' => 3
							     },
						  'passwd' => {'format' => '.*',
							       'length' => 10,
							       'title_id' => 39,
							       'order' => 3
							       },
						  'suffix' => {'format' => '.*',
							       'title_id' => 40,
							       'order' => 4
							       },
						  'filter' => {'format' => '.*',
							       'length' => 50,
							       'occurrence' => '1',
							       'title_id' => 41,
							       'order' => 7
							       },
						  'attrs' => {'format' => '\w+',
							      'length' => 15,
							      'default' => 'mail',
							      'title_id' => 42,
							      'order' => 8
							      },
						  'select' => {'format' => ['all','first'],
							       'default' => 'first',
							       'title_id' => 43,
							       'order' => 9
							       },
					          'scope' => {'format' => ['base','one','sub'],
							      'default' => 'sub',
							      'title_id' => 97,
							      'order' => 5
							      },
						  'timeout' => {'format' => '\w+',
								'default' => 30,
								'unit' => 'seconds',
								'title_id' => 98,
								'order' => 6
								}
					      },
				     'occurrence' => '0-n',
				     'title_id' => 35,
				     'group' => 'data_source'
				     },
	    'include_ldap_2level_query' => {'format' => {'host' => {'format' => $regexp{'host'},
							     'occurrence' => '1',
							     'title_id' => 136,
							     'order' => 1
							     },
						  'port' => {'format' => '\d+',
							     'default' => 389,
							     'length' => 4,
							     'title_id' => 137,
							     'order' => 2
							     },
						  'user' => {'format' => '.*',
							     'title_id' => 138,
							     'order' => 3
							     },
						  'passwd' => {'format' => '.*',
							       'length' => 10,
							       'title_id' => 139,
							       'order' => 3
							       },
						  'suffix1' => {'format' => '.*',
							       'title_id' => 140,
							       'order' => 4
							       },
						  'filter1' => {'format' => '.*',
							       'length' => 50,
							       'occurrence' => '1',
							       'title_id' => 141,
							       'order' => 7
							       },
						  'attrs1' => {'format' => '\w+',
							      'length' => 15,
							      'title_id' => 142,
							      'order' => 8
							      },
						  'select1' => {'format' => ['all','first','regex'],
							       'default' => 'first',
							       'title_id' => 143,
							       'order' => 9
							       },
					          'scope1' => {'format' => ['base','one','sub'],
							      'default' => 'sub',
							      'title_id' => 197,
							      'order' => 5
							      },
						  'timeout1' => {'format' => '\w+',
								'default' => 30,
								'unit' => 'seconds',
								'title_id' => 198,
								'order' => 6
								},
						  'regex1' => {'format' => '.+',
								'length' => 50,
								'default' => '',
								'title_id' => 201,
								'order' => 10
								},
						  'suffix2' => {'format' => '.*',
							       'title_id' => 144,
							       'order' => 11
							       },
						  'filter2' => {'format' => '.*',
							       'length' => 50,
							       'occurrence' => '1',
							       'title_id' => 145,
							       'order' => 14
							       },
						  'attrs2' => {'format' => '\w+',
							      'length' => 15,
							      'default' => 'mail',
							      'title_id' => 146,
							      'order' => 15
							      },
						  'select2' => {'format' => ['all','first','regex'],
							       'default' => 'first',
							       'title_id' => 147,
							       'order' => 16
							       },
					          'scope2' => {'format' => ['base','one','sub'],
							      'default' => 'sub',
							      'title_id' => 199,
							      'order' => 12
							      },
						  'timeout2' => {'format' => '\w+',
								'default' => 30,
								'unit' => 'seconds',
								'title_id' => 200,
								'order' => 13
								},
						  'regex2' => {'format' => '.+',
								'length' => 50,
								'default' => '',
								'title_id' => 202,
								'order' => 17
								}
					      },
				     'occurrence' => '0-n',
				     'title_id' => 135,
				     'group' => 'data_source'
				     },
	    'include_list' => {'format' => $regexp{'listname'},
			       'occurrence' => '0-n',
			       'title_id' => 44,
			       'group' => 'data_source'
			       },
	    'include_sql_query' => {'format' => {'db_type' => {'format' => ['mysql','Pg','Oracle','Sybase'],
							       'occurrence' => '1',
							       'title_id' => 46,
							       'order' => 1
							       },
						 'host' => {'format' => $regexp{'host'},
							    'occurrence' => '1',
							    'title_id' => 47,
							    'order' => 2
							    },
						 'db_name' => {'format' => '\S+',
							       'occurrence' => '1',
							       'title_id' => 48,
							       'order' => 3 
							       },
						 'connect_options' => {'format' => '.+',
								       'title_id' => 94,
								       'order' => 4
								       },
						 'user' => {'format' => '\S+',
							    'occurrence' => '1',
							    'title_id' => 49,
							    'order' => 5
							    },
						 'passwd' => {'format' => '.+',
							      'title_id' => 50,
							      'order' => 6
							      },
						 'sql_query' => {'format' => $regexp{'sql_query'},
								 'length' => 50,
								 'occurrence' => '1',
								 'title_id' => 51,
								 'order' => 7
								 },
						 'f_dir' => {'format' => '.+',
							     'title_id' => 52,
							     'order' => 8
							     }
					     },
				    'occurrence' => '0-n',
				    'title_id' => 45,
				    'group' => 'data_source'
				    },
	    'info' => {'scenario' => 'info',
		       'title_id' => 53,
		       'group' => 'command'
		       },
	    'invite' => {'scenario' => 'invite',
			 'title_id' => 54,
			 'group' => 'command'
			 },
	    'lang' => {'format' => ['fr','us','de','it','fi','es','tw','cn','pl','cz','hu'],
		       'default' => {'conf' => 'lang'},
		       'title_id' => 55,
		       'group' => 'description'
		   },
	    'max_size' => {'format' => '\d+',
			   'length' => 8,
			   'unit' => 'bytes',
			   'default' => {'conf' => 'max_size'},
			   'title_id' => 56,
			   'group' => 'tuning'
		       },
	    'owner' => {'format' => {'email' => {'format' => $regexp{'email'},
						 'length' =>30,
						 'occurrence' => '1',
						 'title_id' => 58,
						 'order' => 1
						 },
				     'reception' => {'format' => ['mail','nomail'],
						     'default' => 'mail',
						     'title_id' => 59,
						     'order' =>5
						     },
				     'gecos' => {'format' => '.+',
						 'length' => 30,
						 'title_id' => 60,
						 'order' => 2
						 },
				     'info' => {'format' => '.+',
						'length' => 30,
						'title_id' => 61,
						'order' => 3
						},
				     'profile' => {'format' => ['privileged','normal'],
						   'default' => 'normal',
						   'title_id' => 62,
						   'order' => 4
						   }
				 },
			'occurrence' => '1-n',
			'title_id' => 57,
			'group' => 'description'
			},
	    'priority' => {'format' => [0..9,'z'],
			   'length' => 1,
			   'default' => {'conf' => 'default_list_priority'},
			   'title_id' => 63,
			   'group' => 'tuning'
		       },
	    'remind' => {'scenario' => 'remind',
			 'title_id' => 64,
			 'group' => 'command'
			  },
	    'remind_return_path' => {'format' => ['unique','owner'],
				     'default' => {'conf' => 'remind_return_path'},
				     'title_id' => 65,
				     'group' => 'bounces'
				 },
	    'remind_task' => {'task' => 'remind',
			      'tilte-id' => 96
			      },
	    'reply_to' => {'format' => '\S+',
			   'default' => 'sender',
			   'title_id' => 66,
			   'group' => 'tuning',
			   'obsolete' => 1
			   },
	    'reply_to_header' => {'format' => {'value' => {'format' => ['sender','list','all','other_email'],
							   'default' => 'sender',
							   'title_id' => 91,
							   'occurrence' => '1',
							   'order' => 1
							   },
					       'other_email' => {'format' => $regexp{'email'},
								 'title_id' => 92,
								 'order' => 2
								 },
					       'apply' => {'format' => ['forced','respect'],
							   'default' => 'respect',
							   'title_id' => 93,
							   'order' => 3
							   }
					   },
				  'title_id' => 90,
				  'group' => 'tuning'
				  },		
	    'review' => {'scenario' => 'review',
			 'synonym' => {'open' => 'public'},
			 'title_id' => 67,
			 'group' => 'command'
			 },
	    'send' => {'scenario' => 'send',
		       'title_id' => 68
		       },
	    'serial' => {'format' => '\d+',
			 'default' => 0,
			 'length' => 3,
			 'default' => 0,
			 'title_id' => 69,
			 'group' => 'other'
			 },
	    'shared_doc' => {'format' => {'d_read' => {'scenario' => 'd_read',
						       'title_id' => 86,
						       'order' => 1
						       },
					  'd_edit' => {'scenario' => 'd_edit',
						       'title_id' => 87,
						       'order' => 2
						       }
				      },
			     'title_id' => 70,
			     'group' => 'command'
			 },
	    'status' => {'format' => ['open','closed','pending'],
			 'default' => 'open',
			 'title_id' => 71,
			 'group' => 'other'
			  },
	    'subject' => {'format' => '.+',
			  'length' => 50,
			  'occurrence' => '1',
			  'title_id' => 72,
			  'group' => 'description'
			   },
	    'subscribe' => {'scenario' => 'subscribe',
			    'title_id' => 73,
			    'group' => 'command'
			    },
	    'topics' => {'format' => '\w+(\/\w+)?',
			 'split_char' => ',',
			 'occurrence' => '0-n',
			 'title_id' => 74,
			 'group' => 'description'
			 },
	    'ttl' => {'format' => '\d+',
		      'length' => 6,
		      'unit' => 'seconds',
		      'default' => 3600,
		      'title_id' => 75,
		      'group' => 'data_source'
		      },
	    'unsubscribe' => {'scenario' => 'unsubscribe',
			      'title_id' => 76,
			      'group' => 'command'
			      },
	    'update' => {'format' => {'date_epoch' => {'format' => '\d+',
						       'length' => 8,
						       'occurrence' => '1',
						       'title_id' => 78,
						       'order' => 3
						       },
				      'date' => {'format' => '.+',
						 'length' => 30,
						 'title_id' => 79,
						 'order' => 2
						 },
				      'email' => {'format' => $regexp{'email'},
						  'length' => 30,
						  'occurrence' => '1',
						  'title_id' => 80,
						  'order' => 1
						  }
				  },
			 'title_id' => 77,
			 'group' => 'other'
		     },
	    'user_data_source' => {'format' => ['database','file','include'],
				   'default' => 'file',
				   'title_id' => 81,
				   'group' => 'data_source'
				   },
	    'visibility' => {'scenario' => 'visibility',
			     'synonym' => {'public' => 'noconceal'},
			     'title_id' => 82,
			     'group' => 'description'
			     },
	    'web_archive'  => {'format' => {'access' => {'scenario' => 'access_web_archive',
							 'title_id' => 84
							 }
					},
			       'title_id' => 83,
			       'group' => 'archives'

			   },
	    'welcome_return_path' => {'format' => ['unique','owner'],
				      'default' => {'conf' => 'welcome_return_path'},
				      'title_id' => 85,
				      'group' => 'bounces'
				  },
	    
	    'export' => {'format' => '\w+',
			 'split_char' => ',',
			 'occurrence' => '0-n',
			 'default' =>'',
		     }
	    
	    );

## This is the generic hash which keeps all lists in memory.
my %list_of_lists = ();
my %list_of_robots = ();
my %list_of_topics = ();
my %edit_list_conf = ();

## Last modification times
my %mtime;

use Fcntl;
use DB_File;

$DB_BTREE->{compare} = '_compare_addresses';

sub LOCK_SH {1};
sub LOCK_EX {2};
sub LOCK_NB {4};
sub LOCK_UN {8};

## Connect to Database
sub db_connect {
    do_log('debug2', 'List::db_connect');

    my $connect_string;

    unless (require DBI) {
	do_log ('info',"Unable to use DBI library, install DBI (CPAN) first");
	return undef;
    }

    ## Do we have db_xxx required parameters
    foreach my $db_param ('db_type','db_name','db_host','db_user') {
	unless ($Conf{$db_param}) {
	    do_log ('info','Missing parameter %s for DBI connection', $db_param);
	    return undef;
	}
    }

    ## Used by Oracle (ORACLE_HOME)
    if ($Conf{'db_env'}) {
	foreach my $env (keys %{$Conf{'db_env'}}) {
	    $ENV{$env} = $Conf{'db_env'}{$env};
	}
    }

    if ($Conf{'db_type'} eq 'Oracle') {
	## Oracle uses sids instead of dbnames
	$connect_string = sprintf 'DBI:%s:sid=%s;host=%s', $Conf{'db_type'}, $Conf{'db_name'}, $Conf{'db_host'};

    }elsif ($Conf{'db_type'} eq 'Sybase') {
	$connect_string = sprintf 'DBI:%s:dbname=%s;server=%s', $Conf{'db_type'}, $Conf{'db_name'}, $Conf{'db_host'};

    }else {
	$connect_string = sprintf 'DBI:%s:dbname=%s;host=%s', $Conf{'db_type'}, $Conf{'db_name'}, $Conf{'db_host'};
    }

    if ($Conf{'db_port'}) {
	$connect_string .= ';port=' . $Conf{'db_port'};
    }

    if ($Conf{'db_options'}) {
	$connect_string .= ';' . $Conf{'db_options'};
    }

    unless ( $dbh = DBI->connect($connect_string, $Conf{'db_user'}, $Conf{'db_passwd'}) ) {
	do_log ('err','Can\'t connect to Database %s as %s', $connect_string, $Conf{'db_user'});

	&send_notify_to_listmaster('no_db', $Conf{'domain'});
	&fatal_err('Sympa cannot connect to database %s, dying', $Conf{'db_name'});

#	return undef;
    }

    if ($Conf{'db_type'} eq 'Pg') { # Configure Postgres to use ISO format dates
       $dbh->do ("SET DATESTYLE TO 'ISO';");
    }

    ## added sybase support
    if ($Conf{'db_type'} eq 'Sybase') { # Configure to use sympa database 
	my $dbname;
	$dbname="use $Conf{'db_name'}";
        $dbh->do ($dbname);
    }

    do_log('debug','Connected to Database %s',$Conf{'db_name'});

    return 1;
}

## Disconnect from Database
sub db_disconnect {
    do_log('debug2', 'List::db_disconnect');

    unless ($dbh->disconnect()) {
	do_log ('notice','Can\'t disconnect from Database %s : %s',$Conf{'db_name'}, $dbh->errstr);
	return undef;
    }

    return 1;
}

## Get database handler
sub db_get_handler {
    do_log('debug2', 'List::db_get_handler');


    return $dbh;
}

## Creates an object.
sub new {
    my($pkg, $name, $robot) = @_;
    my $liste={};
    do_log('debug2', 'List::new(%s,%s)', $name, $robot);
    
    ## Allow robot in the name
    if ($name =~ /\@/) {
	my @parts = split /\@/, $name;
	$robot ||= $parts[1];
	$name = $parts[0];
    }

    ## Only process the list if the name is valid.
    unless ($name and ($name =~ /^[a-z0-9][a-z0-9\-\+\._]*$/io) ) {
	&do_log('info', 'Incorrect listname "%s"',  $name);
	return undef;
    }
    ## Lowercase the list name.
    $name =~ tr/A-Z/a-z/;
    
    if ($list_of_lists{$name}){
	# use the current list in memory and update it
	$liste=$list_of_lists{$name};
    }else{
	do_log('debug', 'List object %s creation', $name) if $main::options{'debug'}; ##TEMP

	# create a new object list
	bless $liste, $pkg;
    }
    return undef unless ($liste->load($name, $robot));