Changeset d515b21 in adblock2privoxy


Ignore:
Timestamp:
Apr 9, 2014 10:15:54 AM (6 years ago)
Author:
zubr <a@…>
Branches:
master
Children:
f180591
Parents:
47e082f
Message:

HTTP loading support, tasks improvements, Redirect comment support

Files:
1 deleted
6 edited

Legend:

Unmodified
Added
Removed
  • adblock2privoxy.cabal

    r47e082f rd515b21  
    4949                   old-locale >=1.0.0 && <1.1, 
    5050                   strict >=0.3.2 && <0.4, 
    51                    HTTP >=4000.2.8 && <4000.3, 
    52                    network >=2.4.2 && <2.5 
     51                   network >=2.4.2 && <2.5, 
     52                   http-conduit, 
     53                   text >=0.11.3 && <0.12 
    5354  ghc-options:     -Wall 
    5455  other-modules:    
     56                   ElementBlocker, 
    5557                   InputParser, 
     58                   OptionsConverter, 
    5659                   ParsecExt, 
    57                    Utils, 
    58                    ParserExtTests, 
    59                    ElementBlocker, 
     60                   PatternConverter, 
    6061                   PolicyTree, 
    61                    OptionsConverter, 
    62                    PatternConverter, 
     62                   PopupBlocker, 
     63                   SourceInfo, 
     64                   Statistics, 
     65                   Task, 
     66                   Templates, 
    6367                   UrlBlocker, 
    64                    Templates, 
    65                    PopupBlocker, 
    66                    Statistics, 
    67                    SourceInfo 
     68                   Utils 
    6869 
    6970source-repository this 
  • src/ElementBlocker.hs

    r899fa03 rd515b21  
    1515import qualified Templates  
    1616import Control.Monad  
     17import Data.String.Utils (startswith) 
    1718   
    1819 
     
    2728        do 
    2829           let debugPath = path </> "debug" 
     30               filteredInfo = filter ((||) <$> not . startswith "Url:" <*> startswith "Url: http") info 
    2931           createDirectoryIfMissing True path 
    3032           cont <- getDirectoryContents path 
     
    3234           createDirectoryIfMissing True debugPath 
    3335           writeBlockTree path debugPath rulesTree  
    34            writePatterns info (path </> "ab2p.common.css") (debugPath </> "ab2p.common.css") flatPatterns       
     36           writePatterns filteredInfo (path </> "ab2p.common.css") (debugPath </> "ab2p.common.css") flatPatterns       
    3537    removeOld entry' =  
    3638        let entry = path </> entry' 
  • src/Main.hs

    r47e082f rd515b21  
    99import System.Console.GetOpt 
    1010import System.Environment 
    11 import Templates (writeTemplateFiles) 
    12 import Data.Time.Clock (getCurrentTime) 
    13 import Network.HTTP 
     11import Templates 
     12import Data.Time.Clock  
     13import Network.HTTP.Conduit 
    1414import Network.URI 
    15 import Utils 
     15import Data.Text.Lazy.Encoding 
     16import Data.Text.Lazy (unpack) 
     17import Network.Socket 
     18import System.FilePath 
    1619 
    1720data Options = Options 
     
    2023     , _webDir      :: FilePath 
    2124     , _taskFile    :: FilePath 
     25     , _forced    :: Bool 
    2226     } deriving Show 
    2327 
    2428options :: [OptDescr (Options -> Options)] 
    2529options = 
    26      [ Option "V" ["version"] 
     30     [ Option "v" ["version"] 
    2731         (NoArg (\ opts -> opts { _showVersion = True })) 
    2832         "show version number" 
     
    3943                 "PATH") 
    4044         "path to task file containing urls to process" 
     45     , Option "f" ["forced"] 
     46         (NoArg (\ opts -> opts { _forced = True })) 
     47         "run even if no sources are expired" 
    4148     ] 
    4249 
     
    4552   case getOpt Permute options argv of 
    4653      (opts,nonOpts,[]  ) ->  
    47                 case foldl (flip id) (Options False "" "" "") opts of 
    48                         Options False "" _ _ -> writeError "Privoxy dir is not specified.\n" 
    49                         opts'@(Options _ privoxyDir "" _) -> return (opts'{_webDir = privoxyDir}, nonOpts) 
    50                         opts' -> return (opts', nonOpts) 
     54                case foldl (flip id) (Options False "" "" "" False) opts of 
     55                        Options False "" _ _ _ -> writeError "Privoxy dir is not specified.\n" 
     56                        opts' -> return (setDefaults opts', nonOpts) 
    5157      (_,_,errs) -> writeError $ concat errs 
     58   where 
     59        setDefaults opts@(Options _ privoxyDir "" _ _) = setDefaults opts{ _webDir = privoxyDir } 
     60        setDefaults opts@(Options _ privoxyDir _ "" _) = setDefaults opts{ _taskFile = privoxyDir </> "ab2p.task" } 
     61        setDefaults opts = opts   
    5262   
    5363writeError :: String -> IO a 
     
    5767 
    5868getResponse :: String -> IO String 
    59 getResponse url = do 
    60         response <- simpleHTTP (getRequest url) 
    61         getResponseBody response 
     69getResponse url = withSocketsDo $ unpack . decodeUtf8 <$> simpleHttp url 
    6270 
    63 processSources :: String -> String -> [SourceInfo]-> IO () 
    64 processSources privoxyDir webDir sources = do  
     71processSources :: String -> String -> String -> [SourceInfo]-> IO () 
     72processSources privoxyDir webDir taskFile sources = do  
    6573        (parsed, sourceInfo) <- unzip <$> mapM parseSource sources    
    6674        let parsed' = concat parsed  
    67         infoText <- showInfos <$> getCurrentTime $> sourceInfo                
    68         writeTask privoxyDir infoText parsed' 
     75            infoText = showInfos sourceInfo                
     76        writeTask taskFile infoText parsed' 
    6977        elemBlock webDir infoText parsed' 
    7078        urlBlock privoxyDir infoText parsed' 
     
    7280        where  
    7381        parseSource sourceInfo = do 
    74                             let  
    75                                 url = _url sourceInfo 
    76                                 loader = if isURI url then getResponse else readFile 
    77                             putStrLn $ "parse " ++ url 
    78                             text <- loader url 
    79                             now <- getCurrentTime 
    80                             case parse adblockFile url text of 
    81                                 Right parsed -> return (parsed, updateInfo now parsed sourceInfo) 
    82                                 Left msg -> return ([], sourceInfo) <$ putStrLn $ show msg 
     82            let  
     83                url = _url sourceInfo 
     84                loader = if isURI url then getResponse else readFile 
     85            putStrLn $ "parse " ++ url 
     86            text <- loader url 
     87            now <- getCurrentTime 
     88            case parse adblockFile url text of 
     89                Right parsed ->  
     90                        let sourceInfo' = updateInfo now parsed sourceInfo  
     91                            url' = _url sourceInfo' 
     92                        in if url == url'      
     93                           then return (parsed, sourceInfo') 
     94                           else parseSource sourceInfo' 
     95                Left msg -> return ([], sourceInfo) <$ putStrLn $ show msg 
    8396         
    8497main::IO() 
    85 main = do  
     98main =  do  
     99        now <- getCurrentTime 
    86100        args <- getArgs 
    87         (opts, urls) <- parseOptions args 
     101        (Options showVersion privoxyDir webDir taskFile forced, urls) <- parseOptions args 
    88102        let acton 
    89                 | _showVersion opts = putStrLn "adblock2privoxy version 1.0" 
     103                | showVersion = putStrLn "adblock2privoxy version 1.0" 
    90104                | not . null $ urls  
    91                    =    processSources (_privoxyDir opts) (_webDir opts) (makeInfo <$> urls) 
    92                 | not . null $ _taskFile opts  
    93                    = do task <- readTask . _taskFile $ opts 
    94                         processSources (_privoxyDir opts) (_webDir opts) (logInfo task) 
     105                   =    processSources privoxyDir webDir taskFile (makeInfo <$> urls) 
     106                | not . null $ taskFile  
     107                   = do task <- readTask taskFile 
     108                        let sources = logInfo task                         
     109                        if forced || or (infoExpired now <$> sources)                                 
     110                                then processSources privoxyDir webDir taskFile sources 
     111                                else putStrLn "all sources are up to date" 
    95112                | otherwise = writeError "no input specified" 
    96113        acton 
    97         putStrLn "done" 
     114        now' <- getCurrentTime 
     115        putStrLn $ concat ["done in ", show $ diffUTCTime now' now, " seconds"] 
    98116 
  • src/SourceInfo.hs

    r47e082f rd515b21  
    55updateInfo, 
    66makeInfo, 
    7 logInfo 
     7logInfo, 
     8infoExpired 
    89) where 
    910import InputParser 
     
    2021 
    2122data SourceInfo = SourceInfo { _title, _url, _license, _homepage :: String,  
    22                                _lastUpdated :: UTCTime, _expires, _version :: Integer } 
     23                               _lastUpdated :: UTCTime, _expires, _version :: Integer, _expired :: Bool } 
    2324 
    2425emptySourceInfo :: SourceInfo 
    25 emptySourceInfo = SourceInfo "" "" "" "" (UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0) ) 72 0 
     26emptySourceInfo = SourceInfo "" "" "" "" (UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0) ) 72 0 True 
    2627 
    2728separator :: String 
     
    3132endMark = "------- end ------" 
    3233 
    33 showInfos :: UTCTime -> [SourceInfo] -> [String]  
    34 showInfos now sourceInfos = (sourceInfos >>= showInfo now) ++ [endMark ++ "\n"] 
     34showInfos :: [SourceInfo] -> [String]  
     35showInfos sourceInfos = (sourceInfos >>= showInfo) ++ [endMark ++ "\n"] 
    3536 
    36 showInfo :: UTCTime -> SourceInfo -> [String]  
    37 showInfo now sourceInfo@(SourceInfo _ url _ _ lastUpdated expires _) =  
     37showInfo :: SourceInfo -> [String]  
     38showInfo sourceInfo@(SourceInfo _ url _ _ lastUpdated expires _ expired) =  
    3839        catMaybes [ Just separator, 
    3940                    optionalLine "Title: " _title, 
    4041                    Just $ concat ["Url: ", url], 
    4142                    Just $ concat ["Last modified: ", formatTime defaultTimeLocale "%d %b %Y %H:%M %Z" lastUpdated], 
    42                     Just $ concat ["Expires: ", show expires, " hours", expired],  
    43                     optionalLine "Version: " _version, 
     43                    Just $ concat ["Expires: ", show expires, " hours", expiredMark],  
     44                    optionalLine "Version: " $ show . _version, 
    4445                    optionalLine "License: " _license, 
    4546                    optionalLine "Homepage: " _homepage ] 
    4647    where  
    47     expired | (diffUTCTime now lastUpdated) > (fromInteger $ expires * 60 * 60) = " (expired)" 
    48             | otherwise = "" 
     48    expiredMark | expired = " (expired)" 
     49                | otherwise = "" 
    4950    optionalLine caption getter | getter sourceInfo == getter emptySourceInfo = Nothing 
    50                                 | otherwise = Just $ concat [caption, show $ getter sourceInfo]  
     51                                | otherwise = Just $ concat [caption, getter sourceInfo]  
    5152 
    5253updateInfo :: UTCTime -> [Line] -> SourceInfo -> SourceInfo 
    53 updateInfo now lns initial 
    54     = execState (sequence $ parseInfo . lineComment <$> take 50 lns) initial' 
    55     where initial' = initial { _lastUpdated = now }  
     54updateInfo now lns old 
     55    = updated { _expired = infoExpired now updated }  
     56    where  
     57    initial = old { _lastUpdated = now }  
     58    updated = execState (sequence $ parseInfo . lineComment <$> take 50 lns) initial 
    5659     
    5760makeInfo :: String -> SourceInfo 
     
    6164logInfo lns = chunkInfo <$> chunks 
    6265   where  
    63    chunks = split [separator] . takeWhile (/= endMark) $ lns 
     66   chunks = filter (not.null) . split [separator] . takeWhile (/= endMark) $ lns 
    6467   chunkInfo chunk = execState (sequence $ parseInfo <$> chunk) emptySourceInfo 
     68 
     69infoExpired :: UTCTime -> SourceInfo -> Bool 
     70infoExpired now (SourceInfo _ _ _ _ lastUpdated expires _ _ ) =  
     71        diffUTCTime now lastUpdated > (fromInteger $ expires * 60 * 60) 
    6572 
    6673lineComment :: Line -> String 
     
    7178parseInfo text = do 
    7279    info <- get 
    73     let urlParser = (\x -> info{_url = x}) <$> (string "Url: " *> many1 anyChar) 
     80    let urlParser = (\x -> info{_url = x}) <$> ((string "Url: " <|> string "Redirect: ") *> many1 anyChar) 
    7481        titleParser = (\x -> info{_title = x}) <$> (string "Title: " *> many1 anyChar) 
    7582        homepageParser = (\x -> info{_homepage = x}) <$> (string "Homepage: " *> many1 anyChar) 
  • src/Task.hs

    r47e082f rd515b21  
    44) where 
    55import System.IO 
    6 import System.FilePath 
    76import InputParser 
    87import Statistics 
     
    109 
    1110writeTask :: String -> [String] -> [Line] -> IO () 
    12 writeTask path info lns =  
     11writeTask filename info lns =  
    1312    let  
    1413        statistics = collectStat lns 
    15         filename = path </> "ab2p.task" 
    1614        errorLine (Line position (Error text))  
    1715            = [concat ["ERROR: ", recordSourceText position, " - ", text]] 
     
    2523 
    2624readTask :: String -> IO [String]        
    27 readTask path = lines <$> readFile path 
     25readTask path = do  
     26        result <- lines <$> readFile path 
     27        return $ length result `seq` result --read whole file to allow its overwriting 
     28 
  • test-data/my.txt

    r9dc8cfc rd515b21  
    11[Adblock Plus 2.0] 
     2! Redirect: /home/alexey/Projects/adblock2privoxy/test-data/my1.txt 
    23se7en.ru##div.sign > a[target="_blank"] 
    34|r.e1.ru 
Note: See TracChangeset for help on using the changeset viewer.