#!/usr/bin/perl

use strict;
use warnings;
use 5.010;

# used to manage files
use Path::Class;

# used for checking config dirs rights (make the translation for lstat output)
use Fcntl ':mode';

# used to handle ldap connections
use Net::LDAP;

# used to base64 encode
use MIME::Base64;

# used to generate {CRYPT} password (for LDAP)
use Crypt::PasswdMD5;

# used to uncompress tar.gz
use Archive::Extract;

use File::NCopy;
 
my @root_config_dirs = qw( /usr/share/fusiondirectory /etc/fusiondirectory );
my @apache_config_dirs = qw( /var/spool/fusiondirectory /var/cache/fusiondirectory /var/cache/fusiondirectory/tmp /var/cache/fusiondirectory/fai );
my @config_dirs = ( @root_config_dirs, @apache_config_dirs );

# fd's directory and class.cache file's path declaration
my $fd_home = "/usr/share/fusiondirectory";
my $fd_cache = "/var/cache/fusiondirectory";
my $fd_config_dir = "/etc/fusiondirectory";

my $fd_config = $fd_config_dir."/fusiondirectory.conf";
my $locale_dir = $fd_home."/locale";
my $class_cache = $fd_cache."/class.cache";
my $locale_cache_dir = $fd_cache."/locale";

my $yes_flag = 0;

##################################################################################################################################################

# check if the user who run the script is root
sub user_is_root {
	# return true if the script run as root (UID= 0)
	return ($<==0);
}

# ask a question send as parameter, and return true if the answer is "yes"
sub ask_yn_question {

	return 1 if ($yes_flag);
	my ($question) = @_;
	say ( "$question [Yes/No]?" );

	while ( my $input = <STDIN> ) {
		# remove the \n at the end of $input
		chomp $input;

		# if user's answer is "yes"
		if ( lc($input) eq "yes" || lc($input) eq "y") {
			return 1;
		# else if he answer "no"
		} elsif ( lc($input) eq "no" || lc($input) eq "n") {
			return 0;
		}
	}

}

####################################################### class.cache update #########################################################################

# function that scan recursivly a directory to find .inc and . php
# then return a hash with class => path to the class file
sub get_classes {

    my ($path) = @_;
    my %hash_result = ();
	
    # if this function has been called without a parameter
    die ("! function get_classes called without parameter\n") if ( !defined($path) );

    # create a "dir" object with the path
    my $dir = dir ($path) or die ("! Can't open $path\n");

    # create an array with the content of $dir
    my @dir_files = $dir->children;

    foreach my $file (@dir_files) {
        # recursive call if $file is a directory
        if ( -d $file ) {
            %hash_result = (%hash_result, get_classes($file));
            next;
        }

        # only process if $file is a .inc or a .php file
        if ( ( $file =~ /.*\.(inc|php)$/ ) && ( $file !~ /.*smarty.*/ ) ) {
					# put the entire content of the file pointed by $file in $data
					my @lines = $file->slurp;
            
					# modifing $file, to contains relative path, not complete one
					$file =~ s/^$fd_home//;

					foreach my $line ( @lines ) {
					# remove \n from the end of each line
					chomp $line;

						# only process for lines beginning with "class", and extracting the 2nd word (the class name)
						if ( $line =~ /^class\s*(\w+).*/ ) {
							# adding the values (class name and file path) to the hash
							$hash_result{$1} = $file;
						}
          }
        }
    }
	return %hash_result;
}

# call get_classes and create /var/cache/fusiondirectory/class.cache
sub rescan_classes {

	# hash that will contain the result of the "get_classes" function
	my %get_classes_result = get_classes ($fd_home);

	# create a "file" object with the $class_cache path
	my $file_class = file ($class_cache);

	# create the handler (write mode) for the file previoulsy created
	my $fhw = $file_class->openw() or die ("! Unable to open $class_cache in read mode\n");	

	# first lines of class.cache
	$fhw->print ("<?php\n\t\$class_mapping= array(\n");

	# for each $key/$value, writting a new line to $class_cache
	while ( my($key,$value) = each %get_classes_result ) {
		$fhw->print ("\t\t\"$key\" => \"$value\",\n");
	}

	# last line of classe.cache
	$fhw->print ("\t);\n?>");

	$fhw->close or die ("! Can't close $class_cache\n");
}

