sympa_wizard.pl.in 26 KB
Newer Older
salaun's avatar
 
salaun committed
1
#!--PERL--
2
# $Id$
salaun's avatar
 
salaun committed
3
4

# Sympa - SYsteme de Multi-Postage Automatique
5
6
7
8
9
#
# 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 GIP RENATER
salaun's avatar
 
salaun committed
10
11
12
13
14
15
16
17
18
19
20
21
#
# 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
22
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
salaun's avatar
 
salaun committed
23

24
=head1 NAME
salaun's avatar
 
salaun committed
25

26
sympa_wizard.pl - help perform sympa initial setup
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
=head1 SYNOPSIS

=over

=item sympa_wizard.pl

Edit current sympa configuration

=item sympa_wizard.pl [--target file] --create <sympa.conf|wwsympa.conf>

Creates a new sympa or wwsympa configuration file

=item sympa_wizard.pl --check

check CPAN modules needed for running sympa

=item sympa_wizard.pl --help

Display usage instructions

=back

=head1 AUTHORS

=over

=item Serge Aumont <sa@cru.fr>

56
=item Olivier SalaE<252>n <os@cru.fr>
salaun's avatar
 
salaun committed
57

58
59
60
61
=back

=cut

62
use lib '--modulesdir--';
63
64
65
66
67
use strict;
use POSIX qw(strftime);
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
68
use Sys::Hostname qw(hostname);
69
use Sympa::Constants;
70

71
72
73
74
75
76
my $with_CPAN; # check if module "CPAN" installed.

BEGIN {
    $with_CPAN = eval { require CPAN; };
}

77
## sympa configuration files
78
79
my $wwsympa_conf = Sympa::Constants::WWSCONFIG;
my $sympa_conf   = Sympa::Constants::CONFIG;
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

my %options;
GetOptions(
    \%options, 
    'target=s',
    'create=s',
    'check',
    'help'
);

if ($options{help}) {
    pod2usage();
} elsif ($options{create}) {
    create_configuration();
} elsif ($options{check}) {
    check_cpan();
} else {
    edit_configuration();
}

exit 0;

sub create_configuration {
103
    use confdef;
104

105
106
107
108
109
110
111
112
113
114
115
    eval {
	require Conf;
	require tools;
    };
    if ($@) {
	*{Language::gettext} = sub { shift };
	*{tools::wrap_text} = sub { "$_[1]$_[0]\n" };
    } else {
	Language::SetLang('');
    }

116
    my $conf;
117
118
119
120
121
122
123
    if ($options{create} eq 'sympa.conf') {
        $conf = $options{target} ? $options{target} : $sympa_conf;
    } elsif ($options{create} eq 'wwsympa.conf') {
        $conf = $options{target} ? $options{target} : $wwsympa_conf;
    } else {
        pod2usage("$options{create} is not a valid argument");
        exit 1;
124
    }
125

salaun's avatar
salaun committed
126
    if (-f $conf) {
127
128
        print STDERR "$conf file already exists, exiting\n";
        exit 1;
salaun's avatar
salaun committed
129
    }
130

131
    unless (open (NEWF,"> $conf")){
132
        die "Unable to open $conf : $!";
133
134
    };

135
    if ($options{create} eq 'sympa.conf') {
136
#        print NEWF <<EOF
137
138
139
140
## Configuration file for Sympa
## many parameters are optional
## refer to the documentation for a detailed list of parameters

141
#EOF
142
    }
143

144
    foreach my $param (@confdef::params) {
145
146

        if ($param->{'title'}) {
147
148
            printf NEWF "###\\\\\\\\ %s ////###\n\n",
                        Language::gettext($param->{'title'});
149
150
151
152
153
154
155
            next;
        }

        next unless ($param->{'file'} eq $options{create});

        next unless (defined $param->{'default'} || defined $param->{'sample'});

156
157
        print NEWF tools::wrap_text(Language::gettext($param->{'query'}),
                                    '## ', '## ')
158
159
            if (defined $param->{'query'});

160
161
        print NEWF tools::wrap_text(Language::gettext($param->{'advice'}),
                                    '## ', '## ')
162
163
            if (defined $param->{'advice'});

164
165
166
167
168
        if (defined $param->{'sample'}) {
            printf NEWF "#%s\t%s\n\n", $param->{'name'}, $param->{'sample'};
        } elsif (defined $param->{'default'}) {
            printf NEWF "%s\t%s\n\n", $param->{'name'}, $param->{'default'};
        }
169
170
    }

salaun's avatar
salaun committed
171
172
    close NEWF;
    print STDERR "$conf file has been created\n";
173
174
}

