| By | Chris Done |
| At | 2013-06-16 |
| Title | Notice about blocked spam. |
| Description |
Edit file src/Main.hs 33188 → 33188
47 47 routes = [("/css/amelie.css", run Style.handle)48 48 ,("/css/",serveDirectory "static/css")49 49 ,("/js/amelie.js",run Script.handle)50 50 ,("/js/",serveDirectory "static/js")51 51 ,("/hs/",serveDirectory "static/hs")- 52 ,("",run Home.handle)+ 52 ,("",run (Home.handle False))+ 53 ,("/spam",run (Home.handle True))53 54 ,("/:id",run (Paste.handle False))54 55 ,("/raw/:id",run Raw.handle)55 56 ,("/revision/:id",run (Paste.handle True))56 57 ,("/report/:id",run Report.handle)57 58 ,("/reported",run Reported.handle)… … … … Edit file src/Hpaste/View/Home.hs 33188 → 33188
11 11 import Hpaste.Types
12 12 import Hpaste.View.Html
13 13 import Hpaste.View.Layout
14 14 import Hpaste.View.Paste (pasteLink)
15 15 - 16 + 16 import Control.Monad
17 17 import Data.Text (Text)
18 18 import Data.Time.Show (showDateTime)
19 19 import Prelude hiding ((++))
20 20 import Text.Blaze.Html5 as H hiding (map)
21 21 import qualified Data.Text as T
22 22 import Text.Blaze.Extra
23 23 import Network.URI.Params
24 24 import Network.URI
25 25 26 26 -- | Render the home page.
- 27 page :: URI -> [Channel] -> [Language] -> [Paste] -> Html -> Html
- 28 page uri chans langs ps form =
+ 27 page :: URI -> [Channel] -> [Language] -> [Paste] -> Html -> Bool -> Html
+ 28 page uri chans langs ps form spam =
29 29 layoutPage $ Page {30 30 pageTitle = "Recent pastes"
- 31 , pageBody = content uri chans langs ps form
+ 31 , pageBody = content uri chans langs ps form spam
32 32 , pageName = "home"
33 33 }
34 34 35 35 -- | Render the home page body.
- 36 content :: URI -> [Channel] -> [Language] -> [Paste] -> Html -> Html
- 37 content uri chans langs ps form = do
+ 36 content :: URI -> [Channel] -> [Language] -> [Paste] -> Html -> Bool -> Html
+ 37 content uri chans langs ps form spam = do
+ 38 when spam $ p $ strong $ do "Your submission was identified as being probably spam and was ignored. "
+ 39 "Try reducing links and making your paste look less spammy. "
+ 40 "If the problem persists, try contacting support and we will adjust the spam filters."
38 41 createNew form
39 42 latest uri chans langs ps
40 43 41 44 -- | Create a new paste section.
42 45 createNew :: Html -> Html
… … … … Edit file src/Hpaste/Model/Spam.hs 33188 → 33188
- 1 {-# LANGUAGE RecordWildCards #-}+ 1 {-# LANGUAGE RecordWildCards #-}2 2 {-# LANGUAGE OverloadedStrings #-}3 3 {-# LANGUAGE ScopedTypeVariables #-}4 4 5 5 -- | Spam detection.
6 6 7 7 module Hpaste.Model.Spam where
8 8 9 9 import Hpaste.Types
10 10 import Data.Monoid
11 11 import Data.Text (Text)
+ 12 import Control.Monad.IO
+ 13 import Control.Monad.Env
+ 14 import Control.Monad
+ 15 import qualified Data.Text.Lazy as LT
12 16 import qualified Data.Text as T
- 13 import System.Process
+ 17 import System.Process hiding (env)
+ 18 import Snap.App
+ 19 import Network.Mail.Mime
14 20 15 21 -- | Get a spam rating for the given potential paste.
- 16 spamRating :: PasteSubmit -> IO Integer
+ 22 spamRating :: PasteSubmit -> Model Config s Integer
17 23 spamRating ps = do
- 18 if definitelySpam ps
+ 24 score <- if definitelySpam ps
19 25 then return 100
- 20 else fmap (weighted ps) (getRating mail)
+ 26 else fmap (weighted ps) (io (getRating mail))
+ 27 when (score > spamMaxLevel) $ reportBadScore ps score
+ 28 return score
21 29 22 30 where mail = unlines ["from: noreply@hpaste.org"
23 31 ,"subject: " ++ T.unpack (pasteSubmitTitle ps)
24 32 ,""
25 33 ,T.unpack (pasteSubmitPaste ps)]
26 34 + 35 reportBadScore PasteSubmit{..} score = do+ 36 conf <- env modelStateConfig
+ 37 m <- io $ simpleMail (configAdmin conf)
+ 38 (configSiteAddy conf)
+ 39 ("Paste marked as spam: " <> pasteSubmitTitle)+ 40 body
+ 41 body
+ 42 []
+ 43 io $ renderSendMail m
+ 44 + 45 where body = LT.pack $
+ 46 "Paste '" ++ T.unpack pasteSubmitTitle ++ "' by " ++ T.unpack pasteSubmitAuthor ++ " " ++
+ 47 "has rating " ++ show score ++ " with content: " ++
+ 48 T.unpack pasteSubmitPaste
+ 49 27 50 -- | Get the rating from spam assassin.
28 51 getRating :: String -> IO Integer
29 52 getRating mail = do
30 53 (_,err,_) <- readProcessWithExitCode "spamc" ["-c"] mail
31 54 return $ case reads err of
… … … … 39 62 40 63 -- | Multiple the rating by weights specific to hpaste.
41 64 weighted :: PasteSubmit -> Integer -> Integer
42 65 weighted ps n = foldr ($) n weights where
43 66 weights = [if T.isInfixOf "http://" text || T.isInfixOf "https://" text
- 44 then (* (1 + fromIntegral (T.count "http://" text + T.count "https://" text))) else id
+ 67 then (*2) else id -- then (* (1 + fromIntegral (T.count "http://" text + T.count "https://" text))) else id
45 68 ,if pasteSubmitAuthor ps == "Anonymous Coward" || pasteSubmitAuthor ps == "Anonymous"
46 69 then (*2) else id
47 70 ]
48 71 text = allText ps
49 72 … … … … Edit file src/Hpaste/Controller/Home.hs 33188 → 33188
5 5 6 6 module Hpaste.Controller.Home
7 7 (handle)
8 8 where
9 9 - 10 import Hpaste.Controller.Cache (cache)
+ 10 import Hpaste.Controller.Cache (cacheIf)
11 11 import Hpaste.Controller.Paste (pasteForm)
12 12 import Hpaste.Model.Channel (getChannels)
13 13 import Hpaste.Model.Language (getLanguages)
14 14 import Hpaste.Model.Paste (getLatestPastes)
15 15 import Hpaste.Types.Cache as Key
16 16 import Hpaste.View.Home (page)
17 17 + 18 import Data.Maybe
18 19 import Snap.App
19 20 20 21 -- | Handle the home page, display a simple list and paste form.
- 21 handle :: HPCtrl ()
- 22 handle = do
- 23 html <- cache Key.Home $ do
+ 22 handle :: Bool -> HPCtrl ()
+ 23 handle spam = do
+ 24 html <- cacheIf (not spam) Key.Home $ do
24 25 pastes <- model $ getLatestPastes
25 26 chans <- model $ getChannels
26 27 langs <- model $ getLanguages
27 28 form <- pasteForm chans langs Nothing Nothing Nothing
28 29 uri <- getMyURI
- 29 return $ Just $ page uri chans langs pastes form
+ 30 return $ Just $ page uri chans langs pastes form spam
30 31 maybe (return ()) outputText html
… … … … Edit file src/Hpaste/Controller/Paste.hs 33188 → 33188
93 93 val = either (const Nothing) Just $ value
94 94 case val of
95 95 Nothing -> return ()
96 96 Just PasteSubmit{pasteSubmitSpamTrap=Just{}} -> goHome97 97 Just paste -> do
- 98 spamrating <- io $ spamRating paste
+ 98 spamrating <- model $ spamRating paste
99 99 if spamrating >= spamMaxLevel
- 100 then goHome
+ 100 then goSpamBlocked
101 101 else do
102 102 resetCache Key.Home
103 103 maybe (return ()) (resetCache . Key.Paste . fromIntegral) $ pasteSubmitId paste
104 104 pid <- model $ createPaste languages channels paste spamrating
105 105 maybe (return ()) redirectToPaste pid
106 106 return html
+ 107 + 108 -- | Go back to the home page with a spam indication.
+ 109 goSpamBlocked :: HPCtrl ()
+ 110 goSpamBlocked = redirect "/spam"
107 111 108 112 -- | Redirect to the paste's page.
109 113 redirectToPaste :: PasteId -> HPCtrl ()
110 114 redirectToPaste (PasteId pid) =
111 115 redirect $ "/" ++ fromString (show pid)
… … … …