# Copyright (c) vhffs project and its contributors
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without 
# modification, are permitted provided that the following conditions 
# are met:
#
# 1. Redistributions of source code must retain the above copyright 
#   notice, this list of conditions and the following disclaimer.
#2. Redistributions in binary form must reproduce the above copyright
#   notice, this list of conditions and the following disclaimer in 
#   the documentation and/or other materials provided with the 
#   distribution.
#3. Neither the name of vhffs nor the names of its contributors 
#   may be used to endorse or promote products derived from this 
#   software without specific prior written permission.
#
#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
#"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
#LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 
#FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 
#COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 
#INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 
#BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 
#LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 
#CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 
# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
# POSSIBILITY OF SUCH DAMAGE.

=pod

=head1 NAME

Vhffs::Functions - Utility functions for VHFFS.

=head1 METHODS

=cut

package Vhffs::Functions;
require Exporter;
@ISA    = qw(Exporter);
@EXPORT = qw( send_mail mail_template);

use strict;
use utf8;
use DBI;
use POSIX qw(locale_h);
use locale;
use Locale::gettext;
use Vhffs::Constants;

my $password;
srand(time ^ $$);

# TODO: move those tables to Constants

my @STATUS_STRINGS;
$STATUS_STRINGS[Vhffs::Constants::WAITING_FOR_VALIDATION] = 'Waiting for validation';
$STATUS_STRINGS[Vhffs::Constants::VALIDATION_REFUSED] = 'Validation refused';
$STATUS_STRINGS[Vhffs::Constants::WAITING_FOR_CREATION] = 'Waiting for creation';
$STATUS_STRINGS[Vhffs::Constants::CREATING_ERROR] = 'Creation error';
$STATUS_STRINGS[Vhffs::Constants::CREATED] = 'Created';
$STATUS_STRINGS[Vhffs::Constants::ACTIVATED] = 'Activated';
$STATUS_STRINGS[Vhffs::Constants::SUSPEND_PENDING] = 'Waiting for suspension';
$STATUS_STRINGS[Vhffs::Constants::SUSPENDED] = 'Suspended';
$STATUS_STRINGS[Vhffs::Constants::WAITING_FOR_MODIFICATION] = 'Waiting for modification';
$STATUS_STRINGS[Vhffs::Constants::MODIFICATION_ERROR] = 'Modification error';
$STATUS_STRINGS[Vhffs::Constants::MODIFICATION_APPLIED] = 'Modification applied';
$STATUS_STRINGS[Vhffs::Constants::TO_DELETE] = 'Will be deleted';


my @TYPES_STRINGS;
$TYPES_STRINGS[Vhffs::Constants::TYPE_USER] = 'User';
$TYPES_STRINGS[Vhffs::Constants::TYPE_GROUP] = 'Group';
$TYPES_STRINGS[Vhffs::Constants::TYPE_WEB] = 'Webarea';
$TYPES_STRINGS[Vhffs::Constants::TYPE_REPOSITORY] = 'Download Repository';
$TYPES_STRINGS[Vhffs::Constants::TYPE_MYSQL] = 'MySQL DB';
$TYPES_STRINGS[Vhffs::Constants::TYPE_PGSQL] = 'PgSQL DB';
$TYPES_STRINGS[Vhffs::Constants::TYPE_CVS] = 'CVS Repository';
$TYPES_STRINGS[Vhffs::Constants::TYPE_SVN] = 'SVN Repository';
$TYPES_STRINGS[Vhffs::Constants::TYPE_GIT] = 'GIT Repository';
$TYPES_STRINGS[Vhffs::Constants::TYPE_MERCURIAL] = 'Mercurial Repository';
$TYPES_STRINGS[Vhffs::Constants::TYPE_BAZAAR] = 'Bazaar Repository';
$TYPES_STRINGS[Vhffs::Constants::TYPE_DNS] = 'Domain Name';
$TYPES_STRINGS[Vhffs::Constants::TYPE_MAIL] = 'Mail Domain';
$TYPES_STRINGS[Vhffs::Constants::TYPE_ML] = 'Mailing List';
$TYPES_STRINGS[Vhffs::Constants::TYPE_CRON] = 'Cron job';


# Return 1 if string is either 'yes', 'on', '1', 'y', else return 0
sub strtobool
{
	my $str = shift;
	return 0 unless defined $str;
	return 1 if( $str eq 'yes'  ||  $str eq 'y'  ||  $str eq 'on'  ||  $str eq '1' );
	return 0;
}


