├── .travis.yml ├── clojalk.properties ├── .gitignore ├── project.clj ├── src └── clojalk │ ├── main.clj │ ├── jmx.clj │ ├── utils.clj │ ├── net │ └── protocol.clj │ ├── data.clj │ ├── wal.clj │ ├── net.clj │ └── core.clj ├── test └── clojalk │ └── test │ ├── net.clj │ ├── wal.clj │ └── core.clj ├── scripts ├── put.clj └── bench.clj └── README.md /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | script: "lein test" 3 | -------------------------------------------------------------------------------- /clojalk.properties: -------------------------------------------------------------------------------- 1 | server.port=12026 2 | 3 | wal.enable=true 4 | wal.dir=./binlogs/ 5 | wal.files=6 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | *jar 3 | /lib/ 4 | /classes/ 5 | .lein-failures 6 | .lein-deps-sum 7 | clojalk.iml 8 | clojalk.iws 9 | clojalk.ipr 10 | /docs/ 11 | /binlogs/ 12 | *.swp 13 | *#* 14 | 15 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojalk "1.0.0-SNAPSHOT" 2 | :description "A beanstalkd clone in clojure" 3 | :dependencies [[org.clojure/clojure "1.2.1"] 4 | [org.clojure/clojure-contrib "1.2.0"] 5 | [aleph "0.2.0"]] 6 | :dev-dependencies [[org.clojars.sunng/beanstalk "1.0.5"] 7 | [lein-exec "0.1"] 8 | [lein-marginalia "0.6.0"]] 9 | :warn-on-reflection true 10 | :main clojalk.main) 11 | -------------------------------------------------------------------------------- /src/clojalk/main.clj: -------------------------------------------------------------------------------- 1 | (ns clojalk.main 2 | (:gen-class) 3 | (:refer-clojure :exclude [use peek]) 4 | (:use [clojalk net core utils jmx wal]) 5 | (:use [clojure.contrib.properties])) 6 | 7 | (set! *warn-on-reflection* false) 8 | (defn property [^java.util.Properties properties ^String key] 9 | (.getProperty properties key)) 10 | 11 | (defn -main [& args] 12 | (let [prop-file-name (or (first args) "clojalk.properties") 13 | props (read-properties prop-file-name)] 14 | (binding [*clojalk-log-enabled* (Boolean/valueOf ^String (property props "wal.enable")) 15 | *clojalk-log-dir* (property props "wal.dir") 16 | *clojalk-log-count* (as-int (property props "wal.files"))] 17 | (if *clojalk-log-enabled* (start-wal))) 18 | (binding [*clojalk-port* (as-int (property props "server.port"))] 19 | (start-server)) 20 | (start-jmx-server) 21 | (println (str "Clojalk server started, listening on " 22 | (property props "server.port"))))) 23 | -------------------------------------------------------------------------------- /test/clojalk/test/net.clj: -------------------------------------------------------------------------------- 1 | (ns clojalk.test.net 2 | (:refer-clojure :exclude [use peek]) 3 | (:use [clojalk core net utils]) 4 | (:use [lamina.core]) 5 | (:use [clojure.test]) 6 | (:import java.net.InetSocketAddress)) 7 | 8 | (defmacro with-ch [ch data-in addr-in & body] 9 | `(let [~ch (channel ~data-in) 10 | addr# {:remote-addr ~addr-in}] 11 | (receive-all ~ch #(command-dispatcher ~ch addr# %)) 12 | ~@body)) 13 | 14 | (defmacro is-ch [ch test] 15 | `(receive-all ~ch #(is (~test %)))) 16 | 17 | (deftest test-put 18 | (with-ch ch ["PUT" "5" "0" "9" "abc"] (InetSocketAddress. "127.0.0.1" 19875) 19 | (is-ch ch #(= "INSERTED" (first %))))) 20 | 21 | (deftest test-use 22 | (with-ch ch ["USE" "tomcat"] (InetSocketAddress. "127.0.0.1" 19876) 23 | (is-ch ch #(= ["USING" "tomcat"] %)))) 24 | 25 | (deftest test-watch 26 | (with-ch ch ["WATCH" "tomcat"] (InetSocketAddress. "127.0.0.1" 19877) 27 | (is-ch ch #(= ["WATCHING" "2"] %)))) 28 | 29 | (deftest test-ignore 30 | (with-ch ch ["IGNORE" "default"] (InetSocketAddress. "127.0.0.1" 19878) 31 | (is-ch ch #(= ["NOT_IGNORED"] %)))) 32 | 33 | (deftest test-peekdelayed 34 | (with-ch ch ["PEEK-DELAYED"] (InetSocketAddress. "127.0.0.1" 19879) 35 | (is-ch ch #(= ["NOT_FOUND"] %)))) 36 | 37 | -------------------------------------------------------------------------------- /scripts/put.clj: -------------------------------------------------------------------------------- 1 | (ns clojalk.script.put 2 | (:refer-clojure :exclude [use peek read]) 3 | (:use [beanstalk.core]) 4 | (:use [clojure.contrib.properties]) 5 | (:import [java.util.concurrent CountDownLatch])) 6 | 7 | (if-not (= (count *command-line-args*) 4) 8 | (do 9 | (println "Usage: lein exec scripts/put.clj tube-name job-count connection-count") 10 | (System/exit 1))) 11 | 12 | (def props (read-properties "./clojalk.properties")) 13 | (defn get-client [] (new-beanstalk (Integer/valueOf (.getProperty props "server.port")))) 14 | ;(def client (new-beanstalk 11300)) 15 | 16 | (def job-body "sunng@about.meSun Ning") 17 | 18 | (def job-body-length 19 | (alength ^bytes (.getBytes ^String job-body "utf8"))) 20 | 21 | (def tube-name (nth *command-line-args* 1)) 22 | (def total-jobs (atom (Integer/valueOf (nth *command-line-args* 2)))) 23 | (def total-clients (Integer/valueOf (nth *command-line-args* 3))) 24 | (def latch (CountDownLatch. total-clients)) 25 | 26 | (defn do-put-jobs [] 27 | (let [client (get-client)] 28 | (use client tube-name) 29 | (loop [] 30 | (if (<= @total-jobs 0) 31 | (.countDown latch) 32 | (do 33 | (put client (rand-int 2048) 0 1000 job-body-length job-body) 34 | (swap! total-jobs dec) 35 | (recur)))))) 36 | 37 | (defn run-in-thread [runnable] 38 | (let [t (Thread. runnable)] 39 | (.setDaemon t false) 40 | (.start t))) 41 | 42 | (time 43 | (do 44 | (dorun (map run-in-thread (take total-clients (repeat do-put-jobs)))) 45 | (.await latch))) 46 | 47 | -------------------------------------------------------------------------------- /src/clojalk/jmx.clj: -------------------------------------------------------------------------------- 1 | (ns clojalk.jmx 2 | (:refer-clojure :exclude [use peek]) 3 | (:use [clojalk data utils wal]) 4 | (:require [clojure.contrib.jmx :as jmx]) 5 | (:import [clojure.contrib.jmx Bean])) 6 | 7 | (defn new-mbean [state-ref] 8 | (proxy [Bean] [state-ref] 9 | (getAttribute [attr] 10 | (let [attr-value (@(.state ^clojure.contrib.jmx.Bean this) (keyword attr))] 11 | (if (fn? attr-value) 12 | (attr-value) 13 | attr-value))))) 14 | 15 | (defn- workers [] 16 | (map #(name (:id @%)) (filter #(= :worker (:type @%)) (vals @sessions)))) 17 | 18 | (defn- producers [] 19 | (map #(name (:id @%)) (filter #(= :producer (:type @%)) (vals @sessions)))) 20 | 21 | (def jmx-session-bean 22 | (new-mbean 23 | (ref 24 | {:workers (fn [] (into-string-array (workers))) 25 | :producers (fn [] (into-string-array (producers)))}))) 26 | 27 | (def jmx-job-bean 28 | (new-mbean 29 | (ref 30 | {:total-jobs (fn [] (count @jobs)) 31 | }))) 32 | 33 | (def jmx-tube-bean 34 | (new-mbean 35 | (ref 36 | {:tubes (fn [] (into-string-array (map #(name (:name %)) (vals @tubes)))) 37 | }))) 38 | 39 | (def jmx-wal-bean 40 | (new-mbean 41 | (ref 42 | {:total-files #(count @log-files) 43 | :total-file-size (fn [] @log-total-size)}))) 44 | 45 | (defn start-jmx-server [] 46 | (jmx/register-mbean jmx-session-bean "clojalk.management:type=Sessions") 47 | (jmx/register-mbean jmx-job-bean "clojalk.management:type=Jobs") 48 | (jmx/register-mbean jmx-tube-bean "clojalk.management:type=Tubes") 49 | (jmx/register-mbean jmx-wal-bean "clojalk.management:type=Wal")) 50 | -------------------------------------------------------------------------------- /test/clojalk/test/wal.clj: -------------------------------------------------------------------------------- 1 | (ns clojalk.test.wal 2 | (:refer-clojure :exclude [use peek]) 3 | (:use [clojalk data wal utils]) 4 | (:use [clojure.test]) 5 | (:import [java.io ByteArrayInputStream])) 6 | 7 | (def job (struct Job 100 0 1000 1023 8 | 0 0 :ready 9 | :default "tomcat" nil 0 0 0 0 0)) 10 | 11 | (defn- getString [buf length] 12 | (let [bytes (byte-array length)] 13 | (.get buf bytes) 14 | (String. bytes "UTF8"))) 15 | 16 | (deftest test-job-to-bin 17 | (let [buffer (job-to-bin job true)] 18 | (.rewind buffer) 19 | (are [x y] (= x y) 20 | 100 (.getLong buffer) 21 | 0 (.getInt buffer) 22 | 1000 (.getInt buffer) 23 | 1023 (.getInt buffer) 24 | 0 (.getLong buffer) 25 | 0 (.getLong buffer) 26 | :ready (enum-state (.getShort buffer)) 27 | 0 (.getInt buffer) 28 | 0 (.getInt buffer) 29 | 0 (.getInt buffer) 30 | 0 (.getInt buffer) 31 | 0 (.getInt buffer) 32 | 7 (.getInt buffer) 33 | "default" (getString buffer 7) 34 | 6 (.getInt buffer) 35 | "tomcat" (getString buffer 6))) 36 | 37 | (let [buffer (job-to-bin job false)] 38 | (.rewind buffer) 39 | (are [x y] (= x y) 40 | 100 (.getLong buffer) 41 | 0 (.getInt buffer) 42 | 1000 (.getInt buffer) 43 | 1023 (.getInt buffer) 44 | 0 (.getLong buffer) 45 | 0 (.getLong buffer) 46 | :ready (enum-state (.getShort buffer)) 47 | 0 (.getInt buffer) 48 | 0 (.getInt buffer) 49 | 0 (.getInt buffer) 50 | 0 (.getInt buffer) 51 | 0 (.getInt buffer) 52 | 0 (.getInt buffer) 53 | 0 (.getInt buffer)))) 54 | 55 | 56 | (deftest test-read-job 57 | (let [bytes (.array (job-to-bin job true)) 58 | stream (ByteArrayInputStream. bytes) 59 | rjob (read-job stream)] 60 | (doseq [k (keys job)] 61 | (is (= (job k) (rjob k)))))) 62 | -------------------------------------------------------------------------------- /scripts/bench.clj: -------------------------------------------------------------------------------- 1 | (ns bench 2 | (:refer-clojure :exclude [use peek read]) 3 | (:use [beanstalk.core])) 4 | 5 | (defn sleep [timemillis] 6 | (Thread/sleep timemillis)) 7 | 8 | (defn byte-length [s] 9 | (alength (.getBytes s "utf8"))) 10 | 11 | (defn make-conn [] 12 | (new-beanstalk 12026)) 13 | 14 | (def task-body 15 | "Activationsunng@sunng.info") 16 | 17 | (defn do-put [conn] 18 | (put conn 19 | (rand-int 5000) ; priority 20 | (rand-int 5) ; delay 21 | 1000 ; ttr 22 | (byte-length task-body) 23 | task-body)) 24 | 25 | (defn do-reserve [conn] 26 | (:id (reserve conn))) 27 | 28 | (defn do-delete [conn id] 29 | (delete conn id)) 30 | 31 | (def *tube-name* "bench-tube") 32 | (def *puts* (atom 0)) 33 | (def *reserves* (atom 0)) 34 | (def *deletes* (atom 0)) 35 | 36 | (defn producer [] 37 | (println "starting producer") 38 | (let [conn (make-conn)] 39 | (use conn *tube-name*) 40 | (loop [] 41 | (do-put conn) 42 | (swap! *puts* inc) 43 | (sleep (rand-int 30)) 44 | (recur)))) 45 | 46 | (defn worker [] 47 | (println "starting worker") 48 | (let [conn (make-conn)] 49 | (watch conn *tube-name*) 50 | (loop [] 51 | (let [id (do-reserve conn)] 52 | (swap! *reserves* inc) 53 | (sleep (rand-int 100)) 54 | (do-delete conn id) 55 | (swap! *deletes* inc) 56 | (recur))))) 57 | 58 | (defn monitor [] 59 | (println "starting monitor") 60 | (let [conn (make-conn)] 61 | (use conn *tube-name*) 62 | (loop [] 63 | (println (:stats (stats-tube conn *tube-name*))) 64 | (println (str "puts: " @*puts* " reserves: " @*reserves* " deletes: " @*deletes*)) 65 | (sleep 5000) 66 | (recur)))) 67 | 68 | (defn run-in-thread [runnable] 69 | (let [t (Thread. runnable)] 70 | (.setDaemon t false) 71 | (.start t))) 72 | 73 | (dorun (map run-in-thread (take 5 (repeat producer)))) 74 | (dorun (map run-in-thread (take 10 (repeat worker)))) 75 | (run-in-thread monitor) 76 | (println "benchmark started") 77 | 78 | -------------------------------------------------------------------------------- /src/clojalk/utils.clj: -------------------------------------------------------------------------------- 1 | (ns clojalk.utils 2 | (:require [clojure.contrib.logging :as logging]) 3 | (:require [clojure.contrib.string :as string]) 4 | (:import [java.util UUID]) 5 | (:import [java.util.concurrent Executors TimeUnit ExecutorService])) 6 | 7 | (defn current-time [] 8 | (System/currentTimeMillis)) 9 | 10 | (defmacro dbg [x] 11 | `(let [x# ~x] 12 | (println "dbg:" '~x "=" x#) 13 | x#)) 14 | 15 | ;;------ utility functions ------------ 16 | (defn not-nil [x] 17 | (not (nil? x))) 18 | 19 | (defn third [x] 20 | (nth x 2)) 21 | 22 | (defn uppercase [#^String s] (.toUpperCase s)) 23 | 24 | (defn assoc-all [x s] 25 | "assoc a sequence of k-v pairs into x" 26 | (if-not (empty? s) 27 | (apply assoc x s) 28 | x)) 29 | 30 | (defn conj-all [x s] 31 | "conject a sequence s into x" 32 | (if-not (empty? s) 33 | (apply conj x s) 34 | x)) 35 | 36 | (defn disj-all [x s] 37 | "disjoin a sequence from x" 38 | (if-not (empty? s) 39 | (apply disj x s) 40 | x)) 41 | 42 | (defn as-int [s] 43 | (Integer/valueOf s)) 44 | 45 | (defn as-long [s] 46 | (Long/valueOf s)) 47 | 48 | (defn remove-item [s i] 49 | (remove (fn [x] (= x i)) s)) 50 | 51 | (defn uuid [] 52 | (.toString (UUID/randomUUID))) 53 | 54 | (defn line-based-string [x] 55 | (str "- " (string/as-str x) "\n")) 56 | 57 | (defn format-coll [x] 58 | (let [sorted-coll (sort x)] 59 | (str "---\n" 60 | (string/join "" 61 | (map line-based-string x))))) 62 | 63 | (defn format-stats [x] 64 | (let [stats-keys (sort (keys x))] 65 | (str "---\n" 66 | (string/join "" 67 | (map #(str (string/as-str %) ": " (string/as-str (x %)) "\n") stats-keys))))) 68 | 69 | (def into-string-array (partial into-array String)) 70 | 71 | ;;------- scheduler ------------------ 72 | 73 | (defn- wrap-task [task] 74 | (try task (catch Exception e (logging/warn "Exception caught on scheduled task" e)))) 75 | 76 | ;; define scheduler as an agent so we can use it within an stm 77 | (defonce compute-intensive-scheduler 78 | (agent (Executors/newScheduledThreadPool (* 2 (.availableProcessors (Runtime/getRuntime)))))) 79 | 80 | ;; schedule a delayed task to thread pool and return thread pool itself 81 | (defn- do-schedule [threads task delay] 82 | (.schedule ^ExecutorService threads ^Runnable task ^long (long delay) ^TimeUnit TimeUnit/SECONDS) 83 | threads) 84 | 85 | ;; schedule a delayed task, can be used within an stm 86 | (defn schedule [task delay] 87 | (send compute-intensive-scheduler do-schedule task delay)) 88 | 89 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # clojalk [![Build Status](https://secure.travis-ci.org/sunng87/clojalk.png)](http://travis-ci.org/) # 2 | 3 | A distributed task queue written pure in clojure. A Beanstalkd clone. 4 | 5 | ## Usage ## 6 | 7 | ### Installation ### 8 | 9 | Clojalk is still in development so we don't have a packaged release. 10 | To use clojalk, you should checkout the code base and build 11 | it by yourself. This is not difficult task but be sure you have 12 | leiningen installed. 13 | 14 | git clone git@github.com:sunng87/clojalk.git 15 | cd clojalk 16 | lein uberjar clojalk.jar 17 | 18 | To start a clojalk server: 19 | 20 | java -jar clojalk.jar [clojalk.properties] 21 | 22 | Clojalk will load a property file "clojalk.properties" from current 23 | working directory if you don't specify a custom file path from command 24 | line. 25 | 26 | Also you can start clojalk from code base with lein. This is only for 27 | test purpose: 28 | 29 | lein run 30 | 31 | Try out your installation: 32 | 33 | telnet 127.0.0.1 12026 34 | 35 | You should be familiar with beanstalkd's memcached-styled protocol. 36 | 37 | ### Protocol ### 38 | 39 | Clojalk is almost fully compatible with Beanstalkd's protocol. So you 40 | can refer to the [protocol 41 | document](https://github.com/kr/beanstalkd/blob/master/doc/protocol.txt 42 | "Beanstalkd Protocol") of Beanstalkd which also works with clojalk. 43 | 44 | Commands supported by clojalk are listed here. 45 | 46 | Tube operations: 47 | 48 | * watch 49 | * use 50 | * ignore 51 | * pause-tube 52 | 53 | Job life-cycle operations: 54 | 55 | * put 56 | * reserve 57 | * reserve-with-timeout 58 | * delete 59 | * release 60 | * bury 61 | * kick 62 | * touch 63 | 64 | Monitoring commands: 65 | 66 | * stats 67 | * stats-job 68 | * stats-tube 69 | * list-tubes-watched 70 | * list-tube-used 71 | * list-tubes 72 | * peek 73 | * peek-ready 74 | * peek-delayed 75 | * peek-buried 76 | 77 | ### Clients ### 78 | 79 | The clojure client [beanstalk](https://github.com/sunng87/beanstalk 80 | "beanstalk") is forked and maintained by me, which works with clojalk 81 | and beanstalkd. 82 | 83 | More clients to be tested against clojalk. 84 | 85 | ## Thanks ## 86 | 87 | I should thanks [Keith Rarick](https://github.com/kr "Keith Rarick") 88 | who designed beanstalkd and its protocol. 89 | 90 | And also I received great help from [Zach 91 | Tellman](https://github.com/ztellman "Zach Tellman") on implementing 92 | the protocol with gloss. 93 | 94 | ### Contributors ### 95 | 96 | * [xiaonaitong](https://github.com/xiaonaitong "xiaonaitong") 97 | 98 | ## License ### 99 | 100 | Copyright (C) 2011 [Sun Ning](http://sunng.info/ "Sun Ning") 101 | 102 | Distributed under the Eclipse Public License, the same as Clojure uses. 103 | 104 | -------------------------------------------------------------------------------- /src/clojalk/net/protocol.clj: -------------------------------------------------------------------------------- 1 | (ns clojalk.net.protocol 2 | (:use [clojalk.utils]) 3 | (:use [gloss.core]) 4 | (:use [clojure.string :only [upper-case]])) 5 | 6 | ;; a wrapper for string-integer, copied from ztellman's aleph redis client 7 | ;; this codec adds an offset to string length, which is common seen in text 8 | ;; based protocol (message with \r\n as suffix) 9 | (defn string-length-and-offset [count-offset] 10 | (prefix 11 | (string-integer :ascii :delimiters ["\r\n"] :as-str true) 12 | #(if (neg? %) 0 (+ % count-offset)) 13 | #(if-not % -1 (- % count-offset)))) 14 | 15 | ;; --------- gloss codec definitions ----------- 16 | (defcodec token (string :ascii :delimiters [" " "\r\n" "\n" "\0"])) 17 | (defcodec token-space (string :ascii :delimiters [" "])) 18 | (defcodec token-newline (string :ascii :delimiters ["\r\n"])) 19 | (defcodec body 20 | (finite-frame 21 | (string-length-and-offset 2) 22 | (string :utf8 :suffix "\r\n"))) 23 | 24 | (def codec-map 25 | {;; request headers 26 | "QUIT" [] 27 | "LIST-TUBES" [] 28 | "LIST-TUBE-USED" [] 29 | "LIST-TUBES-WATCHED" [] 30 | "PEEK" [token] 31 | "PEEK-READY" [] 32 | "PEEK-BURIED" [] 33 | "PEEK-DELAYED" [] 34 | "WATCH" [token] 35 | "IGNORE" [token] 36 | "USE" [token] 37 | "PAUSE-TUBE" [token token] 38 | "RESERVE" [] 39 | "RESERVE-WITH-TIMEOUT" [token] 40 | "RELEASE" [token token token] 41 | "DELETE" [token] 42 | "TOUCH" [token] 43 | "BURY" [token token] 44 | "KICK" [token] 45 | "PUT" [token token token body] 46 | "STATS-JOB" [token] 47 | "STATS-TUBE" [token] 48 | "STATS" [] 49 | 50 | ;; response headers 51 | "INSERTED" [token-newline] 52 | "RESERVED" [token-space body] 53 | "USING" [token-newline] 54 | "WATCHING" [token-newline] 55 | "BAD_FORMAT" [token-newline] 56 | "NOT_IGNORED" [token-newline] 57 | "INTERNAL_ERROR" [token-newline] 58 | "UNKNOWN_COMMAND" [token-newline] 59 | "OK" [body] 60 | "RELEASED" [token-newline] 61 | "BURIED" [token-newline] 62 | "NOT_FOUND" [token-newline] 63 | "DELETED" [token-newline] 64 | "KICKED" [token-newline] 65 | "TOUCHED" [token-newline] 66 | "FOUND" [token-space body] 67 | "TIMED_OUT" [token-newline] 68 | "PAUSED" [token-newline] 69 | "DRAINING" [token-newline]}) 70 | 71 | (defn- commands-mapping [cmd] 72 | (let [normalized-cmd (upper-case cmd)] 73 | (if (contains? codec-map normalized-cmd) 74 | (compile-frame (codec-map normalized-cmd) 75 | #(if (empty? (rest %)) [""] (rest %)) 76 | #(cons normalized-cmd %)) 77 | (string :utf8 :delimiters ["\r\n"])))) 78 | 79 | (defn- empty-header [body] "") 80 | 81 | (defn- find-header [resp] 82 | (if (and (vector? resp) (> (count resp) 1)) (first resp))) 83 | 84 | (defcodec beanstalkd-codec 85 | (header token commands-mapping first)) 86 | -------------------------------------------------------------------------------- /src/clojalk/data.clj: -------------------------------------------------------------------------------- 1 | ;; ## Stateful containers hold data at runtime 2 | ;; 3 | (ns clojalk.data 4 | (:use [clojalk.utils])) 5 | 6 | ;; # Data Structures and constructors 7 | 8 | ;; Structure definition for ***Job*** 9 | ;; 10 | ;; **Job** is the basic task unit in clojalk. The fields are described below. 11 | ;; 12 | ;; * **id** a numerical unique id of this Job 13 | ;; * **delay** delayed time in seconds. 14 | ;; * **ttr** time-to-run in seconds. TTR is the max time that a worker could reserve this job. 15 | ;; The job will be released once it's timeout. 16 | ;; * **priority** describes the priority of jobs. The value should be in range of 0-65535. 17 | ;; Job with lower numerical value has higher priority. 18 | ;; * **created_at** is the timestamp when job was created, in milliseconds. 19 | ;; * **deadline_at** is to stored the deadline of a job, in milliseconds. The fields has 20 | ;; multiple meaning according to the *state*. In a word, it's the time that job should update 21 | ;; its state. 22 | ;; * **state** is a keyword enumeration. It's the most important field that describes 23 | ;; the life-cycle of a Job. 24 | ;; 1. **:ready** the job is ready for worker to consume. 25 | ;; 1. **:delayed** the job is not ready until the deadline hit. 26 | ;; 1. **:reserved** indicates the job is reserved by a worker at that time. 27 | ;; 1. **:buried** indicatets the job could not be reserved until someone ***kick***s it. 28 | ;; 1. **:invalid** means the job has been deleted. 29 | ;; * **tube** is the keyword tube name of this job 30 | ;; * **body** the body of this job 31 | ;; * **reserver** the session holds this job. nil if the job is not reserved. 32 | ;; * **reserves**, **timeouts**, **releases**, **buries** and **kicks** are statistical field 33 | ;; to indicate how many times the job reserved, timeout, released, buried and kicked. 34 | ;; 35 | (defstruct Job :id :delay :ttr :priority :created_at 36 | :deadline_at :state :tube :body :reserver 37 | :reserves :timeouts :releases :buries :kicks) 38 | 39 | ;; Structure definition for Tube 40 | ;; 41 | ;; Tube is a collection of jobs, similar to the database in RDBMS. 42 | ;; 43 | ;; * **name** the name of this tube, as keyword. 44 | ;; * **ready_set** is a sorted set of jobs in ready state. Jobs are sorted with their priority. 45 | ;; * **delay_set** is a sorted set of jobs in delayed state. Jobs are sorted with their deadline. 46 | ;; * **buried_list** is a vector of buried jobs. 47 | ;; * **waiting_list** is a vector of pending workers. 48 | ;; * **paused** indicates whether the tube has been paused or not. 49 | ;; * **pause_deadline** is the time to end the pause state. 50 | ;; * **pauses** is a statistical field of how many times the tube paused. 51 | ;; 52 | (defstruct Tube :name :ready_set :delay_set :buried_list 53 | :waiting_list :paused :pause_deadline :pauses) 54 | 55 | ;; Structure definition for Session (connection in beanstalkd) 56 | ;; 57 | ;; Session represents all clients connected to clojalk. 58 | ;; 59 | ;; * **id** the id of this session 60 | ;; * **type** is a keyword enumeration indicates the role of a session. (worker or producer) 61 | ;; * **use** the tube name that producer session is using 62 | ;; * **watch** a list of tube names that worker session is watching 63 | ;; * **deadline_at** is the timeout for reserve request of worker session 64 | ;; * **state** of a worker session: 65 | ;; 1. **:idle** the worker session is idle 66 | ;; 1. **:waiting** the worker session has sent reserve request, is now waiting for jobs 67 | ;; 1. **:working** the worker session has reserved a job 68 | ;; * **incoming_job** the job worker session just reserved 69 | ;; * **reserved_jobs** id of jobs the worker session reserved 70 | ;; 71 | (defstruct Session :id :type :use :watch :deadline_at :state 72 | :incoming_job :reserved_jobs) 73 | 74 | ;; A generic comparator for job: 75 | ;; Compare selected field or id if equal. 76 | (defn- job-comparator [field j1 j2] 77 | (cond 78 | (< (field j1) (field j2)) -1 79 | (> (field j1) (field j2)) 1 80 | :else (< (:id j1) (:id j2)))) 81 | 82 | ;; Curried job-comparator by *priority* 83 | (def priority-comparator 84 | (partial job-comparator :priority)) 85 | 86 | ;; Curried job-comparator by *delay* 87 | (def delay-comparator 88 | (partial job-comparator :delay)) 89 | 90 | ;; Function to create an empty tube. 91 | (defn make-tube [name] 92 | (struct Tube (keyword name) ; name 93 | (ref (sorted-set-by priority-comparator)) ; ready_set 94 | (ref (sorted-set-by delay-comparator)) ; delay_set 95 | (ref []) ; buried_list 96 | (ref []) ; waiting queue 97 | (ref false) ; paused state 98 | (ref -1) ; pause timeout 99 | (ref 0))) ; pause command counter 100 | 101 | ;; Default job id generator. We use an atomic integer to store id. 102 | (defonce id-counter (atom (long 0))) 103 | ;; Get next id by increase the id-counter 104 | (defn next-id [] 105 | (swap! id-counter inc)) 106 | 107 | ;; Function to create an empty job with given data. 108 | (defn make-job [priority delay ttr tube body] 109 | (let [id (next-id) 110 | now (current-time) 111 | created_at now 112 | deadline_at (+ now (* 1000 delay)) 113 | state (if (> delay 0) :delayed :ready)] 114 | (struct Job id delay ttr priority created_at 115 | deadline_at state tube body nil 116 | 0 0 0 0 0))) 117 | 118 | ;; 119 | ;; Field to indicate if the server is in a drain mode. 120 | ;; If the server is drained, it doesn't accept new job any more. 121 | (defonce drain (atom false)) 122 | 123 | ;; Function to toggle drain mode. 124 | (defn toggle-drain [] 125 | (swap! drain not)) 126 | 127 | ;; **jobs** is a referenced hash map holds all jobs with id as key. 128 | (defonce jobs (ref {})) 129 | ;; **tubes** is a referenced hash map for all tubes, with their name as key 130 | (defonce tubes (ref {:default (make-tube "default")})) 131 | ;; **commands** is for command stats. commands are assigned into this map when it's defined 132 | (defonce commands (ref {})) 133 | ;; start time 134 | (defonce start-at (current-time)) 135 | 136 | ;; All **sessions** are stored in this referenced map. id as key. 137 | (defonce sessions (ref {})) 138 | ;; A statistical field for job timeout count. 139 | ;; Note that we use a ref here because timeout check of jobs are inside a dosync block which 140 | ;; should be free of side-effort. If we use an atom here, it could be error in retry. 141 | (defonce job-timeouts (atom 0)) 142 | -------------------------------------------------------------------------------- /src/clojalk/wal.clj: -------------------------------------------------------------------------------- 1 | ;; # Clojalk WAL module 2 | ;; 3 | ;; WAL module provides persistent facility for clojalk. 4 | ;; Jobs are log into a sequenced binary file when updated. The file will be 5 | ;; replayed when clojalk restarting. 6 | ;; 7 | 8 | (ns clojalk.wal 9 | (:refer-clojure :exclude [use peek]) 10 | (:require clojalk.data) 11 | (:use [clojalk utils]) 12 | (:use clojure.java.io) 13 | (:import [java.nio ByteBuffer]) 14 | (:import [java.io FileOutputStream])) 15 | 16 | (set! *warn-on-reflection* false) 17 | 18 | (def job-base-size 58) 19 | 20 | (defn- as-bytes [^String s] 21 | (.getBytes s "UTF8")) 22 | 23 | (defn state-enum [state] 24 | (short (case state 25 | :ready 0 26 | :delayed 1 27 | :reserved 2 28 | :buried 3 29 | :invalid 4 30 | -1))) 31 | 32 | (defn enum-state [e] 33 | (nth [:ready :delayed :reserved :buried :invalid] e)) 34 | 35 | ;; 36 | ;; Write a job record into a ByteBuffer 37 | ;; The record contains: 38 | ;; 1. id - 8 bytes 39 | ;; 2. delay - 4 bytes 40 | ;; 3. ttr - 4 bytes 41 | ;; 4. priority - 4 bytes 42 | ;; 5. created_at - 8 bytes 43 | ;; 6. deadline_at - 8 bytes 44 | ;; 7. state - 2 bytes 45 | ;; 8. reserves - 4 bytes 46 | ;; 9. timeouts - 4 bytes 47 | ;; 10. releases - 4 bytes 48 | ;; 11. buries - 4 bytes 49 | ;; 12. kicks - 4 bytes 50 | ;; 13. tube-name-length - 4 bytes 51 | ;; 14. tube-name - tube-name-length bytes 52 | ;; 15. body-length - 4 bytes 53 | ;; 16. body - body-length bytes 54 | ;; 55 | ;; If not in full mode, tube-name and body will not be wrote into buffer. 56 | ;; 57 | (defn job-to-bin [job full] 58 | (if (nil? (:tube job)) (println job)) 59 | (let [tube-name-bytes (as-bytes (name (:tube job))) 60 | job-body-bytes (as-bytes (:body job)) 61 | byte-length (if full 62 | (+ job-base-size 63 | 4 (alength ^bytes tube-name-bytes) 64 | 4 (alength ^bytes job-body-bytes)) 65 | (+ job-base-size 4 4)) 66 | buffer (ByteBuffer/allocate byte-length)] 67 | (-> buffer 68 | (.putLong (long (:id job))) 69 | (.putInt (int (:delay job))) 70 | (.putInt (int (:ttr job))) 71 | (.putInt (int (:priority job))) 72 | (.putLong (long (:created_at job))) 73 | (.putLong (long (or (:deadline_at job) 0))) 74 | (.putShort (state-enum (:state job))) 75 | (.putInt (int (:reserves job))) 76 | (.putInt (int (:timeouts job))) 77 | (.putInt (int (:releases job))) 78 | (.putInt (int (:buries job))) 79 | (.putInt (int (:kicks job)))) 80 | (if full 81 | (do 82 | (.putInt buffer (alength ^bytes tube-name-bytes)) 83 | (.put buffer ^bytes tube-name-bytes) 84 | (.putInt buffer (alength ^bytes job-body-bytes)) 85 | (.put buffer ^bytes job-body-bytes)) 86 | (do 87 | (.putInt buffer 0) 88 | (.putInt buffer 0))) 89 | buffer)) 90 | 91 | ;; read a fixed size of bytes from stream 92 | (defn- read-bytes [^java.io.InputStream stream size] 93 | (let [bytes (byte-array size)] 94 | (do 95 | (.read stream ^bytes bytes) 96 | bytes))) 97 | 98 | ;; Read a job entry from stream 99 | ;; To test if a job entry is a full entry, test if its :tube is not nil 100 | ;; 101 | ;; I use a transient map here to simplify the code and improve performance 102 | (defn read-job [stream] 103 | (let [base-bytes (ByteBuffer/wrap (read-bytes stream job-base-size)) 104 | tube-name-length (.getInt (ByteBuffer/wrap (read-bytes stream 4))) 105 | tube-name (if-not (zero? tube-name-length) 106 | (keyword (String. ^bytes (read-bytes stream tube-name-length) "UTF8"))) 107 | job-body-length (.getInt (ByteBuffer/wrap (read-bytes stream 4))) 108 | job-body (if-not (zero? job-body-length) 109 | (String. ^bytes (read-bytes stream job-body-length) "UTF8"))] 110 | (assoc 111 | {} 112 | :id (.getLong base-bytes) 113 | :delay (.getInt base-bytes) 114 | :ttr (.getInt base-bytes) 115 | :priority (.getInt base-bytes) 116 | :created_at (.getLong base-bytes) 117 | :deadline_at (.getLong base-bytes) 118 | :state (enum-state (.getShort base-bytes)) 119 | :reserves (.getInt base-bytes) 120 | :timeouts (.getInt base-bytes) 121 | :releases (.getInt base-bytes) 122 | :buries (.getInt base-bytes) 123 | :kicks (.getInt base-bytes) 124 | :tube tube-name 125 | :body job-body))) 126 | 127 | ;; Read a bin file into a vector of job entries 128 | (defn read-file [bin-log-file handler] 129 | (with-open [stream (input-stream bin-log-file)] 130 | (loop [s stream] 131 | (if-not (zero? (.available s)) 132 | (do 133 | (if-let [job (read-job s)] 134 | (handler job)) 135 | (recur s)))))) 136 | 137 | ;; Scan directory to find files whose name ends with .bin 138 | (defn scan-dir [dir-path] 139 | (filter #(.endsWith ^String (.getName ^java.io.File %) ".bin") (.listFiles (file dir-path)))) 140 | 141 | ;; Delete logging files under the dir 142 | (defn empty-dir [dir-path] 143 | (doseq [f (scan-dir dir-path)] 144 | (delete-file f))) 145 | 146 | ;; default clojalk log directory, to be overwrite by configuration 147 | (def *clojalk-log-dir* "./binlogs/") 148 | 149 | ;; Test if a jobrec is a full record 150 | (defn is-full-record [j] 151 | (not-nil (:tube j))) 152 | 153 | ;; Load a job record into memory 154 | ;; 155 | ;; 1. Remove the job if we found a record state `:invalid` 156 | ;; 2. Add job into `jobs` if it's a full record 157 | ;; 3. Change the `:reserved` jobs to `:ready` and update non-nil 158 | ;;fields of the job 159 | ;; 160 | ;; 161 | ;; Merge Strategy: 162 | ;; 1. if the job record is `:reserved`, just reset it to `:ready` 163 | ;; 2. Merge all fields of the record except tube-name and job-body 164 | ;; (which are not stored in non-full record) 165 | ;; 166 | (defn- replay-handler [j] 167 | (if (= :invalid (:state j)) 168 | (alter clojalk.data/jobs dissoc (:id j)) 169 | (if (is-full-record j) 170 | (alter clojalk.data/jobs assoc (:id j) j) 171 | (let [id (:id j) 172 | jr (if (= :reserved (:state j)) (assoc j :state :ready) j)] 173 | (alter clojalk.data/jobs assoc id 174 | (merge-with #(if (nil? %2) %1 %2) (@clojalk.data/jobs id) jr)))))) 175 | 176 | ;; Construct tube data structures. Load job references into certain container of 177 | ;; tube. Create a new tube if not found. 178 | ;; 179 | (defn- replay-tubes [] 180 | (doseq [jr (vals @clojalk.data/jobs)] 181 | (let [tube (@clojalk.data/tubes (:tube jr))] 182 | (if (nil? tube) 183 | (alter clojalk.data/tubes assoc (:tube jr) (clojalk.data/make-tube (:tube jr))))) 184 | (let [tube (@clojalk.data/tubes (:tube jr))] 185 | (case (:state jr) 186 | :ready (alter (:ready_set tube) conj jr) 187 | :buried (alter (:buried_list tube) conj jr) 188 | :delayed (alter (:delay_set tube) conj jr))))) 189 | 190 | ;; Update id counter after all job records are loaded from logs 191 | ;; 192 | ;; IMPORTANT! Append a **0** into the job key collection to prevent 193 | ;; exception when there is no jobs 194 | (defn- update-id-counter [] 195 | (swap! clojalk.data/id-counter 196 | (constantly (long (apply max (conj (keys @clojalk.data/jobs) 0)))))) 197 | 198 | ;; ## Replay logs and load jobs 199 | ;; 200 | ;; Read logs files from configured directory, load job records from them. 201 | ;; Jobs will be reloaded into memory. Job body and tube name won't be overwrite when records 202 | ;; with same id are found because there will be only one full record for each job, which is 203 | ;; also the first record for it. 204 | ;; After all jobs are loaded into `clojalk.data/jobs`, we will update their references in 205 | ;; each tube (ready_set, delay_set and bury_list). (Tubes are created if not found.) 206 | ;; 207 | ;; After all done, remove the log files. 208 | ;; 209 | ;; All the statistical information about commands invocation are lost when 210 | ;; server restarted. 211 | ;; 212 | (defn replay-logs [] 213 | (if-let [bin-log-files (scan-dir *clojalk-log-dir*)] 214 | (do 215 | (dosync 216 | (dorun (map #(read-file % replay-handler) bin-log-files)) 217 | (replay-tubes)) 218 | (println (str (count @clojalk.data/jobs) " jobs loaded from write-ahead logs.")) 219 | (update-id-counter))) 220 | (empty-dir *clojalk-log-dir*)) 221 | 222 | ;; log files are split into several parts 223 | ;; this var is referenced only when initializing files 224 | (def *clojalk-log-count* 8) 225 | 226 | ;; log file streams 227 | (def log-files (ref [])) 228 | ;; A statistical field for total bytes written to file system 229 | (def log-total-size (atom (long 0))) 230 | 231 | ;; Create empty log files into `log-files`. This is invoked after legacy logs replayed. 232 | (defn init-log-files [] 233 | (let [dir (file *clojalk-log-dir*)] 234 | (if-not (.exists dir) (.mkdirs dir)) 235 | (if-not (.exists dir) 236 | (throw (IllegalStateException. 237 | (str "Failed to create WAL directory: " (.getAbsolutePath dir)))))) 238 | (dosync 239 | (loop [i 0] 240 | (if-not (= i *clojalk-log-count*) 241 | (do 242 | (alter log-files conj 243 | (agent (FileOutputStream. 244 | (file *clojalk-log-dir* (str "clojalk-" i ".bin")) true))) 245 | (recur (inc i))))))) 246 | 247 | ;; A flag for enable/disable WAL 248 | (def *clojalk-log-enabled* false) 249 | 250 | ;; A convenience function to write and flush stream 251 | (defn- stream-write [^java.io.OutputStream s data] 252 | (doto s 253 | (.write ^bytes data))) 254 | 255 | ;; Write the job record into certain log stream. 256 | ;; Here we use a `mod` function to hash job id into a log stream index. 257 | ;; 258 | ;; We should test if WAL is properly initialized before we actually write 259 | ;; logs. 260 | ;; 261 | (defn write-job [j full?] 262 | (if (not-empty @log-files) 263 | (let [id (:id j) 264 | log-files-count (count @log-files) 265 | log-file-index (mod id log-files-count) 266 | log-stream (nth @log-files log-file-index) 267 | job-bytes (.array ^java.nio.ByteBuffer (job-to-bin j full?))] 268 | (swap! log-total-size + (alength ^bytes job-bytes)) 269 | (send log-stream stream-write job-bytes)))) 270 | 271 | ;; Write all jobs into log streams as full record 272 | (defn dump-all-jobs [] 273 | (doseq [j (vals @clojalk.data/jobs)] 274 | (write-job j true))) 275 | 276 | ;; Start proceduce of WAL module invoked before server and task start 277 | (defn start-wal [] 278 | (if *clojalk-log-enabled* 279 | (do 280 | (replay-logs) 281 | (init-log-files) 282 | (dump-all-jobs)))) 283 | -------------------------------------------------------------------------------- /test/clojalk/test/core.clj: -------------------------------------------------------------------------------- 1 | (ns clojalk.test.core 2 | (:refer-clojure :exclude [use peek]) 3 | (:use [clojalk core utils data]) 4 | (:use [clojure.test])) 5 | 6 | 7 | (deftest test-put 8 | (let [session (use (open-session :producer) "test-put")] 9 | (put session 5 0 1000 "") 10 | (put session 3 0 1002 "") 11 | (put session 2 100 1000 "") 12 | (is (= 2 (count @(:ready_set (:test-put @tubes))))) 13 | (is (= 1 (count @(:delay_set (:test-put @tubes))))) 14 | (is (= 3 (-> @(:ready_set (:test-put @tubes)) 15 | first 16 | :priority))) 17 | (is (= :test-put (-> @(:ready_set (:test-put @tubes)) 18 | first 19 | :tube))))) 20 | 21 | (deftest test-reserve 22 | (let [session-p (use (open-session :producer) "test") 23 | session-t (watch (open-session :worker) "test") 24 | session-e (watch (open-session :worker) "empty")] 25 | ;; make some jobs in test tube 26 | (put session-p 3 0 1000 "") 27 | (put session-p 10 0 100 "") 28 | 29 | ;; reserve a job from test tube 30 | (let [job (reserve session-t)] 31 | (is (not (nil? job))) 32 | (is (= 3 (:priority job))) 33 | (is (= :reserved (:state job))) 34 | (is (= 1 (count @(:ready_set (:test @tubes))))) 35 | (is (contains? (:reserved_jobs @session-t) (:id job))) 36 | (is (empty? @(:waiting_list (:test @tubes))))) 37 | 38 | ;; reserve a job from empty tube 39 | (let [job (reserve session-e)] 40 | (is (nil? job)) 41 | (is (not-empty @(:waiting_list (:empty @tubes))))))) 42 | 43 | (deftest test-delete 44 | (let [session-p (use (open-session :producer) "delete-test") 45 | session-w (watch (open-session :worker) "delete-test") 46 | ;; make some jobs in the delete-test tube 47 | j1 (put session-p 3 0 1000 "neat") 48 | j2 (put session-p 10 0 1000 "nice") 49 | j3 (put session-p 4 0 1000 "cute") 50 | j4 (put session-p 100 100 1000 "geek")] 51 | 52 | ;; reserve and delete a job 53 | (let [job (reserve session-w) 54 | detached-job (delete session-w (:id job))] 55 | (is (= :invalid (:state detached-job))) 56 | (is (= 3 (:priority detached-job)))) 57 | 58 | ;; bury and delete a job 59 | (let [job (reserve session-w) 60 | job (bury session-w (:id job) 10) 61 | detached-job (delete session-w (:id job))] 62 | (is (empty? @(:buried_list (:delete-test @tubes)))) 63 | (is (nil? (@jobs (:id job))))) 64 | 65 | ;; delete a ready job with non-worker session 66 | (delete session-p (:id j2)) 67 | (is (empty? @(:ready_set (:delete-test @tubes)))) 68 | 69 | ;; delayed job could not be deleted 70 | (is (nil? (delete session-p (:id j4)))))) 71 | 72 | (deftest test-release 73 | (let [session-p (use (open-session :producer) "release-test") 74 | session-w (watch (open-session :worker) "release-test") 75 | ;; make some jobs in the release-test cube 76 | j1 (put session-p 3 0 1000 "neat") 77 | j2 (put session-p 4 0 1000 "nice")] 78 | 79 | ;; reserve a job then release it 80 | (let [job (reserve session-w)] 81 | (release session-w (:id job) 5 0) 82 | (is (= 2 (count @(:ready_set (:release-test @tubes)))))) 83 | 84 | (let [job (reserve session-w)] 85 | (release session-w (:id job) 10 100) 86 | (is (= 1 (count @(:ready_set (:release-test @tubes))))) 87 | (is (= 5 (-> @(:ready_set (:release-test @tubes)) first :priority)))))) 88 | 89 | (defn- sleep [seconds] 90 | (Thread/sleep (* 1000 seconds))) 91 | 92 | (deftest test-update-delay-task 93 | (let [session-p (use (open-session :producer) "delay-task-test")] 94 | ;; add some delayed job 95 | (put session-p 3 1 1000 "neat") 96 | (put session-p 4 2 1000 "nice") 97 | (put session-p 5 10 1000 "cute") 98 | (put session-p 8 0 1000 "") 99 | 100 | (is (= 3 (count @(:delay_set (:delay-task-test @tubes))))) 101 | (is (= 1 (count @(:ready_set (:delay-task-test @tubes))))) 102 | 103 | ;; sleep 104 | (sleep 3) 105 | 106 | (is (= 1 (count @(:delay_set (:delay-task-test @tubes))))) 107 | (is (= 3 (count @(:ready_set (:delay-task-test @tubes))))))) 108 | 109 | (deftest test-peek 110 | (let [session-p (use (open-session :producer) "peek-test") 111 | j1 (put session-p 9 0 100 "neat") 112 | j2 (put session-p 8 10 100 "nice")] 113 | (is (= "neat" (:body (peek session-p (:id j1))))) 114 | (is (peek session-p (:id j2))) ;;delayed job can also be found with peek 115 | (is (nil? (peek session-p 1001))))) 116 | 117 | (deftest test-peek-ready 118 | (let [session-p (use (open-session :producer) "peek-ready-test")] 119 | (put session-p 9 0 100 "neat") 120 | (put session-p 10 0 100 "cute") 121 | (put session-p 8 10 100 "nice") 122 | (is (= "neat" (:body (peek-ready session-p)))))) 123 | 124 | (deftest test-peek-delayed 125 | (let [session-p (use (open-session :producer) "peek-delayed-test")] 126 | (put session-p 9 0 100 "neat") 127 | (put session-p 8 10 100 "nice") 128 | (put session-p 8 20 100 "cute") 129 | (is (= "nice" (:body (peek-delayed session-p)))))) 130 | 131 | (deftest test-bury 132 | (let [session-p (use (open-session :producer) "bury-test") 133 | session-w (watch (open-session :worker) "bury-test") 134 | j0 (put session-p 5 0 100 "nice")] 135 | 136 | ;; bury j0 137 | (reserve session-w) 138 | (bury session-w (:id j0) 10) 139 | 140 | (is (= 1 (count @(:buried_list (:bury-test @tubes))))) 141 | (is (= 10 (:priority (first @(:buried_list (:bury-test @tubes)))))) 142 | (is (= :buried (:state (first @(:buried_list (:bury-test @tubes)))))))) 143 | 144 | (deftest test-kick 145 | (let [session-p (use (open-session :producer) "kick-test") 146 | session-w (watch (open-session :worker) "kick-test") 147 | j0 (put session-p 10 0 100 "neat") 148 | j1 (put session-p 10 0 100 "nice")] 149 | 150 | ;; kick empty 151 | (kick session-p 100) 152 | 153 | (is (= 0 (count @(:buried_list (:kick-test @tubes))))) 154 | (is (= 2 (count @(:ready_set (:kick-test @tubes))))) 155 | (is (= 0 (count @(:delay_set (:kick-test @tubes))))) 156 | 157 | ;; make some jobs, ready and delayed 158 | (put session-p 20 0 100 "cute") 159 | (put session-p 20 20 100 "peak") 160 | (put session-p 25 20 100 "geek") 161 | 162 | ;; bury some jobs 163 | (reserve session-w) 164 | (reserve session-w) 165 | 166 | (bury session-w (:id j0) 10) 167 | (bury session-w (:id j1) 10) 168 | 169 | (is (= 2 (count @(:buried_list (:kick-test @tubes))))) 170 | (is (= 1 (count @(:ready_set (:kick-test @tubes))))) 171 | (is (= 2 (count @(:delay_set (:kick-test @tubes))))) 172 | 173 | (kick session-p 100) 174 | 175 | (is (= 0 (count @(:buried_list (:kick-test @tubes))))) 176 | (is (= 3 (count @(:ready_set (:kick-test @tubes))))) 177 | (is (= 2 (count @(:delay_set (:kick-test @tubes))))) 178 | 179 | (kick session-p 1) 180 | 181 | (is (= 0 (count @(:buried_list (:kick-test @tubes))))) 182 | (is (= 4 (count @(:ready_set (:kick-test @tubes))))) 183 | (is (= 1 (count @(:delay_set (:kick-test @tubes))))) 184 | 185 | (is (every? #(= :ready (:state %)) @(:ready_set (:kick-test @tubes)))))) 186 | 187 | (deftest test-touch 188 | (let [session-p (use (open-session :producer) "touch-test") 189 | session-w (watch (open-session :worker) "touch-test") 190 | j0 (put session-p 5 0 100 "nice") 191 | j0_ (reserve session-w)] 192 | 193 | (sleep 0.3) 194 | (is (> (:deadline_at (touch session-w (:id j0_))) (:deadline_at j0_))))) 195 | 196 | (deftest test-update-expired-task 197 | (let [session-p (use (open-session :producer) "expire-task-test") 198 | session-w (watch (open-session :worker) "expire-task-test")] 199 | ;;make some jobs in the tube 200 | (put session-p 8 0 1 "nice") 201 | (put session-p 9 0 1 "neat") 202 | (put session-p 10 0 1 "cute") 203 | (put session-p 9 0 10 "geek") 204 | 205 | (is (= 4 (count @(:ready_set (:expire-task-test @tubes))))) 206 | 207 | ;;reserve some jobs from the tube 208 | (reserve session-w) 209 | (reserve session-w) 210 | (reserve session-w) 211 | 212 | (is (= 1 (count @(:ready_set (:expire-task-test @tubes))))) 213 | (sleep 1.1) 214 | (is (= 3 (count @(:ready_set (:expire-task-test @tubes))))) 215 | (is (= 1 (count (:reserved_jobs @session-w)))))) 216 | 217 | (deftest test-update-expired-tube 218 | (let [session-p (use (open-session :producer) "expire-tube-test") 219 | session-w (watch (open-session :worker) "expire-tube-test")] 220 | (put session-p 100 0 500 "nice") 221 | (pause-tube session-p "expire-tube-test" 1) 222 | (is (true? @(:paused (:expire-tube-test @tubes)))) 223 | 224 | ;; working should be waiting for tube to continue 225 | (reserve session-w) 226 | (is (= :waiting (:state @session-w))) 227 | 228 | (sleep 1.2) 229 | ;; job could be automatically assign to pending worker 230 | (is (= :working (:state @session-w))) 231 | (is (false? @(:paused (:expire-tube-test @tubes)))))) 232 | 233 | 234 | (deftest test-pending-reserved-session 235 | (let [session-p (use (open-session :producer) "pending-test") 236 | session-w (watch (open-session :worker) "pending-test") 237 | session-w2 (watch (open-session :worker) "pending-test")] 238 | ;; waiting for incoming job 239 | (reserve session-w) 240 | (is (= :waiting (:state @session-w))) 241 | (reserve session-w2) 242 | 243 | ;; put a job 244 | (put session-p 10 0 20 "nice") 245 | 246 | (is (= "nice" (:body (:incoming_job @session-w)))) 247 | (is (= :working (:state @session-w))) 248 | 249 | (let [the-job-id (:id (:incoming_job @session-w))] 250 | ;; release it 251 | (release session-w the-job-id 10 0) 252 | 253 | ;; it should be reserved by session-w2 immediately 254 | (is (= :working (:state @session-w2))) 255 | (is (= :reserved (:state (get @jobs the-job-id)))) 256 | (is (= session-w2 (:reserver (get @jobs the-job-id)))) 257 | (is (empty? @(:waiting_list (:pending-test @tubes))))) 258 | 259 | ;; reserve and acquire the job 260 | (reserve session-w) 261 | (put session-p 10 0 20 "neat") 262 | (is (= :working (:state @session-w))) 263 | 264 | ;; bury it 265 | (let [the-job-id (:id (:incoming_job @session-w))] 266 | (bury session-w the-job-id 10) 267 | (is (= :idle (:state @session-w))) 268 | (is (= 1 (count @(:buried_list (:pending-test @tubes))))) 269 | 270 | (reserve session-w) 271 | 272 | ;; kick it to ready 273 | (kick session-p 10) 274 | (is (= :reserved (:state (get @jobs the-job-id)))) 275 | (is (= :working (:state @session-w)))))) 276 | 277 | (deftest test-reserve-timeout 278 | (let [session-w (watch (open-session :worker) "test-reserve-timeout")] 279 | ;;reserve an empty tube with timeout 280 | (reserve-with-timeout session-w 1) 281 | (is (= 1 (count @(:waiting_list (:test-reserve-timeout @tubes))))) 282 | 283 | (sleep 1.2) 284 | (is (empty? @(:waiting_list (:test-reserve-timeout @tubes)))) 285 | (is (= :idle (:state @session-w))))) 286 | 287 | (deftest test-stats-tube 288 | (let [tube-name "test-stats-tube" 289 | session-p (use (open-session :producer) tube-name) 290 | session-w (watch (open-session :worker) tube-name)] 291 | ;; put some jobs 292 | (put session-p 2000 0 5000 "nice") 293 | (put session-p 2500 0 5000 "neat") 294 | (put session-p 2500 10 5000 "loop") 295 | (put session-p 1000 0 5000 "geek") 296 | (put session-p 999 0 400 "joke") 297 | 298 | (reserve session-w) 299 | (let [stats (stats-tube nil tube-name)] 300 | (is (= (name (:name stats)) tube-name)) 301 | (is (= (:current-jobs-urgent stats) 1)) 302 | (is (= (:current-jobs-delayed stats) 1)) 303 | (is (= (:current-jobs-reserved stats) 1)) 304 | (is (= (:total-jobs stats) 5)) 305 | (is (false? (:pause stats))) 306 | (is (zero? (:pause-time-left stats)))))) 307 | 308 | (deftest test-drain 309 | (toggle-drain) 310 | (let [session-p (use (open-session :producer) "test-drain")] 311 | (is (true? @drain)) 312 | (is (nil? (put session-p 5 0 100 "nice")))) 313 | (toggle-drain)) 314 | -------------------------------------------------------------------------------- /src/clojalk/net.clj: -------------------------------------------------------------------------------- 1 | ;; # Network interface for clojalk 2 | ;; 3 | ;; Clojalk uses **aleph** as TCP server which is based on Netty. 4 | ;; The text based protocol is almost compatible with Beanstalkd except 5 | ;; some response message with space ended, due to the limitation of 6 | ;; gloss protocol definition framework. (I will explain in the document.) 7 | ;; 8 | (ns clojalk.net 9 | (:refer-clojure :exclude [use peek]) 10 | (:require [clojure.contrib.logging :as logging]) 11 | (:require [clojure.contrib.string :as string]) 12 | (:use [clojalk data core utils]) 13 | (:use [clojalk.net.protocol]) 14 | (:use [aleph.tcp]) 15 | (:use [lamina.core]) 16 | (:use [gloss.core])) 17 | 18 | ;; this is an aleph handler for testing and debug only 19 | (defn echo-handler [ch client-info] 20 | (receive-all ch 21 | #(if-let [msg %] 22 | (do 23 | (println msg) 24 | (if (seq? msg) ;; known command will be transformed into a sequence by codec 25 | (case (first msg) 26 | "quit" (close ch) 27 | (enqueue ch ["INSERTED" "5"])) 28 | 29 | (enqueue ch ["UNKNOWN_COMMAND"])))))) 30 | 31 | ;; Create a new session on the channel. 32 | ;; 33 | ;; Not that `clojalk.data/Session` could accept additional field as 34 | ;; data storage. Here we attach the channel to it. 35 | ;; 36 | ;; Also we registered a `lamina` channel callback on the channel-close 37 | ;; event to cleanup data bound on the session. 38 | (defn- create-session [ch remote-addr type] 39 | (open-session remote-addr type :channel ch) 40 | ;; also register on-closed callback on channel 41 | (on-closed ch #(close-session remote-addr))) 42 | 43 | ;; Find a session from sessions. Create a new session with 44 | ;; `create-session` if not found. 45 | (defn get-or-create-session [ch remote-addr type] 46 | (if-not (contains? @sessions remote-addr) 47 | (create-session ch remote-addr type)) 48 | (@sessions remote-addr)) 49 | 50 | ;; Internally, the reserve operation in clojalk is non-blocking. It 51 | ;; will return `nil` if there is no job available for reservation. And 52 | ;; the job will be assigned to waiting session when it becomes 53 | ;; available. 54 | ;; 55 | ;; We use watch on the session ref to detect if there is a new job 56 | ;; assigned to the session and then to return the message to client. 57 | ;; 58 | ;; To find out the new job, just compare the `:incoming_job` field. 59 | ;; 60 | ;; Also, if state of the session is changed from `:waiting` to 61 | ;; `:idle`, it means the session has been expired. We will send a 62 | ;; `TIMEOUT` message to client. 63 | (defn reserve-watcher [key identity old-value new-value] 64 | (let [old-job (:incoming_job old-value) 65 | new-job (:incoming_job new-value)] 66 | (if (and new-job (not (= old-job new-job))) 67 | (let [ch (:channel new-value)] 68 | (enqueue ch ["RESERVED" (str (:id new-job)) (:body new-job)])))) 69 | (let [old-state (:state old-value) 70 | new-state (:state new-value)] 71 | (if (and (= :waiting old-state) (= :idle new-state)) 72 | (enqueue (:channel new-value) ["TIMED_OUT"])))) 73 | 74 | ;; ## Command handlers. 75 | ;; 76 | ;; All these command handlers simply follow the procedure: 77 | ;; 78 | ;; 1. Extract arguments from argument array 79 | ;; 2. Type conversion (from string to numbers) 80 | ;; 3. Run specific command with macro `exec-cmd` defined in 81 | ;;clojalk.core 82 | ;; 4. Return data or error message to client 83 | 84 | ;; Handles input like: 85 | ;; 86 | ;; put 87 | ;; 88 | ;; 89 | ;; Arguments are parsed into numbers. If there are invalid characters 90 | ;; in numeric fields, a `BAD_FORMAT` will be returned to client. 91 | ;; 92 | (defn on-put [ch session args] 93 | (try 94 | (let [priority (as-int (first args)) 95 | delay (as-int (second args)) 96 | ttr (as-int (third args)) 97 | body (last args) 98 | job (exec-cmd "put" session priority delay ttr body)] 99 | (if job 100 | (enqueue ch ["INSERTED" (str (:id job))]) 101 | (enqueue ch ["DRAINING"]))) 102 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 103 | 104 | ;; Handles input like: 105 | ;; 106 | ;; reserve 107 | ;; 108 | ;; Add a watch to the session. We use session id as watcher id so next 109 | ;; time when session receives reserve command, the watcher is 110 | ;; overwrote. 111 | ;; 112 | ;; the handler will return immediately whenever there is any job could 113 | ;; be reserved. 114 | ;; 115 | (defn on-reserve [ch session] 116 | (add-watch session (:id session) reserve-watcher) 117 | (exec-cmd "reserve" session)) 118 | 119 | ;; Handles input like: 120 | ;; 121 | ;; use 122 | ;; 123 | (defn on-use [ch session args] 124 | (let [tube-name (first args)] 125 | (exec-cmd "use" session tube-name) 126 | (enqueue ch ["USING" tube-name]))) 127 | 128 | ;; Handles input like: 129 | ;; 130 | ;; watch 131 | ;; 132 | (defn on-watch [ch session args] 133 | (let [tube-name (first args)] 134 | (exec-cmd "watch" session tube-name) 135 | (enqueue ch ["WATCHING" (str (count (:watch @session)))]))) 136 | 137 | ;; Handles input like: 138 | ;; 139 | ;; ignore 140 | ;; 141 | ;; It returns `NOT_IGNORED` if the session is ignoring 142 | ;; the only tube is watching. And this check is performed by this 143 | ;; handler instead of logic in `clojalk.core` 144 | ;; 145 | (defn on-ignore [ch session args] 146 | (if (> (count (:watch @session)) 1) 147 | (let [tube-name (first args)] 148 | (exec-cmd "ignore" session tube-name) 149 | (enqueue ch ["WATCHING" (str (count (:watch @session)))])) 150 | (enqueue ch ["NOT_IGNORED"]))) 151 | 152 | ;; Handles input like: 153 | ;; 154 | ;; quit 155 | ;; 156 | (defn on-quit [ch remote-addr] 157 | ; (close-session remote-addr) 158 | (close ch)) 159 | 160 | ;; Handles input like: 161 | ;; 162 | ;; list-tubes 163 | ;; 164 | (defn on-list-tubes [ch] 165 | (let [tubes (exec-cmd "list-tubes" nil)] 166 | (enqueue ch ["OK" (format-coll tubes)]))) 167 | 168 | ;; Handles input like: 169 | ;; 170 | ;; list-tube-used 171 | ;; 172 | (defn on-list-tube-used [ch session] 173 | (let [tube (exec-cmd "list-tube-used" session)] 174 | (enqueue ch ["USING" (string/as-str tube)]))) 175 | 176 | ;; Handles input like: 177 | ;; 178 | ;; list-tubes-watched 179 | ;; 180 | (defn on-list-tubes-watched [ch session] 181 | (let [tubes (exec-cmd "list-tubes-watched" session)] 182 | (enqueue ch ["OK" (format-coll tubes)]))) 183 | 184 | ;; Handles input like: 185 | ;; 186 | ;; release 187 | ;; 188 | (defn on-release [ch session args] 189 | (try 190 | (let [id (as-long (first args)) 191 | priority (as-int (second args)) 192 | delay (as-int (third args)) 193 | job (exec-cmd "release" session id priority delay)] 194 | (if (nil? job) 195 | (enqueue ch ["NOT_FOUND"]) 196 | (enqueue ch ["RELEASED"]))) 197 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 198 | 199 | ;; Handles input like: 200 | ;; 201 | ;; delete 202 | ;; 203 | (defn on-delete [ch session args] 204 | (try 205 | (let [id (as-long (first args)) 206 | job (exec-cmd "delete" session id)] 207 | (if (nil? job) 208 | (enqueue ch ["NOT_FOUND"]) 209 | (enqueue ch ["DELETED"]))) 210 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 211 | 212 | ;; Handles input like: 213 | ;; 214 | ;; bury 215 | ;; 216 | (defn on-bury [ch session args] 217 | (try 218 | (let [id (as-long (first args)) 219 | priority (as-int (second args)) 220 | job (exec-cmd "bury" session id priority)] 221 | (if (nil? job) 222 | (enqueue ch ["NOT_FOUND"]) 223 | (enqueue ch ["BURIED"]))) 224 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 225 | 226 | ;; Handles input like: 227 | ;; 228 | ;; kick 229 | ;; 230 | (defn on-kick [ch session args] 231 | (try 232 | (let [bound (as-int (first args)) 233 | jobs-kicked (exec-cmd "kick" session bound)] 234 | (enqueue ch ["KICKED" (str (count jobs-kicked))])) 235 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 236 | 237 | (defn on-touch [ch session args] 238 | (try 239 | (let [id (as-long (first args)) 240 | job (exec-cmd "touch" session id)] 241 | (if (nil? job) 242 | (enqueue ch ["NOT_FOUND"]) 243 | (enqueue ch ["TOUCHED"]))) 244 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 245 | 246 | (defn- peek-job [ch job] 247 | (if (nil? job) 248 | (enqueue ch ["NOT_FOUND"]) 249 | (enqueue ch ["FOUND" (str (:id job)) (:body job)]))) 250 | 251 | (defn on-peek [ch session args] 252 | (try 253 | (let [id (as-long (first args)) 254 | job (exec-cmd "peek" session id)] 255 | (peek-job ch job)) 256 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 257 | 258 | (defn on-peek-ready [ch session] 259 | (peek-job ch (exec-cmd "peek-ready" session))) 260 | 261 | (defn on-peek-delayed [ch session] 262 | (peek-job ch (exec-cmd "peek-delayed" session))) 263 | 264 | (defn on-peek-buried [ch session] 265 | (peek-job ch (exec-cmd "peek-buried" session))) 266 | 267 | (defn on-reserve-with-timeout [ch session args] 268 | (try 269 | (let [timeout (as-int (first args))] 270 | (add-watch session (:id session) reserve-watcher) 271 | (exec-cmd "reserve-with-timeout" session timeout)) 272 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 273 | 274 | (defn on-stats-job [ch args] 275 | (try 276 | (let [id (as-long (first args)) 277 | stats (exec-cmd "stats-job" nil id)] 278 | (if (nil? stats) 279 | (enqueue ch ["NOT_FOUND"]) 280 | (enqueue ch ["OK" (format-stats stats)]))) 281 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 282 | 283 | (defn on-stats-tube [ch args] 284 | (let [stats (exec-cmd "stats-tube" nil (first args))] 285 | (if (nil? stats) 286 | (enqueue ch ["NOT_FOUND"]) 287 | (enqueue ch ["OK" (format-stats stats)])))) 288 | 289 | (defn on-stats [ch] 290 | (let [stats- (exec-cmd "stats" nil)] 291 | (enqueue ch ["OK" (format-stats stats-)]))) 292 | 293 | (defn on-pause-tube [ch args] 294 | (try 295 | (let [tube-name (first args) 296 | timeout (as-int (second args)) 297 | tube (exec-cmd "pause-tube" nil tube-name timeout)] 298 | (if (nil? tube) 299 | (enqueue ch ["NOT_FOUND"]) 300 | (enqueue ch ["PAUSED"]))) 301 | (catch NumberFormatException e (enqueue ch ["BAD_FORMAT"])))) 302 | 303 | ;; Dispatching commands to centain handler. 304 | ;; 305 | (defn command-dispatcher [ch client-info msg] 306 | (let [remote-addr (.toString ^java.net.InetSocketAddress (:remote-addr client-info)) 307 | cmd (first msg) 308 | args (rest msg)] 309 | (case cmd 310 | "PUT" (on-put ch (get-or-create-session ch remote-addr :producer) args) 311 | "RESERVE" (on-reserve ch (get-or-create-session ch remote-addr :worker)) 312 | "USE" (on-use ch (get-or-create-session ch remote-addr :producer) args) 313 | "WATCH" (on-watch ch (get-or-create-session ch remote-addr :worker) args) 314 | "IGNORE" (on-ignore ch (get-or-create-session ch remote-addr :worker) args) 315 | "QUIT" (on-quit ch remote-addr) 316 | "LIST-TUBES" (on-list-tubes ch) 317 | "LIST-TUBE-USED" 318 | (on-list-tube-used ch (get-or-create-session ch remote-addr :producer)) 319 | "LIST-TUBES-WATCHED" 320 | (on-list-tubes-watched ch (get-or-create-session ch remote-addr :worker)) 321 | "RELEASE" (on-release ch (get-or-create-session ch remote-addr :worker) args) 322 | "DELETE" (on-delete ch (get-or-create-session ch remote-addr :worker) args) 323 | "BURY" (on-bury ch (get-or-create-session ch remote-addr :worker) args) 324 | "KICK" (on-kick ch (get-or-create-session ch remote-addr :producer) args) 325 | "TOUCH" (on-touch ch (get-or-create-session ch remote-addr :worker) args) 326 | "PEEK" (on-peek ch (get-or-create-session ch remote-addr :producer) args) 327 | "PEEK-READY" (on-peek-ready ch (get-or-create-session ch remote-addr :producer)) 328 | "PEEK-DELAYED" 329 | (on-peek-delayed ch (get-or-create-session ch remote-addr :producer)) 330 | "PEEK-BURIED" 331 | (on-peek-buried ch (get-or-create-session ch remote-addr :producer)) 332 | "RESERVE-WITH-TIMEOUT" 333 | (on-reserve-with-timeout ch (get-or-create-session ch remote-addr :worker) args) 334 | "STATS-JOB" (on-stats-job ch args) 335 | "STATS-TUBE" (on-stats-tube ch args) 336 | "STATS" (on-stats ch) 337 | "PAUSE-TUBE" (on-pause-tube ch args) 338 | (enqueue ch ["UNKNOWN_COMMAND"])))) 339 | 340 | ;; The default aleph handler. 341 | ;; Load data from channel, run command-dispatcher in a try-catch to 342 | ;; prevent server dump. 343 | ;; 344 | ;; 345 | (defn default-handler [ch client-info] 346 | (receive-all ch 347 | #(if-let [msg %] 348 | (if (seq? msg) 349 | (try 350 | (command-dispatcher ch client-info msg) 351 | (catch Exception e 352 | (do 353 | (logging/warn (str "error on processing " msg) e) 354 | (enqueue ch ["INTERNAL_ERROR"])))) 355 | (enqueue ch ["UNKNOWN_COMMAND"]))))) 356 | 357 | ;; Default port, to be override with user configuration 358 | (def *clojalk-port* 12026) 359 | 360 | ;; Start aleph TCP server. 361 | ;; 362 | ;; The codec is defined in `clojalk.net.protocol` 363 | (defn start-server [] 364 | (start-tcp-server default-handler {:port *clojalk-port*, :frame beanstalkd-codec})) 365 | 366 | 367 | -------------------------------------------------------------------------------- /src/clojalk/core.clj: -------------------------------------------------------------------------------- 1 | ;; # The core part of clojalk 2 | ;; 3 | ;; This is the core logic and components of clojalk. It is designed to be used 4 | ;; as a embed library or standalone server. So the APIs here are straight forward 5 | ;; enough as the server exposed. 6 | ;; 7 | ;; There are several models in clojalk. 8 | ;; 9 | ;; * **Session** represents a client (or client thread in embedded usage) that connected 10 | ;; to clojalk. Session could be either a ***worker*** or a ***producer***. A producer puts 11 | ;; jobs into clojalk. A worker consumes jobs and do predefined tasks describe by job body. 12 | ;; * **Tube** is an isolate collection of jobs. A producer session should select a tube to 13 | ;; ***use*** before it puts jobs into clojalk. And a worker session could ***watch*** several 14 | ;; tubes and consume jobs associated with them. By default, a new producer/worker is 15 | ;; using/watching the ***default*** tube. Tube could be created when you start to using and 16 | ;; watching it, so there is no such *create-tube* command. 17 | ;; * **Job** is the basic task unit in clojalk. A job contains some meta information and 18 | ;; a text body that you can put your task description in. I will explain fields of job later. 19 | ;; 20 | (ns clojalk.core 21 | (:refer-clojure :exclude [use peek]) 22 | (:use [clojalk data utils]) 23 | (:require [clojalk.wal]) 24 | (:import [java.util.concurrent Executors TimeUnit])) 25 | 26 | ;; predefine the task names 27 | (declare update-delayed-job) 28 | (declare update-paused-tube) 29 | (declare update-expired-job) 30 | (declare update-expired-waiting-session) 31 | 32 | 33 | ;; ## Functions to handle clojalk logic 34 | 35 | ;; Find top priority job from session's watch list. Steps: 36 | ;; 37 | ;; 1. Get watched tube name list 38 | ;; 1. Select tubes from @tubes 39 | ;; 1. Filter selected tubes to exclude paused tubes 40 | ;; 1. Find top priority job from each tube 41 | ;; 1. Find top priority job among jobs selected from last step 42 | ;; 43 | ;; (This function does not open transaction so it should run within a dosync block) 44 | (defn- top-ready-job [session] 45 | (let [watchlist (:watch @session) 46 | watch-tubes (filter not-nil (map #(get @tubes %) watchlist)) 47 | watch-tubes (filter #(false? @(:paused %)) watch-tubes) 48 | top-jobs (filter not-nil (map #(first @(:ready_set %)) watch-tubes))] 49 | (first (apply sorted-set-by (conj top-jobs priority-comparator))))) 50 | 51 | ;; Append a session into waiting_list of all tubes it watches. 52 | ;; Also update *state* and *deadline_at* of the session. 53 | ;; 54 | ;; (This function does not open transaction so it should run within a dosync block) 55 | (defn- enqueue-waiting-session [session timeout] 56 | (let [watch-tubes (filter #(contains? (:watch @session) (:name %)) (vals @tubes)) 57 | deadline_at (if (nil? timeout) nil (+ (current-time) (* timeout 1000)))] 58 | (if (not-nil timeout) 59 | (schedule #(update-expired-waiting-session session) timeout)) 60 | (doseq [tube watch-tubes] 61 | (alter (:waiting_list tube) conj session)) 62 | (alter session assoc 63 | :state :waiting 64 | :deadline_at deadline_at))) 65 | 66 | ;; Remove session from waiting_list of all tubes it watches. 67 | ;; This function is invoked when a session successfully reserved a job. 68 | ;; This also updates session *state* to `working` and leave *deadline_at* as it is. 69 | ;; 70 | ;; (This function does not open transaction so it should run within a dosync block) 71 | (defn- dequeue-waiting-session [session] 72 | (let [watch-tubes (filter #(contains? (:watch @session) (:name %)) (vals @tubes))] 73 | (doseq [tube watch-tubes] 74 | (alter (:waiting_list tube) #(into [] (remove-item % session)))) 75 | (alter session assoc :state :working))) 76 | 77 | ;; Reserve the job with the session. Steps: 78 | ;; 79 | ;; 1. Find tube of this job 80 | ;; 1. Compute deadline of this reservation 81 | ;; 1. Create an updated version of job 82 | ;; - set state to `reserved` 83 | ;; - set reserver to this session 84 | ;; - set deadline_at to deadline of last step 85 | ;; - increase reserve count 86 | ;; 1. Remove ths job from its tube's ready_set 87 | ;; 1. Update job in @jobs 88 | ;; 1. Run `dequeue-waiting-session` on this session 89 | ;; 1. Assign the job to `incoming_job` of the session 90 | ;; 1. Append the job id to `reserved_jobs` of the session 91 | ;; 92 | ;; Finally, this function returns the reserved job. 93 | ;; 94 | ;; (This function does not open transaction so it should run within a dosync block) 95 | (defn- reserve-job [session job] 96 | (let [tube ((:tube job) @tubes) 97 | deadline (+ (current-time) (* (:ttr job) 1000)) 98 | updated-top-job (assoc job 99 | :state :reserved 100 | :reserver session 101 | :deadline_at deadline 102 | :reserves (inc (:reserves job)))] 103 | (do 104 | (alter (:ready_set tube) disj job) 105 | (alter jobs assoc (:id job) updated-top-job) 106 | (dequeue-waiting-session session) 107 | (alter session assoc :incoming_job updated-top-job) 108 | (alter session update-in [:reserved_jobs] conj (:id updated-top-job)) 109 | (clojalk.wal/write-job updated-top-job false) 110 | (schedule #(update-expired-job (:id updated-top-job)) (:ttr job)) 111 | updated-top-job))) 112 | 113 | ;; Mark the job as ready. This is referenced when 114 | ;; 115 | ;; 1. reserved/delayed job expired 116 | ;; 1. reserved job released 117 | ;; 1. buried job kicked 118 | ;; 119 | ;; Steps: 120 | ;; 121 | ;; 1. Set job state to `ready` and update it in `jobs` 122 | ;; 1. Add this job to its tube's ready_set 123 | ;; 1. Check if there is any waiting session on that tube, assign the job to it if true 124 | ;; 125 | ;; (This function does not open transaction so it should run within a dosync block) 126 | (defn- set-job-as-ready [job] 127 | (let [tube ((:tube job) @tubes)] 128 | (do 129 | (alter jobs update-in [(:id job)] (fnil assoc job) :state :ready) 130 | (alter (:ready_set tube) conj job) 131 | (if-let [s (first @(:waiting_list tube))] 132 | (reserve-job s job))))) 133 | 134 | ;; Create a session and add it to the `sessions` 135 | ;; There are two signatures for this function. If you do not provide id, a uuid will be 136 | ;; generated as session id. 137 | ;; Additional key-value pair (session-data) could also be bound to session. 138 | ;; 139 | ;; By default, the session will use and watch `default` tube. 140 | ;; 141 | (defn open-session 142 | ([type] (open-session (uuid) type)) 143 | ([id type & sesssion-data] 144 | (let [session (ref (struct Session id type :default #{:default} nil :idle nil #{}))] 145 | (dosync 146 | (if (not-empty sesssion-data) 147 | (alter session assoc-all sesssion-data)) 148 | (alter sessions assoc id session)) 149 | session))) 150 | 151 | ;; Close a session with its id 152 | ;; 153 | ;; Note that we will release all reserved jobs before closing the session. 154 | ;; So there won't be any jobs reserved by a dead session. 155 | (defn close-session [id] 156 | (let [session (@sessions id)] 157 | (dosync 158 | (dequeue-waiting-session session) 159 | (dorun (map #(set-job-as-ready (@jobs %)) (:reserved_jobs @session))) 160 | (alter sessions dissoc id)))) 161 | 162 | ;; ## Macros for convenience of creating and executing commands 163 | 164 | ;; Define a clojalk command. Besides defining a normal clojure form, 165 | ;; this form also add a `cmd-name` entry to `commands` for statistic. 166 | ;; 167 | (defmacro defcommand [name args & body] 168 | (dosync (alter commands assoc (keyword (str "cmd-" name)) (atom 0))) 169 | `(defn ~(symbol name) ~args ~@body)) 170 | 171 | ;; Execute a command with name and arguments. 172 | ;; Also update statistical data. 173 | (defmacro exec-cmd [cmd & args] 174 | `(do 175 | (if-let [cnt# (get @commands (keyword (str "cmd-" ~cmd)))] 176 | (swap! cnt# inc)) 177 | (~(symbol cmd) ~@args))) 178 | 179 | ;; ## Commands Definitions 180 | 181 | ;; `put` is a producer task. It will create a new job according to information passed in. 182 | ;; When server is in drain mode, it does not store the job and return nil. 183 | ;; If delay is not zero, the job will be created as a delayed job. Delayed 184 | ;; job could not be reserved until it's timeout and ready. 185 | (defcommand "put" [session priority delay ttr body] 186 | (if-not @drain 187 | (let [tube ((:use @session) @tubes) 188 | job (make-job priority delay ttr (:name tube) body)] 189 | (do 190 | (clojalk.wal/write-job job true) 191 | (dosync 192 | (case (:state job) 193 | :delayed (do 194 | (alter (:delay_set tube) conj job) 195 | (alter jobs assoc (:id job) job) 196 | (schedule #(update-delayed-job (:id job)) (:delay job))) 197 | :ready (set-job-as-ready job))) 198 | job)))) 199 | 200 | ;; `peek` will try to find job with given id. Any session could use this 201 | ;; command. 202 | (defcommand "peek" [session id] 203 | (get @jobs id)) 204 | 205 | ;; `peek-ready` is a producer task. It will peek the most prioritized job from current 206 | ;; using tube. 207 | (defcommand "peek-ready" [session] 208 | (let [tube ((:use @session) @tubes)] 209 | (first @(:ready_set tube)))) 210 | 211 | ;; `peek-delayed` is also a producer task. The job which is nearest to deadline will 212 | ;; be peeked. 213 | (defcommand "peek-delayed" [session] 214 | (let [tube ((:use @session) @tubes)] 215 | (first @(:delay_set tube)))) 216 | 217 | ;; `peek-buried` is another producer task. It will peek the first item in the buried list. 218 | (defcommand "peek-buried" [session] 219 | (let [tube ((:use @session) @tubes)] 220 | (first @(:buried_list tube)))) 221 | 222 | ;; `reserve-with-timeout` is a worker task. It tries to reserve a job from its watching 223 | ;; tubes. If there is no job ready for reservation, it will wait at most `timeout` 224 | ;; seconds. 225 | ;; BE CAUTION: this is only for server mode. If you use clojalk as a embedded library, 226 | ;; `reserve-with-timeout` will return nil at once if there is no job ready. 227 | (defcommand "reserve-with-timeout" [session timeout] 228 | (dosync 229 | (enqueue-waiting-session session timeout) 230 | (if-let [top-job (top-ready-job session)] 231 | (reserve-job session top-job)))) 232 | 233 | ;; `reserve` is a worker task. It will wait for available jobs without timeout. 234 | ;; BE CAUTION: this is only for server mode. If you use clojalk as a embedded library, 235 | ;; `reserve` will return nil at once if there is no job ready. 236 | ;; 237 | (defcommand "reserve" [session] 238 | (reserve-with-timeout session nil)) 239 | 240 | ;; `use` is a producer task. It will create a tube if not exist. 241 | (defcommand "use" [session tube-name] 242 | (let [tube-name-kw (keyword tube-name)] 243 | (dosync 244 | (if-not (contains? @tubes tube-name-kw) 245 | (alter tubes assoc tube-name-kw (make-tube tube-name))) 246 | (alter session assoc :use tube-name-kw) 247 | session))) 248 | 249 | ;; `delete` could be used either with worker or producer. The rule is: 250 | ;; 251 | ;; 1. For reserved job, only reserved session could delete it 252 | ;; so we'd like to reject job that is reserved and its reserver 253 | ;; is not current session 254 | ;; 2. Delayed job could not be deleted until it's ready 255 | ;; 256 | ;; Steps to delete a job is a little bit complex: 257 | ;; 1. Test if job could satisfy rules described above. 258 | ;; 2. Remove job from *jobs* 259 | ;; 3. If the job is buried, update `buried_list` of its tube 260 | ;; 4. If the job is in ready_set, remove it from ready_set 261 | ;; 5. Empty the incoming_job field of session, remove the job from 262 | ;; its reserved_jobs list 263 | ;; 6. Set the session as idle if the no other jobs reserved by it 264 | ;; 7. Set the job as invalid and return 265 | ;; 266 | (defcommand "delete" [session id] 267 | (if-let [job (get @jobs id)] 268 | (if-not (or (= :delayed (:state job)) 269 | (and (= :reserved (:state job)) 270 | (not (= (:id @session) (:id @(:reserver job)))))) 271 | (let [tube ((:tube job) @tubes)] 272 | (do 273 | (dosync 274 | (alter jobs dissoc id) 275 | (if (= (:state job) :buried) 276 | (alter (:buried_list tube) 277 | #(into [] (remove-item % job)))) 278 | (if (= (:state job) :ready) 279 | (alter (:ready_set tube) disj job)) 280 | (alter session assoc :incoming_job nil) 281 | (alter session update-in [:reserved_jobs] disj (:id job)) 282 | (if (empty? (:reserved_jobs @session)) 283 | (alter session assoc :state :idle))) 284 | (clojalk.wal/write-job (assoc job :state :invalid) false) 285 | (assoc job :state :invalid)))))) 286 | 287 | ;; `release` is a worker command to free reserved job and changes its 288 | ;; priority and delay. `release` will also check the state and reserver of 289 | ;; given job because only reserved job could be released by its reserver. 290 | ;; 291 | ;; After job released (set-job-as-ready), it will also update session 292 | ;; like what we do in `delete`. 293 | (defcommand "release" [session id priority delay] 294 | (if-let [job (get @jobs id)] 295 | (if (and (= (:state job) :reserved) 296 | (= (:id @(:reserver job)) (:id @session))) 297 | (let [tube ((:tube job) @tubes) 298 | now (current-time) 299 | deadline (+ now (* 1000 delay)) 300 | updated-job (assoc job :priority priority 301 | :delay delay 302 | :deadline_at deadline 303 | :releases (inc (:releases job)))] 304 | (do 305 | (dosync 306 | (if (> delay 0) 307 | (do 308 | (alter (:delay_set tube) conj (assoc updated-job :state :delayed)) 309 | (schedule #(update-delayed-job (:id updated-job)) delay)) 310 | (set-job-as-ready (assoc updated-job :state :ready))) 311 | (alter session assoc :incoming_job nil) 312 | (alter session update-in [:reserved_jobs] disj (:id job)) 313 | (if (empty? (:reserved_jobs @session)) 314 | (alter session assoc :state :idle))) 315 | (clojalk.wal/write-job updated-job false) 316 | updated-job))))) 317 | 318 | ;; `bury` is a worker task. And only reserved job could be buried by 319 | ;; its reserver. 320 | ;; 321 | ;; buried job will be added into the buried_list of its tube. 322 | (defcommand "bury" [session id priority] 323 | (if-let [job (get @jobs id)] 324 | (if (and (= (:state job) :reserved) 325 | (= (:id @(:reserver job)) (:id @session))) 326 | (let [tube ((:tube job) @tubes) 327 | updated-job (assoc job :state :buried 328 | :priority priority 329 | :buries (inc (:buries job)))] 330 | (do 331 | (dosync 332 | (alter (:buried_list tube) conj updated-job) 333 | (alter jobs assoc (:id updated-job) updated-job) 334 | (alter session assoc :incoming_job nil) 335 | (alter session update-in [:reserved_jobs] disj (:id job)) 336 | (if (empty? (:reserved_jobs @session)) 337 | (alter session assoc :state :idle))) 338 | (clojalk.wal/write-job updated-job false) 339 | updated-job))))) 340 | 341 | ;; `kick` is a producer command. It will kick at most `bound` jobs from buried 342 | ;; or delayed to ready. Buried jobs will be kicked first, if there is no jobs 343 | ;; in buried_list, delayed jobs will be kicked. However, it won't kick both set 344 | ;; of jobs at a kick. That means, if you have buried jobs less that `bound`, only 345 | ;; the buried jobs could be kicked. Delayed ones could be kicked in next `kick`. 346 | (defcommand "kick" [session bound] 347 | (let [tube ((:use @session) @tubes)] 348 | (dosync 349 | (if (empty? @(:buried_list tube)) 350 | ;; no jobs buried, kick from delay set 351 | (let [kicked (take bound @(:delay_set tube)) 352 | updated-kicked (map #(assoc % :state :ready :kicks (inc (:kicks %))) kicked) 353 | remained (drop bound @(:delay_set tube)) 354 | remained-set (apply sorted-set-by delay-comparator remained)] 355 | 356 | (ref-set (:delay_set tube) remained-set) 357 | (doseq [job updated-kicked] 358 | (clojalk.wal/write-job job false) 359 | (set-job-as-ready job)) 360 | updated-kicked) 361 | 362 | ;; kick at most bound jobs from buried list 363 | (let [kicked (take bound @(:buried_list tube)) 364 | updated-kicked (map #(assoc % :state :ready :kicks (inc (:kicks %))) kicked) 365 | remained (vec (drop bound @(:buried_list tube)))] 366 | (ref-set (:buried_list tube) remained) 367 | (doseq [job updated-kicked] 368 | (clojalk.wal/write-job job false) 369 | (set-job-as-ready job)) 370 | updated-kicked))))) 371 | 372 | ;; `touch` is another worker command to renew the deadline. It will perform 373 | ;; the same check as `release` does. 374 | ;; 375 | (defcommand "touch" [session id] 376 | (if-let [job (get @jobs id)] 377 | (if (and (= (:state job) :reserved) 378 | (= (:id @(:reserver job)) (:id @session))) 379 | (let [deadline (+ (current-time) (* (:ttr job) 1000)) 380 | updated-job (assoc job :deadline_at deadline)] 381 | (schedule #(update-expired-job (:id job)) (:ttr job)) 382 | (dosync 383 | (when (= :reserved (:state updated-job)) ;; only reserved jobs could be touched 384 | (alter jobs assoc (:id updated-job) updated-job) 385 | updated-job)))))) 386 | 387 | ;; `watch` is a worker command to add tube into watching list. 388 | ;; Will create tube if it doesn't exist. 389 | (defcommand "watch" [session tube-name] 390 | (let [tube-name-kw (keyword tube-name)] 391 | (dosync 392 | (if-not (contains? @tubes tube-name-kw) 393 | (alter tubes assoc tube-name-kw (make-tube tube-name))) 394 | (alter session update-in [:watch] conj tube-name-kw) 395 | session))) 396 | 397 | ;; `ignore` is a worker command to remove tube from watching list. 398 | ;; Note that a worker could not remove the last tube it watches. 399 | (defcommand "ignore" [session tube-name] 400 | (let [tube-name-kw (keyword tube-name)] 401 | (dosync 402 | (if (> (count (:watch @session)) 1) 403 | (alter session update-in [:watch] disj tube-name-kw))) 404 | session)) 405 | 406 | ;; stats command. list tubes names. 407 | (defcommand "list-tubes" [session] 408 | (keys @tubes)) 409 | 410 | ;; stats command. display tube used by current session. 411 | (defcommand "list-tube-used" [session] 412 | (:use @session)) 413 | 414 | ;; stats command. list tubes watched by current session. 415 | (defcommand "list-tubes-watched" [session] 416 | (:watch @session)) 417 | 418 | ;; Pause select tube in next `timeout` seconds. Jobs in paused tubes could 419 | ;; not be reserved until pause timeout. 420 | ;; Also update a statistical field. 421 | (defcommand "pause-tube" [session id timeout] 422 | (if-let [tube (@tubes (keyword id))] 423 | (do 424 | (dosync 425 | (ref-set (:paused tube) true) 426 | (ref-set (:pause_deadline tube) (+ (* timeout 1000) (current-time))) 427 | (alter (:pauses tube) inc)) 428 | (schedule #(update-paused-tube (:name tube)) timeout)))) 429 | 430 | 431 | ;; stats command. Display some information of a job. 432 | (defcommand "stats-job" [session id] 433 | (if-let [job (get @jobs id)] 434 | (let [state (:state job) 435 | now (current-time) 436 | age (int (/ (- now (:created_at job)) 1000)) 437 | time-left (if (contains? #{:delayed :reserved} state) 438 | (int (/ (- (:deadline_at job) now) 1000)) 0)] 439 | {:id (:id job) 440 | :tube (:tube job) 441 | :state state 442 | :pri (:priority job) 443 | :age age 444 | :delay (:delay job) 445 | :ttr (:ttr job) 446 | :reserves (:reserves job) 447 | :timeouts (:timeouts job) 448 | :releases (:releases job) 449 | :buries (:buries job) 450 | :kicks (:kicks job) 451 | :time-left time-left}))) 452 | 453 | ;; stats command. Display some information of a tube. 454 | (defcommand "stats-tube" [session name] 455 | (if-let [tube (get @tubes (keyword name))] 456 | (let [paused @(:paused tube) 457 | now (current-time) 458 | pause-time-left (int (/ (- @(:pause_deadline tube) now) 1000)) 459 | pause-time-left (if paused pause-time-left 0) 460 | jobs-func #(= (:tube %) (:name tube)) 461 | jobs-of-tube (filter jobs-func (vals @jobs)) 462 | jobs-reserved (filter #(= (:state %) :reserved) jobs-of-tube) 463 | jobs-urgent (filter #(< (:priority %) 1024) @(:ready_set tube))] 464 | {:name (:name tube) 465 | :current-jobs-urgent (count jobs-urgent) 466 | :current-jobs-ready (count @(:ready_set tube)) 467 | :current-jobs-delayed (count @(:delay_set tube)) 468 | :current-jobs-buried (count @(:buried_list tube)) 469 | :current-jobs-reserved (count jobs-reserved) 470 | :total-jobs (count jobs-of-tube) 471 | :current-waiting (count @(:waiting_list tube)) 472 | :current-using (count (filter #(= (keyword name) (:use @%)) (vals @sessions))) 473 | :pause paused 474 | :cmd-pause-tube @(:pauses tube) 475 | :pause-time-left pause-time-left}))) 476 | 477 | ;; stats command. Display server statistical data: 478 | ;; 479 | ;; * commands executions count 480 | ;; * jobs stats 481 | ;; * connections status, workers count, producer count. 482 | ;; * and more. 483 | (defcommand "stats" [session] 484 | (let [all-jobs (vals @jobs) 485 | reserved-jobs (filter #(= :reserved (:state %)) all-jobs) 486 | ready-jobs (filter #(= :ready (:state %)) all-jobs) 487 | urgent-jobs (filter #(< (:priority %) 1024) ready-jobs) 488 | delayed-jobs (filter #(= :delayed (:state %)) all-jobs) 489 | buried-jobs (filter #(= :buried (:state %)) all-jobs) 490 | all-sessions (vals @sessions) 491 | worker-sessions (filter #(= :worker (:type @%)) all-sessions) 492 | waiting-sessions (filter #(= :waiting (:state @%)) worker-sessions) 493 | producer-sessions (filter #(= :producer (:type @%)) all-sessions)] 494 | ; (dbg commands-stats) 495 | (merge (into {} (for [i @commands] [(key i) @(val i)])) 496 | {:job-timeouts @job-timeouts 497 | :current-tubes (count @tubes) 498 | :current-connections (count all-sessions) 499 | :current-producers (count producer-sessions) 500 | :current-workers (count worker-sessions) 501 | :current-waiting (count waiting-sessions) 502 | :uptime (int (/ (- (current-time) start-at) 1000)) 503 | :current-jobs-urgent (count urgent-jobs) 504 | :current-jobs-ready (count ready-jobs) 505 | :current-jobs-reserved (count reserved-jobs) 506 | :current-jobs-delayed (count delayed-jobs) 507 | :current-jobs-buried (count buried-jobs)}))) 508 | 509 | 510 | ;; ## Schedule tasks for time based task 511 | ;; 512 | 513 | ;; Update a delayed job and set it as ready. 514 | ;; 515 | (defn- update-delayed-job [job-id] 516 | (if-let [job (@jobs job-id)] 517 | (when (= :delayed (:state job)) 518 | (dosync 519 | (alter (:delay_set ((:tube job) @tubes)) disj job) 520 | (clojalk.wal/write-job job false) 521 | (set-job-as-ready job))))) 522 | 523 | ;; Release an expired job set it as ready 524 | ;; 525 | ;; Since we won't cancel the task so we should check if the 526 | ;; task is still valid before we actually run it. 527 | ;; 528 | ;; For this scenario, we should ensure: 529 | ;; 530 | ;; * the job has exceed its deadline. To prevent the deadline is 531 | ;;override by another operation. 532 | ;; * the state of job is still `:reserved` 533 | ;; 534 | (defn- update-expired-job [job-id] 535 | (if-let [job (@jobs job-id)] 536 | (when (and (>= (current-time) (:deadline_at job)) (= :reserved (:state job))) 537 | (let [session (:reserver job) 538 | updated-job (assoc job :state :ready 539 | :reserver nil 540 | :timeouts (inc (:timeouts job)))] 541 | (clojalk.wal/write-job updated-job false) 542 | (swap! job-timeouts inc) 543 | (dosync 544 | (alter session update-in [:reserved_jobs] disj (:id updated-job)) 545 | (set-job-as-ready updated-job)))))) 546 | 547 | ;; Enable a paused tube 548 | ;; 549 | (defn- update-paused-tube [tube-name] 550 | (if-let [tube (@tubes tube-name)] 551 | (do 552 | (dosync 553 | (ref-set (:paused tube) false)) 554 | (dosync 555 | ;; handle waiting session 556 | (let [pending-pairs (zipmap @(:waiting_list tube) @(:ready_set tube))] 557 | (doseq [s (keys pending-pairs)] 558 | (reserve-job s (pending-pairs s)))))))) 559 | 560 | ;; Reject a session that waiting for reservation 561 | ;; 562 | (defn- update-expired-waiting-session [session] 563 | (if (= :waiting (:state @session)) 564 | (dosync 565 | (dequeue-waiting-session session) 566 | (alter session assoc :state :idle)))) 567 | 568 | 569 | --------------------------------------------------------------------------------