summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHenningThielemann <>2012-12-14 22:30:50 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2012-12-14 22:30:50 (GMT)
commit9a786a86e6ef9401ee2961026b0d3a33f963d4f0 (patch)
tree667aa29775914a7ed834b07163f576b24028644a
parent4b4ff04a7ea08cc8fee4241bde4fcab9eec6aa00 (diff)
version 0.20.2
-rw-r--r--src/Authentication.hs104
-rw-r--r--src/Upload.hs (renamed from src/Main.hs)16
-rw-r--r--src/Utility.hs10
-rw-r--r--src/YouTube.hs6
-rw-r--r--src/upload-template.xml15
-rw-r--r--youtube.cabal49
6 files changed, 189 insertions, 11 deletions
diff --git a/src/Authentication.hs b/src/Authentication.hs
new file mode 100644
index 0000000..1dfcd71
--- /dev/null
+++ b/src/Authentication.hs
@@ -0,0 +1,104 @@
+module Main (main) where
+
+import qualified YouTube
+
+import qualified Control.Concurrent.MVar as MVar
+import qualified Control.Concurrent as Conc
+-- import qualified System.Posix.Env as PosixEnv
+import qualified System.Environment as Env
+import qualified System.Exit as Exit
+import qualified System.Process as Proc
+import qualified System.IO.Error as Err
+import qualified System.IO as IO
+import Control.Exception (bracket_, )
+import Utility (exitFailureMsg, )
+
+import Control.Monad (when, )
+import Control.Functor.HT (void, )
+import Data.List (isPrefixOf, )
+import Data.List.HT (maybePrefixOf, )
+import Data.Maybe (mapMaybe, )
+
+
+runCurl :: String -> String -> String -> IO String
+runCurl user passwd source = do
+ (inp,out,err,pid) <-
+ Proc.runInteractiveProcess "curl" [
+ "--location", "https://www.google.com/accounts/ClientLogin",
+ "--data",
+ "Email=" ++ user ++
+ "&Passwd=" ++ passwd ++
+ "&service=youtube&source=" ++ source,
+ "--header", "Content-Type:application/x-www-form-urlencoded"]
+ Nothing Nothing
+ errTerm <- MVar.newEmptyMVar
+ authVar <- MVar.newEmptyMVar
+ void $ Conc.forkIO $ IO.hGetContents out >>= MVar.putMVar authVar
+ void $ Conc.forkIO $ IO.hGetContents err >>= IO.hPutStr IO.stderr >> MVar.putMVar errTerm ()
+ IO.hClose inp
+ exit <- Proc.waitForProcess pid
+ case exit of
+ Exit.ExitFailure _ -> Exit.exitWith exit
+ _ -> return ()
+ MVar.takeMVar errTerm
+ MVar.takeMVar authVar
+
+
+run :: Maybe String -> Maybe String -> IO ()
+run mUser mSource = do
+ user <-
+ case mUser of
+ Nothing -> Env.getEnv YouTube.userVar
+ Just x -> return x
+ source <-
+ case mSource of
+ Nothing ->
+ Err.catchIOError
+ (Env.getEnv YouTube.sourceVar)
+ (\err ->
+ if Err.isDoesNotExistError err
+ then return "Haskell-YouTube"
+ else Err.ioError err)
+ -- Nothing -> PosixEnv.getEnvDefault YouTube.sourceVar "Haskell-YouTube"
+ Just x -> return x
+
+ putStr "Password: "
+ IO.hFlush IO.stdout
+ echoMode <- IO.hGetEcho IO.stdin
+ passwd <-
+ bracket_
+ (IO.hSetEcho IO.stdin False)
+ (IO.hSetEcho IO.stdin echoMode)
+ getLine
+ putStrLn ""
+
+ response <- runCurl user passwd source
+ when (any (isPrefixOf "Error=") $ lines response) $
+ exitFailureMsg response
+ case mapMaybe (maybePrefixOf "Auth=") $ lines response of
+ [] ->
+ exitFailureMsg $
+ "no Auth assignment found in server response:\n" ++ response
+ auth : _ -> do
+ putStrLn "please do the following before running youtube-upload:"
+ putStrLn $ "export " ++ YouTube.authVar ++ "=" ++ auth
+ {-
+ We cannot change environment variables of the calling Shell this way.
+ PosixEnv.setEnv YouTube.authVar auth True
+ -}
+
+exitUsage :: IO ()
+exitUsage = do
+ prog <- Env.getProgName
+ exitFailureMsg $
+ "Usage: " ++ prog ++ " [youtubeUserName [developerSource]]"
+
+main :: IO ()
+main = do
+ args0 <- Env.getArgs
+ case args0 of
+ "--help" : _ -> exitUsage
+ [] -> run Nothing Nothing
+ [user] -> run (Just user) Nothing
+ [user, source] -> run (Just user) (Just source)
+ _ -> exitUsage
diff --git a/src/Main.hs b/src/Upload.hs
index 4d10b58..5116985 100644
--- a/src/Main.hs
+++ b/src/Upload.hs
@@ -1,4 +1,6 @@
-module Main where
+module Main (main) where
+
+import qualified YouTube
import qualified Data.ByteString.Lazy as BL
import qualified Control.Concurrent.MVar as MVar
@@ -7,6 +9,7 @@ import qualified System.Environment as Env
import qualified System.Exit as Exit
import qualified System.Process as Proc
import qualified System.IO as IO
+import Utility (exitFailureMsg, )
boundary :: String
@@ -60,13 +63,12 @@ main = do
args <- Env.getArgs
case args of
[keyPath, xml, video] -> do
- auth <- Env.getEnv "YOUTUBEAUTH"
+ auth <- Env.getEnv YouTube.authVar
key <- readFile keyPath
case lines key of
k:_ -> runCurl k auth xml video
- _ -> do
- IO.hPutStrLn IO.stderr "empty developerKey file"
- Exit.exitFailure
+ _ -> exitFailureMsg "empty developerKey file"
_ -> do
- IO.hPutStrLn IO.stderr "Usage: developerKeyPath xmlPath videoPath"
- Exit.exitFailure
+ prog <- Env.getProgName
+ exitFailureMsg $
+ "Usage: " ++ prog ++ " developerKeyPath xmlPath videoPath"
diff --git a/src/Utility.hs b/src/Utility.hs
new file mode 100644
index 0000000..796467e
--- /dev/null
+++ b/src/Utility.hs
@@ -0,0 +1,10 @@
+module Utility where
+
+import qualified System.Exit as Exit
+import qualified System.IO as IO
+
+
+exitFailureMsg :: String -> IO ()
+exitFailureMsg msg = do
+ IO.hPutStrLn IO.stderr msg
+ Exit.exitFailure
diff --git a/src/YouTube.hs b/src/YouTube.hs
new file mode 100644
index 0000000..2d19243
--- /dev/null
+++ b/src/YouTube.hs
@@ -0,0 +1,6 @@
+module YouTube where
+
+authVar, userVar, sourceVar :: String
+authVar = "YOUTUBEAUTH"
+userVar = "YOUTUBEUSER"
+sourceVar = "YOUTUBESOURCE"
diff --git a/src/upload-template.xml b/src/upload-template.xml
new file mode 100644
index 0000000..936ad3a
--- /dev/null
+++ b/src/upload-template.xml
@@ -0,0 +1,15 @@
+<?xml version="1.0"?>
+<entry xmlns="http://www.w3.org/2005/Atom"
+ xmlns:media="http://search.yahoo.com/mrss/"
+ xmlns:yt="http://gdata.youtube.com/schemas/2007">
+ <media:group>
+ <media:title type="plain">TITLE</media:title>
+ <media:description type="plain">
+DESCRIPTION
+ </media:description>
+ <media:category
+ scheme="http://gdata.youtube.com/schemas/2007/categories.cat">CATEGORY
+ </media:category>
+ <media:keywords>TAGS</media:keywords>
+ </media:group>
+</entry>
diff --git a/youtube.cabal b/youtube.cabal
index d02b5fc..688d26a 100644
--- a/youtube.cabal
+++ b/youtube.cabal
@@ -1,5 +1,5 @@
Name: youtube
-Version: 0.1
+Version: 0.2
Synopsis: Upload video to YouTube via YouTube API
Description:
Upload a video to YouTube via YouTube API.
@@ -11,7 +11,16 @@ Description:
you need a YouTube account and an additional developer account.
From the developer account you get a keyfile.
If you want to upload videos you first have to login to YouTube.
- As a result of this you get an authentication token.
+ You can do this with
+ .
+ > youtube-auth your_youtube_login
+ .
+ or
+ .
+ > export YOUTUBEUSER=your_youtube_login
+ > youtube-auth
+ .
+ As a result of this call you get an authentication token.
Write this authentication token into the @YOUTUBEAUTH@ environment variable.
It is queried by @youtube-upload@.
For every upload you have to pass the developer keyfile,
@@ -21,6 +30,9 @@ Description:
I found it very useful to generate the XML files
from an XML template file and a CSV table
using the @cvsreplace@ command from the @spreadsheet@ package.
+ I have included the example file @upload-template.xml@
+ that you can use with a CSV file
+ with the columns @TITLE@, @DESCRIPTION@, @CATEGORY@, @TAGS@.
License: BSD3
License-file: LICENSE
Author: Henning Thielemann
@@ -28,12 +40,41 @@ Maintainer: haskell@henning-thielemann.de
Stability: Experimental
Category: Web
Build-type: Simple
+Cabal-version: >=1.6
+
+Data-Files:
+ src/upload-template.xml
+
+Source-Repository this
+ Tag: 0.2
+ Type: darcs
+ Location: http://code.haskell.org/~thielema/youtube/
-Cabal-version: >=1.2
+Source-Repository head
+ Type: darcs
+ Location: http://code.haskell.org/~thielema/youtube/
+Executable youtube-auth
+ Main-is: Authentication.hs
+ Other-Modules:
+ YouTube
+ Utility
+ Hs-Source-Dirs: src
+ GHC-Options: -Wall -threaded
+ Build-depends:
+ bytestring >=0.9 && <0.11,
+-- unix >=2.5 && <2.7,
+ process >=1.0 && <1.2,
+ utility-ht >=0.0.8 && <0.1,
+ base >=4.2 && <5
+
Executable youtube-upload
- Main-is: src/Main.hs
+ Main-is: Upload.hs
+ Other-Modules:
+ YouTube
+ Utility
+ Hs-Source-Dirs: src
GHC-Options: -Wall -threaded
Build-depends:
bytestring >=0.9 && <0.11,