###################################################### Internalisation's update ####################################################################################

# function that create .mo files with .po for each language
sub get_i18n {

    my ($path) = @_;
    my %hash_result = ();
	
    # if this function has been called without a parameter
    die ("! function get_i18n called without parameter" ) if ( !defined($path) );

    # create a "dir" object
    my $dir = dir ($path) or die ("! Can't open $path\n");

    # create an array with the content of $dir
    my @dir_files = $dir->children;

    foreach my $file (@dir_files) {
			# recursive call if $file is a directory
			if (-d $file) {
				%hash_result = ( %hash_result, get_i18n ($file) );
				next;
			}

			# if the file's directory is ???/language/LC_MESSAGES/messages.po
			if ($file =~ qr{^.*/(\w+)/LC_MESSAGES/messages.po$}) {
				# push the file's path in the language (fr/en/es/it...) array (wich is inside the hash pointed by $ref_result
				push @{$hash_result{$1}}, $file;
			}
    }
	return %hash_result;
}

# call get_i18n with the FusionDirectory's locales's directory and the hash that will contain the result in parameter
sub rescan_i18n {

	# hash that will contain the result of the "get_i18n" function
	my %get_i18n_result = get_i18n ($locale_dir);

	while ( my ($lang, $files) = each %get_i18n_result ) {

		# directory wich will contain the .mo file for each language
		my $lang_cache_dir = dir ("$locale_cache_dir/$lang/LC_MESSAGES");
 
		# if $lang_cache_dir doesn't already exists, creating it
		if ( !-d $lang_cache_dir ) {			
			$lang_cache_dir->mkpath or die ("! Can't create $locale_cache_dir/$lang/LC_MESSAGES");
		}

		# glue .po files's names
		my $po_files = join(" ", @{$files});
		chomp $po_files;

		# merging .po files
		system ( "msgcat --use-first ".$po_files.">".$lang_cache_dir."/messages.po" ) and die ("! Unable to merge .po files for $lang with msgcat, is it already installed?\n");

		# compiling .po files in .mo files
		system ( "msgfmt -o $lang_cache_dir/messages.mo $lang_cache_dir/messages.po && rm $lang_cache_dir/messages.po" ) and die ("! Unable to compile .mo files with msgfmt, is it already installed?\n");
	}
}

############################################################# Directories checking ###################################################################################

# function that make FusionDirectory's directories and setup rights properly
sub check_directories {
	my $apache_user = "";

	# try to identify the running distribution, if it's not debian or rehat like, script ask for user input
	if (-e "/etc/debian_version") {
		$apache_user = "www-data";
	} elsif ((-e "/etc/redhat-release") || (-e "/etc/mageia-release")){
		$apache_user = "apache";
	} else {
		say ("! Looks like you are not a Debian, Redhat or Mageia, I don't know your distribution !");
		say ("Who is your apache user?");
		
		my $apache_user = <STDIN>;
		chomp ($apache_user);
	}

	# for each config directory 
	foreach my $dir (@config_dirs) {
		# if the current dir exists
		if (-e $dir) {
			# retrieve dir's informations
			my @lstat = lstat ($dir);

			# extract the owner and the group of the directory 
			my $user = getpwuid ( $lstat[4] );
			my $group = getgrgid ( $lstat[5] );

			# extract the dir's rights
			my $mode = $lstat[2];
			my $rights = sprintf "%04o", S_IMODE($mode);

			# if $dir is one of the dirs that remains to root
			if ( grep (/.*$dir.*/, @root_config_dirs) ) {
				# if the dir owner is not root, changing the owner...
				if ( ($user ne "root") || ($group ne "root") || ($rights ne "0755") ) {
					if ( ask_yn_question ("$dir is not set properly, do you want to fix it") ){
						chown (0,0,$dir) or die ("! Unable to change $dir owner\n") if ( ($user ne "root") || ($group ne "root") );
						chmod ( 0755, $dir ) or die ("! Unable to change $dir rights\n") if ($rights ne "0755");
					} else {
						say ("Skiping...");
						next;
					}
				}
				next;

			# else if $dir is one of the dirs that remains to apache's user, and the dir's owner is not root or the group is not the apache's user, modifying owner
			} elsif ( grep ( /.*$dir.*/, @apache_config_dirs) ) {
				if ( ($user ne "root") || ($group ne $apache_user) || ($rights ne "0770") ) {
					if ( ask_yn_question("$dir is not set properly, do you want to fix it?") ){
						# retrieve apache's user's GID
						my $apache_gid = getgrnam ( $apache_user );
						
						# change the rights
						chown ( 0,$apache_gid,$dir ) or die ("Unable to change $dir rights") if ( ($user ne "root") || ($group ne $apache_user) );
						chmod ( 0770, $dir ) or die ("! Unable to change $dir rights\n") if ($rights ne "0770");
					} else {
						say ( "Skiping..." );
						next;
					}
				}
			}
		} else {
		
			if ( ask_yn_question("File $dir doesn't exists, do you want to create it") ){
				my $conf_dir = dir ($dir);

				# if $dir is one of the dirs that remains to root
        if (grep (/.*$dir.*/, @root_config_dirs) ) {
		      # create the directory, and change the rights
					$conf_dir->mkpath (0,0755);
					chown (0,0,$dir) or die ("! Unable to change $dir rights\n");

				# else if $dir is one of the dirs that remains to apache's user
        } elsif ( grep (/.*$dir.*/, @apache_config_dirs) ) {
					# retieve apache's user's GID
					my $apache_gid = getgrnam ( $apache_user );

					# create the directory, and change the rights
					$conf_dir->mkpath (0,0770);
					chown (0,$apache_gid,$dir) or die ("Unable to change $dir rights\n");
				}
			} else {
				say ( "Skiping..." );
				next;
			}
		}
	}
}

