List.pm 181 KB
Newer Older
root's avatar
root committed
1
2
3
4
5
# This module is part of ML and does all list processing functions

package List;

use strict;
6
7
8
9
require Exporter;
require 'tools.pl';
my @ISA = qw(Exporter);
my @EXPORT = qw(%list_of_lists);
root's avatar
root committed
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

=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;
salaun's avatar
salaun committed
171
use mail;
root's avatar
root committed
172
173
174
175
176
177
178
use Time::Local;
use MIME::Entity;
use MIME::Words;
use MIME::Parser;

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

my %list_cache;

root's avatar
root committed
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
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.*',
202
203
	      'scenario' => '[\w,\.\-]+',
	      'task' => '\w+'
root's avatar
root committed
204
205
206
207
208
209
210
211
212
	      );

## 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 
salaun's avatar
salaun committed
213
		      host lang web_archive archive digest available_user_options 
214
		      default_user_options reply_to_header reply_to forced_reply_to * 
root's avatar
root committed
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
		      welcome_return_path remind_return_path user_data_source include_file 
		      include_list include_ldap_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');

##############################################################
salaun's avatar
salaun committed
231
## This hash COMPLETELY defines ALL list parameters     
root's avatar
root committed
232
233
234
235
236
237
238
## 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
239
## split_char:   Character used to separate multiple parameters 
root's avatar
root committed
240
241
242
243
244
245
246
## 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
247
##               example : a list may have multiple owner 
root's avatar
root committed
248
## title_id :    Title reference in NLS catalogues
salaun's avatar
salaun committed
249
## group :       Group of parameters
250
251
252
## obsolete :    Obsolete parameter ; should not be displayed 
##               nor saved
## order :       Order of parameters within paragraph
root's avatar
root committed
253
254
255
###############################################################
%::pinfo = ('account' => {'format' => '\S+',
			  'length' => 10,
salaun's avatar
salaun committed
256
257
			  'title_id' => 1,
			  'group' => 'other'
root's avatar
root committed
258
259
			  },
	    'add' => {'scenario' => 'add',
salaun's avatar
salaun committed
260
261
		      'title_id' => 2,
		      'group' => 'command'
root's avatar
root committed
262
263
		      },
	    'anonymous_sender' => {'format' => '.+',
salaun's avatar
salaun committed
264
265
				   'title_id' => 3,
				   'group' => 'tuning'
root's avatar
root committed
266
267
268
				   },
	    'archive' => {'format' => {'period' => {'format' => ['day','week','month','quarter','year'],
						    'synonym' => {'weekly' => 'week'},
269
270
						    'title_id' => 5,
						    'order' => 1
root's avatar
root committed
271
272
273
						},
				       'access' => {'format' => ['open','private','public','owner','closed'],
						    'synonym' => {'open' => 'public'},
274
275
						    'title_id' => 6,
						    'order' => 2
root's avatar
root committed
276
277
						}
				   },
salaun's avatar
salaun committed
278
279
			  'title_id' => 4,
			  'group' => 'archives'
root's avatar
root committed
280
		      },
281
	    'available_user_options' => {'format' => {'reception' => {'format' => ['mail','notice','digest','summary','nomail','txt','html','urlize','not_me'],
282
283
								      'occurrence' => '1-n',
								      'split_char' => ',',
284
								      'default' => 'mail,notice,digest,summary,nomail,txt,html,urlize,not_me',
285
								      'title_id' => 89
286
287
								      }
						  },
288
					 'title_id' => 88
289
				     },
root's avatar
root committed
290
291
292
293
294

	    'bounce' => {'format' => {'warn_rate' => {'format' => '\d+',
						      'length' => 3,
						      'unit' => '%',
						      'default' => {'conf' => 'bounce_warn_rate'},
295
296
						      'title_id' => 8,
						      'order' => 1
root's avatar
root committed
297
298
299
300
301
						  },
				      'halt_rate' => {'format' => '\d+',
						      'length' => 3,
						      'unit' => '%',
						      'default' => {'conf' => 'bounce_halt_rate'},
302
303
						      'title_id' => 9,
						      'order' => 2
root's avatar
root committed
304
305
						  }
				  },
salaun's avatar
salaun committed
306
307
			 'title_id' => 7,
			 'group' => 'bounces'
root's avatar
root committed
308
309
310
311
312
		     },
	    'clean_delay_queuemod' => {'format' => '\d+',
				       'length' => 3,
				       'unit' => 'days',
				       'default' => {'conf' => 'clean_delay_queuemod'},
salaun's avatar
salaun committed
313
314
				       'title_id' => 10,
				       'group' => 'other'
root's avatar
root committed
315
316
317
318
				       },
	    'cookie' => {'format' => '\S+',
			 'length' => 15,
			 'default' => {'conf' => 'cookie'},
salaun's avatar
salaun committed
319
320
			 'title_id' => 11,
			 'group' => 'other'
root's avatar
root committed
321
322
323
		     },
	    'creation' => {'format' => {'date_epoch' => {'format' => '\d+',
							 'occurrence' => '1',
324
325
							 'title_id' => 13,
							 'order' => 3
root's avatar
root committed
326
327
						     },
					'date' => {'format' => '.+',
328
329
						   'title_id' => 14,
						   'order' => 2
root's avatar
root committed
330
331
332
						   },
					'email' => {'format' => $regexp{'email'},
						    'occurrence' => '1',
333
334
						    'title_id' => 15,
						    'order' => 1
root's avatar
root committed
335
336
						    }
				    },
salaun's avatar
salaun committed
337
338
			   'title_id' => 12,
			   'group' => 'other'
root's avatar
root committed
339
340
341
342
343

		       },
	    'custom_header' => {'format' => '\S+:\s+.*',
				'length' => 30,
				'occurrence' => '0-n',
salaun's avatar
salaun committed
344
345
				'title_id' => 16,
				'group' => 'tuning'
root's avatar
root committed
346
347
348
				},
	    'custom_subject' => {'format' => '.*',
				 'length' => 15,
salaun's avatar
salaun committed
349
350
				 'title_id' => 17,
				 'group' => 'tuning'
root's avatar
root committed
351
				 },
352
	    'default_user_options' => {'format' => {'reception' => {'format' => ['digest','mail','nomail','summary','notice','txt','html','urlize','not_me'],
root's avatar
root committed
353
								    'default' => 'mail',
354
355
								    'title_id' => 19,
								    'order' => 1
root's avatar
root committed
356
357
358
								    },
						    'visibility' => {'format' => ['conceal','noconceal'],
								     'default' => 'noconceal',
359
360
								     'title_id' => 20,
								     'order' => 2
root's avatar
root committed
361
362
								     }
						},
salaun's avatar
salaun committed
363
364
				       'title_id' => 18,
				       'group' => 'other'
root's avatar
root committed
365
366
				   },
	    'del' => {'scenario' => 'del',
salaun's avatar
salaun committed
367
368
		      'title_id' => 21,
		      'group' => 'command'
root's avatar
root committed
369
370
371
		      },
	    'digest' => {'file_format' => '\d+(\s*,\s*\d+)*\s+\d+:\d+',
			 'format' => {'days' => {'format' => [1..7],
salaun's avatar
salaun committed
372
						 'file_format' => '1|2|3|4|5|6|7',
root's avatar
root committed
373
						 'occurrence' => '1-n',
374
375
						 'title_id' => 23,
						 'order' => 1
root's avatar
root committed
376
377
378
379
						 },
				      'hour' => {'format' => '\d+',
						 'length' => 2,
						 'occurrence' => '1',
380
381
						 'title_id' => 24,
						 'order' => 2
root's avatar
root committed
382
383
384
385
						 },
				      'minute' => {'format' => '\d+',
						   'length' => 2,
						   'occurrence' => '1',
386
387
						   'title_id' => 25,
						   'order' => 3
root's avatar
root committed
388
389
						   }
				  },
salaun's avatar
salaun committed
390
391
			 'title_id' => 22,
			 'group' => 'tuning'
root's avatar
root committed
392
		     },
salaun's avatar
salaun committed
393

root's avatar
root committed
394
395
396
	    'editor' => {'format' => {'email' => {'format' => $regexp{'email'},
						  'length' => 30,
						  'occurrence' => '1',
397
398
						  'title_id' => 27,
						  'order' => 1
root's avatar
root committed
399
400
401
						  },
				      'reception' => {'format' => ['mail','nomail'],
						      'default' => 'mail',
402
403
						      'title_id' => 28,
						      'order' => 4
root's avatar
root committed
404
405
406
						      },
				      'gecos' => {'format' => '.+',
						  'length' => 30,
407
408
						  'title_id' => 29,
						  'order' => 2
root's avatar
root committed
409
410
411
						  },
				      'info' => {'format' => '.+',
						 'length' => 30,
412
413
						 'title_id' => 30,
						 'order' => 3
root's avatar
root committed
414
415
416
						 }
				  },
			 'occurrence' => '0-n',
salaun's avatar
salaun committed
417
418
			 'title_id' => 26,
			 'group' => 'description'
root's avatar
root committed
419
			 },
420
421
422
	    'expire_task' => {'task' => 'expire',
			      'title_id' => 95
			 },
root's avatar
root committed
423
424
	    'footer_type' => {'format' => ['mime','append'],
			      'default' => 'mime',
salaun's avatar
salaun committed
425
426
			      'title_id' => 31,
			      'group' => 'tuning'
root's avatar
root committed
427
428
			      },
	    'forced_reply_to' => {'format' => '\S+',
salaun's avatar
salaun committed
429
				  'title_id' => 32,
430
431
				  'group' => 'tuning',
				  'obsolete' => 1
root's avatar
root committed
432
433
434
			 },
	    'host' => {'format' => $regexp{'host'},
		       'length' => 20,
salaun's avatar
salaun committed
435
436
		       'title_id' => 33,
		       'group' => 'description'
root's avatar
root committed
437
438
439
440
		   },
	    'include_file' => {'format' => '\S+',
			       'length' => 20,
			       'occurrence' => '0-n',
salaun's avatar
salaun committed
441
442
			       'title_id' => 34,
			       'group' => 'data_source'
root's avatar
root committed
443
444
445
446
447
448
449
450
			       },

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

	    'include_ldap_query' => {'format' => {'host' => {'format' => $regexp{'host'},
							     'occurrence' => '1',
451
452
							     'title_id' => 36,
							     'order' => 1
root's avatar
root committed
453
454
455
456
							     },
						  'port' => {'format' => '\d+',
							     'default' => 389,
							     'length' => 4,
457
458
							     'title_id' => 37,
							     'order' => 2
root's avatar
root committed
459
460
							     },
						  'user' => {'format' => '.*',
461
462
							     'title_id' => 38,
							     'order' => 3
root's avatar
root committed
463
464
465
							     },
						  'passwd' => {'format' => '.*',
							       'length' => 10,
466
467
							       'title_id' => 39,
							       'order' => 3
root's avatar
root committed
468
469
							       },
						  'suffix' => {'format' => '.*',
470
471
							       'title_id' => 40,
							       'order' => 4
root's avatar
root committed
472
473
474
475
							       },
						  'filter' => {'format' => '.*',
							       'length' => 50,
							       'occurrence' => '1',
476
477
							       'title_id' => 41,
							       'order' => 5
root's avatar
root committed
478
479
480
481
							       },
						  'attrs' => {'format' => '\w+',
							      'length' => 15,
							      'default' => 'mail',
482
483
							      'title_id' => 42,
							      'order' => 6 
root's avatar
root committed
484
485
486
							      },
						  'select' => {'format' => ['all','first'],
							       'default' => 'first',
487
488
							       'title_id' => 43,
							       'order' => 7
root's avatar
root committed
489
490
491
							       }  
					      },
				     'occurrence' => '0-n',
salaun's avatar
salaun committed
492
493
				     'title_id' => 35,
				     'group' => 'data_source'
root's avatar
root committed
494
495
496
				     },
	    'include_list' => {'format' => $regexp{'listname'},
			       'occurrence' => '0-n',
salaun's avatar
salaun committed
497
498
			       'title_id' => 44,
			       'group' => 'data_source'
root's avatar
root committed
499
500
501
			       },
	    'include_sql_query' => {'format' => {'db_type' => {'format' => ['mysql','Pg','Oracle','Sybase'],
							       'occurrence' => '1',
502
503
							       'title_id' => 46,
							       'order' => 1
root's avatar
root committed
504
505
506
							       },
						 'host' => {'format' => $regexp{'host'},
							    'occurrence' => '1',
507
508
							    'title_id' => 47,
							    'order' => 2
root's avatar
root committed
509
							    },
510
						 'db_name' => {'format' => '\S+',
root's avatar
root committed
511
							       'occurrence' => '1',
512
513
							       'title_id' => 48,
							       'order' => 3 
root's avatar
root committed
514
							       },
515
516
517
518
						 'connect_options' => {'format' => '.+',
								       'title_id' => 94,
								       'order' => 4
								       },
519
						 'user' => {'format' => '\S+',
root's avatar
root committed
520
							    'occurrence' => '1',
521
							    'title_id' => 49,
522
							    'order' => 5
root's avatar
root committed
523
524
							    },
						 'passwd' => {'format' => '.+',
525
							      'title_id' => 50,
526
							      'order' => 6
root's avatar
root committed
527
528
529
530
							      },
						 'sql_query' => {'format' => $regexp{'sql_query'},
								 'length' => 50,
								 'occurrence' => '1',
531
								 'title_id' => 51,
532
								 'order' => 7
root's avatar
root committed
533
534
								 },
						 'f_dir' => {'format' => '.+',
535
							     'title_id' => 52,
536
							     'order' => 8
root's avatar
root committed
537
538
539
							     }
					     },
				    'occurrence' => '0-n',
salaun's avatar
salaun committed
540
541
				    'title_id' => 45,
				    'group' => 'data_source'
root's avatar
root committed
542
543
				    },
	    'info' => {'scenario' => 'info',
salaun's avatar
salaun committed
544
545
		       'title_id' => 53,
		       'group' => 'command'
root's avatar
root committed
546
547
		       },
	    'invite' => {'scenario' => 'invite',
salaun's avatar
salaun committed
548
549
			 'title_id' => 54,
			 'group' => 'command'
root's avatar
root committed
550
			 },
551
	    'lang' => {'format' => ['fr','us','de','it','fi','es','cn-big5','cn-gb','pl','cz','hu'],
root's avatar
root committed
552
		       'default' => {'conf' => 'lang'},
salaun's avatar
salaun committed
553
554
		       'title_id' => 55,
		       'group' => 'description'
root's avatar
root committed
555
556
557
558
559
		   },
	    'max_size' => {'format' => '\d+',
			   'length' => 8,
			   'unit' => 'bytes',
			   'default' => {'conf' => 'max_size'},
salaun's avatar
salaun committed
560
561
			   'title_id' => 56,
			   'group' => 'tuning'
root's avatar
root committed
562
563
564
565
		       },
	    'owner' => {'format' => {'email' => {'format' => $regexp{'email'},
						 'length' =>30,
						 'occurrence' => '1',
566
567
						 'title_id' => 58,
						 'order' => 1
root's avatar
root committed
568
569
570
						 },
				     'reception' => {'format' => ['mail','nomail'],
						     'default' => 'mail',
571
572
						     'title_id' => 59,
						     'order' =>5
root's avatar
root committed
573
574
575
						     },
				     'gecos' => {'format' => '.+',
						 'length' => 30,
576
577
						 'title_id' => 60,
						 'order' => 2
root's avatar
root committed
578
579
580
						 },
				     'info' => {'format' => '.+',
						'length' => 30,
581
582
						'title_id' => 61,
						'order' => 3
root's avatar
root committed
583
584
585
						},
				     'profile' => {'format' => ['privileged','normal'],
						   'default' => 'normal',
586
587
						   'title_id' => 62,
						   'order' => 4
root's avatar
root committed
588
589
590
						   }
				 },
			'occurrence' => '1-n',
salaun's avatar
salaun committed
591
592
			'title_id' => 57,
			'group' => 'description'
root's avatar
root committed
593
594
595
596
			},
	    'priority' => {'format' => [0..9,'z'],
			   'length' => 1,
			   'default' => {'conf' => 'default_list_priority'},
salaun's avatar
salaun committed
597
598
			   'title_id' => 63,
			   'group' => 'tuning'
root's avatar
root committed
599
600
		       },
	    'remind' => {'scenario' => 'remind',
salaun's avatar
salaun committed
601
602
			 'title_id' => 64,
			 'group' => 'command'
root's avatar
root committed
603
604
605
			  },
	    'remind_return_path' => {'format' => ['unique','owner'],
				     'default' => {'conf' => 'remind_return_path'},
salaun's avatar
salaun committed
606
607
				     'title_id' => 65,
				     'group' => 'bounces'
root's avatar
root committed
608
				 },
609
610
611
	    'remind_task' => {'task' => 'remind',
			      'tilte-id' => 96
			      },
root's avatar
root committed
612
613
	    'reply_to' => {'format' => '\S+',
			   'default' => 'sender',
salaun's avatar
salaun committed
614
			   'title_id' => 66,
615
616
			   'group' => 'tuning',
			   'obsolete' => 1
root's avatar
root committed
617
			   },
618
619
620
	    'reply_to_header' => {'format' => {'value' => {'format' => ['sender','list','other_email'],
							   'default' => 'sender',
							   'title_id' => 91,
621
622
							   'occurrence' => '1',
							   'order' => 1
623
624
							   },
					       'other_email' => {'format' => $regexp{'email'},
625
626
								 'title_id' => 92,
								 'order' => 2
627
628
629
								 },
					       'apply' => {'format' => ['forced','respect'],
							   'default' => 'respect',
630
631
							   'title_id' => 93,
							   'order' => 3
632
633
634
635
636
							   }
					   },
				  'title_id' => 90,
				  'group' => 'tuning'
				  },		
root's avatar
root committed
637
	    'review' => {'scenario' => 'review',
salaun's avatar
salaun committed
638
			 'synonym' => {'open' => 'public'},
salaun's avatar
salaun committed
639
640
			 'title_id' => 67,
			 'group' => 'command'
root's avatar
root committed
641
642
643
644
645
646
647
648
			 },
	    'send' => {'scenario' => 'send',
		       'title_id' => 68
		       },
	    'serial' => {'format' => '\d+',
			 'default' => 0,
			 'length' => 3,
			 'default' => 0,
salaun's avatar
salaun committed
649
650
			 'title_id' => 69,
			 'group' => 'other'
root's avatar
root committed
651
652
			 },
	    'shared_doc' => {'format' => {'d_read' => {'scenario' => 'd_read',
653
654
						       'title_id' => 86,
						       'order' => 1
root's avatar
root committed
655
656
						       },
					  'd_edit' => {'scenario' => 'd_edit',
657
658
						       'title_id' => 87,
						       'order' => 2
root's avatar
root committed
659
660
						       }
				      },
salaun's avatar
salaun committed
661
662
			     'title_id' => 70,
			     'group' => 'command'
root's avatar
root committed
663
664
665
			 },
	    'status' => {'format' => ['open','closed','pending'],
			 'default' => 'open',
salaun's avatar
salaun committed
666
667
			 'title_id' => 71,
			 'group' => 'other'
root's avatar
root committed
668
669
670
671
			  },
	    'subject' => {'format' => '.+',
			  'length' => 50,
			  'occurrence' => '1',
salaun's avatar
salaun committed
672
673
			  'title_id' => 72,
			  'group' => 'description'
root's avatar
root committed
674
675
			   },
	    'subscribe' => {'scenario' => 'subscribe',
salaun's avatar
salaun committed
676
677
			    'title_id' => 73,
			    'group' => 'command'
root's avatar
root committed
678
			    },
679
	    'topics' => {'format' => '\w+(\/\w+)?',
680
			 'split_char' => ',',
root's avatar
root committed
681
			 'occurrence' => '0-n',
salaun's avatar
salaun committed
682
683
			 'title_id' => 74,
			 'group' => 'description'
root's avatar
root committed
684
685
686
687
688
			 },
	    'ttl' => {'format' => '\d+',
		      'length' => 6,
		      'unit' => 'seconds',
		      'default' => 3600,
salaun's avatar
salaun committed
689
690
		      'title_id' => 75,
		      'group' => 'data_source'
root's avatar
root committed
691
692
		      },
	    'unsubscribe' => {'scenario' => 'unsubscribe',
salaun's avatar
salaun committed
693
694
			      'title_id' => 76,
			      'group' => 'command'
root's avatar
root committed
695
696
697
698
			      },
	    'update' => {'format' => {'date_epoch' => {'format' => '\d+',
						       'length' => 8,
						       'occurrence' => '1',
699
700
						       'title_id' => 78,
						       'order' => 3
root's avatar
root committed
701
702
703
						       },
				      'date' => {'format' => '.+',
						 'length' => 30,
704
705
						 'title_id' => 79,
						 'order' => 2
root's avatar
root committed
706
707
708
709
						 },
				      'email' => {'format' => $regexp{'email'},
						  'length' => 30,
						  'occurrence' => '1',
710
711
						  'title_id' => 80,
						  'order' => 1
root's avatar
root committed
712
713
						  }
				  },
salaun's avatar
salaun committed
714
715
			 'title_id' => 77,
			 'group' => 'other'
root's avatar
root committed
716
717
718
		     },
	    'user_data_source' => {'format' => ['database','file','include'],
				   'default' => 'file',
salaun's avatar
salaun committed
719
720
				   'title_id' => 81,
				   'group' => 'data_source'
root's avatar
root committed
721
722
				   },
	    'visibility' => {'scenario' => 'visibility',
salaun's avatar
salaun committed
723
			     'synonym' => {'public' => 'noconceal'},
salaun's avatar
salaun committed
724
725
			     'title_id' => 82,
			     'group' => 'description'
root's avatar
root committed
726
727
728
729
730
			     },
	    'web_archive'  => {'format' => {'access' => {'scenario' => 'access_web_archive',
							 'title_id' => 84
							 }
					},
salaun's avatar
salaun committed
731
732
			       'title_id' => 83,
			       'group' => 'archives'
root's avatar
root committed
733
734
735
736

			   },
	    'welcome_return_path' => {'format' => ['unique','owner'],
				      'default' => {'conf' => 'welcome_return_path'},
salaun's avatar
salaun committed
737
738
				      'title_id' => 85,
				      'group' => 'bounces'
root's avatar
root committed
739
740
741
742
743
				  }
	    );

