X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FHTTP.hs;h=d601365e686697a43fbe681d5b4e78830e5d6c6b;hp=c74248ba9dca05bdcc54c2417758906ecd021212;hb=4f418d48ed53343f5547a79e325fdbb7e75a1da0;hpb=79eb04e3c84bd9514659d0d52c2e862959647aa6 diff --git a/src/LWN/HTTP.hs b/src/LWN/HTTP.hs index c74248b..d601365 100644 --- a/src/LWN/HTTP.hs +++ b/src/LWN/HTTP.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE DoAndIfThenElse #-} + module LWN.HTTP where import qualified Data.ByteString as B (hPut) + import Network.Curl ( CurlCode(..), CurlOption(..), @@ -14,9 +17,9 @@ import Network.Curl ( withCurlDo ) import Network.Curl.Download (openURI) -import System.Directory (getTemporaryDirectory) -import System.IO (hPutStrLn, stderr) -import System.IO.Temp (openBinaryTempFile) +import System.Directory (doesFileExist, getTemporaryDirectory) +import System.IO (hClose, hPutStrLn, stderr, stdout) +import System.IO.Temp (openBinaryTempFile, openTempFile) import LWN.URI (filename) @@ -41,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 @@ -73,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 @@ -83,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 @@ -113,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 = @@ -135,17 +155,22 @@ log_in cookie_jar username password = -- knows that type (jpg, png, etc.) it is. save_image :: URLString -> IO (Maybe FilePath) save_image url = 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 + 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