;; site-control.lisp --- 

;; Copyright (C) 2008,2009 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 Lesser 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 Lesser 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-server-backend* :iolib
  "UCW server backend type for control server")

(defvar *control-request-length-limit* (* 50 1024 1024)
  "Maximum request length in bytes")

(defvar *control-log-level* nil
  "Debugging messages toggle")

(defvar *control-dev-mode* nil)

(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 basic-ucw-site ()
  ((applications :accessor applications :initarg :applications)))

(defclass ucw-site-data-root-mixin ()
  ((data-root :accessor data-root :initarg :data-root)))

(defclass ucw-site (ucw-site-data-root-mixin basic-ucw-site)
  ())

(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))
(defgeneric start-site-application (site application))
(defgeneric stop-site-application (site application))

(defmethod start-site ((site ucw-site))
  (make-entry-points site)
  (mapc (lambda (application)
	  (register-application *control-server* (cdr application))
	  (if (server-running-p) (start-site-application site (cdr application))))
	(applications site)))

(defmethod start-site-application ((site ucw-site) (application application))
  (startup-application application))

(defmethod stop-site ((site ucw-site))
  (mapc (lambda (application)
	  (if (server-running-p) (stop-site-application site (cdr application)))
	  (unregister-application *control-server* (cdr application)))
	(applications site)))

(defmethod stop-site-application ((site ucw-site) (application application))
  (shutdown-application application))

(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-data-root-mixin)
			   path)
  (merge-pathnames path (data-root site)))

(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*
	    (trivial-timers: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 `(,*control-server-backend*
		    :port ,*control-server-port*
		    :host ,*control-server-host*)
	 :log-level (or *control-log-level* ucw.system:*ucw-log-level*)
	 :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))))