## This is the generic hash which keeps all lists in memory.
my %list_of_lists = ();
salaun's avatar
salaun committed
744
my %list_of_robots = ();
root's avatar
root committed
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
my %list_of_topics = ();
my @mtime;

use Fcntl;
use DB_File;

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

## 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;
	}
    }

    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'};
    }

783
784
785
786
    if ($Conf{'db_options'}) {
	$connect_string .= ';' . $Conf{'db_options'};
    }

root's avatar
root committed
787
    unless ( $dbh = DBI->connect($connect_string, $Conf{'db_user'}, $Conf{'db_passwd'}) ) {
salaun's avatar
salaun committed
788
	do_log ('err','Can\'t connect to Database %s as %s', $connect_string, $Conf{'db_user'});
root's avatar
root committed
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823

	&send_notify_to_listmaster('no_db');
	&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;
}

salaun's avatar
salaun committed
824
825
826
827
828
829
830
831
## Get database handler
sub db_get_handler {
    do_log('debug2', 'List::db_get_handler');


    return $dbh;
}

root's avatar
root committed
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
## Creates an object.
sub new {
    my($pkg, $name) = @_;
    my $liste={};
    do_log('debug2', 'List::new(%s)', $name);

    ## 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{
salaun's avatar
salaun committed
850
	do_log('debug', 'List object %s creation', $name) if $main::options{'debug'}; ##TEMP
root's avatar
root committed
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866

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

    return $liste;
}

