bisc 0.3.1.0 → 0.4.0.0
raw patch · 5 files changed
+283/−72 lines, 5 filesdep +optparse-applicative
Dependencies added: optparse-applicative
Files
- Main.hs +133/−50
- README.md +20/−18
- bisc.cabal +11/−4
- man/bisc.1 +70/−0
- man/bisc.conf.5 +49/−0
Main.hs view
@@ -5,41 +5,87 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -import Data.List (nub, foldl')-import Data.Maybe (mapMaybe)-import Data.Function ((&))-import Data.Default (def)-import Data.Text.Encoding (decodeUtf8)-import Control.Monad (mapM_, when, (>=>))-import Control.Monad.Reader (ReaderT, runReaderT, asks)-import Control.Monad.Except (ExceptT, runExceptT, throwError)-import System.FilePath (joinPath, takeBaseName, (</>))-import Database.Selda (Text, liftIO, (.||), (!))+-- Databases+import Database.Selda (Text, liftIO, (!)) import Database.Selda.SQLite (withSQLite)- import qualified Database.Selda as S import qualified Database.LevelDB as L import qualified Database.LevelDB.Streaming as LS -import Control.Exception as BE-import Control.Monad.Catch as CE+-- Error handling+import Control.Exception as BE+import Control.Monad.Catch as CE+import qualified System.Exit as E -import qualified System.Directory as D-import qualified Data.Configurator as C+-- Configuration+import qualified Options.Applicative as O+import qualified System.Directory as D+import qualified Data.Configurator as C++-- Text converion+import Data.Text.Encoding (decodeUtf8) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.ByteString as B -import Debug.Trace+-- Version information+import qualified Paths_bisc as Bisc+import Data.Version (showVersion) --- | Bisc settings+-- Misc+import Data.List (nub)+import Data.Maybe (mapMaybe)+import Data.Function ((&))+import Data.Default (def)+import Control.Monad (when)+import Control.Monad.Reader (ReaderT, runReaderT, asks)+import Control.Monad.Except (ExceptT, runExceptT, throwError)+import System.FilePath (joinPath, takeBaseName, (</>))+++-- Options++-- | Configuration file settings data Settings = Settings- { whitelistPath :: FilePath -- ^ whitelist file- , webenginePath :: FilePath -- ^ webengine data directory+ { webenginePath :: FilePath -- ^ webengine data directory , whitelist :: [Text] -- ^ whitelisted domains+ , options :: Options -- ^ cli options } +-- | Command line options+data Options = Options+ { version :: Bool -- ^ print version number+ , dryRun :: Bool -- ^ don't delete anything+ , configPath :: FilePath -- ^ config file path+ } +-- | Command line parser+cliParser :: FilePath -> O.ParserInfo Options+cliParser defConfig = O.info (O.helper <*> parser) infos+ where+ parser = Options+ <$> O.switch+ ( O.long "version"+ <> O.short 'v'+ <> O.help "Print the version number and exit"+ )+ <*> O.switch+ ( O.long "dry-run"+ <> O.short 'n'+ <> O.help ("Don't actually remove anything, "<>+ "just show what would be done")+ )+ <*> O.strOption+ ( O.long "config"+ <> O.short 'c'+ <> O.value defConfig+ <> O.help "Specify a configuration file"+ )+ infos =+ O.fullDesc <>+ O.progDesc "A small tool that clears cookies (and more)"++ -- SQL records -- | Just a cookie@@ -68,6 +114,7 @@ quotaOrigins :: S.Table QuotaOrigin quotaOrigins = S.table "OriginInfoTable" [] + -- | Main monad stack -- -- * 'ReaderT' for accessing settings@@ -83,38 +130,63 @@ -- | Clears all means of permanent storage main :: IO () main = do- config <- D.getXdgDirectory D.XdgConfig ("bisc" </> "bisc.conf")- run <- runAction <$> loadSettings config- run "Cookies" deleteCookies- run "QuotaManager" deleteQuotaOrigins- run "IndexedDB" deleteIndexedDB- run "LocalStorage" deleteLocalStorage- run "SessionStorage" deleteSessionStorage+ defConfig <- D.getXdgDirectory D.XdgConfig ("bisc" </> "bisc.conf")+ opts <- O.execParser (cliParser defConfig) + when (version opts) $ do+ putStrLn ("bisc " <> showVersion Bisc.version)+ E.exitSuccess + run <- runAction <$> loadSettings opts+ numFailures <- sum <$> mapM (uncurry run) actions++ if numFailures == 0+ then E.exitSuccess+ else do+ putStrLn ("\nwarning: " <> show numFailures <> " actions have failed")+ E.exitWith (E.ExitFailure numFailures)++ -- | Runs an 'Action' and pretty-prints the results-runAction :: Settings -> Text -> Action Result -> IO ()+runAction :: Settings -> Text -> Action Result -> IO Int runAction settings name x = do a <- BE.try $ runExceptT (runReaderT x settings) case a of- Right (Right res) -> printResult res- Right (Left msg) -> printFailed msg- Left (err :: BE.IOException) -> printFailed (T.pack $ BE.displayException err)+ Right (Right res) -> printResult res >> return 0+ Right (Left msg) -> printFailed msg >> return 1+ Left (err :: BE.IOException) ->+ printFailed (T.pack $ BE.displayException err) >> return 1 where- printFailed msg = T.putStrLn ("- " <> name <> " cleaning failed:\n " <> msg)+ printFailed msg =+ T.putStrLn ("- " <> name <> " cleaning failed:\n " <> msg) printResult (n, bad) | n > 0 = do- T.putStrLn ("- " <> name <> ": deleted " <> T.pack (show n) <> " entries for:")+ T.putStrLn ("- " <> name <> ": " <> verb <>+ " " <> T.pack (show n) <> " entries for:") T.putStrLn (T.unlines $ map (" * " <>) bad) | otherwise = T.putStrLn ("- " <> name <> ": nothing to delete")+ verb = if (dryRun . options $ settings)+ then "would delete"+ else "deleted" -- * Cleaning actions +-- | List of actions and their names+actions :: [(Text, Action Result)]+actions =+ [ ("Cookies", deleteCookies)+ , ("QuotaManager", deleteQuotaOrigins)+ , ("IndexedDB", deleteIndexedDB)+ , ("LocalStorage", deleteLocalStorage)+ , ("SessionStorage", deleteSessionStorage)+ ]+ -- | Deletes records in the Cookies database deleteCookies :: Action Result deleteCookies = do- database <- (</> "Cookies") <$> asks webenginePath+ database <- (</> "Cookies") <$> asks webenginePath+ dry <- asks (dryRun . options) exists <- liftIO $ D.doesFileExist database when (not exists) (throwError "database is missing") @@ -124,8 +196,9 @@ cookie <- S.select cookies S.restrict (by whitelist cookie) return (cookie ! #host_key)- n <- S.deleteFrom cookies (by whitelist)- return (n, nub bad)+ when (not dry) $+ S.deleteFrom_ cookies (by whitelist)+ return (length bad, nub bad) where by set x = S.not_ (x ! #host_key `S.isIn` set) @@ -133,7 +206,8 @@ -- | Deletes records in the QuotaManager API database deleteQuotaOrigins :: Action Result deleteQuotaOrigins = do- database <- (</> "QuotaManager") <$> asks webenginePath+ database <- (</> "QuotaManager") <$> asks webenginePath+ dry <- asks (dryRun . options) exists <- liftIO $ D.doesFileExist database when (not exists) (throwError "database is missing") @@ -143,8 +217,9 @@ quota <- S.select quotaOrigins S.restrict (by whitelist quota) return (quota ! #origin)- n <- S.deleteFrom quotaOrigins (by whitelist)- return (n, nub bad)+ when (not dry) $+ S.deleteFrom_ quotaOrigins (by whitelist)+ return (length bad, nub bad) where -- check if quota is not whitelisted by whitelist quota = S.not_ (S.true `S.isIn` matches)@@ -169,6 +244,7 @@ deleteIndexedDB :: Action Result deleteIndexedDB = do webengine <- asks webenginePath+ dry <- asks (dryRun . options) exists <- liftIO $ D.doesDirectoryExist (webengine </> "IndexedDB") when (not exists) $ throwError "directory is missing" @@ -177,7 +253,8 @@ let badFiles = filterMaybe (fmap unlisted . domain) entries badDomains = mapMaybe domain badFiles- liftIO $ mapM_ D.removePathForcibly badFiles+ when (not dry) $+ liftIO $ mapM_ D.removePathForcibly badFiles return (length badFiles, nub badDomains) where listDirectoryAbs :: FilePath -> Action [FilePath]@@ -193,8 +270,8 @@ domain :: FilePath -> Maybe Text domain = extract . url where extract [] = Nothing- extract (x:[]) = Nothing- extract (x:xs) = Just $ T.unwords (init xs)+ extract (_:[]) = Nothing+ extract (_:xs) = Just $ T.unwords (init xs) url = T.splitOn "_" . T.pack . takeBaseName @@ -219,12 +296,15 @@ version <- withRetryDB path (\db -> L.get db def "VERSION") when (version /= Just "1") (throwError "database is empty or the schema unsupported") + dry <- asks (dryRun . options)+ let delete = if dry then (\_ _ _ -> pure ()) else L.delete+ withDB path $ \db -> do badDomains <- L.withIterator db def $ \i -> LS.keySlice i LS.AllKeys LS.Asc & LS.filter (\k -> "META:" `B.isPrefixOf ` k && (metaDomain k) `notElem` whitelist)- & LS.mapM (\k -> L.delete db def k >> return (metaDomain k))+ & LS.mapM (\k -> delete db def k >> return (metaDomain k)) & LS.toList n <- L.withIterator db def $ \i ->@@ -232,7 +312,7 @@ & LS.filter (\k -> "_" `B.isPrefixOf` k && "\NUL\SOH" `B.isInfixOf` k && (recDomain k) `notElem` whitelist)- & LS.mapM (L.delete db def)+ & LS.mapM (delete db def) & LS.length return (n, badDomains)@@ -264,6 +344,9 @@ version <- withRetryDB path (\db -> L.get db def "version") when (version /= Just "1") (throwError "database is empty or the schema unsupported") + dry <- asks (dryRun . options)+ let delete = if dry then (\_ _ _ -> pure ()) else L.delete+ withDB path $ \db -> do -- map of id -> isBad badMap <- L.withIterator db def $ \i ->@@ -277,7 +360,7 @@ LS.keySlice i LS.AllKeys LS.Asc & LS.filter (B.isPrefixOf "namespace") & LS.filter (isBad whitelist)- & LS.mapM (\k -> L.delete db def k >> return (domain k))+ & LS.mapM (\k -> delete db def k >> return (domain k)) & LS.toList -- and their records@@ -286,7 +369,7 @@ & LS.filter (B.isPrefixOf "map-") & LS.mapM (\k -> case lookup (originId k) badMap of- Just True -> L.delete db def k >> return 1+ Just True -> delete db def k >> return 1 _ -> return 0) & LS.sum return (n, nub badDomains)@@ -319,21 +402,21 @@ else liftIO $ L.repair path def >> withDB path action where msg = T.pack (BE.displayException e) --- | Loads the config from a file-loadSettings :: FilePath -> IO Settings-loadSettings path = do+-- | Loads the config file/cli options+loadSettings :: Options -> IO Settings+loadSettings opts = do configdir <- D.getXdgDirectory D.XdgConfig "qutebrowser" datadir <- D.getXdgDirectory D.XdgData "qutebrowser" let defaultWhitelist = joinPath [configdir, "whitelists", "cookies"] defaultWebengine = joinPath [datadir, "webengine"] - config <- C.load [C.Optional path]+ config <- C.load [C.Optional (configPath opts)] whitelist <- C.lookupDefault defaultWhitelist config "whitelist-path" webengine <- C.lookupDefault defaultWebengine config "webengine-path" domains <- T.lines <$> T.readFile whitelist - return (Settings whitelist webengine domains)+ return (Settings webengine domains opts) -- | Catches any Selda error dbErrors :: S.SeldaError -> Action a
README.md view
@@ -2,29 +2,28 @@ ### A small tool that clears cookies (and more) -Websites can store unwanted data using all sorts of methods: besides-the usual cookies, there are also the local and session storage, the-IndexedDB API and more caches as well.+Websites can store unwanted data using all sorts of methods: besides the usual+cookies, there are also the local and session storage, the IndexedDB API and+more caches as well. bisc will try to go through each of them and remove all information from websites that are not explicitly allowed (ie. a whitelist of domains).-It was created for qutebrowser, but it actually supports the storage-format used by Chromium-based browsers, which (sadly) means almost-every one nowadays.+It was created for qutebrowser, but it actually supports the storage format+used by Chromium-based browsers, which (sadly) means almost every one nowadays. ## Installation -bisc is a Haskell program available on [Hackage][hackage] and can-be installed with one of the Haskell package managers. For-example, with [cabal-install][cabal] you would do+bisc is a Haskell program available on [Hackage][hackage] and can be installed+with one of the Haskell package managers. For example, with+[cabal-install][cabal] you would do ``` cabal install bisc ``` and similarly for [stack][stack]. -Alternatively, if you are using Nix or NixOS, bisc is available-under the attribute `haskellPackages.bisc`. It should also be in-the Nix binary cache so you don't have to build from source.+Alternatively, if you are using Nix or NixOS, bisc is available under the+attribute `haskellPackages.bisc`. It should also be in the Nix binary cache so+you don't have to build from source. Finally, statically compiled binaries can be found in the [releases](/git/rnhmjoj/bisc/releases).@@ -35,26 +34,29 @@ ## 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 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" ``` +If you want a different location for the configuration file, you can change it+using the `--config` command line option.+ ## Usage -Create an empty whitelist file and write the domains of the-allowed cookies, one per line.+- 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.+- Run `bisc --dry-run` to see what would be deleted without actually doing it.+- Run `bisc` to delete all non-whitelisted data from qutebrowser. Note that running bisc while the browser is open is not safe: this means it could possibly **corrupt** the databases. Hoever, corruption in the sqllite
bisc.cabal view
@@ -1,5 +1,5 @@ name: bisc-version: 0.3.1.0+version: 0.4.0.0 synopsis: A small tool that clears cookies (and more). description: @@ -22,13 +22,17 @@ copyright: Copyright (C) 2021 Michele Guerini Rocco category: Utility build-type: Simple-extra-source-files: README.md+extra-source-files: README.md, man/bisc.1 man/bisc.conf.5 cabal-version: >=1.10 source-repository head type: git location: https://maxwell.ydns.eu/git/rnhmjoj/bisc +flag static+ default: False+ description: Create a statically-linked binary+ executable bisc main-is: Main.hs build-depends: base ==4.* , selda ==0.*,@@ -36,6 +40,9 @@ leveldb-haskell ==0.*, filepath, directory, text, mtl, configurator, exceptions,- data-default, bytestring+ data-default, bytestring,+ optparse-applicative default-language: Haskell2010- extra-libraries: snappy stdc+++ ghc-options: -Wall+ if flag(static)+ extra-libraries: snappy stdc++
+ man/bisc.1 view
@@ -0,0 +1,70 @@+.TH bisc 1 "Semptember 7, 2021" "bisc 0.4.0" "User Commands"++.SH NAME+bisc - a small tool that clears cookies (and more)++.SH SYNOPSIS+.B bisc+.RI [ option ]++.SH DESCRIPTION+.PP+Websites can store unwanted data using all sorts of methods: besides the usual+cookies, there are also the local and session storage, the IndexedDB API and+more caches as well.+.PP+Bisc will try to go through each of them and remove all information from+websites that are not explicitly allowed (ie. a whitelist of domains).+It was created for qutebrowser, but it actually supports the storage format+used by Chromium-based browsers, which (sadly) means almost every one nowadays.++.SH USAGE+.IP \(bu 2+Create an empty whitelist file (see the FILES section) and write the domains of+the allowed cookies, one per line. For example:+.IP+.nf+\fC+\&.example.com+example.com+\fR+.fi+.IP \(bu 2+Run \fCbisc --dry-run\fR to see what would be deleted without actually+doing it.+.IP \(bu 2+Run \fCbisc\fR to delete all non-whitelisted data from qutebrowser.++.SH OPTIONS+.TP+.BR -c ","\ --config\ FILE+Use FILE as the configuration file.+.TP+.BR -n ","\ --dry-run+Don't actually remove anything, just show what would be done.+.TP+.BR -h ","\ --help+Show the program information and help screen.++.SH FILES+.TP+.I $XDG_CONFIG_HOME/bisc/bisc.conf+Bisc configuration+.TP+.I $XDG_CONFIG_HOME/qutebrowser/whitelists/cookies+Domain whitelist+.TP+.I $XDG_DATA_HOME/qutebrowser/webengine+Chromium/QtWebEngine state directory+.PP+Note: when the variable $XDG_CONFIG_HOME or $XDG_DATA_HOME is not set,+$HOME/.config and $HOME/.local/share respectively, will be used instead.++.SH SEE ALSO+\fBbisc.conf\fR(5) for the bisc configuration file++.SH AUTHORS+Copyright © 2021 Michele Guerini Rocco.+.TP 0+Released under the GPL, version 3 or greater.+This software carries no warranty of any kind.
+ man/bisc.conf.5 view
@@ -0,0 +1,49 @@+.TH bisc.conf 5 "Semptember 7, 2021" "bisc 0.4.0"++.SH NAME+bisc.conf - bisc configuration file++.SH SYNOPSIS++The bisc configuration file, found at the following locations, unless specified+via the \fC-c\fR command line option:+.IP \(bu 3+$XDG_CONFIG_HOME/bisc/bisc.conf,+.IP \(bu 3+$HOME/.config/bisc/bisc.conf (when $XDG_CONFIG_HOME is not set)++.SH DESCRIPTION+.PP+The bisc.conf file allows to change the default location of a couple of files+used by bisc.++.SH OPTIONS++.TP 4+.BR "webengine-path" " (default " "$(XDG_DATA_HOME)/qutebrowser/webengine")+The location of the Chromium/QtWebEngine state directory.+.TP 4+.BR "whitelist-path" " (default " "$(XDG_CONFIG_HOME)/qutebrowser/whitelists/cookies")+The location of the domain whitelist.++.SH EXAMPLE++This is an example configuration:+.IP+.nf+\fC+# This is a comment+whitelist-path = "/home/alice/docs/cookie-whitelist"+# You can also access environment variables:+webengine-path = "$(HOME)/.local/qutebrowser/webengine"+\fR+.fi++.SH SEE ALSO+\fBbisc\fR(1) for the bisc command++.SH AUTHORS+Copyright © 2021 Michele Guerini Rocco.+.TP 0+Released under the GPL, version 3 or greater.+This software carries no warranty of any kind.