aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/admin.cljs.hl52
-rw-r--r--src/app/api.clj5
-rw-r--r--src/app/rpc.cljs4
-rw-r--r--src/app/scoreboard.cljs64
-rw-r--r--src/index.cljs.hl62
5 files changed, 128 insertions, 59 deletions
diff --git a/src/admin.cljs.hl b/src/admin.cljs.hl
new file mode 100644
index 0000000..4083190
--- /dev/null
+++ b/src/admin.cljs.hl
@@ -0,0 +1,52 @@
+(page "admin.html"
+ (:require [app.rpc :as rpc]
+ [app.scoreboard :as s]
+ [cljs.pprint :refer [pprint]]))
+
+(defc token nil)
+(defc= logged-in? (not (nil? token)))
+(defc= error rpc/error)
+(defc= error-message (when error (.-message error)))
+
+(rpc/init)
+
+(html
+ (head
+ (link :rel "stylesheet" :type "text/css" :href "css/main.css")
+ (title "Potluck CTF Adminstration"))
+ (body
+ (h1 "Potluck CTF Administration")
+ (div
+ :id "error"
+ :click #(reset! rpc/error nil)
+ :toggle (cell= (not (nil? rpc/error)))
+ (text "Error: ~{error-message}"))
+ (let [token-input (input :name "token")]
+ (form
+ :toggle (cell= (not logged-in?))
+ :submit #(do (reset! token (.-value token-input))
+ (set! (.-value token-input) nil))
+ (text "Admin Token:")
+ token-input
+ (input :type "submit")))
+ (let [eval-input (input :name "eval" :size 100)
+ output (textarea
+ :value (cell= (with-out-str
+ (pprint rpc/eval-result))))]
+ (form
+ :toggle logged-in?
+ :submit #(rpc/admin-eval! @token (.-value eval-input))
+ (text "(eval ")
+ eval-input
+ (text ")")
+ (br)
+ output))
+ (form
+ :toggle logged-in?
+ :submit #(do (reset! token nil)
+ (reset! rpc/token-ok false))
+ (input :type "submit" :value "Logout"))
+ (h2 "Scoreboard")
+ (s/scoreboard :scoreboard rpc/scoreboard)))
+
+;; vim: set expandtab ts=2 sw=2 filetype=clojure :
diff --git a/src/app/api.clj b/src/app/api.clj
index 27ed9a4..432482c 100644
--- a/src/app/api.clj
+++ b/src/app/api.clj
@@ -24,3 +24,8 @@
assoc-in
[(first (.split token "-")) :scores problem]
:solved)))
+
+(defrpc admin-eval! [token expr]
+ {:rpc/pre (= token (db/get :admin))}
+ (binding [*ns* (find-ns 'simpledb.core)]
+ (eval (read-string expr))))
diff --git a/src/app/rpc.cljs b/src/app/rpc.cljs
index 3698ae2..dab3566 100644
--- a/src/app/rpc.cljs
+++ b/src/app/rpc.cljs
@@ -10,6 +10,7 @@
(defc error nil)
(defc loading [])
(defc token-ok false)
+(defc eval-result nil)
(def get-scoreboard
(mkremote 'app.api/get-scoreboard scoreboard scoreboard-error loading))
@@ -23,6 +24,9 @@
(def submit-flag!
(mkremote 'app.api/submit-flag! scoreboard error loading))
+(def admin-eval!
+ (mkremote 'app.api/admin-eval! eval-result error loading))
+
(defn init []
(get-scoreboard)
(js/setInterval get-scoreboard 1000))
diff --git a/src/app/scoreboard.cljs b/src/app/scoreboard.cljs
new file mode 100644
index 0000000..b58e49e
--- /dev/null
+++ b/src/app/scoreboard.cljs
@@ -0,0 +1,64 @@
+(ns app.scoreboard
+ (:require [hoplon.core :refer [table tbody td th thead tr]])
+ (:require-macros [hoplon.core :refer [defelem loop-tpl]]
+ [javelin.core :refer [cell=]]))
+
+(defelem scoreboard
+ [{:keys [scoreboard] :as attr} kids]
+ (let [scoreboard (cell= (merge (sorted-map) scoreboard))
+ problems (cell= (mapcat (fn [[id person]]
+ (map (partial vector id) (:problems person)))
+ scoreboard))
+ scores (cell= (reverse (sort
+ (map (fn [[id person]]
+ [(apply
+ +
+ (concat
+ (map (fn [[prob state]]
+ (if (and
+ (= :solved state)
+ (not (contains? (:problems person) prob)))
+ 1
+ 0))
+ (:scores person))
+ (map (fn [prob]
+ (if (some (fn [[id2 person2]]
+ (and
+ (= :solved
+ (get (:scores person) prob))
+ (= :solved
+ (get (:scores person2) prob))
+ (not= id id2)))
+ scoreboard)
+ 1
+ 0))
+ (:problems person))))
+ id])
+ scoreboard))))]
+ (table
+ (thead
+ (tr
+ (th :colspan 2
+ :style "border:none")
+ (loop-tpl :bindings [probs (cell= (partition-by first problems))]
+ (th :text (cell= (:name (get scoreboard
+ (first (first probs)))))
+ :colspan (cell= (count probs)))))
+ (tr
+ (th "Player")
+ (th "Score")
+ (loop-tpl :bindings [[owner name] problems]
+ (th :text name))))
+ (tbody
+ (loop-tpl :bindings [[score id] scores]
+ (let [player (cell= (get scoreboard id))]
+ (tr
+ (td :text (cell= (:name player)))
+ (td :text score)
+ (loop-tpl :bindings [[owner _name] problems]
+ (td :text (cell=
+ (name (get (:scores player)
+ _name
+ :unsolved))))))))))))
+
+;; vim: set expandtab ts=2 sw=2 filetype=clojure :
diff --git a/src/index.cljs.hl b/src/index.cljs.hl
index 82980cc..0e2d3d4 100644
--- a/src/index.cljs.hl
+++ b/src/index.cljs.hl
@@ -1,37 +1,6 @@
(page "index.html"
- (:require [app.rpc :as rpc]))
-
-(defc= scoreboard (merge (sorted-map) rpc/scoreboard))
-(defc= problems (mapcat (fn [[id person]]
- (map (partial vector id) (:problems person)))
- scoreboard))
-(defc= scores
- (reverse (sort
- (map (fn [[id person]]
- [(apply
- +
- (concat
- (map (fn [[prob state]]
- (if (and
- (= :solved state)
- (not (contains? (:problems person) prob)))
- 1
- 0))
- (:scores person))
- (map (fn [prob]
- (if (some (fn [[id2 person2]]
- (and
- (= :solved
- (get (:scores person) prob))
- (= :solved
- (get (:scores person2) prob))
- (not= id id2)))
- scoreboard)
- 1
- 0))
- (:problems person))))
- id])
- scoreboard))))
+ (:require [app.rpc :as rpc]
+ [app.scoreboard :as s]))
(defc token nil)
(defc= logged-in? rpc/token-ok)
@@ -82,31 +51,6 @@
(reset! rpc/token-ok false))
(input :type "submit" :value "Logout"))
(h2 "Scoreboard")
- (table
- (thead
- (tr
- (th :colspan 2
- :style "border:none")
- (loop-tpl :bindings [probs (cell= (partition-by first problems))]
- (th :text (cell= (:name (get scoreboard
- (first (first probs)))))
- :colspan (cell= (count probs)))))
- (tr
- (th "Player")
- (th "Score")
- (loop-tpl :bindings [[owner name] problems]
- (th :text name))))
- (tbody
- (loop-tpl :bindings [[score id] scores]
- (let [player (cell= (get scoreboard id))]
- (tr
- (td :text (cell= (:name player)))
- (td :text score)
- (loop-tpl :bindings [[owner _name] problems]
- (td :text (cell=
- (name (get (:scores player)
- _name
- :unsolved))))))))
- ))))
+ (s/scoreboard :scoreboard rpc/scoreboard)))
;; vim: set expandtab ts=2 sw=2 filetype=clojure :