Compare commits
No commits in common. "master" and "0.2.3" have entirely different histories.
4
.gitignore
vendored
4
.gitignore
vendored
@ -1,4 +1,2 @@
|
|||||||
dist
|
dist
|
||||||
dist-newstyle
|
default.nix
|
||||||
result
|
|
||||||
bisc.nix
|
|
||||||
|
517
Main.hs
517
Main.hs
@ -1,283 +1,99 @@
|
|||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE OverloadedLabels #-}
|
{-# LANGUAGE OverloadedLabels #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
|
||||||
|
|
||||||
-- Databases
|
import Data.List (nub)
|
||||||
import Database.Selda (Text, liftIO, (!))
|
import Data.Maybe (mapMaybe)
|
||||||
import Database.Selda.SQLite (withSQLite)
|
import Data.Configurator
|
||||||
import Control.Monad.Trans.Resource (ResourceT)
|
import Control.Monad (mapM_, filterM)
|
||||||
import qualified Database.Selda as S
|
import Control.Monad.Reader (ReaderT, runReaderT, asks)
|
||||||
import qualified Database.LevelDB as L
|
import System.FilePath (joinPath, takeBaseName, (</>))
|
||||||
import qualified Database.LevelDB.Streaming as LS
|
import System.IO (readFile)
|
||||||
|
import System.Directory
|
||||||
|
|
||||||
-- Error handling
|
import Database.Selda
|
||||||
import Control.Exception as BE
|
import Database.Selda.SQLite
|
||||||
import Control.Monad.Catch as CE
|
|
||||||
import qualified System.Exit as E
|
|
||||||
|
|
||||||
-- 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 as T
|
||||||
import qualified Data.Text.IO 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
|
data Settings = Settings
|
||||||
{ webenginePath :: FilePath -- ^ webengine data directory
|
{ whitelistPath :: FilePath
|
||||||
, whitelist :: [Text] -- ^ whitelisted domains
|
, webenginePath :: FilePath
|
||||||
, 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
|
data Cookie = Cookie
|
||||||
{ host_key :: Text -- ^ cookie domain
|
{ host_key :: Text
|
||||||
, creation_utc :: Int -- ^ creation date
|
, creation_utc :: Int
|
||||||
} deriving (S.Generic, Show)
|
} deriving (Generic, Show)
|
||||||
|
|
||||||
-- | The origin (domain) of a quota
|
instance SqlRow Cookie
|
||||||
data QuotaOrigin = QuotaOrigin
|
|
||||||
{ origin :: Text -- ^ URL
|
|
||||||
, last_modified_time :: Int -- ^ creation date
|
|
||||||
} deriving (S.Generic, Show)
|
|
||||||
|
|
||||||
instance S.SqlRow Cookie
|
|
||||||
instance S.SqlRow QuotaOrigin
|
|
||||||
|
|
||||||
|
|
||||||
-- SQL tables
|
type Action = ReaderT Settings IO
|
||||||
|
|
||||||
-- | 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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
defConfig <- D.getXdgDirectory D.XdgConfig ("bisc" </> "bisc.conf")
|
config <- getXdgDirectory XdgConfig ("bisc" </> "bisc.conf")
|
||||||
opts <- O.execParser (cliParser defConfig)
|
settings <- loadSettings config
|
||||||
|
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)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Runs an 'Action' and pretty-prints the results
|
clean :: Action ()
|
||||||
runAction :: Settings -> Text -> Action Result -> IO Int
|
clean = do
|
||||||
runAction settings name x = do
|
path <- asks whitelistPath
|
||||||
a <- BE.try $ runExceptT (runReaderT x settings)
|
whitelist <- liftIO (T.lines <$> T.readFile path)
|
||||||
case a of
|
(n, bad) <- deleteCookies whitelist
|
||||||
Right (Right res) -> printResult res >> return 0
|
if (n > 0)
|
||||||
Right (Left msg) -> printFailed msg >> return 1
|
then do
|
||||||
Left (err :: BE.IOException) ->
|
log ("Cookies: deleted " <> num n <> " from:")
|
||||||
printFailed (T.pack $ BE.displayException err) >> return 1
|
log (prettyPrint bad)
|
||||||
where
|
else log ("Cookies: nothing to delete.")
|
||||||
printFailed msg =
|
|
||||||
T.putStrLn ("- " <> name <> " cleaning failed:\n " <> msg)
|
(n, bad) <- deleteData whitelist
|
||||||
printResult (n, bad)
|
if (n > 0)
|
||||||
| n > 0 = do
|
then do
|
||||||
T.putStrLn ("- " <> name <> ": " <> verb <>
|
log ("Persistent data: deleted " <> num n <> " entries:")
|
||||||
" " <> T.pack (show n) <> " entries for:")
|
log (prettyPrint bad)
|
||||||
T.putStrLn (T.unlines $ map (" * " <>) bad)
|
else log ("Persistent data: nothing to delete.")
|
||||||
| otherwise = T.putStrLn ("- " <> name <> ": nothing to delete")
|
|
||||||
verb = if (dryRun . options $ settings)
|
where log = liftIO . T.putStrLn
|
||||||
then "would delete"
|
num = T.pack . show
|
||||||
else "deleted"
|
|
||||||
|
|
||||||
|
|
||||||
-- * Cleaning actions
|
deleteCookies :: [Text] -> Action (Int, [Text])
|
||||||
|
deleteCookies domains = do
|
||||||
-- | List of actions and their names
|
database <- (</> "Cookies") <$> asks webenginePath
|
||||||
actions :: [(Text, Action Result)]
|
liftIO $ withSQLite database $ do
|
||||||
actions =
|
bad <- query $ do
|
||||||
[ ("Cookies", deleteCookies)
|
cookie <- select cookies
|
||||||
, ("QuotaManager", deleteQuotaOrigins)
|
restrict (by whitelist cookie)
|
||||||
, ("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)
|
return (cookie ! #host_key)
|
||||||
when (not dry) $
|
n <- deleteFrom cookies (by whitelist)
|
||||||
S.deleteFrom_ cookies (by whitelist)
|
return (n, nub bad)
|
||||||
return (length bad, nub bad)
|
|
||||||
where
|
where
|
||||||
by set x = S.not_ (x ! #host_key `S.isIn` set)
|
by set x = not_ (x ! #host_key `isIn` set)
|
||||||
|
whitelist = map text domains
|
||||||
|
|
||||||
|
|
||||||
-- | Deletes records in the QuotaManager API database
|
deleteData :: [Text] -> Action (Int, [Text])
|
||||||
deleteQuotaOrigins :: Action Result
|
deleteData whitelist = do
|
||||||
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
|
webengine <- asks webenginePath
|
||||||
dry <- asks (dryRun . options)
|
appCache <- liftIO $ listDirectoryAbs (webengine </> "Application Cache")
|
||||||
exists <- liftIO $ D.doesDirectoryExist (webengine </> "IndexedDB")
|
indexedDB <- liftIO $ listDirectoryAbs (webengine </> "IndexedDB")
|
||||||
when (not exists) $ throwError "directory is missing"
|
localStorage <- liftIO $ listDirectoryAbs (webengine </> "Local Storage")
|
||||||
|
|
||||||
entries <- listDirectoryAbs (webengine </> "IndexedDB")
|
|
||||||
unlisted <- (\domains -> not . (`elem` domains)) <$> asks whitelist
|
|
||||||
let
|
let
|
||||||
|
entries = appCache ++ indexedDB ++ localStorage
|
||||||
badFiles = filterMaybe (fmap unlisted . domain) entries
|
badFiles = filterMaybe (fmap unlisted . domain) entries
|
||||||
badDomains = mapMaybe domain badFiles
|
badDomains = mapMaybe domain badFiles
|
||||||
when (not dry) $
|
liftIO $ mapM_ removePathForcibly badFiles
|
||||||
liftIO $ mapM_ D.removePathForcibly badFiles
|
|
||||||
return (length badFiles, nub badDomains)
|
return (length badFiles, nub badDomains)
|
||||||
where
|
where
|
||||||
listDirectoryAbs :: FilePath -> Action [FilePath]
|
listDirectoryAbs :: FilePath -> IO [FilePath]
|
||||||
listDirectoryAbs dir = liftIO $ map (dir </>) <$> D.listDirectory dir
|
listDirectoryAbs dir = map (dir </>) <$> listDirectory dir
|
||||||
|
|
||||||
maybeToBool :: Maybe Bool -> Bool
|
maybeToBool :: Maybe Bool -> Bool
|
||||||
maybeToBool Nothing = False
|
maybeToBool Nothing = False
|
||||||
@ -289,203 +105,36 @@ deleteIndexedDB = do
|
|||||||
domain :: FilePath -> Maybe Text
|
domain :: FilePath -> Maybe Text
|
||||||
domain = extract . url where
|
domain = extract . url where
|
||||||
extract [] = Nothing
|
extract [] = Nothing
|
||||||
extract (_:[]) = Nothing
|
extract (x:[]) = Nothing
|
||||||
extract (_:xs) = Just $ T.unwords (init xs)
|
extract (x:xs) = Just $ T.unwords (init xs)
|
||||||
url = T.splitOn "_" . T.pack . takeBaseName
|
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
|
|
||||||
|
|
||||||
|
|
||||||
-- | Deletes records from the session storage levelDB database
|
loadSettings :: FilePath -> IO Settings
|
||||||
--
|
loadSettings path = do
|
||||||
-- The schema consists of a map `url -> id` and records under `id`:
|
configdir <- getXdgDirectory XdgConfig "qutebrowser"
|
||||||
--
|
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
|
let
|
||||||
defaultWhitelist = joinPath [configdir, "whitelists", "cookies"]
|
defaultWhitelist = joinPath [configdir, "whitelists", "cookies"]
|
||||||
defaultWebengine = joinPath [datadir, "webengine"]
|
defaultWebengine = joinPath [datadir, "webengine"]
|
||||||
|
|
||||||
config <- C.load [C.Optional (configPath opts)]
|
config <- load [Optional path]
|
||||||
whitelist <- C.lookupDefault defaultWhitelist config "whitelist-path"
|
whitelist <- lookupDefault defaultWhitelist config "whitelist-path"
|
||||||
webengine <- C.lookupDefault defaultWebengine config "webengine-path"
|
webengine <- lookupDefault defaultWebengine config "webengine-path"
|
||||||
domains <- T.lines <$> T.readFile whitelist
|
return (Settings whitelist webengine)
|
||||||
|
|
||||||
return (Settings webengine domains opts)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Catches any Selda error
|
prettyPrint :: [Text] -> Text
|
||||||
dbErrors :: S.SeldaError -> Action a
|
prettyPrint = T.unlines . bullet
|
||||||
dbErrors (S.DbError msg) = throwError $ "error opening database: " <> T.pack msg
|
where bullet = map (" * " <>)
|
||||||
dbErrors e =
|
|
||||||
if "ErrorBusy" `isInfixOf` msg
|
|
||||||
then throwError "database is locked (in use by another process)"
|
getDirectoryFiles :: FilePath -> IO [FilePath]
|
||||||
else throwError $ "database operation failed: " <> T.pack msg
|
getDirectoryFiles path = map (path </>) <$>
|
||||||
where msg = BE.displayException e
|
getDirectoryContents path >>= filterM doesFileExist
|
||||||
|
|
||||||
|
|
||||||
|
cookies :: Table Cookie
|
||||||
|
cookies = table "cookies" []
|
||||||
|
60
README.md
60
README.md
@ -1,72 +1,32 @@
|
|||||||
# Bisc
|
# 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
|
## Configuration
|
||||||
|
|
||||||
The bisc configuration file is `$XDG_CONFIG_HOME/bisc/bisc.conf`. It allows to
|
The bisc configuration file is `$XDG_CONFIG_HOME/bisc/bisc.conf`.
|
||||||
change the paths of the QtWebEngine/Chromium directory and the whitelist file.
|
It allows to change the paths of the QtWebEngine/Chromium
|
||||||
|
directory and the whitelist file.
|
||||||
The default settings are:
|
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
|
## Usage
|
||||||
|
|
||||||
- Create an empty whitelist file and write the domains of the allowed cookies,
|
Create an empty whitelist file and write the domains of the
|
||||||
one per line.
|
allowed cookies, one per line.
|
||||||
Eg.
|
Eg.
|
||||||
```
|
```
|
||||||
.example.com
|
.example.com
|
||||||
example.com
|
example.com
|
||||||
```
|
```
|
||||||
|
|
||||||
- Run `bisc --dry-run` to see what would be deleted without actually doing it.
|
Run `bisc` to delete all non-whitelisted data from qutebrowser.
|
||||||
- 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
|
## License
|
||||||
|
|
||||||
Copyright (C) 2022 Michele Guerini Rocco
|
Copyright (C) 2019 Michele Guerini Rocco
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
it under the terms of the GNU General Public License as published by
|
||||||
|
36
bisc.cabal
36
bisc.cabal
@ -1,48 +1,32 @@
|
|||||||
name: bisc
|
name: bisc
|
||||||
version: 0.4.1.0
|
version: 0.2.3.0
|
||||||
synopsis: A small tool that clears cookies (and more).
|
synopsis: A small tool that clears qutebrowser cookies.
|
||||||
description:
|
description:
|
||||||
|
|
||||||
Websites can store unwanted data using all sorts of methods: besides
|
Bisc clears qutebrowser cookies and javascript local storage
|
||||||
the usual cookies, there are also the local and session storage, the
|
by domains, stored in a whitelist.
|
||||||
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
|
homepage: https://maxwell.ydns.eu/git/rnhmjoj/bisc
|
||||||
license: GPL-3
|
license: GPL-3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Michele Guerini Rocco
|
author: Michele Guerini Rocco
|
||||||
maintainer: rnhmjoj@inventati.org
|
maintainer: rnhmjoj@inventati.org
|
||||||
copyright: Copyright (C) 2022 Michele Guerini Rocco
|
copyright: Copyright (C) 2019 Michele Guerini Rocco
|
||||||
category: Utility
|
category: Utility
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
extra-source-files: README.md, man/bisc.1 man/bisc.conf.5
|
extra-source-files: README.md
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: https://maxwell.ydns.eu/git/rnhmjoj/bisc
|
location: https://maxwell.ydns.eu/git/rnhmjoj/bisc
|
||||||
|
|
||||||
flag static
|
|
||||||
default: False
|
|
||||||
description: Create a statically-linked binary
|
|
||||||
|
|
||||||
executable bisc
|
executable bisc
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
build-depends: base ==4.* , selda ==0.*,
|
build-depends: base ==4.* , selda ==0.*,
|
||||||
selda-sqlite ==0.*,
|
selda-sqlite ==0.*,
|
||||||
leveldb-haskell ==0.*, resourcet,
|
filepath, directory, text,
|
||||||
filepath, directory, text, unix,
|
mtl, configurator
|
||||||
mtl, configurator, exceptions,
|
|
||||||
data-default, bytestring,
|
|
||||||
optparse-applicative
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -Wno-name-shadowing -O2
|
default-extensions: DeriveGeneric, OverloadedStrings
|
||||||
if flag(static)
|
OverloadedLabels, FlexibleContexts
|
||||||
extra-libraries: snappy stdc++
|
|
||||||
|
42
default.nix
42
default.nix
@ -1,42 +0,0 @@
|
|||||||
{ 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
|
|
75
man/bisc.1
75
man/bisc.1
@ -1,75 +0,0 @@
|
|||||||
.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.
|
|
@ -1,49 +0,0 @@
|
|||||||
.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.
|
|
Loading…
Reference in New Issue
Block a user