175
sub edit_configuration {
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    require confdef;
    # complement required fields.
    foreach my $param (@confdef::params) {
        if ($param->{'name'} eq 'domain') {
            $param->{'default'} = hostname();
        } elsif ($param->{'name'} eq 'wwsympa_url') {
            $param->{'default'} = sprintf 'http://%s/sympa', hostname();
        }
    }
    eval {
        require Conf;
        require tools;
    };
    if ($@) {
        die "Installation of Sympa has not been completed.\nRun sympa_wizard.pl --check\n";
    }
192

193
194
195
196
    my $new_wwsympa_conf = '/tmp/wwsympa.conf';
    my $new_sympa_conf = '/tmp/sympa.conf';
    my $wwsconf = {};
    my $somechange = 0;
salaun's avatar
 
salaun committed
197

198
199
200
201
202
203
204
205
206
207
208
209
    my $rep;
    print "Does your console support UTF-8 (if you are not sure, hit [Enter])? [y/N] : ";
    $rep = <STDIN>;
    chomp $rep;
    if (lc $rep eq 'y') {
        my $lang = $ENV{'LANGUAGE'} || $ENV{'LC_ALL'} || $ENV{'LANG'} || '';
        $lang =~ s/\..*//;
        Language::SetLang($lang);
    } else {
	Language::SetLang('en_US');
    }

210
211
    ## Load config 
    unless ($wwsconf = wwslib::load_config($wwsympa_conf)) {
212
	&Log::fatal_err("Unable to load sympa configuration, file $wwsympa_conf or one of the vhost robot.conf files contain errors. Exiting.");  
salaun's avatar
 
salaun committed
213
    }
214

215
216
    ## Load sympa config (but not using database)
    unless (Conf::load( $sympa_conf,'nodb')) {
217
	&Log::fatal_err("Unable to load sympa configuration, file $sympa_conf or one of the vhost robot.conf files contain errors. Exiting.");  
salaun's avatar
 
salaun committed
218
    }
219
220
221
222

    my (@new_wwsympa_conf, @new_sympa_conf);

    ## Edition mode
223
    foreach my $param (@confdef::params) {
224
225
226
        my $desc;

        if ($param->{'title'}) {
227
228
            my $title = Language::gettext($param->{'title'});
            print "\n\n** $title **\n";
229
230
231

            ## write to conf file
            push @new_wwsympa_conf,
232
                sprintf "###\\\\\\\\ %s ////###\n\n", $title;
233
            push @new_sympa_conf,
234
                sprintf "###\\\\\\\\ %s ////###\n\n", $title;
235
236
237
238
239
240
241

            next;
        }    

        my $file = $param->{'file'} ;
        my $name = $param->{'name'} ; 
        my $query = $param->{'query'} ;
242
        $query = Language::gettext($query) if $query;
243
        my $advice = $param->{'advice'} ;
244
        $advice = Language::gettext($advice) if $advice;
245
246
247
248
249
250
251
        my $sample = $param->{'sample'} ;
        my $current_value ;
        if ($file eq 'wwsympa.conf') {	
            $current_value = $wwsconf->{$name} ;
        } elsif ($file eq 'sympa.conf') {
            $current_value = $Conf::Conf{$name}; 
        } else {
252
            next;
253
254
255
        }
        my $new_value;
        if ($param->{'edit'} eq '1') {
256
257
258
259
            print "\n";
            print tools::wrap_text($query, '* ', '  ');
            print tools::wrap_text($advice, '  ... ', '  ') if $advice;
            printf(Language::gettext('%s [%s] : '), $name, $current_value);
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
            $new_value = <STDIN> ;
            chomp $new_value;
        }
        if ($new_value eq '') {
            $new_value = $current_value;
        }

        ## SKip empty parameters
        next if (($new_value eq '') &&
            ! $sample);

        ## param is an ARRAY
        if (ref($new_value) eq 'ARRAY') {
            $new_value = join ',',@{$new_value};
        }

        if ($file eq 'wwsympa.conf') {
            $desc = \@new_wwsympa_conf;
        }elsif ($file eq 'sympa.conf') {
            $desc = \@new_sympa_conf;
        }else{
281
282
            printf STDERR gettext("Incorrect parameter definition: %s\n"),
                          $file;
283
284
285
286
287
        }

        if ($new_value eq '') {
            next unless $sample;

288
            push @{$desc}, tools::wrap_text($query, '## ', '## ');
289
290

            unless ($advice eq '') {
291
                push @{$desc}, tools::wrap_text($advice, '## ', '## ');
292
293
            }

294
            push @{$desc}, "# $name\t$sample\n\n";
295
        }else {
296
            push @{$desc}, tools::wrap_text($query, '## ', '## ');
297
            unless ($advice eq '') {
298
                push @{$desc}, tools::wrap_text($advice, '## ', '## ');
299
300
301
            }

            if ($current_value ne $new_value) {
302
                push @{$desc}, "# was $name $current_value\n";
303
304
305
                $somechange = 1;
            }

306
            push @{$desc}, "$name\t$new_value\n\n";
307
        }
salaun's avatar
 
salaun committed
308
    }
309

310
    if ($somechange) {
311

312
313
        my $date = Language::gettext_strftime("%d.%b.%Y-%H.%M.%S",
                                              localtime(time));
314
315
316

        ## Keep old config files
        unless (rename $wwsympa_conf, $wwsympa_conf.'.'.$date) {
317
318
            warn sprintf(Language::gettext("Unable to rename %s : %s"),
                         $wwsympa_conf, $!);
319
320
321
        }

        unless (rename $sympa_conf, $sympa_conf.'.'.$date) {
322
323
            warn sprintf(Language::gettext("Unable to rename %s : %s"),
                         $sympa_conf, $!);
324
325
326
327
        }

        ## Write new config files
        unless (open (WWSYMPA,"> $wwsympa_conf")){
328
329
            die sprintf(Language::gettext("Unable to open %s : %s"),
                        $wwsympa_conf, $!);
330
331
        };

332
        my $umask = umask 037;
333
        unless (open (SYMPA,"> $sympa_conf")){
334
            umask $umask;
335
336
            die sprintf(Language::gettext("Unable to open %s : %s"),
                        $sympa_conf, $!);
337
        };
338
339
        umask $umask;
        chown [getpwnam(Sympa::Constants::USER)]->[2], [getgrnam(Sympa::Constants::GROUP)]->[2], $sympa_conf;
340
341
342

        print SYMPA @new_sympa_conf;
        print WWSYMPA @new_wwsympa_conf;
343

344
345
346
        close SYMPA;
        close WWSYMPA;

347
        printf Language::gettext("%s and %s have been updated.\nPrevious versions have been saved as %s and %s.\n"), $sympa_conf, $wwsympa_conf, "$sympa_conf.$date", "$wwsympa_conf.$date";
salaun's avatar
 
salaun committed
348
    }
349
}
350

