adblock2privoxy 1.4.2 → 2.0.0
raw patch · 14 files changed
+109/−50 lines, 14 filesnew-uploader
Files
- README.rst +2/−2
- adblock2privoxy.cabal +7/−7
- changelog +7/−0
- distribution/debbuild/DEBIAN/control +2/−2
- distribution/rpmbuild/SPECS/adblock2privoxy.spec +4/−4
- man/man1/adblock2privoxy.1 +2/−2
- src/ElementBlocker.hs +36/−14
- src/Network.hs +5/−3
- src/PatternConverter.hs +24/−9
- src/ProgramOptions.hs +1/−1
- src/SourceInfo.hs +3/−1
- src/Utils.hs +10/−0
- stack.yaml +1/−1
- templates/ab2p.system.action +5/−4
README.rst view
@@ -201,5 +201,5 @@ Contribution ------------ -* Clone repository from http://projects.zubr.me/adblock2privoxy.git.-* `Report bugs <https://projects.zubr.me/newticket?project=adblock2privoxy>`_+* Clone repository from https://github.com/essandess/adblock2privoxy.git.+* `Report bugs <https://github.com/essandess/adblock2privoxy/issues>`_
adblock2privoxy.cabal view
@@ -1,10 +1,10 @@ name: adblock2privoxy-version: 1.4.2+version: 2.0.0 cabal-version: >= 1.10 build-type: Simple tested-with:- GHC==7.10.3-author: Alexey Zubritsky <adblock2privoxy@zubr.me>+ GHC==8.4.3+author: Alexey Zubritsky <adblock2privoxy@zubr.me>, Steven Thomas Smith <steve.t.smith@gmail.com> data-files: templates/ab2p.system.action, templates/ab2p.system.filter@@ -20,10 +20,10 @@ distribution/debbuild/DEBIAN/control distribution/makeDeb.sh license: GPL-3-maintainer: Alexey Zubritskiy <adblock2privoxy@zubr.me>+maintainer: Steven Thomas Smith <steve.t.smith@gmail.com> license-file: LICENSE stability: stable-homepage: https://projects.zubr.me/wiki/adblock2privoxy+homepage: https://github.com/essandess/adblock2privoxy category: Web synopsis: Convert adblock config files to privoxy format description:@@ -101,6 +101,6 @@ source-repository this type: git- location: http://projects.zubr.me/adblock2privoxy.git+ location: https://github.com/essandess/adblock2privoxy.git subdir: adblock2privoxy- tag: 1.4.2+ tag: 2.0.0
changelog view
@@ -1,3 +1,10 @@+2.0.0+ * Update to ghc 8.4.3+ * Regex wildcard optimizations+ * Fix several parsing issues+ * Fix several privoxy action syntax issues+ * Migrate to GitHub fork+ 1.4.2 * Fixed "commitBuffer: invalid argument (invalid character)" problem * Fixed system.action file generation in case when no webserver is used
distribution/debbuild/DEBIAN/control view
@@ -2,8 +2,8 @@ Version: 1.4.2 Depends: libgmp10 Architecture: #ARCH#-Maintainer: Alexey Zubritskiy <adblock2privoxy@zubr.me>-Homepage: https://projects.zubr.me/wiki/adblock2privoxy+Maintainer: Alexey Zubritskiy <adblock2privoxy@zubr.me>, Steven Thomas Smith <steve.t.smith@gmail.com>+Homepage: https://github.com/essandess/adblock2privoxy Section: web Priority: extra Recommends: privoxy, nginx
distribution/rpmbuild/SPECS/adblock2privoxy.spec view
@@ -1,12 +1,12 @@ Name: adblock2privoxy-Version: 1.4.2+Version: 2.0.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.4.2/adblock2privoxy-1.4.2.tar.gz-Vendor: Alexey Zubritskiy <adblock2privoxy@zubr.me>+URL: https://github.com/essandess/adblock2privoxy+Source0: http://hackage.haskell.org/package/adblock2privoxy-2.0.0/adblock2privoxy-2.0.0.tar.gz+Vendor: Alexey Zubritskiy <adblock2privoxy@zubr.me>, Steven Thomas Smith <steve.t.smith@gmail.com> Group: Web BuildRequires: stack
man/man1/adblock2privoxy.1 view
@@ -242,6 +242,6 @@ .IP "6)" 3 Restart privoxy and apache to load updated configs .PP-Clone repository from <http://projects.zubr.me/adblock2privoxy.git>+Clone repository from <https://github.com/essandess/adblock2privoxy.git> .SH AUTHORS-Alexey Zubritsky <adblock2privoxy\@zubr.me>.+Alexey Zubritsky <adblock2privoxy\@zubr.me>, Steven Thomas Smith <steve.t.smith\@gmail.com>.
src/ElementBlocker.hs view
@@ -31,35 +31,57 @@ cont <- getDirectoryContents path _ <- sequence $ removeOld <$> cont createDirectoryIfMissing True debugPath- writeBlockTree path debugPath rulesTree- writePatterns filteredInfo (path </> "ab2p.common.css") (debugPath </> "ab2p.common.css") flatPatterns+ -- writeBlockTree path debugPath rulesTree+ writeBlockTree path rulesTree+ writePatterns_with_debug filteredInfo (path </> "ab2p.common.css") (debugPath </> "ab2p.common.css") flatPatterns removeOld entry' = let entry = path </> entry' in do isDir <- doesDirectoryExist entry if isDir then when (head entry' /= '.') $ removeDirectoryRecursive entry else when (takeExtension entry == ".css") $ removeFile entry- writeBlockTree :: String -> String -> BlockedRulesTree -> IO ()- writeBlockTree normalNodePath debugNodePath (Node name patterns children) =+ -- writeBlockTree :: String -> String -> BlockedRulesTree -> IO ()+ -- writeBlockTree normalNodePath debugNodePath (Node name patterns children) =+ writeBlockTree :: String -> BlockedRulesTree -> IO ()+ writeBlockTree normalNodePath (Node name patterns children) = do createDirectoryIfMissing True normalPath- createDirectoryIfMissing True debugPath- _ <- sequence (writeBlockTree normalPath debugPath <$> children)- writePatterns ["See ab2p.common.css for sources info"] normalFilename debugFilename patterns+ -- createDirectoryIfMissing True debugPath+ -- _ <- sequence (writeBlockTree normalPath debugPath <$> children)+ -- writePatterns ["See ab2p.common.css for sources info"] normalFilename debugFilename patterns+ _ <- sequence (writeBlockTree normalPath <$> children)+ writePatterns ["See ab2p.common.css for sources info"] normalFilename patterns where normalPath | null name = normalNodePath | otherwise = normalNodePath </> name- debugPath- | null name = debugNodePath- | otherwise = debugNodePath </> name+ -- debugPath+ -- | null name = debugNodePath+ -- | otherwise = debugNodePath </> name normalFilename = normalPath </> "ab2p.css"- debugFilename = debugPath </> "ab2p.css"- writePatterns :: [String] -> String -> String -> [Pattern] -> IO ()- writePatterns _ _ _ [] = return ()- writePatterns info' normalFilename debugFilename patterns =+ -- debugFilename = debugPath </> "ab2p.css"+ writePatterns_with_debug :: [String] -> String -> String -> [Pattern] -> IO ()+ writePatterns_with_debug _ _ _ [] = return ()+ writePatterns_with_debug info' normalFilename debugFilename patterns = do writeCssFile debugFilename $ intercalate "\n" $ (++ Templates.blockCss) <$> patterns+ writeCssFile normalFilename $ intercalate "\n" ((++ Templates.blockCss) . intercalate "," <$>+ splitEvery 4000 patterns)+ where+ 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 "*/"+ hPutStrLn outFile content+ hClose outFile+ writePatterns :: [String] -> String -> [Pattern] -> IO ()+ writePatterns _ _ [] = return ()+ writePatterns info' normalFilename patterns =+ do+ -- writeCssFile debugFilename $ intercalate "\n" $ (++ Templates.blockCss) <$> patterns writeCssFile normalFilename $ intercalate "\n" ((++ Templates.blockCss) . intercalate "," <$> splitEvery 4000 patterns) where
src/Network.hs view
@@ -13,11 +13,13 @@ downloadHttp :: Manager -> Int -> String -> IO String downloadHttp manager retries url = do putStrLn $ "load " ++ url ++ " (" ++ show retries ++ " more attempts)..."- req <- parseUrl url- let req' = req {responseTimeout = Just 15000000}+ req <- parseUrlThrow url -- parseUrl+ let req' = req+ -- let req' = req {responseTimeoutMicro = Just 15000000} result <- try $ liftM responseBody $ httpLbs req' manager case result of- Left e@(FailedConnectionException _ _) ->+ Left e@(HttpExceptionRequest _ (ConnectionFailure _)) ->+ -- Left e@(FailedConnectionException _ _) -> if retries > 0 then downloadHttp manager (retries - 1) url else throw e Left e -> throw e Right content -> return $ unpack.decodeUtf8 $ content
src/PatternConverter.hs view
@@ -36,17 +36,25 @@ "" -> "" _ -> changeFirst.changeLast $ host where- changeLast [] = []+ changeLast [] = []+ changeLast ('.' : '*' : [])+ | query' == "" = "."+ | otherwise = ".*"+ changeLast ('*' : '.' : [])+ | query' == "" = "*."+ | otherwise = "*.*" changeLast [lst] | lst == '|' || lst `elem` hostSeparators = []- | lst == '*' || lst == '\0' = "*."+ | lst == '*' && query' == "" = "*."+ | lst == '*' && query' /= "" = "*"+ | lst == '.' = "." | otherwise = lst : "*." changeLast (c:cs) = c : changeLast cs changeFirst [] = [] changeFirst (first:cs) | first == '*' = '.' : '*' : cs- | bindStart == Hard || proto /= "" = first : cs+ | first == '.' || bindStart == Hard || proto /= "" = first : cs | bindStart == Soft = '.' : first : cs | otherwise = '.' : '*' : first : cs @@ -60,20 +68,21 @@ _ -> replaceQuery start other (bindStart == None && host == "") where replaceQuery c cs openStart = replaceFirst c openStart ++ (join . map replaceWildcard $ cs) ++ queryEnd- replaceFirst '*' _ = ".*"+ {- http://blogs.perl.org/users/mauke/2017/05/converting-glob-patterns-to-efficient-regexes-in-perl-and-javascript.html -}+ replaceFirst '*' _ = "(*PRUNE).*?" replaceFirst c openStart | c == '/' || c == '^' = if openStart- then "(.*" ++ replaceWildcard c ++ ")?"+ then "(?:(*PRUNE).*?" ++ replaceWildcard c ++ ")?" else "" | otherwise = if openStart- then ".*" ++ replaceWildcard c+ then "(*PRUNE).*?" ++ replaceWildcard c else replaceWildcard c queryEnd = if bindEnd == None then "" else "$" replaceWildcard c | c == '^' = "[^\\w%.-]"- | c == '*' = ".*"+ | c == '*' = "(*PRUNE).*?" | c `elem` special = '\\' : [c] | otherwise = [c] where special = "?$.+[]{}()\\|" -- also ^ and * are special@@ -88,13 +97,19 @@ in parse (join <$> (fmap.fmap) postfilter raw) "url" where makeUrls start mid end = makeUrl <$> pure start <*> mid <*> pure end- makeUrl start (proto, host, query) end = UrlPattern start proto host query end False+ makeUrl start (proto, host, query) end = UrlPattern start proto (trimTrailingNul host) query end False bindStart = (try (Soft <$ string "||") <|> try (Hard <$ string "|") <|> return None) <?> "query start" queryEnd = (char '|' <* eof) <|> ('\0' <$ eof) <|> char '\0' <?> "query end" bindEnd = (\c -> if c == '|' then Hard else None) <$> queryEnd port = option False $ many1 (noneOf ":") *> char ':' *> many1 (digit <|> char '*') *> optionMaybe (oneOf "/^") *> (True <$ queryEnd) + trimTrailingNul :: String -> String+ trimTrailingNul [] = []+ trimTrailingNul (c:cs)+ | cs == [] && c == '\0' = []+ | otherwise = c : trimTrailingNul(cs)+ hostChar :: Parser Char hostChar = alphaNum <|> oneOf ".-:" @@ -158,7 +173,7 @@ else do lift $ skipMany $ char '*' --skip leading * if presented- name <- lift $ many protocolChar+ name <- lift $ many1 protocolChar sep <- lift $ many $ oneOf hostSeparators let chars = name ++ replace "^" "//" sep -- concatenate input and expand separator wildcard nextChar <- lift $ lookAhead anyChar
src/ProgramOptions.hs view
@@ -72,7 +72,7 @@ writeError msg = ioError $ userError $ msg ++ "\n" ++ usageInfo header options where header = versionText ++- "\nSee home page for more details and updates: http://projects.zubr.me/wiki/adblock2privoxy\n" +++ "\nSee home page for more details and updates: https://github.com/essandess/adblock2privoxy\n" ++ "Usage: adblock2privoxy [OPTION...] [URL...]"
src/SourceInfo.hs view
@@ -11,6 +11,7 @@ import Control.Monad.State import Control.Applicative hiding (many) import Text.ParserCombinators.Parsec hiding ((<|>),State,Line)+import Data.List import Data.Time.Clock import Data.Time.Calendar --import System.Locale@@ -90,7 +91,8 @@ *> skipMany (char ' ') *> many1 anyChar) expiresParser = (\n unit -> info{_expires = unit * read n}) <$> (string "Expires: " *> many1 digit) <*> (24 <$ string " days" <|> 1 <$ string " hours")- versionParser = (\x -> info{_version = read x}) <$> (string "Version: " *> many1 digit)+ versionnumber = intercalate "." <$> many1 digit `sepBy` char '.'+ versionParser = (\x -> info{_version = read x}) <$> (string "Version: " *> versionnumber) stringParser = skipMany (char ' ') *> (try urlParser <|> try titleParser <|> try expiresParser <|> try versionParser <|> try licenseParser <|> try homepageParser <|> try lastUpdatedParser)
src/Utils.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Utils ( Struct2 (..), Struct3 (..),@@ -57,9 +58,18 @@ zipListM :: [a] -> ZipListM a zipListM = ZipListM . ZipList +#if (MIN_VERSION_base(4,11,0))+instance Semigroup a => Semigroup (ZipListM a) where+ x <> y = (<>) <$> x <*> y+#endif+ instance Monoid a => Monoid (ZipListM a) where mempty = pure mempty+#if (MIN_VERSION_base(4,11,0))+ mappend = (<>)+#else mappend x y = mappend <$> x <*> y+#endif class Struct2 f where struct2 :: a1 -> a2 -> f a1 a2
stack.yaml view
@@ -1,7 +1,7 @@ # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)-resolver: lts-5.2+resolver: lts-12.9 # Local packages, usually specified by relative directory name packages:
templates/ab2p.system.action view
@@ -26,7 +26,8 @@ {-block} TAG:^ab2p-unblock-s$ -#workaround for gzip handling privoxy bugs-{ +prevent-compression }- *.yahoo.com- *.amazon.com+# Omit per GitHub issue #7+# workaround for gzip handling privoxy bugs+#{ +prevent-compression }+#.yahoo.com+#.amazon.com