############################################################# LDAP conformity check #################################################################################

# function that add the FusionDirectory's admin account
# return nothing is it a problem?
sub add_ldap_admin {

	my ($base, $ldap) = @_;

	say ("Please enter FusionDirectory's admin password");
	my $fd_admin_pwd = "";
	my $pw1 = "";
						
	while ( my $input2 = <STDIN> ) {
		chomp $input2;

		if ( $pw1 eq "" ) {
			$pw1 = $input2;
			say ( "Please enter it again" );
		} elsif ( $input2 eq $pw1 ) {
			$fd_admin_pwd = $input2;
			last;
		} elsif ( $input2 eq "quit" ) {
			return;
		} else {
			say ("! Input don't match with the first one, type it again, or type 'quit' to end this script");
		}
	}

	my $admin_add = $ldap->add( "uid=fd-admin,ou=people,$base",
		attr => [
			'cn'	=>	'System Administrator-fd-admin',
			'sn'	=>	'Administrator',
			'uid'	=>	'fd-admin',
			'givenname'	=>	'System',
			'objectclass'	=>	[ 'top', 'person', 'gosaAccount', 'organizationalPerson', 'inetOrgPerson' ],
			'userPassword' => "{CRYPT}".unix_md5_crypt($fd_admin_pwd)
			]
	);
	# send a warning if the ldap's admin's add didn't gone well
	$admin_add->code && warn "\n! failed to add LDAP's cn=System Administrator,ou=people,$base entry";
}

# function that initiate the ldap connexion, and bind as the ldap's admin
sub get_ldap_connexion {
	
	my %hash_result = ();
	my $bind_dn = "";
	my $bind_pwd = "";
	my $uri = "";
	my $base = "";

	# read ldap's server's info from /etc/fusiondirectory/fusiondirectory.conf
	if (-e $fd_config) {
		# open fusiondirectory.conf in read mode
		my $fd_conf_file = file ($fd_config);	
		my $fhr = $fd_conf_file->openr;

		while (my $line = $fhr->getline) {
			if ($line =~ /^.*referral\ URI="(.*):389\/(.*)"$/) {
				$uri = $1;
				$hash_result{base} = $2;
			} elsif ($line =~ /^.*adminDn="(.*)"$/) {
				$bind_dn = $1;
			} elsif ($line =~ /^.*adminPassword="(.*)".*$/) {
				$bind_pwd = $1;
			}
		}

		$fhr->close;
	# if can't find fusiondirectory.conf	
	} else {		

		if ( ask_yn_question ("Can't find fusiondirectory.conf, do you want to specify LDAP's informations yourself") ) {
			say ("LDAP server's URI");
			$uri = <STDIN>;
			chomp $uri;
	
			say ("Search base");
			$base = <STDIN>;
			chomp $base;
			$hash_result{base} = $base;

			say ("Bind DN");
			$bind_dn = <STDIN>;
			chomp $bind_dn;
				
			say ("Bind password");
			$bind_pwd = <STDIN>;
			chomp $bind_pwd;
		} else {
			return;
		}
	}
	
	# ldap connection
	my $ldap = Net::LDAP->new ($uri) or die ("! Can't contact LDAP server $uri\n");

	$hash_result{ldap} = $ldap;

	# bind to the LDAP server
	my $bind = $ldap->bind ($bind_dn, password => $bind_pwd);

	# send a warning if the bind didn't gone well
	$bind->code && die ("! Failed to bind to LDAP server: ", $bind->error."\n");

	return %hash_result;
}