## Saves the statistics data to disk.
sub savestats {
    my $self = shift;
    do_log('debug2', 'List::savestats');
   
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
salaun's avatar
salaun committed
867
    my $dir = $self->{'dir'};
root's avatar
root committed
868
869
    return undef unless ($list_of_lists{$name});
    
salaun's avatar
salaun committed
870
   _save_stats_file("$dir/stats", $self->{'stats'}, $self->{'total'});
root's avatar
root committed
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
    
    ## Changed on disk
    $self->{'mtime'}[2] = time;

    return 1;
}

## Update the stats struct 
## Input  : num of bytes of msg
## Output : num of msgs sent
sub update_stats {
    my($self, $bytes) = @_;
    do_log('debug2', 'List::update_stats(%d)', $bytes);

    my $stats = $self->{'stats'};
    $stats->[0]++;
    $stats->[1] += $self->{'total'};
    $stats->[2] += $bytes;
    $stats->[3] += $bytes * $self->{'total'};
    return $stats->[0];
}

## Dumps a copy of lists to disk, in text format
sub dump {
895
896
    my @listnames = @_;
    do_log('debug2', 'List::dump(%s)', @listnames);
root's avatar
root committed
897

898
    foreach my $l (@listnames) {
root's avatar
root committed
899
	
900
	my $list = new List($l);
root's avatar
root committed
901
902
903
	my $user_file_name;

	if ($list->{'admin'}{'user_data_source'} eq 'database') {
904
            do_log('debug', 'Dumping list %s',$l);
salaun's avatar
salaun committed
905
	    $user_file_name = "$list->{'dir'}/subscribers.db.dump";
root's avatar
root committed
906
	    $list->_save_users_file($user_file_name);
salaun's avatar
salaun committed
907
	    $list->{'mtime'} = [ (stat("$list->{'dir'}/config"))[9], (stat("$list->{'dir'}/subscribers"))[9], (stat("$list->{'dir'}/stats"))[9] ];
root's avatar
root committed
908
	}elsif ($list->{'admin'}{'user_data_source'} eq 'include') {
909
            do_log('debug', 'Dumping list %s',$l);
salaun's avatar
salaun committed
910
	    $user_file_name = "$list->{'dir'}/subscribers.incl.dump";
root's avatar
root committed
911
	    $list->_save_users_file($user_file_name);
salaun's avatar
salaun committed
912
	    $list->{'mtime'} = [ (stat("$list->{'dir'}/config"))[9], (stat("$list->{'dir'}/subscribers"))[9], (stat("$list->{'dir'}/stats"))[9] ];
root's avatar
root committed
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
	} 

    }
    return 1;
}

