Changeset d0db38d in adblock2privoxy


Ignore:
Timestamp:
Oct 6, 2013 2:39:28 PM (6 years ago)
Author:
zubr <a@…>
Branches:
master
Children:
26a672b
Parents:
96c17d9
Message:

url blocker

Files:
7 added
1 deleted
6 edited
1 moved

Legend:

Unmodified
Added
Removed
  • AdBlock2Privoxy.cabal

    r96c17d9 rd0db38d  
    2525                   Utils, 
    2626                   ParserExtTests, 
    27                    PatternConvertor, 
    2827                   ElementBlocker, 
    2928                   PolicyTree, 
    30                    HeadersMatcher 
     29                   OptionsConverter, 
     30                   PatternConverter, 
     31                   UrlBlocker, 
     32                   Templates 
    3133 
  • src/ElementBlocker.hs

    r96c17d9 rd0db38d  
    55writeElemBlock 
    66) where 
    7 import InputParser 
     7import InputParser hiding (Policy(..)) 
     8import qualified InputParser  
    89import PolicyTree 
    910import Control.Applicative 
     
    1516import Data.List  
    1617import System.Directory (createDirectoryIfMissing) 
    17 import Control.Monad (when) 
     18import Control.Monad (unless) 
     19import qualified Templates  
    1820   
    1921 
     
    4345     do outFile <- openFile filename WriteMode 
    4446        hPutStrLn outFile $ intercalate "," patterns 
    45         when (not $ null patterns) $ hPutStrLn outFile $ blockCss 
     47        unless (null patterns) $ hPutStrLn outFile $ Templates.blockCss 
    4648        hClose outFile 
    47      where 
    48         blockCss = "{display:none,visibility:hidden}" 
     49      
     50         
    4951 
    5052elemBlockData :: [Line] -> ElemBlockData  
     
    5355                        (Map.foldrWithKey appendTreePattern (Node "" [] []) policyTreeMap)  
    5456    where  
    55     policyTreeMap = policyTrees input 
    56      
    57     policyTrees :: [Line] -> Map.Map String PolicyTree 
    58     policyTrees lns =  Map.unionWith (trimTree Block .*. mergePolicyTrees Unblock)  
     57    policyTreeMap :: Map.Map String PolicyTree 
     58    policyTreeMap =  Map.unionWith (trimTree Block .*. mergePolicyTrees Unblock)  
    5959                            blockLinesMap  
    6060                            (erasePolicy Block <$> unblockLinesMap) 
    6161        where  
    62         blockLinesMap = Map.fromListWith (mergeAndTrim Block) (mapMaybe blockLine lns) 
    63         unblockLinesMap = Map.fromListWith (mergeAndTrim Unblock) (mapMaybe unblockLine lns) 
    64         unblockLine (Line _ (ElementHide domains True pattern)) = (,) pattern <$> restrictionsTree Unblock domains 
     62        blockLinesMap = Map.fromListWith (mergeAndTrim Block) (mapMaybe blockLine input) 
     63        unblockLinesMap = Map.fromListWith (mergeAndTrim Unblock) (mapMaybe unblockLine input) 
     64        unblockLine (Line _ (ElementHide domains InputParser.Unblock pattern)) = (,) pattern <$> restrictionsTree Unblock domains 
    6565        unblockLine _ = Nothing   
    66         blockLine (Line _ (ElementHide domains False pattern)) = (,) pattern <$> restrictionsTree Block domains 
     66        blockLine (Line _ (ElementHide domains InputParser.Block pattern)) = (,) pattern <$> restrictionsTree Block domains 
    6767        blockLine _ = Nothing   
    6868         
  • src/InputParser.hs

    r96c17d9 rd0db38d  
    77Pattern, 
    88Domain, 
     9Policy (..), 
    910adblockFile 
    1011) 
     
    1819import Control.Monad 
    1920import Text.Parsec.Permutation 
    20  
     21  
    2122-------------------------------------------------------------------------- 
    2223---------------------------- data model  --------------------------------- 
     
    2728        deriving (Read,Show,Eq) 
    2829         
     30data Policy = Block | Unblock deriving (Show, Eq, Read, Ord)         
    2931data Record =   Error String | 
    3032                Comment |  
    31                 ElementHide (Restrictions Domain) Exclude Pattern |  
    32                 RequestBlock Exclude Pattern RequestOptions 
     33                ElementHide (Restrictions Domain) Policy Pattern |  
     34                RequestBlock Policy Pattern RequestOptions 
    3335        deriving (Read,Show,Eq) 
    3436                    
     
    3739                    deriving (Read, Show,Eq) 
    3840 
    39 data RequestOptions = RequestOptions  
    40                             (Restrictions RequestType)  
    41                             (Maybe ThirdParty)  
    42                             (Restrictions Domain)  
    43                             MatchCase 
    44                             (Maybe Collapse) 
    45                             DoNotTrack 
    46                             [String] 
     41data RequestOptions = RequestOptions { 
     42                            _requestType :: Restrictions RequestType,  
     43                            _thirdParty  :: Maybe Bool,  
     44                            _domain      :: Restrictions Domain,  
     45                            _matchCase   :: Bool, 
     46                            _collapse    :: Maybe Bool, 
     47                            _doNotTrack  :: Bool, 
     48                            _unknown     :: [String] 
     49                      } 
    4750        deriving (Read,Show,Eq) 
    4851 
    4952-- primitive 
    50 type ThirdParty = Bool 
    51 type Exclude = Bool 
    52 type Collapse = Bool 
    53 type MatchCase = Bool 
    54 type DoNotTrack = Bool 
    5553type Pattern = String 
    5654type Domain = String 
     
    8179elementHide = ElementHide <$> domains ',' <*> excludeMatch <*> pattern 
    8280    where 
    83         excludeMatch = char '#' *> ((False <$ string "#") <|> (True <$ string "@#")) 
     81        excludeMatch = char '#' *> ((Block <$ string "#") <|> (Unblock <$ string "@#")) 
    8482        pattern = manyTill anyChar (lookAhead lineEnd) 
    8583 
     
    8785match = RequestBlock <$> excludeMatch <*> pattern <*> options 
    8886    where 
    89         excludeMatch = option False $ True <$ count 2 (char '@') 
     87        excludeMatch = option Block $ Unblock <$ count 2 (char '@') 
    9088        patternEnd = try (return () <* char '$' <* requestOptions <* lineEnd) <|> try (return () <* lineEnd) 
    9189        pattern = manyTill anyChar (lookAhead patternEnd) 
  • src/Normalizer.hs

    rdcd1d6c rd0db38d  
    11module Normalizer ( 
    2 --opa, 
    32fixLines 
    43) where 
    54import InputParser 
    65import Control.Applicative hiding (many) 
    7 import Text.ParserCombinators.Parsec hiding (Line, (<|>)) 
    86import Control.Monad.State 
    97import Data.List 
    108import Data.String.Utils (strip) 
    119import Utils 
    12 import PatternConvertor 
     10import PatternConverter 
    1311 
    1412  
     
    2220fixLine  (Line text                     requestBlock@(RequestBlock {}))  
    2321       =  Line text <$> fixRequestBlock requestBlock  
    24           where     
    25               fixRequestBlock      (RequestBlock excl                       pattern                  options) 
    26                              = case RequestBlock excl <<$> fixBlockPattern pattern $>> fixOptions options of 
    27                                     Right res     -> res 
    28                                     Left  problem -> [Error $ show problem] 
    29               fixRequestBlock _ = undefined 
    30                               
    31               fixOptions (RequestOptions                  restrRt  tp                  restrDom  mc coll dnt u)  
    32                         = RequestOptions (fixRestrictions restrRt) tp (fixRestrictions restrDom) mc coll dnt u  
    33                
    34               fixBlockPattern :: Pattern -> Either ParseError [Pattern] 
    35               fixBlockPattern pattern = makePattern <<$> parseUrl pattern 
    36                                                     
     22          where                 
     23              fixRequestBlock (RequestBlock excl                       pattern                  options) 
     24                                = let fixedOptions = options { 
     25                                                     _requestType = fixRestrictions $ _requestType options, 
     26                                                     _domain      = fixRestrictions $      _domain options 
     27                                                     } 
     28                                      fixedPattern = makePattern (_matchCase options) <<$> parseUrl pattern 
     29                                  in case RequestBlock excl <<$> fixedPattern $>> fixedOptions of 
     30                                          Right res     -> res 
     31                                          Left  problem -> [Error $ show problem] 
     32              fixRequestBlock _ = undefined         
    3733           
    3834fixLine a = [a] 
  • src/PatternConverter.hs

    rdcd1d6c rd0db38d  
    1 module PatternConvertor ( 
     1module PatternConverter ( 
    22makePattern, 
    33parseUrl 
     
    2929              deriving (Show) 
    3030 
    31 makePattern :: UrlPattern -> Pattern 
    32 makePattern (UrlPattern bindStart proto host query bindEnd isRegex) =  if query' == ""  
    33                                                                             then host'  
    34                                                                             else host' ++ '/' : query'  
     31makePattern :: Bool -> UrlPattern -> Pattern 
     32makePattern matchCase (UrlPattern bindStart proto host query bindEnd isRegex)  
     33            | query' == "" = host'  
     34            | otherwise    = host' ++ separator' ++ query'  
    3535    where  
     36        separator'  
     37            | matchCase = "/(?-i)" 
     38            | otherwise = "/" 
    3639        host' = case host of 
    3740                    "" -> "" 
     
    5356        query' = case query of 
    5457                    ""     -> "" 
    55                     (start:other) -> if isRegex then query 
     58                    (start:other) ->  
     59                              if isRegex then query 
    5660                              else case query of 
    5761                                '*' : '/' : other' -> replaceQuery '/' other' True 
  • src/PolicyTree.hs

    rdcd1d6c rd0db38d  
    1313) where 
    1414import Control.Applicative 
    15 import InputParser 
     15import InputParser hiding (Policy(..)) 
    1616import Data.String.Utils (split) 
    1717import Utils 
     
    2323showTree :: Show a => Int -> DomainTree a -> String 
    2424showTree lvl (Node name value children)  
    25     = concat $  
     25    = concat $   
    2626        [replicate (lvl * 2) ' ', "\"", name, "\" - ", (show value)] 
    2727        ++ (('\n':) <$> showTree (lvl + 1) <$> children) 
  • src/Utils.hs

    rdcd1d6c rd0db38d  
    1212minList, 
    1313compareList, 
     14appendIf, 
    1415pure', 
    1516pure'', 
     
    4546minList :: Ord a => [a] -> [a] -> [a] 
    4647minList a b = if compareList a b == GT then b else a 
     48 
     49appendIf :: Bool -> a -> [a] -> [a] 
     50appendIf condition item list 
     51    | condition = item : list 
     52    | otherwise = list 
    4753 
    4854newtype ZipListM a = ZipListM { getZipList' :: ZipList a } deriving (Functor, Applicative) 
Note: See TracChangeset for help on using the changeset viewer.