# function that check LDAP configuration
sub check_ldap {

	# initiate the LDAP connexion
	my %hash_ldap_param = get_ldap_connexion();

	# LDAP's connection's parameters
	my $base = $hash_ldap_param{base};
	my $ldap = $hash_ldap_param{ldap};

	# search for branch people
	my $people = $ldap->search (base => $base, filter => "ou=people");

	# stock search results
	my @people_entries = $people->entries;

	# if ou=people exists
	if ( defined ($people_entries[0]) ) {

		# search for FusionDirectory's admin account
		my $admin = $ldap->search ( base => "ou=people,".$base, filter => "(&(cn=System Administrator-fd-admin)(uid=fd-admin)(objectClass=inetOrgPerson))" );

		# store search's results
		my @admin_entries = $admin->entries;

		# if the search didn't returned a result
		if ( !defined ( $admin_entries[0] ) ) { 
			say ("! FusionDirectory's admin not found in your LDAP directory");

			# if user's answer is "yes", creating admin account
			if ( ask_yn_question("Do you want to create it") ) {
				add_ldap_admin($base, $ldap);
			} else {
				say ("Skiping...");
			}
		}

	# if ou=people doesn't exists
	} else {
		say ( "! ou=people,$base not found in your LDAP directory" );
		
		# if user's answer is "yes", creating ou=people branch 
		if ( ask_yn_question("Do you want to create it") ) { 
			my $people_add = $ldap->add( "ou=people,$base",
				attr => [
					'ou'	=> 'people', 
					'objectClass'	=>	'organizationalUnit'
					]
			);

			$people_add->code and warn "! failed to add LDAP's ou=people,$base branch\n";
			add_ldap_admin($base, $ldap);
		} else {
			say ("Skiping...");
		}
	}

	# search for ou=groups
	my $ldap_groups = $ldap->search ( base => $base, filter => "ou=groups" );
	my @groups_entries = $ldap_groups->entries;
	
	# if ou=groups don't exists
	if ( !defined $groups_entries[0] ) {
		say ("! ou=groups,$base not found in your LDAP directory");

		# if user's answer is "yes", creating ou=groups branch 
		if ( ask_yn_question("Do you want to create it") ) {
			my $group_add = $ldap->add( "ou=groups,$base",
				attr => [
					'ou'	=> 'groups',
					'objectClass'	=>	'organizationalUnit'
					]
			);

			$group_add->code and warn "! failed to add LDAP's ou=groups,$base branch\n";
		} else {
			say ("skiping...");
		}
	}
	
	# unbind to the LDAP server
	my $unbind = $ldap->unbind;
	$unbind->code && warn "! Unable to unbind from LDAP server: ", $unbind->error."\n";	
}


# function that migrate old FAI repos
sub migrate_repo {

	# initiate the LDAP connexion
	my %hash_ldap_param = get_ldap_connexion();

	# LDAP's connection's parameters
	my $base = $hash_ldap_param{base};
	my $ldap = $hash_ldap_param{ldap};

	# search for FAI repository server
	my $fai_repo = $ldap->search (base => $base, filter => "(&(FAIrepository=*)(objectClass=FAIrepositoryServer))");

	# stock search's results
	my @fai_entries = $fai_repo->entries;

	foreach my $repoServer (@fai_entries) {
		# retrieve the FAIrepository from the LDAP object
		my $ref_FAIrepo = $repoServer->get_value('fairepository', asref=>1);
		my @repos;
		
		# foreach FAIrepository of the LDAP object
		foreach my $repo (@{$ref_FAIrepo}) {
			# Unless the FAIrepository has already been migrated
			unless ($repo =~ /^.*\|install\|local$/) {
				say "modifying $repo";
				push @repos, $repo."|install|local";
			}
		}		
		my $modify = $ldap->modify ($repoServer->dn, replace =>	[ FAIrepository => \@repos]);
		$modify->code && warn "! Unable to delete FAI repositories for ".$repoServer->dn." : ".$modify->error."\n";
	}
	# unbind to the LDAP server
	my $unbind = $ldap->unbind;
	$unbind->code && warn "! Unable to unbind from LDAP server: ", $unbind->error."\n";
}

