diff --git a/INSTALL.rst b/INSTALL.rst new file mode 100644 --- /dev/null +++ b/INSTALL.rst @@ -0,0 +1,39 @@ +============================ +Adblock2Privoxy installation +============================ + +From binary package +------------------- +There are packages for various systems available at `downloads page `_ + + * For linux: you can try RPM or DEB package (depending on your package manager). + * For windows: Just unzip the file provided. You'll find adblock2privoxy executable is in bin folder. + +From sources +------------ +You can install adblock2privoxy from sources if there is no binary package for your system. + +1. Ensure you have Haskell compiler and Cabal + + * For Windows: you can download `MinGHC installer `_ (It includes GHC 7.8.3 compiler and Cabal) + * From Linux: Install Haskell platform from your distributive repository or follow `the guide `_ +2. Obtain sources. You can + + * Either download and extract sources from `Hackage `_ + * Or clone git repository with `git clone http://projects.zubr.me/adblock2privoxy.git` + +3. Open console and go to the sources folder +4. Run:: + + cabal update + runhaskell Setup.hs configure --user + runhaskell Setup.hs build + runhaskell Setup.hs install + +Packaging +--------- +You can create your own binary package for adblock2privoxy. There are two ways: + + * Use scripts from `distribution` folder + * Or do the same actions as for installing from sources, but use `--prefix=[package directory]` option on configure step. After that you put content of [package directory] to package or archive. + diff --git a/README.rst b/README.rst --- a/README.rst +++ b/README.rst @@ -36,7 +36,7 @@ * Unsupported: collapse, background, xbl, ping and dtd Tested with privoxy version 3.0.21. -Element blocking feature requires a webserver to serve CSS files. See Nginx and Apache config examples provided. +Element hiding feature requires a webserver to serve CSS files. See Nginx and Apache config examples provided. Description ----------- @@ -47,28 +47,40 @@ Options ------- + + -v --version + Show version number + -p PATH --privoxyDir=PATH + Privoxy config output path + -w PATH --webDir=PATH + Css files output path + -d DOMAIN --domainCSS=DOMAIN + Domain of CSS web server (required for Element Hide functionality) + -t PATH --taskFile=PATH + Path to task file containing urls to process and options. + -f --forced + Run even if no sources are expired - -v, --version - show version number - -p PATH, --privoxyDir=PATH - privoxy config output path (required) - -w PATH, --webDir=PATH - css files output path (optional, privoxyDir is used by default) - -t PATH, --taskFile=PATH - path to task file containing urls to process - -f, --forced - run even if no sources are expired +If taskFile is not specified explicilty, [privoxyDir]/ab2p.task is used. +If task file exists and privoxyDir, webDir or domainCSS is not specified, corresponding value is taken from task file. + +If webDir is not specified (and cannot be taken from task file), privoxyDir value is used for webDir. + +If domainCSS is not specified (and cannot be taken from task file), Element Hide functionality become disabled (and no webserver is needed). + +domainCSS can contain just IP address if no CSS web server has no associated domain. + Usage ----- Example of first run:: - adblock2privoxy -p /etc/privoxy -w /var/www/privoxy -t my_ab2b.task https://easylist-downloads.adblockplus.org/easylist.txt https://easylist-downloads.adblockplus.org/advblock.txt my_custom.txt + adblock2privoxy -p /etc/privoxy -w /var/www/privoxy -d www.example.com -t my_ab2b.task https://easylist-downloads.adblockplus.org/easylist.txt https://easylist-downloads.adblockplus.org/advblock.txt my_custom.txt Example of subsequent runs:: - adblock2privoxy -p /etc/privoxy -w /var/www/privoxy -t my_ab2b.task + adblock2privoxy -t my_ab2b.task The app generates following files @@ -83,18 +95,18 @@ * ab2p.common.css * ab2p.css - * [lot of directories for first level domain names] + * [lot of directories for all levels of domain names] * taskFile: - * special file containing execution details. It can be reused to update privoxy config from same sources. + * special file containing execution details. It can be reused to update privoxy config from same sources with same options. How to apply results -------------------- 1. Install privoxy. Optionally setup it as transparent proxy -2. Change privoxy config file: Add following lines +2. Change privoxy config file. Add following lines:: actionsfile ab2p.system.action actionsfile ab2p.action @@ -107,8 +119,8 @@ server { listen 80; - #ab2p css domain name (optional) - server_name privoxy.zubr.me; + #ab2p css domain name (optional, should be equal to domainCSS parameter) + server_name www.example.com; #root = webDir parameter value root /var/www/privoxy; @@ -129,7 +141,7 @@ Apache config example:: - #ab2p css domain name (optional) + #ab2p css domain name (optional, should be equal to domainCSS parameter) ServerName www.example.com #root = webDir parameter value @@ -152,7 +164,7 @@ * `EasyList `_ * `Russian AD list `_ -5) Run adblock2privoxy providing privoxy dir, web dir and adblock input file urls +5) Run adblock2privoxy providing privoxy dir, web dir, domain and adblock input file urls 6) Restart privoxy and apache to load updated configs diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,19 +1,2 @@ import Distribution.Simple -import Distribution.Simple.PreProcess -import Distribution.PackageDescription (PackageDescription(..), Executable(..)) -import System.Process ( rawSystem ) -import System.FilePath ( () ) -import System.Directory ( findExecutable ) -import Distribution.Simple.Utils (info) - -main :: IO () -main = defaultMainWithHooks $ simpleUserHooks { - hookedPreProcessors = [] - -- ensure that adblock2privoxy-distrib doesn't get installed to bindir - , copyHook = \pkgdescr -> - (copyHook simpleUserHooks) pkgdescr{ executables = - [x | x <- executables pkgdescr, exeName x /= "adblock2privoxy-distrib"] } - , instHook = \pkgdescr -> - (instHook simpleUserHooks) pkgdescr{ executables = - [x | x <- executables pkgdescr, exeName x /= "adblock2privoxy-distrib"] } - } +main = defaultMain diff --git a/adblock2privoxy.cabal b/adblock2privoxy.cabal --- a/adblock2privoxy.cabal +++ b/adblock2privoxy.cabal @@ -1,19 +1,28 @@ name: adblock2privoxy -version: 1.2.5 -cabal-version: >= 1.6 -build-type: Custom +version: 1.3.0 +cabal-version: >= 1.10 +build-type: Simple +tested-with: + GHC==7.8.3, + GHC==7.6.3 author: Alexey Zubritsky data-files: templates/ab2p.system.action, templates/ab2p.system.filter extra-source-files: README.rst + INSTALL.rst changelog man/man1/adblock2privoxy.1 + distribution/rpmbuild/SPECS/adblock2privoxy.spec + distribution/buildWin.bat + distribution/makeFedoraRpm.sh license: GPL-3 maintainer: Alexey Zubritskiy license-file: LICENSE stability: stable +homepage: https://projects.zubr.me/wiki/adblock2privoxy +category: Web synopsis: Convert adblock config files to privoxy format description: AdBlock Plus browser plugin has great block list files provided by big community, @@ -40,12 +49,17 @@ document, elemhide, other, popup, third-party, domain=..., match-case, donottrack . Unsupported: collapse, background, xbl, ping and dtd -homepage: https://projects.zubr.me/wiki/adblock2privoxy -category: Web + executable adblock2privoxy hs-source-dirs: src main-is: Main.hs + default-language: Haskell2010 + default-extensions: + RankNTypes, + ScopedTypeVariables, + FlexibleInstances, + GeneralizedNewtypeDeriving build-depends: base >= 4 && < 5, parsec, @@ -55,12 +69,13 @@ directory, MissingH, parsec-permutation, - time >=1.4 && <1.5, - old-locale >=1.0 && <1.1, - strict >=0.3 && <0.4, - network >=2.4 && <2.6, + time >=1.4, + old-locale >=1.0, + strict >=0.3, + network >=2.4, http-conduit, - text >=0.11 && <0.12 + text >=0.11, + network-uri ghc-options: -Wall other-modules: ElementBlocker, @@ -78,17 +93,8 @@ UrlBlocker, Utils -executable adblock2privoxy-distrib - build-depends: - base >= 4 && < 5, - pandoc, - Cabal >=1.6 && <1.20, - pandoc-types >=1.12.3 && <1.13 - ghc-options: -Wall - main-is: Main.hs - hs-source-dirs: distrib-src - source-repository this type: git location: ​http://projects.zubr.me/adblock2privoxy.git - tag: 1.2.4 + subdir: adblock2privoxy + tag: 1.3.0 diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,11 @@ +1.3.0 + * Build and packaging process refactoring + * Build script for windows + * Installation documentation + * CSS server domain changed from hardcoded 'privoxy.zubr.me' to configurable one (ticket #1) + * Element hiding CSS generation is skipped if the domain is not specified + * Task files contains output paths, so it's possible to run ab2p with single parameter: task file name + * Bugfixes for tickets #7, #8, #9 1.2.4 * Documentation and bugfixes diff --git a/distrib-src/Main.hs b/distrib-src/Main.hs deleted file mode 100644 --- a/distrib-src/Main.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Main where -import Text.Pandoc -import qualified Text.Pandoc.UTF8 as UTF8 -import Data.Char (toUpper) -import Control.Monad -import System.FilePath -import System.Environment (getArgs) -import System.Directory -import Distribution.PackageDescription.Parse -import Distribution.Verbosity (normal) -import Distribution.PackageDescription -import Text.Pandoc.Builder -import Distribution.Package -import Data.Time.Clock -import Data.Time -import System.Locale -import Distribution.Version (versionBranch) -import Data.List (intercalate) - --- It is helper executable updating documentation --- and distribution packages with --- latest metadata from .cabal file - -main :: IO () -main = do - verbose <- liftM (elem "--verbose") getArgs - cabalMeta <- liftM packageDescription $ readPackageDescription normal "adblock2privoxy.cabal" - createManPage verbose cabalMeta - -createManPage:: Bool -> PackageDescription -> IO () -createManPage verbose cabalMeta = do - pandoc <- liftM (readRST def) $ UTF8.readFile "README.rst" - now <- getCurrentTime - let PackageIdentifier (PackageName name) version = package cabalMeta - let versionText = intercalate "." $ map show $ versionBranch version - let pandoc' = setTitle (text $ map toUpper name) . - setAuthors [text $ author cabalMeta] . - setDate (text $ formatTime defaultTimeLocale (iso8601DateFormat Nothing) now) . - setMeta "section" (text "1") . - setMeta "header" (text "General Commands Manual") . - setMeta "footer" (text $ name ++ " " ++ versionText) - $ pandoc - createDirectoryIfMissing True ("man" "man1") - writeManPage verbose ("man" "man1" "adblock2privoxy.1") pandoc' - -writeManPage :: Bool -> FilePath -> Pandoc -> IO () -writeManPage verbose page pandoc = do - template <- getDefaultTemplate Nothing "man" - case template of - Left ex -> print ex - Right template' -> do - let opts = def{ writerStandalone = True, - writerTemplate = template'} - let manPage = writeMan opts $ - bottomUp capitalizeHeaders pandoc - UTF8.writeFile page manPage - when verbose $ putStrLn $ "Created " ++ page - -capitalizeHeaders :: Block -> Block -capitalizeHeaders (Header 1 attr xs) = Header 1 attr $ bottomUp capitalize xs -capitalizeHeaders x = x - -capitalize :: Inline -> Inline -capitalize (Str xs) = Str $ map toUpper xs -capitalize x = x diff --git a/distribution/buildWin.bat b/distribution/buildWin.bat new file mode 100644 --- /dev/null +++ b/distribution/buildWin.bat @@ -0,0 +1,17 @@ +@ECHO OFF +ECHO This script compiles adblock2privoxy to windows binary. + +ECHO Make sure you have Haskell comiler and Cabal installed before run of this script. +ECHO You can download MinGHC installer (including GHC 7.8.3 compiler and Cabal) +ECHO from https://s3.amazonaws.com/download.fpcomplete.com/minghc/minghc-7.8.3.exe. + +MKDIR binary\adblock2privoxy +CD .. +cabal update +runhaskell Setup.hs configure --user --prefix=%cd%\distribution\binary\adblock2privoxy +runhaskell Setup.hs build +runhaskell Setup.hs install +CD distribution\binary + +ECHO Build is done. The result is in current folder +ECHO You can copy it to the final destination and run the executable from bin folder diff --git a/distribution/makeFedoraRpm.sh b/distribution/makeFedoraRpm.sh new file mode 100644 --- /dev/null +++ b/distribution/makeFedoraRpm.sh @@ -0,0 +1,28 @@ +#!/bin/bash +set -e +echo This script compiles adblock2privoxy to binary RPM and DEB on Fedora Core. + +echo "create build folders" +mkdir -p rpmbuild/BUILD +ln -nsf ../../.. rpmbuild/BUILD/root +mkdir -p rpmbuild/BUILDROOT +mkdir -p rpmbuild/RPMS + +echo "install build tools and dependencies" +sudo yum -y install @development-tools +sudo yum -y install fedora-packager +#sudo yum -y install alien +#sudo yum -y install dpkg-dev +sudo yum-builddep -y rpmbuild/SPECS/adblock2privoxy.spec + +echo "build RPM" +rpmbuild --define "_topdir `pwd`/rpmbuild" -bb rpmbuild/SPECS/adblock2privoxy.spec + +mkdir -p binary +mv rpmbuild/RPMS/*/* binary/ +cd binary + +#echo "convert to DEB" +#sudo alien * + +echo Build is done. The result is in current folder diff --git a/distribution/rpmbuild/SPECS/adblock2privoxy.spec b/distribution/rpmbuild/SPECS/adblock2privoxy.spec new file mode 100644 --- /dev/null +++ b/distribution/rpmbuild/SPECS/adblock2privoxy.spec @@ -0,0 +1,71 @@ +Name: adblock2privoxy +Version: 1.3.0 +Release: 1%{?dist} +Summary: Convert adblock config files to privoxy format + +License: GPL-3 +URL: https://projects.zubr.me/wiki/adblock2privoxy +Source0: http://hackage.haskell.org/package/adblock2privoxy-1.3.0/adblock2privoxy-1.3.0.tar.gz +Vendor: Alexey Zubritskiy +Group: Web + +BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-rpm-macros +BuildRequires: cabal-install +BuildRequires: zlib-devel + +%description +AdBlock Plus browser plugin has great block list files provided by big community, +but it is client software and cannot work on a server as proxy. + +Privoxy proxy has good potential to block ads at server side, +but it experiences acute shortage of updated block lists. + +This software converts adblock lists to privoxy config files format. + +Almost all adblock features are supported including + +* block/unblock requests (on privoxy) + +all syntax features are supported except for regex templates matching host name + +* hide/unhide page elements (via CSS) + +all syntax features are supported + +* all block request options except for outdated ones: + +Supported: script, image, stylesheet, object, xmlhttprequest, object-subrequest, subdocument, +document, elemhide, other, popup, third-party, domain=..., match-case, donottrack + +Unsupported: collapse, background, xbl, ping and dtd + + +%prep +%setup -q -T -D -n root +cabal update +cabal install --user --only-dependencies --enable-optimization=2 + + +%build +%global cabal_configure_options --user +%global ghc_user_conf 1 +%global ghc_without_dynamic 1 +%ghc_bin_build + + +%install +%ghc_bin_install +cp -r man %{buildroot}%{_mandir} + + +%files +%doc %{_mandir} +%doc LICENSE README.rst INSTALL.rst changelog +%{_bindir}/%{name} +%{_datadir}/%{name}-%{version} + + +%changelog +* Sun Jan 04 2015 Alexey Zubritskiy - 1.3.0 +- Rpm release for new version (generated from cabal file) diff --git a/man/man1/adblock2privoxy.1 b/man/man1/adblock2privoxy.1 --- a/man/man1/adblock2privoxy.1 +++ b/man/man1/adblock2privoxy.1 @@ -1,9 +1,8 @@ -.TH "ADBLOCK2PRIVOXY" "1" "2014\-11\-30" "adblock2privoxy 1.2.4" "General Commands Manual" +.TH "ADBLOCK2PRIVOXY" "1" "2015\-01\-04" "adblock2privoxy 1.3.0" "General Commands Manual" .SH ADBLOCK2PRIVOXY .PP \f[B]Convert adblock config files to privoxy format\f[] -.PP -Synopsis1 \-\-\-\-\-\-\-\- +.SS Synopsis .RS .PP adblock2privoxy [OPTION...] [URL...] @@ -45,7 +44,7 @@ .RE .PP Tested with privoxy version 3.0.21. -Element blocking feature requires a webserver to serve CSS files. +Element hiding feature requires a webserver to serve CSS files. See Nginx and Apache config examples provided. .SS Description .PP @@ -60,38 +59,57 @@ .SS Options .RS .TP -.B \-v, \-\-version -show version number +.B \-v \-\-version +Show version number .RS .RE .TP -.B \-p PATH, \-\-privoxyDir=PATH -privoxy config output path (required) +.B \-p PATH \-\-privoxyDir=PATH +Privoxy config output path .RS .RE .TP -.B \-w PATH, \-\-webDir=PATH -css files output path (optional, privoxyDir is used by default) +.B \-w PATH \-\-webDir=PATH +Css files output path .RS .RE .TP -.B \-t PATH, \-\-taskFile=PATH -path to task file containing urls to process +.B \-d DOMAIN \-\-domainCSS=DOMAIN +Domain of CSS web server (required for Element Hide functionality) .RS .RE .TP -.B \-f, \-\-forced -run even if no sources are expired +.B \-t PATH \-\-taskFile=PATH +Path to task file containing urls to process and options. .RS .RE +.TP +.B \-f \-\-forced +Run even if no sources are expired +.RS .RE +.RE +.PP +If taskFile is not specified explicilty, [privoxyDir]/ab2p.task is used. +.PP +If task file exists and privoxyDir, webDir or domainCSS is not +specified, corresponding value is taken from task file. +.PP +If webDir is not specified (and cannot be taken from task file), +privoxyDir value is used for webDir. +.PP +If domainCSS is not specified (and cannot be taken from task file), +Element Hide functionality become disabled (and no webserver is needed). +.PP +domainCSS can contain just IP address if no CSS web server has no +associated domain. .SS Usage .PP Example of first run: .IP .nf \f[C] -adblock2privoxy\ \-p\ /etc/privoxy\ \-w\ /var/www/privoxy\ \-t\ my_ab2b.task\ https://easylist\-downloads.adblockplus.org/easylist.txt\ https://easylist\-downloads.adblockplus.org/advblock.txt\ my_custom.txt +adblock2privoxy\ \-p\ /etc/privoxy\ \-w\ /var/www/privoxy\ \-d\ www.example.com\ \-t\ my_ab2b.task\ https://easylist\-downloads.adblockplus.org/easylist.txt\ https://easylist\-downloads.adblockplus.org/advblock.txt\ my_custom.txt \f[] .fi .PP @@ -99,7 +117,7 @@ .IP .nf \f[C] -adblock2privoxy\ \-p\ /etc/privoxy\ \-w\ /var/www/privoxy\ \-t\ my_ab2b.task +adblock2privoxy\ \-t\ my_ab2b.task \f[] .fi .PP @@ -125,7 +143,7 @@ .IP \[bu] 2 ab2p.css .IP \[bu] 2 -[lot of directories for first level domain names] +[lot of directories for all levels of domain names] .RE .IP \[bu] 2 taskFile: @@ -133,20 +151,26 @@ .RS .IP \[bu] 2 special file containing execution details. -It can be reused to update privoxy config from same sources. +It can be reused to update privoxy config from same sources with same +options. .RE .SS How to apply results .IP "1." 3 Install privoxy. Optionally setup it as transparent proxy .IP "2." 3 -Change privoxy config file: Add following lines +Change privoxy config file. +Add following lines: .RS 4 -.RS -.PP -actionsfile ab2p.system.action actionsfile ab2p.action filterfile -ab2p.system.filter filterfile ab2p.filter -.RE +.IP +.nf +\f[C] +actionsfile\ ab2p.system.action +actionsfile\ ab2p.action +filterfile\ ab2p.system.filter +filterfile\ ab2p.filter +\f[] +.fi .RE .IP "3." 3 Install nginx or apache webserver @@ -158,8 +182,8 @@ \f[C] server\ { \ \ \ \ \ \ \ \ listen\ 80; -\ \ \ \ \ \ \ \ #ab2p\ css\ domain\ name\ (optional) -\ \ \ \ \ \ \ \ server_name\ privoxy.zubr.me; +\ \ \ \ \ \ \ \ #ab2p\ css\ domain\ name\ (optional,\ should\ be\ equal\ to\ domainCSS\ parameter) +\ \ \ \ \ \ \ \ server_name\ www.example.com; \ \ \ \ \ \ \ \ #root\ =\ webDir\ parameter\ value\ \ \ \ \ \ \ \ \ root\ /var/www/privoxy;\ @@ -183,7 +207,7 @@ .nf \f[C] -\ \ \ \ \ \ \ \ #ab2p\ css\ domain\ name\ (optional) +\ \ \ \ \ \ \ \ #ab2p\ css\ domain\ name\ (optional,\ should\ be\ equal\ to\ domainCSS\ parameter) \ \ \ \ \ \ \ \ ServerName\ www.example.com\ \ \ \ \ \ \ \ \ #root\ =\ webDir\ parameter\ value\ @@ -213,8 +237,8 @@ Russian AD list (https://code.google.com/p/ruadlist/) .RE .IP "5)" 3 -Run adblock2privoxy providing privoxy dir, web dir and adblock input -file urls +Run adblock2privoxy providing privoxy dir, web dir, domain and adblock +input file urls .IP "6)" 3 Restart privoxy and apache to load updated configs .PP diff --git a/src/ElementBlocker.hs b/src/ElementBlocker.hs --- a/src/ElementBlocker.hs +++ b/src/ElementBlocker.hs @@ -67,6 +67,7 @@ splitEvery n = takeWhile (not . null) . unfoldr (Just . splitAt n) writeCssFile filename content = do outFile <- openFile filename WriteMode + hSetEncoding outFile utf8 hPutStrLn outFile "/*" _ <- mapM (hPutStrLn outFile) info' hPutStrLn outFile "*/" diff --git a/src/InputParser.hs b/src/InputParser.hs --- a/src/InputParser.hs +++ b/src/InputParser.hs @@ -54,7 +54,7 @@ } deriving (Read,Show,Eq) --- primitive +-- primitive type Pattern = String type Domain = String diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -5,8 +5,8 @@ import Text.ParserCombinators.Parsec hiding (Line, many, optional) import Task import Control.Applicative hiding (many) -import SourceInfo -import System.Console.GetOpt +import SourceInfo as Source +import ProgramOptions as Options import System.Environment import Templates import Data.Time.Clock @@ -15,77 +15,33 @@ import Data.Text.Lazy.Encoding import Data.Text.Lazy (unpack) import Network.Socket -import System.FilePath -import Paths_adblock2privoxy (version) -import Data.Version (showVersion) - -data Options = Options - { _showVersion :: Bool - , _privoxyDir :: FilePath - , _webDir :: FilePath - , _taskFile :: FilePath - , _forced :: Bool - } deriving Show - -options :: [OptDescr (Options -> Options)] -options = - [ Option "v" ["version"] - (NoArg (\ opts -> opts { _showVersion = True })) - "show version number" - , Option "p" ["privoxyDir"] - (ReqArg (\ f opts -> opts { _privoxyDir = f }) - "PATH") - "privoxy config output path (required)" - , Option "w" ["webDir"] - (ReqArg (\ f opts -> opts { _webDir = f }) - "PATH") - "css files output path (optional, privoxyDir is used by default)" - , Option "t" ["taskFile"] - (ReqArg (\ f opts -> opts { _taskFile = f }) - "PATH") - "path to task file containing urls to process" - , Option "f" ["forced"] - (NoArg (\ opts -> opts { _forced = True })) - "run even if no sources are expired" - ] +import System.Directory -parseOptions :: [String] -> IO (Options, [String]) -parseOptions argv = - case getOpt Permute options argv of - (opts,nonOpts,[] ) -> - case foldl (flip id) (Options False "" "" "" False) opts of - Options False "" _ _ _ -> writeError "Privoxy dir is not specified.\n" - opts'@Options{_showVersion = True} -> return (opts', nonOpts) - opts' -> return (setDefaults opts', nonOpts) - (_,_,errs) -> writeError $ concat errs - where - setDefaults opts@(Options _ privoxyDir "" _ _) = setDefaults opts{ _webDir = privoxyDir } - setDefaults opts@(Options _ privoxyDir _ "" _) = setDefaults opts{ _taskFile = privoxyDir "ab2p.task" } - setDefaults opts = opts -writeError :: String -> IO a -writeError msg = ioError $ userError $ msg ++ usageInfo header options - where - header = "Usage: adblock2privoxy [OPTION...] [URL...]" - getResponse :: String -> IO String -getResponse url = withSocketsDo $ unpack . decodeUtf8 <$> simpleHttp url +getResponse url = do + putStrLn $ "load " ++ url ++ "..." + withSocketsDo $ unpack . decodeUtf8 <$> simpleHttp url -processSources :: String -> String -> String -> [SourceInfo]-> IO () -processSources privoxyDir webDir taskFile sources = do +processSources :: Options -> String -> [SourceInfo]-> IO () +processSources options taskFile sources = do (parsed, sourceInfo) <- unzip <$> mapM parseSource sources let parsed' = concat parsed - infoText = showInfos sourceInfo - writeTask taskFile infoText parsed' - elemBlock webDir infoText parsed' - urlBlock privoxyDir infoText parsed' - writeTemplateFiles privoxyDir + sourceInfoText = showInfo sourceInfo + optionsText = logOptions options + writeTask taskFile (sourceInfoText ++ optionsText) parsed' + if null._cssDomain $ options + then putStrLn "WARNING: CSS generation is not run because webserver domain is not specified" + else elemBlock (_webDir options) sourceInfoText parsed' + urlBlock (_privoxyDir options) sourceInfoText parsed' + writeTemplateFiles (_privoxyDir options) (_cssDomain options) + putStrLn $ "Run 'adblock2privoxy -t " ++ taskFile ++ "' every 1-2 days to process data updates." where parseSource sourceInfo = do let url = _url sourceInfo loader = if isURI url then getResponse else readFile - putStrLn $ "parse " ++ url + putStrLn $ "process " ++ url text <- loader url now <- getCurrentTime case parse adblockFile url text of @@ -101,19 +57,27 @@ main = do now <- getCurrentTime args <- getArgs - (Options printVersion privoxyDir webDir taskFile forced, urls) <- parseOptions args - let acton - | printVersion = putStrLn $ "adblock2privoxy version " ++ (showVersion version) + (options@(Options printVersion _ _ taskFile _ forced), urls) <- parseOptions args + (options', task) <- do + fileExists <- doesFileExist taskFile + if fileExists + then do task <- readTask taskFile + return (fillFromLog options task, Just task) + else return (options, Nothing) + let + action + | printVersion = putStrLn versionText | not . null $ urls - = processSources privoxyDir webDir taskFile (makeInfo <$> urls) - | not . null $ taskFile - = do task <- readTask taskFile - let sources = logInfo task - if forced || or (infoExpired now <$> sources) - then processSources privoxyDir webDir taskFile sources - else putStrLn "all sources are up to date" - | otherwise = writeError "no input specified" - acton + = processSources options' taskFile (makeInfo <$> urls) + | otherwise = case task of + Nothing -> writeError "no input specified" + (Just task') -> do + let sources = Source.readLogInfos task' + if forced || or (infoExpired now <$> sources) + then processSources options' taskFile sources + else putStrLn "all sources are up to date" + + action now' <- getCurrentTime - putStrLn $ concat ["done in ", show $ diffUTCTime now' now, " seconds"] + putStrLn $ concat ["Execution done in ", show $ diffUTCTime now' now, " seconds."] diff --git a/src/ParsecExt.hs b/src/ParsecExt.hs --- a/src/ParsecExt.hs +++ b/src/ParsecExt.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE RankNTypes, ScopedTypeVariables, FlexibleInstances #-} module ParsecExt ( CasesParser, StateParser, @@ -17,7 +16,7 @@ import Control.Monad.State import Data.Maybe --- parser should consume some input to prevent infinite loop +-- parser should consume some input to prevent infinite loop manyCases :: (Monoid a, Monoid st) => Parser a -> StateParser st a manyCases p = do acc <- get put $ Just mempty @@ -70,6 +69,6 @@ lift (put Nothing) (mapRWST.mapStateT) lookAhead $ casesParser acc' next lift (put st) - when (not.null $ input) $ casesParser acc' parsers + unless (null input) $ casesParser acc' parsers ------------------------------------------------------------------------------------------------ diff --git a/src/PatternConverter.hs b/src/PatternConverter.hs --- a/src/PatternConverter.hs +++ b/src/PatternConverter.hs @@ -46,7 +46,8 @@ changeFirst [] = [] changeFirst (first:cs) | first == '*' = '.' : '*' : cs - | bindStart == Hard || proto /= "" = first : cs + | bindStart == Hard || proto /= "" = first : cs + | bindStart == Soft = '.' : first : cs | otherwise = '.' : '*' : first : cs query' = case query of @@ -135,15 +136,8 @@ query' = if "*" `isSuffixOf` host && query /= "" then '*' : query else query in [url {_query = query'}] else [] --- www = case regular of --- [regular'] -> [regular'{_host = "www." ++ host} | --- bs == Soft && --- proto == "" && --- host /= "" && --- not ("*" `isPrefixOf` host) && --- not ("." `isPrefixOf` host)] --- _ -> [] - -- TODO: process port as an url part + + -- TODO: process port as an url part urlParts :: [StringStateParser (String,String,String)] urlParts = square3 proto (manyCases host) (oneCase query) where diff --git a/src/PolicyTree.hs b/src/PolicyTree.hs --- a/src/PolicyTree.hs +++ b/src/PolicyTree.hs @@ -23,7 +23,7 @@ showTree :: Show a => Int -> DomainTree a -> String showTree lvl (Node name value children) = concat $ - [replicate (lvl * 2) ' ', "\"", name, "\" - ", (show value)] + [replicate (lvl * 2) ' ', "\"", name, "\" - ", show value] ++ (('\n':) <$> showTree (lvl + 1) <$> children) instance Show a => Show (DomainTree a) where @@ -97,7 +97,7 @@ trimTree :: NodePolicy -> PolicyTree -> PolicyTree trimTree trump (Node name policy children) = Node name policy childrenFiltered - where + where childrenFiltered = filter (not.redundantChild) childrenTrimmed childrenTrimmed = trimTree trump <$> children redundantChild (Node _ childPolicy childChildren) = samePolicy childPolicy && null childChildren diff --git a/src/SourceInfo.hs b/src/SourceInfo.hs --- a/src/SourceInfo.hs +++ b/src/SourceInfo.hs @@ -1,10 +1,10 @@ module SourceInfo ( SourceInfo(_url), -showInfos, +showInfo, updateInfo, makeInfo, -logInfo, +readLogInfos, infoExpired ) where import InputParser @@ -31,15 +31,15 @@ endMark :: String endMark = "------- end ------" -showInfos :: [SourceInfo] -> [String] -showInfos sourceInfos = (sourceInfos >>= showInfo) ++ [endMark ++ "\n"] +showInfo :: [SourceInfo] -> [String] +showInfo sourceInfos = (sourceInfos >>= showInfoItem) ++ [endMark ++ "\n"] -showInfo :: SourceInfo -> [String] -showInfo sourceInfo@(SourceInfo _ url _ _ lastUpdated expires _ expired) = +showInfoItem :: SourceInfo -> [String] +showInfoItem sourceInfo@(SourceInfo _ url _ _ lastUpdated expires _ expired) = catMaybes [ Just separator, optionalLine "Title: " _title, - Just $ concat ["Url: ", url], - Just $ concat ["Last modified: ", formatTime defaultTimeLocale "%d %b %Y %H:%M %Z" lastUpdated], + Just $ "Url: " ++ url, + Just $ "Last modified: " ++ formatTime defaultTimeLocale "%d %b %Y %H:%M %Z" lastUpdated, Just $ concat ["Expires: ", show expires, " hours", expiredMark], optionalLine "Version: " $ show . _version, optionalLine "License: " _license, @@ -48,7 +48,7 @@ expiredMark | expired = " (expired)" | otherwise = "" optionalLine caption getter | getter sourceInfo == getter emptySourceInfo = Nothing - | otherwise = Just $ concat [caption, getter sourceInfo] + | otherwise = Just $ caption ++ getter sourceInfo updateInfo :: UTCTime -> [Line] -> SourceInfo -> SourceInfo updateInfo now lns old @@ -60,19 +60,19 @@ makeInfo :: String -> SourceInfo makeInfo url = emptySourceInfo { _url = url } -logInfo :: [String] -> [SourceInfo] -logInfo lns = chunkInfo <$> chunks +readLogInfos :: [String] -> [SourceInfo] +readLogInfos lns = chunkInfo <$> chunks where chunks = filter (not.null) . split [separator] . takeWhile (/= endMark) $ lns chunkInfo chunk = execState (sequence $ parseInfo <$> chunk) emptySourceInfo infoExpired :: UTCTime -> SourceInfo -> Bool infoExpired now (SourceInfo _ _ _ _ lastUpdated expires _ _ ) = - diffUTCTime now lastUpdated > (fromInteger $ expires * 60 * 60) + diffUTCTime now lastUpdated > fromInteger (expires * 60 * 60) lineComment :: Line -> String lineComment (Line _ (Comment text)) = text -lineComment _ = "" +lineComment _ = "" parseInfo :: String -> State SourceInfo () parseInfo text = do @@ -86,7 +86,7 @@ <$> parseTime defaultTimeLocale "%d %b %Y %H:%M %Z" <$> (string "Last modified: " *> many1 anyChar) licenseParser = (\x -> info{_license = x}) - <$> ((string "Licen" <|> string "Лицензия") *> (manyTill anyChar $ char ':') + <$> ((string "Licen" <|> string "Лицензия") *> manyTill anyChar (char ':') *> skipMany (char ' ') *> many1 anyChar) expiresParser = (\n unit -> info{_expires = unit * read n}) <$> (string "Expires: " *> many1 digit) <*> (24 <$ string " days" <|> 1 <$ string " hours") diff --git a/src/Statistics.hs b/src/Statistics.hs --- a/src/Statistics.hs +++ b/src/Statistics.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Statistics ( collectStat )where @@ -23,7 +22,7 @@ isJustFilled (Just list) = not.null $ list -getStat :: Line -> Stat-> Stat +getStat :: Line -> Stat-> Stat getStat (Line _ Comment {} ) = increment "Comments" getStat (Line _ Error {}) = increment "Errors" getStat (Line _ ElementHide {}) = increment "Elements hiding rules" diff --git a/src/Task.hs b/src/Task.hs --- a/src/Task.hs +++ b/src/Task.hs @@ -2,6 +2,7 @@ writeTask, readTask ) where +import System.IO.Strict as Strict import System.IO import InputParser import Statistics @@ -14,7 +15,7 @@ errorLine (Line position (Error text)) = [concat ["ERROR: ", recordSourceText position, " - ", text]] errorLine _ = [] - in do + in do outFile <- openFile filename WriteMode _ <- mapM (hPutStrLn outFile) info _ <- sequence $ hPutStrLn outFile <$> statistics @@ -23,6 +24,6 @@ readTask :: String -> IO [String] readTask path = do - result <- lines <$> readFile path + result <- lines <$> Strict.readFile path return $ length result `seq` result --read whole file to allow its overwriting diff --git a/src/Templates.hs b/src/Templates.hs --- a/src/Templates.hs +++ b/src/Templates.hs @@ -1,8 +1,9 @@ module Templates where import {-# SOURCE #-} UrlBlocker import Paths_adblock2privoxy -import System.Directory (copyFile) import System.FilePath (()) +import Data.String.Utils (replace, startswith) +import Control.Applicative blockCss, ab2pPrefix, actionsFilePrefix, filtersFilePrefix :: String blockCss = "{display:none!important;visibility:hidden!important}" @@ -28,11 +29,20 @@ terminalActionSwitch True Dnt = "+add-header{DNT: 1}" terminalActionSwitch _ _ = "" -writeTemplateFiles :: String -> IO () -writeTemplateFiles outDir = do +writeTemplateFiles :: String -> String -> IO () +writeTemplateFiles outDir cssDomain = do copySystem "ab2p.system.action" copySystem "ab2p.system.filter" - where + where + filterDomain content = unlines $ filterLine <$> lns + where + lns = lines content + replace' line (from, to) = replace from to line + filterLine line + | null cssDomain && startswith "[?CSS_DOMAIN]" line = "" + | otherwise = foldl replace' line [("[?CSS_DOMAIN]", ""), ("[CSS_DOMAIN]", cssDomain)] + copySystem file = do dataDir <- getDataDir - copyFile (dataDir "templates" file) (outDir file) + content <- readFile $ dataDir "templates" file + writeFile (outDir file) $ filterDomain content diff --git a/src/UrlBlocker.hs b/src/UrlBlocker.hs --- a/src/UrlBlocker.hs +++ b/src/UrlBlocker.hs @@ -15,7 +15,7 @@ import qualified Templates import qualified Data.Map as Map import Data.String.Utils (split) -import Data.Maybe +import Data.Maybe import System.IO import System.FilePath import PatternConverter @@ -47,13 +47,14 @@ writeContent (path "ab2p.action") Templates.actionsFilePrefix actions writeContent filename header content = do outFile <- openFile filename WriteMode - hPutStrLn outFile (header) + hSetEncoding outFile utf8 + hPutStrLn outFile header _ <- mapM (hPutStrLn outFile) $ ('#':) <$> info hPutStrLn outFile $ intercalate "\n\n" $ show <$> content hClose outFile urlBlockData :: [Line] -> UrlBlockData -urlBlockData lns = filterBlockData $ result +urlBlockData lns = filterBlockData result where result = mconcat [nodeResult node | node <- shortenNodes $ sortBy cmpPolicy $ filterNodesList blockLines] cmpPolicy node1 node2 = compare (_policy node1) (_policy node2) @@ -69,7 +70,7 @@ blockLine _ = [] filterNodesList :: [FilteringNode] -> [FilteringNode] -filterNodesList nodes = Map.foldr (:) [] $ Map.fromListWith joinNodes $ list +filterNodesList nodes = Map.foldr (:) [] $ Map.fromListWith joinNodes list where list = [(name node, node) | node <- nodes] joinNodes (Node patterns1 filters1 type1 policy1 method1) @@ -89,7 +90,7 @@ shortenNodes nodes = evalState (mapM shortenNode nodes) initialState where initialState = Map.empty :: Map.Map String String - shortenNode node = (\f -> node {_filters = f}) <$> ((mapM.mapM) shortenFilter $ _filters node) + shortenNode node = (\f -> node {_filters = f}) <$> (mapM.mapM) shortenFilter (_filters node) shortenFilter headerFilter@(HeaderFilter headerType flt) = let filterCode = _code flt in do @@ -100,7 +101,7 @@ (_,[]) -> return headerFilter (start, rest) -> let end = last $ split "]" rest - shortenCode' = start ++ (show $ Map.size dictionary + 1) ++ end + shortenCode' = start ++ show (Map.size dictionary + 1) ++ end in do put $ Map.insert filterCode shortenCode' dictionary return $ HeaderFilter headerType flt { _code = shortenCode' } @@ -116,13 +117,13 @@ popupResult = maybeToList (optionsToNodes (singleTypeOptions Popup) $> Xpopup) requestType = _requestType requestOptions mainOptions = [requestOptions {_requestType = requestType { _positive = mainPosRequestTypes } }] - mainPosRequestTypes = filter (`notElem` [Subdocument]) <$> (_positive requestType) - boolOptions getter = case getter requestOptions of - False -> Nothing - True -> Just requestOptions {_requestType = Restrictions Nothing [], _thirdParty = Nothing} + mainPosRequestTypes = filter (`notElem` [Subdocument]) <$> _positive requestType + boolOptions getter = if getter requestOptions + then Nothing + else Just requestOptions {_requestType = Restrictions Nothing [], _thirdParty = Nothing} singleTypeOptions singleType = do - foundTypes <- filter (== singleType) <$> (_positive requestType) + foundTypes <- filter (== singleType) <$> _positive requestType foundType <- listToMaybe foundTypes return requestOptions {_requestType = requestType { _positive = Just [foundType] } } optionsToNodes options = collectNodes patterns <$> headerFilters policy 2 <$> options @@ -156,7 +157,7 @@ (Switch False BlockAction) (Switch True . TaggerAction <$> taggers), _patterns = patterns, - _hasTag = (nodeType == Nested) } + _hasTag = nodeType == Nested } taggers = filterTaggers <$> levelFilters filterTaggers flt@(HeaderFilter _ (Filter _ _ orEmpty)) = newTagger flt nextLevelFilters policy method Regular moreForwarding @@ -182,11 +183,11 @@ filtersCode :: HeaderFilters -> ChainType -> Policy -> BlockMethod -> String -> String filtersCode [] _ policy method rest - = join [Templates.ab2pPrefix, toLower <$> show policy, "-" ,toLower <$> show method,(if null rest then "" else "-"), rest] + = join [Templates.ab2pPrefix, toLower <$> show policy, "-" ,toLower <$> show method, if null rest then "" else "-", rest] filtersCode (levelFilters : nextLevelFilters) chainType policy method rest - = filtersCode nextLevelFilters Nested policy method $ join [levelCode, (if null rest then "" else "-when-"), rest] + = filtersCode nextLevelFilters Nested policy method $ join [levelCode, if null rest then "" else "-when-", rest] where - levelCode = (intercalate "-" $ filterCode <$> levelFilters) + levelCode = intercalate "-" $ filterCode <$> levelFilters filterCode (HeaderFilter HeaderType {_typeCode = typeCode} (Filter code _ orEmpty)) | chainType == Negate = negateCode | chainType == Nested && orEmpty = negateCode ++ '-' : mainCode @@ -229,9 +230,9 @@ show (Switch enable (TaggerAction tagger)) = intercalate " \\\n " $ mainText : (_forwarding tagger >>= cancelTaggerText) where - mainText = join [name enable, name $ _taggerType $ _headerType $ tagger, "{", name tagger, "}" ] + mainText = join [name enable, name . _taggerType . _headerType $ tagger, "{", name tagger, "}" ] cancelTaggerText (CancelTagger cancelTaggerCode) - = [join [name enable, name $ _taggerType $ _headerType $ tagger, "{", cancelTaggerCode, "}" ]] + = [join [name enable, name . _taggerType . _headerType $ tagger, "{", cancelTaggerCode, "}" ]] cancelTaggerText _ = [] instance Named Action where diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Utils ( Struct2 (..), Struct3 (..), @@ -148,7 +147,9 @@ infixl 4 .*., <<$>, <<<$>, $>, $>>, $>>>, <<*>>, <<<*>>> -(.*.) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) +(.*.) :: (c -> d) -> + (a -> b -> c) -> + a -> b -> d (.*.) = (.).(.) (<<$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) diff --git a/templates/ab2p.system.action b/templates/ab2p.system.action --- a/templates/ab2p.system.action +++ b/templates/ab2p.system.action @@ -1,15 +1,15 @@ #AbBlock system actions -- don't edit -- {+set-image-blocker{blank} \ - +filter{ab2p-elemhide-filter} \ +[?CSS_DOMAIN] +filter{ab2p-elemhide-filter} \ +client-header-tagger{ab2p-elemhide-check-debug} \ +client-header-tagger{ab2p-handle-as-image-c} \ +server-header-tagger{ab2p-handle-as-image-s}} / -{-filter{ab2p-elemhide-filter} \ - +filter{ab2p-elemhide-filter-debug}} -TAG:^ab2p-elemhide-filter-debug$ +[?CSS_DOMAIN]{-filter{ab2p-elemhide-filter} \ +[?CSS_DOMAIN] +filter{ab2p-elemhide-filter-debug}} +[?CSS_DOMAIN]TAG:^ab2p-elemhide-filter-debug$ {+handle-as-image} TAG:^ab2p-handle-as-image$ diff --git a/templates/ab2p.system.filter b/templates/ab2p.system.filter --- a/templates/ab2p.system.filter +++ b/templates/ab2p.system.filter @@ -27,11 +27,11 @@ CLIENT-HEADER-TAGGER: ab2p-elemhide-check-debug s@^cookie:.*ab2p-elemhide-filter-debug=true(?:;|$).*@ab2p-elemhide-filter-debug@Ti -FILTER: ab2p-elemhide-filter -s@[^'"\s]\s*]*>(?=\s*[^'"\s])@$&@iUD +[?CSS_DOMAIN]FILTER: ab2p-elemhide-filter +[?CSS_DOMAIN]s@[^'"\s]\s*]*>(?=\s*[^'"\s])@$&@iUD -FILTER: ab2p-elemhide-filter-debug -s@[^'"\s]\s*]*>(?=\s*[^'"\s])@$&@iUD +[?CSS_DOMAIN]FILTER: ab2p-elemhide-filter-debug +[?CSS_DOMAIN]s@[^'"\s]\s*]*>(?=\s*[^'"\s])@$&@iUD FILTER: ab2p-popup-filter s@[^'"\s]\s*]*>(?=\s*[^'"\s])@$&@iUD