X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FHTTP.hs;h=ea7174ad1e5b70d8ec9a6a9bc8b9ad3f0411fbba;hp=8b4c14d0cc04a09badc271f15bd0ea628ca24390;hb=5b4118c3497d02fc7b533f6b3f5db3b13969f99a;hpb=241e9b547e48d4af7eb37ca6989775c0d09152bc;ds=sidebyside diff --git a/src/LWN/HTTP.hs b/src/LWN/HTTP.hs index 8b4c14d..ea7174a 100644 --- a/src/LWN/HTTP.hs +++ b/src/LWN/HTTP.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE DoAndIfThenElse #-} + module LWN.HTTP where +import qualified Data.ByteString as B (hPut) + import Network.Curl ( CurlCode(..), CurlOption(..), @@ -10,9 +14,14 @@ import Network.Curl ( initialize, respBody, respCurlCode, - withCurlDo + withCurlDo ) -import System.IO (hPutStrLn, stderr) +import Network.Curl.Download (openURI) +import System.Directory (doesFileExist, getTemporaryDirectory) +import System.IO (hClose, hPutStrLn, stderr, stdout) +import System.IO.Temp (openBinaryTempFile, openTempFile) + +import LWN.URI (filename) login_url :: URLString login_url = "https://lwn.net/login" @@ -35,24 +44,39 @@ default_curl_opts = -- And we don't want to use a DNS cache anyway. CurlDNSCacheTimeout 0, + -- Follow redirects. + CurlFollowLocation True, + -- Give it a little time... CurlTimeout 45, - -- And let us know when things go wrong. + -- For debugging. CurlVerbose True ] +make_cookie_jar :: IO FilePath +make_cookie_jar = do + temp_dir <- getTemporaryDirectory + let file_name_template = "lwn-epub-cookies.txt" + (out_path, out_handle) <- openTempFile temp_dir file_name_template + hClose out_handle -- We just want to create it for now. + return out_path get_page :: Maybe FilePath -> URLString -> IO (Maybe String) -get_page cookie_jar url = +get_page cookie_file url = withCurlDo $ do + hPutStrLn stdout ("Getting page: " ++ url ++ "...") + -- Create a curl instance. curl <- initialize -- Perform the request, and get back a CurlResponse object. -- The cast is needed to specify how we would like our headers -- and body returned (Strings). - resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse + putStrLn "Curl options:" + print curl_opts + + resp <- do_curl_ curl url curl_opts :: IO CurlResponse -- Pull out the response code as a CurlCode. let code = respCurlCode resp @@ -67,9 +91,9 @@ get_page cookie_jar url = return Nothing where get_opts = - case cookie_jar of + case cookie_file of Nothing -> [] - Just cookies -> [ CurlCookieJar cookies ] + Just cookies -> [ CurlCookieFile cookies ] curl_opts = default_curl_opts ++ get_opts @@ -77,6 +101,8 @@ get_page cookie_jar url = log_in :: FilePath -> String -> String -> IO Bool log_in cookie_jar username password = withCurlDo $ do + hPutStrLn stdout ("Logging " ++ username ++ " in...") + -- Create a curl instance. curl <- initialize @@ -107,7 +133,7 @@ log_in cookie_jar username password = post_password = password_field ++ "=" ++ password post_data :: [String] - post_data = [post_username, post_password] + post_data = [post_username, post_password, post_submit] post_opts :: [CurlOption] post_opts = @@ -118,3 +144,33 @@ log_in cookie_jar username password = curl_opts :: [CurlOption] curl_opts = default_curl_opts ++ post_opts + + +-- | Save the image at 'url'. Saves to a temporary file, and +-- returns the path to that file if successful. Otherwise, +-- returns 'Nothing'. +-- +-- We need to be able to parse the filename out of the URL +-- so that when we stick our image in the document, the reader +-- knows that type (jpg, png, etc.) it is. +save_image :: URLString -> IO (Maybe FilePath) +save_image url = do + it_exists <- doesFileExist url + if it_exists then do + -- It's local, just use it. + return $ Just url + else do + let fn = filename url + case fn of + Nothing -> return Nothing + Just file -> do + temp_dir <- getTemporaryDirectory + (out_path, out_handle) <- openBinaryTempFile temp_dir file + result <- openURI url + case result of + Left err -> do + hPutStrLn stderr ("HTTP Error: " ++ err) + return Nothing + Right bs -> do + B.hPut out_handle bs + return $ Just out_path