351
352
sub check_cpan {

353
354
355
356
357
358
359
360
361
362
363
364
365
366
    ## assume required_version = 1.0 if not specified.
    my %cpan_modules = (
			'Archive::Zip' => {
					   required_version => '1.05',
					   package_name => 'Archive-Zip',
					   mandatory => 1,
					   usage => 'this module provides zip/unzip for archive and shared document download/upload',
					  },
			'AuthCAS' => {
				      required_version =>'1.4',
				      package_name => 'AuthCAS',
				      usage => 'CAS Single Sign-On client libraries. Required if you configure Sympa to delegate web authentication to a CAS server.',
				     },
			'CGI' => {
367
				  required_version =>'3.51',
368
369
370
371
				  package_name => 'CGI',
				  mandatory => 1,
				  usage => 'required to run Sympa web interface',
				  },
372
373
			# CGI::Cookie is included in CGI.
			# CGI::Fast is included in CGI.
374
375
			'Crypt::CipherSaber' => {
						 required_version =>'0.50',
376
377
						 package_name => 'Crypt-CipherSaber',
						 usage => 'this module provides reversible encryption of user passwords in the database.  Useful when updating from old version with password reversible encryption, or if secure session cookies in non-SSL environments are required.',
378
379
380
						},
			'DB_File' => {
				      required_version =>'1.75',
381
				      package_name => 'DB_File',
382
383
384
				      mandatory => 1,
				      usage => ' used for maintaining snapshots of list members',
				     },
385
386
387
388
			'DBD::ODBC' => {
					package_name => 'DBD-ODBC',
					usage => 'ODBC database driver, required if you connect to a database via ODBC.',
					},
389
390
391
392
393
394
395
			'DBD::Oracle' => {
					  required_version =>'0.90',
					  package_name => 'DBD-Oracle',
					  usage => 'Oracle database driver, required if you connect to a Oracle database.',
				     },
			'DBD::Pg' => {
				      required_version =>'0.90',
396
				      prerequisites => 'postgresql-devel and postgresql-server. postgresql should be running for make test to succeed',
397
398
399
400
401
				      package_name => 'DBD-Pg',
				      usage => 'PostgreSQL database driver, required if you connect to a PostgreSQL database.',
				     },
			'DBD::SQLite' => {
					  required_version =>'0.90',
402
					  prerequisites => 'sqlite-devel. No need to install a server, the SQLite server code being provided with the client code.',
403
404
405
406
407
408
409
410
411
					  package_name => 'DBD-SQLite',
					  usage => 'SQLite database driver, required if you connect to a SQLite database.',
					 },
			'DBD::Sybase' => {
					  required_version =>'0.90',
					  package_name => 'DBD-Sybase',
					  usage => 'Sybase database driver, required if you connect to a Sybase database.',
					 },
			'DBD::mysql' => {
412
					 required_version =>'4.008',
413
					 prerequisites => 'mysql-devel and myslq-server. mysql should be running for make test to succeed',
414
					 package_name => 'DBD-mysql',
415
416
417
418
419
420
421
422
423
424
425
426
427
					 mandatory => 1,
					 usage => 'Mysql database driver, required if you connect to a Mysql database.\nYou first need to install the Mysql server and have it started before installing the Perl DBD module.',
					},
			'DBI' => {
				  required_version =>'1.48',
				  package_name => 'DBI',
				  mandatory => 1,
				  usage => 'a generic Database Driver, required by Sympa to access Subscriber information and User preferences. An additional Database Driver is required for each database type you wish to connect to.',
				 },
			'Digest::MD5' => {
					  required_version =>'2.00',
					  package_name => 'Digest-MD5',
					  mandatory => 1,
428
					  usage => 'used to compute MD5 digests for passwords, etc',
429
					 },
430
431
432
433
434
435
			'Email::Simple' => {
					    required_version =>'2.100',
					    package_name => 'Email-Simple',
					    mandatory => 1, 
					    usage => 'Used for email tracking',
					   },
436
437
438
439
440
441
			'Encode' => {
				     package_name => 'Encode',
				     mandatory => 1,
				     usage => 'module for character encoding processing',
				    },
			'FCGI' => {
442
				   required_version => '0.67',
443
				   package_name => 'FCGI',
444
				   'usage' => "WWSympa, Sympa's web interface can run as a FastCGI (i.e. a persistent CGI). If you install this module, you will also need to install the associated FastCGI frontend, e.g. mod_fcgid for Apache.",
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
				  },
			'File::Copy::Recursive' => {
						    required_version =>'0.36',
						    package_name => 'File-Copy-Recursive',
						    mandatory => 1,
						    usage => 'used to copy file hierarchies',
						   },
			'File::NFSLock' => {
					    package_name => 'File-NFSLock',
					    usage => 'required to perform NFS lock ; see also lock_method sympa.conf parameter'
					   },
			'HTML::FormatText' => {
					       package_name => 'HTML-Format',
					       mandatory => 1,
					       usage => 'used to compute plaindigest messages from HTML',
					      },
			'HTML::StripScripts::Parser' => {
462
							 required_version =>'1.03',
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
							 package_name => 'HTML-StripScripts-Parser',
							 mandatory => 1,
							 usage => 'required for XSS protection on the web interface',
							},
			'HTML::TreeBuilder' => {
						package_name => 'HTML-Tree',
						mandatory => 1,
						usage => 'used to compute plaindigest messages from HTML',
					       },
			'IO::Scalar' => {
					 package_name => 'IO-stringy',
					 mandatory => 1,
					 usage => 'internal use for string processing',
					},
			'IO::Socket::SSL' => {
					      required_version =>'0.90',
					      package_name => 'IO-Socket-SSL',
					      usage => 'required when including members of a remote list',
					     },
482
			# Net::SSLeay is included in IO-Socket-SSL.
483
484
485
486
487
			'JSON::XS' => {
					      required_version =>'2.32',
					      package_name => 'JSON-XS',
					      usage => 'required when using the VOOT protocol',
					     },
488
			'Locale::Messages' => {
489
490
491
492
493
						 package_name => 'libintl-perl',
						 mandatory => 1,
						 usage => 'internationalization functions',
						},
			'LWP' => {
494
				  package_name => 'libwww-perl',
495
496
497
				  mandatory => 1,
				  usage => 'required when including members of a remote list',
				 },
498
499
500
501
502
503
504
505
506
507
508
			'Mail::Address' => {
					    required_version => '1.70',
					    package_name => 'MailTools',
					    mandatory => 1,
					    usage => 'used to parse or build mailboxes in message headers',
					   },
			'Mail::DKIM' => {
					 required_version => '0.36',
					 package_name => 'Mail-DKIM',
					 usage => 'required in order to use DKIM features (both for signature verification and signature insertion)',
					},
509
			'MHonArc::UTF8' => {
510
					    required_version =>'2.6.18',
511
512
513
514
515
516
517
518
					    package_name => 'MHonArc',
					    mandatory => 1, 
					    usage => 'mhonarc is used to build Sympa web archives',
					   },
			'MIME::Base64' => {
					   required_version =>'3.03',
					   package_name => 'MIME-Base64',
					   mandatory => 1,
519
					   usage => 'required to compute digest for password and emails',
520
521
					  },
			'MIME::Charset' => {
522
					    required_version =>'1.010',
523
524
					    package_name => 'MIME-Charset',
					    mandatory => 1,
525
					    usage => 'used to encode mail body using a different charset',
526
527
					   },
			'MIME::EncWords' => {
528
					     required_version =>'1.014',
529
530
					     package_name => 'MIME-EncWords',
					     mandatory => 1,
531
					     usage => 'required to decode/encode SMTP header fields without breaking character encoding', 
532
533
534
535
536
					    },
			'MIME::Lite::HTML' => {
					       required_version =>'1.23',
					       package_name => 'MIME-Lite-HTML',
					       mandatory => 1,
537
					       usage => 'used to compose HTML mail from the web interface',
538
539
540
541
542
					      },
			'MIME::Tools' => {
					  required_version =>'5.423',
					  package_name => 'MIME-tools',
					  mandatory => 1,
543
					  usage => 'provides libraries for manipulating MIME messages',
544
545
546
					 },
			'Net::LDAP' => {
					required_version =>'0.27', 
547
					prerequisites => 'openldap-devel is needed to build the Perl code',
548
549
550
551
552
553
554
					package_name => 'perl-ldap',
					usage => 'required to query LDAP directories. Sympa can do LDAP-based authentication ; it can also build mailing lists with LDAP-extracted members.',
				       },
			'Net::Netmask' => {
					   required_version =>'1.9015', 
					   package_name => 'Net-Netmask',
					   mandatory => 1,
555
					   usage => 'used to check netmask within Sympa autorization scenario rules',
556
557
558
559
560
561
562
563
					  },
			'Net::SMTP' => {
					package_name => 'libnet',
					usage => 'this is required if you set \'list_check_smtp\' sympa.conf parameter, used to check existing aliases before mailing list creation.',
				       },
			'perl' => {
				   required_version =>'5.008',
				  },
564
565
566
567
568
569
			'Proc::ProcessTable' => {
				       package_name => 'Proc-ProcessTable',
				       required_version =>'0.44', 
				       mandatory => 1,
				       usage => 'Used by the bulk.pl daemon to check the number of slave bulks running.',
				      },
570
			'SOAP::Lite' => {
571
					 required_version =>'0.712',
572
573
574
575
576
					 package_name => 'SOAP-Lite',
					 usage => 'required if you want to run the Sympa SOAP server that provides ML services via a "web service"',
					},
			'Template' => {
				       package_name => 'Template-Toolkit',
577
578
				       mandatory => 1,
				       usage => 'Sympa template format, used for web pages and other mail, config file templates. See http://template-toolkit.org/.',
579
580
581
582
583
				      },
			'Term::ProgressBar' => {
						required_version =>'2.09',
						package_name => 'Term-ProgressBar',
						mandatory => 1,	
584
						usage => 'used while checking the RDBMS buffer size',
585
586
					       },
			'Text::LineFold' => {
587
			    		     required_version =>'2011.05',
588
					     package_name => 'Unicode-LineBreak',
589
					     mandatory => 1,
590
591
					     usage => 'used to fold lines in HTML mail composer and system messages, prior to Text::Wrap',
					    },
592
			'Time::HiRes' => {
593
					  required_version =>'1.29',
594
					  package_name => 'Time-HiRes',
595
					  mandatory => 1,
596
					  usage => 'used by sympa.pl --test_database_message_buffer to test database performances',
597
					 },
598
599
600
601
602
603
			'URI::Escape' => {
					  required_version =>'1.35',
					  package_name => 'URI-Escape',
					  mandatory => 1,
					  usage => 'Used to create URI containing non URI-canonical characters.',
					 },
604
			'XML::LibXML' => {
605
					  prerequisites => 'libxml2-devel is needed to build the Perl code',
606
607
					  package_name => 'XML-LibXML',
					  mandatory => 1,
608
					  usage => 'used to parse list configuration templates and instanciate list families',
609
610
					 },
		       );
611

612
613
614
615
616
617
618
619
620
621
622
623
    print "##########################################################################################
# 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.
##############################################################################################
Strike return key to continue...
";
    my $rep = <STDIN>;

624
625
    ### main:
    print "******* Check perl for SYMPA ********\n";
626
627
    ### REQ perl version
    print "\nChecking for PERL version:\n-----------------------------\n";
628
629
    my $rpv = $cpan_modules{"perl"}{'required_version'};
    if ($] >= $cpan_modules{"perl"}{'required_version'}){
630
        print "your version of perl is OK ($]  >= $rpv)\n";
631
    }else {
632
633
634
635
        print "Your version of perl is TOO OLD ($]  < $rpv)\nPlease INSTALL a new one !\n";
    }

    print "\nChecking for REQUIRED modules:\n------------------------------------------\n";
