Merge pull request #245 from asciinema/next

Bounded (thread-pool based) & asynchronous (Aleph) PNG generation
This commit is contained in:
Marcin Kulik 2017-04-12 15:47:44 +02:00 committed by GitHub
commit 1c8bdc5e90
34 changed files with 923 additions and 5 deletions

16
.gitignore vendored
View File

@ -23,10 +23,16 @@ public/uploads/*
.rbx
.env
/.dir-locals.el
/.lein-env
/.lein-repl-history
/target
/classes
/checkouts
pom.xml
pom.xml.asc
*.jar
*.class
/.lein-*
/.nrepl-port
/dev/
/.dir-locals.el
/profiles.clj
/target/
/dev/resources/local.edn
/dev/src/local.clj

12
dev/resources/dev.edn Normal file
View File

@ -0,0 +1,12 @@
{:components
{:file-store #var asciinema.component.local-file-store/local-file-store
:exp-set #var asciinema.component.mem-expiring-set/mem-expiring-set}
:config
{:http
{:port 4000}
:db
{:uri "jdbc:postgresql://localhost:15432/asciinema_development?user=vagrant"}
:file-store
{:path "uploads/"}
:png-gen
{:bin-path "a2png/a2png.sh"}}}

25
dev/src/dev.clj Normal file
View File

@ -0,0 +1,25 @@
(ns dev
(:refer-clojure :exclude [test])
(:require [clojure.repl :refer :all]
[clojure.pprint :refer [pprint]]
[clojure.tools.namespace.repl :refer [refresh]]
[clojure.java.io :as io]
[com.stuartsierra.component :as component]
[duct.generate :as gen]
[duct.util.repl :refer [setup test cljs-repl migrate rollback]]
[duct.util.system :refer [load-system]]
[reloaded.repl :refer [system init start stop go reset]]
[asciinema.boundary.file-store :as file-store]
[asciinema.boundary.asciicast-database :as asciicast-database]
[asciinema.component.local-file-store :refer [->LocalFileStore]]
[asciinema.component.s3-file-store :refer [->S3FileStore]]))
(defn new-system []
(load-system (keep io/resource ["asciinema/system.edn" "dev.edn" "local.edn"])))
(when (io/resource "local.clj")
(load "local"))
(gen/set-ns-prefix 'asciinema)
(reloaded.repl/set-init! new-system)

8
dev/src/user.clj Normal file
View File

@ -0,0 +1,8 @@
(ns user)
(defn dev
"Load and switch to the 'dev' namespace."
[]
(require 'dev)
(in-ns 'dev)
:loaded)

47
project.clj Normal file
View File

@ -0,0 +1,47 @@
(defproject asciinema "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url "http://example.com/FIXME"
:min-lein-version "2.0.0"
:dependencies [[org.clojure/clojure "1.8.0"]
[com.stuartsierra/component "0.3.1"]
[clj-time "0.13.0"]
[duct "0.8.2"]
[yada "1.2.0"]
[aleph "0.4.1"]
[bidi "2.0.16"]
[prismatic/schema "1.1.3"]
[environ "1.1.0"]
[ring "1.5.0"]
[clj-bugsnag "0.2.9"]
[clj-aws-s3 "0.3.10" :exclusions [joda-time]]
[cheshire "5.7.0"]
[pandect "0.6.1"]
[com.taoensso/timbre "4.8.0"]
[com.taoensso/carmine "2.15.1"]
[org.slf4j/slf4j-nop "1.7.21"]
[duct/hikaricp-component "0.1.0"]
[org.postgresql/postgresql "9.4.1211"]
[duct/ragtime-component "0.1.4"]
[me.raynes/conch "0.8.0"]]
:plugins [[lein-environ "1.0.3"]]
:main ^:skip-aot asciinema.main
:target-path "target/%s/"
:aliases {"setup" ["run" "-m" "duct.util.repl/setup"]}
:profiles
{:dev [:project/dev :profiles/dev]
:test [:project/test :profiles/test]
:uberjar {:aot :all}
:profiles/dev {}
:profiles/test {}
:project/dev {:dependencies [[duct/generate "0.8.2"]
[reloaded.repl "0.2.3"]
[org.clojure/tools.namespace "0.2.11"]
[org.clojure/tools.nrepl "0.2.12"]
[eftest "0.1.1"]
[com.gearswithingears/shrubbery "0.4.1"]
[kerodon "0.8.0"]]
:source-paths ["dev/src"]
:resource-paths ["dev/resources"]
:repl-options {:init-ns user}
:env {:port "3000"}}
:project/test {}})

View File

@ -0,0 +1,11 @@
<!DOCTYPE html>
<html lang="en" class="example">
<head>
<title>Example Endpoint</title>
<link rel="stylesheet" href="/assets/normalize.css/normalize.css">
<link rel="stylesheet" href="/css/site.css">
</head>
<body>
<h1>This is an example endpoint</h1>
</body>
</html>

View File

@ -0,0 +1,12 @@
<!DOCTYPE html>
<html lang="en" class="error-page">
<head>
<title>Server Error</title>
<link rel="stylesheet" href="/assets/normalize.css/normalize.css">
<link rel="stylesheet" href="/css/site.css">
</head>
<body>
<h1>Resource Not Found</h1>
<h2>The requested page does not exist.</h2>
</body>
</html>

View File

@ -0,0 +1,12 @@
<!DOCTYPE html>
<html lang="en" class="error-page">
<head>
<title>Server Error</title>
<link rel="stylesheet" href="/assets/normalize.css/normalize.css">
<link rel="stylesheet" href="/css/site.css">
</head>
<body>
<h1>Internal Server Error</h1>
<h2>Sorry, something went wrong.</h2>
</body>
</html>

View File

@ -0,0 +1,103 @@
.error-page body {
background: #eee;
}
.error-page h1 {
margin: 15% 0 0 0;
text-align: center;
font-size: 42px;
color: #900;
}
.error-page h2 {
text-align: center;
font-size: 32px;
font-weight: normal;
color: #333;
}
.welcome body {
background: #eee;
color: #333;
font-family: Helvetica, Arial, sans-serif;
max-width: 700px;
padding: 15px;
margin: auto;
}
.welcome p {
line-height: 1.4em;
}
.welcome code {
font-family: Menlo, DejaVu Sans Mono, Lucida Console, monospace;
font-size: 12px;
background: #ddd;
color: #111;
}
.welcome h1 {
text-align: center;
font-size: 36px;
font-weight: lighter;
margin: 40px 0 30px 0;
}
.welcome h1 .outer {
border: solid 4px #555;
padding: 3px;
display: inline-block;
}
.welcome h1 .inner {
border: solid 2px #555;
padding: 0 3px;
display: inline-block;
font-weight: normal;
color: #444;
}
.welcome .project-name {
font-weight: bold;
}
.welcome .profiles {
margin-top: 30px;
}
.welcome .profiles code {
font-size: 11px;
}
.welcome .profiles h2 {
font-weight: normal;
font-size: 23px;
margin-bottom: 0;
color: #333;
}
.welcome .profiles dl {
margin: 0 10px;
}
.welcome .profiles dt {
font-weight: normal;
font-size: 19px;
margin: 18px 0 5px 0;
}
.welcome .profiles dd {
font-size: 14px;
margin: 8px 0 8px 0;
}
.example body {
background: #eee;
}
.example h1 {
margin: 15% 0 0 0;
text-align: center;
font-size: 36px;
font-weight: normal;
}

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

View File

@ -0,0 +1,36 @@
<!DOCTYPE html>
<html lang="en" class="welcome">
<head>
<title>Welcome to Duct</title>
<link rel="stylesheet" href="/assets/normalize.css/normalize.css">
<link rel="stylesheet" href="/css/site.css">
</head>
<body>
<h1>Welcome to <span class="outer"><span class="inner">Duct</span></span></h1>
<div class="intro">
<p>Congratulations! Your project <span class="project-name">asciinema</span> is
ready and running.</p>
<p>This is a static welcome page located at <code>resources/asciinema/public/index.html</code>
in the project directory. Remove or replace it when you start developing.
If you remove the index page entirely, be sure to change the
<code>:route-aliases</code> map in <code>resources/asciinema/system.edn</code>.
</div>
<div class="profiles">
<h2>Template profiles used:</h2>
<dl>
<dt>+example</dt>
<dd>Adds an example endpoint at <a href="/example">/example</a>.</dd>
<dt>+postgres</dt>
<dd>Adds a PostgreSQL dependency and database component. The database used for
development defaults to <code>postgres</code> on <code>localhost</code>.</dd>
<dt>+ragtime</dt>
<dd>Adds Ragtime migrations. Use <code>(migrate)</code> and <code>(rollback)</code>
in the REPL. Migrations are stored in <code>resources/asciinema/migrations</code>.
</dd>
<dt>+site</dt>
<dd>Adds middleware and configuration suited for a user-facing website.</dd>
</dl>
</div>
</body>
</html>

View File

@ -0,0 +1,2 @@
User-agent: *
Disallow:

View File

@ -0,0 +1,34 @@
{:components
{:http #var asciinema.component.yada-listener/yada-listener
:db #var asciinema.component.db/hikaricp
:ragtime #var duct.component.ragtime/ragtime
:file-store #var asciinema.component.s3-file-store/s3-file-store
:exp-set #var asciinema.component.redis-client/redis-client
:png-gen #var asciinema.component.a2png/a2png
:executor #var asciinema.component.fixed-thread-executor/fixed-thread-executor}
:endpoints
{:asciicasts #var asciinema.endpoint.asciicasts/asciicasts-endpoint}
:dependencies
{:http {:app :asciicasts}
:ragtime [:db]
:asciicasts [:db :file-store :exp-set :executor :png-gen]}
:config
{:http
{:port http-port}
:db
{:uri db-uri}
:ragtime
{:resource-path "asciinema/migrations"}
:file-store
{:cred {:access-key s3-access-key
:secret-key s3-secret-key}
:bucket s3-bucket
:path-prefix "uploads/"}
:exp-set
{:host redis-host
:port redis-port}
:png-gen
{:bin-path a2png-bin-path}
:executor
{:threads 2
:queue-length 16}}}

View File

@ -0,0 +1,5 @@
(ns asciinema.boundary.asciicast-database)
(defprotocol AsciicastDatabase
(get-asciicast-by-id [this id])
(get-asciicast-by-token [this token]))

View File

@ -0,0 +1,4 @@
(ns asciinema.boundary.executor)
(defprotocol Executor
(execute [this f]))

View File

@ -0,0 +1,6 @@
(ns asciinema.boundary.expiring-set
(:refer-clojure :exclude [conj! contains?]))
(defprotocol ExpiringSet
(conj! [this value expires-at])
(contains? [this value]))

View File

@ -0,0 +1,8 @@
(ns asciinema.boundary.file-store)
(defprotocol FileStore
(put-file [this file path] [this file path size])
(input-stream [this path])
(move-file [this old-path new-path])
(delete-file [this path])
(serve-file [this ctx path opts]))

View File

@ -0,0 +1,4 @@
(ns asciinema.boundary.png-generator)
(defprotocol PngGenerator
(generate [this json-is png-params]))

View File

@ -0,0 +1,4 @@
(ns asciinema.boundary.user-database)
(defprotocol UserDatabase
(get-user-by-id [this id]))

View File

@ -0,0 +1,26 @@
(ns asciinema.component.a2png
(:require [asciinema.boundary.png-generator :as png-generator]
[asciinema.util.io :refer [cleanup-input-stream create-tmp-dir]]
[clojure.java.io :as io]
[clojure.java
[io :as io]
[shell :as shell]]
[me.raynes.conch :as conch]))
(defn- exec-a2png [bin-path in-url out-path {:keys [snapshot-at theme scale]}]
(conch/let-programs [a2png bin-path]
(a2png in-url out-path (str snapshot-at) theme (str scale) {:timeout 30000})))
(defrecord A2png [bin-path]
png-generator/PngGenerator
(generate [this json-is png-params]
(let [dir (create-tmp-dir "a2png-")
cleanup #(shell/sh "rm" "-rf" (.getPath dir))
json-local-path (str dir "/asciicast.json")
png-local-path (str dir "/asciicast.png")]
(io/copy json-is (io/file json-local-path))
(exec-a2png bin-path json-local-path png-local-path png-params)
(cleanup-input-stream (io/input-stream png-local-path) cleanup))))
(defn a2png [{:keys [bin-path]}]
(->A2png bin-path))

View File

@ -0,0 +1,50 @@
(ns asciinema.component.db
(:require [asciinema.boundary.asciicast-database :refer :all]
[asciinema.boundary.user-database :refer :all]
[clojure.java.jdbc :as jdbc]
[clj-time.coerce :as timec]
[duct.component.hikaricp :as hikaricp]))
(extend-protocol jdbc/ISQLValue
org.joda.time.DateTime
(sql-value [val]
(timec/to-sql-time val)))
(extend-protocol jdbc/IResultSetReadColumn
java.sql.Timestamp
(result-set-read-column [x _ _]
(timec/from-sql-time x)))
;; AsciicastDatabase
(def q-get-asciicast-by-id "SELECT * FROM asciicasts WHERE id=?")
(def q-get-asciicast-by-secret-token "SELECT * FROM asciicasts WHERE secret_token=?")
(def q-get-public-asciicast-by-id "SELECT * FROM asciicasts WHERE id=? AND private=FALSE")
(extend-protocol AsciicastDatabase
duct.component.hikaricp.HikariCP
(get-asciicast-by-id [{db :spec} id]
(first (jdbc/query db [q-get-asciicast-by-id id])))
(get-asciicast-by-token [{db :spec} token]
(when-let [query (cond
(re-matches #"\d+" token)
[q-get-public-asciicast-by-id (Long/parseLong token)]
(= (count token) 25)
[q-get-asciicast-by-secret-token token])]
(first (jdbc/query db query)))))
;; UserDatabase
(def q-get-user-by-id "SELECT * FROM users WHERE id=?")
(extend-protocol UserDatabase
duct.component.hikaricp.HikariCP
(get-user-by-id [{db :spec} id]
(first (jdbc/query db [q-get-user-by-id id]))))
;; constructor
(def hikaricp hikaricp/hikaricp)

View File

@ -0,0 +1,39 @@
(ns asciinema.component.fixed-thread-executor
(:require [aleph.flow :as flow]
[asciinema.boundary.executor :as executor]
[com.stuartsierra.component :as component]
[manifold.deferred :as d])
(:import [java.util.concurrent
ExecutorService
RejectedExecutionException
TimeUnit]))
(defrecord FixedThreadExecutor [threads queue-length]
executor/Executor
(execute [{:keys [^ExecutorService executor]} f]
(try
(let [result (d/deferred)
f (fn []
(try
(d/success! result (f))
(catch Exception e
(d/error! result e))))]
(.execute executor f)
result)
(catch RejectedExecutionException _
nil)))
component/Lifecycle
(start [{:keys [threads queue-length] :as component}]
(let [executor (flow/fixed-thread-executor threads {:onto? false
:initial-thread-count threads
:queue-length queue-length})]
(assoc component :executor executor)))
(stop [{:keys [^ExecutorService executor] :as component}]
(.shutdown executor)
(when-not (.awaitTermination executor 1000 TimeUnit/MILLISECONDS)
(.shutdownNow executor))
(assoc component :executor nil)))
(defn fixed-thread-executor [{:keys [threads queue-length]}]
(->FixedThreadExecutor threads queue-length))

View File

@ -0,0 +1,38 @@
(ns asciinema.component.local-file-store
(:require [asciinema.boundary.file-store :as file-store]
[clojure.java.io :as io]
[ring.util.http-response :as response]))
(defrecord LocalFileStore [base-path]
file-store/FileStore
(put-file [this file path]
(let [path (str base-path path)]
(io/make-parents path)
(io/copy file (io/file path))))
(put-file [this file path size]
(file-store/put-file this file path))
(input-stream [this path]
(let [path (str base-path path)]
(io/input-stream path)))
(move-file [this old-path new-path]
(let [old-path (str base-path old-path)
new-path (str base-path new-path)]
(.renameTo (io/file old-path) (io/file new-path))))
(delete-file [this path]
(let [path (str base-path path)]
(io/delete-file path)))
(serve-file [this ctx path {:keys [filename]}]
(let [path (str base-path path)
response (assoc (:response ctx) :body (io/file path))]
(if filename
(update response :headers assoc "content-disposition" (str "attachment; filename=" filename))
response))))
(defn local-file-store [{:keys [path]}]
(->LocalFileStore path))

View File

@ -0,0 +1,14 @@
(ns asciinema.component.mem-expiring-set
(:require [asciinema.boundary.expiring-set :as exp-set]))
(defrecord MemExpiringSet [store]
exp-set/ExpiringSet
(conj! [this value _expires-at]
(swap! store conj value))
(contains? [this value]
(contains? @store value)))
(defn mem-expiring-set [{:keys [store]}]
(->MemExpiringSet (or store (atom #{}))))

View File

@ -0,0 +1,28 @@
(ns asciinema.component.redis-client
(:require [asciinema.boundary.expiring-set :as exp-set]
[clj-time.core :as t]
[clj-time.local :as tl]
[com.stuartsierra.component :as component]
[taoensso.carmine :as car]))
(defrecord RedisClient [host port]
component/Lifecycle
(start [component]
(if (:listener component)
component
(let [conn {:pool {} :spec {:host host :port port}}]
(assoc component :conn conn))))
(stop [component]
(if (:conn component)
(dissoc component :conn)
component))
exp-set/ExpiringSet
(conj! [this value expires-at]
(let [seconds (t/in-seconds (t/interval (tl/local-now) expires-at))]
(car/wcar (:conn this) (car/setex value seconds true))))
(contains? [this value]
(car/as-bool (car/wcar (:conn this) (car/exists value)))))
(defn redis-client [{:keys [host port]}]
(->RedisClient host port))

View File

@ -0,0 +1,64 @@
(ns asciinema.component.s3-file-store
(:require [asciinema.boundary.file-store :as file-store]
[aws.sdk.s3 :as s3]
[clj-time
[coerce :as timec]
[core :as time]]
[ring.util.http-response :as response]
[ring.util.mime-type :as mime-type])
(:import com.amazonaws.auth.BasicAWSCredentials
com.amazonaws.services.s3.AmazonS3Client
[com.amazonaws.services.s3.model GeneratePresignedUrlRequest ResponseHeaderOverrides]))
(defn- s3-client* [cred]
(let [credentials (BasicAWSCredentials. (:access-key cred) (:secret-key cred))]
(AmazonS3Client. credentials)))
(def ^:private s3-client (memoize s3-client*))
(defn- generate-presigned-url [cred bucket path {:keys [expires filename]
:or {expires (-> 1 time/days time/from-now)}}]
(let [client (s3-client cred)
request (GeneratePresignedUrlRequest. bucket path)]
(.setExpiration request (timec/to-date expires))
(when filename
(let [header-overrides (doto (ResponseHeaderOverrides.)
(.setContentDisposition (str "attachment; filename=" filename)))]
(.setResponseHeaders request header-overrides)))
(.toString (.generatePresignedUrl client request))))
(defrecord S3FileStore [cred bucket path-prefix]
file-store/FileStore
(put-file [this file path]
(file-store/put-file this file path nil))
(put-file [this file path size]
(let [path (str path-prefix path)
content-type (mime-type/ext-mime-type path)]
(s3/put-object cred bucket path file {:content-length size
:content-type content-type})))
(input-stream [this path]
(let [path (str path-prefix path)]
(:content (s3/get-object cred bucket path))))
(move-file [this old-path new-path]
(let [old-path (str path-prefix old-path)
new-path (str path-prefix new-path)]
(s3/copy-object cred bucket old-path new-path)
(s3/delete-object cred bucket old-path)))
(delete-file [this path]
(let [path (str path-prefix path)]
(s3/delete-object cred bucket path)))
(serve-file [this ctx path opts]
(let [path (str path-prefix path)
url (generate-presigned-url cred bucket path opts)]
(-> (:response ctx)
(assoc :status 302)
(update :headers assoc "location" url)))))
(defn s3-file-store [{:keys [cred bucket path-prefix]}]
(->S3FileStore cred bucket path-prefix))

View File

@ -0,0 +1,21 @@
(ns asciinema.component.yada-listener
(:require [com.stuartsierra.component :as component]
[yada.yada :as yada]))
(defrecord YadaListener [port server app]
component/Lifecycle
(start [component]
(if server
component
(let [handler (:routes app)
server (yada/listener handler {:port port})]
(assoc component :server server))))
(stop [component]
(if server
(do
((:close server))
(assoc component :server nil))
component)))
(defn yada-listener [{:keys [port app]}]
(map->YadaListener {:port port :app app}))

View File

@ -0,0 +1,90 @@
(ns asciinema.endpoint.asciicasts
(:require [asciinema.boundary
[asciicast-database :as adb]
[executor :as executor]
[expiring-set :as exp-set]
[file-store :as fstore]
[png-generator :as png]
[user-database :as udb]]
[asciinema.model.asciicast :as asciicast]
[asciinema.yada :refer [not-found-model resource]]
[clj-time.core :as t]
[schema.core :as s]
[yada.yada :as yada]))
(def Theme (apply s/enum asciicast/themes))
(defn- service-unavailable-response [ctx]
(-> (:response ctx)
(assoc :status 503)
(update :headers assoc "retry-after" "5")))
(defn- async-response [ctx executor f]
(or (executor/execute executor f)
(service-unavailable-response ctx)))
(defn asciicast-file-resource [db file-store]
(resource
{:produces "application/json"
:parameters {:path {:token String}
:query {(s/optional-key :dl) s/Bool}}
:properties (fn [ctx]
(if-let [asciicast (adb/get-asciicast-by-token db (-> ctx :parameters :path :token))]
{::asciicast asciicast}
{:exists? false}))
:response (fn [ctx]
(let [asciicast (-> ctx :properties ::asciicast)
dl (-> ctx :parameters :query :dl)
path (asciicast/json-store-path asciicast)
filename (str "asciicast-" (:id asciicast) ".json")]
(fstore/serve-file file-store ctx path (when dl {:filename filename}))))}))
(def png-ttl-days 7)
(defn asciicast-image-resource [db file-store exp-set executor png-gen]
(resource
{:produces
"image/png"
:parameters
{:path {:token String}
:query {(s/optional-key :time) s/Num
(s/optional-key :theme) Theme
(s/optional-key :scale) (s/enum "1" "2")}}
:properties
(fn [ctx]
(if-let [asciicast (adb/get-asciicast-by-token db (-> ctx :parameters :path :token))]
(let [user (udb/get-user-by-id db (:user_id asciicast))
{:keys [time theme scale]} (-> ctx :parameters :query)
png-params (cond-> (asciicast/png-params asciicast user)
time (assoc :snapshot-at time)
theme (assoc :theme theme)
scale (assoc :scale (Integer/parseInt scale)))]
{:version (asciicast/png-version asciicast png-params)
::asciicast asciicast
::png-params png-params})
{:exists? false}))
:response
(fn [ctx]
(let [asciicast (-> ctx :properties ::asciicast)
png-params (-> ctx :properties ::png-params)
png-store-path (asciicast/png-store-path asciicast png-params)
expires (-> png-ttl-days t/days t/from-now)]
(if (exp-set/contains? exp-set png-store-path)
(fstore/serve-file file-store ctx png-store-path {})
(async-response ctx
executor
(fn []
(let [json-store-path (asciicast/json-store-path asciicast)]
(with-open [json-is (fstore/input-stream file-store json-store-path)
png-is (png/generate png-gen json-is png-params)]
(fstore/put-file file-store png-is png-store-path)))
(exp-set/conj! exp-set png-store-path expires)
(fstore/serve-file file-store ctx png-store-path {}))))))}))
(defn asciicasts-endpoint [{:keys [db file-store exp-set executor png-gen]}]
["" [["/a/" [[[:token ".json"] (asciicast-file-resource db file-store)]
[[:token ".png"] (asciicast-image-resource db file-store exp-set executor png-gen)]]]
[true (yada/resource not-found-model)]]])

42
src/asciinema/main.clj Normal file
View File

@ -0,0 +1,42 @@
(ns asciinema.main
(:gen-class)
(:require [asciinema.yada :as y]
[clj-bugsnag.core :as bugsnag]
[com.stuartsierra.component :as component]
[duct.util.runtime :refer [add-shutdown-hook]]
[duct.util.system :refer [load-system]]
[environ.core :refer [env]]
[clojure.java.io :as io]))
(defn- request-context [req]
(str (-> req (get :request-method :unknown) name .toUpperCase)
" "
(:uri req)))
(defn- create-exception-notifier []
(when-let [key (:bugsnag-key env)]
(let [environment (:env-name env "production")
version (:git-sha env)]
(fn [ex req]
(bugsnag/notify ex {:api-key key
:environment environment
:project-ns "asciinema"
:version version
:context (request-context req)
:meta {:request (dissoc req :body)}})))))
(defn -main [& args]
(binding [y/*exception-notifier* (create-exception-notifier)]
(let [bindings {'http-port (Integer/parseInt (:port env "3000"))
'db-uri (:database-url env)
's3-bucket (:s3-bucket env)
's3-access-key (:s3-access-key env)
's3-secret-key (:s3-secret-key env)
'redis-host (:redis-host env "localhost")
'redis-port (Integer/parseInt (:redis-port env "6379"))
'a2png-bin-path (:a2png-bin-path env "a2png/a2png.sh")}
system (->> (load-system [(io/resource "asciinema/system.edn")] bindings)
(component/start))]
(add-shutdown-hook ::stop-system #(component/stop system))
(println "Started HTTP server on port" (-> system :http :port))))
@(promise))

View File

@ -0,0 +1,38 @@
(ns asciinema.model.asciicast
(:require [pandect.algo.sha1 :as sha1]
[clojure.string :as str]))
(defn json-store-path [{:keys [id file stdout_frames]}]
(cond
file (str "asciicast/file/" id "/" file)
stdout_frames (str "asciicast/stdout_frames/" id "/" stdout_frames)))
(def themes #{"asciinema" "tango" "solarized-dark" "solarized-light" "monokai"})
(def default-theme "asciinema")
(defn theme-name [asciicast user]
(or (:theme_name asciicast)
(:theme_name user)
default-theme))
(defn snapshot-at [{:keys [snapshot_at duration]}]
(or snapshot_at (/ duration 2.0)))
(def default-png-scale 2)
(defn png-params [asciicast user]
{:snapshot-at (snapshot-at asciicast)
:theme (theme-name asciicast user)
:scale default-png-scale})
(defn png-version [asciicast params]
(let [attrs (assoc params :id (:id asciicast))]
(->> attrs
(map (fn [[k v]] (str (name k) "=" v)))
(str/join "/")
(sha1/sha1))))
(defn png-store-path [asciicast params]
(let [ver (png-version asciicast params)
png-filename (str ver ".png")]
(str "png/" (:id asciicast) "/" png-filename)))

22
src/asciinema/util/io.clj Normal file
View File

@ -0,0 +1,22 @@
(ns asciinema.util.io
(:require [clojure.java.shell :as shell])
(:import java.io.FilterInputStream
java.nio.file.attribute.FileAttribute
java.nio.file.Files))
(defn create-tmp-dir [prefix]
(let [dir (Files/createTempDirectory prefix (into-array FileAttribute []))]
(.toFile dir)))
(defmacro with-tmp-dir [[sym prefix] & body]
`(let [~sym (create-tmp-dir ~prefix)]
(try
~@body
(finally
(shell/sh "rm" "-rf" (.getPath ~sym))))))
(defn cleanup-input-stream [is cleanup]
(proxy [FilterInputStream] [is]
(close []
(proxy-super close)
(cleanup))))

46
src/asciinema/yada.clj Normal file
View File

@ -0,0 +1,46 @@
(ns asciinema.yada
(:require [clojure.java.io :as io]
[taoensso.timbre :as log]
[yada.status :as status]
[yada.yada :as yada]))
(def ^:dynamic *exception-notifier* nil)
(def not-found-model
{:produces
#{"text/html" "text/plain"}
:response
(fn [ctx]
(assoc (:response ctx)
:status 404
:body (case (yada/content-type ctx)
"text/html" (io/input-stream (io/resource "asciinema/errors/404.html"))
"Not found")))})
(defn error-response [ctx]
(let [status (-> ctx :response :status)
status-name (get-in status/status [status :name])]
(case (yada/content-type ctx)
"text/html" (str "<html><body><h1>" status-name "</h1></body></html>")
status-name)))
(defn create-logger []
(let [notifier *exception-notifier*]
(fn [ctx]
(when-let [error (:error ctx)]
(let [status (-> ctx :response :status)]
(when (not= status 404)
(log/error error))
(when (and (= status 500) notifier)
(let [ex (or (-> error ex-data :error) error)]
(notifier ex (:request ctx))))))
ctx)))
(defn resource [model]
(let [error-statuses (set (concat (range 400 404) (range 405 600) ))]
(-> model
(assoc :logger (create-logger))
(update-in [:responses 404] #(or % not-found-model))
(update-in [:responses error-statuses] #(or % {:produces #{"text/html" "text/plain"}
:response error-response}))
yada/resource)))

View File

@ -0,0 +1,7 @@
(ns asciinema.boundary.file-store-test
(:require [clojure.test :refer :all]
[asciinema.boundary.file-store :as file-store]))
(deftest a-test
(testing "FIXME, I fail."
(is (= 0 1))))

View File

@ -0,0 +1,54 @@
(ns asciinema.component.db-test
(:require [clojure.test :refer :all]
[clojure.java.jdbc :as jdbc]
[clj-time.local :as timel]
[com.stuartsierra.component :as component]
[asciinema.component.db :as db]
[asciinema.boundary.asciicast-database :as adb]))
(defmacro with-db-component [component-var & body]
`(let [component# (-> (db/hikaricp {:uri "jdbc:postgresql://localhost:15432/asciinema_test?user=vagrant"})
component/start)]
(try
(jdbc/with-db-transaction [db# (:spec component#)]
(let [~component-var (assoc component# :spec db#)]
(jdbc/db-set-rollback-only! db#)
~@body))
(finally
(component/stop component#)))))
(defn insert-asciicast
([db] (insert-asciicast db {}))
([db attrs]
(first (jdbc/insert! db :asciicasts (merge {:duration 10.0
:terminal_columns 80
:terminal_lines 24
:created_at (timel/local-now)
:updated_at (timel/local-now)
:version 1
:secret_token "abcdeabcdeabcdeabcdeabcde"}
attrs)))))
(deftest get-asciicast-by-id-test
(testing "for existing asciicast"
(with-db-component db
(let [asciicast (insert-asciicast (:spec db))]
(is (map? (adb/get-asciicast-by-id db (:id asciicast)))))))
(testing "for non-existing asciicast"
(with-db-component db
(is (nil? (adb/get-asciicast-by-id db 1))))))
(deftest get-asciicast-by-token-test
(testing "for existing public asciicast"
(with-db-component db
(let [asciicast (insert-asciicast (:spec db) {:private false})]
(is (map? (adb/get-asciicast-by-token db (:secret_token asciicast))))
(is (map? (adb/get-asciicast-by-token db (-> asciicast :id str)))))))
(testing "for existing private asciicast"
(with-db-component db
(let [asciicast (insert-asciicast (:spec db) {:private true})]
(is (map? (adb/get-asciicast-by-token db (:secret_token asciicast))))
(is (nil? (adb/get-asciicast-by-token db (-> asciicast :id str)))))))
(testing "for non-existing asciicast"
(with-db-component db
(is (nil? (adb/get-asciicast-by-token db "1"))))))