diff --git a/Commands/Follow.hs b/Commands/Follow.hs new file mode 100644 --- /dev/null +++ b/Commands/Follow.hs @@ -0,0 +1,60 @@ +{- +Copyright (C) 2006-2008 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +module Commands.Follow(follow, unfollow) where +import Utils +import System.Log.Logger +import Data.List +import Download + +i = infoM "follow" + +follow = simpleCmd "follow" "Start following someone" + follow_help + [] follow_worker + +follow_worker _ cp ([], [user]) = + do xmlstr <- sendAuthRequest cp ("/friendships/create/" ++ user ++ ".xml") [] [("id", user)] + debugM "follow" $ "Got doc: " ++ xmlstr + -- let doc = getContent . xmlParse "follow" . stripUnicodeBOM $ xmlstr + -- return () + +follow_worker _ _ _ = + permFail "follow: syntax error; see twidge follow --help" + +follow_help = + "Usage: twidge follow username\n\n\ + \will add username to your list of people you follow.\n\n" + + +unfollow = simpleCmd "unfollow" "Stop following someone" + unfollow_help + [] unfollow_worker + +unfollow_worker _ cp ([], [user]) = + do xmlstr <- sendAuthRequest cp ("/friendships/destroy/" ++ user ++ ".xml") [] [("id", user)] + debugM "unfollow" $ "Got doc: " ++ xmlstr + -- let doc = getContent . xmlParse "follow" . stripUnicodeBOM $ xmlstr + -- return () + +unfollow_worker _ _ _ = + permFail "unfollow: syntax error; see twidge unfollow --help" + +unfollow_help = + "Usage: twidge unfollow username\n\n\ + \will remove username from the list of people you follow.\n" diff --git a/Commands/Setup.hs b/Commands/Setup.hs new file mode 100644 --- /dev/null +++ b/Commands/Setup.hs @@ -0,0 +1,75 @@ +{- +Copyright (C) 2006-2008 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +module Commands.Setup(setup) where +import Utils +import System.Log.Logger +import Data.List +import Data.ConfigFile +import System.IO +import Data.Either.Utils +import Data.Char +import Config +import Control.Monad(when) + +i = infoM "setup" + +-------------------------------------------------- +-- lscasts +-------------------------------------------------- + +setup = simpleCmd "setup" "Interactively configure twidge for first-time use" + setup_help + [] setup_worker + +setup_worker cpath cp _ = + do when (has_option cp "DEFAULT" "username" || + has_option cp "DEFAULT" "password") + (confirmSetup) + hSetBuffering stdout NoBuffering + putStrLn "\nWelcome to twidge. We will now configure twidge for your" + putStrLn "use. This will be quick and easy!\n" + putStrLn "First, what is your usename?\n" + putStr "Username: " + username <- getLine + putStrLn $ "\nWelcome, " ++ username ++ "! Now I'll need your password.\n" + putStr "Password: " + hSetEcho stdin False + password <- getLine + hSetEcho stdin True + let newcp = forceEither $ set cp "DEFAULT" "username" (esc username) + let newcp' = forceEither $ set newcp "DEFAULT" "password" (esc password) + + writeCP cpath newcp' + + putStrLn "\n\ntwidge has now been configured for you.\n" + where confirmSetup = + do putStrLn "\nIt looks like you have already configured twidge." + putStrLn "If we continue, I may remove your existing" + putStrLn "configuration. Would you like to proceed?" + putStr "\nYES or NO: " + c <- getLine + if (map toLower c) == "yes" + then return () + else permFail "Aborting configuration at user request." + esc x = concatMap fix x + fix '%' = "%%" + fix x = [x] + +setup_help = + "Usage: twidge setup\n\n" diff --git a/Commands/Update.hs b/Commands/Update.hs new file mode 100644 --- /dev/null +++ b/Commands/Update.hs @@ -0,0 +1,133 @@ +{- +Copyright (C) 2006-2008 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +module Commands.Update(update, dmsend) where +import Utils +import System.Log.Logger +import Types +import System.Console.GetOpt +import Data.List +import Download +import Control.Monad(when) +import Text.Regex.Posix +import Data.ConfigFile +import MailParser(message) +import Text.ParserCombinators.Parsec + +i = infoM "update" + +update = simpleCmd "update" "Update your status" + update_help + [Option "r" ["recvmail"] (NoArg ("m", "")) + "Receive update as body of email on stdin"] + update_worker + +update_worker x cp ([("m", "")], []) = + do c <- getContents + case parse message "(stdin)" c of + Left x -> permFail $ "Couldn't parse mail: " ++ show x + Right (refs, body) -> + let irt = case refs =~ "<([^>]+)>$" of + "" -> [] + m -> case parseMsgId m of + Nothing -> [] + Just (m, host, section) -> + if host == serverHost cp && + section `elem` ["lsrecent", "lsarchive", + "lsreplies"] + then [("in_reply_to_status_id", + sId m)] + else [] + status = body + in do poststatus <- procStatus cp "update" status + xmlstr <- sendAuthRequest cp "/statuses/update.xml" [] + ([("source", "Twidge"), ("status", poststatus)] ++ + irt) + debugM "update" $ "Got doc: " ++ xmlstr +update_worker x cp ([], []) = + do l <- getLine + update_worker x cp ([], [l]) +update_worker _ cp ([], [status]) = + do poststatus <- procStatus cp "update" status + xmlstr <- sendAuthRequest cp "/statuses/update.xml" [] + [("source", "Twidge"), ("status", poststatus)] + debugM "update" $ "Got doc: " ++ xmlstr +update_worker _ _ _ = + permFail "update: syntax error; see twidge update --help" + +procStatus cp section status = + do poststatus <- case get cp section "shortenurls" of + Right True -> shortenUrls status + _ -> return status + when (length poststatus > 140) + (permFail $ "Your status update was " ++ + show (length poststatus) ++ + " characters; max length 140") + return poststatus + +dmsend = simpleCmd "dmsend" "Send direct message" + dmsend_help + [] + dmsend_worker + +dmsend_worker x cp ([], [r]) = + do l <- getLine + dmsend_worker x cp ([], [r, l]) +dmsend_worker x cp ([], [recipient, status]) = + do poststatus <- procStatus cp "dmsend" status + xmlstr <- sendAuthRequest cp "/direct_messages/new.xml" [] + [("source", "Twidge"), + ("text", poststatus), ("user", recipient)] + debugM "dmsend" $ "Got doc: " ++ xmlstr +dmsend_worker _ _ _ = permFail "Syntax error; see twidge dmsend --help" + +shortenUrls "" = return "" +shortenUrls status = + do debugM "update" $ "shortenUrls considering: " ++ show status + if match == "" + then return before -- No match means no "after" + else do tiny <- mkTinyURL match + debugM "update" $ "Got tinyurl: " ++ show tiny + rest <- shortenUrls after + return $ + before ++ (if (length tiny < length match) + then tiny else match) + ++ rest + where (before, match, after) = status =~ pat + pat = "(http|ftp)://[^ ]+" + +mkTinyURL url = + simpleDownload $ "http://tinyurl.com/api-create.php?url=" ++ url + +update_help = + "Usage: twidge update [status]\n\n\ + \Updates your status to the given status. You will most likely need to\n\ + \quote this to prevent interference from the shell. For instance:\n\n\ + \ twidge update \"At home, baking.\"\n\n\ + \You can also omit the status, in which case a single line will be read\n\ + \from stdin and taken as your update. Example:\n\n\ + \ date | twidge update\n" + +dmsend_help = + "Usage: twidge dmsend recipient [status]\n\n\ + \Sends a direct message to the given recipient. You will most likely need\n\ + \to quote this to prevent interference from the shell. For instance:\n\n\ + \ twidge dmsend unixtwidge \"At home, baking.\"\n\n\ + \You can also omit the status, in which case a single line will be read\n\ + \from stdin and taken as your update. Example:\n\n\ + \ date | twidge dmsend unixtwidge\n" diff --git a/MailParser.hs b/MailParser.hs new file mode 100644 --- /dev/null +++ b/MailParser.hs @@ -0,0 +1,66 @@ +{- +Copyright (C) 2006-2008 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +module MailParser where +import Text.ParserCombinators.Parsec +import Data.String.Utils +import FeedParser(sanitize) + +eol = (string "\r\n") <|> string "\n" + +line = do l <- many (noneOf "\r\n") + eol + return l + +line1 = do l <- many1 (noneOf "\r\n") + eol + return l + +header = + do c1 <- (refHdr <|> (line1 >> return "")) + return c1 + +refHdr = + do try (string "References: ") + c <- line + c2 <- restOfHdr + return (c ++ c2) + where restOfHdr = + (do oneOf " \t" + r <- line + n <- restOfHdr + return (r ++ n)) <|> return "" + +headers = many1 header + +maybeFrom = try (do string "From " + many1 (noneOf "\r\n") + eol + return () + ) <|> (return ()) + +body = do b <- many anyChar + eof + return b + +message = + do maybeFrom + h <- headers + eol + b <- body + return (strip (concat h), strip . sanitize $ b) diff --git a/twidge.cabal b/twidge.cabal --- a/twidge.cabal +++ b/twidge.cabal @@ -1,5 +1,5 @@ Name: twidge -Version: 0.99.0 +Version: 0.99.0.1 License: GPL Maintainer: John Goerzen Author: John Goerzen @@ -44,9 +44,9 @@ Executable: twidge Main-Is: twidge.hs -Other-Modules: Commands, Config, Download, FeedParser, - Types, Utils, - Commands.Ls +Other-Modules: Commands, Commands.Follow, Commands.Ls, + Commands.Setup, Commands.Update, Config, Download, FeedParser, + MailParser, Types, Utils GHC-Options: -O2 Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances