Changeset e90f7e4 in adblock2privoxy


Ignore:
Timestamp:
Nov 3, 2013 4:43:10 PM (6 years ago)
Author:
zubr <a@…>
Branches:
master
Children:
54de81f
Parents:
26a672b
Message:

url blocker

Files:
3 added
1 deleted
11 edited

Legend:

Unmodified
Added
Removed
  • AdBlock2Privoxy.cabal

    rd0db38d re90f7e4  
    1010  build-depends:    
    1111                   base >= 4, 
    12                    MissingH, 
    1312                   parsec, 
    14                    parsec-permutation, 
    1513                   mtl, 
    1614                   containers, 
    1715                   filepath, 
    18                    directory 
     16                   directory, 
     17                   MissingH, 
     18                   parsec-permutation 
    1919  ghc-options:     -Wall 
    2020  other-modules:    
    21                    Normalizer, 
    2221                   InputParser, 
    2322                   ParsecExt, 
     
    3029                   PatternConverter, 
    3130                   UrlBlocker, 
    32                    Templates 
     31                   Templates, 
     32                   PopupBlocker, 
     33                   Statistics 
    3334 
  • notes.txt

    rd0db38d re90f7e4  
    296296~xmlhttprequest=no X-Requested-With 
    297297 
    298 third-party = Referer filled and != host 
     298third-party = Referer filled and != host AND accept/content-type empty or (!= */xml && != */html) 
    299299~third-party = Referer = host 
    300300domain=<domain> = Referer = <domain> 
     
    302302 
    303303subdocument = seth header X-Frame-Options DENY;  
    304 subdocument,third-party = seth header X-Frame-Options DENY;  
     304subdocument,third-party = seth header X-Frame-Options SAMEORIGIN;  
    305305~subdocument = (accept/content-type filled and != */html) or xmlhttprequest 
    306306 
    307 popup = mark urls in window.open?? 
     307popup = special handling with popup-block.js: replace window.open a filtering implementation 
     308 
     309 
    308310 
    309311 
     
    330332 
    331333subdocument = don't set header X-Frame-Options DENY; 
     334subdocument,~third-party = don't set header X-Frame-Options DENY; 
    332335~subdocument = accept/content-type empty or != */html OR ~third-party or xmlhttprequest !!! SPECIAL CASE 2 
    333336 
     
    335338~elemhide = undefined 
    336339 
    337 document = ??? 
    338 popup = ??? 
     340document = accept/content-type empty = */html, */xml or xmlhttprequest 
     341~document = accept/content-type empty or != */html, */xml or xmlhttprequest 
     342popup = special handling with popup-block.js 
    339343 
    340344Classification: 
  • src/ElementBlocker.hs

    rd0db38d re90f7e4  
    11module ElementBlocker ( 
    2 elemBlockData, 
    3 BlockedRulesTree, 
    4 ElemBlockData (..), 
    5 writeElemBlock 
     2elemBlock 
    63) where 
    74import InputParser hiding (Policy(..)) 
     
    2219type BlockedRulesTree = DomainTree [Pattern]  
    2320data ElemBlockData = ElemBlockData [Pattern] BlockedRulesTree deriving Show 
     21 
     22elemBlock :: String -> [Line] -> IO () 
     23elemBlock path = writeElemBlock path . elemBlockData 
    2424 
    2525writeElemBlock :: String -> ElemBlockData -> IO () 
     
    5555                        (Map.foldrWithKey appendTreePattern (Node "" [] []) policyTreeMap)  
    5656    where  
    57     policyTreeMap :: Map.Map String PolicyTree 
     57    policyTreeMap :: Map.Map String PolicyTree  
    5858    policyTreeMap =  Map.unionWith (trimTree Block .*. mergePolicyTrees Unblock)  
    5959                            blockLinesMap  
  • src/InputParser.hs

    rd0db38d re90f7e4  
    100100requestOptions :: Parser RequestOptions 
    101101requestOptions = runPermParser $ RequestOptions  
    102                                     <$> requestTypes  
     102                                    <$> (fixRestrictions <$> requestTypes)  
    103103                                    <*> (getMaybeAll <$> requestOptionNorm "ThirdParty")  
    104                                     <*> optionalDomain 
     104                                    <*> (fixRestrictions <$> optionalDomain) 
    105105                                    <*> (getAllOrFalse <$> requestOptionNorm  "MatchCase") 
    106106                                    <*> (getMaybeAll <$> requestOptionNorm "Collapse") 
     
    151151 
    152152domains :: Char -> Parser (Restrictions Domain) 
    153 domains sep = runPermParser restrictions 
     153domains sep = fixRestrictions <$> runPermParser restrictions 
    154154    where  
    155155        restrictions = Restrictions <$> (Just <$> manyPerm  (try domain)) <*> manyPerm  (try notDomain) <* manyPerm (try separator) 
     
    182182noRestrictions :: Restrictions a 
    183183noRestrictions = Restrictions Nothing [] 
     184 
     185fixRestrictions :: (Eq a) => Restrictions a -> Restrictions a 
     186fixRestrictions = annigilate.deduplicate.allowAll 
     187        where  
     188        allowAll (Restrictions (Just []) n) = Restrictions Nothing n 
     189        allowAll a = a 
     190        deduplicate (Restrictions (Just p) n) = Restrictions (Just $ nub p) (nub n) 
     191        deduplicate a = a 
     192        annigilate (Restrictions (Just p) n) =  
     193                            let notN x = x `notElem` n 
     194                            in Restrictions (Just $ filter notN p) n 
     195        annigilate a = a 
  • src/Main.hs

    r96c17d9 re90f7e4  
    11module Main where 
    22import InputParser 
    3 import Control.Applicative  
    4 import Text.ParserCombinators.Parsec hiding (Line, many, optional, (<|>)) 
    5 import Control.Monad 
    6 import Data.List 
    73import System.IO 
    8 import ParsecExt 
    9 import Normalizer 
    10 import Utils 
    11 import PolicyTree 
    124import ElementBlocker 
    13 import qualified Data.Map as Map 
    14 import Data.Maybe  
     5import UrlBlocker 
     6import Text.ParserCombinators.Parsec hiding (Line, many, optional) 
     7import Statistics 
    158 
    16  
    17 filename :: String 
    18 --filename = "/home/alexey/Projects/AdBlock2Privoxy/testData"c 
    19 filename = "/home/alexey/Downloads/easylist.txt" 
     9filename, outDir :: String 
     10filename = "/home/alexey/Projects/AdBlock2Privoxy/test-data/testData" 
     11--filename = "/home/alexey/Downloads/easylist.txt" 
    2012--filename = "/home/alexey/Downloads/advblock.txt" 
    2113outDir = "/home/alexey/test/ab" 
    22 type Stat = Map.Map String Int  
    2314 
    24  
    25 increment :: String -> Stat-> Stat 
    26 increment key map = Map.insertWith (+) key 1 map 
    27  
    28 isJustFilled Nothing = False 
    29 isJustFilled (Just list) = not.null $ list 
    30  
    31 getStat :: Line -> Stat-> Stat 
    32 getStat  (Line _ Comment) = increment "comments" 
    33 getStat  (Line _ Error {}) = increment "errors" 
    34 getStat  (Line _ ElementHide {}) = increment "elemHide" 
    35 getStat  (Line _ (RequestBlock exclude _ (RequestOptions requestType thirdParty domains _ _ _ _))) = r 
    36     where  
    37  
    38     r s = r8 s 
    39     r1 = increment "RBlock" 
    40     r2 | exclude = r1 . increment "excludeRBlock" 
    41        | otherwise = r1 
    42     r3 | isJust thirdParty = r2 . increment "thidrPartyRBlock" 
    43        | otherwise = r2 
    44     r4 | (not.null._negative $ domains) || ((isJustFilled . _positive) $ domains) = r3 . increment "domainsRBlock" 
    45        | otherwise = r3 
    46     r5 | isJust thirdParty && ((not.null._negative $ domains) || ((isJustFilled . _positive) $ domains)) = r4 . increment "domains&thirdPartyRBlock" 
    47        | otherwise = r4 
    48     r6 | ((not.null._negative $ requestType) && ((isJustFilled . _positive) $ requestType)) = r5 . increment "mixedRequestTypeRBlock" 
    49        | otherwise = r5 
    50     r7 | ((not.null._negative $ requestType) || ((isJustFilled . _positive) $ requestType)) = r6 . increment "requestTypeRBlock" 
    51        | otherwise = r6 
    52     r8 | isJust thirdParty && ((not.null._negative $ requestType) || ((isJustFilled . _positive) $ requestType)) = r7 . increment "requestType&thirdPartyRBlock" 
    53        | otherwise = r7 
    54      
    55  
    56 getWrong  (Line text (RequestBlock exclude _ (RequestOptions requestType thirdParty domains _ _ _ _))) 
    57     | ((not.null._negative $ requestType) && ((isJustFilled . _positive) $ requestType)) = Just text 
    58 getWrong _ = Nothing 
    5915 
    6016main::IO() 
    6117main = do 
     18        putStrLn $ filename ++ ": parsing started" 
    6219        inputFile <- openFile filename ReadMode 
    6320        text <- hGetContents inputFile 
    64         parsed <- return $ parse adblockFile filename text 
    65          
    66         case parsed of 
    67             --Right parsed' -> writeElemBlock outDir $ (elemBlockData $ (fixLines $ parsed')) 
    68             Right parsed' -> putStrLn $ show $ collectStat parsed' 
     21        let parsed = parse adblockFile filename text 
     22        putStrLn $ show parsed 
     23        case parsed of  
     24            Right parsed' ->  
     25                do  
     26                   stat outDir parsed' 
     27                   elemBlock (outDir ++ "/site") parsed' 
     28                   urlBlock outDir parsed' 
    6929            Left msg -> putStrLn $ show msg 
    70         ---putStrLn $ show $ fixLines <$> parsed 
    71         --putStrLn res 
    7230        hClose inputFile 
    7331        putStrLn "done" 
    74     where 
    75         collectStat = foldr getStat (Map.empty) 
     32 
  • src/OptionsConverter.hs

    r26a672b re90f7e4  
    44    HeaderType (..), 
    55    HeaderFilter (..), 
    6     FilterNode (..), 
    7     filterNodes 
     6    headerFilters 
    87) where 
    98import InputParser 
     
    2322data HeaderFilter = HeaderFilter HeaderType Filter            
    2423type HeaderFilters = [[HeaderFilter]] 
    25 data FilterNode = Node { _pattern :: [Pattern], _filters :: HeaderFilters, _isNested :: Bool, _policy :: Policy} 
    26  
    27 --TODO: SPECIAL CASE 1 & 2 
    2824 
    2925allTypes :: [HeaderType] 
     
    3733 
    3834 
    39 filterNodes :: Policy -> [Pattern] -> RequestOptions -> [FilterNode] 
    40 filterNodes policy patterns requestOptions  
    41     = collectNodes patterns $ headerFilters policy requestOptions 2 
    42     where collectNodes _ Nothing = []  
    43           collectNodes patterns' (Just filters@(_: next))  
    44             = Node patterns' filters (null patterns') policy : collectNodes [] (Just next) 
    45           collectNodes patterns' (Just []) = [Node patterns' [] (null patterns') policy] 
    46  
    47  
    48 headerFilters :: Policy -> RequestOptions -> Int -> Maybe HeaderFilters 
    49 headerFilters _ _ 1 = Just [] 
    50 headerFilters policy requestOptions level 
     35headerFilters :: Policy -> Int -> RequestOptions -> Maybe HeaderFilters 
     36headerFilters _ 0 _ = Just [] 
     37headerFilters policy level requestOptions 
    5138    = do  
    52          nextLevel <- headerFilters policy requestOptions (level - 1) 
     39         nextLevel <- headerFilters policy (level - 1) requestOptions 
    5340         let filters = do 
    5441                       headerType <- allTypes 
     
    6552acceptFilter, contentTypeFilter, requestedWithFilter, referrerFilter :: FilterFabrique 
    6653 
    67 contentTypeFilter  policy (RequestOptions (Restrictions positive negative) _ _ _ _ _ _) 
     54contentTypeFilter  policy (RequestOptions (Restrictions positive negative) thirdParty _ _ _ _ _) 
    6855    | fromMaybe False emptyPositive   = None 
    6956    | result == mempty = Any  
    7057    | otherwise = Specific $ Filter code regex orEmpty 
    71     where     
    72     negativePart = mappend ("n", "") <$> convert False negative 
     58    where  
     59    negative'  
     60        | fromMaybe False thirdParty = Document : negative 
     61        | otherwise                  = negative    
     62    negativePart = mappend ("n", "") <$> convert False negative' 
    7363    positivePart = positive >>= convert True 
    7464    result@(code, regex) = mconcat $ catMaybes [positivePart, negativePart] 
    75      
    76     emptyPositive = null . filter (`notElem` negative) <$> positive 
    7765    orEmpty = (policy == Unblock) && isNothing positive 
     66    emptyPositive = null . filter (`notElem` (fromMaybe "" $ fst <$> negativePart)) . fst <$> positivePart 
    7867    
    7968    convert _ [] = Nothing 
    8069    convert include requestTypes = let 
    81         contentTypes' = nub $ requestTypes >>= contentTypes 
     70        contentTypes' = nub $ requestTypes >>= contentTypes include 
    8271        code' = sort $ (head . dropWhile (`elem` "/(?:x-)")) <$> contentTypes' 
    8372        regex' = lookahead contentTypes' ".*" include 
     
    9786        | Xmlhttprequest `elem` negative                             = Just False 
    9887        | Xmlhttprequest `elem` fromMaybe [] positive                = Just True 
    99         |                           (hasContentTypes     negative)  
    100           && (fromMaybe True $ not . hasContentTypes <$> positive)   = Just True 
     88        |                           (hasContentTypes False    negative)  
     89          && (fromMaybe True $ not . hasContentTypes True <$> positive)   = Just True 
    10190        | otherwise                                                  = Nothing 
    10291     
    103     hasContentTypes  = not . all null . fmap contentTypes 
     92     
     93    hasContentTypes include = not . all null . fmap (contentTypes include) 
    10494 
    10595 
     
    115105     
    116106    emptyPositive = null . filter (`notElem` negative) <$> positive 
    117     orEmpty = (policy == Unblock) && (isNothing positive || (not $ fromMaybe True thirdParty)) 
     107    orEmpty =  (policy == Unblock) && (isNothing positive || (not $ fromMaybe True thirdParty)) 
    118108      
    119109    convert _ [] = Nothing 
     
    130120                  excapeRx = replace "/" "\\/" . replace "." "\\."                           
    131121                                         
    132 contentTypes :: RequestType -> [String] 
    133 contentTypes Script = ["/(?:x-)?javascript"] 
    134 contentTypes Image = ["image/"] 
    135 contentTypes Stilesheet = ["/css"] 
    136 contentTypes Object = ["video/","audio/","/(?:x-)?shockwave-flash"] 
    137 contentTypes ObjectSubrequest = ["video/","audio/","/octet-stream"] 
    138 contentTypes Subdocument = ["/html"] 
    139 contentTypes _ = []                    
     122contentTypes :: Bool -> RequestType -> [String] 
     123contentTypes _ Script = ["/(?:x-)?javascript"] 
     124contentTypes _ Image = ["image/"] 
     125contentTypes _ Stilesheet = ["/css"] 
     126contentTypes _ Object = ["video/","audio/","/(?:x-)?shockwave-flash"] 
     127contentTypes _ ObjectSubrequest = ["video/","audio/","/octet-stream"] 
     128contentTypes _ Document = ["/html", "/xml"] 
     129contentTypes False Subdocument = ["/html", "/xml"] 
     130contentTypes _ _ = []   
     131                   
  • src/PatternConverter.hs

    rd0db38d re90f7e4  
    1313import ParsecExt 
    1414import Utils 
    15  
    16 --opa s = case parseUrl s of 
    17 --        Left e -> putStrLn $ show e 
    18 --        Right urls -> putStrLn $ intercalate "\n" $ makePattern <$> urls  
    1915 
    2016data SideBind = Hard | Soft | None deriving (Show, Eq)  
  • src/Templates.hs

    rd0db38d re90f7e4  
    11module Templates where 
     2import  {-# SOURCE #-}  UrlBlocker 
    23 
    34blockCss, ab2pPrefix :: String 
     
    56ab2pPrefix = "ab2p-" 
    67 
    7 terminalActionSwitch :: Bool -> String 
    8 terminalActionSwitch True =  
     8terminalActionSwitch :: Bool -> BlockMethod -> String 
     9terminalActionSwitch True Request =  
    910 "+block{ adblock rules } \\\n\ 
    1011 \+server-header-tagger{ab2p-block-s}" 
    11 terminalActionSwitch False =  
     12terminalActionSwitch False Request =  
    1213 "-block \\\n\ 
    1314 \-server-header-tagger{ab2p-block-s} \\\n\ 
     
    1516 \+server-header-tagger{ab2p-unblock-s} \\\n\ 
    1617 \+client-header-tagger{ab2b-unblock-u}" 
     18terminalActionSwitch True Xframe = "+xframe-filter"  
     19terminalActionSwitch False Xframe = "-xframe-filter"  
     20terminalActionSwitch False Elem = "-elem-hide-filter"  
     21terminalActionSwitch _ _ = ""  
     22  
  • src/UrlBlocker.hs

    r26a672b re90f7e4  
    1 module UrlBlocker where 
     1module UrlBlocker ( 
     2BlockMethod(..), 
     3TaggerType(..), 
     4urlBlock 
     5) where 
    26import InputParser 
    37import Control.Applicative 
     
    812import OptionsConverter 
    913import Utils  
     14import Control.Monad.State 
    1015import qualified Templates  
    1116import qualified Data.Map as Map 
    12                 
     17import Data.String.Utils (split) 
     18import Data.Maybe    
     19import System.IO   
     20import System.FilePath.Posix 
     21import PatternConverter           
    1322 
    1423data TaggerType = Client | Server 
     
    1625data Tagger = Tagger { _taggerCode :: String, _forwarding :: [TaggerForwarder], _headerType :: HeaderType } 
    1726 
    18 data ActionType   = TaggerAction Tagger | BlockAction | TerminalAction 
     27data ActionType   = TaggerAction Tagger | BlockAction | TerminalAction BlockMethod 
    1928data ActionSwitch = Switch Bool ActionType 
    2029data Action = Action { _actionCode :: String, _switches :: [ActionSwitch], _patterns :: [Pattern], _hasTag :: Bool } 
    2130 
    2231type UrlBlockData = ([Tagger], [Action]) 
     32data BlockMethod = Request | Xframe | Elem deriving (Show, Eq) 
     33data FilteringNode = Node { _pattern :: [Pattern], _filters :: HeaderFilters, _isNested :: Bool,  
     34    _policy :: Policy, _method :: BlockMethod } 
    2335 
    2436class Named a where 
    2537    name :: a -> String 
    2638 
     39urlBlock :: String -> [Line] -> IO() 
     40urlBlock path = writeBlockData path . urlBlockData  
     41     
     42writeBlockData :: String -> UrlBlockData -> IO() 
     43writeBlockData path (taggers, actions) =  
     44    do writeContent (path </> "adblock.filter") "#AbBlock generated filters -- don't edit --" taggers 
     45       writeContent (path </> "adblock.action") "#AbBlock generated actions -- don't edit --" actions 
     46 
     47writeContent :: Show a => String -> String -> [a] -> IO() 
     48writeContent filename header content =  
     49     do outFile <- openFile filename WriteMode 
     50        hPutStrLn outFile (header ++ "\n")  
     51        hPutStrLn outFile $ intercalate "\n\n" $ show <$> content 
     52        hClose outFile 
     53 
    2754urlBlockData :: [Line] -> UrlBlockData  
    28 urlBlockData lns = mconcat [nodeResult node | node <- sortBy cmpPolicy filterNodesList ] 
     55urlBlockData lns = mconcat [nodeResult node | node <- shortenNodes $ sortBy cmpPolicy filterNodesList ] 
    2956    where 
    3057    cmpPolicy node1 node2 = compare (_policy node1) (_policy node2) 
     
    3259        where 
    3360        blockLine (Line _ (RequestBlock policy pattern options))  
    34             = [(name node, node) | node <- filterNodes policy [pattern] options] 
    35         blockLine _ = []   
    36         joinNodes (Node patterns1 filters1 nested1 policy1)  
    37                   (Node patterns2 _ nested2 _)  
    38             = Node (patterns1 ++ patterns2) filters1 (nested1 || nested2) policy1  
    39          
    40  
    41 nodeResult :: FilterNode -> UrlBlockData 
    42 nodeResult node@(Node patterns (levelFilters : nextLevelFilters) nested policy) 
     61            = [(name node, node) | node <- filteringNodes policy (errorToPattern expandedPatterns) options] 
     62            where  
     63            expandedPatterns = makePattern (_matchCase options) <<$> parseUrl pattern 
     64            errorToPattern (Left parseError) = ['#' : pattern ++ " - " ++ show parseError] 
     65            errorToPattern (Right patterns') = patterns' 
     66        blockLine _ = [] 
     67        joinNodes (Node patterns1 filters1 nested1 policy1 method1)  
     68                  (Node patterns2 _ nested2 _ _)  
     69            = Node (patterns1 ++ patterns2) filters1 (nested1 || nested2) policy1 method1 
     70 
     71 
     72shortenNodes :: [FilteringNode] -> [FilteringNode]       
     73shortenNodes nodes = evalState (mapM shortenNode nodes) initialState 
     74    where  
     75    initialState = Map.empty :: Map.Map String String 
     76    shortenNode node = (\f -> node {_filters = f}) <$> ((mapM.mapM) shortenFilter $ _filters node)        
     77    shortenFilter headerFilter@(HeaderFilter headerType flt)  
     78        = let filterCode = _code flt  
     79          in do  
     80             dictionary <- get  
     81             case Map.lookup filterCode dictionary of  
     82                 Just shortenCode -> return $ HeaderFilter headerType flt { _code = shortenCode } 
     83                 Nothing -> case break (=='[') filterCode of 
     84                    (_,[]) -> return headerFilter 
     85                    (start, rest) ->  
     86                        let end = last $ split "]" rest  
     87                            shortenCode' = start ++ (show $ Map.size dictionary + 1) ++  end  
     88                        in do put $ Map.insert filterCode shortenCode' dictionary 
     89                              return $ HeaderFilter headerType flt { _code = shortenCode' } 
     90                             
     91 
     92filteringNodes :: Policy -> [Pattern] -> RequestOptions -> [FilteringNode] 
     93filteringNodes policy patterns requestOptions  
     94    = join $ mainResult ++ subdocumentResult ++ elemhideResult 
     95    where  
     96    mainResult = optionsToNodes mainOptions $> Request 
     97    subdocumentResult = maybeToList (optionsToNodes (singleTypeOptions Subdocument) $> Xframe) 
     98    elemhideResult = maybeToList (optionsToNodes (singleTypeOptions Elemhide) $> Elem) 
     99    requestType = _requestType requestOptions 
     100    mainOptions = [requestOptions {_requestType = requestType { _positive = mainRequestTypes } }] 
     101    mainRequestTypes = filter (/= Subdocument) <$> (_positive requestType) 
     102    singleTypeOptions singleType =  
     103        do 
     104        foundTypes <- filter (== singleType) <$> (_positive requestType) 
     105        foundType <- listToMaybe foundTypes 
     106        return requestOptions {_requestType = requestType { _positive = Just [foundType] } } 
     107    optionsToNodes options = collectNodes patterns <$> headerFilters policy 2 <$> options 
     108    collectNodes :: [Pattern] -> Maybe HeaderFilters -> BlockMethod -> [FilteringNode] 
     109    collectNodes _ Nothing _ = []  
     110    collectNodes patterns' (Just []) method = [Node patterns' [] (null patterns') policy method] 
     111    collectNodes patterns' (Just filters@(_: next)) method 
     112            = Node patterns' filters (null patterns') policy Request : collectNodes [] (Just next) method 
     113           
     114 
     115nodeResult :: FilteringNode -> UrlBlockData 
     116nodeResult node@(Node patterns (levelFilters : nextLevelFilters) nested policy method) 
    43117    = (taggers, (mainAction : auxActions)) 
    44118    where  
    45119    mainAction = Action { _actionCode = name node, 
    46                           _switches   = appendIf (policy == Unblock)  
     120                          _switches   = appendIf (policy == Unblock && method == Request)  
    47121                                            (Switch False BlockAction) 
    48122                                            (Switch True . TaggerAction <$> taggers), 
     
    58132    taggers = levelFilters >>= filterTaggers 
    59133    filterTaggers (HeaderFilter headerType@HeaderType {_typeCode = typeCode} filter'@(Filter filterCode _ orEmpty))   
    60         | orEmpty   = [orEmptyTagger, mainTagger [Cancel orEmptyTagger]] 
    61         | otherwise = [mainTagger []] 
     134        | orEmpty  = [orEmptyTagger, mainTagger [Cancel orEmptyTagger]] 
     135        | otherwise   = [mainTagger []] 
    62136        where 
    63         nextNodeName = makeName policy nextLevelFilters 
    64         mainTagger moreForwarders = Tagger {   _taggerCode = nextNodeName $ typeCode : filterCode, 
    65                                                _forwarding = Forward (Just filter') (nextNodeName "") : moreForwarders, 
     137        nextLevelName = filtersCode policy method nextLevelFilters 
     138        mainTagger moreForwarders = Tagger {   _taggerCode = nextLevelName $ typeCode : filterCode, 
     139                                               _forwarding = Forward (Just filter') (nextLevelName "") : moreForwarders, 
    66140                                               _headerType = headerType } 
    67         orEmptyTagger             = Tagger { _taggerCode = nextNodeName ['n', typeCode], 
    68                                              _forwarding = [Forward Nothing (nextNodeName "")], 
     141        orEmptyTagger             = Tagger { _taggerCode = nextLevelName ['n', typeCode], 
     142                                             _forwarding = [Forward Nothing (nextLevelName "")], 
    69143                                             _headerType = headerType } 
    70 nodeResult node@(Node patterns [] nested policy) = ([], [baseAction]) 
    71     where baseAction = Action (name node) [Switch (policy == Block) TerminalAction] patterns nested 
     144nodeResult node@(Node patterns [] nested policy method) = ([], [baseAction]) 
     145    where baseAction = Action (name node) [Switch (policy == Block) $ TerminalAction method] patterns nested 
    72146             
    73 instance Named FilterNode where 
    74     name (Node _ filters _ policy)  = makeName policy filters ""  
    75      
    76 makeName :: Policy -> HeaderFilters -> String -> String 
    77 makeName policy [] rest  
    78     = join [Templates.ab2pPrefix, toLower <$> show policy, (if null rest then "" else "-"), rest] 
    79 makeName policy (levelFilters : nextLevelFilters) rest  
    80     = makeName policy nextLevelFilters $ join [filtersCode, (if null rest then "" else "-when-"), rest] 
    81     where  
    82     filtersCode = (intercalate "-" $ filterCode <$> levelFilters) 
     147instance Named FilteringNode where 
     148    name (Node _ filters _ policy method)  = filtersCode policy method filters ""  
     149     
     150filtersCode :: Policy -> BlockMethod -> HeaderFilters -> String -> String 
     151filtersCode policy method [] rest  
     152    = join [Templates.ab2pPrefix, toLower <$> show policy, "-" ,toLower <$> show method,(if null rest then "" else "-"), rest] 
     153filtersCode policy method (levelFilters : nextLevelFilters) rest  
     154    = filtersCode policy method nextLevelFilters $ join [levelCode, (if null rest then "" else "-when-"), rest] 
     155    where  
     156    levelCode = (intercalate "-" $ filterCode <$> levelFilters) 
    83157    filterCode (HeaderFilter HeaderType {_typeCode = typeCode} (Filter code _ orEmpty)) 
    84158        | orEmpty   = 'n' : typeCode : '-' : mainCode   
    85         | otherwise = mainCode 
     159        | otherwise    = mainCode 
    86160        where mainCode = typeCode : code 
    87161 
     
    114188 
    115189instance Show ActionSwitch where 
    116     show (Switch enable TerminalAction) = Templates.terminalActionSwitch enable 
     190    show (Switch enable (TerminalAction method)) = Templates.terminalActionSwitch enable method 
    117191    show (Switch enable BlockAction) = name enable ++ "block" 
    118192    show (Switch enable (TaggerAction tagger))  
  • src/UrlBlocker.hs-boot

    rd0db38d re90f7e4  
    11module UrlBlocker ( 
    2 TaggerType (..) 
     2BlockMethod(..), 
     3TaggerType(..) 
    34) where 
    45 
     6data BlockMethod = Request | Xframe | Elem 
    57data TaggerType = Client | Server 
  • test-data/testData

    r96c17d9 re90f7e4  
    11[Adblock Plus 2.0] 
    2 ! root level 
    3 #@#root Level Unblocked Block 
    4 #@#rootLevelUnblock 
    5 ##rootLevelBlock 
    6 ##rootLevelBlock 
    7 ##root Level Unblocked Block 
    8 ##more Root Level Block 
    9 ##root excluded 
    10 #@#root excluded3 
    11 ! domain level 
    12 a.domain##root excluded3 
    13 one.com##little block 
    14 one.com##one.com block 
    15 ad.one.com##one.com block 
    16 two.com.us##more block 
    17 three.com.us,all.com.us,bla.com.us##more block 
    18 ~foo.one.ru,~baz.one.ru,~wrong.com,one.ru,two.ru##ru block 
    19 one.org,other.org,~no.other.org,two.one.org##org blocked unblock 
    20 ~something.org,~something.one.org,~very.deep.one.org,free.one.org,deep.one.org,~two.one.org#@#org blocked unblock 
    21 !smth.com#@#root excluded 
    22 !~smth.nl##root excluded2 
     2!! root level 
     3!#@#root Level Unblocked Block 
     4!#@#rootLevelUnblock 
     5!##rootLevelBlock 
     6!##rootLevelBlock 
     7!##root Level Unblocked Block 
     8!##more Root Level Block 
     9!##root excluded 
     10!#@#root excluded3 
     11!! domain level 
     12!a.domain##root excluded3 
     13!one.com##little block 
     14!one.com##one.com block 
     15!ad.one.com##one.com block 
     16!two.com.us##more block 
     17!three.com.us,all.com.us,bla.com.us##more block 
     18!~foo.one.ru,~baz.one.ru,~wrong.com,one.ru,two.ru##ru block 
     19!one.org,other.org,~no.other.org,two.one.org##org blocked unblock 
     20!~something.org,~something.one.org,~very.deep.one.org,free.one.org,deep.one.org,~two.one.org#@#org blocked unblock 
     21!!smth.com#@#root excluded 
     22!!~smth.nl##root excluded2 
    2323 
    24  
    25  
    26  
    27 !ElemBlockData ["more Root Level Block","rootLevelBlock"]  
    28 !"" - ["root excluded","root excluded2"] 
    29 !  "us" - ["root excluded","root excluded2"] 
    30 !    "com" - ["root excluded","root excluded2"] 
    31 !      "two" - ["more block","root excluded","root excluded2"] 
    32 !      "three" - ["more block","root excluded","root excluded2"] 
    33 !      "bla" - ["more block","root excluded","root excluded2"] 
    34 !      "all" - ["more block","root excluded","root excluded2"] 
    35 !  "ru" - ["root excluded","root excluded2"] 
    36 !    "two" - ["root excluded","root excluded2","ru block"] 
    37 !    "one" - ["root excluded","root excluded2","ru block"] 
    38 !      "foo" - ["root excluded","root excluded2"] 
    39 !      "baz" - ["root excluded","root excluded2"] 
    40 !  "org" - ["root excluded","root excluded2"] 
    41 !    "other" - ["org blocked unblock","root excluded","root excluded2"] 
    42 !      "no" - ["root excluded","root excluded2"] 
    43 !    "one" - ["org blocked unblock","root excluded","root excluded2"] 
    44 !      "free" - ["root excluded","root excluded2"] 
    45 !      "deep" - ["root excluded","root excluded2"] 
    46 !        "very" - ["org blocked unblock","root excluded","root excluded2"] 
    47 !  "nl" - ["root excluded","root excluded2"] 
    48 !    "smth" - ["root excluded"] 
    49 !  "com" - ["root excluded","root excluded2"] 
    50 !    "smth" - ["root excluded2"] 
    51 !    "one" - ["little block","one.com block","root excluded","root excluded2"] 
    52 !done 
    53  
     24!_adrotator. 
     25!.co/ads/$popup 
     26||vivamob.net^$third-party 
Note: See TracChangeset for help on using the changeset viewer.