#!/usr/bin/perl
# qutebrowser-cookiecleaner
# Copyright (C) Eskild Hustvedt 2018
#
# 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 3 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
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
use 5.014;
use warnings;
use DBI;
use List::Util 1.33 qw(all);
use File::Basename qw(basename);
use Getopt::Long;
use File::Glob qw(bsd_glob);
use constant {
    V_INFO => 1,
};

my $VERSION = 0.1;
my $verbosity = 0;
my $XDG_DATA_HOME = $ENV{XDG_DATA_HOME} ? $ENV{XDG_DATA_HOME} : $ENV{HOME}.'/.local/share';
my $XDG_CONFIG_HOME = $ENV{XDG_CONFIG_HOME} ? $ENV{XDG_CONFIG_HOME} : $ENV{HOME}.'/.config';

# Output something in verbose mode
sub sayv
{
    my $level = shift;
    if ($verbosity >= $level)
    {
        say(@_);
    }
}

# Retrieve a database handle
sub DBH
{
    my $dbfile = $XDG_DATA_HOME.'/qutebrowser/webengine/Cookies';
    if (!-e $dbfile)
    {
        die($dbfile.': does not exist'."\n");
    }
    my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile",'','');

    return $dbh;
}

# Expire cookies, local storage, IndexedDB and databases, except those whitelisted
sub expireContent
{
    my $dbh = DBH();

    my @statements;
    my @exceptions;
    my @whitelist;

    open(my $i,'<',$XDG_CONFIG_HOME.'/qutebrowser-cookiecleaner.list');
    my $no = 0;
    while (my $line = <$i>)
    {
        $no++;
        next if $line =~ /^\s*#/;
        chomp($line);
        if (index($line,'%') != -1)
        {
            die('Line  '.$no.' contains forbidden character "%"'."\n");
        }
        push(@exceptions,'%'.$line);
        push(@statements,'host_key NOT LIKE ?');
        push(@whitelist,$line);
    }
    close($i);

    if(scalar @exceptions == 0)
    {
        die('Your qutebrowser-cookiecleaner.list file has no exceptions. Refusing to continue.'."\n");
    }

    # --
    # Cookies
    # --

    my $sth;

    my $deleteStatement = 'DELETE FROM cookies WHERE '.join(' AND ',@statements);
    my $deletedEntriesStatement = 'SELECT * FROM cookies WHERE '.join(' AND ',@statements);

    # If verbose mode is on, we need more information, so fetch and output the
    # entries we will delete.
    if ($verbosity > 0)
    {
        $sth = $dbh->prepare($deletedEntriesStatement);
        $sth->execute(@exceptions);

        while(my $entry = $sth->fetchrow_hashref)
        {
            sayv(V_INFO,'Deleting "'.$entry->{name}.'" for "'.$entry->{host_key}.'"');
        }
    }

    $sth = $dbh->prepare($deleteStatement);
    $sth->execute(@exceptions);

    $sth = $dbh->prepare('VACUUM;');
    $sth->execute();

    $dbh->disconnect;

    # --
    # Localstorage
    # --

    my $localstorageDir = $XDG_DATA_HOME.'/qutebrowser/webengine/Local Storage/*.localstorage';

    foreach my $file (bsd_glob($localstorageDir))
    {
        if(all { index(basename($file),$_) == -1 } @whitelist )
        {
            sayv(V_INFO,'Deleting Local Storage file '.basename($file));
            unlink($file);
            if (-e $file.'-journal')
            {
                unlink($file.'-journal');
            }
        }
    }

    foreach my $dirEntry (qw(IndexedDB databases))
    {
        my $dirsGlob = $XDG_DATA_HOME.'/qutebrowser/webengine/'.$dirEntry.'/*';

        foreach my $dir (bsd_glob($dirsGlob))
        {
            next if ! -d $dir;
            if(all { index(basename($dir),$_) == -1 } @whitelist )
            {
                sayv(V_INFO,'Deleting '.$dirEntry.' for '.basename($dir));
                unlink(bsd_glob($dir.'/*')) or die("Unlink error for subtree: $dir: $!\n");
                rmdir($dir) or die("Failed to rmdir $dir: $!\n");
            }
        }
    }
}

# Main function. Command-line parsing.
sub main
{
    my $wrap = 0;

    GetOptions(
        'help' => sub {
            say 'qutebrowser-cookiecleaner version '.$VERSION;
            say "";
            say "Usage: qutebrowser-cookiecleaner [OPTIONS]";
            say "";
            say "Options:";
            say "  -v, --verbose     Increase verbosity";
            say "      --help        Show this help screen";
            say "      --wrap        Wrap another command, cleaning on start and";
            say "                    exit. See README.md for details.";
            exit(0);
        },
        'wrap' => \$wrap,
        'version' => sub
        {
            print 'qutebrowser-cookiecleaner version '.$VERSION."\n";
            exit(0);
        },
        'v|verbose+' => \$verbosity,
    ) or do
    {
        if ($wrap)
        {
            warn('Maybe you need to add -- after --wrap (--wrap --)?'."\n")
        }
        die('See --help for more information'."\n");
    };


    if ($wrap)
    {
        if(scalar @ARGV == 0)
        {
            die('--wrap requires additional parameters: the command to run'."\n");
        }
        $0 = 'qutebrowser-cookiecleaner: cleaning';
        expireContent();
        $0 = 'qutebrowser-cookiecleaner: waiting for '.join(' ',@ARGV);
        system(@ARGV);
        if ($? == -1)
        {
            die('Failed to execute subprocess '.join(' ',@ARGV).': '.$!."\n");
        }
        $0 = 'qutebrowser-cookiecleaner: cleaning';
    }
    elsif(scalar @ARGV != 0)
    {
        die('Unknown parameters: '.join(' ',@ARGV)."\nDid you mean to use --wrap?\n");
    }

    expireContent();
}

main();