# function that install all the FD's plugins from a directory
sub install_plugins {
	# move to the directory containing the FD's plugins
	say ("\nWhere is the directory that contains the compressed plugins?");
	my $dir = <STDIN>;
	chomp $dir;
	chdir ($dir) or die ("! Unable to move to $dir\n");

	my $plugin_dir = dir ($dir);
	my @plugin_dirs = $plugin_dir->children;

	foreach my $plugin_archive (@plugin_dirs) {
		$plugin_archive =~ /^.*\/(.*)\.tar\.gz$/;
		my $plugin = $1;
		my $plugin_path = $plugin_archive;
		$plugin_path =~ s/\.tar\.gz$//;
		

		# skip if the current file is not a .tar.gz 
		next if ( $plugin_archive !~ /^.*\.tar\.gz$/ );
		
		# extract the <plugin>.tar.gz
		my $archive = Archive::Extract->new (archive => $plugin_archive); 
		my $extract = $archive->extract( to => $dir ) or warn ("! Unable to extract $plugin_archive\n");
		
		my $cp = File::NCopy->new(recursive => 1);

		# copy extra HTML and images
		if ( (-e $plugin_path."/html/") ){
			$dir = dir ($fd_home."/html/plugins/".$plugin);
			$dir->mkpath() or warn ("! Unable to make ".$fd_home."/html/plugins/".$plugin."\n") if ( !-e $fd_home."/html/plugins/".$plugin);
			$cp->copy ($plugin_path."/html/*", $fd_home."/html/plugins/".$plugin) or warn ("! Unable to copy ".$plugin_path."/html/");
		}
		
		# copy contrib
		if ( -e $plugin_path."/contrib/" ){
			$dir = dir ($fd_home."/doc/contrib/".$plugin);
			$dir->mkpath() or warn ("! Unable to make ".$fd_home."/doc/contrib/".$plugin."\n") if ( !-e $fd_home."/doc/contrib/".$plugin);
			$cp->copy ($plugin_path."/contrib/*", $fd_home."/doc/contrib/".$plugin) or warn ("! Unable to copy ".$plugin_path."/contrib/\n");
		}
			
		# copy etc
		$cp->copy ($plugin_path."/etc/*", $fd_config_dir) or warn ("! Unable to copy ".$plugin_path."/etc/\n") if ( -e $plugin_path."/etc/");
		
		# copy help
		if ( -e $plugin_path."/help/" ){
			$dir = dir ($fd_home."/doc/plugins/".$plugin);
			$dir->mkpath() or warn ("! Unable to make ".$fd_home."/doc/plugins/".$plugin."\n") if ( !-e $fd_home."/doc/plugins/".$plugin);
			$cp->copy ($plugin_path."/help/*", $fd_home."/help/plugins/".$plugin) or warn ("! Unable to copy ".$plugin_path."/help/\n");
		}
		
		# copy the locales
		if ( -e $plugin_path."/locale/" ) {
			$dir = dir ($fd_home."/locale/plugins/".$plugin);
			$dir->mkpath() or warn ("! Unable to make ".$fd_home."/locale/plugins/".$plugin) if ( !-e $fd_home."/locale/plugins/".$plugin);
			$cp->copy ($plugin_path."/locale/*", $fd_home."/locale/plugins/".$plugin) or warn ("! Unable to copy ".$plugin_path."/locale/") if ( -e $plugin_path."/locale/" );
		}
		
		# install the plugin
		my @types = qw(addons admin personal);

		foreach my $type (@types) {
			if ( -e $plugin_path."/".$type ){
				$dir = dir ($fd_home."/plugins/".$type."/".$plugin);
				$dir->mkpath() or warn ("! Unable to make ".$fd_home."/plugins/".$type."/".$plugin."\n") if ( !-e $fd_home."/plugins/".$type."/".$plugin );
				$cp->copy ($plugin_path."/".$type."/*", $fd_home."/plugins/".$type."/".$plugin) or warn ("! Unable to copy ".$plugin_path."/".$type."\n") if ( -e $fd_home."/plugins/".$type."/".$plugin );
			}
		}
		
		if ( -e $plugin_path."/plugin.dsc") {
			$dir = dir ($fd_home."/plugins/".$plugin);
			$dir->mkpath() or warn ("! Unable to make ".$fd_home."/plugins/".$plugin."\n") if ( !-e $fd_home."/plugins/".$plugin );
			$cp->copy ($plugin_path."/plugin.dsc", $fd_home."/plugins/".$plugin."/plugin.dsc") or warn ("! Unable to copy ".$plugin_path."/plugin/dsc\n");
		}
	}
}

