Author: hhubner Date: Wed Jan 30 08:02:24 2008 New Revision: 2424

Modified: branches/trunk-reorg/bknr/datastore/src/data/blob.lisp branches/trunk-reorg/bknr/modules/bug/bug-handlers.lisp branches/trunk-reorg/bknr/modules/mail/mailinglist-handlers.lisp branches/trunk-reorg/bknr/modules/mail/register-handler.lisp branches/trunk-reorg/bknr/modules/tamagotchi/tamagotchi-handlers.lisp branches/trunk-reorg/bknr/modules/text/article-handlers.lisp branches/trunk-reorg/bknr/modules/text/billboard-handlers.lisp branches/trunk-reorg/bknr/modules/text/blog-handlers.lisp branches/trunk-reorg/bknr/modules/text/paste-handlers.lisp branches/trunk-reorg/bknr/modules/text/wiki-handlers.lisp branches/trunk-reorg/bknr/modules/url/edit-url-handlers.lisp branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp branches/trunk-reorg/bknr/web/src/images/import-images-handler.lisp branches/trunk-reorg/bknr/web/src/packages.lisp branches/trunk-reorg/bknr/web/src/web/authorizer.lisp branches/trunk-reorg/bknr/web/src/web/event-log.lisp branches/trunk-reorg/bknr/web/src/web/handlers.lisp branches/trunk-reorg/bknr/web/src/web/sessions.lisp branches/trunk-reorg/bknr/web/src/web/tags.lisp branches/trunk-reorg/bknr/web/src/web/user-handlers.lisp branches/trunk-reorg/projects/quickhoney/src/handlers.lisp branches/trunk-reorg/projects/quickhoney/src/init.lisp branches/trunk-reorg/projects/quickhoney/src/webserver.lisp Log: First session handling fixes.

Modified: branches/trunk-reorg/bknr/datastore/src/data/blob.lisp ============================================================================== --- branches/trunk-reorg/bknr/datastore/src/data/blob.lisp (original) +++ branches/trunk-reorg/bknr/datastore/src/data/blob.lisp Wed Jan 30 08:02:24 2008 @@ -168,7 +168,7 @@ (with-open-file (s nblobs-pathname :direction :output) (write (n-blobs-per-directory subsystem) :stream s))))

