bisc 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+130/−57 lines, 3 filesdep +configuratordep +mtl
Dependencies added: configurator, mtl
Files
- Main.hs +78/−55
- README.md +42/−0
- bisc.cabal +10/−2
Main.hs view
@@ -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" []
+ README.md view
@@ -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 <http://www.gnu.org/licenses/>.
bisc.cabal view
@@ -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