# ClamTk, copyright (C) 2004-2010 Dave M
#
# This file is part of ClamTk.
#
# ClamTk is free software; you can redistribute it and/or modify it
# under the terms of either:
#
# a) the GNU General Public License as published by the Free Software
# Foundation; either version 1, or (at your option) any later version, or
#
# b) the "Artistic License".
package ClamTk::Prefs;

use strict;
#use warnings;    # disabled upon release
$|++;

use ClamTk::App;

use encoding 'utf8';

use File::Path;
use Locale::gettext;
use POSIX qw/locale_h/;
textdomain('clamtk');
setlocale( LC_MESSAGES, '' );
bind_textdomain_codeset( 'clamtk', 'UTF-8' );

sub structure {
    my $paths = ClamTk::App->get_path('all');

    # Ensure default paths/files exist.
    # If they do, ensure they have the proper permissions
    if ( !-d $paths->{viruses} ) {
        # This is typically /home/user/.clamtk/viruses,
        # used for the quarantine directory
        eval { mkpath( $paths->{viruses}, 0, oct(755) ); };
        return 0 if ($@);
    } else {
        # Ensure the permissions are correct
        chmod oct(755), $paths->{viruses};
    }
    if ( !-d $paths->{history} ) {
        # This is typically /home/user/.clamtk/history,
        # which holds records of scans
        eval { mkpath( $paths->{history}, 0, oct(755) ); };
        return 0 if ($@);
    } else {
        # Ensure the permissions are correct
        chmod oct(755), $paths->{history};
    }
    if ( !-d $paths->{db} ) {
        # This is typically /home/user/.clamtk/db
        eval { mkpath( $paths->{db}, 0, oct(755) ); };
        warn $@  if $@;
        return 0 if ($@);
    } else {
        # Ensure the permissions are correct
        chmod oct(755), $paths->{db};
    }
    if ( !-e $paths->{prefs} ) {
        # This is /home/user/.clamtk/prefs,
        # a custom INI-style file
        open( my $F, ">:encoding(UTF-8)", $paths->{prefs} )
            or do {
            warn "Unable to create preferences! $!\n";
            return 0;
            };
        close($F);
        eval { custom_prefs() };
        return 0 if ($@);
    }
    if ( !-e $paths->{restore} ) {
        # This is /home/user/.clamtk/restore, which holds
        # information for putting back false positives
        open( my $F, ">:encoding(UTF-8)", $paths->{restore} )
            or do {
            warn "Unable to create restore file! $!\n";
            return 0;
            };
        close($F);
    }
    return 1;
}

sub custom_prefs {
   # ensure prefs have normalized variables, especially for 3.11 -> 4.00 users
    my %pkg;
    # Get the user's current prefs
    my $paths = ClamTk::App->get_path('prefs');

    open( my $F, "<:encoding(UTF-8)", $paths )
        or do {
        warn "Unable to read preferences! $!\n";
        return 0;
        };

    while (<$F>) {
        my ( $k, $v ) = split(/=/);
        chomp($v);
        $pkg{$k} = $v;
    }
    close($F);

    # If the preferences aren't already set,
    # use 'shared' by default. This makes it work out of the box.
    if ( !exists $pkg{Update} ) {
        $pkg{Update} = 'shared';
    } elsif ( $pkg{Update} !~ /shared|single/ ) {
        # If it's set to 'shared' or 'single', leave it alone.
        # Otherwise, look for system signatures.
        $pkg{Update} = 'shared';
    }

    # The proxy is off by default
    if ( !exists $pkg{HTTPProxy} ) {
        $pkg{HTTPProxy} = 0;
    }

    # The whitelist is off by default
    if ( !exists $pkg{Whitelist} ) {
        $pkg{Whitelist} = '';
    }

    for my $n (qw/LastScan LastInfection/) {
        if ( !exists $pkg{$n} ) {
            $pkg{$n} = gettext('Never');
        }
    }

    for my $o (
        qw/SaveToLog ScanHidden SizeLimit
        Thorough Recursive/
        )
    {
        if ( !exists $pkg{$o} ) {
            $pkg{$o} = 0;    # off by default
        }
    }

    for my $p (qw/OpenDNS AVCheck GUICheck TruncateLog/) {
        if ( !exists $pkg{$p} ) {
            $pkg{$p} = 1;    # on by default
        }
    }
    write_all(%pkg);
    return;
}

sub get_all_prefs {
    # Sometimes it's useful to have all
    # the preferences rather than just one.
    my %pkg;
    my $paths = ClamTk::App->get_path('prefs');
    open( my $F, "<:encoding(UTF-8)", $paths )
        or do {
        warn "Unable to read preferences! $!\n";
        return 0;
        };

    while (<$F>) {
        my ( $k, $v ) = split(/=/);
        chomp($v);
        $pkg{$k} = $v;
    }
    close($F);
    return %pkg if %pkg;
}

sub write_all {
    my %loc = @_;

    my $paths = ClamTk::App->get_path('prefs');
    open( my $F, ">:encoding(UTF-8)", $paths )
        or do {
        warn "Unable to write preferences! $!\n";
        return 0;
        };

    while ( my ( $k, $v ) = each %loc ) {
        print $F "$k=$v\n";
    }
    close($F);

    return 1;
}