sub hash_mxdomain
{
	my $domain = shift;
	my $path = "";

	$path = substr( $domain , 0 , 1 ) . "/" . substr( $domain , 1 , 1 ) . "/" . $domain ;

	return( $path );
}


sub check_arg
{
	my $arg = shift;
	return undef unless defined $arg;
	$arg =~ s/\'//g;
	return( $arg );
}


sub hash_popuser
{
	my $user = shift;
	my $path = "";

	$path = substr( $user , 0 , 1 ) . "/" . $user ;

	return( $path );
}

sub old_hash
{
	use Digest::MD5 qw(md5 md5_hex md5_base64);
	my $servername = shift;
	my $hash = md5_hex( $servername );
	my $webdir = substr( $hash , 0 , 2 ) . "/" . substr( $hash , 2 , 2 ) . "/" .substr( $hash , 4 , 2 ) . "/" . substr( $hash , 6 , 2 ) . "/" . substr( $hash , 8 , 2 ) . "/" . substr( $hash , 10 , 2 ) . "/" .substr( $hash , 12 , 2 ) . "/" .substr( $hash , 14 , 2 ) . "/" . substr( $hash , 16 , 2 ) . "/" .substr( $hash , 18 , 2 ) . "/" . substr( $hash , 20 , 2 ) . "/" . substr( $hash , 22 , 2 ) . "/" . substr( $hash , 24 , 2 ) . "/" .substr( $hash , 26 , 2 ) . "/" .substr( $hash , 28 , 2 ) .  "/" .substr( $hash , 30 , 2 ) .  "/" .$servername;

	return( $webdir );
}


sub hash_webdir
{
	use Digest::MD5 qw(md5 md5_hex md5_base64);
	my $servername = shift;
	my $hash = md5_hex( $servername );
	my $webdir = substr( $hash , 0 , 2 ) . "/" . substr( $hash , 2 , 2 ) . "/" .substr( $hash , 4 , 2 ) . "/" .$servername;

	return $webdir;
	
}

