rnhmjoj/bisc
1
1
Fork 0
Code Issues Pull Requests Releases 5 Wiki Activity

make paths configurable

Browse Source
This commit is contained in:
Michele Guerini Rocco 2019-03-25 00:02:38 +01:00
parent a86ee05bd1
commit a8423d4dc1
Signed by: rnhmjoj
GPG Key ID: 91BE884FBA4B591A
3 changed files with 105 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
Main.hs
View File

@ -3,18 +3,27 @@
{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
import System.Environment.XDG.BaseDir (getUserDataDir, getUserConfigDir) import Data.List (nub)
import System.FilePath (joinPath, takeBaseName, (</>)) import Data.Maybe (mapMaybe)
import System.IO (readFile) import Data.Configurator
import System.Directory (removeFile, getDirectoryContents, doesFileExist) import Control.Monad (mapM_, filterM)
import Control.Monad (mapM_, filterM) import Control.Monad.Reader (ReaderT, runReaderT, asks)
import Data.List (nub) import System.FilePath (joinPath, takeBaseName, (</>))
import Data.Maybe (mapMaybe) import System.Directory (removeFile, getDirectoryContents, doesFileExist)
import Data.Monoid ((<>)) import System.IO (readFile)
import Database.Selda import Database.Selda
import Database.Selda.SQLite 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 data Cookie = Cookie
{ host_key :: Text { host_key :: Text
@ -23,40 +32,43 @@ data Cookie = Cookie
instance SqlRow Cookie instance SqlRow Cookie
cookies :: Table Cookie
cookies = table "cookies" [] type Action = ReaderT Settings IO
databasePath :: IO FilePath main :: IO ()
databasePath = do main = do
datadir <- getUserDataDir "qutebrowser" config <- X.getUserConfigFile "bisc" "bisc.conf"
return $ joinPath [datadir, "webengine", "Cookies"] settings <- loadSettings config
runReaderT clean settings
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"]
prettyPrint :: [Text] -> Text clean :: Action ()
prettyPrint = T.unlines . bullet clean = do
where bullet = map (" * " <>) 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.")
where log = liftIO . T.putStrLn
num = T.pack . show
getDirectoryFiles :: FilePath -> IO [FilePath] deleteCookies :: [Text] -> Action (Int, [Text])
getDirectoryFiles path = map (path </>) <$>
getDirectoryContents path >>= filterM doesFileExist
deleteCookies :: [Text] -> IO (Int, [Text])
deleteCookies domains = do deleteCookies domains = do
database <- databasePath database <- (</> "Cookies") <$> asks webenginePath
withSQLite database $ do liftIO $ withSQLite database $ do
bad <- query $ do bad <- query $ do
cookie <- select cookies cookie <- select cookies
restrict (by whitelist cookie) restrict (by whitelist cookie)
@ -68,13 +80,17 @@ deleteCookies domains = do
whitelist = map text domains whitelist = map text domains
deleteLocalStore :: [Text] -> IO (Int, [Text]) deleteData :: [Text] -> Action (Int, [Text])
deleteLocalStore whitelist = do deleteData whitelist = do
entries <- getDirectoryFiles =<< localStorePath webengine <- asks webenginePath
appCache <- liftIO $ getDirectoryFiles (webengine </> "Application Cache")
indexedDB <- liftIO $ getDirectoryFiles (webengine </> "IndexedDB")
localStorage <- liftIO $ getDirectoryFiles (webengine </> "Local Storage")
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
mapM_ removeFile badFiles liftIO $ mapM_ removeFile badFiles
return (length badFiles, nub badDomains) return (length badFiles, nub badDomains)
where where
maybeToBool :: Maybe Bool -> Bool maybeToBool :: Maybe Bool -> Bool
@ -94,22 +110,29 @@ deleteLocalStore whitelist = do
unlisted = not . (`elem` whitelist) unlisted = not . (`elem` whitelist)
main :: IO () loadSettings :: FilePath -> IO Settings
main = do loadSettings path = do
whitelist <- T.lines <$> (T.readFile =<< whitelistPath) configdir <- X.getUserConfigDir "qutebrowser"
(n, bad) <- deleteCookies whitelist datadir <- X.getUserDataDir "qutebrowser"
if (n > 0) let
then do defaultWhitelist = joinPath [configdir, "whitelists", "cookies"]
log ("Cookies: deleted " <> num n <> " from:") defaultWebengine = joinPath [datadir, "webengine"]
log (prettyPrint bad)
else log ("Cookies: nothing to delete.")
(n, bad) <- deleteLocalStore whitelist config <- load [Optional path]
if (n > 0) whitelist <- lookupDefault defaultWhitelist config "whitelist-path"
then do webengine <- lookupDefault defaultWebengine config "webengine-path"
log ("Local storage: deleted " <> num n <> " entries:") return (Settings whitelist webengine)
log (prettyPrint bad)
else log ("Local storage: nothing to delete.")
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" []

3
bisc.cabal
View File

@ -18,7 +18,8 @@ executable bisc
main-is: Main.hs main-is: Main.hs
build-depends: base ==4.* , selda ==0.3.*, build-depends: base ==4.* , selda ==0.3.*,
selda-sqlite ==0.1.*, selda-sqlite ==0.1.*,
xdg-basedir, filepath, directory, text xdg-basedir, filepath, directory,
text, mtl, configurator
default-language: Haskell2010 default-language: Haskell2010
default-extensions: DeriveGeneric, OverloadedStrings default-extensions: DeriveGeneric, OverloadedStrings
OverloadedLabels, FlexibleContexts OverloadedLabels, FlexibleContexts

75
default.nix
View File

@ -1,64 +1,33 @@
{ nixpkgs ? import <nixpkgs> {} }: { nixpkgs ? import <nixpkgs> {}, compiler ? "default", doBenchmark ? false }:
let let
inherit (nixpkgs) pkgs; inherit (nixpkgs) pkgs;
haskellPackages = pkgs.haskellPackages.override { f = { mkDerivation, base, configurator, directory, filepath, mtl
overrides = self: super: { , selda, selda-sqlite, stdenv, text, xdg-basedir
selda = self.callPackage }:
({ mkDerivation, base, bytestring, exceptions, hashable, mtl mkDerivation {
, psqueues, text, time, unordered-containers pname = "bisc";
}: version = "0.1.0.0";
mkDerivation { src = ./.;
pname = "selda"; isLibrary = false;
version = "0.3.3.1"; isExecutable = true;
sha256 = "1rxwyls59mpmvb5f2l47ak5cnzmws847kgmn8fwbxb69h6a87bwr"; executableHaskellDepends = [
enableSharedExecutables = false; base configurator directory filepath mtl selda selda-sqlite text
libraryHaskellDepends = [ xdg-basedir
base bytestring exceptions hashable mtl psqueues text time ];
unordered-containers description = "A small tool that clears qutebrowser cookies";
]; license = stdenv.lib.licenses.gpl3;
description = "ulti-backend, high-level EDSL for interacting with SQL databases"; };
license = pkgs.stdenv.lib.licenses.mit;
hydraPlatforms = pkgs.stdenv.lib.platforms.none;
}) {};
selda-sqlite = self.callPackage haskellPackages = if compiler == "default"
({ mkDerivation, base, direct-sqlite, directory, exceptions, text, selda }: then pkgs.haskellPackages
mkDerivation { else pkgs.haskell.packages.${compiler};
pname = "selda-sqlite";
version = "0.1.6.1";
sha256 = "1qqrgqzcfwqzlcklm0qjvdy3ndn3zg8s5mp8744v76bd6z2xwq4d";
revision = "2";
editedCabalFile = "0gb8raqmy8r8xwjpx238mqar5gdfd4194si2ms1a9ndcrilkkqja";
libraryHaskellDepends = [
base direct-sqlite directory exceptions selda text
];
description = "QLite backend for the Selda database EDSL";
license = pkgs.stdenv.lib.licenses.mit;
hydraPlatforms = pkgs.stdenv.lib.platforms.none;
}) {};
bisc = self.callPackage variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;
({ mkDerivation, base, filepath, directory, stdenv, xdg-basedir
, selda, selda-sqlite, text }:
mkDerivation {
pname = "bisc";
version = "0.1.0.0";
src = ./.;
isLibrary = false;
isExecutable = true;
executableHaskellDepends = [
base filepath directory selda selda-sqlite xdg-basedir text
];
description = "A small tool that clears qutebrowser cookies";
license = stdenv.lib.licenses.gpl3;
}) {};
};
};
drv = haskellPackages.bisc; drv = variant (haskellPackages.callPackage f {});
in in