-(defun delete-orphaned-blob-files () +(defun delete-orphaned-blob-files (&optional (cold-run t)) (dolist (blob-pathname (directory (merge-pathnames (make-pathname :directory '(:relative :wild-inferiors)) (store-blob-root-pathname)))) (handler-case @@ -177,7 +177,9 @@ (object (find-store-object object-id))) (labels ((delete-orphan (pathname) (handler-case - (delete-file pathname) + (if cold-run + (format t "cold run, not deleting ~A~%" pathname) + (delete-file pathname)) (error (e) (warn "can't delete file ~A: ~A" pathname e))))) (cond

Modified: branches/trunk-reorg/bknr/modules/bug/bug-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/bug/bug-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/bug/bug-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -21,13 +21,13 @@

(defmethod handle-object-form ((handler bug-tracker-handler) action tracker) (with-bknr-page (:title #?"bug-tracker for $((mailinglist-name tracker))") - (when (admin-p (bknr-request-user)) + (when (admin-p (bknr-session-user)) (html ((:a :href (format nil "/edit-bug-tracker/~a" (store-object-id tracker))) "edit bug-tracker"))) (bug-tracker-page :bug-tracker-id (store-object-id tracker))))

(defmethod file-bug-report ((handler bug-tracker-handler) tracker) - (let ((user (bknr-request-user))) + (let ((user (bknr-session-user))) ;; XXX check user rights (with-query-params (name status priority description) (let ((bug-report (make-object 'bug-report @@ -58,9 +58,9 @@

(defmethod handle-object-form ((handler bug-report-handler) action report) (with-bknr-page (:title #?"bug-report") - (when (or (equal (bknr-request-user) + (when (or (equal (bknr-session-user) (bug-report-handler report)) - (admin-p (bknr-request-user))) + (admin-p (bknr-session-user))) (html ((:a :href (format nil "/edit-bug-report/~a" (store-object-id report))) "edit bug-report"))) (bug-page :bug-id (store-object-id report)))) @@ -68,7 +68,7 @@ (defmethod handle-object-form ((handler bug-report-handler) (action (eql :annotate)) report) (if report - (let ((user (bknr-request-user))) + (let ((user (bknr-session-user))) (with-query-params (title text) (let ((article (make-object 'article :author user @@ -114,7 +114,7 @@ (defmethod handle-object-form ((handler edit-bug-tracker-handler) (action (eql :save)) tracker) - (if (admin-p (bknr-request-user)) + (if (admin-p (bknr-session-user)) (with-query-params (name email description) (change-slot-values tracker 'name name 'email email 'description description) (call-next-method)) @@ -144,8 +144,8 @@ (defmethod handle-object-form ((handler edit-bug-report-handler) (action (eql :save)) report) - (if (or (admin-p (bknr-request-user)) - (equal (bknr-request-user) + (if (or (admin-p (bknr-session-user)) + (equal (bknr-session-user) (bug-report-handler report))) (with-query-params (name status priority description) (let ((status-kw (make-keyword-from-string status)) @@ -171,8 +171,8 @@ (defmethod handle-object-form ((handler edit-bug-report-handler) (action (eql :close)) report) - (if (or (admin-p (bknr-request-user)) - (equal (bknr-request-user) + (if (or (admin-p (bknr-session-user)) + (equal (bknr-session-user) (bug-report-handler report))) (progn (change-slot-values report 'closed (get-universal-time) @@ -187,8 +187,8 @@ (defmethod handle-object-form ((handler edit-bug-report-handler) (action (eql :reopen)) report) - (if (or (admin-p (bknr-request-user)) - (equal (bknr-request-user) + (if (or (admin-p (bknr-session-user)) + (equal (bknr-session-user) (bug-report-handler report))) (progn (change-slot-values report 'closed nil @@ -203,8 +203,8 @@ (defmethod handle-object-form ((handler edit-bug-report-handler) (action (eql :delete)) report) - (if (or (admin-p (bknr-request-user)) - (equal (bknr-request-user) + (if (or (admin-p (bknr-session-user)) + (equal (bknr-session-user) (bug-report-handler report))) (progn (let ((tracker (bug-report-tracker report))) @@ -220,9 +220,9 @@ (action (eql :handle)) report) (if (or (null (bug-report-handler report)) - (admin-p (bknr-request-user))) + (admin-p (bknr-session-user))) (progn - (change-slot-values report 'handler (bknr-request-user)) + (change-slot-values report 'handler (bknr-session-user)) (call-next-method)) (with-bknr-page (:title #?"Edit bug report") (:p "You can not become the handler of this bug report")

Modified: branches/trunk-reorg/bknr/modules/mail/mailinglist-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/mail/mailinglist-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/mail/mailinglist-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -106,7 +106,7 @@ (with-query-params (email) (let ((user (find-user email))) (if user - (if (admin-p (bknr-request-user)) + (if (admin-p (bknr-session-user)) (html-subscription-info user) (progn (html (:p "Sending unsubscribe information to " (:princ-safe (user-email user))))

Modified: branches/trunk-reorg/bknr/modules/mail/register-handler.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/mail/register-handler.lisp (original) +++ branches/trunk-reorg/bknr/modules/mail/register-handler.lisp Wed Jan 30 08:02:24 2008 @@ -109,7 +109,7 @@ :email email :subscribe-mailinglist mailinglist)) (website-url (and mailinglist (mailinglist-website-url mailinglist)))) - (if (admin-p (bknr-request-user)) + (if (admin-p (bknr-session-user)) (progn (confirm-registration registration) (html (:h2 "registration completed")

Modified: branches/trunk-reorg/bknr/modules/tamagotchi/tamagotchi-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/tamagotchi/tamagotchi-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/tamagotchi/tamagotchi-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -15,7 +15,7 @@ (let ((tamagotchi (object-handler-get-object handler))) (cond ((null tamagotchi) t) ((null (tamagotchi-owner tamagotchi)) t) - ((equal (bknr-request-user) (tamagotchi-owner tamagotchi)) t) + ((equal (bknr-session-user) (tamagotchi-owner tamagotchi)) t) (t nil)))))

(defmethod object-handler-get-object ((handler tamagotchi-handler))

Modified: branches/trunk-reorg/bknr/modules/text/article-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/text/article-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/text/article-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -41,7 +41,7 @@ (progn (change-slot-values article 'subject subject 'text text) (index-article article)) (setf article (make-object 'article - :author (bknr-request-user) + :author (bknr-session-user) :subject subject :text text))) (redirect (edit-object-url article)))) @@ -104,7 +104,7 @@ (let ((keywords (keywords-from-query-param-list (query-param-list "keyword"))) (expires (parse-date-field "expiration"))) (with-query-params (subject text layout) - (let ((snippet (make-object 'snippet :author (bknr-request-user) + (let ((snippet (make-object 'snippet :author (bknr-session-user) :subject (or subject "") :time (get-universal-time) :text text

Modified: branches/trunk-reorg/bknr/modules/text/billboard-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/text/billboard-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/text/billboard-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -19,7 +19,7 @@ ((:p :class "articleText") (:princ (article-html-text article)))))

(defun list-billboards-page () - (let ((may-edit (admin-p (bknr-request-user)))) + (let ((may-edit (admin-p (bknr-session-user)))) (with-bknr-page (:title "billboards") (html ((:form :method "post" :action (request-uri)) @@ -53,7 +53,7 @@ (defun billboard-page () (let ((billboard (parse-url))) (with-query-params (new show-all delete) - (let ((may-edit (admin-p (bknr-request-user)))) + (let ((may-edit (admin-p (bknr-session-user)))) (setf billboard (find-billboard (or billboard *default-billboard*))) (if delete (let ((article (store-object-with-id delete))) @@ -62,7 +62,7 @@ (html "the article has been deleted"))) (if (and new may-edit) (let ((article (make-object 'article - :author (bknr-request-user)))) + :author (bknr-session-user)))) (billboard-add-article billboard article) (redirect (format nil "/edit-article/~a" (store-object-id article)))) (with-bknr-page (:title #?"billboard: $((billboard-name billboard))") @@ -75,7 +75,7 @@ with shown for article in (billboard-articles billboard) do (when (or show-all - (not (article-read article (bknr-request-user)))) + (not (article-read article (bknr-session-user)))) (setf shown t) (html (:tr (:td "date") @@ -106,6 +106,6 @@ (unless (billboard-always-show-all billboard) (html ((:input :type "submit" :name "show-all" :value "show-all")))) - (when (admin-p (bknr-request-user)) + (when (admin-p (bknr-session-user)) (html ((:input :type "submit" :name "new" :value "new")))))))))))) \ No newline at end of file

Modified: branches/trunk-reorg/bknr/modules/text/blog-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/text/blog-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/text/blog-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -85,7 +85,7 @@ ())

(defmethod authorized-p ((handler edit-blog-handler)) - (let ((user (bknr-request-user)) + (let ((user (bknr-session-user)) (blog (object-handler-get-object handler))) (if blog (or (admin-p user) @@ -115,7 +115,7 @@ (index-article article))) (let ((article (make-object 'blog-article :time (get-universal-time) - :author (bknr-request-user) + :author (bknr-session-user) :subject subject :text text :keywords (list keyword))))

Modified: branches/trunk-reorg/bknr/modules/text/paste-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/text/paste-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/text/paste-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -42,7 +42,7 @@ (with-query-params (subject text lisp) (if (and subject text) (let ((paste (make-object 'paste - :author (bknr-request-user) + :author (bknr-session-user) :subject subject :time (get-universal-time) :text text @@ -59,7 +59,7 @@ (if paste (with-query-params (text lisp) (let ((annotation (make-object 'keywords-article - :author (bknr-request-user) + :author (bknr-session-user) :subject "" :time (get-universal-time) :text text

Modified: branches/trunk-reorg/bknr/modules/text/wiki-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/text/wiki-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/text/wiki-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -34,7 +34,7 @@ ())

(defmethod authorized-p ((handler edit-wiki-handler)) - (not (anonymous-p (bknr-request-user)))) + (not (anonymous-p (bknr-session-user))))

(defmethod handle-object-form ((handler edit-wiki-handler) action (article (eql nil))) @@ -53,7 +53,7 @@ (with-query-params (text comment) (let ((version (make-version (html-quote text) :comment (html-quote comment) - :author (bknr-request-user) + :author (bknr-session-user) :date (get-universal-time)))) (if article (article-add-version article version)

Modified: branches/trunk-reorg/bknr/modules/url/edit-url-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/url/edit-url-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/url/edit-url-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -9,7 +9,7 @@ ())

(defmethod authorized-p ((handler form-handler)) - (not (equal (bknr-request-user) (find-user "anonymous")))) + (not (equal (bknr-session-user) (find-user "anonymous"))))

#+(or) (defmethod handle-form ((handler submit-url-handler) action) @@ -35,12 +35,12 @@ (setf url (normalize-url url)) (ensure-form-field keywords) (if (and cache - (not (user-has-flag (bknr-request-user) :cache))) + (not (user-has-flag (bknr-session-user) :cache))) (error (make-condition 'form-not-authorized-condition :reason "You do not have the right to cache objects")))

(when cache - (make-cached-url-from-url url :user (bknr-request-user) :depth 1 + (make-cached-url-from-url url :user (bknr-session-user) :depth 1 :force nil))

(let ((url-obj (url-with-url url))) @@ -55,7 +55,7 @@ :description description :keywords keywords :date (get-universal-time) - :submitter (bknr-request-user)))) + :submitter (bknr-session-user)))) (declare (ignore submission)) (redirect (if redirect url "/url"))))) (form-field-missing-condition (e)

Modified: branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp (original) +++ branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -86,7 +86,7 @@ (error "no file uploaded")) (with-query-params (name keyword) (let* ((image (import-image file-pathname - :user (bknr-request-user) + :user (bknr-session-user) :keywords (list keyword) :keywords-from-dir nil)) (image-id (store-object-id image)))

Modified: branches/trunk-reorg/bknr/web/src/images/import-images-handler.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/images/import-images-handler.lisp (original) +++ branches/trunk-reorg/bknr/web/src/images/import-images-handler.lisp Wed Jan 30 08:02:24 2008 @@ -35,7 +35,7 @@ (class-name (apply #'find-symbol (reverse (split "::?" (query-param "class-name")))))) (import-directory spool-dir :class-name class-name - :user (bknr-request-user) + :user (bknr-session-user) :keywords keywords :spool (import-handler-spool-dir handler) :keywords-from-dir (query-param "keyfromdir"))))

Modified: branches/trunk-reorg/bknr/web/src/packages.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/packages.lisp (original) +++ branches/trunk-reorg/bknr/web/src/packages.lisp Wed Jan 30 08:02:24 2008 @@ -378,9 +378,7 @@ #:bknr-session-host

#:host-name - #:bknr-request-user - #:bknr-request - #:bknr-request-session + #:bknr-session #:*session* #:anonymous-session

Modified: branches/trunk-reorg/bknr/web/src/web/authorizer.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/authorizer.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/authorizer.lisp Wed Jan 30 08:02:24 2008 @@ -19,7 +19,6 @@

(defun session-from-request () "check whether the request has a valid session id in either the bknr-sessionid cookie or query parameter" - (start-session) (session-value 'bknr-session))

(defmethod find-user-from-request-parameters ((authorizer bknr-authorizer)) @@ -34,7 +33,6 @@

(defmethod authorize ((authorizer bknr-authorizer)) ;; Catch any errors that occur during request body processing - (start-session) (handler-case (when (session-value 'bknr-session) (return-from authorize t))

Modified: branches/trunk-reorg/bknr/web/src/web/event-log.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/event-log.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/event-log.lisp Wed Jan 30 08:02:24 2008 @@ -62,7 +62,7 @@ print-hours ;; number of hours to search print-count) ;; maximum number of events to print (when (and message (not (equal "" message))) - (make-event 'message-event :from (bknr-request-user) :text message)) + (make-event 'message-event :from (bknr-session-user) :text message)) ;; Parameter parsing, will move to with-query-params soon (if (and last-printed (not (equal "" last-printed))) (setf last-printed (parse-integer last-printed)) @@ -78,10 +78,10 @@ (let ((selected-classes (or (and show-only-class (list (find-class (find-symbol show-only-class (find-package "bknr"))))) (selected-classes (request-query)) - (mapcar #'find-class (get-user-preferences (bknr-request-user) :event-log-classes)) + (mapcar #'find-class (get-user-preferences (bknr-session-user) :event-log-classes)) (default-selected-classes)))) (unless show-only-class - (set-user-preferences (bknr-request-user) :event-log-classes (mapcar #'class-name selected-classes))) + (set-user-preferences (bknr-session-user) :event-log-classes (mapcar #'class-name selected-classes))) ;; selected-classes contains the list of event classes to print. (html ((:form :action "/event-log" :method "post")

Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/handlers.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/handlers.lisp Wed Jan 30 08:02:24 2008 @@ -155,8 +155,8 @@ (defmethod website-session-info ((website website)) (html ((:div :id "session-info") "local time is " (:princ-safe (format-date-time)) - (if (bknr-request-user) - (html ", logged in as " (html-link (bknr-request-user))) + (if (bknr-session-user) + (html ", logged in as " (html-link (bknr-session-user))) (html ", not logged in")))))

(defclass page-handler () @@ -216,14 +216,16 @@ (with-slots (require-user-flag) page-handler (if (and require-user-flag (not (find require-user-flag - (user-flags (bknr-request-user))))) + (user-flags (bknr-session-user))))) nil t)))

(defmethod invoke-handler ((handler page-handler)) + (start-session) + (unless (session-value 'bknr-session) + (setf (session-value 'bknr-session) + (make-instance 'bknr-session :user (find-user "anonymous")))) (let* ((*website* (page-handler-site handler)) - (*session* (bknr-request-session)) - (*user* (bknr-request-user)) (*req-var-hash* (or *req-var-hash* (make-hash-table)))) (do-log-request) @@ -411,7 +413,7 @@ ())

(defmethod authorized-p ((handler admin-only-handler)) - (admin-p (bknr-request-user))) + (admin-p (bknr-session-user)))

(defclass xml-handler () ((style-path :initarg :style-path :reader xml-handler-style-path)) @@ -487,7 +489,7 @@ (defgeneric import-handler-import-files (handler))

(defmethod import-handler-import-pathname ((handler import-handler)) - (let* ((user (bknr-request-user)) + (let* ((user (bknr-session-user)) (spool-dir (merge-pathnames (make-pathname :directory (list :relative (user-login user))) (import-handler-spool-dir handler))))

Modified: branches/trunk-reorg/bknr/web/src/web/sessions.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/sessions.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/sessions.lisp Wed Jan 30 08:02:24 2008 @@ -2,28 +2,26 @@

(defclass bknr-session () ((id :initarg :id :reader bknr-session-id :initform (get-universal-time)) - (user :initarg :user :reader bknr-session-user :initform nil) + (user :initarg :user) (host :initarg :host :reader bknr-session-host :initform nil)))

(defmethod print-object ((session bknr-session) stream) (print-unreadable-object (session stream :type t :identity t) - (format stream "user ~A host ~A" (bknr-session-user session) (bknr-session-host session)) + (with-slots (user host) session + (format stream "user ~A host ~A" user host)) session))

-(defmethod bknr-session-user ((user (eql nil))) - nil) - -(defun bknr-request-user () - (bknr-session-user (session-value 'bknr-session))) - -(defun bknr-request-session () +(defun bknr-session () (session-value 'bknr-session))

+(defun bknr-session-user () + (slot-value (bknr-session) 'user)) + (defun do-log-request () (format *debug-io* "Log: ~A~%" (request-uri)) (return-from do-log-request) #+(or) - (let* ((session (bknr-request-session)) + (let* ((session (bknr-session)) (user (bknr-session-user session)) (host (bknr-session-host session)) (url (request-uri)) @@ -45,7 +43,7 @@ (defun do-error-log-request (error) (format *debug-io* "Error: ~A~%" error) #+(or) - (let* ((session (bknr-request-session)) + (let* ((session (bknr-session)) (user (bknr-session-user session)) (host (bknr-session-host session)) (url (request-uri))

Modified: branches/trunk-reorg/bknr/web/src/web/tags.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/tags.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/tags.lisp Wed Jan 30 08:02:24 2008 @@ -226,7 +226,7 @@ do (navi-button :url link :text name))))) (when (and (website-admin-navigation *website*) - (admin-p (bknr-request-user))) + (admin-p (bknr-session-user))) (html ((:div :class "navi") "admin: " (loop

Modified: branches/trunk-reorg/bknr/web/src/web/user-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/user-handlers.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/user-handlers.lisp Wed Jan 30 08:02:24 2008 @@ -39,7 +39,7 @@

(defmethod authorized-p ((handler user-handler)) (let* ((user (object-handler-get-object handler)) - (web-user (bknr-request-user)) + (web-user (bknr-session-user)) (action (query-param "action")) (action-keyword (when action (make-keyword-from-string action)))) (cond ((anonymous-p web-user) nil) @@ -87,7 +87,7 @@

(defmethod handle-object-form ((handler user-handler) (action (eql :save)) user) (unless user - (setf user (bknr-request-user))) + (setf user (bknr-session-user))) (when user (with-query-params (password password-repeat full-name @@ -98,7 +98,7 @@ (set-user-password user password)) (change-slot-values user 'email email 'full-name full-name)))

- (when (admin-p (bknr-request-user)) + (when (admin-p (bknr-session-user)) (let* ((all-flags (all-user-flags)) (set-flags (keywords-from-query-param-list (query-param-list "flags"))) (unset-flags (set-difference all-flags set-flags))) @@ -112,7 +112,7 @@ (:report "You are not authorized to perform this operation"))

(defmethod handle-object-form ((handler user-handler) (action (eql :delete)) user) - (unless (admin-p (bknr-request-user)) + (unless (admin-p (bknr-session-user)) (error 'unauthorized-error)) (when user (delete-user user))

Modified: branches/trunk-reorg/projects/quickhoney/src/handlers.lisp ============================================================================== --- branches/trunk-reorg/projects/quickhoney/src/handlers.lisp (original) +++ branches/trunk-reorg/projects/quickhoney/src/handlers.lisp Wed Jan 30 08:02:24 2008 @@ -75,8 +75,8 @@

(defmethod handle ((handler login-js-handler)) (format *html-stream* "parent.login_complete(~A, ~S);~%" - (if (admin-p (bknr-request-user)) "true" "false") - (user-login (bknr-request-user)))) + (if (admin-p (bknr-session-user)) "true" "false") + (user-login (bknr-session-user))))

(defclass clients-js-handler (javascript-handler page-handler) ())

Modified: branches/trunk-reorg/projects/quickhoney/src/init.lisp ============================================================================== --- branches/trunk-reorg/projects/quickhoney/src/init.lisp (original) +++ branches/trunk-reorg/projects/quickhoney/src/init.lisp Wed Jan 30 08:02:24 2008 @@ -2,6 +2,9 @@

(defun startup () (setq cxml::*default-catalog* '("/home/hans/share/xml/catalog")) + ;; XXX hack hack hack + (mapcar #'cl-gd::load-foreign-library + '("/usr/lib/libcrypto.so" "/usr/lib/libssl.so" "/usr/local/lib/libgd.so" "/home/hans/bknr-svn/thirdparty/cl-gd/cl-gd-glue.so")) (when *store* (close-store)) (make-instance 'store

Modified: branches/trunk-reorg/projects/quickhoney/src/webserver.lisp ============================================================================== --- branches/trunk-reorg/projects/quickhoney/src/webserver.lisp (original) +++ branches/trunk-reorg/projects/quickhoney/src/webserver.lisp Wed Jan 30 08:02:24 2008 @@ -3,6 +3,13 @@

(enable-interpol-syntax)

+(defclass admin-handler (admin-only-handler page-handler) + ()) + +(defmethod handle ((handler admin-handler)) + (with-bknr-page (:title "CMS") + "Please choose an administration activity from the menu above")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -23,6 +30,7 @@ ("/upload-animation" upload-animation-handler) ("/upload-button" upload-button-handler) ("/rss" rss-handler) + ("/admin" admin-handler) ("/" redirect-handler :to "/frontpage") user