packages feed

feed2lj (empty) → 0.0.2

raw patch · 5 files changed

+297/−0 lines, 5 filesdep +HTTPdep +basedep +curlsetup-changed

Dependencies added: HTTP, base, curl, directory, feed, haskell98, nano-md5, old-locale, pureMD5, regex-posix, time, utf8-string

Files

+ Feed2Lj.hs view
@@ -0,0 +1,95 @@+-- vim: ts=2 sw=2 expandtab si ai :++import LjPost++import System.Environment (getArgs)+import System.Directory (renameFile)+import Control.Monad (liftM, mapM,ap)+import Maybe (fromJust, isNothing, isJust)+import Network.HTTP (urlEncode)++import Text.Regex.Posix ((=~))++import Network.Curl (curlGetString)+import Text.Feed.Import (parseFeedString)+import Text.Feed.Types (Feed, Item)+import Text.Feed.Query++import IO+import Codec.Binary.UTF8.String (encodeString)++--import Debug.Trace (trace)+--debug x = trace (show x) x++-- take first n sentences from string s+takeSentences n s+  | n > 0     = let (s',r) = takeSentence s+                in s' ++ takeSentences (n-1) r+  | otherwise = ""++takeSentence s =+  let ends = ".?!;"+      (first,rest) = break (`elem` ends) s+  in if not (null rest)+     then (first ++ [head rest],tail rest)+     else (first,[])++-- remove all html/xml tags, quick and dirty+eatTags :: String -> String+eatTags [] = []+eatTags s =+  let (b,t,a) = s =~ "</?[^>]*/?>" :: (String,String,String)+  in b ++ eatTags a++-- mini template engine+renderTemplate _ [] = []+renderTemplate alist s =+  let (b,t,a) = s =~ "%[a-z0-9]*%" :: (String,String,String)+      tagval t+         | t == "%%" = Just "%"+         | otherwise = let inner = take (length t - 2) $ drop 1 t+                       in  lookup inner alist+      val = tagval t+  in if isJust val+       then b ++ (fromJust val) ++ renderTemplate alist a+       else b ++ t ++ renderTemplate alist a++renderItem :: String -> Item -> String+renderItem t i =+  let title = ( fromJust . getItemTitle ) i+      link = ( fromJust . getItemLink ) i+      guid = ( fromJust . getItemId ) i+      summary = ( takeSentences 5 . eatTags . fromJust . getItemSummary) i+      tags = zip [ "title","link","text" ]+                 [ title, urlEncode link,summary ]+  in renderTemplate tags t++isNotSent sent i = ((snd . fromJust . getItemId) i) `notElem` sent++postItem u p t i = do+  let message = renderItem t i+  let subj = fromJust $ getItemTitle i+  r <- postToLj u p subj message+  if isSuccess r+    then putLjKey "url" r+    else putLjKey "errmsg" r++main = do+  url:_ <- getArgs+  (_,rawfeed) <- curlGetString url []++  ljuser <- return fromJust `ap` readLjSetting "username"+  ljpass <- return fromJust `ap` readLjSetting "password"+  sentfile <- return fromJust `ap` readLjSetting "sentfile"+  t <- return fromJust `ap` readLjSetting "template"+  sent_ids <- (return . lines) =<< readFile sentfile++  let feed = fromJust $ parseFeedString rawfeed+  let items = feedItems feed+  let newitems = reverse $ filter (isNotSent sent_ids) items+  let new_ids = map ( snd . fromJust . getItemId) newitems++  mapM_ (postItem ljuser ljpass t) newitems++  renameFile sentfile (sentfile ++ "~")+  writeFile sentfile $ unlines (sent_ids ++ new_ids)
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2009, Sergey Astanin+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright notice,+      this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice,+      this list of conditions and the following disclaimer in the documentation+      and/or other materials provided with the distribution.+    * Neither the name of the Sergey Astanin nor the names of other+      contributors may be used to endorse or promote products derived from this+      software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ LjPost.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE CPP #-}+-- vim: set fileencoding=utf-8 ts=2 sw=2 expandtab:++module LjPost (readLjSetting, postToLj, isSuccess, lookupLjKey, putLjKey) where++import IO+import Maybe (fromJust, fromMaybe, isNothing)+import Data.Time+import System.Locale (defaultTimeLocale)+import System.Directory (getHomeDirectory)++#ifdef NANOMD5+import Data.ByteString.UTF8 (fromString)+import Data.Digest.OpenSSL.MD5 (md5sum)+#else+-- PUREMD5+import Data.ByteString.Lazy.UTF8 (fromString)+import Data.Digest.Pure.MD5 (md5)+#endif++import Network.Curl++ljFlatUrl = "www.livejournal.com/interface/flat"+ljPassFile = "~/.ljpass"++currentTime = do+  t <- getCurrentTime+  tz <- getCurrentTimeZone+  return $ utcToLocalTime tz t++showTime = formatTime defaultTimeLocale++-- options for various requests,+-- see http://www.livejournal.com/doc/server/ljp.csp.protocol.html++postFlags = [CurlPost True]++quoteOpt ('=':xs) = "%3d" ++ quoteOpt xs+quoteOpt ('&':xs) = "%26" ++ quoteOpt xs+quoteOpt (x:xs) = x : quoteOpt xs+quoteOpt [] = []++getChallengeOpts = CurlPostFields ["mode=getchallenge"] : postFlags++authOpts u p c = [ "user=" ++ quoteOpt u, "auth_method=challenge",+  "auth_challenge=" ++ quoteOpt c,+  "auth_response=" ++ quoteOpt (evalResponse c p) ]++loginAuthOpts u p c =+  CurlPostFields ("mode=login" : (authOpts u p c)) : postFlags++currentTimeOpts :: IO [String]+currentTimeOpts = do+  t <- currentTime+  let opts = [ "year=%Y", "mon=%m", "day=%d", "hour=%H", "min=%M" ]+  return $ map (flip showTime t) opts++postOpts u p c subj msg topts =+  CurlPostFields ("mode=postevent" : (authOpts u p c)+                  ++ ["event=" ++ quoteOpt msg, "subject=" ++ quoteOpt subj,+                     "lineendings=unix", "ver=1"]+                  ++ topts ) : postFlags++-- make an associative list+list2alist :: [a] -> [(a,a)]+list2alist (k:v:rest) = (k,v) : list2alist rest+list2alist _ = []++-- lookup key in flat LJ response+lookupLjKey :: String -> CurlResponse -> Maybe String+lookupLjKey k = ( lookup k . list2alist . lines . respBody )++-- print key k from flat LJ response+putLjKey k r = putStrLn $ show $ lookupLjKey k r++-- evaluate challenge response+evalResponse c p = smd5 ( c ++ (smd5 p) )+#ifdef NANOMD5+  where smd5 = md5sum . fromString+#else+  -- PUREMD5+  where smd5 = show . md5 . fromString+#endif++-- does LJ report success?+isSuccess :: CurlResponse -> Bool+isSuccess = (=="OK") . fromMaybe "" . lookupLjKey "success"++-- read and parse a file with LJ password and username+readPassFile f = do+  ljpass <- readFile f+  return $ map (\(f,s) -> (f,tail s)) $ map (break (== '=')) $ lines ljpass++expandhome ('~':'/':p) = do h <- getHomeDirectory ; return (h ++ "/" ++ p)+expandhome p = return p++readLjSetting key = do+  passfile <- expandhome ljPassFile+  s <- readPassFile passfile+  return (lookup key s)++-- login into LJ as ljuser/ljpass and post msg with given subj+postToLj ljuser ljpass subj msg = withCurlDo $ do+  curl <- initialize+  r <- do_curl_ curl ljFlatUrl getChallengeOpts :: IO CurlResponse+  if (isSuccess r)+    then do+      let challenge = fromJust $ lookupLjKey "challenge" r+      timeopts <- currentTimeOpts+      let opts = postOpts ljuser ljpass challenge subj msg timeopts+      r <- do_curl_ curl ljFlatUrl opts :: IO CurlResponse+      return r+    else return r
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ feed2lj.cabal view
@@ -0,0 +1,61 @@+name:                feed2lj+version:             0.0.2+synopsis:            Cross-post any RSS/Atom feed to LiveJournal+description:         A script to cross-post any RSS/Atom Feed to LiveJournal.+                     .+                     All HTML tags are merely stripped from the original. By+                     default the script takes only the first 5 sentences of+                     the original message. You may need to edit source to change+                     this behaviour.+                     .+                     CONFIGURATION+                     .+                     Create a file named `~/.ljpass` with your LJ login+                     (`username`) and `password`. GUIDs of the processed+                     message are saved to the file defined by `sentfile`.+                     Additionally, define an HTML `template` of the cross-posted+                     messages as they should appear in LJ.+                     .+                     For example:+                     .+                          > username=myljlogin+                          > password=myljpassword+                          > sentfile=/path/to/file/where/crossposted/GUIDs/are/saved+                          > template=<p>%text%</p><p>( <a href="%link%" title="%title%">more</a> )</p>+                     .+                     USAGE+                     .+                          > $ feed2lj http://example.com/rss.xml++stability:           experimental+category:            Web+license:             BSD3+license-file:        LICENSE+author:              Sergey Astanin+maintainer:          s.astanin@gmail.com+homepage:            http://bitbucket.org/jetxee/feed2ljhs/+bug-reports:         http://bitbucket.org/jetxee/feed2ljhs/issues/+tested-with:         GHC == 6.10++cabal-version:       >= 1.2+build-type:          Simple++flag nano-md5+  description: Use MD5 digest from OpenSSL bindings (default: use pureMD5)+  default: False++executable feed2lj+  main-is:             Feed2Lj.hs+  other-modules:       LjPost+  extensions:          CPP+  build-depends:       haskell98+                       , base >= 3 && < 5+                       , old-locale, directory, time+                       , utf8-string, regex-posix+                       , HTTP, curl, feed+  if flag(nano-md5)+    build-depends:  nano-md5+    cpp-options:    -DNANOMD5+  else+    build-depends:  pureMD5+    cpp-options:    -DPUREMD5