#################### main function #####################
if ( user_is_root() ) {
	my %commands = ();
	$commands{"--update-cache"} 		= ["Updating class.cache",							\&rescan_classes];
	$commands{"--update-locales"}  		= ["Updating internalization",						\&rescan_i18n];
	$commands{"--check-dirs"}    		= ["Checking FusionDirectory's directories",			\&check_directories];
	$commands{"--check-ldap"}   		= ["Checking your LDAP tree",							\&check_ldap];
	$commands{"--migrate-repos"}   		= ["Migrating your FAI repositories",					\&migrate_repo];
	$commands{"--install-plugins"}   	= ["Installing FusionDirectory's plugins",			\&install_plugins];

	my $usage = 0;
	 
	foreach my $arg ( @ARGV ) {
		if ( defined $commands { lc ( $arg ) } ) {
			my @command = @{ $commands{ $arg } };
			say( $command[0] );
			$command[1]();
			
		} elsif ( ( lc($arg) eq "--help" ) || ( lc($arg) eq "-h" ) ) {
			say ( "\nCommands:" );
			while ( my ( $key,$value ) = each %commands ) {
				say ( "$key\t\t".$value->[0] );
			}
			say ( "--help\t\tShows this help\n" );

		} elsif (( lc($arg) eq "--yes" ) || ( lc($arg) eq "-y" )){
			$yes_flag = 1;
 		} else {
			say ( "\nInvalid argument\n" );
			$usage = 1;
 		}	
	}

	if( $usage || ( @ARGV <= 0 ) ) {
		print ( "Usage : $0" );
		foreach my $command ( keys ( %commands )) {
			print ( " [$command]" );
		}
		print "\n\n";
	}
} else {
	say ("\nYou have to run this script as root");
	exit -1;
}

__END__

=head1 NAME

fusiondirectory-setup - FusionDirectory setup script

=head1 DESCRIPTION

This script is designed to perform multiple checks on your FusionDirectory/LDAP architecture, and fix usual misconfiguration.
Some extra features allow you to install FusionDirectory's plugins, and migrate your old FAIrepositories.

=head2 Options

=over 4

=over 4

=item --update-cache

This option update the /var/cache/fusiondirectory/class.cache file. Wich contain PHP classes used in FusionDirectory, and their location.

=item --update-locales

This option update internalization, by generating a new .mo locales file for each language, with every .po files it found.
Needs I<msgcat> and I<msgfmt> to be installed.

=item --check-dirs

This option perform a check on all FusionDirectory's files or directories.

=item --check-ldap

This option check your LDAP tree. Looking for admin account, and groups or people branch. If one of those don't exists, the script will ask you what to do.

=item --migrate-repositories

This option check the fairepository object in your ldap tree and add the new option for FusionDirectory 1.0.2.

=item --install-plugins

This option will install the plugin from a tar.gz of the plugin. This option is intended for people wanting to install from the sources.

=back

=head1 EXAMPLE

 benoit@catbert$ fusiondirectory-setup --update-cache --update-locales
 Update FusionDirectory class cache and update localization 

=head1 AUTHOR

Benjamin Carpentier

=head1 LICENCE AND COPYRIGHT

This code is part of FusionDirectory (http://www.fusiondirectory.org/)

=over 2

=item Copyright (C) 2011  FusionDirectory

=back

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.

=cut