-- hdav.hs: WebDAV client -- Copyright © 2012 Clint Adams -- -- 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 3 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, see . import qualified Data.ByteString.Char8 as BC8 import Data.Maybe (fromMaybe, fromJust) import Network (withSocketsDo) import qualified System.Console.CmdArgs.Explicit as CA import Network.Protocol.HTTP.DAV (getPropsAndContent, putContentAndProps) doCopy :: [(String, String)] -> IO () doCopy as = do let url1 = fromJust . lookup "sourceurl" $ as let url2 = fromJust . lookup "targeturl" $ as let sourceUsername = BC8.pack . fromMaybe "" . lookup "source-username" $ as let sourcePassword = BC8.pack . fromMaybe "" . lookup "source-password" $ as let targetUsername = BC8.pack . fromMaybe "" . lookup "target-username" $ as let targetPassword = BC8.pack . fromMaybe "" . lookup "target-password" $ as (p, b) <- getPropsAndContent url1 sourceUsername sourcePassword putContentAndProps url2 targetUsername targetPassword (p, b) dispatch :: String -> [(String, String)] -> IO () dispatch m as | m == "copy" = doCopy as | otherwise = fail "Unexpected condition." showHelp :: IO () showHelp = print $ CA.helpText [] CA.HelpFormatDefault arguments main :: IO () main = withSocketsDo $ do putStrLn "hDAV version 0.0.0, Copyright (C) 2012 Clint Adams\n\ \hDAV comes with ABSOLUTELY NO WARRANTY.\n\ \This is free software, and you are welcome to redistribute it\n\ \under certain conditions.\n\n" as <- CA.processArgs arguments if ("help","") `elem` as then showHelp else dispatch' as where dispatch' as = case lookup "mode" as of Nothing -> showHelp Just m -> dispatch m as arguments :: CA.Mode [(String,String)] arguments = CA.modes "hdav" [] "hdav WebDAV client" [ (CA.mode "copy" [("mode", "copy")] "copy" (CA.flagArg (upd "sourceurl") "SOURCEURL") [ CA.flagReq ["source-username"] (upd "source-username") "USERNAME" "username for source URL" , CA.flagReq ["source-password"] (upd "source-password") "PASSWORD" "password for source URL" , CA.flagReq ["target-username"] (upd "target-username") "USERNAME" "username for target URL" , CA.flagReq ["target-password"] (upd "target-password") "PASSWORD" "password for target URL" , CA.flagHelpSimple (("help",""):)]) { CA.modeArgs = ([(CA.flagArg (upd "sourceurl") "SOURCEURL") { CA.argRequire = True }, (CA.flagArg (upd "targeturl") "TARGETURL") { CA.argRequire = True }], Nothing) } ] where upd msg x v = Right $ (msg,x):v -- vim: set softtabstop=4 shiftwidth=4 expandtab