diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -3,19 +3,28 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE FlexibleContexts #-} -import System.Environment.XDG.BaseDir (getUserDataDir, getUserConfigDir) -import System.FilePath (joinPath, takeBaseName, ()) -import System.IO (readFile) -import System.Directory (removeFile, getDirectoryContents, doesFileExist) -import Control.Monad (mapM_, filterM) -import Data.List (nub) -import Data.Maybe (mapMaybe) -import Data.Monoid ((<>)) +import Data.List (nub) +import Data.Maybe (mapMaybe) +import Data.Configurator +import Control.Monad (mapM_, filterM) +import Control.Monad.Reader (ReaderT, runReaderT, asks) +import System.FilePath (joinPath, takeBaseName, ()) +import System.Directory (removeFile, getDirectoryContents, doesFileExist) +import System.IO (readFile) + import Database.Selda import Database.Selda.SQLite -import qualified Data.Text as T -import qualified Data.Text.IO as T +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified System.Environment.XDG.BaseDir as X + + +data Settings = Settings + { whitelistPath :: FilePath + , webenginePath :: FilePath + } + data Cookie = Cookie { host_key :: Text , creation_utc :: Int @@ -23,40 +32,43 @@ instance SqlRow Cookie -cookies :: Table Cookie -cookies = table "cookies" [] +type Action = ReaderT Settings IO -databasePath :: IO FilePath -databasePath = do - datadir <- getUserDataDir "qutebrowser" - return $ joinPath [datadir, "webengine", "Cookies"] -localStorePath :: IO FilePath -localStorePath = do - datadir <- getUserDataDir "qutebrowser" - return $ joinPath [datadir, "webengine", "Local Storage"] - -whitelistPath :: IO FilePath -whitelistPath = do - configdir <- getUserConfigDir "qutebrowser" - return $ joinPath [configdir, "whitelists", "cookies"] +main :: IO () +main = do + config <- X.getUserConfigFile "bisc" "bisc.conf" + settings <- loadSettings config + runReaderT clean settings -prettyPrint :: [Text] -> Text -prettyPrint = T.unlines . bullet - where bullet = map (" * " <>) +clean :: Action () +clean = do + path <- asks whitelistPath + whitelist <- liftIO (T.lines <$> T.readFile path) + (n, bad) <- deleteCookies whitelist + if (n > 0) + then do + log ("Cookies: deleted " <> num n <> " from:") + log (prettyPrint bad) + else log ("Cookies: nothing to delete.") + (n, bad) <- deleteData whitelist + if (n > 0) + then do + log ("Persistent data: deleted " <> num n <> " entries:") + log (prettyPrint bad) + else log ("Persistent data: nothing to delete.") -getDirectoryFiles :: FilePath -> IO [FilePath] -getDirectoryFiles path = map (path ) <$> - getDirectoryContents path >>= filterM doesFileExist + where log = liftIO . T.putStrLn + num = T.pack . show -deleteCookies :: [Text] -> IO (Int, [Text]) +deleteCookies :: [Text] -> Action (Int, [Text]) deleteCookies domains = do - database <- databasePath - withSQLite database $ do + database <- ( "Cookies") <$> asks webenginePath + liftIO $ withSQLite database $ do bad <- query $ do cookie <- select cookies restrict (by whitelist cookie) @@ -68,13 +80,17 @@ whitelist = map text domains -deleteLocalStore :: [Text] -> IO (Int, [Text]) -deleteLocalStore whitelist = do - entries <- getDirectoryFiles =<< localStorePath +deleteData :: [Text] -> Action (Int, [Text]) +deleteData whitelist = do + webengine <- asks webenginePath + appCache <- liftIO $ getDirectoryFiles (webengine "Application Cache") + indexedDB <- liftIO $ getDirectoryFiles (webengine "IndexedDB") + localStorage <- liftIO $ getDirectoryFiles (webengine "Local Storage") let + entries = appCache ++ indexedDB ++ localStorage badFiles = filterMaybe (fmap unlisted . domain) entries badDomains = mapMaybe domain badFiles - mapM_ removeFile badFiles + liftIO $ mapM_ removeFile badFiles return (length badFiles, nub badDomains) where maybeToBool :: Maybe Bool -> Bool @@ -94,22 +110,29 @@ unlisted = not . (`elem` whitelist) -main :: IO () -main = do - whitelist <- T.lines <$> (T.readFile =<< whitelistPath) - (n, bad) <- deleteCookies whitelist - if (n > 0) - then do - log ("Cookies: deleted " <> num n <> " from:") - log (prettyPrint bad) - else log ("Cookies: nothing to delete.") +loadSettings :: FilePath -> IO Settings +loadSettings path = do + configdir <- X.getUserConfigDir "qutebrowser" + datadir <- X.getUserDataDir "qutebrowser" + let + defaultWhitelist = joinPath [configdir, "whitelists", "cookies"] + defaultWebengine = joinPath [datadir, "webengine"] - (n, bad) <- deleteLocalStore whitelist - if (n > 0) - then do - log ("Local storage: deleted " <> num n <> " entries:") - log (prettyPrint bad) - else log ("Local storage: nothing to delete.") + config <- load [Optional path] + whitelist <- lookupDefault defaultWhitelist config "whitelist-path" + webengine <- lookupDefault defaultWebengine config "webengine-path" + return (Settings whitelist webengine) - where log = liftIO . T.putStrLn - num = T.pack . show + +prettyPrint :: [Text] -> Text +prettyPrint = T.unlines . bullet + where bullet = map (" * " <>) + + +getDirectoryFiles :: FilePath -> IO [FilePath] +getDirectoryFiles path = map (path ) <$> + getDirectoryContents path >>= filterM doesFileExist + + +cookies :: Table Cookie +cookies = table "cookies" [] diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,42 @@ +# Bisc +### A small tool that clears qutebrowser cookies + +## Configuration + +The bisc configuration file is `$XDG_CONFIG_HOME/bisc/bisc.conf`. +It allows to change the paths of the QtWebEngine/Chromium +directory and the whitelist file. +The default settings are: +``` +whitelist-path = $(XDG_CONFIG_HOME)/qutebrowser/whitelists/cookies +webengine-path = $(XDG_DATA_HOME)/qutebrowser/webengine +``` + +## Usage + +Create an empty whitelist file and write the domains of the +allowed cookies, one per line. +Eg. +``` +.example.com +example.com +``` + +Run `bisc` to delete all non-whitelisted data from qutebrowser. + +## License + +Copyright (C) 2019 Michele Guerini Rocco + +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 . diff --git a/bisc.cabal b/bisc.cabal --- a/bisc.cabal +++ b/bisc.cabal @@ -1,11 +1,12 @@ name: bisc -version: 0.1.0.0 +version: 0.2.0.0 synopsis: A small tool that clears qutebrowser cookies. description: Bisc clears qutebrowser cookies and javascript local storage by domains, stored in a whitelist. +homepage: https://maxwell.ydns.eu/git/rnhmjoj/bisc license: GPL-3 license-file: LICENSE author: Michele Guerini Rocco @@ -13,12 +14,19 @@ copyright: Copyright (C) 2018 Michele Guerini Rocco category: Utility build-type: Simple +extra-source-files: README.md cabal-version: >=1.10 + +source-repository head + type: git + location: https://maxwell.ydns.eu/git/rnhmjoj/bisc + executable bisc main-is: Main.hs build-depends: base ==4.* , selda ==0.3.*, selda-sqlite ==0.1.*, - xdg-basedir, filepath, directory, text + xdg-basedir, filepath, directory, + text, mtl, configurator default-language: Haskell2010 default-extensions: DeriveGeneric, OverloadedStrings OverloadedLabels, FlexibleContexts