636
    check_modules('y', \%cpan_modules, 'mandatory');
637
    print "\nChecking for OPTIONAL modules:\n------------------------------------------\n";
638
    check_modules('n', \%cpan_modules, 'optional');
639
640
641
642
643
644
645
646

    print <<EOM;
******* NOTE *******
You can retrieve all theses modules from any CPAN server
(for example ftp://ftp.pasteur.fr/pub/computing/CPAN/CPAN.html)
EOM
###--------------------------
# reports modules status
647
648
# $cpan_modules is the cpan_modules structure
# $type is the type of modules (mandatory | optional) that should be installed
649
650
651
652
###--------------------------
}

sub check_modules {
653
654
#    my($default, $todo, $versions, $opt_features) = @_;
    my($default, $cpan_modules, $type) = @_;
655
656
657
658

    print "perl module          from CPAN       STATUS\n"; 
    print "-----------          ---------       ------\n";

659
660
661
662
663
664
665
666
667
668
669
670
671
    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 ("%-20s %-15s", $mod, $cpan_modules->{$mod}{package_name});
672

673
674
675
676
        eval "require $mod";
        if ($@) {
            ### not installed
            print "was not found on this system.\n";
677
            install_module($mod, {'default' => $default}, $cpan_modules);
678
        } else {
679

680
681
682
683
684
	  my ($vs, $v);
	  
	  ## MHonArc module does not provide its version the standard way
	  if ($mod =~ /^MHonArc/i) {
	    require "mhamain.pl";
685
686
	    $v = $mhonarc::VERSION;
	  }else {
687
           
688
689
690
691
692
	    $vs = "$mod" . "::VERSION";
	    {
	      no strict 'refs';
	      $v = $$vs;
	    }
693
694
	  }

695
	  my $rv = $cpan_modules->{$mod}{required_version} || "1.0" ;
696
697
698
699
700
701
	  ### OK: check version
	  if ($v ge $rv) {
	    printf ("OK (%-6s >= %s)\n", $v, $rv);
	    next;
	  } else {
	    print "version is too old ($v < $rv).\n";
702
703
	    print ">>>>>>> You must update \"$cpan_modules->{$mod}{package_name}\" to version \"$cpan_modules->{$mod}{required_version}}\" <<<<<<.\n";
	    install_module($mod, {'default' => $default}, $cpan_modules);
704
	  }
705
        }
salaun's avatar
 
salaun committed
706
707
708
    }
}

