summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHenningThielemann <>2012-12-14 20:42:20 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2012-12-14 20:42:20 (GMT)
commit4b4ff04a7ea08cc8fee4241bde4fcab9eec6aa00 (patch)
treeba0959ddb5c21b6b69d62e328c78585c8231df8b
version 0.10.1
-rw-r--r--LICENSE30
-rw-r--r--Setup.hs3
-rw-r--r--src/Main.hs72
-rw-r--r--youtube.cabal41
4 files changed, 146 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..70bb71f
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Henning Thielemann 2012
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Henning Thielemann nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..cd7dc32
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..4d10b58
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,72 @@
+module Main where
+
+import qualified Data.ByteString.Lazy as BL
+import qualified Control.Concurrent.MVar as MVar
+import qualified Control.Concurrent as Conc
+import qualified System.Environment as Env
+import qualified System.Exit as Exit
+import qualified System.Process as Proc
+import qualified System.IO as IO
+
+
+boundary :: String
+boundary = "20ura9wrejfoegsnvgengnesg893ut9834"
+
+writeBody :: FilePath -> FilePath -> IO.Handle -> IO ()
+writeBody xml video h = do
+ IO.hPutStrLn h $ "--" ++ boundary
+ IO.hPutStrLn h "Content-Type: application/atom+xml; charset=UTF-8"
+ IO.hPutStrLn h ""
+ BL.readFile xml >>= BL.hPut h
+ IO.hPutStrLn h $ "--" ++ boundary
+ IO.hPutStrLn h "Content-Type: video/avi"
+ IO.hPutStrLn h "Content-Transfer-Encoding: binary"
+ IO.hPutStrLn h ""
+ BL.readFile video >>= BL.hPut h
+ IO.hPutStrLn h ""
+ IO.hPutStrLn h $ "--" ++ boundary ++ "--"
+
+runCurl :: String -> String -> FilePath -> FilePath -> IO ()
+runCurl developerKey auth xml video = do
+ (inp,out,err,pid) <-
+ Proc.runInteractiveProcess "curl" [
+ "--header", "Authorization: GoogleLogin auth=" ++ auth,
+ "--header", "X-GData-Key: key=" ++ developerKey,
+ "--header", "GData-Version: 2",
+ "--header", "Content-Type: multipart/related; boundary=\"" ++ boundary ++ "\"",
+ "--header", "Slug: " ++ video,
+ "--data-binary", "@-",
+-- "http://localhost:8080/"
+ "http://uploads.gdata.youtube.com/feeds/api/users/default/uploads"
+ ]
+ Nothing Nothing
+ term <- MVar.newEmptyMVar
+ let transfer from to =
+ IO.hGetContents from >>= IO.hPutStr to >> MVar.putMVar term ()
+-- BL.hGetContents from >>= BL.hPutStr to >> MVar.putMVar term ()
+ _ <- Conc.forkIO $ transfer out IO.stdout
+ _ <- Conc.forkIO $ transfer err IO.stderr
+ writeBody xml video inp
+ IO.hClose inp
+ exit <- Proc.waitForProcess pid
+ case exit of
+ Exit.ExitFailure _ -> Exit.exitWith exit
+ _ -> return ()
+ MVar.takeMVar term
+ MVar.takeMVar term
+
+main :: IO ()
+main = do
+ args <- Env.getArgs
+ case args of
+ [keyPath, xml, video] -> do
+ auth <- Env.getEnv "YOUTUBEAUTH"
+ key <- readFile keyPath
+ case lines key of
+ k:_ -> runCurl k auth xml video
+ _ -> do
+ IO.hPutStrLn IO.stderr "empty developerKey file"
+ Exit.exitFailure
+ _ -> do
+ IO.hPutStrLn IO.stderr "Usage: developerKeyPath xmlPath videoPath"
+ Exit.exitFailure
diff --git a/youtube.cabal b/youtube.cabal
new file mode 100644
index 0000000..d02b5fc
--- /dev/null
+++ b/youtube.cabal
@@ -0,0 +1,41 @@
+Name: youtube
+Version: 0.1
+Synopsis: Upload video to YouTube via YouTube API
+Description:
+ Upload a video to YouTube via YouTube API.
+ The aim of this program is to simplify uploads of related videos.
+ .
+ First you must have the @curl@ executable installed.
+ .
+ In order to use the @youtube-upload@ command
+ 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.
+ 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,
+ an XML file containing meta data for the video and the video file.
+ .
+ The XML file must be encoded with UTF-8.
+ 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.
+License: BSD3
+License-file: LICENSE
+Author: Henning Thielemann
+Maintainer: haskell@henning-thielemann.de
+Stability: Experimental
+Category: Web
+Build-type: Simple
+
+Cabal-version: >=1.2
+
+
+Executable youtube-upload
+ Main-is: src/Main.hs
+ GHC-Options: -Wall -threaded
+ Build-depends:
+ bytestring >=0.9 && <0.11,
+ process >=1.0 && <1.2,
+ base >=4.2 && <5