## Saves a copy of the list to disk. Does not remove the
## data.
sub save {
    my $self = shift;
    do_log('debug2', 'List::save');

    my $name = $self->{'name'};    
 
    return undef 
	unless ($list_of_lists{$name});
 
    my $user_file_name;

    if ($self->{'admin'}{'user_data_source'} eq 'file') {
salaun's avatar
salaun committed
933
	$user_file_name = "$self->{'dir'}/subscribers";
root's avatar
root committed
934
935
936
937
938

        unless ($self->_save_users_file($user_file_name)) {
	    &do_log('info', 'unable to save user file %s', $user_file_name);
	    return undef;
	}
salaun's avatar
salaun committed
939
        $self->{'mtime'} = [ (stat("$self->{'dir'}/config"))[9], (stat("$self->{'dir'}/subscribers"))[9], (stat("$self->{'dir'}/stats"))[9] ];
root's avatar
root committed
940
941
942
943
944
945
946
947
948
949
950
951
    }
    
    return 1;
}

## Saves the configuration file to disk
sub save_config {
    my ($self, $email) = @_;
    do_log('debug2', 'List::save_config()');

    my $name = $self->{'name'};    
    my $old_serial = $self->{'admin'}{'serial'};
salaun's avatar
salaun committed
952
953
    my $config_file_name = "$self->{'dir'}/config";
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
root's avatar
root committed
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970

    return undef 
	unless ($list_of_lists{$name});
 
    ## Update management info
    $self->{'admin'}{'serial'}++;
    $self->{'admin'}{'defaults'}{'serial'} = 0;
    $self->{'admin'}{'update'} = {'email' => $email,
				  'date_epoch' => time,
				  'date' => &POSIX::strftime("%d %b %Y at %H:%M:%S", localtime(time))
				  };
    $self->{'admin'}{'defaults'}{'update'} = 0;
    
    unless (&_save_admin_file($config_file_name, $old_config_file_name, $self->{'admin'})) {
	&do_log('info', 'unable to save config file %s', $config_file_name);
	return undef;
    }
salaun's avatar
salaun committed
971
#    $self->{'mtime'}[0] = (stat("$list->{'dir'}/config"))[9];
root's avatar
root committed
972
973
974
975
976
977
978
979
    
    return 1;
}

