cabal: increase version number

- use a build flag to turn on static system libraries
- generate shell completion scripts
- externalise the generate cabal2nix function

.gitignore

@@ -1,2 +1,4 @@
 dist
-default.nix
+dist-newstyle
+result
+bisc.nix

Main.hs

@@ -1,99 +1,283 @@
-{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE OverloadedLabels  #-}
+{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedLabels    #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiWayIf          #-}
 
-import Data.List            (nub)
+-- Databases
-import Data.Maybe           (mapMaybe)
+import Database.Selda               (Text, liftIO, (!))
-import Data.Configurator
+import Database.Selda.SQLite        (withSQLite)
-import Control.Monad        (mapM_, filterM)
+import Control.Monad.Trans.Resource (ResourceT)
-import Control.Monad.Reader (ReaderT, runReaderT, asks)
+import qualified Database.Selda             as S
-import System.FilePath      (joinPath, takeBaseName, (</>))
+import qualified Database.LevelDB           as L
-import System.IO            (readFile)
+import qualified Database.LevelDB.Streaming as LS
-import System.Directory
 
-import Database.Selda
+-- Error handling
-import Database.Selda.SQLite
+import Control.Exception     as BE
+import Control.Monad.Catch   as CE
+import qualified System.Exit as E
 
-import qualified Data.Text        as T
+-- Configuration
-import qualified Data.Text.IO     as T
+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
+
+-- Version information
+import qualified Paths_bisc as Bisc
+import Data.Version (showVersion)
+
+-- File locking bypass
+import qualified System.Posix.Files as Posix
+
+-- Misc
+import Data.List             (nub, isInfixOf)
+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
+  { webenginePath :: FilePath  -- ^ webengine data directory
-  , webenginePath :: FilePath
+  , 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
+  , unsafe     :: Bool      -- ^ ignore locks
+  , 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.switch
+          (  O.long "unsafe"
+          <> O.short 'u'
+          <> O.help ("Ignore database locks. " <>
+                    "This will probably corrupt the databases, but " <>
+                    "works while the browser is running.")
+          )
+      <*> 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
 data Cookie = Cookie
-  { host_key        :: Text
+  { host_key     :: Text  -- ^ cookie domain
-  , creation_utc    :: Int
+  , creation_utc :: Int   -- ^ creation date
-  } deriving (Generic, Show)
+  } deriving (S.Generic, Show)
 
-instance SqlRow Cookie
+-- | The origin (domain) of a quota
+data QuotaOrigin = QuotaOrigin
+  { origin             :: Text  -- ^ URL
+  , last_modified_time :: Int   -- ^ creation date
+  } deriving (S.Generic, Show)
+
+instance S.SqlRow Cookie
+instance S.SqlRow QuotaOrigin
 
 
-type Action = ReaderT Settings IO
+-- SQL tables
+
+-- | Cookies table
+cookies :: S.Table Cookie
+cookies = S.table "cookies" []
+
+-- | QuotaManager origins table
+quotaOrigins :: S.Table QuotaOrigin
+quotaOrigins = S.table "OriginInfoTable" []
 
 
+-- | Main monad stack
+--
+-- * 'ReaderT' for accessing settings
+-- * 'ExceptT' for custom errors
+type Action = ReaderT Settings (ExceptT Text IO)
+
+-- | Number of removed domains, list of domains
+type Result = (Int, [Text])
+
+
+-- * Main
+
+-- | Clears all means of permanent storage
 main :: IO ()
 main = do
-  config   <- getXdgDirectory XdgConfig ("bisc" </> "bisc.conf")
+  defConfig <- D.getXdgDirectory D.XdgConfig ("bisc" </> "bisc.conf")
-  settings <- loadSettings config
+  opts <- O.execParser (cliParser defConfig)
-  runReaderT clean settings
+
+  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)
 
 
-clean :: Action ()
+-- | Runs an 'Action' and pretty-prints the results
-clean = do
+runAction :: Settings -> Text -> Action Result -> IO Int
-  path <- asks whitelistPath
+runAction settings name x = do
-  whitelist <- liftIO (T.lines <$> T.readFile path)
+  a <- BE.try $ runExceptT (runReaderT x settings)
-  (n, bad)  <- deleteCookies whitelist
+  case a of
-  if (n > 0)
+    Right (Right res) -> printResult res >> return 0
-    then do
+    Right (Left msg) -> printFailed msg  >> return 1
-      log ("Cookies: deleted " <> num n <> " from:")
+    Left (err :: BE.IOException) ->
-      log (prettyPrint bad)
+      printFailed (T.pack $ BE.displayException err) >> return 1
-    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.")
-
-  where log = liftIO . T.putStrLn
-        num = T.pack . show
-
-
-deleteCookies :: [Text] -> Action (Int, [Text])
-deleteCookies domains = do
-  database <- (</> "Cookies") <$> asks webenginePath
-  liftIO $ withSQLite database $ do
-    bad <- query $ do
-      cookie <- select cookies
-      restrict (by whitelist cookie)
-      return (cookie ! #host_key)
-    n <- deleteFrom cookies (by whitelist)
-    return (n, nub bad)
   where
-    by set x = not_ (x ! #host_key `isIn` set)
+    printFailed msg =
-    whitelist = map text domains
+      T.putStrLn ("- " <> name <> " cleaning failed:\n  " <> msg)
+    printResult (n, bad)
+      | n > 0 = do
+        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"
 
 
-deleteData :: [Text] -> Action (Int, [Text])
+-- * Cleaning actions
-deleteData whitelist = do
+
+-- | 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
+  dir <- asks webenginePath
+  dry <- asks (dryRun . options)
+
+  -- check for database
+  exists <- liftIO $ D.doesFileExist (dir </> "Cookies")
+  when (not exists) (throwError "database is missing")
+
+  whitelist <- map S.text <$> asks whitelist
+  withoutLocks "Cookies" $ \database -> do
+    CE.handle dbErrors $ withSQLite database $ do
+      bad <- S.query $ do
+        cookie <- S.select cookies
+        S.restrict (by whitelist cookie)
+        return (cookie ! #host_key)
+      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)
+
+
+-- | Deletes records in the QuotaManager API database
+deleteQuotaOrigins :: Action Result
+deleteQuotaOrigins = do
+  dir <- asks webenginePath
+  dry <- asks (dryRun . options)
+
+  -- check for database
+  exists <- liftIO $ D.doesFileExist (dir </> "QuotaManager")
+  when (not exists) (throwError "database is missing")
+
+  whitelist <- map mkPattern <$> asks whitelist
+  withoutLocks "QuotaManager" $ \database -> do
+    CE.handle dbErrors $ withSQLite database $ do
+      bad <- S.query $ do
+        quota <- S.select quotaOrigins
+        S.restrict (by whitelist quota)
+        return (quota ! #origin)
+      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)
+      where
+        url = quota ! #origin
+        matches = do
+          pattern <- S.selectValues (map S.Only whitelist)
+          S.restrict (url `S.like` S.the pattern)
+          return S.true
+    -- turns domains into patterns to match a url
+    mkPattern domain = "http%://%" <> domain <> "/"
+
+
+-- | Deletes per-domain files under the IndexedDB directory
+--
+-- For example:
+--
+--    https_example.com_0.indexeddb.leveldb
+--    https_www.example.com_0.indexeddb.leveldb
+--
+deleteIndexedDB :: Action Result
+deleteIndexedDB = do
   webengine <- asks webenginePath
-  appCache     <- liftIO $ listDirectoryAbs (webengine </> "Application Cache")
+  dry <- asks (dryRun . options)
-  indexedDB    <- liftIO $ listDirectoryAbs (webengine </> "IndexedDB")
+  exists <- liftIO $ D.doesDirectoryExist (webengine </> "IndexedDB")
-  localStorage <- liftIO $ listDirectoryAbs (webengine </> "Local Storage")
+  when (not exists) $ throwError "directory is missing"
+
+  entries <- listDirectoryAbs (webengine </> "IndexedDB")
+  unlisted <- (\domains -> not . (`elem` domains)) <$> asks whitelist
   let
-    entries    = appCache ++ indexedDB ++ localStorage 
     badFiles   = filterMaybe (fmap unlisted . domain) entries
     badDomains = mapMaybe domain badFiles
-  liftIO $ mapM_ removePathForcibly badFiles
+  when (not dry) $
+    liftIO $ mapM_ D.removePathForcibly badFiles
   return (length badFiles, nub badDomains)
   where
-    listDirectoryAbs :: FilePath -> IO [FilePath]
+    listDirectoryAbs :: FilePath -> Action [FilePath]
-    listDirectoryAbs dir = map (dir </>) <$> listDirectory dir
+    listDirectoryAbs dir = liftIO $ map (dir </>) <$> D.listDirectory dir
 
     maybeToBool :: Maybe Bool -> Bool
     maybeToBool Nothing  = False
@@ -105,36 +289,203 @@ deleteData whitelist = do
     domain :: FilePath -> Maybe Text
     domain = extract . url where
       extract    []  = Nothing
-      extract (x:[]) = Nothing
+      extract (_:[]) = Nothing
-      extract (x:xs) = Just $ T.unwords (init xs)
+      extract (_:xs) = Just $ T.unwords (init xs)
       url = T.splitOn "_" . T.pack . takeBaseName
 
-    unlisted = not . (`elem` whitelist)
+
+-- | Deletes records from the local storage levelDB database
+--
+-- The schema consists of two (or more) records for each url:
+--
+--   "META:<url>" which stores metadata
+--   "_<url>\NUL\SOH<key>" which stores the actual data
+--
+-- See https://source.chromium.org/chromium/chromium/src/+/master:components/services/storage/dom_storage/local_storage_impl.cc;l=51
+--
+deleteLocalStorage :: Action Result
+deleteLocalStorage = do
+  webengine <- asks webenginePath
+  whitelist <- asks whitelist
+  let path = webengine </> "Local Storage" </> "leveldb"
+
+  dry <- asks (dryRun . options)
+  unsafe <- asks (unsafe . options)
+
+  when (not dry && unsafe) $ liftIO $ do
+    -- delete and recreate the lock file to bypass POSIX locks
+    D.removeFile (path </> "LOCK")
+    T.writeFile (path </> "LOCK") ""
+
+  dbIsOk <- liftIO $ D.doesFileExist (path </> "LOCK")
+  when (not dbIsOk) (throwError "database is missing or corrupted")
+
+  version <- withRetryDB path (\db -> L.get db def "VERSION")
+  when (version /= Just "1") (throwError "database is empty or the schema unsupported")
+
+  -- when dry running replace the delete function with a nop
+  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 -> delete db def k >> return (metaDomain k))
+       & LS.toList
+
+    n <- L.withIterator db def $ \i ->
+         LS.keySlice i LS.AllKeys LS.Asc
+       & LS.filter (\k -> "_" `B.isPrefixOf` k
+                       && "\NUL\SOH" `B.isInfixOf` k
+                       && (recDomain k) `notElem` whitelist)
+       & LS.mapM (delete db def)
+       & LS.length
+
+    return (n, badDomains)
+  where
+    -- extract domains from the keys
+    domain = snd . T.breakOnEnd "://" . decodeUtf8
+    metaDomain = domain . B.drop 5
+    recDomain  = domain . head . B.split 0 . B.drop 1
 
 
-loadSettings :: FilePath -> IO Settings
+-- | Deletes records from the session storage levelDB database
-loadSettings path = do
+--
-  configdir <- getXdgDirectory XdgConfig "qutebrowser"
+-- The schema consists of a map `url -> id` and records under `id`:
-  datadir   <- getXdgDirectory XdgData   "qutebrowser"
+--
+--   namespace-<session-uid>-<url> = <id>
+--   map-<id>-<key> = <value>
+--
+-- See https://source.chromium.org/chromium/chromium/src/+/master:components/services/storage/dom_storage/session_storage_metadata.cc;l=21
+--
+deleteSessionStorage :: Action Result
+deleteSessionStorage = do
+  webengine <- asks webenginePath
+  whitelist <- asks whitelist
+  let path = webengine </> "Session Storage"
+
+  dry <- asks (dryRun . options)
+  unsafe <- asks (unsafe . options)
+
+  when (not dry && unsafe) $ liftIO $ do
+    -- delete and recreate the lock file to bypass POSIX locks
+    D.removeFile (path </> "LOCK")
+    T.writeFile (path </> "LOCK") ""
+
+  dbIsOk <- liftIO $ D.doesFileExist (path </> "LOCK")
+  when (not dbIsOk) (throwError "database is missing or corrupted")
+
+  version <- withRetryDB path (\db -> L.get db def "version")
+  when (version /= Just "1") (throwError "database is empty or the schema unsupported")
+
+  -- when dry running replace the delete function with a nop
+  let delete = if dry then (\_ _ _ -> pure ()) else L.delete
+
+  withDB path $ \db -> do
+    -- map of id -> isBad
+    badMap <- L.withIterator db def $ \i ->
+         LS.keySlice i LS.AllKeys LS.Asc
+       & LS.filter (B.isPrefixOf "namespace")
+       & LS.mapM (\k -> (,) <$> L.get db def k <*> pure (isBad whitelist k))
+       & LS.toList
+
+    -- delete the unlisted domains map
+    badDomains <- L.withIterator db def $ \i ->
+         LS.keySlice i LS.AllKeys LS.Asc
+       & LS.filter (B.isPrefixOf "namespace")
+       & LS.filter (isBad whitelist)
+       & LS.mapM (\k -> delete db def k >> return (domain k))
+       & LS.toList
+
+    -- and their records
+    n <- L.withIterator db def $ \i ->
+         LS.keySlice i LS.AllKeys LS.Asc
+       & LS.filter (B.isPrefixOf "map-")
+       & LS.mapM (\k ->
+         case lookup (originId k) badMap of
+           Just True -> delete db def k >> return 1
+           _ -> return 0)
+       & LS.sum
+    return (n, nub badDomains)
+  where
+    isBad whitelist = not . flip elem whitelist . domain
+    -- extract domain from keys (47 = length "namespace-<uid>-")
+    url = decodeUtf8 . B.drop 47
+    domain = (!! 2). T.splitOn "/" . url
+    -- extract id from key: drop "map-", take until "-" (ascii 45)
+    originId = Just . B.takeWhile (/= 45). B.drop 4
+
+
+-- * Helper functions
+
+-- | Loads a leveldb database and runs a resourceT action
+withDB :: FilePath -> (L.DB -> ResourceT IO a) -> Action a
+withDB path f = liftIO $ L.runResourceT (L.open path def >>= f)
+
+
+-- | Like 'withDB' but retry the action after repairing the db
+withRetryDB :: FilePath -> (L.DB -> ResourceT IO a) -> Action a
+withRetryDB path action = do
+  res <- CE.try (withDB path action)
+  case res of
+    Right b -> return b
+    Left (e :: BE.IOException) ->
+      if | "Corruption"  `T.isInfixOf` msg -> do
+           -- try repairing before giving up
+           liftIO $ L.repair path def
+           withDB path action
+         | "unavailable" `T.isInfixOf` msg ->
+           throwError "database is locked (in use by another process)"
+         | otherwise ->
+           throwError ("error opening the database:\n " <> msg)
+      where msg = T.pack (BE.displayException e)
+
+
+-- | Bypass SQLite locking mechanism
+--
+-- SQLite manages concurrent access via POSIX locks: these are tied to a
+-- specific file and pid. They can be bypassed by simply creating a hard
+-- link (pointing to the same inode), editing the link and then removing it.
+withoutLocks :: String -> (FilePath -> Action a) -> Action a
+withoutLocks dbName cont = do
+  dir <- asks webenginePath
+  unsafe <- asks (unsafe . options)
+  let
+    real = dir </> dbName
+    link = real <> "-bypass"
+  -- bypass the SQLite POSIX locks with hard links
+  when unsafe $ liftIO (Posix.createLink real link)
+
+  res <- cont (if unsafe then link else real)
+
+  -- remove the hard links
+  when unsafe $ liftIO (Posix.removeLink link)
+  return res
+
+
+-- | 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    <- load [Optional path]
+  config    <- C.load [C.Optional (configPath opts)]
-  whitelist <- lookupDefault defaultWhitelist config "whitelist-path"
+  whitelist <- C.lookupDefault defaultWhitelist config "whitelist-path"
-  webengine <- lookupDefault defaultWebengine config "webengine-path"
+  webengine <- C.lookupDefault defaultWebengine config "webengine-path"
-  return (Settings whitelist webengine)
+  domains   <- T.lines <$> T.readFile whitelist
+
+  return (Settings webengine domains opts)
 
 
-prettyPrint :: [Text] -> Text
+-- | Catches any Selda error
-prettyPrint = T.unlines . bullet
+dbErrors :: S.SeldaError -> Action a
-  where bullet = map ("  * " <>)
+dbErrors (S.DbError msg) = throwError $ "error opening database: " <> T.pack msg
-
+dbErrors e =
-
+  if "ErrorBusy" `isInfixOf` msg
-getDirectoryFiles :: FilePath -> IO [FilePath]
+    then throwError "database is locked (in use by another process)"
-getDirectoryFiles path = map (path </>) <$>
+    else throwError $ "database operation failed: " <> T.pack msg
-  getDirectoryContents path >>= filterM doesFileExist
+  where msg = BE.displayException e
-
-
-cookies :: Table Cookie
-cookies = table "cookies" []

README.md

@@ -1,32 +1,72 @@
 # Bisc
-### A small tool that clears qutebrowser cookies
+
+### 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.
+
+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.
+
+## 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
+```
+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.
+
+Finally, statically compiled binaries can be found in the
+[releases](/git/rnhmjoj/bisc/releases).
+
+[hackage]: http://hackage.haskell.org/package/bisc
+[cabal]: https://github.com/haskell/cabal/blob/master/cabal-install/README.md
+[stack]: https://docs.haskellstack.org/en/stable/README/
 
 ## Configuration
 
-The bisc configuration file is `$XDG_CONFIG_HOME/bisc/bisc.conf`.
+The bisc configuration file is `$XDG_CONFIG_HOME/bisc/bisc.conf`.  It allows to
-It allows to change the paths of the QtWebEngine/Chromium
+change the paths of the QtWebEngine/Chromium directory and the whitelist file.
-directory and the whitelist file.
 The default settings are:
 ```
-whitelist-path = $(XDG_CONFIG_HOME)/qutebrowser/whitelists/cookies
+whitelist-path = "$(XDG_CONFIG_HOME)/qutebrowser/whitelists/cookies"
-webengine-path = $(XDG_DATA_HOME)/qutebrowser/webengine
+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
+- Create an empty whitelist file and write the domains of the allowed cookies,
-allowed cookies, one per line.
+  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
+databases (Cookies and QuotaManager) has never happened or been reported to me
+and the LevelDB ones (LocalStorage, SessionStorage, IndexedDB), while they do
+corrupt more often, are automatically repaired by bisc.
 
 ## License
 
-Copyright (C) 2019 Michele Guerini Rocco
+Copyright (C) 2022 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
@@ -35,7 +75,7 @@ the Free Software Foundation, either version 3 of the License, or
 
 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
+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

bisc.cabal

@@ -1,32 +1,48 @@
 name:                bisc
-version:             0.2.3.0
+version:             0.4.1.0
-synopsis:            A small tool that clears qutebrowser cookies.
+synopsis:            A small tool that clears cookies (and more).
 description:         
 
-  Bisc clears qutebrowser cookies and javascript local storage
+  Websites can store unwanted data using all sorts of methods: besides
-  by domains, stored in a whitelist.
+  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.
+
 
 homepage:            https://maxwell.ydns.eu/git/rnhmjoj/bisc
 license:             GPL-3
 license-file:        LICENSE
 author:              Michele Guerini Rocco
 maintainer:          rnhmjoj@inventati.org
-copyright:           Copyright (C) 2019 Michele Guerini Rocco
+copyright:           Copyright (C) 2022 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.*,
                        selda-sqlite ==0.*,
-                       filepath, directory, text,
+                       leveldb-haskell ==0.*, resourcet,
-                       mtl, configurator
+                       filepath, directory, text, unix,
+                       mtl, configurator, exceptions,
+                       data-default, bytestring,
+                       optparse-applicative
   default-language:    Haskell2010
-  default-extensions:  DeriveGeneric, OverloadedStrings
+  ghc-options:         -Wall -Wno-name-shadowing -O2
-                       OverloadedLabels, FlexibleContexts
+  if flag(static)
+    extra-libraries:   snappy stdc++

default.nix

@@ -0,0 +1,42 @@
+{ nixpkgs ? <nixpkgs>
+, static ? false
+, compiler ? "default"
+, doBenchmark ? false
+, system ? builtins.currentSystem
+}:
+
+let
+
+  basepkgs = import nixpkgs { inherit system; };
+  pkgs = if static then basepkgs.pkgsStatic else basepkgs.pkgs;
+
+  ghc = if static then pkgs.haskell.packages.integer-simple.ghc901
+    else if compiler == "default" then pkgs.haskellPackages
+    else pkgs.haskell.packages.${compiler};
+
+  variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;
+
+  drv = variant (override (ghc.callPackage ./bisc.nix {}));
+
+  override = drv: pkgs.haskell.lib.overrideCabal drv (old: with pkgs.lib; {
+    buildTools = [ pkgs.installShellFiles ];
+    configureFlags = optional static "-f static";
+    buildFlags = optionals static [
+      "--ld-option=-lstdc++"
+      "--ld-option=-lsnappy"
+    ];
+    postInstall = ''
+      # generate completion
+      $out/bin/bisc --bash-completion-script "$out/bin/bisc" > bisc.bash
+      $out/bin/bisc --fish-completion-script "$out/bin/bisc" > bisc.fish
+      $out/bin/bisc --zsh-completion-script  "$out/bin/bisc" > bisc.zsh
+
+      installShellCompletion bisc.{bash,fish,zsh}
+      installManPage man/*.[0-9]
+    '';
+    postFixup = optionalString static "rm -r $out/nix-support";
+  });
+
+in
+
+  if pkgs.lib.inNixShell then drv.env else drv

man/bisc.1

@@ -0,0 +1,75 @@
+.TH bisc 1 "January 11, 2022" "bisc 0.4.1" "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 -u ","\ --unsafe
+Ignore database locks.
+This will probably corrupt the databases, but works while the browser is
+running.
+.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 © 2022 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

@@ -0,0 +1,49 @@
+.TH bisc.conf 5 "January 11, 2022" "bisc 0.4.1"
+
+.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 © 2022 Michele Guerini Rocco.
+.TP 0
+Released under the GPL, version 3 or greater.
+This software carries no warranty of any kind.