sub create_dir
{
	my $dir = shift;

	my $value;

	my @subdirs = split( /\// , $dir );
	@subdirs = reverse @subdirs;
                
	my $path = "";
               
	while( defined ( $value = pop ( @subdirs ) )  )
	{
		$path .= "/".$value if( $value ne '' );
		mkdir( $path ) if( ! -d $path );
	}

	return -1 unless -d $dir;
	return 0;
}


sub stripslashes
{
    my $string = shift;

    $string =~ s/\\//g;
    $string =~ s/\Q//g;

    return ( $string  );
}

sub addslashes
{
	my $string = shift;

	return( quotemeta( $string ) );
}

=head2 chmod_recur

    Vhffs::Functions::chmod_recur($dir, $fmod, $dmod);

Changes permissions on files and directories recursively.
C<$fmod> and C<$dmod> are the mod to apply to files and
directory, respectively. See the documentation of the
original C<chmod> function for more information.

=cut

sub chmod_recur {
    my ($dir, $fmod, $dmod) = @_;

    my @files = ( $dir );
    my $file;

    while( $file = shift @files ) {
        if( -d $file ) {
            chmod( $dmod, $file );
            opendir DIRECTORY, $file;
            my @content = readdir( DIRECTORY );
            closedir( DIRECTORY );
            foreach my $item ( @content ) {
                next if( $item eq '' or $item eq '..' or $item eq '.' );
                push @files, $file.'/'.$item;
            }
        }
        else {
            chmod( $fmod, $file );
        }
    }
}

# Change the owner and groupe recursivly for a dir
sub change_owner_recur
{
    my $dir = shift;
    my $uid = shift;
    my $gid = shift;

    my @files = ($dir);
    my $f;
    
    while( defined($f = shift @files) ) {
        chown( $uid, $gid, $f );
        if( -d $f ) {
            opendir( DIRECTORY, $f );
            my @content = readdir( DIRECTORY );
            closedir( DIRECTORY );
            foreach my $item ( @content ) {
                next if( $item eq '' or $item eq '..' or $item eq '.' );
                push @files, $f.'/'.$item;
            }
        }
    }

    return 1;
}



sub send_mail
{
	use MIME::Lite;
	use MIME::Base64;
	use Encode;
	use Crypt::GPG;

	my $vhffs = shift;
	my $from = shift;
	my $to = shift;
	my $mailtag = shift;
	my $subject = shift;
	my $message = shift;
	my $precedence = shift;

	chomp $message;
	$message .= "\n";

	my ( $gpgbin , $gpgconf );
	if( defined $vhffs->get_config->get_gpg && defined $vhffs->get_config->get_gpg->{'gpg_bin'} ) {
		$gpgbin = $vhffs->get_config->get_gpg->{'gpg_bin'};
		my ( $cleanfrom ) = ( $from =~ /<(.+)>/ );
		$gpgconf = $vhffs->get_config->get_gpg->{ $cleanfrom || $from };
	}

	$subject = $mailtag.' '.$subject if defined $mailtag;
	$subject = Encode::encode_utf8( $subject );
	$subject = '=?UTF-8?B?'.MIME::Base64::encode_base64( $subject , '' ).'?=';
	$message = Encode::encode_utf8( $message );

	if( defined $gpgconf ) {

		my $msg = new MIME::Lite(
			From        => $from,
			To          => $to,
			Subject     => $subject,
			Type        => 'multipart/signed; micalg=pgp-sha1; protocol="application/pgp-signature"',
			Disposition => 'inline'
			);
		$msg->add('Precedence' => $precedence) if defined $precedence;

		my $data = $msg->attach(
			Type => 'text/plain; charset=utf-8',
			Encoding => '8bit',
			Disposition => 'inline',
			Data => $message
			);

		$ENV{'GNUPGHOME'} = $gpgconf->{'gnupghome'};
		my $gpg = new Crypt::GPG;
		$gpg->gpgbin( $gpgbin );
		$gpg->secretkey( $gpgconf->{'secretkey'} );
		$gpg->passphrase( $gpgconf->{'passphrase'} );
		my $sign;
		eval{ $sign = $gpg->sign( $data->as_string ); };
		if( defined $sign ) {
			my $signature = $msg->attach(
				Type => 'application/pgp-signature; name="signature.asc"',
				Encoding => '7bit',
				Disposition => 'inline',
				Data => $sign
				);
			$signature->attr( 'content-description' => 'Digital signature' );

			$msg->send;
		} else {
			undef $gpgconf;
		}
	}

	unless( defined $gpgconf ) {

		my $msg = new MIME::Lite(
			From    => $from,
			To      => $to,
			Subject => $subject,
			Type    => 'text/plain; charset=utf-8',
			Encoding => '8bit',
			Data    => $message
			);
		$msg->add('Precedence' => $precedence) if defined $precedence;

		$msg->send;
	}

	return 1;
}


sub obfuscate_email($$) {
    my ($vhffs, $mail) = @_;

    my $tech = $vhffs->get_config->get_panel->{'mail_obfuscation'} || 'none';
    
    return $mail if($tech eq 'none');
    if($tech eq 'simple') {
        $mail =~ s/@/ AT REMOVEME /g;
        $mail =~ s/\./ DOT /g;
        return $mail;
    }
    if($tech eq 'entities') {
        my @chars = split //, $mail;
        $mail = '';
        foreach(@chars) {
            if($_ eq '@') {
                $mail .= '&#64;';
            } else {
                my $ord = ord($_);
                if( ($ord >= ord('a') && $ord <= ord('z') ) 
                    || ($ord >= ord('A') && $ord <= ord('Z') ) ) {
                    $mail .= "&#$ord;";
                } else {
                    $mail .= $_;
                }
            }
        }
        return $mail;
    }
    if($tech eq 'javascript') {
        return js_encode_mail($mail);
    }
	if($tech eq 'swap')  {
		my @both = split /@/, $mail;
		return $both[1].'/'.$both[0];
	}

    return "Unsupported email obfuscation method !\n";
}

=head2 js_encode_mail

This function does the opposite of the JS function decode_mail.

=cut

sub js_encode_mail($) {
    my $clear = shift;
    my $crypted = '';
    my @chars = split //, $clear;
    foreach(@chars) {
        my $c = chr(ord($_) + 1);
        if($c eq "'") {
            $crypted .= '\\\'';
        } else {
            $crypted .= $c;
        }
    }

    return '<script type="text/javascript">document.write(decode_mail(\''.$crypted.'\'));</script>';
}

#Connect to the database
sub db_connect
{
    my $backend_config;
    my $dbparams;
    my $dbh;
    my $driver;
	my $port;
	my $host;


    ($backend_config) = @_;

	if( ! defined $backend_config )
	{
		print "Oops!: I wonder if I am blind but I cannot find the backend area in the vhffs configuration file :/, could you help me ?\n";
		exit -1;
	}

	#Default port;

    if( $backend_config->{'driver'} =~  /pg/ )
    {
		$port 	= 5432;
    	$driver = "Pg";
		$host 	= "localhost";
		$port 	= $backend_config->{'db_port'} if( defined( $backend_config->{'db_port'} ) );
		$host 	= $backend_config->{'db_host'} if( defined( $backend_config->{'db_host'} ) );

		$dbparams = "dbname=$backend_config->{'db_name'};host=$host;port=$port";
        $dbh = DBI->connect("DBI:$driver:$dbparams",$backend_config->{'db_username'}, $backend_config->{'db_password'}) || (warn "Cant connect: $DBI::errstr\n" and return undef);
        $dbh->{pg_enable_utf8}=1;
        
        return( $dbh );
    }
    
    else
    {
        print "Oops!: The backend you specify in your config file is not supported in Vhffs\n";
        exit -1;
    }
}

sub generate_random_password
{
    my $password;
    for (0 .. 7) { $password .= ('a'..'z', 'A'..'Z', '0'..'9')[int rand 62] ; }
    return $password;
}


sub password_encrypt
{
    use Crypt::PasswdMD5;

    my $password = shift;

    my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[map {rand 64} (1..8)];
    return unix_md5_crypt($password, $salt);
}



sub hash_homename
{
    my ( $chain , $path , $main );
    $chain = shift;
    $main = shift;
        
    return undef if( ! defined $main->get_config->get_datadir );

    $path = $main->get_config->get_datadir. "/home/" . substr( $chain , 0 , 
                   1 ) . "/" . substr( $chain , 1 , 1 ) . "/" . $chain;    

    return( $path );
}


sub hash_groupname
{
    my ( $chain , $path , $main );
    $chain = shift;
    $main = shift;
        
    return undef if( ! defined $main->get_config->get_datadir );

    $path = $main->get_config->get_datadir. "/groups/" . substr( $chain , 0 , 1 ) . "/" . substr( $chain , 1 , 1 ) . "/" . $chain;    

    return( $path );
}


sub valid_mail
{
	my $mail = shift;

	my ( $localpart , $domain ) = ( $mail =~ /(.+)\@(.+)/ );
	return 0 unless Vhffs::Functions::check_domain_name( $domain );

	use Email::Valid;
	return 1 if( Email::Valid->rfc822 ( $mail ) );
	return 0;
}

sub status_string_from_status_id($) {
    my $status = shift;
    return gettext($STATUS_STRINGS[$status] or 'Unknown');
}

sub type_string_from_type_id($) {
    my $type = shift;
    return gettext($TYPES_STRINGS[$type] or 'Unknown');
}

sub mail_template
{
	my( $user , $keys , $template , $file , $content , $line , $key , $vhffs );
	$vhffs		= shift;
	$template 	= shift;
	$user 		= shift;
	$keys		= shift;

	$file = Vhffs::Constants::MAILS_DIR . "/" . $template;

	return( -1 ) if( ! defined $user );

	return( -1 ) if( ! -f $file );
	return( -1 ) if( ! -r $file );

	$content = "";

	open( FIC , $file );

	while( $line = <FIC> )
	{
		foreach $key ( keys %{$keys} )
		{
			$line =~ s/$key/$keys->{$key}/g;
		}
		$content .= $line;
	}

	if( send_mail( $vhffs , $keys->{FROM} , $user->get_mail , $keys->{SUBJECT} , $content ) != 1 )
	{
		return( -2 );
	}

	close( FIC );



	return( 1 );
}

=pod

=head2 check_domain_name

    die "Domain name is invalid (you can't use FQDN)\n" unless(Vhffs::Function::check_domain_name($name));
    die "Domain name is invalid (could be FQDN or not)\n" unless(Vhffs::Function::check_domain_name($name, 1));

Checks for domain name validity.

=cut

sub check_domain_name($;$) {
    my $domain_name = shift;
    my $fqdn = shift;
    $domain_name =~ s/\.$// if($fqdn);
    return (defined $domain_name && length($domain_name) >= 5 && $domain_name =~ /^(?:[a-z0-9\-]{1,63}[.])+([a-z0-9]{2,10})$/);
}

sub check_ip($) {
    my $ip = shift;
    return (defined $ip && $ip =~ /^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$/);
}

sub check_ipv6($) {
    my $ip = shift;
    return (defined $ip && $ip =~ /^((([0-9A-Fa-f]{1,4}:){7}[0-9A-Fa-f]{1,4})|(([0-9A-Fa-f]{1,4}:){6}:[0-9A-Fa-f]{1,4})|(([0-9A-Fa-f]{1,4}:){5}:([0-9A-Fa-f]{1,4}:)?[0-9A-Fa-f]{1,4})|(([0-9A-Fa-f]{1,4}:){4}:([0-9A-Fa-f]{1,4}:){0,2}[0-9A-Fa-f]{1,4})|(([0-9A-Fa-f]{1,4}:){3}:([0-9A-Fa-f]{1,4}:){0,3}[0-9A-Fa-f]{1,4})|(([0-9A-Fa-f]{1,4}:){2}:([0-9A-Fa-f]{1,4}:){0,4}[0-9A-Fa-f]{1,4})|(([0-9A-Fa-f]{1,4}:){6}((\b((25[0-5])|(1\d{2})|(2[0-4]\d)|(\d{1,2}))\b)\.){3}(\b((25[0-5])|(1\d{2})|(2[0-4]\d)|(\d{1,2}))\b))|(([0-9A-Fa-f]{1,4}:){0,5}:((\b((25[0-5])|(1\d{2})|(2[0-4]\d)|(\d{1,2}))\b)\.){3}(\b((25[0-5])|(1\d{2})|(2[0-4]\d)|(\d{1,2}))\b))|(::([0-9A-Fa-f]{1,4}:){0,5}((\b((25[0-5])|(1\d{2})|(2[0-4]\d)|(\d{1,2}))\b)\.){3}(\b((25[0-5])|(1\d{2})|(2[0-4]\d)|(\d{1,2}))\b))|([0-9A-Fa-f]{1,4}::([0-9A-Fa-f]{1,4}:){0,5}[0-9A-Fa-f]{1,4})|(::([0-9A-Fa-f]{1,4}:){0,6}[0-9A-Fa-f]{1,4})|(([0-9A-Fa-f]{1,4}:){1,7}:))$/);
}

sub rotate_log
{
	use File::Basename;

	my $path = shift;
	my $rotation = shift;
	my $compress = shift;
	my $dir = dirname ( $path );
	my $file = basename ( $path );

	return if ( ! -f $path );

	# remove files out of the rotation
	opendir ( DIR , $dir );
	my @files = readdir( DIR );
	foreach ( @files )
	{
		next if( $file ne substr($_, 0, length( $file ) ) );
		my $suffix = substr($_, length( $file ) );
		$suffix =~ s/^.//;
		$suffix =~ s/.gz$//;
		next if( ! ( $suffix =~ /\d+/ ) );
		unlink $dir."/".$_ if( $suffix >= $rotation-1 );
	}

	# rotate logs
	my $i;
	for ( $i = $rotation-2 ; $i >= 0 ; $i-- )  {
		my $j = $i +1;

		# found a file which is not compressed
		if ( -f $dir."/".$file.".".$i )  {

			# rotate it
			rename $dir."/".$file.".".$i , $dir."/".$file.".".$j ;
	
			# compress it if compression is enabled
			if ( $compress )  {
				my $cmd = "gzip ".$dir."/".$file.".".$j;
				system ( $cmd );
			}
		}
		# found a file which is already compressed
		elsif ( -f $dir."/".$file.".".$i.".gz" )  {

			# rotate it
			rename $dir."/".$file.".".$i.".gz" , $dir."/".$file.".".$j.".gz" ;

			# uncompress it if compression is disabled
			if ( ! $compress )  {
				my $cmd = "gzip -d ".$dir."/".$file.".".$j.".gz";
				system ( $cmd );
			}
		}
	}

	# last rotate, log -> log.0
	rename $dir."/".$file , $dir."/".$file.".0" ;

	# create an empty file (prevent re-using of file .0 in stats parser)
	open( EMPTYFILE , "> ".$dir."/".$file );
	print EMPTYFILE "";
	close( EMPTYFILE );
}


# read a file and put each line in a @
sub readfile
{
	my $file = shift;
	my $l;

	return undef unless( defined $file  &&  -f $file );

	open MYFILE , $file;
	while( <MYFILE> )  {
		chomp;
		push( @{$l} , $_ );
	}
	close MYFILE;
	return $l;
}

1;
