Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 210 lines (187 sloc) 6.652 kB
0f6a167 @dylex huzblem
authored
1 import Prelude hiding (log)
2
3 import Control.Concurrent
4 import Control.Exception
5 import Control.Monad
6 import Control.Monad.Reader
7 import Control.Monad.State
24d1999 @dylex primitive link numbering and bindings
authored
8 import Data.Char
0f6a167 @dylex huzblem
authored
9 import Data.Function
10 import Data.IORef
11 import Data.List
12 import qualified Data.Map as Map
13 import Data.Maybe
14 import Network.Socket
15 import qualified System.Console.GetOpt as GetOpt
16 import System.Directory
17 import System.Environment
18 import System.Exit
19 import System.FilePath
20 import System.IO
21 import System.IO.Error
2622056 @dylex basic download support; -s config option; other minor stuff
authored
22 import System.Posix.Env as Env
0f6a167 @dylex huzblem
authored
23
24 import Util
25 import Config
26 import Uzbl
27 import Event
28 import Cookies
f596bb7 @dylex database interface for history, other bits, some incomplete
authored
29 import Database
f3faead @dylex move block list from database to text file
authored
30 import Block
bda0a09 @dylex scripts, blocking, urls
authored
31 import URIs
0f6a167 @dylex huzblem
authored
32
33 removeFile_ :: FilePath -> IO ()
34 removeFile_ f = void $ tryJust (\e -> guard (isDoesNotExistError e) >. ()) $ removeFile f
35
36 data Options = Options
481f931 @dylex add httponly support to cookies.txt saving
authored
37 { optionSocket :: Maybe String
e3e0d36 @dylex cookie propegation... stuff like that
authored
38 , optionCookies :: Maybe FilePath
39 , optionDebug :: Bool
2622056 @dylex basic download support; -s config option; other minor stuff
authored
40 , optionConfig :: Config
f3faead @dylex move block list from database to text file
authored
41 , optionBlocks :: FilePath
9adc433 @dylex shift-insert paste in prompt; complete on marks; database option
authored
42 , optionDatabase :: String
0f6a167 @dylex huzblem
authored
43 }
44
45 defaultOptions :: Options
46 defaultOptions = Options
481f931 @dylex add httponly support to cookies.txt saving
authored
47 { optionSocket = Nothing
48 , optionCookies = Just $ uzblHome "cookies.txt"
e3e0d36 @dylex cookie propegation... stuff like that
authored
49 , optionDebug = False
2622056 @dylex basic download support; -s config option; other minor stuff
authored
50 , optionConfig = defaultConfig
f3faead @dylex move block list from database to text file
authored
51 , optionBlocks = uzblHome "block"
9adc433 @dylex shift-insert paste in prompt; complete on marks; database option
authored
52 , optionDatabase = "dbname=uzbl"
0f6a167 @dylex huzblem
authored
53 }
54
481f931 @dylex add httponly support to cookies.txt saving
authored
55 defaultSocket :: FilePath
56 defaultSocket = uzblHome ".huzblem"
57
97fbc6e @dylex useragent switching and command/set completers
authored
58 optionConfig' :: (Config -> Config) -> Options -> Options
59 optionConfig' f o = o{ optionConfig = f (optionConfig o) }
60
2622056 @dylex basic download support; -s config option; other minor stuff
authored
61 setConfig :: String -> Options -> Options
62 setConfig c = case break ('=' ==) c of
63 ("","") -> id
97fbc6e @dylex useragent switching and command/set completers
authored
64 (v,'=':s) | Just x <- readValue "" s -> optionConfig' $ Map.insert v x
65 (v,_) -> optionConfig' $ Map.delete v
2622056 @dylex basic download support; -s config option; other minor stuff
authored
66
0f6a167 @dylex huzblem
authored
67 options :: [GetOpt.OptDescr (Options -> Options)]
68 options =
69 [ GetOpt.Option "s" ["socket"]
481f931 @dylex add httponly support to cookies.txt saving
authored
70 (GetOpt.ReqArg (\s o -> o{ optionSocket = Just s }) "NAME|PATH")
71 ("suffix or absolute path for event manager socket [" ++ defaultSocket ++ "]")
e3e0d36 @dylex cookie propegation... stuff like that
authored
72 , GetOpt.Option "" ["cookies"]
73 (GetOpt.OptArg (\s o -> o{ optionCookies = s }) "FILE")
74 ("Load and use cookies from FILE [" ++ fromMaybe "NONE" (optionCookies defaultOptions) ++ "]")
9adc433 @dylex shift-insert paste in prompt; complete on marks; database option
authored
75 , GetOpt.Option "v" ["verbose"]
e3e0d36 @dylex cookie propegation... stuff like that
authored
76 (GetOpt.NoArg (\o -> o{ optionDebug = True }))
77 ("Print out more log messages")
2622056 @dylex basic download support; -s config option; other minor stuff
authored
78 , GetOpt.Option "s" ["set"]
79 (GetOpt.ReqArg setConfig "VAR[=VALUE]")
80 ("Set (or clear) a configuration variable")
97fbc6e @dylex useragent switching and command/set completers
authored
81 , GetOpt.Option "p" ["private"]
82 (GetOpt.NoArg (optionConfig' $ Map.insert "enable_private" (ValInt 1)))
83 ("Private mode (equivalent to -s enable_private=1)")
9adc433 @dylex shift-insert paste in prompt; complete on marks; database option
authored
84 , GetOpt.Option "d" ["database"]
85 (GetOpt.ReqArg (\s o -> o{ optionDatabase = s }) "CONN")
86 ("database connection info [" ++ optionDatabase defaultOptions ++ "]")
0f6a167 @dylex huzblem
authored
87 ]
88
89 main :: IO ()
90 main = do
91 args <- getArgs
92 (opts, urls) <- case GetOpt.getOpt GetOpt.Permute options args of
93 (o, a, []) -> return (foldl' (flip ($)) defaultOptions o, a)
94 (_, _, err) -> do
e3e0d36 @dylex cookie propegation... stuff like that
authored
95 mapM_ putStr err
96 putStr $ GetOpt.usageInfo "huzblem [OPTIONS] [URI ...]" options
0f6a167 @dylex huzblem
authored
97 exitFailure
2622056 @dylex basic download support; -s config option; other minor stuff
authored
98 path <- Env.getEnv "PATH"
99 setEnv "PATH" (uzblHome "" ++ maybe "" (':':) path) True
f3faead @dylex move block list from database to text file
authored
100 hSetEncoding stdout char8
0f6a167 @dylex huzblem
authored
101
102 s <- socket AF_UNIX Stream defaultProtocol
481f931 @dylex add httponly support to cookies.txt saving
authored
103 let sock = maybe defaultSocket (\p -> if isAbsolute p then p else defaultSocket ++ '-' : p) $ optionSocket opts
0f6a167 @dylex huzblem
authored
104 sa = SockAddrUnix sock
f3faead @dylex move block list from database to text file
authored
105 catchdne f h = catchJust (\e -> guard (isDoesNotExistError e) >. ()) f (\() -> h)
0f6a167 @dylex huzblem
authored
106
f3faead @dylex move block list from database to text file
authored
107 me <- catchdne (do
0f6a167 @dylex huzblem
authored
108 connect s sa
109 sClose s
110 putStrLn "huzblem already running"
111 return False)
f3faead @dylex move block list from database to text file
authored
112 (do
e3e0d36 @dylex cookie propegation... stuff like that
authored
113 removeFile_ sock
0f6a167 @dylex huzblem
authored
114 bindSocket s sa
115 listen s (8+length args)
116 return True)
117
e3e0d36 @dylex cookie propegation... stuff like that
authored
118 cookies <- case optionCookies opts of
119 Nothing -> return emptyCookies
120 Just f
481f931 @dylex add httponly support to cookies.txt saving
authored
121 | Just f' <- stripPrefix "elinks:" f -> loadElinksCookies f'
e3e0d36 @dylex cookie propegation... stuff like that
authored
122 | ".elinks/" `isInfixOf` f -> loadElinksCookies f
481f931 @dylex add httponly support to cookies.txt saving
authored
123 | otherwise -> loadCookiesTxt f
e3e0d36 @dylex cookie propegation... stuff like that
authored
124
0f6a167 @dylex huzblem
authored
125 let uu [] = [Nothing]
bda0a09 @dylex scripts, blocking, urls
authored
126 uu l = map (Just . expandURI) l
2622056 @dylex basic download support; -s config option; other minor stuff
authored
127 mapM_ (runUzbl sock cookies (optionConfig opts)) (uu urls)
0f6a167 @dylex huzblem
authored
128
129 unless me exitSuccess
130
131 clients <- newMVar Map.empty
9adc433 @dylex shift-insert paste in prompt; complete on marks; database option
authored
132 db <- databaseOpen (optionDatabase opts)
afab9ea @dylex script cleanup, consolidate init
authored
133 blocks <- (newMVar $!) =<< catchdne (loadBlocks (optionBlocks opts)) (return defaultBlocks)
134 scriptinit <- newIORef (error "scripts uninit")
0f6a167 @dylex huzblem
authored
135 let global = UzblGlobal
136 { uzblemSocket = sock
137 , uzblemClients = clients
347ae78 @dylex change cookies to be per-window, partially inherited
authored
138 , uzblemCookies = cookies
f596bb7 @dylex database interface for history, other bits, some incomplete
authored
139 , uzblDatabase = db
e3e0d36 @dylex cookie propegation... stuff like that
authored
140 , uzblDebug = optionDebug opts
f3faead @dylex move block list from database to text file
authored
141 , uzblBlocks = blocks
afab9ea @dylex script cleanup, consolidate init
authored
142 , uzblScriptInit = scriptinit
0f6a167 @dylex huzblem
authored
143 }
afab9ea @dylex script cleanup, consolidate init
authored
144 setScriptInit global
145
146 sem <- newIORef (1 :: Int)
147 wait <- newQSem 0
148 let up = atomicModifyIORef sem (\i -> (succ i, ()))
149 down = do
7600b8f @dylex hlint pass
authored
150 i <- atomicModifyIORef sem (join (,) . pred)
afab9ea @dylex script cleanup, consolidate init
authored
151 when (i == 0) $ signalQSem wait
0f6a167 @dylex huzblem
authored
152
7600b8f @dylex hlint pass
authored
153 void $ forkIO $ forever $ accept s >>= \r ->
0f6a167 @dylex huzblem
authored
154 void $ forkIO $ bracket_ up down (client global r)
155 void $ forkIO $ do
156 threadDelay 5000000
157 down
158 waitQSem wait
f3faead @dylex move block list from database to text file
authored
159
160 when (isNothing (optionSocket opts)) $
161 saveBlocks (optionBlocks opts) =<< takeMVar blocks
0f6a167 @dylex huzblem
authored
162 removeFile_ sock
f596bb7 @dylex database interface for history, other bits, some incomplete
authored
163 databaseClose db
0f6a167 @dylex huzblem
authored
164
165 client :: UzblGlobal -> (Socket, SockAddr) -> IO ()
166 client global (s,_) = do
167 h <- socketToHandle s ReadWriteMode
168 hSetBuffering h LineBuffering
24d1999 @dylex primitive link numbering and bindings
authored
169 hSetEncoding h utf8
0f6a167 @dylex huzblem
authored
170 l <- hGetLine h
171 case words l of
172 ["EVENT", '[':sinst, "INSTANCE_START", spid]
173 | Just inst <- stripLast ']' sinst
174 , [(pid,"")] <- reads spid -> do
175 tid <- myThreadId
176 let c = UzblClient
177 { uzblGlobal = global
178 , uzblThread = tid
179 , uzblHandle = h
180 , uzblInstance = inst
181 , uzblPid = pid
182 , uzblEvent = Nothing
183 }
184 ucl = modifyMVar_ $ uzblemClients global
185 bracket_
186 (ucl $ return . Map.insert (clientKey c) c)
187 (ucl $ return . Map.update (\c' -> guard (on (/=) uzblThread c c') >. c') (clientKey c))
481f931 @dylex add httponly support to cookies.txt saving
authored
188 (evalStateT (runReaderT (proc c) c) emptyState)
0f6a167 @dylex huzblem
authored
189 _ -> putStrLn $ "huzblem: bad start: " ++ l
190
191 proc :: UzblClient -> UzblM ()
192 proc c = do
24d1999 @dylex primitive link numbering and bindings
authored
193 let evt = "EVENT [" ++ uzblInstance c ++ "] "
194 rqt = "REQUEST [" ++ uzblInstance c ++ "] "
0f6a167 @dylex huzblem
authored
195 loop = (`when` loop) =<< line =<< io (hGetLine (uzblHandle c))
196 line "" = return True
197 line s
24d1999 @dylex primitive link numbering and bindings
authored
198 | Just l <- stripPrefix evt s
199 , ev:args <- quotedWords l = go (Event ev) args
200 | Just l <- stripPrefix rqt s
201 , (rq,arg) <- breakStrip isSpace l = go (Request rq) [arg]
0f6a167 @dylex huzblem
authored
202 | otherwise = log s >. True
24d1999 @dylex primitive link numbering and bindings
authored
203 go ev args = local (\ur -> ur{ uzblEvent = Just (ev, args) }) $
204 if ev == Event "INSTANCE_EXIT"
205 then log "finished" >. False
206 else debug "" >> event ev args >. True
0f6a167 @dylex huzblem
authored
207 log "starting"
208 loop
209
Something went wrong with that request. Please try again.