[Bese-devel] darcs patch: Lisp startable UCW
Marco Baringer
mb at bese.it
Mon Aug 1 10:27:02 UTC 2005
Robert Marlow <bobstopper at bobturf.org> writes:
first off: you rock!
now, the comments:
1) is there a particularl reason you moved a bunch of configuration
stuff into ucwctl? i have a few apps which don't use ucwctl (but
have their own 'start.lisp' scripts) so i'll need to rewrite the
code you've added to ucwctl.
2) mind if i rename get-backend to 'make-backend'? i know this may
seem trivial but all of our functions which create new stuff are
called 'make-XYZ', while the get-XYZ always returns an already
existisng object.
3) i'm still looking through it so i may come up with other questions.
> ] {
> hunk ./bin/ucwctl 12
> -VARROOT=$UCWROOT/var
> -LOGROOT=$UCWROOT/logs
> +VARROOT="$UCWROOT/var"
> +LOGROOT="$UCWROOT/logs"
> +LOGLEVEL="INFO"
> +HOST="127.0.0.1"
> +PORT="8080"
> +DEBUGGER="T"
> +INSPECTOR="NIL"
> +BACKEND="httpd"
> +#BACKEND="mod-lisp"
> +#BACKEND="aserve"
> +#BACKEND="araneida"
> +SYSTEMS="(:ucw :ucw.$BACKEND :ucw.admin :ucw.examples)"
> +APPLICATIONS="(list it.bese.ucw-user::*example-application*
> + ucw::*admin-application*)"
> hunk ./bin/ucwctl 40
> - $LISP_LOAD $UCWROOT/bin/start.lisp
> + $LISP_LOAD \
> + --eval "(defmethod print-object ((c asdf::missing-component) s)
> + (format s \"Unable to find the system for ~S.
> +asdf:*central-registry* is ~S.
> +Are the symlinks and asdf:*central-registry* properly setup?\" \
> + (asdf::missing-requires c) \
> + asdf:*central-registry*))" \
> + --eval "(mapc (lambda (name) (asdf:oos 'asdf:load-op name)) '$SYSTEMS)" \
> + --eval "(ucw:start-swank)" \
> + --eval "(ucw:create-server :backend :$BACKEND
> + :applications $APPLICATIONS
> + :debugger $DEBUGGER
> + :inspector $INSPECTOR
> + :log-root-directory #P\"$LOGROOT/\"
> + :log-level it.bese.arnesi:+$LOGLEVEL+
> + :host \"$HOST\"
> + :port $PORT)"
> hunk ./bin/ucwctl 60
> - --eval "(load \"$UCWROOT/bin/stop.lisp\")"
> + --eval "(ucw:shutdown-server ucw:*default-server*)" \
> + --eval "(quit)"
> hunk ./src/backend/araneida.lisp 12
> - ((listener :accessor listener :initarg :listener)
> + ((listener :accessor listener :initarg :listener :initform nil)
> hunk ./src/backend/araneida.lisp 38
> - &key (port 8080) (host "127.0.0.1"))
> - (setf (listener backend) (make-instance (listener-class backend) :port port)
> - (default-url backend) (araneida:make-url :scheme "http" :host host :port port)))
> + &key (port 8080) (host "127.0.0.1"))
> + (unless (listener backend)
> + (setf (listener backend) (make-instance (listener-class backend) :port port)
> + (default-url backend) (araneida:make-url :scheme "http" :host host :port port)
> + (araneida::http-listener-default-hostname (listener backend)) host
> + araneida::*default-url-defaults* (default-url backend))))
> hunk ./src/backend/araneida.lisp 56
> - #+clisp (araneida:host-serve-events))
> + #+clisp (araneida:host-serve-events))
> hunk ./src/backend/araneida.lisp 195
> +
> +
> +(defmethod get-backend ((backend araneida:http-listener) &optional host port)
> + (declare (ignore host port))
> + (make-instance 'ucw:araneida-backend
> + :listener backend
> + :default-url (araneida:make-url :scheme "http" :host host :port port)))
this is a particularly good idea :)
> addfile ./src/control.lisp
> hunk ./src/control.lisp 1
> +(in-package :ucw)
> +
> +(defun threaded-lisp-p ()
> + #+(and sbcl sb-thread) t
> + #+(and cmu mp) t
> + #+openmcl t)
> +
> +
> +(defun start-swank ()
> + (if (threaded-lisp-p)
> + (swank:create-server :dont-close t)
> + (warn "Can't start slime server due to lack of threads.")))
> +
> +
> +(defun create-server (&key (backend :default) applications debugger
> + inspector host port (start-p t)
> + (server-class 'standard-server) log-root-directory
> + (log-level +info+))
> + "Creates and returns a UCW server according to SERVER-CLASS, HOST and
> +PORT. Affects *DEFAULT-SERVER*.
> +
> +BACKEND may be :HTTPD, :MOD-LISP, :ASERVE, :ARANEIDA, an existing backend,
> +an existing UCW server backend or :DEFAULT in which case it attempts to
> +return a sane default from the UCW backends loaded and available.
> +
> +APPLICATIONS is a list of defined applications to be loaded into the
> +server.
> +
> +DEBUGGER and INSPECTOR are booleans which affect *DEBUG-ON-ERROR* and
> +*INSPECT-COMPONENTS* respectively.
> +
> +Logs are generated in verbosity defined by LOG-LEVEL and directed to
> +LOG-ROOT-DIRECTORY if defined."
> + (setf *debug-on-error* (or *debug-on-error* debugger)
> + *inspect-components* (or *inspect-components* inspector))
> +
> + (when log-root-directory
> + (let ((ucw-logger (get-logger 'ucw::ucw-logger))
> + (ucw.backend (get-logger 'ucw::ucw.backend))
> + (ucw.log (merge-pathnames "ucw.log" log-root-directory))
> + (ucw.backend.log (merge-pathnames "ucw-backend.log" log-root-directory))
> + (console-appender (make-stream-log-appender)))
> +
> + (setf (appenders ucw-logger) (list console-appender
> + (make-file-log-appender ucw.log))
> + (log.level ucw-logger) log-level
> + (appenders ucw.backend) (list console-appender
> + (make-file-log-appender ucw.backend.log)))))
> +
> + (let ((server nil))
> +
> + (restart-case
> + (when *default-server*
> + (error "*DEFAULT-SERVER* already defined as ~A.
> +Create another server anyway?" *default-server*))
> + (replace ()
> + :report "Replace *DEFAULT-SERVER* with a new server instance"
> + (shutdown-server *default-server*)
> + (setf *default-server* nil))
> + (continue ()
> + :report "Create an additional server"))
> + (setf server (make-instance server-class))
> + (unless *default-server*
> + (setf *default-server* server))
> + (setf (server.backend server)
> + (get-backend backend host port))
> + (mapc (lambda (app)
> + (register-application server app))
> + applications)
> + (when start-p
> + (startup-server server))
> + server))
> +
> +
> +(defgeneric get-backend (backend &optional host port)
> + (:documentation "Returns a UCW server backend as requested by the
> +functional arguments. BACKEND may be :HTTPD, :MOD-LISP, :ASERVE,
> +:ARANEIDA, an existing backend, an existing UCW server backend or
> +:DEFAULT in which case it attempts to return a sane default from
> +the UCW backends loaded and available."))
> +
> +
> +(defmethod get-backend ((backend (eql :httpd)) &optional host port)
> + (make-instance (if (threaded-lisp-p)
> + 'ucw:multithread-httpd-backend
> + 'ucw:httpd-backend)
> + :host host
> + :port port))
> +
> +
> +(defmethod get-backend ((backend (eql :mod-lisp)) &optional host port)
> + (make-instance (if (threaded-lisp-p)
> + 'ucw:multithread-mod-lisp-backend
> + 'ucw:mod-lisp-backend)
> + :host host
> + :port 8080))
> +
> +
> +(defmethod get-backend ((backend (eql :aserve)) &optional host port)
> + (declare (ignore host))
> + (make-instance 'ucw:aserve-backend :port 8080))
> +
> +
> +(defmethod get-backend ((backend (eql :araneida)) &optional host port)
> + (make-instance 'ucw:araneida-backend
> + :host host
> + :port port))
> +
> +
> +(defmethod get-backend ((backend (eql :default)) &optional host port)
> + (cond
> + ((find-class 'mod-lisp-backend nil)
> + (get-backend :mod-lisp host port))
> + ((find-class 'httpd-backend nil)
> + (get-backend :httpd host port))
> + ((find-class 'aserve-backend nil)
> + (get-backend :aserve host port))
> + ((find-class 'araneida-backend nil)
> + (get-backend :araneida host port))
> + (t (error "No backends loaded and ready for use"))))
> +
> +
> +(defmethod get-backend ((backend backend) &optional host port)
> + (declare (ignore host port))
> + backend)
> +
> +
> +(defmethod get-backend (backend &optional host port)
> + (error "Unacceptable UCW backend ~A" backend))
> +
> hunk ./src/packages.lisp 231
> - #:time-difference))
> + #:time-difference
> +
> + ;; Control utilities
> + #:start-swank
> + #:create-server))
> hunk ./src/rerl/standard-application.lisp 41
> - (register-entry-point (application.server app)
> - (strcat (application.url-prefix app) url)
> - entry-point))
> + (when (application.server app)
> + (register-entry-point (application.server app)
> + (strcat (application.url-prefix app) url)
> + entry-point)))
> hunk ./src/rerl/standard-classes.lisp 37
> + (started :accessor server.started :initform nil :initarg :started)
> hunk ./src/rerl/standard-classes.lisp 80
> +
> hunk ./src/rerl/standard-server.lisp 16
> + (setf (server.started server) t)
> hunk ./src/rerl/standard-server.lisp 40
> - (application.url-prefix app)))))
> + (application.url-prefix app)))
> + (maphash (lambda (url entry-point)
> + (register-entry-point server
> + (strcat (application.url-prefix app) url)
> + entry-point))
> + (application.entry-points app))))
> hunk ./src/vars.lisp 7
> -(defvar *debug-on-error*)
> +(defvar *debug-on-error* nil)
> hunk ./src/vars.lisp 9
> -(defvar *ucw-tal-root*)
> +(defvar *ucw-tal-root*
> + (merge-pathnames (make-pathname :directory '(:relative "wwwroot"))
> + (asdf:component-pathname (asdf:find-system :ucw))))
> hunk ./src/vars.lisp 13
> -(defvar *inspect-components*)
> +(defvar *inspect-components* nil)
> hunk ./ucw.asd 92
> - :depends-on ("packages" :rerl)))))
> + :depends-on ("packages" :rerl))
> + (:file "control"
> + :depends-on ("packages" :backend :rerl)))))
> }
>
> Context:
>
> [bash -> sh
> Julian Stecklina <der_julian at web.de>**20050731145119]
> [When creating the string for request paramteers use the same element-type as the raw-uri array
> Marco Baringer <mb at bese.it>**20050730114429]
> [Use defcomponent instead of defclass for simple-template-component
> Marco Baringer <mb at bese.it>**20050726095406]
> [Instead of looking for a property named VERSIONS we now call it :FEATURES. Updated the error message accordingly
> Marco Baringer <mb at bese.it>**20050729103158]
> [Renamed 'version' to 'feature' in asdf property check. added check for cps-interpreter
> Marco Baringer <mb at bese.it>**20050728120322]
> [Changes to the stylesheet
> Marco Baringer <mb at bese.it>**20050728120129]
> [template-component-environment methods must always return a fresh list
> Marco Baringer <mb at bese.it>**20050725121551]
> [Make the wiki example use the show-window macro
> Marco Baringer <mb at bese.it>**20050725121447]
> [Added SHOW and SHOW-WINDOW macros
> Marco Baringer <mb at bese.it>**20050725121421]
> [Post method for login component
> matley at innerloop.it**20050724142609]
> [Added initarg to client-value (form-component)
> matley at innerloop.it**20050723142419]
> [Little typo bugfix
> matley at innerloop.it**20050722200835]
> [Only use copy-seq on the request parameters if thay are strings (as opposed to mime-part objects)
> Marco Baringer <mb at bese.it>**20050721154259]
> [Export the mime-part accessors
> Marco Baringer <mb at bese.it>**20050721154124]
> [Update component slots and backtrack slots when reinitializing component classes
> Marco Baringer <mb at bese.it>**20050718172834]
> [Allow defcomponent slot forms to be symbols (some effect as with defclass)
> Marco Baringer <mb at bese.it>**20050718171831]
> [More accurate information regarding versions and how to get the software.
> José Pablo Ezequiel Fernández <pupeno at pupeno.com>**20050718033950]
> [More changes regarding dependencies.
> José Pablo Ezequiel Fernández <pupeno at pupeno.com>**20050717214720]
> [Some clear statements about the dependencies (more is still neede).
> José Pablo Ezequiel Fernández <pupeno at pupeno.com>**20050717213407]
> [Make ucw's installation directory an explicit configuration variable in make-image.lisp
> Marco Baringer <mb at bese.it>**20050717191936]
> [Remove useless debugging code from ucw-tags.lisp
> Marco Baringer <mb at bese.it>**20050717191301]
> [Fix handling of HTTR response status codes in aserve backend (Patch by: Antonio Menezes Leitao <aml at gia.ist.utl.pt>)
> Marco Baringer <mb at bese.it>**20050717190254]
> [Fix handling of HTTP request/respons headers in aserve backend. (Patch by: Antonio Menezes Leitao <aml at gia.ist.utl.pt>)
> Marco Baringer <mb at bese.it>**20050717185826]
> [Initial Import from arch
> Marco Baringer <mb at bese.it>**20050706133829
> This patch is exactly equal to ucw-2004 at common-lisp.net/ucw--dev--0.3--patch-426 it simply
> represents the move over to darcs.
> ]
> [Added boring file
> Marco Baringer <mb at bese.it>**20050706132641]
> Patch bundle hash:
> 544613ec9e5780e48c348da7472bba4343554ed4
>
> _______________________________________________
> bese-devel mailing list
> bese-devel at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/bese-devel
More information about the bese-devel
mailing list