[Semi-generic site/application control library
clinton@unknownlamer.org**20081204014518
 Ported from the remains of tee-it-up this is the initial version of a
 generic site control program. This allows sites that are composed of
 multiple applications to easily attach/detach themselves from a
 server.
 
 Currently it is limited to one iolib server, but an arbitrary number
 of sites may be registered to it.
] {
hunk ./golgonooza.asd 15
+			 (:file "site-control" :depends-on ("packages"))
hunk ./golgonooza.asd 19
-	       :parenscript))
+	       :parenscript :clon))
hunk ./src/packages.lisp 48
+(defpackage :org.unknownlamer.golgonooza.site-control
+  (:use :common-lisp :ucw-core)
+  (:nicknames :ucw-site-control)
+  (:import-from :arnesi :when-bind)
+  (:export :*control-server-port*
+	   :*control-server-host*
+	   :*control-request-length-limit*
+	   :*control-dev-mode*
+	   :*control-data-root*
+
+	   :ucw-site
+	   :applications
+	   :data-root
+	   :make-entry-points
+	   :start-site
+	   :stop-site
+	   :find-site-application
+	   :data-root-path
+
+	   :register-site
+	   :unregister-site
+	   :find-site
+
+	   :start-control-server
+	   :stop-control-server))
+
addfile ./src/site-control.lisp
hunk ./src/site-control.lisp 1
-
+;; site-control.lisp --- 
+
+;; Copyright (C) 2008 Clinton Ebadi <clinton@unknownlamer.org>
+
+;; Author: Clinton Ebadi <clinton@unknownlamer.org>
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(in-package :org.unknownlamer.golgonooza.site-control)
+
+;; this is intended to be a generic site-control interface. Currently
+;; applications are limited to running on one server
+
+(defvar *control-server-port* 50004
+  "Port to run server on")
+
+(defvar *control-server-host* "127.0.0.1"
+  "Host to bind port on")
+
+(defvar *control-request-length-limit* (* 50 1024 1024)
+  "Maximum request length in bytes")
+
+(defvar *control-dev-mode* t
+  "Debugging messages toggle")
+
+(defvar *control-data-root* "/tmp/golgonooza-site-control/")
+
+(defvar *control-sites* nil
+  "List of actively running sites")
+
+(defvar *control-server* nil
+  "UCW Server for controlled sites")
+
+(defvar *stale-data-reaper* nil
+  "CLON Scheduler that expires sessions and deletes any stale uploads etc.")
+
+(defclass ucw-site ()
+  ((applications :accessor applications :initarg :applications)
+   (data-root :accessor data-root :initarg :data-root)))
+
+(defgeneric make-entry-points (site))
+(defgeneric start-site (site))
+(defgeneric stop-site (site))
+
+(defgeneric find-site-application (site name))
+(defgeneric data-root-path (site path))
+
+(defmethod start-site ((site ucw-site))
+  (make-entry-points site)
+  (mapc (lambda (application)
+	  (register-application *control-server* (cdr application))
+	  (if (server-running-p) (startup-application (cdr application))))
+	(applications site)))
+
+(defmethod stop-site ((site ucw-site))
+  (mapc (lambda (application)
+	  (if (server-running-p) (shutdown-application (cdr application)))
+	  (unregister-application *control-server* (cdr application)))
+	(applications site)))
+
+(defmethod find-site-application ((site ucw-site) name)
+  (cdr (assoc name (applications site))))
+
+(defmethod find-site-application ((site symbol) name)
+  (find-site-application (find-site site) name))
+
+(defmethod data-root-path ((site ucw-site) path)
+  (format nil "~A~A" (data-root site) path))
+
+(defgeneric register-site (name site))
+(defgeneric unregister-site (name))
+
+(defun server-running-p ()
+  *control-server*)
+
+(defun initialize-sites ()
+  (mapc (lambda (site) (start-site (cdr site)))
+	*control-sites*))
+
+(defun uninitialize-sites ()
+  (mapc (lambda (site) (stop-site (cdr site)))
+	*control-sites*))
+
+(defun reap-stale-data ()
+  (mapc (lambda (site) (mapc (lambda (app)
+			  (format *debug-io* "Reaping sessions... ~D~%"
+				  (length (ucw-core::remove-expired-sessions
+					   (cdr app)))))
+			(applications (cdr site))))
+	*control-sites*)
+  (format *debug-io* "Reaping files... ~D~%"
+	  (length
+	   (mapc (lambda (file)
+		   (ignore-errors (delete-file file)))
+		 (cl-fad:list-directory
+		  ucw-core::*directory-for-temporary-files*)))))
+
+(defun stop-reaping ()
+  (reap-stale-data) ; one final run to nuke leftover uploads
+  (if *stale-data-reaper*
+      (setq *stale-data-reaper*
+	    (sb-ext:unschedule-timer *stale-data-reaper*))))
+
+(defun start-reaping ()
+  (stop-reaping)
+  (setq *stale-data-reaper*
+	(clon:schedule-function
+	 #'reap-stale-data
+	 (clon:make-scheduler (clon:make-typed-cron-schedule :hour '*))
+	 :thread t :name "ucw stale bread reaper")))
+
+(defun start-control-server ()
+  (setq *control-server*
+	(create-server
+	 :backend `(:iolib :port ,*control-server-port*
+			   :host ,*control-server-host*)
+	 :log-level (if *control-dev-mode* ucw-core::+debug+ ucw-core::+warn+)
+	 :log-root-directory (format nil "~A~A"  *control-data-root* "log/")))
+
+  (setf *debug-on-error* *control-dev-mode*
+	*inspect-components* nil
+	
+	(ucw-core::request-content-length-limit-of
+	 (server.backend *control-server*)) *control-request-length-limit*
+	 
+	ucw-core::*directory-for-temporary-files* (format nil "~Atmp/"
+							  *control-data-root*))
+  (initialize-sites)
+  (start-reaping)
+
+  *control-server*)
+
+(defun stop-control-server ()
+  (stop-reaping)
+  (uninitialize-sites)
+  (ucw-core:shutdown-server *control-server*)
+  (if (eq *control-server* *default-server*)
+      (setq *default-server* nil))
+  (setq *control-server* nil))
+
+(defun find-site (name)
+  (cdr (assoc name *control-sites*)))
+
+(defmethod register-site (name site)
+  (push (cons name site) *control-sites*)
+  (if (server-running-p)
+      (start-site site)))
+
+(defmethod unregister-site (name)
+  (when-bind site (find-site name)
+    (if (server-running-p)
+	(stop-site site))
+    (setq *control-sites* (delete name *control-sites* :key #'car))))
}