709
710
711
712
##----------------------
# Install a CPAN module
##----------------------
sub install_module {
713
714
715
    return unless $with_CPAN;

    my ($module, $options, $cpan_modules) = @_;
salaun's avatar
 
salaun committed
716

717
    my $default = $options->{'default'};
salaun's avatar
salaun committed
718

719
720
721
    unless ($ENV{'FTP_PASSIVE'} eq 1) {
        $ENV{'FTP_PASSIVE'} = 1;
        print "Setting FTP Passive mode\n";
salaun's avatar
 
salaun committed
722
    }
salaun's avatar
salaun committed
723

724
725
726
727
728
729
730
731
732
    ## This is required on RedHat 9 for DBD::mysql installation
    my $lang = $ENV{'LANG'};
    $ENV{'LANG'} = 'C' if ($ENV{'LANG'} =~ /UTF\-8/);

    unless ($EUID == 0) {
        print "\#\# You need root privileges to install $module module. \#\#\n";
        print "\#\# Press the Enter key to continue checking modules. \#\#\n";
        my $t = <STDIN>;
        return undef;
salaun's avatar
 
salaun committed
733
    }
salaun's avatar
salaun committed
734

735
    unless ($options->{'force'}) {
736
737
        printf "-> Usage of this module: %s\n", $cpan_modules->{$module}{usage} if ($cpan_modules->{$module}{usage});
        printf "-> Prerequisites: %s\n", $cpan_modules->{$module}{prerequisites} if ($cpan_modules->{$module}{prerequisites});
738
	print "-> Install module $module ? [$default]";
739
740
741
742
        my $answer = <STDIN>; chomp $answer;
        $answer ||= $default;
        return unless ($answer =~ /^y$/i);
    }
743

744
745
746
747
748
749
  $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
750

751
    #CPAN::Shell->clean($module) if ($options->{'force'});
salaun's avatar
 
salaun committed
752

753
    CPAN::Shell->make($module);
salaun's avatar
salaun committed
754

755
756
757
758
759
760
761
762
763
    if ($options->{'force'}) {
        CPAN::Shell->force('test', $module);
    }else {
        CPAN::Shell->test($module);
    }

    CPAN::Shell->install($module); ## Could use CPAN::Shell->force('install') if make test failed

    ## Check if module has been successfuly installed
764
    unless (eval "require $module") {
765
766
767
768
769
770
771
772
773

        ## Prevent recusive calls if already in force mode
        if ($options->{'force'}) {
            print  "Installation of $module still FAILED. You should download the tar.gz from http://search.cpan.org and install it manually.";
            my $answer = <STDIN>;
        }else {
            print  "Installation of $module FAILED. Do you want to force the installation of this module? (y/N) ";
            my $answer = <STDIN>; chomp $answer;
            if ($answer =~ /^y/i) {
774
                install_module($module, {'force' => 1}, $cpan_modules);
775
776
777
            }
        }
    }
salaun's avatar
 
salaun committed
778

779
780
    ## Restore lang
    $ENV{'LANG'} = $lang if (defined $lang);
salaun's avatar
 
salaun committed
781

782
}