Fetching contributors…
Cannot retrieve contributors at this time
339 lines (290 sloc) 9.72 KB
(in-package :cl-user)
;; load in aserve
;; $Id:,v 1.69 2008/02/04 21:02:24 jkf Exp $
;; load in aserve
; loading this file will compile and load AllegroServe (+++mt NOT Webactions and examples)
; calling (make-aserve.fasl) will build
; aserve.fasl - just allegroserve
; webactions/webactions.fasl - just webactions
(in-package :user)
(defvar *loadswitch* :compile-if-needed)
(defparameter *aserve-root* (directory-namestring *load-pathname*))
(defparameter *aserve-files*
;; this list is in cl/src/sys/ as well... keep in sync
#+include-playback "playback" ;;; not part of production release
(defparameter *aserve-other-files*
;; other files that make up the aserve dist
(defparameter *aserve-examples*
(defparameter *aserve-international-only*
;; files that should only be loaded into a international lisp
(defparameter *webactions-files*
;; this list of source files that are compiled to make
;; webactions
(defparameter *webactions-other-files*
;; other files to distribute with a source distribution
;; end experimental
(eval-when (compile eval load)
(require :sock) ;; so we can tell if we have hiper sockets
;(setq *features* (delete :hiper-socket *features*))
(with-compilation-unit nil
(dolist (file *aserve-files*)
;; aServe doesn't work very well under 5.0.1 Lite due to
;; socket problem which are patched in the normal 5.0.1 but
;; not the lite version
(if* (equal file "examples/examples")
then (load (merge-pathnames (format nil "" file)
else (excl:load-compiled (merge-pathnames (format nil "" file)
(gc t) ; must compact to keep under the heap limit
(if* (or (member :ics *features* :test #'eq)
(not (member file *aserve-international-only* :test #'equal)))
then (progn (case *loadswitch*
(:compile-if-needed (compile-file-if-needed
(merge-pathnames (format nil "" file)
(:compile (compile-file
(merge-pathnames (format nil "" file)
(:load nil))
(load (merge-pathnames
(format nil "~a.fasl" file)
;; after running this function you'll have a lisp binary
;; with the webserver loaded.
;; you can cd to aserveserver and start with
;; nohup ./aserverserver -f ../examples/examples.fasl >& errs &
;; and it will run the server in the background, serving the aserve
;; examples.
(defun makeapp ()
(run-shell-command "rm -fr aserveserver" :show-window :hide)
'(:sock :process :defftype :foreign
:ffcompat "aserve.fasl")
; strange use of find-symbol below so this form can be read without
; the net.aserve package existing
:restart-init-function (find-symbol (symbol-name :start-cmd) :net.aserve)
:application-administration '(:resource-command-line
;; Quiet startup:
:read-init-files nil
:print-startup-message nil
:purify nil
:include-compiler nil
:include-devel-env nil
:include-debugger t
:include-tpl t
:include-ide nil
:discard-arglists t
:discard-local-name-info t
:discard-source-file-info t
:discard-xref-info t
:ignore-command-line-arguments t
:suppress-allegro-cl-banner nil))
(defun make-distribution ()
;; make a distributable version of aserve
(run-shell-command (format nil "rm -fr ~aaserve-dist" *aserve-root*)
:show-window :hide)
(copy-files-to *aserve-files* "aserve.fasl" :root *aserve-root*)
(dolist (file '("aserve.fasl"
(copy-files-to (list file)
(format nil "aserve-dist/~a" file)
:root *aserve-root*)))
;; checklist for publishing aserve source for source-master:
;; 1. incf version number in,doc/aserve.html, edit ChangeLog and commit
;; 2. make clean
;; 3. start lisp and load aserve/load to compile all files, there should
;; be no warnings.
;; 4. start the server (net.aserve:start :port 8000)
;; and run through the samples from Netscape and IE
;; 5a. :cl test/t-aserve
;; 5b: :cl webactions/test/t-webactions
;; 6. (make-src-distribution)
;; 7. (ftp-publish-src)
;; 8. on cobweb in /fi/opensource/src/aserve
;; do cvs update to put code on opensource site
;; 9. on cobweb as root do:
;; rsh cvs 'cd /repository/cvs-public/aserve && rsync -a --delete /cvs/aserve/ . && chgrp -R cvspublic .'
;; 10. ftp and put the tar file in the
;; incoming directory, then go to the aserve sourceforge web page and
;; select the file manager and publish it.
;; 11. cd /www/opensource/devel/www/aserve
;; on cobweb and rsync the files with SourceForge
(defparameter aserve-version-name
(apply #'format nil "aserve-~d.~d.~d"
(symbol-name :*aserve-version*)
(defun make-aserve.fasl ()
;; make both aserve and webactions
(copy-files-to *aserve-files* "aserve.fasl" :root *aserve-root*
:verbose t)
(copy-files-to *webactions-files* "webactions/webactions.fasl"
:root *aserve-root*
:verbose t)
(defun make-src-distribution (&optional (dist-name aserve-version-name))
;; make a source distribution of aserve
(run-shell-command (format nil "rm -fr ~aaserve-src" *aserve-root*)
:show-window :hide)
(dolist (file (append (mapcar (lambda (file) (format nil "" file))
(append *aserve-files*
(copy-files-to (list file)
(format nil "aserve-src/~a/~a" dist-name file)
:root *aserve-root*)))
(defun ftp-publish-src ()
;; assuming tha we've made the source distribution, tar it
;; and copy it to the ftp directory
(format nil "(cd ~aaserve-src ; tar cfz ~a.tgz ~a)"
:show-window :hide)
(format nil "cp ~aaserve-src/~a.tgz /fi/ftp/pub/aserve"
:show-window :hide))
(defun publish-docs ()
;; copy documentation to the external web site
(format nil "cp ~adoc/htmlgen.html ~adoc/aserve.html ~adoc/tutorial.html /fi/www/sites/opensource/devel/www/aserve"
:show-window :hide)
(run-shell-command "rsh cobweb bin/sync-a-opensource"
:show-window :hide))
(defun copy-files-to (files dest &key (root "") verbose)
;; copy the contents of all files to the file named dest.
;; append .fasl to the filenames (if no type is present)
(setq dest (concatenate 'string root dest))
(ensure-directories-exist dest)
(let ((buffer (make-array 4096 :element-type '(unsigned-byte 8))))
(with-open-file (p dest :direction :output :if-exists :supersede
#-(and allegro (version>= 6))
#-(and allegro (version>= 6))
'(unsigned-byte 8))
(if* verbose
then (format t "Creating ~s~%" dest))
(dolist (file files)
(setq file (concatenate 'string root file))
(if* (and (null (pathname-type file))
(not (probe-file file)))
then (setq file (concatenate 'string file ".fasl")))
(with-open-file (in file
#-(and allegro (version>= 6))
#-(and allegro (version>= 6))
'(unsigned-byte 8))
(let ((count (read-sequence buffer in)))
(if* (<= count 0) then (return))
(write-sequence buffer p :end count))))))))