sub set_preference {
    my ( undef, $wk, $wv ) = @_;    # undef = package name
    my $paths = ClamTk::App->get_path('prefs');

    open( my $F, "<:encoding(UTF-8)", $paths )
        or do {
        warn "Unable to read preferences! $!\n";
        return 0;
        };

    my %pkg;
    while (<$F>) {
        my ( $k, $v ) = split(/=/);
        chomp($v);
        $pkg{$k} = $v;
    }
    close($F);

    open( $F, ">:encoding(UTF-8)", $paths )
        or return -1;

    while ( my ( $k, $v ) = each %pkg ) {
        print $F "$k=$v\n" unless ( $k eq $wk );
    }
    print $F "$wk=$wv\n";
    close($F)
        or warn "Couldn't close $paths: $!\n";
    return 1;
}

sub get_preference {
    my ( undef, $wanted ) = @_;    # undef = package name

    my $paths = ClamTk::App->get_path('prefs');
    my %pkg;
    open( my $F, "<:encoding(UTF-8)", $paths )
        or do {
        warn "Unable to read preferences! $!\n";
        return 0;
        };

    while (<$F>) {
        my ( $k, $v ) = split(/=/);
        chomp($v);
        $pkg{$k} = $v;
    }
    close($F);

    return unless %pkg;
    return $pkg{$wanted} || '';
}

sub set_proxy {
    my ( undef, $ip, $port ) = @_;    # undef = package name
           # If the user doesn't set a port, we'll just jot down port 80.
    $port = $port || '80';

    my $path = ClamTk::App->get_path('db');

    # I'm going to clobber this every time.
    # Doesn't need to be utf-8 friendly. I think.
    open( my $FH, '>', "$path/local.conf" )
        or return -1;
    print $FH <<"EOF";
HTTPProxyServer $ip
HTTPProxyPort $port
DatabaseMirror db.local.clamav.net
DatabaseMirror database.clamav.net
EOF
    close($FH)
        or warn "Couldn't close $path/local.conf: $!\n";
    return 1;
}

sub restore {
    shift;    # throw one away
    my $wanted = shift;    # the md5sum of the file we're after
    my $job    = shift;    # either exists, add, or remove
    my $path   = shift;    # full path of file
    my $perm   = shift;    # permissions in octal (eg., 0644)

    my %p;
    my $restore_path = ClamTk::App->get_path('restore');

    open( my $F, "<:encoding(UTF-8)", $restore_path ) or do {
        warn "Can't open restore file for reading: $!\n";
        return -1;
    };

    while (<$F>) {
        chomp;
        my ( $m, $paths, $perms ) = split /:/;
        if ( exists $p{$m} ) {
            #warn "File $m already exists?\n";
            return -1;
        }
        $p{$m} = { path => $paths, perm => $perms };
    }
    close($F)
        or warn "Couldn't close $restore_path: $!\n";

    if ( $job eq 'exists' ) {
        for my $e ( keys %p ) {
            if ( $e eq $wanted ) {
                return ( $p{$e}->{path}, $p{$e}->{perm} );
            }
        }
        return -1;
    }

    if ( $job eq 'add' ) {
        if ( exists( $p{$wanted} ) ) {
            #warn "File $wanted already exists?\n";
            return -1;
        }
        open( $F, ">:encoding(UTF-8)", $restore_path ) or do {
            warn "Can't open restore file for writing: $!\n";
            return -1;
        };

        if ( scalar( keys %p ) ) {
            for my $e ( keys %p ) {
                print $F $e, ":", $p{$e}->{path}, ":", $p{$e}->{perm}, "\n";
            }
        }
        print $F "$wanted:$path:$perm\n";
        close($F);
    }

    if ( $job eq 'remove' ) {
        open( $F, ">:encoding(UTF-8)", $restore_path ) or do {
            warn "Can't open restore file for writing: $!\n";
            return -1;
        };

        for my $e ( keys %p ) {
            next if ( $e eq $wanted );
            print $F $e, ":", $p{$e}->{path}, ":", $p{$e}->{perm}, "\n";
        }
        close($F)
            or warn "Couldn't close $restore_path: $!\n";
    }
    return;
}

sub restore_file_fix {
    # This subroutine might only be in 4.25; for some reason the line
    # 'next if ($e eq $wanted)' got dropped from 'sub restore' above.
    # So, we need to remove all the lines from the restore file that
    # don't have coresponding viruses in the quarantine directory.

    my $restore    = ClamTk::App->get_path('restore');
    my $quarantine = ClamTk::App->get_path('viruses');
    return unless ( -e $restore && -e $quarantine );

    use Digest::MD5 qw/md5_hex/;

    # First, grab everything quarantined.
    my @viruses = glob "$quarantine/*";

    # Now, grab their md5sums
    my %p;
    for my $f (@viruses) {
        my $ctx = Digest::MD5->new;
        open( my $G, '<', $f ) or next;
        $ctx->addfile(*$G);
        my $md5 = $ctx->hexdigest;
        close($G)
            or warn "Couldn't close $f: $!\n";
        $p{$md5} = $f;
    }

    # Now grab the md5sums the restore file says we have
    my %q;
    open( my $F, "<:encoding(UTF-8)", $restore )
        or return;
    while (<$F>) {
        chomp;
        my ( $m, undef, undef ) = split /:/;
        $q{$m} = 1;
    }
    close($F)
        or warn "Couldn't close $restore: $!\n";

    # Go through the keys (md5s) of the restore file;
    # remove the records of those that don't exist.
    for my $k ( keys %q ) {
        unless ( exists $p{$k} ) {
            ClamTk::Prefs->restore( $k, 'remove' );
        }
    }
    return;
}

1;