## Loads the administrative data for a list
sub load {
    my ($self, $name) = @_;
    do_log('debug2', 'List::load(%s)', $name);
salaun's avatar
salaun committed
980
    
salaun's avatar
salaun committed
981
982
    my $users;
    my $robot;
salaun's avatar
salaun committed
983
984
#    foreach my $r (&get_robots) {
    foreach my $r (keys %{$Conf{'robots'}}) {
salaun's avatar
salaun committed
985
	if ((-d "$Conf{'home'}/$r/$name") && (-f "$Conf{'home'}/$r/$name/config")) {
salaun's avatar
salaun committed
986
987
988
	    $robot=$r;
	    last;
	}
root's avatar
root committed
989
    }
salaun's avatar
salaun committed
990
991
    if ($robot) {
	$self->{'domain'} = $robot ;
992
	$self->{'dir'} = "$Conf{'home'}/$robot/$name";
salaun's avatar
salaun committed
993
994
    }elsif((!($robot)) && (-d "$Conf{'home'}/$name") && (-f "$Conf{'home'}/$name/config")) {
	$self->{'domain'} = $Conf{'host'};
995
	$self->{'dir'} = "$Conf{'home'}/$name";
salaun's avatar
salaun committed
996
    }else{
salaun's avatar
salaun committed
997
998
999
	&do_log('info', 'No such list %s', $name);
	return undef ;
    }    
salaun's avatar
salaun committed
1000