diff of f391bda68eef35e8b79c60b0ff5280cb0395ea54
f391bda68eef35e8b79c60b0ff5280cb0395ea54
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 3510b20..475ca54 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -98,7 +98,8 @@
(:file "blog-main")
(:file "blog-post")
- (:file "blog-list-posts")))
+ (:file "blog-list-posts")
+ (:file "blog-post-editor")))
(:file "main"))))
:in-order-to ((test-op (test-op "aggressive-murja/tests"))))
diff --git a/src/models/tab.lisp b/src/models/tab.lisp
index 2d08f7c..b323cdc 100644
--- a/src/models/tab.lisp
+++ b/src/models/tab.lisp
@@ -11,3 +11,6 @@
(require-login :initarg :require-login :initform nil :accessor require-login)
(needed-abilities :initarg :abilities :initform nil :accessor abilities)
(subtab :initarg :subtab :initform nil :accessor subtab)))
+
+(defmethod print-object ((tabb tab) output)
+ (format output "#<TAB: ~a ~a>" (tab-route tabb) (title tabb)))
diff --git a/src/murja-newui/newui.lisp b/src/murja-newui/newui.lisp
index 724ad9f..1a7ff43 100644
--- a/src/murja-newui/newui.lisp
+++ b/src/murja-newui/newui.lisp
@@ -133,8 +133,6 @@
(renderation (render c))
(json (json:stringify (hash ("id" id)
("new-html" renderation)))))
- (format t "html: ~a~%" renderation)
- (format t "Rerendered and sending down the line: ~s~%" json)
(hunchensocket:send-text-message *current-ws* json))))
(defmethod render ((e event))
@@ -212,7 +210,8 @@
(with-slots (attrs) (root-component current-state)
(push root-component-id attrs)
(push :id attrs))
- (setf (root-component-generator current-state) (lambda ()
+ (setf (root-component-generator current-state) (lambda (&rest unused)
+ (declare (ignore unused))
(let ((comp ,@(rewrite body)))
(with-slots (attrs) comp
(push root-component-id attrs)
diff --git a/src/views/blog-main.lisp b/src/views/blog-main.lisp
index 9f19e2b..fa0f258 100644
--- a/src/views/blog-main.lisp
+++ b/src/views/blog-main.lisp
@@ -23,7 +23,9 @@
(c :div (:class "se-testi-div")
(c :div ()
(format nil "Näkyyköhän tää? ~d" a))
- (c :button (:onclick (e (lambda () (incf a))))
+ (c :button (:onclick (e (lambda (ee)
+ (declare (ignore ee))
+ (incf a))))
"Clickme"))))
(deftab / (:route "/blog/"
@@ -31,8 +33,8 @@
(let* ((settings (get-settings))
(page-size (gethash "recent-post-count" settings))
(page 1))
- (with-state (
- (page-posts (murja.models.post:get-page page page-size))) ()
+
+ (with-state ((page-posts (murja.models.post:get-page page page-size))) ()
(c :div ()
(murja.views.components.page:page page-posts)))))
diff --git a/src/views/blog-post-editor.lisp b/src/views/blog-post-editor.lisp
index 36319a0..21586c5 100644
--- a/src/views/blog-post-editor.lisp
+++ b/src/views/blog-post-editor.lisp
@@ -17,14 +17,19 @@
(c :textarea (:name "content"
:oninput (e (lambda (value) (format t "oninput called with text value ~s~%" value ))))
content)
- (c :button (:onclick (e (lambda () (format t "Toimiiko edes tää?~%")))) "Click me"))))
-
-
+ (c :button (:onclick (e (lambda (v)
+ (declare (ignore v))
+ (format t "Toimiiko edes tää?~%"))))
+ "Click me"))))
(deftab /blog/post/edit (:route "/blog/post/:id/edit"
:require-login t
:captured-route-params (id)
:needed-abilities (list "edit-post")
- :subtab t)
+ :subtab t
+ :inject-to-head ((c :script (:src "https://cdnjs.cloudflare.com/ajax/libs/ace/1.43.1/ace.min.js"
+ :integrity "sha512-4pjReWfvI2kek2LBL2nn0btGloS+00a3CvuBXdSOY0DjuMm3YJy8M5CKWKaXd4QJG5Fh4iKlLuboM1ru7FHT6Q=="
+ :crossorigin "anonymous"
+ :referrerpolicy "no-referrer") )))
(let ((post (modelpost:get-post id :allow-hidden? t)))
(editor post)))
diff --git a/src/views/components/root.lisp b/src/views/components/root.lisp
index 29dad7e..b122467 100644
--- a/src/views/components/root.lisp
+++ b/src/views/components/root.lisp
@@ -4,7 +4,7 @@
(:import-from :murja.posts.post-db :get-titles-by-year)
(:import-from :murja.middleware.db :*settings*)
(:import-from :murja.models.user :user-nickname)
- (:export :root-component))
+ (:export :*inject-to-head* :root-component))
(in-package :murja.views.components.root)
@@ -40,24 +40,26 @@
(c :input (:type :submit :value "Log in")))))
+(defvar *inject-to-head* nil)
(defun root-component (inner-component)
"Returns the root html element of murja with `inner-component` embedded inside it"
-
- (c :html ()
- (c :head ()
- (c :link (:href "/resources/murja.css" :rel "stylesheet" :type "text/css"))
- (c :script (:src "https://unpkg.com/ace-custom-element@latest/dist/index.min.js" :type "module"))
- (c :script (:src "/resources/newui.js"))
- (c :meta (:charset "UTF-8")))
- (c :body ()
- (c :header ()
- (c :a (:href "/") (gethash "blog-title" *settings* )))
-
- (c :div (:class "sidebar-flex")
- inner-component
- (c :div (:id "sidebar")
- (loginform/user-widget)
- (sidebar-tree))))))
+ (let ((head-element (list (c :link (:href "/resources/murja.css" :rel "stylesheet" :type "text/css"))
+ (c :script (:src "/resources/newui.js"))
+ (c :meta (:charset "UTF-8")))))
+ (dolist (to-head *inject-to-head*)
+ (push to-head head-element))
+ (c :html ()
+ (component
+ :head ()
+ head-element)
+ (c :body ()
+ (c :header ()
+ (c :a (:href "/") (gethash "blog-title" *settings* )))
+ (c :div (:class "sidebar-flex")
+ inner-component
+ (c :div (:id "sidebar")
+ (loginform/user-widget)
+ (sidebar-tree)))))))
diff --git a/src/views/components/tab.lisp b/src/views/components/tab.lisp
index 6a02d5e..0544067 100644
--- a/src/views/components/tab.lisp
+++ b/src/views/components/tab.lisp
@@ -6,7 +6,7 @@
(in-package :murja.views.components.tab)
-(defvar *selected-tab* nil)
+;; (defvar *selected-tab* nil)
(defun tabs (firstly-selected-title tablist tab-params ;; &key onleave ;; how did I plan to call js callbacks here again?
)
@@ -26,12 +26,15 @@
(c :li (:class (format nil "tab-header delinkify ~a" (when (string= (tabmodel:title tab) selected-title) "tab-selected"))
:data-href (tabmodel:tab-route tab))
(c :a (:href (tabmodel:tab-route tab)
- :onclick (e (lambda ()
+ :onclick (e (lambda (unused)
+ (declare (ignore unused))
(setf selected-title (tabmodel:title tab)))
:post-js (format nil "history.pushState({}, '', '~a')" (tabmodel:tab-route tab))))
(tabmodel:title tab))))
tablist))
(progn
- (format t "selected-tab: ~a~%" selected-tab)
- (setf *selected-tab* selected-tab)
+ ;; (format t "selected-tab: ~a~%" selected-tab)
+ ;; (format t "tab-params: ~a~%" tab-params)
+ ;; (setf *selected-tab* selected-tab)
+ ;; (format t "selected tabs component ~a~%" (tabmodel:tab-component selected-tab))
(apply (tabmodel:tab-component selected-tab) tab-params))))))
diff --git a/src/views/middleware/newui-dispatcher.lisp b/src/views/middleware/newui-dispatcher.lisp
index 03128bc..8067a59 100644
--- a/src/views/middleware/newui-dispatcher.lisp
+++ b/src/views/middleware/newui-dispatcher.lisp
@@ -19,7 +19,8 @@
subtab
require-login
needed-abilities
- captured-route-params)
+ captured-route-params
+ inject-to-head)
&body rst)
`(progn
(setf (gethash (quote ,sym) *tabs*)
@@ -28,39 +29,45 @@
:require-login ,require-login
:subtab ,subtab
:title ,title
- :component (lambda ,captured-route-params
- (murja.middleware.db:with-db
- (let ((murja.middleware.db:*settings* (murja.settings:get-settings)))
- (c :div ()
- ,@rst))))))
+ :component (lambda (&rest all)
+ (destructuring-bind ,captured-route-params all
+ (murja.middleware.db:with-db
+ (let ((murja.middleware.db:*settings* (murja.settings:get-settings)))
+ (c :div ()
+ ,@rst)))))))
(defroute ,(intern (format nil "~a-sym" sym)) (,route
- :method :get
- :decorators (@transaction
- @newui
- (@ssr-authenticated :require-authentication ,require-login )
- @check-if-initial
- @dispatcher)) ()
+ :method :get
+ :decorators (@transaction
+ @newui
+ (@ssr-authenticated :require-authentication ,require-login )
+ @check-if-initial
+ (@dispatcher ,inject-to-head))) ()
(values (quote ,sym) (list ,@captured-route-params)))))
-(defun @dispatcher (next)
+(defun @dispatcher (next inject-to-head)
(multiple-value-bind (sym route-params) (funcall next)
(let* ((tab (gethash sym *tabs*))
+ ;; inject-to-head gets passed through to macros here as an unevaluated list
+ ;; and I don't understand why that happens, but this fixes the symptom and
+ ;; shouldn't expose too much vulnerabilities as :inject-to-head is trusted data
+ (inject-to-head (map 'list
+ #'eval
+ inject-to-head))
(usr-abilities (when *user*
(coerce (murja.models.user:abilities *user*) 'list))))
(assert tab)
-
(when (or (not (abilities tab))
(intersection usr-abilities (abilities tab))
(or (not (require-login tab))
*user*))
-
- (root-component
- (tabs (title tab)
- (remove-if-not (lambda (tab)
- (or (not (require-login tab))
- (subtab tab)
- *user*))
- (alexandria:hash-table-values
- *tabs*))
- route-params))))))
+ (let ((*inject-to-head* inject-to-head))
+ (root-component
+ (tabs (title tab)
+ (remove-if-not (lambda (tab)
+ (or (not (require-login tab))
+ (subtab tab)
+ *user*))
+ (alexandria:hash-table-values
+ *tabs*))
+ route-params)))))))