Browse files

added registration and authentication

  • Loading branch information...
1 parent 00ba41a commit d3e78ff96d585262d9fc0e147992f008f13cdd9f @archimag archimag committed Mar 5, 2011
Showing with 831 additions and 93 deletions.
  1. +14 −3 cliki2.asd
  2. +52 −9 src/defmodule.lisp
  3. +15 −0 src/markup.lisp
  4. +50 −13 src/model.lisp
  5. +87 −21 src/render.lisp
  6. +26 −41 src/{routes.lisp → routes/articles.lisp}
  7. +235 −0 src/routes/auth.lisp
  8. +12 −0 src/routes/entry.lisp
  9. +28 −0 src/sendmail.lisp
  10. +82 −1 static/css/style.css
  11. +230 −5 templates/cliki2.tmpl
View
17 cliki2.asd
@@ -1,11 +1,22 @@
;;;; cliki2.asd
(defsystem cliki2
- :depends-on (#:restas-directory-publisher #:bknr.datastore #:ironclad #:docutils)
+ :depends-on (#:restas-directory-publisher
+ #:bknr.datastore
+ #:ironclad
+ #:docutils
+ #:cl-recaptcha)
:components
((:module "src"
:components
((:file "defmodule")
(:file "model" :depends-on ("defmodule"))
- (:file "render" :depends-on ("model"))
- (:file "routes" :depends-on ("render"))))))
+ (:file "markup" :depends-on ("defmodule"))
+ (:file "render" :depends-on ("model" "markup"))
+ (:file "sendmail" :depends-on ("defmodule"))
+ (:module "routes"
+ :components
+ ((:file "entry")
+ (:file "articles")
+ (:file "auth"))
+ :depends-on ("render" "sendmail"))))))
View
61 src/defmodule.lisp
@@ -5,26 +5,65 @@
(in-package #:cliki2)
+;;;; base path
+
(eval-when (:load-toplevel :compile-toplevel :execute)
(defparameter *basepath*
(make-pathname :directory (pathname-directory (asdf:component-pathname (asdf:find-system '#:cliki2))))))
+;;; mails
+
+(defparameter *sendmail*
+ (find-if #'fad:file-exists-p
+ '("/usr/bin/sendmail" "/usr/sbin/sendmail")))
+
+(defparameter *noreply-email* "noreply@cliki2.net")
+
+;;;; auth
+
(defvar *user* nil)
-;;;; initialization
+(defun sign-in-p ()
+ *user*)
+
+(defun not-sign-in-p ()
+ (not *user*))
+
+(defparameter *reCAPTCHA.publick-key* "6LdZjAcAAAAAAGh_MzHcHfJWp6rpI0XUNghGQB1f")
+
+(defparameter *reCAPTCHA.privake-key* "6LdZjAcAAAAAAKJ2GPWTHPh1H1Foc0kyfbwgrFgO")
+
+(defparameter *reCAPTCHA.theme* nil)
+
+(defparameter *cookie-auth-name* "userauth")
+
+(defparameter *cookie-cipher-key* (ironclad:ascii-string-to-byte-array "Specify the secure key"))
+
+(defvar *user-auth-cipher*)
+
+;;;; store
(defparameter *datadir* #P"/var/cliki2/")
+;;;; initialization
+
(defmethod restas:initialize-module-instance ((module (eql #.*package*)) context)
- (let ((*store* nil))
- (restas:with-context context
+ (unless (restas:context-symbol-value context '*default-render-method*)
+ (restas:context-add-variable context
+ '*default-render-method*
+ (make-instance 'drawer)))
+
+ (restas:with-context context
+ (setf (restas:context-symbol-value context '*user-auth-cipher*)
+ (ironclad:make-cipher :blowfish
+ :mode :ecb
+ :key (restas:context-symbol-value context '*cookie-cipher-key*)))
+
+ (let ((*store* nil))
+
(open-store (merge-pathnames "store/" *datadir*))
- (restas:context-add-variable context '*store* *store*)
- (restas:context-add-variable context
- '*user*
- (or (user-with-name "archimag")
- (with-transaction ()
- (make-instance 'user :name "archimag" :password "123")))))))
+ (setf (restas:context-symbol-value context '*store*)
+ *store*))))
;;;; compile templates
@@ -33,3 +72,7 @@
(merge-pathnames "templates/cliki2.tmpl" *basepath*)))
(compile-all-templates)
+
+;;;; decorators
+
+(push '@check-auth-user *decorators*)
View
15 src/markup.lisp
@@ -0,0 +1,15 @@
+;;;; markup.lisp
+
+(in-package #:cliki2)
+
+
+(defun generate-html-from-markup (markup)
+ (let ((doc (docutils:read-rst (ppcre:regex-replace-all "\\r\\n" markup (string #\Newline) )))
+ (writer (make-instance 'docutils.writer.html:html-writer)))
+ (docutils:visit-node writer doc)
+ (with-output-to-string (out)
+ (iter (for part in '(docutils.writer.html:body-pre-docinfo
+ docutils.writer.html:docinfo
+ docutils.writer.html:body))
+ (docutils:write-part writer part out))
+ (format out "</div>"))))
View
63 src/model.lisp
@@ -5,17 +5,52 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; user
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
+
(defclass user (store-object)
((name :initarg :name
:index-type string-unique-index
:index-reader user-with-name
:index-values all-users
:reader user-name)
- (password :initarg :password :accessor user-password)
- (info :initarg :info :initarg nil :accessor user-info))
+ (email :initarg :email
+ :index-type string-unique-index
+ :index-reader user-with-email
+ :reader user-email)
+ (role :initarg :role
+ :initform nil
+ :accessor user-role)
+ (password :initarg :password
+ :accessor user-password)
+ (info :initarg :info
+ :initarg nil
+ :accessor user-info))
+ (:metaclass persistent-class))
+
+(defclass invite (store-object)
+ ((user :initarg :user
+ :reader invite-user)
+ (date :initarg :date
+ :initform (get-universal-time)
+ :reader invite-date)
+ (mark :reader invite-mark
+ :index-type string-unique-index
+ :index-reader invite-with-mark
+ :index-values all-invites))
(:metaclass persistent-class))
+(defmethod shared-initialize :after ((invite invite) slot-names &key
+ &aux (user (invite-user invite)))
+ (setf (slot-value invite 'mark)
+ (ironclad:byte-array-to-hex-string
+ (ironclad:digest-sequence :sha1
+ (babel:string-to-octets
+ (format nil
+ "~A~A~A"
+ (user-name user)
+ (user-email user)
+ (user-password user)))))))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; revision
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -24,17 +59,17 @@
((author :initarg :author
:initform nil
:reader revision-author)
- (author-ip :initarg :author-ip :initform nil :reader revision-author-ip)
- (date :initarg :date :initform (get-universal-time) :reader revision-date)
- (content-sha1 :initarg :content :initform "" :reader revision-content-sha1))
+ (author-ip :initarg :author-ip
+ :initform nil
+ :reader revision-author-ip)
+ (date :initarg :date
+ :initform (get-universal-time)
+ :reader revision-date)
+ (content-sha1 :initarg :content
+ :initform ""
+ :reader revision-content-sha1))
(:metaclass persistent-class))
-(defun calc-sha1-sum (val)
- "Calc sha1 sum of the val (string)"
- (ironclad:byte-array-to-hex-string
- (ironclad:digest-sequence :sha1
- (babel:string-to-octets val :encoding :utf-8))))
-
(defun content-path (sha1)
(merge-pathnames (format nil "content/~A/~A" (subseq sha1 0 2) (subseq sha1 2))
*datadir*))
@@ -68,7 +103,9 @@
:index-type string-unique-index
:index-reader article-with-title
:index-values all-articles)
- (revisions :initarg :charin :initform nil :accessor article-revisions))
+ (revisions :initarg :revisions
+ :initform nil
+ :accessor article-revisions))
(:metaclass persistent-class))
(defun article-last-revision (article)
View
108 src/render.lisp
@@ -2,29 +2,24 @@
(in-package #:cliki2)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; drawer
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defclass drawer () ())
-
-(setf *default-render-method* (make-instance 'drawer))
-
(defgeneric render-article-revision (drawer article revision mode))
(defgeneric render-handle-markup (drawer content))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; links
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defmethod render-handle-markup ((drawer drawer) content)
- (let ((doc (docutils:read-rst (ppcre:regex-replace-all "\\r\\n" content (string #\Newline) )))
- (writer (make-instance 'docutils.writer.html:html-writer)))
- (docutils:visit-node writer doc)
- (with-output-to-string (out)
- (iter (for part in '(docutils.writer.html:body-pre-docinfo
- docutils.writer.html:docinfo
- docutils.writer.html:body))
- (docutils:write-part writer part out))
- (format out "</div>"))))
+(defun user-info-links ()
+ (list :user
+ (if *user*
+ (list :name (user-name *user*)
+ :href (restas:genurl 'view-person
+ :name (user-name *user*))
+ :sign-out (restas:genurl 'sign-out))
+ (list :register (restas:genurl 'register)
+ :sign-in (restas:genurl 'sign-in)
+ :callback (hunchentoot:referer)))))
(defun article-action-list (article mode
&aux (title (article-title article)))
@@ -38,13 +33,84 @@
(:revision (list :view (restas:genurl 'view-article :title title)
:history (restas:genurl 'view-article-history :title title)))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; drawer
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass drawer () ())
+
+(defmethod render-handle-markup ((drawer drawer) content)
+ (generate-html-from-markup content))
+
(defmethod render-article-revision ((drawer drawer) (article article) (revision revision) mode)
(let ((title (article-title article)))
(cliki2.view:view-article
- (list :title title
- :content (render-handle-markup drawer (revision-content revision))
- :links (article-action-list article mode)))))
+ (list* :title title
+ :content (render-handle-markup drawer (revision-content revision))
+ :links (article-action-list article mode)
+ (user-info-links)))))
+
+;; article
(defmethod restas:render-object ((drawer drawer) (article article))
(render-article-revision drawer article (article-last-revision article) :view))
+;; edit-article-page
+
+(defclass edit-article-page ()
+ ((title :initarg :title :reader article-title)
+ (article :initarg :article :reader article)))
+
+(defmethod restas:render-object ((drawer drawer) (page edit-article-page))
+ (let* ((title (article-title page))
+ (article (article page)))
+ (cliki2.view:edit-article
+ (list* :title title
+ :content (if article
+ (article-content article)
+ "")
+ (user-info-links)))))
+
+;; article-not-found
+
+(defclass article-not-found ()
+ ((title :initarg :title :reader article-title)))
+
+(defmethod restas:render-object ((drawer drawer) (article article-not-found)
+ &aux (title (article-title article)))
+ (cliki2.view:article-not-found
+ (list* :title title
+ :create-link (restas:genurl 'edit-article :title title)
+ (user-info-links))))
+
+;; login
+
+(defmethod restas:render-object ((drawer drawer) (page (eql :sign-in-page)))
+ (cliki2.view:sign-in
+ (list* :forgot-href (restas:genurl 'forgot)
+ (user-info-links))))
+
+;; register
+
+(defclass register-page ()
+ ((data :initarg :data :initform nil :reader register-data)))
+
+(defmethod restas:render-object ((drawer drawer) (page register-page))
+ (cliki2.view:register
+ (concatenate 'list
+ (list :recaptcha-pubkey *recaptcha.publick-key*)
+ (register-data page)
+ (user-info-links))))
+
+;; register-sendmail-page
+
+(defmethod restas:render-object ((drawer drawer) (page (eql :register-sendmail-page)))
+ (cliki2.view:register-continue
+ (user-info-links)))
+
+;; confirm-registration
+
+(defmethod restas:render-object ((drawer drawer) (page (eql :confirm-registration-page)))
+ (cliki2.view:confirm-registration
+ (user-info-links)))
+
View
67 src/routes.lisp → src/routes/articles.lisp
@@ -1,34 +1,11 @@
-;;;; routes.lisp
+;;;; articles.lisp
(in-package #:cliki2)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; entry
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(restas:define-route entry ("")
- (view-article :title "index"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; static
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(restas:mount-submodule -static- (#:restas.directory-publisher)
- (restas.directory-publisher:*directory* (merge-pathnames "static/"
- *basepath*))
- (restas.directory-publisher:*autoindex* t))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; article
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
(restas:define-route view-article (":title")
(or (article-with-title title)
- (restas:abort-route-handler
- (cliki2.view:article-not-found
- (list :title title
- :create-link (restas:genurl 'edit-article
- :title title))))))
+ (make-instance 'article-not-found
+ :title title)))
(restas:define-route view-article-source ("raw/:title"
:content-type "text/plain")
@@ -38,16 +15,30 @@
(article-content article)))
(restas:define-route edit-article ("edit/:title"
- :render-method 'cliki2.view:edit-article)
- (let ((article (article-with-title title)))
- (list :title title
- :content (if article
- (article-content article)
- ""))))
+ :requirement 'sign-in-p)
+ (make-instance 'edit-article-page
+ :title title
+ :article (article-with-title title)))
+
+(restas:define-route forbidden-edit-article ("edit/:title"
+ :requirement 'not-sign-in-p)
+ (declare (ignore title))
+ hunchentoot:+http-forbidden+)
+
+
+(restas:define-route forbidden-save-article ("edit/:title"
+ :method :post
+ :requirement 'not-sign-in-p)
+ (declare (ignore title))
+ hunchentoot:+http-forbidden+)
+
+(defun check-edit-command (field)
+ (and (sign-in-p)
+ (hunchentoot:post-parameter field)))
(restas:define-route save-article ("edit/:title"
:method :post
- :requirement (lambda () (hunchentoot:post-parameter "save")))
+ :requirement (lambda () (check-edit-command "save")))
(with-transaction ()
(let ((article (or (article-with-title title)
(make-instance 'article :title title))))
@@ -63,14 +54,14 @@
(restas:define-route preview-article ("edit/:title"
:method :post
:render-method 'cliki2.view:edit-article
- :requirement (lambda () (hunchentoot:post-parameter "preview")))
+ :requirement (lambda () (check-edit-command "preview")))
(list :title title
:content (hunchentoot:post-parameter "content")
:preview (hunchentoot:post-parameter "content")))
(restas:define-route cancel-edit-article ("edit/:title"
:method :post
- :requirement (lambda () (hunchentoot:post-parameter "cancel")))
+ :requirement (lambda () (check-edit-command "cancel")))
(restas:redirect 'view-article
:title title))
@@ -102,9 +93,3 @@
:key #'revision-content-sha1
:test #'string=)
:revision)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; person article
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
View
235 src/routes/auth.lisp
@@ -0,0 +1,235 @@
+;;;; auth.lisp
+
+(in-package #:cliki2)
+
+(defun pack-auth-cookie (name password &key (version 1) (date (get-universal-time)))
+ (format nil "~A|~A|~A|~A" version name password date))
+
+(defun encrypt-auth-cookie (name password &key (version 1) (date (get-universal-time)))
+ (let ((result (ironclad:ascii-string-to-byte-array
+ (pack-auth-cookie name password :version version :date date))))
+ (ironclad:encrypt-in-place *user-auth-cipher*
+ result)
+ (ironclad:byte-array-to-hex-string result)))
+
+(defun set-auth-cookie (name password &key (version 1))
+ (hunchentoot:set-cookie *cookie-auth-name*
+ :value (encrypt-auth-cookie name password :version version)
+ :path "/"
+ :expires (+ (get-universal-time) (* 60 60 24 4))
+ :http-only t))
+
+;;;; get-auth-cookie
+
+(defun unpack-auth-cookie (str)
+ (let ((info (split-sequence:split-sequence #\| str)))
+ (values (first info)
+ (second info)
+ (third info)
+ (fourth info))))
+
+(defun hex-string-to-byte-array (string &key (start 0) (end nil))
+ (declare (type string string))
+ (let* ((end (or end (length string)))
+ (length (/ (- end start) 2))
+ (key (make-array length :element-type '(unsigned-byte 8))))
+ (declare (type (simple-array (unsigned-byte 8) (*)) key))
+ (flet ((char-to-digit (char)
+ (let ((x (position char "0123456789abcdef" :test #'char-equal)))
+ (or x (error "Invalid hex key ~A specified" string)))))
+ (loop for i from 0
+ for j from start below end by 2
+ do (setf (aref key i)
+ (+ (* (char-to-digit (char string j)) 16)
+ (char-to-digit (char string (1+ j)))))
+ finally (return key)))))
+
+(defun decrypt-auth-cookie (str)
+ (ignore-errors
+ (let ((result (hex-string-to-byte-array str)))
+ (ironclad:decrypt-in-place *user-auth-cipher*
+ result)
+ (unpack-auth-cookie (babel:octets-to-string result :encoding :utf-8)))))
+
+(defun get-auth-cookie ()
+ (let ((cookie (hunchentoot:cookie-in *cookie-auth-name*)))
+ (if cookie
+ (decrypt-auth-cookie cookie))))
+
+;;; compute-user-login-name
+
+(defclass check-auth-user-route (routes:proxy-route) ())
+
+(defun check-user-auth ()
+ (multiple-value-bind (version name password date) (get-auth-cookie)
+ (if (and version name password date)
+ (let ((user (user-with-name name)))
+ (if (and user
+ (string= (user-password user)
+ password))
+ user)))))
+
+(defmethod routes:route-check-conditions ((route check-auth-user-route) bindings)
+ (let ((*user* (check-user-auth)))
+ (call-next-method)))
+
+(defmethod restas:process-route ((route check-auth-user-route) bindings)
+ (let ((*user* (check-user-auth)))
+ (call-next-method)))
+
+(defun @check-auth-user (origin)
+ (make-instance 'check-auth-user-route :target origin))
+
+(defun password-cache (password)
+ (ironclad:byte-array-to-hex-string
+ (ironclad:digest-sequence :md5
+ (babel:string-to-octets password :encoding :utf-8))))
+
+(defun run-sing-in (user &key (version 1))
+ "Set cookie for user name and password"
+ (set-auth-cookie (user-name user)
+ (user-password user)
+ :version version))
+
+(defun run-sing-out ()
+ "Clear cookie with auth information"
+ (hunchentoot:set-cookie *cookie-auth-name*
+ :value ""
+ :path "/"))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; routes
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(restas:define-route sign-out ("specials/singout")
+ (run-sing-out)
+ ;;(setf *user* nil)
+ (restas:redirect (hunchentoot:referer)))
+
+
+(restas:define-route sign-in ("specials/singin")
+ :sign-in-page)
+
+(restas:define-route sign-in/post ("specials/singin"
+ :method :post
+ :requirement 'not-sign-in-p)
+ (let* ((name (hunchentoot:post-parameter "name"))
+ (password (password-cache (hunchentoot:post-parameter "password")))
+ (done (hunchentoot:get-parameter "done"))
+ (user (user-with-name name)))
+ (cond
+ ((and user (string= (user-password user) password))
+ (run-sing-in user)
+ (restas:redirect (or done "/")))
+ (t (restas:redirect 'sign-in)))))
+
+(restas:define-route register ("specials/register")
+ (make-instance 'register-page))
+
+(defun form-field-value (field)
+ (hunchentoot:post-parameter field))
+
+(defun form-field-empty-p (field)
+ (string= (form-field-value field)
+ ""))
+
+(defparameter *re-email-check*
+ "^[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?$")
+
+(defun check-register-form ()
+ (let ((bads nil))
+ (flet ((form-error-message (field message)
+ (push message bads)
+ (push field bads)))
+ (cond
+ ((form-field-empty-p "name")
+ (form-error-message :bad-name "empty"))
+ ((user-with-name (form-field-value "name"))
+ (form-error-message :bad-name "exist")))
+
+ (cond
+ ((form-field-empty-p "email") (form-error-message :bad-email "empty"))
+ ((not (ppcre:scan *re-email-check*
+ (string-downcase (form-field-value "email"))))
+ (form-error-message :bad-email
+ "bad"))
+ ((user-with-email (form-field-value "email"))
+ (form-error-message :bad-email
+ "exist")))
+
+ (cond
+ ((form-field-empty-p "password")
+ (form-error-message :bad-password
+ "empty"))
+ ((< (length (form-field-value "password")) 8)
+ (form-error-message :bad-password
+ "short")))
+
+ (unless (string= (form-field-value "password")
+ (form-field-value "re-password"))
+ (form-error-message :bad-re-password
+ "bad"))
+
+ (unless (cl-recaptcha:verify-captcha (hunchentoot:post-parameter "recaptcha_challenge_field")
+ (hunchentoot:post-parameter "recaptcha_response_field")
+ (hunchentoot:real-remote-addr)
+ :private-key *reCAPTCHA.privake-key*)
+ (form-error-message :bad-recaptcha "Bad")))
+
+ bads))
+
+(restas:define-route register/post ("specials/register"
+ :method :post
+ :requirement 'not-sign-in-p)
+ (let ((fails (check-register-form))
+ (nickname (form-field-value "name"))
+ (email (form-field-value "email"))
+ (password (form-field-value "password")))
+ (cond
+ (fails
+ (make-instance 'register-page
+ :data (list* :name nickname
+ :email email
+ :password password
+ :re-password (form-field-value "re-password")
+ fails)))
+ (t (let ((invite (with-transaction ()
+ (make-instance 'invite
+ :user (make-instance 'user
+ :name nickname
+ :email email
+ :password (password-cache password)
+ :role :invite))))
+ (to (list email)))
+ (sendmail to
+ (cliki2.view:confirmation-mail
+ (list :to to
+ :noreply-mail *noreply-email*
+ :subject (prepare-subject "Потверждение регистрации")
+ :host (hunchentoot:host)
+ :link (restas:gen-full-url 'accept-invitation
+ :mark (invite-mark invite)))))
+ :register-sendmail-page)))))
+
+(restas:define-route confirm-registration ("specials/invite/:mark"
+ :requirement 'not-sign-in-p)
+ (let ((invite (invite-with-mark mark)))
+ (unless invite
+ (restas:abort-route-handler hunchentoot:+http-not-found+))
+ :confirm-registration-page))
+
+(restas:define-route confirm-registration/post ("specials/invite/:mark"
+ :method :post
+ :requirement 'not-sign-in-p)
+ (let ((invite (invite-with-mark mark)))
+ (unless invite
+ (restas:abort-route-handler hunchentoot:+http-not-found+))
+
+ (with-transaction ()
+ (setf (user-role (invite-user invite))
+ nil)
+ (delete-object invite))
+
+ (restas:redirect 'entry)))
+
View
12 src/routes/entry.lisp
@@ -0,0 +1,12 @@
+;;;; entry.lisp
+
+(in-package #:cliki2)
+
+
+(restas:define-route entry ("")
+ (view-article :title "index"))
+
+(restas:mount-submodule -static- (#:restas.directory-publisher)
+ (restas.directory-publisher:*directory* (merge-pathnames "static/"
+ *basepath*))
+ (restas.directory-publisher:*autoindex* t))
View
28 src/sendmail.lisp
@@ -0,0 +1,28 @@
+;;;; sendmail.lisp
+
+(in-package #:cliki2)
+
+(defun prepare-subject (subject &optional (external-format :utf-8))
+ (format nil
+ "=?~A?B?~A?="
+ external-format
+ (base64:string-to-base64-string
+ (coerce (loop for code across (babel:string-to-octets subject
+ :encoding external-format)
+ collect (code-char code))
+ 'string))))
+
+(defun sendmail (to content)
+ #+sbcl
+ (let* ((sendmail-process (sb-ext:run-program *sendmail*
+ to
+ :input :stream
+ :output nil
+ :error nil
+ :wait nil))
+ (sendmail (sb-ext:process-input sendmail-process)))
+ (unwind-protect
+ (write-string content sendmail)
+ (close sendmail)
+ (sb-ext:process-wait sendmail-process)
+ (sb-ext:process-close sendmail-process))))
View
83 static/css/style.css
@@ -22,6 +22,7 @@ a.hyperspec { font-weight: bold; }
a[href]:hover { background: #ff9 }
+/*
table { border-collapse: collapse; border: 1px solid #aaa; }
th
{
@@ -31,6 +32,7 @@ th
text-transform: lowercase
}
th, td { padding: 0.2em 0.3em }
+*/
ul li { list-style-type: square }
@@ -118,4 +120,83 @@ pre
#footer a[href] { color: gold; text-decoration: none }
#footer a[href]:hover { background: transparent; color: gold }
-.content { margin: 1em 0 1em 0; }
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * articles
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+.content { margin: 1em 0 1em 0; }
+
+.textarea { padding: 1em 0 1em 0;}
+.textarea textarea { width: 100%; }
+
+.top { color: #ccc }
+.top a:link, .top a:visited { color: #999 }
+
+.top li { display: inline; list-style-type: none; list-style-position: outside; list-style-image: none }
+
+#login { font-size: 80%; text-align: right; margin-bottom: 0.5em }
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * user
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+.info {color: gray; font-size: 80%;}
+
+.login-form {
+ padding: 2px;
+ font-size: 90%;
+ font-weight: normal;
+
+ /*border: 1px solid #D0D0D0;*/
+
+ display: table;
+}
+
+.login-form > table {
+ padding: 10px;
+}
+
+.login-form tr > td:first-child {
+
+ font-weight: bold;
+ vertical-align: top;
+ width: auto;
+}
+
+.login-form > table td {
+ padding-right: 5px;
+ padding-top: 3px;
+}
+
+.register-form {
+ border: 1px solid #d0d0d0;
+ display: table;
+
+ padding-top: 30px;
+ padding-bottom: 30px;
+ padding-left: 10px;
+ padding-right: 20px;
+}
+
+.register-form td {
+ padding-bottom: 20px;
+}
+
+.register-form tr > td:first-child {
+ vertical-align: top;
+ font-weight: bold;
+ font-size: 90%;
+
+}
+
+
+
+.register-form input[type=button] {
+ margin-top: 10px;
+}
+
+.error-info {
+ color: red;
+ font-size: 80%;
+}
View
235 templates/cliki2.tmpl
@@ -2,6 +2,10 @@
{namespace cliki2.view}
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * Main template
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
{template base}
<html>
<head>
@@ -11,6 +15,20 @@
</head>
<body>
+ <div class="top">
+ {if $user.name}
+ <div id="login">
+ <strong>{$user.name}</strong> |
+ <a href="{$user.signOut}" id="logout">Sign Out</a>
+ </div>
+ {else}
+ <div id="login">
+ <a href="{$user.register}">Register</a> |
+ <a href="{$user.signIn}{if $callback}?done={$callback}{/if}">Sign In</a>
+ </div>
+ {/if}
+ </div>
+
<div id="banner">
<a title="cliki home article" class="logo" href="http://www.cliki.net/">
CL<span class="sub">iki</span>
@@ -32,9 +50,14 @@
</html>
{/template}
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * Article templates
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
{template article-not-found}
{call base}
{param title: $title /}
+ {param user: $user /}
{param body}
<h1>Cliki2 does not have an article with this exact name</h1>
<a href="{$createLink}">Create</a>
@@ -65,6 +88,7 @@
{template view-article}
{call base}
{param title: $title /}
+ {param user: $user /}
{param body}
<div class="content">
{$content |noAutoescape}
@@ -78,13 +102,15 @@
{template edit-article}
{call base}
{param title: 'Edit ' + $title /}
-
+ {param user: $user /}
{param body}
<form method="post">
- <form method="post">
- <textarea rows="30" cols="80" name="content">
- {nil}{$content}{nil}
- </textarea>
+ <form method="post">
+ <div class="textarea">
+ <textarea rows="30" cols="80" name="content">
+ {nil}{$content}{nil}
+ </textarea>
+ </div>
<div class="edit-buttons">
<input type="submit" value="Save" name="save" />
@@ -120,3 +146,202 @@
{/param}
{/call}
{/template}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * User
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+{template sign-in}
+ {call base}
+ {param title: 'Sign In' /}
+ {param user: $user /}
+ {param body}
+ <div>
+ <form class="sign-form" method="post">
+ <table >
+ <tbody>
+ <tr>
+ <td>Nickname</td>
+ <td><input name="name" /></td>
+ </tr>
+
+ <tr>
+ <td>Password</td>
+ <td>
+ <input type="password" name="password"/>
+ <a href="{$forgotHref}" >Forgot?</a>
+ </td>
+ </tr>
+
+ <tr>
+ <td />
+ <td><input type="submit" value="Sing In" /></td>
+ </tr>
+ </tbody>
+ </table>
+ </form>
+ </div>
+
+ {/param}
+ {/call}
+{/template}
+
+
+{template register}
+ {call base}
+ {param title: $title /}
+ {param user: $user /}
+ {param body}
+ <div>
+ <h3>Create account</h3>
+
+ <form method="post">
+ <table>
+ <tbody>
+ <tr>
+ <td>Nickname:</td>
+ <td>
+ {if $badName}
+ <div class="error-info">
+ {switch $badName}
+ {case 'empty'} Login is empty
+ {case 'exist'} User with like nickname already exist
+ {/switch}
+ </div>
+ {/if}
+ <input name="name" size="30" {if $name}value="{$name}"{/if} />
+ <div class="info">Sample: graham, Piter.Norvig </div>
+ </td>
+ </tr>
+
+ <tr>
+ <td>Email:</td>
+ <td>
+ {if $badEmail}
+ <div class="error-info">
+ {switch $badEmail}
+ {case 'empty'} email required
+ {case 'bad'} It does not seem as email
+ {case 'exist'} User with like email arleady exist
+ {/switch}
+ </div>
+ {/if}
+ <input name="email" size="30" {if $email}value="{$email}"{/if}/>
+ </td>
+ </tr>
+
+ <tr>
+ <td>Password:</td>
+ <td>
+ {if $badPassword}
+ <div class="error-info">
+ {switch $badPassword}
+ {case 'empty'} Password required
+ {case 'short'} Too short password
+ {/switch}
+ </div>
+ {/if}
+ <input name="password" type="password" size="30" {if $password}value="{$password}"{/if} />
+ <div class="info">Minimum length - 8 characters</div>
+ </td>
+ </tr>
+
+ <tr>
+ <td>Repeat password:</td>
+ <td>
+ {if $badRePassword}
+ <div class="error-info">
+ Passwords do not match
+ </div>
+ {/if}
+ <input name="re-password" type="password" size="30" {if $rePassword}value="{$rePassword}"{/if}/>
+ </td>
+ </tr>
+ </tbody>
+ </table>
+
+ <br />
+
+ <div>
+ {if $badRecaptcha}
+ <div class="error-info">
+ reCaptcha failed
+ </div>
+ {/if}
+
+ <script>
+ var RecaptchaOptions = {lb} theme : "{$theme ? $theme : 'clean'}", lang: "en" {rb};
+ </script>
+
+ <script type="text/javascript"
+ src="http://api.recaptcha.net/challenge?k={$recaptchaPubkey}">
+ </script>
+
+ <noscript>
+ <iframe src="http://api.recaptcha.net/noscript?k={$recaptchaPubkey}"
+ height="300" width="500" frameborder="0"></iframe><br />
+ <textarea name="recaptcha_challenge_field" rows="3" cols="40">
+ </textarea>
+ <input type="hidden" name="recaptcha_response_field"
+ value="manual_challenge" />
+ </noscript>
+ </div>
+
+ <br />
+ <input type="submit" value="Create account" />
+ </form>
+ </div>
+ {/param}
+ {/call}
+{/template}
+
+{template register-continue}
+ {call base}
+ {param title: 'Register' /}
+ {param user: $user /}
+ {param body}
+ <div>
+ <p>You receive an email with a link to continue registration.</p>
+ </div>
+ {/param}
+ {/call}
+{/template}
+
+{template confirmation-mail}
+ {nil}To: {foreach $receiver in $to}{if not isFirst($receiver)}{sp}{/if}{$receiver}{/foreach}{\n}
+ {nil}From: {$noreplyMail}{\n}
+ {nil}Subject: {$subject}{\n}
+ {nil}Content-Type: text/html; charset=utf-8{\n}
+ {\n}
+
+ Hi,
+ <p>
+ For complete registration on <a href="http://{$host}/">{$host}</a> go to <a href="{$link}">{$link}</a>.
+ </p>
+
+ <p>
+ If you are not registered on the <a href="http://{$host}">{$host}</a> then just ignore this message.
+ </p>
+
+ Keeper
+{/template}
+
+{template confirm-registration}
+ {call base}
+ {param title: 'Register' /}
+ {param user: $user /}
+ {param body}
+ <p>
+ <form method="post">
+ <input type="submit" value="Confirm registration" />
+ </form>
+ </p>
+ {/param}
+ {/call}
+{/template}
+
+{template success-registration}
+ <div>
+ Congratulations on your successful registration
+ </div>
+{/template}

0 comments on commit d3e78ff

Please sign in to comment.