Merge packages into rulisp

resources/colorize/colorize.css

@@ -0,0 +1,27 @@
+.symbol { color : #770055; background-color : transparent; border: 0px; margin: 0px;}
+a.symbol:link { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:active { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:visited { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:hover { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+.special { color : #FF5000; background-color : inherit; }
+.keyword { color : #770000; background-color : inherit; }
+.comment { color : #007777; background-color : inherit; }
+.string { color : #777777; background-color : inherit; }
+.character { color : #0055AA; background-color : inherit; }
+.syntaxerror { color : #FF0000; background-color : inherit; }
+span.paren1:hover { color : inherit; background-color : #BAFFFF; }
+span.paren2:hover { color : inherit; background-color : #FFCACA; }
+span.paren3:hover { color : inherit; background-color : #FFFFBA; }
+span.paren4:hover { color : inherit; background-color : #CACAFF; }
+span.paren5:hover { color : inherit; background-color : #CAFFCA; }
+span.paren6:hover { color : inherit; background-color : #FFBAFF; }
+
+.code {
+    background-color: #eee;
+    border: 1px solid #d0d0d0;
+    margin: 0.2em;
+    padding: 0.5em;
+    font-family: "Courier New", monospace;
+    font-size: 90%;
+    overflow: auto;
+}

resources/colorize/style.css

@@ -0,0 +1,11 @@
+
+.colorize-top-menu { padding-left: 0; padding-bottom: 0.2em; margin: 0;  border-bottom: 1px solid gray;}
+
+.colorize-top-menu li {display: inline; list-style-type: none; margin-right: 0.3em;}
+
+.colorize-list-nav {text-align: right; padding: 0.2em; margin-bottom: 0.2em; border-bottom: 1px solid gray; } 
+
+.paste { margin: 0.5em;}
+.info { font-size: 90%; color: gray; }
+
+.paste-detail { margin-top: 1em; }

resources/planet/planet.css

@@ -0,0 +1,76 @@
+/* planet.css */
+
+
+.entry {
+    margin-bottom: 10px;
+    padding: 0;
+    padding-bottom: 10px;
+    border-bottom: 1px solid #d0d0d0;
+}
+
+.entry-title {
+    font-size: 140%;
+    padding: 10px;
+}
+
+.entry-title a {
+    text-decoration: none;
+}
+
+.entry-title a:hover {
+    text-decoration: underline;
+}
+
+.entry-author-info {
+    margin-top: 3px;
+    font-size: 13px;
+    color: gray;
+}
+
+.entry-content {
+    padding-left: 10px;
+}
+
+.entry-content pre {
+    background-color: #eeeeee;
+    border: 1px solid #d0d0d0;
+    padding: 10px;
+}
+
+#planet-body {
+    margin-top: 0;
+    padding-top: 0;
+    position: relative;
+}
+
+#planet-content {
+    margin-right: 210px;
+}
+
+#planet-info-panel {
+    border-left: 1px solid #d0d0d0;
+    position: absolute;
+    right: 0;
+    top: 0;
+    width: 180px;
+    height: 100%;
+
+    padding-left: 15px;
+
+    color: #6a5eab;
+}
+
+#syndicate {
+    background-image: url(feed-icon-14x14.png);
+    background-repeat: no-repeat;
+    padding-left: 20px;
+    padding-bottom: 10px;
+}
+
+#planet-info-panel ul {
+    list-style: none;
+    padding: 0;
+}
+
+#authors li { padding: 5px 0; }
+

rulisp.asd

@@ -7,21 +7,75 @@
 
 (defsystem rulisp
   :depends-on (#:restas
-               #:simple-date #:postmodern
+	       #:ironclad
+	       #:split-sequence
+               #:simple-date
+	       #:postmodern
                #:zip
-               #:restas-simple-auth #:restas-planet #:restas-wiki
-               #:restas-colorize #:restas-directory-publisher #:restas-forum
-               #:xfactory #:cl-typesetting
-               #:wiki-parser)
+	       #:restas-directory-publisher
+               #:xfactory
+	       #:cl-typesetting
+	       #:net-telent-date
+	       #:local-time
+	       #:clon
+	       #:closure-template
+	       #:cl-libxml2
+	       #:babel
+	       #:colorize
+	       #:metabang-bind
+	       #:iterate
+	       #:alexandria
+	       #:cl-ppcre)
+  :defsystem-depends-on (#:closure-template)
   :components ((:file "pref")
                (:module :src
                         :components ((:file "packages")
                                      (:module "dokuwiki"
                                               :components ((:file "render-html"))
+                                              :depends-on ("packages" "wiki" "wiki-parser"))
+				     (:module "auth"
+                                              :components ((:module "templates"
+								    :components ((:closure-template "forgot")
+										 (:closure-template "login")
+										 (:closure-template "register")))
+							   (:file "defmodule" :depends-on ("templates"))
+							   (:file "storage" :depends-on ("defmodule"))
+							   (:file "cookie" :depends-on ("storage"))
+							   (:file "sendmail" :depends-on ("defmodule"))
+							   (:file "simple-auth" :depends-on ("cookie" "sendmail")))
                                               :depends-on ("packages"))
+				     (:module "planet"
+					      :components ((:file "feed-parser")
+							   (:file "spider" :depends-on ("feed-parser"))
+							   (:file "planet" :depends-on ("spider")))
+					      :depends-on ("packages"))
+				     (:module "wiki"
+					      :components
+					      ((:file "wiki")
+					       (:file "storage")
+					       (:file "drawer")
+					       (:file "routes" :depends-on ("storage" "drawer")))
+					      :depends-on ("packages"))
+				     (:module "colorize"
+					      :components ((:file "defmodule")
+							   (:file "storage" :depends-on ("defmodule"))
+							   (:file "drawer" :depends-on ("defmodule"))
+							   (:file "routes" :depends-on ("storage" "drawer")))
+					      :depends-on ("packages"))
+				     (:module "forum"
+					      :components ((:file "defmodule")
+							   (:file "storage" :depends-on ("defmodule"))
+							   (:file "forum" :depends-on ("storage")))
+					      :depends-on ("packages"))
+
+				     (:module "wiki-parser"
+					      :components ((:file "parser")
+							   (:file "dokuwiki" :depends-on ("parser")))
+					      :depends-on ("packages"))
                                      (:file "storage" :depends-on ("packages"))
                                      (:file "pcl"  :depends-on ("rulisp"))
                                      (:file "jscl"  :depends-on ("rulisp"))
-                                     (:file "rulisp" :depends-on ("storage" "dokuwiki")))
+                                     (:file "rulisp" :depends-on ("storage"
+								  "dokuwiki"
+								  "auth")))
                         :depends-on ("pref"))))
-

src/auth/cookie.lisp

@@ -0,0 +1,98 @@
+;;;; cookie.lisp
+;;;;
+;;;; This file is part of the rulisp application, released under GNU Affero General Public License, Version 3.0
+;;;; See file COPYING for details.
+;;;;
+;;;; Author: Moskvitin Andrey <archimag@gmail.com>
+
+(in-package #:rulisp.auth)
+
+;;;; set-auth-cookie
+
+(defun pack-auth-cookie (name password &key (version 1) date)
+  (format nil
+          "~A|~A|~A|~A"
+          version
+          name
+          password
+          (or date
+              (get-universal-time))))
+
+(defun encrypt-auth-cookie (name password &key (version 1) date)
+  (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)
+  (split-sequence:split-sequence #\| str))
+
+(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 
+
+;; (restas:define-memoized-function compute-user-login/impl (cipher)
+;;   (let ((auth-info (get-auth-cookie)))
+;;     (if auth-info
+;;         (check-user-password (second auth-info)
+;;                              (third auth-info)))))
+
+(defun compute-user-login-name ()
+  "Return user name for *request*."
+  (let ((auth-info (get-auth-cookie)))
+    (if auth-info
+        (check-user-password (second auth-info)
+                             (third auth-info)))))
+
+;;(compute-user-login/impl *user-auth-cipher*))
+
+;;;; run-login
+
+(defun run-login (login password-md5 &key (version 1) )
+  "Set cookie for user name and password"
+  ;; (setf *bindings*
+  ;;       (acons :user-login-name login *bindings*))
+  (set-auth-cookie login password-md5 :version version))
+
+;;;; run-logout
+
+(defun run-logout ()
+  "Clear cookie with auth information"
+  (hunchentoot:set-cookie *cookie-auth-name*))

src/auth/defmodule.lisp

@@ -0,0 +1,62 @@
+;;;; defplugin.lisp
+;;;;
+;;;; This file is part of the rulisp application, released under GNU Affero General Public License, Version 3.0
+;;;; See file COPYING for details.
+;;;;
+;;;; Author: Moskvitin Andrey <archimag@gmail.com>
+
+(in-package #:rulisp.auth)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; preferences
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defparameter *sendmail*
+  (find-if #'fad:file-exists-p
+           (list "/usr/bin/sendmail"
+                 "/usr/sbin/sendmail")))
+
+(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])?$")
+
+(defparameter *noreply-email* "noreply@example.com")
+
+(defparameter *cookie-auth-name* "userauth")
+
+(defparameter *cookie-cipher-key* (ironclad:ascii-string-to-byte-array "Specify the secure key"))
+
+(defvar *user-auth-cipher*)
+
+(defparameter *finalize-page* #'closure-template.standard:xhtml-strict-frame)
+
+(defparameter *host* "example.com")
+
+;; (defparameter *storage* nil)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; initialization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod restas:initialize-module-instance ((module (eql #.*package*)) context)
+  (restas:context-add-variable 
+   context
+   '*user-auth-cipher*
+   (ironclad:make-cipher :blowfish 
+                         :mode :ecb
+                         :key (restas:context-symbol-value context
+                                                           '*cookie-cipher-key*))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; md5
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun calc-md5-sum (val)
+  "Calc sha1 sum of the val (string)"
+  (ironclad:byte-array-to-hex-string
+   (ironclad:digest-sequence :md5
+                             (babel:string-to-octets val :encoding :utf-8))))
+
+(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))))

src/auth/sendmail.lisp

@@ -0,0 +1,32 @@
+;;;; sendmail.lisp
+;;;;
+;;;; This file is part of the rulisp application, released under GNU Affero General Public License, Version 3.0
+;;;; See file COPYING for details.
+;;;;
+;;;; Author: Moskvitin Andrey <archimag@gmail.com>
+
+(in-package #:rulisp.auth)
+
+(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 send-mail (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))))